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 +++++++++++++++++++++++++++++++++++++--- 1 file changed, 959 insertions(+), 59 deletions(-) (limited to 'hamster/ls-Herbert und Robbi 1') 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; + -- cgit v1.2.3