summaryrefslogtreecommitdiff
path: root/hamster/ls-Herbert und Robbi 1
diff options
context:
space:
mode:
Diffstat (limited to 'hamster/ls-Herbert und Robbi 1')
-rw-r--r--hamster/ls-Herbert und Robbi 11018
1 files changed, 959 insertions, 59 deletions
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<V>",{} praefix = "Flaeche:",{} flaechentype = 1007,{} neutral = 0,{} erzeuge = 1,{} hamsterlauf = 2,{} interaktiv = 3,{} kommandostufe = 99,{} west = ""8"",{} ost = ""2"",{} cleol = ""5"",{} piep = ""7"",{}
- mark ein = ""15"",{} mark aus = ""14"",{} escape = ""27"",{} blank = " ",{} niltext = "",{} hindernis = "#",{} korn = "o",{} hinderniskachel = "##",{} blankkachel = " .",{} kornkachel = " o",{} protokollname = "PROTOKOLL";{}LET max x = 40,{}
- max y = 23;{}LET FLAECHE = ROW max x ROW max y INT;{}LET LANDSCHAFT = STRUCT (INT xpos, ypos, blickrichtung,{} anzahl koerner, FLAECHE flaeche);{}LET HAMSTER = STRUCT (LOCATION stelle, INT koerner, form);{}BOUND LANDSCHAFT VAR aktuelle landschaft;{}FLAECHE VAR land;{}HAMSTER VAR hamster;{}FILE VAR protokoll;{}INT CONST besetzt :: -1,{} frei :: 0;{}
-TEXT CONST kornsymbole ::{} "1234567890abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ";{}INT CONST maxkornzahl :: LENGTH kornsymbole;{}BOOL VAR hamster eingestellt :: TRUE,{} befehlssatz erweitert :: FALSE;{}TEXT VAR eingabezeichen :: niltext,{} archivlandschaftsname :: niltext,{} hinderniszeichen :: "\#\#",{} schrifttyp :: niltext;{}INT VAR verzoegerungsfaktor :: 5,{}
- modus :: kommandostufe,{} a, b, c, d;{}REAL VAR xstart :: 0.0,{} ystart :: 0.0;{}WINDOW VAR fenster :: window (1, 1, 79, 24);{}INITFLAG VAR in this task :: FALSE;{}OP := (LOCATION VAR l, LOCATION CONST r):{} l.x := r.x; l.y := r.y{}END OP :=;{}PROC initialize hamstersystem:{} IF NOT initialized (in this task){} THEN install menu (menukarte);{} FI{}END PROC initialize hamstersystem;{}
-PROC sei ein hamster:{} hamster eingestellt := TRUE{}END PROC sei ein hamster;{}BOOL PROC ist hamster:{} hamster eingestellt{}END PROC ist hamster;{}PROC sei ein roboter:{} hamster eingestellt := FALSE{}END PROC sei ein roboter;{}BOOL PROC ist roboter:{} NOT hamster eingestellt{}END PROC ist roboter;{}PROC hole landschaft (TEXT CONST name):{} aktuelle landschaft := old (praefix + name);{} land := aktuelle landschaft.flaeche;{} hamster.form := aktuelle landschaft.blickrichtung;{}
- hamster.stelle.x := aktuelle landschaft.xpos;{} hamster.stelle.y := aktuelle landschaft.ypos;{} hamster.koerner := aktuelle landschaft.anzahl koerner{}END PROC hole landschaft;{}PROC lege landschaft ab (TEXT CONST name):{} IF exists (praefix + name){} THEN forget (praefix + name, quiet){} FI;{} aktuelle landschaft := new (praefix + name);{} aktuelle landschaft.flaeche := land;{} aktuelle landschaft.blickrichtung := hamster.form;{} aktuelle landschaft.xpos := hamster.stelle.x;{}
- aktuelle landschaft.ypos := hamster.stelle.y;{} aktuelle landschaft.anzahl koerner := hamster.koerner;{} type( old(praefix + name), flaechentype){}END PROC lege landschaft ab;{}PROC hamstermodus:{} modus := neutral{}END PROC hamstermodus;{}PROC kommandomodus:{} modus := kommandostufe{}END PROC kommandomodus;{}PROC erzeugemodus:{} modus := erzeuge{}END PROC erzeugemodus;{}PROC intermodus:{} modus := interaktiv{}END PROC intermodus;{}PROC laufmodus:{} modus := hamsterlauf{}
-END PROC laufmodus;{}BOOL PROC vorn frei:{} kontrolliere modus;{} LOCATION VAR hier :: hamster.stelle;{} SELECT hamster.form OF{} CASE 1: IF hamster.stelle.y < 2 THEN protestiere FI;{} hier.y DECR 1{} CASE 2: IF hamster.stelle.x < 2 THEN protestiere FI;{} hier.x DECR 1{} CASE 3: IF hamster.stelle.y >= max y THEN protestiere FI;{} hier.y INCR 1{} CASE 4: IF hamster.stelle.x >= max x THEN protestiere FI;{} hier.x INCR 1{} OTHERWISE modus := kommandostufe;{}
- IF ist hamster{} THEN errorstop(nachricht( 7)){} ELSE errorstop(nachricht(14)){} FI{} END SELECT;{} IF modus = erzeuge{} THEN TRUE{} ELSE land[hier.x] [hier.y] <> besetzt{} FI{}END PROC vorn frei;{}BOOL PROC korn da:{} kontrolliere modus;{} kornzahl > 0{}END PROC korn da;{}INT PROC kornzahl:{} land [hamster.stelle.x] [hamster.stelle.y]{}END PROC kornzahl;{}BOOL PROC werkstueck da:{} korn da{}END PROC werkstueck da;{}BOOL PROC backen leer:{}
- kontrolliere modus;{} hamster.koerner <= 0 AND (modus = hamsterlauf OR modus = interaktiv){}END PROC backen leer;{}BOOL PROC behaelter leer:{} backen leer{}END PROC behaelter leer;{}PROC protestiere:{} IF modus = erzeuge{} THEN out(piep); eins zurueck{} ELSE verzoegere 10 mal; zeige("X"); verzoegere 10 mal;{} kommandomodus;{} IF ist hamster{} THEN errorstop(nachricht( 6)){} ELSE errorstop(nachricht(13)){} FI;{} FI.{} eins zurueck:{}
- SELECT hamster.form OF{} CASE 1: hamster.stelle.y INCR 1{} CASE 2: hamster.stelle.x INCR 1{} CASE 3: hamster.stelle.y DECR 1{} CASE 4: hamster.stelle.x DECR 1{} OTHERWISE kommandomodus;{} IF ist hamster{} THEN errorstop(nachricht( 7)){} ELSE errorstop(nachricht(14)){} FI;{} END SELECT.{} verzoegere 10 mal:{} INT VAR j;{} FOR j FROM 1 UPTO 10 REP{} verzoegere{} PER{}END PROC protestiere;{}
-PROC verzoegere:{} IF modus <> hamsterlauf{} THEN LEAVE verzoegere{} FI;{} eingabezeichen := incharety (verzoegerungsfaktor);{} IF eingabezeichen = escape{} THEN kommandomodus;{} IF ist hamster{} THEN errorstop(nachricht( 4)){} ELSE errorstop(nachricht(11)){} FI{} ELIF eingabezeichen = "-" THEN verlangsame{} ELIF eingabezeichen = "+" THEN beschleunige{} ELIF eingabezeichen = "?" THEN boxinfo (fenster, laufauskunftstext,{} 5, maxint, a, b, c, d);{}
- cursor on; zeige landschaft{} ELIF pos ("0123456789", eingabezeichen) > 0{} THEN geschwindigkeit (int (eingabezeichen)){} FI.{} verlangsame:{} IF verzoegerungsfaktor > 31 THEN (* lass es dabei *){} ELIF verzoegerungsfaktor < 1{} THEN verzoegerungsfaktor INCR 1{} ELSE verzoegerungsfaktor INCR verzoegerungsfaktor{} FI.{} beschleunige:{} IF verzoegerungsfaktor < 1{} THEN verzoegerungsfaktor := -1{} ELSE verzoegerungsfaktor := verzoegerungsfaktor DIV 2{}
- FI{}END PROC verzoegere;{}PROC geschwindigkeit (INT CONST faktor):{} SELECT faktor OF{} CASE 0 : verzoegerungsfaktor := 20000;{} CASE 1 : verzoegerungsfaktor := 50;{} CASE 2 : verzoegerungsfaktor := 20;{} CASE 3 : verzoegerungsfaktor := 10;{} CASE 4 : verzoegerungsfaktor := 8;{} CASE 5 : verzoegerungsfaktor := 5;{} CASE 6 : verzoegerungsfaktor := 2;{} CASE 7 : verzoegerungsfaktor := 1;{} CASE 8 : verzoegerungsfaktor := 0;{} CASE 9 : verzoegerungsfaktor := -1;{}
- OTHERWISE (*belasse es dabei*){} END SELECT{}END PROC geschwindigkeit;{}PROC vor:{} kontrolliere modus;{} IF vorn frei{} THEN zeige(kachel);{} bilde neue hamsterkoordinaten;{} zeige(erscheinungsform SUB hamster.form);{} verzoegere{} ELSE modus := kommandostufe;{} zeige("X");{} IF ist hamster{} THEN errorstop(nachricht(1)){} ELSE errorstop(nachricht(8)){} FI{} FI.{} kachel:{} INT CONST z :: land [hamster.stelle.x] [hamster.stelle.y];{}
- IF z = besetzt THEN hinderniskachel{} ELIF z = frei THEN blankkachel{} ELSE kornkachel{} FI.{} bilde neue hamsterkoordinaten:{} SELECT hamster.form OF{} CASE 1 :hamster.stelle.y DECR 1{} CASE 2 :hamster.stelle.x DECR 1{} CASE 3 :hamster.stelle.y INCR 1{} CASE 4 :hamster.stelle.x INCR 1{} OTHERWISE modus:=kommandostufe;{} IF ist hamster{} THEN errorstop(nachricht( 7)){} ELSE errorstop(nachricht(14)){}
- FI{} END SELECT.{}END PROC vor;{}PROC nimm:{} kontrolliere modus;{} IF korn da{} THEN variiere kornzahl (-1);{} IF kornzahl < 1 THEN zeige (ost + blank) FI{} ELSE modus := kommandostufe;{} zeige("X");{} IF ist hamster{} THEN errorstop(nachricht(2)){} ELSE errorstop(nachricht(9)){} FI{} FI;{} verzoegere{}END PROC nimm;{}PROC gib:{} kontrolliere modus;{} IF backen leer{} THEN modus := kommandostufe;{} zeige ("X");{}
- IF ist hamster{} THEN errorstop(nachricht( 3)){} ELSE errorstop(nachricht(10)){} FI{} ELSE variiere kornzahl (+1);{} zeige(ost + korn){} FI;{} verzoegere{}END PROC gib;{}PROC links um:{} kontrolliere modus;{} hamster.form := hamster.form MOD 4 + 1;{} (* da hamster.form der Werte 1,2,3,4 faehig ist und linksdreht *){} zeige (subjekt);{} verzoegere.{} subjekt:{} erscheinungsform SUB hamster.form.{}END PROC links um;{}PROC variiere kornzahl (INT CONST delta):{}
- IF delta * delta <> 1{} THEN LEAVE variiere kornzahl{} FI; (* als delta kommen nur +1 und -1 vor *){} INT VAR k;{} IF kornzahl = -1 AND delta = 1{} THEN k := 1{} ELSE k := kornzahl + delta{} FI;{} IF k <= 0{} THEN land [hamster.stelle.x] [hamster.stelle.y] := frei{} ELSE land [hamster.stelle.x] [hamster.stelle.y] := min (k,maxkornzahl){} FI;{} IF modus = hamsterlauf OR modus = interaktiv{} THEN hamster.koerner DECR delta{} FI{}END PROC variiere kornzahl;{}PROC kontrolliere modus:{}
- initialize hamstersystem;{} SELECT modus OF{} CASE neutral : erzeugemodus;{} landschaft;{} laufmodus{} CASE erzeuge,{} interaktiv,{} hamsterlauf: (* nichts *){} OTHERWISE kommandomodus;{} line;{} IF ist hamster{} THEN sage(anwendungstext (21));pause(20);{} errorstop(nachricht( 5)){} ELSE sage(anwendungstext (22));pause(20);{}
- errorstop(nachricht(12)){} FI{} END SELECT{}END PROC kontrolliere modus;{}PROC zeige (TEXT CONST was):{} cursor (2 * hamster.stelle.x - 1, hamster.stelle.y);{} IF hamster.stelle.x >= max x AND hamster.stelle.y > max y{} THEN out ((was SUB 1)); out(west){} ELSE out(was); (LENGTH was) TIMESOUT west{} FI.{}END PROC zeige;{}PROC sage (TEXT CONST aussage):{} cursor(1,24); out(aussage + cleol){}END PROC sage;{}TEXT PROC nachricht (INT CONST nummer):{}
- inv (text (anwendungstext (nummer), 65)) + piep{}END PROC nachricht;{}TEXT PROC inv (TEXT CONST text):{} TEXT VAR aus :: mark ein + text + blank + mark aus;{} aus{}END PROC inv;{}PROC zeige landschaft:{} initialize hamstersystem;{} INT VAR y;{} FOR y FROM 1 UPTO max y REP{} setze zeile zusammen;{} cursor (1,y); out (zeile){} PER;{} cursor(1,24); out(cleol);{} IF modus = interaktiv{} THEN gib befehlszeile aus{} FI;{} zeige hamster; cursor on.{} setze zeile zusammen:{} TEXT VAR zeile :: niltext;{}
- INT VAR x;{} FOR x FROM 1 UPTO max x REP{} zeile CAT kachel{} PER.{} kachel:{} INT CONST z :: land [x] [y];{} IF z = besetzt THEN hinderniskachel{} ELIF z = frei THEN blankkachel{} ELSE kornkachel{} FI.{} gib befehlszeile aus:{} cursor(1,1); write(cleol); write (anwendungstext (62)){}END PROC zeige landschaft;{}PROC zeige hamster:{} zeige (erscheinungsform SUB hamster.form){}END PROC zeige hamster;{}PROC landschaft (TEXT CONST kandidat):{}
- initialize hamstersystem;{} archivlandschaftsname := kandidat;{} IF exists (praefix + kandidat){} CAND type (old (praefix + kandidat)) = flaechentype{} THEN behandle existierende landschaft{} ELIF exists (praefix + kandidat){} THEN forget (praefix + kandidat, quiet);{} behandle neue landschaft{} ELSE behandle neue landschaft{} FI.{} behandle existierende landschaft:{} hole landschaft (kandidat);{} SELECT modus OF{} CASE hamsterlauf,{} interaktiv,{}
- neutral : zeige landschaft;{} laufmodus{} CASE erzeuge : modifiziere eventuell{} CASE kommandostufe : modifiziere landschaft{} OTHERWISE errorstop (anwendungstext (15)){} END SELECT.{} behandle neue landschaft:{} SELECT modus OF{} CASE hamsterlauf,{} interaktiv,{} neutral,{} erzeuge : erschaffe landschaft;{} modifiziere landschaft;{} zeige landschaft;{}
- laufmodus{} CASE kommandostufe : erschaffe landschaft;{} modifiziere landschaft;{} OTHERWISE errorstop (anwendungstext (15)){} END SELECT.{} modifiziere eventuell:{} IF ist hamster{} THEN IF boxyes (fenster, anwendungstext (41), 5, a, b, c, d){} THEN cursor on; modifiziere landschaft{} FI{} ELSE IF boxyes (fenster, anwendungstext (42), 5, a, b, c, d){} THEN cursor on; modifiziere landschaft{}
- FI{} FI;{} zeige landschaft.{} erschaffe landschaft:{} INT VAR j;{} FOR j FROM 1 UPTO max y REP{} INT VAR k;{} FOR k FROM 1 UPTO max x REP{} land [k] [j] := frei{} PER{} PER;{} hamster.form := 4;{} hamster.stelle.x := 20;{} hamster.stelle.y := 12;{} hamster.koerner := 0.{}END PROC landschaft;{}PROC landschaft:{} initialize hamstersystem;{} IF ist hamster{} THEN landschaft (erfragter landschaftsname (anwendungstext (36))){}
- ELSE landschaft (erfragter landschaftsname (anwendungstext (37))){} FI{}END PROC landschaft;{}TEXT PROC erfragter landschaftsname (TEXT CONST satz):{} TEXT VAR landschaftsname :: archivlandschaftsname;{} REP{} page; line (3); out (satz + cleol); line (2);{} editget (landschaftsname);{} landschaftsname := compress (landschaftsname);{} IF landschaftsname = niltext{} THEN line (2); out (anwendungstext (18) + piep);{} line (2); out (anwendungstext (38)); pause{} FI{}
- UNTIL landschaftsname <> niltext PER;{} landschaftsname{}END PROC erfragter landschaftsname;{}PROC arbeitsfeld (TEXT CONST kandidat):{} landschaft (kandidat){}END PROC arbeitsfeld;{}PROC arbeitsfeld:{} landschaft{}END PROC arbeitsfeld;{}PROC modifiziere landschaft:{} INT CONST modalibi :: modus;{} erzeugemodus;{} zeige landschaft;{} informiere;{} zeige hamster;{} nimm ein eingabezeichen;{} WHILE nicht endewunsch REP{} erfuelle fortschreibungswunsch;{} nimm ein eingabezeichen{} PER;{}
- erfrage koernerzahl;{} lege landschaft ab (archivlandschaftsname);{} modus := modalibi.{} nimm ein eingabezeichen:{} inchar (eingabezeichen).{} nicht endewunsch:{} pos ("hH", eingabezeichen) = 0.{} erfuelle fortschreibungswunsch:{} INT CONST r :: pos (richtung, eingabezeichen){} IF r > 0{} THEN IF hamster.form = r{} THEN vor{} ELSE hamster.form := r;{} zeige hamster{} FI{} ELIF eingabezeichen = "?" THEN boxinfo (fenster, landschaftsauskunftstext,{}
- 5, maxint, a, b, c, d);{} cursor on; zeige landschaft; informiere{} ELIF eingabezeichen = "k" THEN kopiere landschaft;{} zeige landschaft; informiere{} ELIF eingabezeichen = "g" THEN gib{} ELIF eingabezeichen = "n" THEN IF korn da THEN nimm ELSE out (piep) FI{} ELIF eingabezeichen = "z" THEN zeige (text (kornzahl, 2)){} ELIF eingabezeichen = hindernis{} THEN land [hamster.stelle.x] [hamster.stelle.y] := besetzt; vor{}
- ELIF eingabezeichen = blank{} THEN land [hamster.stelle.x] [hamster.stelle.y] := frei; vor{} ELSE out (piep){} FI.{} kopiere landschaft:{} TEXT VAR kopie;{} IF NOT not empty (alle landschaften){} THEN IF ist hamster{} THEN boxinfo (fenster, anwendungstext (196), 5, maxint){} ELSE boxinfo (fenster, anwendungstext (197), 5, maxint){} FI{} ELSE lasse original auswaehlen{} FI.{} lasse original auswaehlen:{}
- IF ist hamster{} THEN kopie := boxone (fenster, alle landschaften,{} anwendungstext (23), anwendungstext (24),{} FALSE){} ELSE kopie := boxone (fenster, alle landschaften,{} anwendungstext (25), anwendungstext (26),{} FALSE){} FI;{} cursor on; hole landschaft (kopie).{} alle landschaften:{} ohne praefix (infix namen (ALL myself, praefix, flaechentype), praefix).{}
- erfrage koernerzahl:{} TEXT VAR eingabe; BOOL VAR ist ok; INT VAR zahl;{} cursor (1,23); 79 TIMESOUT waagerecht;{} REP{} ist ok := TRUE;{} IF ist hamster{} THEN eingabe := boxanswer (fenster, anwendungstext (43),{} text (hamster.koerner),{} 5, a, b, c, d){} ELSE eingabe := boxanswer (fenster, anwendungstext (44),{} text (hamster.koerner),{}
- 5, a, b, c, d){} FI;{} disable stop;{} IF eingabe = "" THEN eingabe := "0" FI;{} zahl := int (eingabe);{} IF zahl < 0 OR zahl > maxint THEN ist ok := FALSE FI;{} IF is error THEN ist ok := FALSE; clear error FI;{} enable stop;{} UNTIL last conversion ok AND ist ok PER;{} cursor on;{} hamster.koerner := zahl.{} informiere:{} cursor (1,1);{} IF ist hamster{} THEN out (anwendungstext (27)){}
- ELSE out (anwendungstext (28)){} FI{}END PROC modifiziere landschaft;{}PROC lauf (TEXT CONST dateiname):{} initialize hamstersystem;{} IF NOT exists (dateiname){} THEN errorstop (anwendungstext (16) + dateiname + anwendungstext (17)){} FI;{} hamstermodus;{} disable stop;{} run (dateiname);{} kommandomodus;{} cursor (1, 24);{} IF is error{} THEN IF length (errormessage) > 1{} THEN sage (errormessage); pause;{} FI{} ELSE sage (anwendungstext (29)); pause; konserviere landschaft{}
- FI;{} clear error;{} enable stop{}END PROC lauf;{}PROC lauf:{} lauf (last param){}END PROC lauf;{}PROC konserviere landschaft:{} TEXT VAR neuer landschaftsname;{} IF ist hamster{} THEN stelle landschaftsfrage{} ELSE stelle arbeitsfeldfrage{} FI; cursor on.{} stelle landschaftsfrage:{} IF boxyes (fenster, anwendungstext (45), 5){} THEN bewahre landschaft auf{} FI.{} stelle arbeitsfeldfrage:{} IF boxyes (fenster, anwendungstext (46), 5){} THEN bewahre landschaft auf{}
- FI.{} bewahre landschaft auf:{} neuer landschaftsname := archivlandschaftsname + ".x";{} lege landschaft ab (neuer landschaftsname);{} gib hinweis auf neuen namen.{} gib hinweis auf neuen namen:{} IF ist hamster{} THEN boxinfo (fenster, anwendungstext (30){} + inv (neuer landschaftsname), 5, maxint, a, b, c, d){} ELSE boxinfo (fenster, anwendungstext (31){} + inv (neuer landschaftsname), 5, maxint, a, b, c, d){} FI{}END PROC konserviere landschaft;{}
-PROC hamsterinter (TEXT CONST landschaftsname):{} initialize hamstersystem;{} sei ein hamster;{} steuere interaktiv (landschaftsname);{} cursor on{}END PROC hamsterinter;{}PROC hamsterinter:{} initialize hamstersystem;{} hamsterinter (erfragter landschaftsname (anwendungstext (39))){}END PROC hamsterinter;{}PROC roboterinter (TEXT CONST landschaftsname):{} initialize hamstersystem;{} sei ein roboter;{} steuere interaktiv (landschaftsname);{} cursor on{}END PROC roboterinter;{}PROC roboterinter:{}
- initialize hamstersystem;{} roboterinter (erfragter landschaftsname (anwendungstext (40))){}END PROC roboterinter;{}PROC steuere interaktiv (TEXT CONST landschaftsname):{} forget (protokollname, quiet);{} protokoll := sequential file (output, protokollname);{} intermodus;{} landschaft (landschaftsname);{} TEXT VAR befehl :: niltext, letzter befehl :: niltext;{} REP{} arbeiten{} PER.{} arbeiten:{} intermodus;{} hole befehl;{} fuehre befehl aus.{} hole befehl:{} TEXT VAR befehlszeichen;{}
- TEXT CONST befehlskette :: "vlngpeVLNGPE";{} INT VAR befehlsposition;{} zeige (hamsterform);{} cursor (1,24);{} IF ist hamster{} THEN out (cleol + anwendungstext (32) + letzter befehl){} ELSE out (cleol + anwendungstext (33) + letzter befehl){} FI;{} cursor(24,24);{} inchar (befehlszeichen);{} befehlsposition := pos(befehlskette,befehlszeichen);{} IF befehlsposition = 0{} THEN out(piep);{} LEAVE arbeiten{} FI;{} SELECT befehlsposition OF{}
- CASE 1, 7: befehl := "vor";{} out("vor");{} letzter befehl := "vor"{} CASE 2, 8: befehl := "links um";{} out("links um");{} letzter befehl := "links um"{} CASE 3, 9: befehl := "nimm";{} out("nimm");{} letzter befehl := "nimm"{} CASE 4,10: befehl := "gib";{} out("gib");{} letzter befehl := "gib"{}
- CASE 5,11: out("protokoll");{} letzter befehl := "protokoll";{} FILE VAR p :: sequential file (modify,protokollname);{} headline(p, protokollname + " (Verlassen: <ESC><q>)");{} cursor on; show(p); cursor off;{} zeige landschaft; befehl := "";{} output(protokoll);{} LEAVE arbeiten{} CASE 6,12: out("ende"); kommandomodus; befehl := "";{} LEAVE steuere interaktiv{}
- END SELECT.{} hamsterform:{} erscheinungsform SUB hamster.form.{} fuehre befehl aus:{} BOOL VAR korrekt;{} disable stop;{} do (befehl);{} cursor (1,24);{} korrekt := NOT is error;{} IF is error{} THEN IF errormessage > ""{} THEN out (inv (text (errormessage, 65)) + piep);{} pause(30);{} FI;{} clear error{} FI;{} IF korrekt AND befehl <> ""{} THEN protokolliere (befehl){} FI;{} enable stop;{}
-END PROC steuere interaktiv;{}PROC protokolliere (TEXT CONST befehl):{} putline (protokoll, befehl + ";"){}END PROC protokolliere;{}PROC drucke landschaft (TEXT CONST landschaftsname):{} initialize hamstersystem;{} ROW max y TEXT VAR drucklandschaft;{} BOUND LANDSCHAFT VAR al;{} INT VAR i, hamsterx, hamstery;{} TEXT VAR hamsterzeichen;{} landschaftsdatei holen;{} drucklandschaft erzeugen;{} hamster in drucklandschaft einsetzen;{} druckdatei erzeugen;{} disable stop;{} TEXT VAR datname := std;{}
- do ("print (""druckdatei"")");{} IF is error{} THEN menuinfo (inv (errormessage));{} clear error;{} FI;{} last param (datname);{} enable stop;{} druckdatei loeschen;{} cursor on.{} landschaftsdatei holen:{} IF exists (praefix + landschaftsname) AND{} (type (old (praefix + landschaftsname)) = flaechentype){} THEN hole landschaft;{} ELSE LEAVE drucke landschaft{} FI.{} hole landschaft:{} al := old (praefix + landschaftsname);{} hamsterx := al.xpos;{}
- hamstery := al.ypos;{} hamsterzeichen := erscheinungsform SUB al.blickrichtung.{} drucklandschaft erzeugen:{} TEXT VAR zeile; INT VAR x;{} FOR i FROM 1 UPTO max y REP{} zeile := "";{} FOR x FROM 1 UPTO maxx REP{} zeile erzeugen{} PER;{} drucklandschaft[i] := zeile{} PER.{} zeile erzeugen:{} INT CONST zeichen :: al.flaeche [x] [i];{} IF zeichen = besetzt THEN zeile CAT hinderniszeichen{} ELIF zeichen = frei THEN zeile CAT " ."{}
- ELSE zeile CAT " o"{} FI.{} hamster in drucklandschaft einsetzen:{} change (drucklandschaft [hamstery], hamsterx*2-1, hamsterx*2-1,{} hamsterzeichen).{} druckdatei erzeugen:{} FILE VAR p::sequential file(output, "druckdatei");{} INT VAR blankzahl;{} line(p);{} putline(p,"#type (""" + schrifttyp + """)#");{} putline(p,"#start(" + text(xstart) + "," + text(ystart) + ")#");{} putline(p,"#limit(20.8)#");{} blankzahl := ( 80 - (8 + length (landschaftsname))) DIV 2;{}
- putline(p, blankzahl * " " + praefix + landschaftsname + " ");{} putline(p, "  ");{} FOR i FROM 1 UPTO maxy REP{} putline(p, drucklandschaft[i] + " "){} PER.{} druckdatei loeschen:{} forget("druckdatei", quiet){}END PROC drucke landschaft;{}PROC drucke landschaft:{} initialize hamstersystem;{} IF ist hamster{} THEN drucke landschaft (erfragter landschaftsname (anwendungstext (36))){} ELSE drucke landschaft (erfragter landschaftsname (anwendungstext (37))){} FI;{} cursor on{}
-END PROC drucke landschaft;{}PROC druckereinstellung fuer flaechenausdruck:{} initialize hamstersystem;{} page;{} IF ist hamster{} THEN putline (center (invers (anwendungstext (71)))){} ELSE putline (center (invers (anwendungstext (72)))){} FI;{} line (3);{} put (anwendungstext (73));{} editget (schrifttyp);{} line (2);{} schrifttyp := compress (schrifttyp);{} putline (anwendungstext (74));{} putline (anwendungstext (75)); line (2);{} putline (anwendungstext (76) + text (xstart) + "," + text (ystart) +{}
- anwendungstext (77)); line;{} put (anwendungstext (78)); get (xstart); line;{} put (anwendungstext (79)); get (ystart); line (2);{} IF yes (anwendungstext (80) + hinderniszeichen + anwendungstext (81)){} THEN line;{} put (anwendungstext (82)); inchar (hinderniszeichen); line (2);{} hinderniszeichen CAT hinderniszeichen;{} IF hinderniszeichen = "##"{} THEN hinderniszeichen := "\#\#"{} FI{} FI;{} line;{} put (anwendungstext (83)){}END PROC druckereinstellung fuer flaechenausdruck;{}
-PROC hamster druckerstart einstellen (REAL CONST xpos, ypos):{} xstart := xpos; ystart := ypos{}END PROC hamster druckerstart einstellen;{}REAL PROC hamster drucker xstart:{} xstart{}END PROC hamster drucker xstart;{}REAL PROC hamster drucker ystart:{} ystart{}END PROC hamster drucker ystart;{}PROC hamster landschaftsschrifttyp einstellen (TEXT CONST typ):{} schrifttyp := typ{}END PROC hamster landschaftsschrifttyp einstellen;{}TEXT PROC hamster landschaftsschrifttyp:{} schrifttyp{}END PROC hamster landschaftsschrifttyp;{}
-PROC drucke arbeitsfeld (TEXT CONST arbeitsfeldname):{} drucke landschaft (arbeitsfeldname){}END PROC drucke arbeitsfeld;{}PROC drucke arbeitsfeld:{} drucke landschaft{}END PROC drucke arbeitsfeld;{}TEXT PROC taste:{} eingabezeichen{}END PROC taste;{}TEXT PROC landschaftsauskunftstext:{} initialize hamstersystem;{} IF ist hamster{} THEN anwendungstext (52){} ELSE anwendungstext (53){} FI{}END PROC landschaftsauskunftstext;{}TEXT PROC laufauskunftstext:{} initialize hamstersystem;{}
- anwendungstext (51){}END PROC laufauskunftstext;{}TEXT PROC befehlsauskunftstext:{} initialize hamstersystem;{} IF ist hamster{} THEN anwendungstext (54){} ELSE anwendungstext (55){} FI{}END PROC befehlsauskunftstext;{}TEXT PROC testauskunftstext 1:{} initialize hamstersystem;{} IF befehlssatz erweitert{} THEN langer testauskunftstext{} ELSE kurzer testauskunftstext{} FI.{} kurzer testauskunftstext:{} IF ist hamster{} THEN anwendungstext (56){} ELSE anwendungstext (57){}
- FI.{} langer testauskunftstext:{} IF ist hamster{} THEN anwendungstext (58){} ELSE anwendungstext (60){} FI.{}END PROC testauskunftstext 1;{}TEXT PROC testauskunftstext 2:{} initialize hamstersystem;{} IF befehlssatz erweitert{} THEN eintragung{} ELSE niltext{} FI.{} eintragung:{} IF ist hamster{} THEN anwendungstext (59){} ELSE anwendungstext (61){} FI{}END PROC testauskunftstext 2;{}PROC befehlssatz erweitern (BOOL CONST status):{} befehlssatz erweitert := status{}
-END PROC befehlssatz erweitern;{}BOOL PROC befehlssatz ist erweitert:{} befehlssatz erweitert{}END PROC befehlssatz ist erweitert;{}END PACKET ls herbert und robbi 1;{}
+PACKET ls herbert und robbi 1 DEFINES
+ sei ein hamster, ist hamster,
+ sei ein roboter, ist roboter,
+ landschaft, arbeitsfeld,
+ vor, links um, nimm, gib,
+ korn da, werkstueck da,
+ backen leer, behaelter leer,
+ vorn frei, lauf,
+ hamsterinter, roboterinter,
+ geschwindigkeit, taste,
+ befehlssatz erweitern,
+ befehlssatz ist erweitert,
+ drucke landschaft,
+ hamster druckerstart einstellen,
+ hamster drucker xstart,
+
+ hamster drucker ystart,
+ hamster landschaftsschrifttyp einstellen,
+ hamster landschaftsschrifttyp,
+ druckereinstellung fuer flaechenausdruck,
+ landschaftsauskunftstext,
+ testauskunftstext 1, testauskunftstext 2,
+ befehlsauskunftstext, laufauskunftstext,
+ kommandomodus, hamstermodus,
+ zeige landschaft, lege landschaft ab:
+TYPE LOCATION = STRUCT (INT x, y);
+LET menukarte = "ls-MENUKARTE:Herbert und Robbi",
+ richtung = ""3""8""10""2"",
+
+ erscheinungsform = "A<V>",
+ praefix = "Flaeche:",
+ flaechentype = 1007,
+ neutral = 0,
+ erzeuge = 1,
+ hamsterlauf = 2,
+ interaktiv = 3,
+ kommandostufe = 99,
+ west = ""8"",
+ ost = ""2"",
+ cleol = ""5"",
+ piep = ""7"",
+
+ mark ein = ""15"",
+ mark aus = ""14"",
+ escape = ""27"",
+ blank = " ",
+ niltext = "",
+ hindernis = "#",
+ korn = "o",
+ hinderniskachel = "##",
+ blankkachel = " .",
+ kornkachel = " o",
+ protokollname = "PROTOKOLL";
+LET max x = 40,
+
+ max y = 23;
+LET FLAECHE = ROW max x ROW max y INT;
+LET LANDSCHAFT = STRUCT (INT xpos, ypos, blickrichtung,
+ anzahl koerner, FLAECHE flaeche);
+LET HAMSTER = STRUCT (LOCATION stelle, INT koerner, form);
+BOUND LANDSCHAFT VAR aktuelle landschaft;
+FLAECHE VAR land;
+HAMSTER VAR hamster;
+FILE VAR protokoll;
+INT CONST besetzt :: -1,
+ frei :: 0;
+
+TEXT CONST kornsymbole ::
+ "1234567890abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ";
+INT CONST maxkornzahl :: LENGTH kornsymbole;
+BOOL VAR hamster eingestellt :: TRUE,
+ befehlssatz erweitert :: FALSE;
+TEXT VAR eingabezeichen :: niltext,
+ archivlandschaftsname :: niltext,
+ hinderniszeichen :: "\#\#",
+ schrifttyp :: niltext;
+INT VAR verzoegerungsfaktor :: 5,
+
+ modus :: kommandostufe,
+ a, b, c, d;
+REAL VAR xstart :: 0.0,
+ ystart :: 0.0;
+WINDOW VAR fenster :: window (1, 1, 79, 24);
+INITFLAG VAR in this task :: FALSE;
+OP := (LOCATION VAR l, LOCATION CONST r):
+ l.x := r.x; l.y := r.y
+END OP :=;
+PROC initialize hamstersystem:
+ IF NOT initialized (in this task)
+ THEN install menu (menukarte);
+ FI
+END PROC initialize hamstersystem;
+
+PROC sei ein hamster:
+ hamster eingestellt := TRUE
+END PROC sei ein hamster;
+BOOL PROC ist hamster:
+ hamster eingestellt
+END PROC ist hamster;
+PROC sei ein roboter:
+ hamster eingestellt := FALSE
+END PROC sei ein roboter;
+BOOL PROC ist roboter:
+ NOT hamster eingestellt
+END PROC ist roboter;
+PROC hole landschaft (TEXT CONST name):
+ aktuelle landschaft := old (praefix + name);
+ land := aktuelle landschaft.flaeche;
+ hamster.form := aktuelle landschaft.blickrichtung;
+
+ hamster.stelle.x := aktuelle landschaft.xpos;
+ hamster.stelle.y := aktuelle landschaft.ypos;
+ hamster.koerner := aktuelle landschaft.anzahl koerner
+END PROC hole landschaft;
+PROC lege landschaft ab (TEXT CONST name):
+ IF exists (praefix + name)
+ THEN forget (praefix + name, quiet)
+ FI;
+ aktuelle landschaft := new (praefix + name);
+ aktuelle landschaft.flaeche := land;
+ aktuelle landschaft.blickrichtung := hamster.form;
+ aktuelle landschaft.xpos := hamster.stelle.x;
+
+ aktuelle landschaft.ypos := hamster.stelle.y;
+ aktuelle landschaft.anzahl koerner := hamster.koerner;
+ type( old(praefix + name), flaechentype)
+END PROC lege landschaft ab;
+PROC hamstermodus:
+ modus := neutral
+END PROC hamstermodus;
+PROC kommandomodus:
+ modus := kommandostufe
+END PROC kommandomodus;
+PROC erzeugemodus:
+ modus := erzeuge
+END PROC erzeugemodus;
+PROC intermodus:
+ modus := interaktiv
+END PROC intermodus;
+PROC laufmodus:
+ modus := hamsterlauf
+
+END PROC laufmodus;
+BOOL PROC vorn frei:
+ kontrolliere modus;
+ LOCATION VAR hier :: hamster.stelle;
+ SELECT hamster.form OF
+ CASE 1: IF hamster.stelle.y < 2 THEN protestiere FI;
+ hier.y DECR 1
+ CASE 2: IF hamster.stelle.x < 2 THEN protestiere FI;
+ hier.x DECR 1
+ CASE 3: IF hamster.stelle.y >= max y THEN protestiere FI;
+ hier.y INCR 1
+ CASE 4: IF hamster.stelle.x >= max x THEN protestiere FI;
+ hier.x INCR 1
+ OTHERWISE modus := kommandostufe;
+
+ IF ist hamster
+ THEN errorstop(nachricht( 7))
+ ELSE errorstop(nachricht(14))
+ FI
+ END SELECT;
+ IF modus = erzeuge
+ THEN TRUE
+ ELSE land[hier.x] [hier.y] <> besetzt
+ FI
+END PROC vorn frei;
+BOOL PROC korn da:
+ kontrolliere modus;
+ kornzahl > 0
+END PROC korn da;
+INT PROC kornzahl:
+ land [hamster.stelle.x] [hamster.stelle.y]
+END PROC kornzahl;
+BOOL PROC werkstueck da:
+ korn da
+END PROC werkstueck da;
+BOOL PROC backen leer:
+
+ kontrolliere modus;
+ hamster.koerner <= 0 AND (modus = hamsterlauf OR modus = interaktiv)
+END PROC backen leer;
+BOOL PROC behaelter leer:
+ backen leer
+END PROC behaelter leer;
+PROC protestiere:
+ IF modus = erzeuge
+ THEN out(piep); eins zurueck
+ ELSE verzoegere 10 mal; zeige("X"); verzoegere 10 mal;
+ kommandomodus;
+ IF ist hamster
+ THEN errorstop(nachricht( 6))
+ ELSE errorstop(nachricht(13))
+ FI;
+ FI.
+ eins zurueck:
+
+ SELECT hamster.form OF
+ CASE 1: hamster.stelle.y INCR 1
+ CASE 2: hamster.stelle.x INCR 1
+ CASE 3: hamster.stelle.y DECR 1
+ CASE 4: hamster.stelle.x DECR 1
+ OTHERWISE kommandomodus;
+ IF ist hamster
+ THEN errorstop(nachricht( 7))
+ ELSE errorstop(nachricht(14))
+ FI;
+ END SELECT.
+ verzoegere 10 mal:
+ INT VAR j;
+ FOR j FROM 1 UPTO 10 REP
+ verzoegere
+ PER
+END PROC protestiere;
+
+PROC verzoegere:
+ IF modus <> hamsterlauf
+ THEN LEAVE verzoegere
+ FI;
+ eingabezeichen := incharety (verzoegerungsfaktor);
+ IF eingabezeichen = escape
+ THEN kommandomodus;
+ IF ist hamster
+ THEN errorstop(nachricht( 4))
+ ELSE errorstop(nachricht(11))
+ FI
+ ELIF eingabezeichen = "-" THEN verlangsame
+ ELIF eingabezeichen = "+" THEN beschleunige
+ ELIF eingabezeichen = "?" THEN boxinfo (fenster, laufauskunftstext,
+ 5, maxint, a, b, c, d);
+
+ cursor on; zeige landschaft
+ ELIF pos ("0123456789", eingabezeichen) > 0
+ THEN geschwindigkeit (int (eingabezeichen))
+ FI.
+ verlangsame:
+ IF verzoegerungsfaktor > 31 THEN (* lass es dabei *)
+ ELIF verzoegerungsfaktor < 1
+ THEN verzoegerungsfaktor INCR 1
+ ELSE verzoegerungsfaktor INCR verzoegerungsfaktor
+ FI.
+ beschleunige:
+ IF verzoegerungsfaktor < 1
+ THEN verzoegerungsfaktor := -1
+ ELSE verzoegerungsfaktor := verzoegerungsfaktor DIV 2
+
+ FI
+END PROC verzoegere;
+PROC geschwindigkeit (INT CONST faktor):
+ SELECT faktor OF
+ CASE 0 : verzoegerungsfaktor := 20000;
+ CASE 1 : verzoegerungsfaktor := 50;
+ CASE 2 : verzoegerungsfaktor := 20;
+ CASE 3 : verzoegerungsfaktor := 10;
+ CASE 4 : verzoegerungsfaktor := 8;
+ CASE 5 : verzoegerungsfaktor := 5;
+ CASE 6 : verzoegerungsfaktor := 2;
+ CASE 7 : verzoegerungsfaktor := 1;
+ CASE 8 : verzoegerungsfaktor := 0;
+ CASE 9 : verzoegerungsfaktor := -1;
+
+ OTHERWISE (*belasse es dabei*)
+ END SELECT
+END PROC geschwindigkeit;
+PROC vor:
+ kontrolliere modus;
+ IF vorn frei
+ THEN zeige(kachel);
+ bilde neue hamsterkoordinaten;
+ zeige(erscheinungsform SUB hamster.form);
+ verzoegere
+ ELSE modus := kommandostufe;
+ zeige("X");
+ IF ist hamster
+ THEN errorstop(nachricht(1))
+ ELSE errorstop(nachricht(8))
+ FI
+ FI.
+ kachel:
+ INT CONST z :: land [hamster.stelle.x] [hamster.stelle.y];
+
+ IF z = besetzt THEN hinderniskachel
+ ELIF z = frei THEN blankkachel
+ ELSE kornkachel
+ FI.
+ bilde neue hamsterkoordinaten:
+ SELECT hamster.form OF
+ CASE 1 :hamster.stelle.y DECR 1
+ CASE 2 :hamster.stelle.x DECR 1
+ CASE 3 :hamster.stelle.y INCR 1
+ CASE 4 :hamster.stelle.x INCR 1
+ OTHERWISE modus:=kommandostufe;
+ IF ist hamster
+ THEN errorstop(nachricht( 7))
+ ELSE errorstop(nachricht(14))
+
+ FI
+ END SELECT.
+END PROC vor;
+PROC nimm:
+ kontrolliere modus;
+ IF korn da
+ THEN variiere kornzahl (-1);
+ IF kornzahl < 1 THEN zeige (ost + blank) FI
+ ELSE modus := kommandostufe;
+ zeige("X");
+ IF ist hamster
+ THEN errorstop(nachricht(2))
+ ELSE errorstop(nachricht(9))
+ FI
+ FI;
+ verzoegere
+END PROC nimm;
+PROC gib:
+ kontrolliere modus;
+ IF backen leer
+ THEN modus := kommandostufe;
+ zeige ("X");
+
+ IF ist hamster
+ THEN errorstop(nachricht( 3))
+ ELSE errorstop(nachricht(10))
+ FI
+ ELSE variiere kornzahl (+1);
+ zeige(ost + korn)
+ FI;
+ verzoegere
+END PROC gib;
+PROC links um:
+ kontrolliere modus;
+ hamster.form := hamster.form MOD 4 + 1;
+ (* da hamster.form der Werte 1,2,3,4 faehig ist und linksdreht *)
+ zeige (subjekt);
+ verzoegere.
+ subjekt:
+ erscheinungsform SUB hamster.form.
+END PROC links um;
+PROC variiere kornzahl (INT CONST delta):
+
+ IF delta * delta <> 1
+ THEN LEAVE variiere kornzahl
+ FI; (* als delta kommen nur +1 und -1 vor *)
+ INT VAR k;
+ IF kornzahl = -1 AND delta = 1
+ THEN k := 1
+ ELSE k := kornzahl + delta
+ FI;
+ IF k <= 0
+ THEN land [hamster.stelle.x] [hamster.stelle.y] := frei
+ ELSE land [hamster.stelle.x] [hamster.stelle.y] := min (k,maxkornzahl)
+ FI;
+ IF modus = hamsterlauf OR modus = interaktiv
+ THEN hamster.koerner DECR delta
+ FI
+END PROC variiere kornzahl;
+PROC kontrolliere modus:
+
+ initialize hamstersystem;
+ SELECT modus OF
+ CASE neutral : erzeugemodus;
+ landschaft;
+ laufmodus
+ CASE erzeuge,
+ interaktiv,
+ hamsterlauf: (* nichts *)
+ OTHERWISE kommandomodus;
+ line;
+ IF ist hamster
+ THEN sage(anwendungstext (21));pause(20);
+ errorstop(nachricht( 5))
+ ELSE sage(anwendungstext (22));pause(20);
+
+ errorstop(nachricht(12))
+ FI
+ END SELECT
+END PROC kontrolliere modus;
+PROC zeige (TEXT CONST was):
+ cursor (2 * hamster.stelle.x - 1, hamster.stelle.y);
+ IF hamster.stelle.x >= max x AND hamster.stelle.y > max y
+ THEN out ((was SUB 1)); out(west)
+ ELSE out(was); (LENGTH was) TIMESOUT west
+ FI.
+END PROC zeige;
+PROC sage (TEXT CONST aussage):
+ cursor(1,24); out(aussage + cleol)
+END PROC sage;
+TEXT PROC nachricht (INT CONST nummer):
+
+ inv (text (anwendungstext (nummer), 65)) + piep
+END PROC nachricht;
+TEXT PROC inv (TEXT CONST text):
+ TEXT VAR aus :: mark ein + text + blank + mark aus;
+ aus
+END PROC inv;
+PROC zeige landschaft:
+ initialize hamstersystem;
+ INT VAR y;
+ FOR y FROM 1 UPTO max y REP
+ setze zeile zusammen;
+ cursor (1,y); out (zeile)
+ PER;
+ cursor(1,24); out(cleol);
+ IF modus = interaktiv
+ THEN gib befehlszeile aus
+ FI;
+ zeige hamster; cursor on.
+ setze zeile zusammen:
+ TEXT VAR zeile :: niltext;
+
+ INT VAR x;
+ FOR x FROM 1 UPTO max x REP
+ zeile CAT kachel
+ PER.
+ kachel:
+ INT CONST z :: land [x] [y];
+ IF z = besetzt THEN hinderniskachel
+ ELIF z = frei THEN blankkachel
+ ELSE kornkachel
+ FI.
+ gib befehlszeile aus:
+ cursor(1,1); write(cleol); write (anwendungstext (62))
+END PROC zeige landschaft;
+PROC zeige hamster:
+ zeige (erscheinungsform SUB hamster.form)
+END PROC zeige hamster;
+PROC landschaft (TEXT CONST kandidat):
+
+ initialize hamstersystem;
+ archivlandschaftsname := kandidat;
+ IF exists (praefix + kandidat)
+ CAND type (old (praefix + kandidat)) = flaechentype
+ THEN behandle existierende landschaft
+ ELIF exists (praefix + kandidat)
+ THEN forget (praefix + kandidat, quiet);
+ behandle neue landschaft
+ ELSE behandle neue landschaft
+ FI.
+ behandle existierende landschaft:
+ hole landschaft (kandidat);
+ SELECT modus OF
+ CASE hamsterlauf,
+ interaktiv,
+
+ neutral : zeige landschaft;
+ laufmodus
+ CASE erzeuge : modifiziere eventuell
+ CASE kommandostufe : modifiziere landschaft
+ OTHERWISE errorstop (anwendungstext (15))
+ END SELECT.
+ behandle neue landschaft:
+ SELECT modus OF
+ CASE hamsterlauf,
+ interaktiv,
+ neutral,
+ erzeuge : erschaffe landschaft;
+ modifiziere landschaft;
+ zeige landschaft;
+
+ laufmodus
+ CASE kommandostufe : erschaffe landschaft;
+ modifiziere landschaft;
+ OTHERWISE errorstop (anwendungstext (15))
+ END SELECT.
+ modifiziere eventuell:
+ IF ist hamster
+ THEN IF boxyes (fenster, anwendungstext (41), 5, a, b, c, d)
+ THEN cursor on; modifiziere landschaft
+ FI
+ ELSE IF boxyes (fenster, anwendungstext (42), 5, a, b, c, d)
+ THEN cursor on; modifiziere landschaft
+
+ FI
+ FI;
+ zeige landschaft.
+ erschaffe landschaft:
+ INT VAR j;
+ FOR j FROM 1 UPTO max y REP
+ INT VAR k;
+ FOR k FROM 1 UPTO max x REP
+ land [k] [j] := frei
+ PER
+ PER;
+ hamster.form := 4;
+ hamster.stelle.x := 20;
+ hamster.stelle.y := 12;
+ hamster.koerner := 0.
+END PROC landschaft;
+PROC landschaft:
+ initialize hamstersystem;
+ IF ist hamster
+ THEN landschaft (erfragter landschaftsname (anwendungstext (36)))
+
+ ELSE landschaft (erfragter landschaftsname (anwendungstext (37)))
+ FI
+END PROC landschaft;
+TEXT PROC erfragter landschaftsname (TEXT CONST satz):
+ TEXT VAR landschaftsname :: archivlandschaftsname;
+ REP
+ page; line (3); out (satz + cleol); line (2);
+ editget (landschaftsname);
+ landschaftsname := compress (landschaftsname);
+ IF landschaftsname = niltext
+ THEN line (2); out (anwendungstext (18) + piep);
+ line (2); out (anwendungstext (38)); pause
+ FI
+
+ UNTIL landschaftsname <> niltext PER;
+ landschaftsname
+END PROC erfragter landschaftsname;
+PROC arbeitsfeld (TEXT CONST kandidat):
+ landschaft (kandidat)
+END PROC arbeitsfeld;
+PROC arbeitsfeld:
+ landschaft
+END PROC arbeitsfeld;
+PROC modifiziere landschaft:
+ INT CONST modalibi :: modus;
+ erzeugemodus;
+ zeige landschaft;
+ informiere;
+ zeige hamster;
+ nimm ein eingabezeichen;
+ WHILE nicht endewunsch REP
+ erfuelle fortschreibungswunsch;
+ nimm ein eingabezeichen
+ PER;
+
+ erfrage koernerzahl;
+ lege landschaft ab (archivlandschaftsname);
+ modus := modalibi.
+ nimm ein eingabezeichen:
+ inchar (eingabezeichen).
+ nicht endewunsch:
+ pos ("hH", eingabezeichen) = 0.
+ erfuelle fortschreibungswunsch:
+ INT CONST r :: pos (richtung, eingabezeichen)
+ IF r > 0
+ THEN IF hamster.form = r
+ THEN vor
+ ELSE hamster.form := r;
+ zeige hamster
+ FI
+ ELIF eingabezeichen = "?" THEN boxinfo (fenster, landschaftsauskunftstext,
+
+ 5, maxint, a, b, c, d);
+ cursor on; zeige landschaft; informiere
+ ELIF eingabezeichen = "k" THEN kopiere landschaft;
+ zeige landschaft; informiere
+ ELIF eingabezeichen = "g" THEN gib
+ ELIF eingabezeichen = "n" THEN IF korn da THEN nimm ELSE out (piep) FI
+ ELIF eingabezeichen = "z" THEN zeige (text (kornzahl, 2))
+ ELIF eingabezeichen = hindernis
+ THEN land [hamster.stelle.x] [hamster.stelle.y] := besetzt; vor
+
+ ELIF eingabezeichen = blank
+ THEN land [hamster.stelle.x] [hamster.stelle.y] := frei; vor
+ ELSE out (piep)
+ FI.
+ kopiere landschaft:
+ TEXT VAR kopie;
+ IF NOT not empty (alle landschaften)
+ THEN IF ist hamster
+ THEN boxinfo (fenster, anwendungstext (196), 5, maxint)
+ ELSE boxinfo (fenster, anwendungstext (197), 5, maxint)
+ FI
+ ELSE lasse original auswaehlen
+ FI.
+ lasse original auswaehlen:
+
+ IF ist hamster
+ THEN kopie := boxone (fenster, alle landschaften,
+ anwendungstext (23), anwendungstext (24),
+ FALSE)
+ ELSE kopie := boxone (fenster, alle landschaften,
+ anwendungstext (25), anwendungstext (26),
+ FALSE)
+ FI;
+ cursor on; hole landschaft (kopie).
+ alle landschaften:
+ ohne praefix (infix namen (ALL myself, praefix, flaechentype), praefix).
+
+ erfrage koernerzahl:
+ TEXT VAR eingabe; BOOL VAR ist ok; INT VAR zahl;
+ cursor (1,23); 79 TIMESOUT waagerecht;
+ REP
+ ist ok := TRUE;
+ IF ist hamster
+ THEN eingabe := boxanswer (fenster, anwendungstext (43),
+ text (hamster.koerner),
+ 5, a, b, c, d)
+ ELSE eingabe := boxanswer (fenster, anwendungstext (44),
+ text (hamster.koerner),
+
+ 5, a, b, c, d)
+ FI;
+ disable stop;
+ IF eingabe = "" THEN eingabe := "0" FI;
+ zahl := int (eingabe);
+ IF zahl < 0 OR zahl > maxint THEN ist ok := FALSE FI;
+ IF is error THEN ist ok := FALSE; clear error FI;
+ enable stop;
+ UNTIL last conversion ok AND ist ok PER;
+ cursor on;
+ hamster.koerner := zahl.
+ informiere:
+ cursor (1,1);
+ IF ist hamster
+ THEN out (anwendungstext (27))
+
+ ELSE out (anwendungstext (28))
+ FI
+END PROC modifiziere landschaft;
+PROC lauf (TEXT CONST dateiname):
+ initialize hamstersystem;
+ IF NOT exists (dateiname)
+ THEN errorstop (anwendungstext (16) + dateiname + anwendungstext (17))
+ FI;
+ hamstermodus;
+ disable stop;
+ run (dateiname);
+ kommandomodus;
+ cursor (1, 24);
+ IF is error
+ THEN IF length (errormessage) > 1
+ THEN sage (errormessage); pause;
+ FI
+ ELSE sage (anwendungstext (29)); pause; konserviere landschaft
+
+ FI;
+ clear error;
+ enable stop
+END PROC lauf;
+PROC lauf:
+ lauf (last param)
+END PROC lauf;
+PROC konserviere landschaft:
+ TEXT VAR neuer landschaftsname;
+ IF ist hamster
+ THEN stelle landschaftsfrage
+ ELSE stelle arbeitsfeldfrage
+ FI; cursor on.
+ stelle landschaftsfrage:
+ IF boxyes (fenster, anwendungstext (45), 5)
+ THEN bewahre landschaft auf
+ FI.
+ stelle arbeitsfeldfrage:
+ IF boxyes (fenster, anwendungstext (46), 5)
+ THEN bewahre landschaft auf
+
+ FI.
+ bewahre landschaft auf:
+ neuer landschaftsname := archivlandschaftsname + ".x";
+ lege landschaft ab (neuer landschaftsname);
+ gib hinweis auf neuen namen.
+ gib hinweis auf neuen namen:
+ IF ist hamster
+ THEN boxinfo (fenster, anwendungstext (30)
+ + inv (neuer landschaftsname), 5, maxint, a, b, c, d)
+ ELSE boxinfo (fenster, anwendungstext (31)
+ + inv (neuer landschaftsname), 5, maxint, a, b, c, d)
+ FI
+END PROC konserviere landschaft;
+
+PROC hamsterinter (TEXT CONST landschaftsname):
+ initialize hamstersystem;
+ sei ein hamster;
+ steuere interaktiv (landschaftsname);
+ cursor on
+END PROC hamsterinter;
+PROC hamsterinter:
+ initialize hamstersystem;
+ hamsterinter (erfragter landschaftsname (anwendungstext (39)))
+END PROC hamsterinter;
+PROC roboterinter (TEXT CONST landschaftsname):
+ initialize hamstersystem;
+ sei ein roboter;
+ steuere interaktiv (landschaftsname);
+ cursor on
+END PROC roboterinter;
+PROC roboterinter:
+
+ initialize hamstersystem;
+ roboterinter (erfragter landschaftsname (anwendungstext (40)))
+END PROC roboterinter;
+PROC steuere interaktiv (TEXT CONST landschaftsname):
+ forget (protokollname, quiet);
+ protokoll := sequential file (output, protokollname);
+ intermodus;
+ landschaft (landschaftsname);
+ TEXT VAR befehl :: niltext, letzter befehl :: niltext;
+ REP
+ arbeiten
+ PER.
+ arbeiten:
+ intermodus;
+ hole befehl;
+ fuehre befehl aus.
+ hole befehl:
+ TEXT VAR befehlszeichen;
+
+ TEXT CONST befehlskette :: "vlngpeVLNGPE";
+ INT VAR befehlsposition;
+ zeige (hamsterform);
+ cursor (1,24);
+ IF ist hamster
+ THEN out (cleol + anwendungstext (32) + letzter befehl)
+ ELSE out (cleol + anwendungstext (33) + letzter befehl)
+ FI;
+ cursor(24,24);
+ inchar (befehlszeichen);
+ befehlsposition := pos(befehlskette,befehlszeichen);
+ IF befehlsposition = 0
+ THEN out(piep);
+ LEAVE arbeiten
+ FI;
+ SELECT befehlsposition OF
+
+ CASE 1, 7: befehl := "vor";
+ out("vor");
+ letzter befehl := "vor"
+ CASE 2, 8: befehl := "links um";
+ out("links um");
+ letzter befehl := "links um"
+ CASE 3, 9: befehl := "nimm";
+ out("nimm");
+ letzter befehl := "nimm"
+ CASE 4,10: befehl := "gib";
+ out("gib");
+ letzter befehl := "gib"
+
+ CASE 5,11: out("protokoll");
+ letzter befehl := "protokoll";
+ FILE VAR p :: sequential file (modify,protokollname);
+ headline(p, protokollname + " (Verlassen: <ESC><q>)");
+ cursor on; show(p); cursor off;
+ zeige landschaft; befehl := "";
+ output(protokoll);
+ LEAVE arbeiten
+ CASE 6,12: out("ende"); kommandomodus; befehl := "";
+ LEAVE steuere interaktiv
+
+ END SELECT.
+ hamsterform:
+ erscheinungsform SUB hamster.form.
+ fuehre befehl aus:
+ BOOL VAR korrekt;
+ disable stop;
+ do (befehl);
+ cursor (1,24);
+ korrekt := NOT is error;
+ IF is error
+ THEN IF errormessage > ""
+ THEN out (inv (text (errormessage, 65)) + piep);
+ pause(30);
+ FI;
+ clear error
+ FI;
+ IF korrekt AND befehl <> ""
+ THEN protokolliere (befehl)
+ FI;
+ enable stop;
+
+END PROC steuere interaktiv;
+PROC protokolliere (TEXT CONST befehl):
+ putline (protokoll, befehl + ";")
+END PROC protokolliere;
+PROC drucke landschaft (TEXT CONST landschaftsname):
+ initialize hamstersystem;
+ ROW max y TEXT VAR drucklandschaft;
+ BOUND LANDSCHAFT VAR al;
+ INT VAR i, hamsterx, hamstery;
+ TEXT VAR hamsterzeichen;
+ landschaftsdatei holen;
+ drucklandschaft erzeugen;
+ hamster in drucklandschaft einsetzen;
+ druckdatei erzeugen;
+ disable stop;
+ TEXT VAR datname := std;
+
+ do ("print (""druckdatei"")");
+ IF is error
+ THEN menuinfo (inv (errormessage));
+ clear error;
+ FI;
+ last param (datname);
+ enable stop;
+ druckdatei loeschen;
+ cursor on.
+ landschaftsdatei holen:
+ IF exists (praefix + landschaftsname) AND
+ (type (old (praefix + landschaftsname)) = flaechentype)
+ THEN hole landschaft;
+ ELSE LEAVE drucke landschaft
+ FI.
+ hole landschaft:
+ al := old (praefix + landschaftsname);
+ hamsterx := al.xpos;
+
+ hamstery := al.ypos;
+ hamsterzeichen := erscheinungsform SUB al.blickrichtung.
+ drucklandschaft erzeugen:
+ TEXT VAR zeile; INT VAR x;
+ FOR i FROM 1 UPTO max y REP
+ zeile := "";
+ FOR x FROM 1 UPTO maxx REP
+ zeile erzeugen
+ PER;
+ drucklandschaft[i] := zeile
+ PER.
+ zeile erzeugen:
+ INT CONST zeichen :: al.flaeche [x] [i];
+ IF zeichen = besetzt THEN zeile CAT hinderniszeichen
+ ELIF zeichen = frei THEN zeile CAT " ."
+
+ ELSE zeile CAT " o"
+ FI.
+ hamster in drucklandschaft einsetzen:
+ change (drucklandschaft [hamstery], hamsterx*2-1, hamsterx*2-1,
+ hamsterzeichen).
+ druckdatei erzeugen:
+ FILE VAR p::sequential file(output, "druckdatei");
+ INT VAR blankzahl;
+ line(p);
+ putline(p,"#type (""" + schrifttyp + """)#");
+ putline(p,"#start(" + text(xstart) + "," + text(ystart) + ")#");
+ putline(p,"#limit(20.8)#");
+ blankzahl := ( 80 - (8 + length (landschaftsname))) DIV 2;
+
+ putline(p, blankzahl * " " + praefix + landschaftsname + " ");
+ putline(p, "  ");
+ FOR i FROM 1 UPTO maxy REP
+ putline(p, drucklandschaft[i] + " ")
+ PER.
+ druckdatei loeschen:
+ forget("druckdatei", quiet)
+END PROC drucke landschaft;
+PROC drucke landschaft:
+ initialize hamstersystem;
+ IF ist hamster
+ THEN drucke landschaft (erfragter landschaftsname (anwendungstext (36)))
+ ELSE drucke landschaft (erfragter landschaftsname (anwendungstext (37)))
+ FI;
+ cursor on
+
+END PROC drucke landschaft;
+PROC druckereinstellung fuer flaechenausdruck:
+ initialize hamstersystem;
+ page;
+ IF ist hamster
+ THEN putline (center (invers (anwendungstext (71))))
+ ELSE putline (center (invers (anwendungstext (72))))
+ FI;
+ line (3);
+ put (anwendungstext (73));
+ editget (schrifttyp);
+ line (2);
+ schrifttyp := compress (schrifttyp);
+ putline (anwendungstext (74));
+ putline (anwendungstext (75)); line (2);
+ putline (anwendungstext (76) + text (xstart) + "," + text (ystart) +
+
+ anwendungstext (77)); line;
+ put (anwendungstext (78)); get (xstart); line;
+ put (anwendungstext (79)); get (ystart); line (2);
+ IF yes (anwendungstext (80) + hinderniszeichen + anwendungstext (81))
+ THEN line;
+ put (anwendungstext (82)); inchar (hinderniszeichen); line (2);
+ hinderniszeichen CAT hinderniszeichen;
+ IF hinderniszeichen = "##"
+ THEN hinderniszeichen := "\#\#"
+ FI
+ FI;
+ line;
+ put (anwendungstext (83))
+END PROC druckereinstellung fuer flaechenausdruck;
+
+PROC hamster druckerstart einstellen (REAL CONST xpos, ypos):
+ xstart := xpos; ystart := ypos
+END PROC hamster druckerstart einstellen;
+REAL PROC hamster drucker xstart:
+ xstart
+END PROC hamster drucker xstart;
+REAL PROC hamster drucker ystart:
+ ystart
+END PROC hamster drucker ystart;
+PROC hamster landschaftsschrifttyp einstellen (TEXT CONST typ):
+ schrifttyp := typ
+END PROC hamster landschaftsschrifttyp einstellen;
+TEXT PROC hamster landschaftsschrifttyp:
+ schrifttyp
+END PROC hamster landschaftsschrifttyp;
+
+PROC drucke arbeitsfeld (TEXT CONST arbeitsfeldname):
+ drucke landschaft (arbeitsfeldname)
+END PROC drucke arbeitsfeld;
+PROC drucke arbeitsfeld:
+ drucke landschaft
+END PROC drucke arbeitsfeld;
+TEXT PROC taste:
+ eingabezeichen
+END PROC taste;
+TEXT PROC landschaftsauskunftstext:
+ initialize hamstersystem;
+ IF ist hamster
+ THEN anwendungstext (52)
+ ELSE anwendungstext (53)
+ FI
+END PROC landschaftsauskunftstext;
+TEXT PROC laufauskunftstext:
+ initialize hamstersystem;
+
+ anwendungstext (51)
+END PROC laufauskunftstext;
+TEXT PROC befehlsauskunftstext:
+ initialize hamstersystem;
+ IF ist hamster
+ THEN anwendungstext (54)
+ ELSE anwendungstext (55)
+ FI
+END PROC befehlsauskunftstext;
+TEXT PROC testauskunftstext 1:
+ initialize hamstersystem;
+ IF befehlssatz erweitert
+ THEN langer testauskunftstext
+ ELSE kurzer testauskunftstext
+ FI.
+ kurzer testauskunftstext:
+ IF ist hamster
+ THEN anwendungstext (56)
+ ELSE anwendungstext (57)
+
+ FI.
+ langer testauskunftstext:
+ IF ist hamster
+ THEN anwendungstext (58)
+ ELSE anwendungstext (60)
+ FI.
+END PROC testauskunftstext 1;
+TEXT PROC testauskunftstext 2:
+ initialize hamstersystem;
+ IF befehlssatz erweitert
+ THEN eintragung
+ ELSE niltext
+ FI.
+ eintragung:
+ IF ist hamster
+ THEN anwendungstext (59)
+ ELSE anwendungstext (61)
+ FI
+END PROC testauskunftstext 2;
+PROC befehlssatz erweitern (BOOL CONST status):
+ befehlssatz erweitert := status
+
+END PROC befehlssatz erweitern;
+BOOL PROC befehlssatz ist erweitert:
+ befehlssatz erweitert
+END PROC befehlssatz ist erweitert;
+END PACKET ls herbert und robbi 1;
+