From afd4c3c448381f6eb706090911a15c162fdaf8af Mon Sep 17 00:00:00 2001 From: Lars-Dominik Braun Date: Sun, 9 Oct 2016 11:28:19 +0200 Subject: Decompress source files MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit EUMEL’s TEXT dataspaces wastes a lot of storage space. Some files were therefore “compressed” by storing them as a single line, reducing overhead significantly. --- hamster/ls-Herbert und Robbi 1 | 1018 +++++++++++++++++++++++++++++++++++--- hamster/ls-Herbert und Robbi 2 | 120 ++++- hamster/ls-Herbert und Robbi 3 | 963 +++++++++++++++++++++++++++++++++--- hamster/ls-Herbert und Robbi-gen | 125 ++++- 4 files changed, 2094 insertions(+), 132 deletions(-) (limited to 'hamster') diff --git a/hamster/ls-Herbert und Robbi 1 b/hamster/ls-Herbert und Robbi 1 index ed19e98..9b3ff72 100644 --- a/hamster/ls-Herbert und Robbi 1 +++ b/hamster/ls-Herbert und Robbi 1 @@ -22,63 +22,963 @@ *) -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",{} 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: )");{} 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;{} +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", + 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: )"); + 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 index 7394932..a8ce067 100644 --- a/hamster/ls-Herbert und Robbi 2 +++ b/hamster/ls-Herbert und Robbi 2 @@ -22,10 +22,118 @@ *) -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){} +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 index e5db408..7a1da20 100644 --- a/hamster/ls-Herbert und Robbi 3 +++ b/hamster/ls-Herbert und Robbi 3 @@ -22,63 +22,908 @@ *) -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;{} +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 index ae21ddb..6104fe3 100644 --- a/hamster/ls-Herbert und Robbi-gen +++ b/hamster/ls-Herbert und Robbi-gen @@ -22,12 +22,121 @@ *) -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.{} +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. + -- cgit v1.2.3