path: root/hamster/ls-Herbert und Robbi 1

(* 
        
          ********************************************************* 
          ********************************************************* 
          **                                                     ** 
          **                ls-Herbert und Robbi 1               ** 
          **                                                     ** 
          **                     Version 1.1                     ** 
          **                                                     ** 
          **                  (Stand: 30.03.88)                  ** 
          **                                                     ** 
          **                                                     ** 
          **         Autor: Wolfgang Weber, Bielefeld            ** 
          **                                                     ** 
          **                                                     ** 
          ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** 
          **                                                     ** 
          ** Copyright (C) 1988 ERGOS GmbH, Siegburg             ** 
          **                                                     ** 
          ********************************************************* 
          ********************************************************* 
 
                                                                           *) 
 
PACKET ls herbert und robbi 1  DEFINES
       sei ein hamster, ist hamster,
       sei ein roboter, ist roboter,
       landschaft, arbeitsfeld,
       vor, links um, nimm, gib,
       korn da, werkstueck da,
       backen leer, behaelter leer,
       vorn frei, lauf,
       hamsterinter, roboterinter,
       geschwindigkeit, taste,
       befehlssatz erweitern,
       befehlssatz ist erweitert,
       drucke landschaft,
       hamster druckerstart einstellen,
       hamster drucker xstart,

       hamster drucker ystart,
       hamster landschaftsschrifttyp einstellen,
       hamster landschaftsschrifttyp,
       druckereinstellung fuer flaechenausdruck,
       landschaftsauskunftstext,
       testauskunftstext 1, testauskunftstext 2,
       befehlsauskunftstext, laufauskunftstext,
       kommandomodus, hamstermodus,
       zeige landschaft, lege landschaft ab:
TYPE LOCATION          = STRUCT (INT x, y);
LET  menukarte         =  "ls-MENUKARTE:Herbert und Robbi",
     richtung          =  ""3""8""10""2"",

     erscheinungsform  =           "A<V>",
     praefix           =       "Flaeche:",
     flaechentype      =             1007,
     neutral           =                0,
     erzeuge           =                1,
     hamsterlauf       =                2,
     interaktiv        =                3,
     kommandostufe     =               99,
     west              =            ""8"",
     ost               =            ""2"",
     cleol             =            ""5"",
     piep              =            ""7"",

     mark ein          =           ""15"",
     mark aus          =           ""14"",
     escape            =           ""27"",
     blank             =              " ",
     niltext           =               "",
     hindernis         =              "#",
     korn              =              "o",
     hinderniskachel   =             "##",
     blankkachel       =             " .",
     kornkachel        =             " o",
     protokollname     =      "PROTOKOLL";
LET    max x           =               40,

       max y           =               23;
LET    FLAECHE         =  ROW max x ROW max y INT;
LET    LANDSCHAFT      =  STRUCT (INT xpos, ypos, blickrichtung,
                                      anzahl koerner, FLAECHE flaeche);
LET    HAMSTER         =  STRUCT (LOCATION stelle, INT koerner, form);
BOUND LANDSCHAFT VAR aktuelle landschaft;
FLAECHE VAR land;
HAMSTER VAR hamster;
FILE VAR protokoll;
INT  CONST besetzt                 ::             -1,
           frei                    ::              0;

TEXT CONST kornsymbole             ::
  "1234567890abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ";
INT CONST maxkornzahl              ::   LENGTH kornsymbole;
BOOL VAR   hamster eingestellt     ::           TRUE,
           befehlssatz erweitert   ::          FALSE;
TEXT VAR   eingabezeichen          ::        niltext,
           archivlandschaftsname   ::        niltext,
           hinderniszeichen        ::           "\#\#",
           schrifttyp              ::        niltext;
INT  VAR   verzoegerungsfaktor     ::              5,

           modus                   ::  kommandostufe,
           a, b, c, d;
REAL VAR   xstart                  ::            0.0,
           ystart                  ::            0.0;
WINDOW VAR fenster                 ::  window (1, 1, 79, 24);
INITFLAG VAR in this task          ::  FALSE;
OP := (LOCATION VAR l, LOCATION CONST r):
   l.x := r.x; l.y := r.y
END OP :=;
PROC initialize hamstersystem:
  IF NOT initialized (in this task)
     THEN install menu (menukarte);
  FI
END PROC initialize hamstersystem;

PROC sei ein hamster:
  hamster eingestellt := TRUE
END PROC sei ein hamster;
BOOL PROC ist hamster:
   hamster eingestellt
END PROC ist hamster;
PROC sei ein roboter:
  hamster eingestellt := FALSE
END PROC sei ein roboter;
BOOL PROC ist roboter:
   NOT hamster eingestellt
END PROC ist roboter;
PROC hole landschaft (TEXT CONST name):
   aktuelle landschaft := old (praefix + name);
   land                := aktuelle landschaft.flaeche;
   hamster.form        := aktuelle landschaft.blickrichtung;

   hamster.stelle.x    := aktuelle landschaft.xpos;
   hamster.stelle.y    := aktuelle landschaft.ypos;
   hamster.koerner     := aktuelle landschaft.anzahl koerner
END PROC hole landschaft;
PROC lege landschaft ab (TEXT CONST name):
   IF exists (praefix + name)
      THEN forget (praefix + name, quiet)
   FI;
   aktuelle landschaft                := new (praefix + name);
   aktuelle landschaft.flaeche        := land;
   aktuelle landschaft.blickrichtung  := hamster.form;
   aktuelle landschaft.xpos           := hamster.stelle.x;

   aktuelle landschaft.ypos           := hamster.stelle.y;
   aktuelle landschaft.anzahl koerner := hamster.koerner;
   type( old(praefix + name), flaechentype)
END PROC lege landschaft ab;
PROC hamstermodus:
   modus := neutral
END PROC hamstermodus;
PROC kommandomodus:
   modus := kommandostufe
END PROC kommandomodus;
PROC erzeugemodus:
   modus := erzeuge
END PROC erzeugemodus;
PROC intermodus:
   modus := interaktiv
END PROC intermodus;
PROC laufmodus:
   modus := hamsterlauf

END PROC laufmodus;
BOOL PROC vorn frei:
  kontrolliere modus;
  LOCATION VAR hier :: hamster.stelle;
  SELECT hamster.form OF
    CASE 1: IF hamster.stelle.y < 2       THEN protestiere FI;
            hier.y DECR 1
    CASE 2: IF hamster.stelle.x < 2       THEN protestiere FI;
            hier.x DECR 1
    CASE 3: IF hamster.stelle.y >= max y  THEN protestiere FI;
            hier.y INCR 1
    CASE 4: IF hamster.stelle.x >= max x  THEN protestiere FI;
            hier.x INCR 1
    OTHERWISE modus := kommandostufe;

              IF ist hamster
                 THEN errorstop(nachricht( 7))
                 ELSE errorstop(nachricht(14))
              FI
  END SELECT;
  IF modus = erzeuge
     THEN TRUE
     ELSE land[hier.x] [hier.y] <> besetzt
  FI
END PROC vorn frei;
BOOL PROC korn da:
  kontrolliere modus;
  kornzahl > 0
END PROC korn da;
INT PROC kornzahl:
  land [hamster.stelle.x] [hamster.stelle.y]
END PROC kornzahl;
BOOL PROC werkstueck da:
  korn da
END PROC werkstueck da;
BOOL PROC backen leer:

  kontrolliere modus;
  hamster.koerner <= 0 AND (modus = hamsterlauf OR modus = interaktiv)
END PROC backen leer;
BOOL PROC behaelter leer:
  backen leer
END PROC behaelter leer;
PROC protestiere:
  IF modus = erzeuge
     THEN out(piep); eins zurueck
     ELSE verzoegere 10 mal; zeige("X"); verzoegere 10 mal;
          kommandomodus;
          IF ist hamster
             THEN errorstop(nachricht( 6))
             ELSE errorstop(nachricht(13))
          FI;
  FI.
  eins zurueck:

    SELECT hamster.form OF
      CASE 1:   hamster.stelle.y INCR 1
      CASE 2:   hamster.stelle.x INCR 1
      CASE 3:   hamster.stelle.y DECR 1
      CASE 4:   hamster.stelle.x DECR 1
      OTHERWISE kommandomodus;
                IF ist hamster
                   THEN errorstop(nachricht( 7))
                   ELSE errorstop(nachricht(14))
                FI;
     END SELECT.
  verzoegere 10 mal:
    INT VAR j;
    FOR j FROM 1 UPTO 10 REP
      verzoegere
    PER
END PROC protestiere;

PROC verzoegere:
  IF modus <> hamsterlauf
     THEN LEAVE verzoegere
  FI;
  eingabezeichen := incharety (verzoegerungsfaktor);
  IF   eingabezeichen = escape
       THEN kommandomodus;
            IF ist hamster
               THEN errorstop(nachricht( 4))
               ELSE errorstop(nachricht(11))
            FI
  ELIF eingabezeichen = "-" THEN verlangsame
  ELIF eingabezeichen = "+" THEN beschleunige
  ELIF eingabezeichen = "?" THEN boxinfo (fenster, laufauskunftstext,
                                                   5, maxint, a, b, c, d);

                                 cursor on; zeige landschaft
  ELIF pos ("0123456789", eingabezeichen) > 0
        THEN geschwindigkeit (int (eingabezeichen))
  FI.
  verlangsame:
    IF   verzoegerungsfaktor > 31 THEN  (* lass es dabei *)
    ELIF verzoegerungsfaktor < 1
         THEN verzoegerungsfaktor INCR 1
         ELSE verzoegerungsfaktor INCR verzoegerungsfaktor
    FI.
  beschleunige:
    IF verzoegerungsfaktor < 1
       THEN verzoegerungsfaktor := -1
       ELSE verzoegerungsfaktor := verzoegerungsfaktor DIV 2

    FI
END PROC verzoegere;
PROC geschwindigkeit (INT CONST faktor):
  SELECT faktor OF
    CASE 0 :  verzoegerungsfaktor := 20000;
    CASE 1 :  verzoegerungsfaktor :=    50;
    CASE 2 :  verzoegerungsfaktor :=    20;
    CASE 3 :  verzoegerungsfaktor :=    10;
    CASE 4 :  verzoegerungsfaktor :=     8;
    CASE 5 :  verzoegerungsfaktor :=     5;
    CASE 6 :  verzoegerungsfaktor :=     2;
    CASE 7 :  verzoegerungsfaktor :=     1;
    CASE 8 :  verzoegerungsfaktor :=     0;
    CASE 9 :  verzoegerungsfaktor :=    -1;

    OTHERWISE (*belasse es dabei*)
  END SELECT
END PROC geschwindigkeit;
PROC vor:
  kontrolliere modus;
  IF vorn frei
     THEN zeige(kachel);
          bilde neue hamsterkoordinaten;
          zeige(erscheinungsform SUB hamster.form);
          verzoegere
     ELSE modus := kommandostufe;
          zeige("X");
          IF ist hamster
             THEN errorstop(nachricht(1))
             ELSE errorstop(nachricht(8))
          FI
  FI.
  kachel:
    INT CONST z :: land [hamster.stelle.x] [hamster.stelle.y];

    IF   z = besetzt THEN hinderniskachel
    ELIF z = frei    THEN blankkachel
                     ELSE kornkachel
    FI.
  bilde neue hamsterkoordinaten:
    SELECT hamster.form OF
      CASE 1    :hamster.stelle.y DECR 1
      CASE 2    :hamster.stelle.x DECR 1
      CASE 3    :hamster.stelle.y INCR 1
      CASE 4    :hamster.stelle.x INCR 1
      OTHERWISE  modus:=kommandostufe;
                 IF ist hamster
                    THEN errorstop(nachricht( 7))
                    ELSE errorstop(nachricht(14))

                 FI
    END SELECT.
END PROC vor;
PROC nimm:
  kontrolliere modus;
  IF korn da
     THEN variiere kornzahl (-1);
          IF kornzahl < 1 THEN zeige (ost + blank) FI
     ELSE modus := kommandostufe;
          zeige("X");
          IF ist hamster
             THEN errorstop(nachricht(2))
             ELSE errorstop(nachricht(9))
          FI
  FI;
  verzoegere
END PROC nimm;
PROC gib:
  kontrolliere modus;
  IF backen leer
     THEN modus := kommandostufe;
          zeige ("X");

          IF ist hamster
             THEN errorstop(nachricht( 3))
             ELSE errorstop(nachricht(10))
          FI
     ELSE variiere kornzahl (+1);
          zeige(ost + korn)
  FI;
  verzoegere
END PROC gib;
PROC links um:
  kontrolliere modus;
  hamster.form := hamster.form MOD 4 + 1;
  (* da hamster.form der Werte 1,2,3,4 faehig ist und linksdreht *)
  zeige (subjekt);
  verzoegere.
  subjekt:
    erscheinungsform SUB hamster.form.
END PROC links um;
PROC variiere kornzahl (INT CONST delta):

  IF delta * delta <> 1
     THEN LEAVE variiere kornzahl
  FI;   (* als delta kommen nur +1 und -1 vor *)
  INT VAR k;
  IF kornzahl = -1 AND delta = 1
     THEN k := 1
     ELSE k := kornzahl + delta
  FI;
  IF k <= 0
     THEN land [hamster.stelle.x] [hamster.stelle.y] := frei
     ELSE land [hamster.stelle.x] [hamster.stelle.y] := min (k,maxkornzahl)
  FI;
  IF modus = hamsterlauf OR modus = interaktiv
     THEN hamster.koerner DECR delta
  FI
END PROC variiere kornzahl;
PROC kontrolliere modus:

  initialize hamstersystem;
  SELECT modus OF
    CASE neutral    : erzeugemodus;
                      landschaft;
                      laufmodus
    CASE erzeuge,
         interaktiv,
         hamsterlauf: (* nichts *)
    OTHERWISE         kommandomodus;
                      line;
                      IF ist hamster
                         THEN sage(anwendungstext (21));pause(20);
                              errorstop(nachricht( 5))
                         ELSE sage(anwendungstext (22));pause(20);

                              errorstop(nachricht(12))
                      FI
  END SELECT
END PROC kontrolliere modus;
PROC zeige (TEXT CONST was):
   cursor (2 * hamster.stelle.x - 1, hamster.stelle.y);
   IF hamster.stelle.x >= max x  AND hamster.stelle.y > max y
      THEN out ((was SUB 1)); out(west)
      ELSE out(was); (LENGTH was) TIMESOUT west
   FI.
END PROC zeige;
PROC sage (TEXT CONST aussage):
   cursor(1,24); out(aussage + cleol)
END PROC sage;
TEXT PROC nachricht (INT CONST nummer):

   inv (text (anwendungstext (nummer), 65)) + piep
END PROC nachricht;
TEXT PROC inv (TEXT CONST text):
  TEXT VAR aus :: mark ein + text + blank + mark aus;
  aus
END PROC inv;
PROC zeige landschaft:
  initialize hamstersystem;
  INT VAR y;
  FOR y FROM 1 UPTO max y REP
     setze zeile zusammen;
     cursor (1,y); out (zeile)
  PER;
  cursor(1,24); out(cleol);
  IF modus = interaktiv
     THEN gib befehlszeile aus
  FI;
  zeige hamster; cursor on.
  setze zeile zusammen:
    TEXT VAR zeile :: niltext;

    INT VAR x;
    FOR x FROM 1 UPTO max x REP
       zeile CAT kachel
    PER.
  kachel:
    INT CONST z :: land [x] [y];
    IF   z = besetzt THEN hinderniskachel
    ELIF z = frei    THEN blankkachel
                     ELSE kornkachel
    FI.
   gib befehlszeile aus:
     cursor(1,1); write(cleol); write (anwendungstext (62))
END PROC zeige landschaft;
PROC zeige hamster:
   zeige (erscheinungsform SUB hamster.form)
END PROC zeige hamster;
PROC landschaft (TEXT CONST kandidat):

  initialize hamstersystem;
  archivlandschaftsname := kandidat;
  IF   exists (praefix + kandidat)
         CAND type (old (praefix + kandidat)) = flaechentype
       THEN behandle existierende landschaft
  ELIF exists (praefix + kandidat)
       THEN forget (praefix + kandidat, quiet);
            behandle neue landschaft
  ELSE behandle neue landschaft
  FI.
  behandle existierende landschaft:
    hole landschaft (kandidat);
    SELECT modus OF
      CASE hamsterlauf,
           interaktiv,

           neutral       : zeige landschaft;
                           laufmodus
      CASE erzeuge       : modifiziere eventuell
      CASE kommandostufe : modifiziere landschaft
      OTHERWISE            errorstop (anwendungstext (15))
    END SELECT.
  behandle neue landschaft:
    SELECT modus OF
      CASE hamsterlauf,
           interaktiv,
           neutral,
           erzeuge       : erschaffe landschaft;
                           modifiziere landschaft;
                           zeige landschaft;

                           laufmodus
      CASE kommandostufe : erschaffe landschaft;
                           modifiziere landschaft;
      OTHERWISE            errorstop (anwendungstext (15))
    END SELECT.
  modifiziere eventuell:
    IF ist hamster
       THEN IF boxyes (fenster, anwendungstext (41), 5, a, b, c, d)
               THEN cursor on; modifiziere landschaft
            FI
       ELSE IF boxyes (fenster, anwendungstext (42), 5, a, b, c, d)
               THEN cursor on; modifiziere landschaft

            FI
    FI;
    zeige landschaft.
  erschaffe landschaft:
    INT VAR j;
    FOR j FROM 1 UPTO max y REP
      INT VAR k;
      FOR k FROM 1 UPTO max x REP
        land [k] [j] := frei
      PER
    PER;
    hamster.form     :=   4;
    hamster.stelle.x :=  20;
    hamster.stelle.y :=  12;
    hamster.koerner  :=   0.
END PROC landschaft;
PROC landschaft:
  initialize hamstersystem;
  IF ist hamster
     THEN landschaft (erfragter landschaftsname (anwendungstext (36)))

     ELSE landschaft (erfragter landschaftsname (anwendungstext (37)))
  FI
END PROC landschaft;
TEXT PROC erfragter landschaftsname (TEXT CONST satz):
  TEXT VAR landschaftsname :: archivlandschaftsname;
  REP
    page; line (3); out (satz + cleol); line (2);
    editget (landschaftsname);
    landschaftsname := compress (landschaftsname);
    IF landschaftsname = niltext
       THEN line (2); out (anwendungstext (18) + piep);
            line (2); out (anwendungstext (38)); pause
    FI

  UNTIL landschaftsname <> niltext PER;
  landschaftsname
END PROC erfragter landschaftsname;
PROC arbeitsfeld (TEXT CONST kandidat):
  landschaft (kandidat)
END PROC arbeitsfeld;
PROC arbeitsfeld:
  landschaft
END PROC arbeitsfeld;
PROC modifiziere landschaft:
  INT CONST modalibi :: modus;
  erzeugemodus;
  zeige landschaft;
  informiere;
  zeige hamster;
  nimm ein eingabezeichen;
  WHILE nicht endewunsch REP
    erfuelle fortschreibungswunsch;
    nimm ein eingabezeichen
  PER;

  erfrage koernerzahl;
  lege landschaft ab (archivlandschaftsname);
  modus := modalibi.
  nimm ein eingabezeichen:
    inchar (eingabezeichen).
  nicht endewunsch:
    pos ("hH", eingabezeichen) = 0.
  erfuelle fortschreibungswunsch:
    INT CONST r :: pos (richtung, eingabezeichen)
    IF   r > 0
         THEN IF hamster.form = r
                 THEN vor
                 ELSE hamster.form := r;
                      zeige hamster
              FI
    ELIF eingabezeichen = "?" THEN boxinfo (fenster, landschaftsauskunftstext,

                                                     5, maxint, a, b, c, d);
                                   cursor on; zeige landschaft; informiere
    ELIF eingabezeichen = "k" THEN kopiere landschaft;
                                   zeige landschaft; informiere
    ELIF eingabezeichen = "g" THEN gib
    ELIF eingabezeichen = "n" THEN IF korn da THEN nimm ELSE out (piep) FI
    ELIF eingabezeichen = "z" THEN zeige (text (kornzahl, 2))
    ELIF eingabezeichen = hindernis
         THEN  land [hamster.stelle.x] [hamster.stelle.y] := besetzt; vor

    ELIF eingabezeichen = blank
         THEN  land [hamster.stelle.x] [hamster.stelle.y] := frei;    vor
    ELSE out (piep)
    FI.
    kopiere landschaft:
      TEXT VAR kopie;
      IF NOT not empty (alle landschaften)
         THEN IF ist hamster
                 THEN boxinfo (fenster, anwendungstext (196), 5, maxint)
                 ELSE boxinfo (fenster, anwendungstext (197), 5, maxint)
              FI
         ELSE lasse original auswaehlen
      FI.
    lasse original auswaehlen:

      IF ist hamster
         THEN kopie := boxone (fenster, alle landschaften,
                               anwendungstext (23), anwendungstext (24),
                               FALSE)
         ELSE kopie := boxone (fenster, alle landschaften,
                               anwendungstext (25), anwendungstext (26),
                               FALSE)
      FI;
      cursor on; hole landschaft (kopie).
    alle landschaften:
      ohne praefix (infix namen (ALL myself, praefix, flaechentype), praefix).

    erfrage koernerzahl:
      TEXT VAR eingabe; BOOL VAR ist ok; INT VAR zahl;
      cursor (1,23); 79 TIMESOUT waagerecht;
      REP
        ist ok := TRUE;
        IF ist hamster
           THEN eingabe := boxanswer (fenster, anwendungstext (43),
                                               text (hamster.koerner),
                                               5, a, b, c, d)
           ELSE eingabe := boxanswer (fenster, anwendungstext (44),
                                               text (hamster.koerner),

                                               5, a, b, c, d)
        FI;
        disable stop;
        IF eingabe = "" THEN eingabe := "0" FI;
        zahl := int (eingabe);
        IF zahl < 0 OR zahl > maxint THEN ist ok := FALSE FI;
        IF is error THEN ist ok := FALSE; clear error FI;
        enable stop;
      UNTIL last conversion ok AND ist ok PER;
      cursor on;
      hamster.koerner := zahl.
    informiere:
      cursor (1,1);
      IF ist hamster
         THEN out (anwendungstext (27))

         ELSE out (anwendungstext (28))
      FI
END PROC modifiziere landschaft;
PROC lauf (TEXT CONST dateiname):
  initialize hamstersystem;
  IF NOT exists (dateiname)
     THEN errorstop (anwendungstext (16) + dateiname + anwendungstext (17))
  FI;
  hamstermodus;
  disable stop;
  run (dateiname);
  kommandomodus;
  cursor (1, 24);
  IF is error
     THEN IF length (errormessage) > 1
             THEN sage (errormessage); pause;
          FI
     ELSE sage (anwendungstext (29)); pause; konserviere landschaft

  FI;
  clear error;
  enable stop
END PROC lauf;
PROC lauf:
  lauf (last param)
END PROC lauf;
PROC konserviere landschaft:
  TEXT VAR neuer landschaftsname;
  IF ist hamster
     THEN stelle landschaftsfrage
     ELSE stelle arbeitsfeldfrage
  FI; cursor on.
  stelle landschaftsfrage:
    IF boxyes (fenster, anwendungstext (45), 5)
       THEN bewahre landschaft auf
    FI.
  stelle arbeitsfeldfrage:
    IF boxyes (fenster, anwendungstext (46), 5)
       THEN bewahre landschaft auf

    FI.
  bewahre landschaft auf:
    neuer landschaftsname := archivlandschaftsname + ".x";
    lege landschaft ab (neuer landschaftsname);
    gib hinweis auf neuen namen.
  gib hinweis auf neuen namen:
    IF ist hamster
       THEN boxinfo (fenster, anwendungstext (30)
                     + inv (neuer landschaftsname), 5, maxint, a, b, c, d)
       ELSE boxinfo (fenster, anwendungstext (31)
                     + inv (neuer landschaftsname), 5, maxint, a, b, c, d)
    FI
END PROC konserviere landschaft;

PROC hamsterinter (TEXT CONST landschaftsname):
  initialize hamstersystem;
  sei ein hamster;
  steuere interaktiv (landschaftsname);
  cursor on
END PROC hamsterinter;
PROC hamsterinter:
  initialize hamstersystem;
  hamsterinter (erfragter landschaftsname (anwendungstext (39)))
END PROC hamsterinter;
PROC roboterinter (TEXT CONST landschaftsname):
  initialize hamstersystem;
  sei ein roboter;
  steuere interaktiv (landschaftsname);
  cursor on
END PROC roboterinter;
PROC roboterinter:

  initialize hamstersystem;
  roboterinter (erfragter landschaftsname (anwendungstext (40)))
END PROC roboterinter;
PROC steuere interaktiv (TEXT CONST landschaftsname):
  forget (protokollname, quiet);
  protokoll := sequential file (output, protokollname);
  intermodus;
  landschaft (landschaftsname);
  TEXT VAR befehl :: niltext, letzter befehl :: niltext;
  REP
    arbeiten
  PER.
  arbeiten:
    intermodus;
    hole befehl;
    fuehre befehl aus.
  hole befehl:
    TEXT VAR befehlszeichen;

    TEXT CONST befehlskette :: "vlngpeVLNGPE";
    INT VAR befehlsposition;
    zeige (hamsterform);
    cursor (1,24);
    IF ist hamster
       THEN out (cleol + anwendungstext (32) + letzter befehl)
       ELSE out (cleol + anwendungstext (33) + letzter befehl)
    FI;
    cursor(24,24);
    inchar (befehlszeichen);
    befehlsposition := pos(befehlskette,befehlszeichen);
    IF befehlsposition = 0
       THEN out(piep);
            LEAVE arbeiten
    FI;
    SELECT befehlsposition OF

      CASE 1, 7: befehl := "vor";
                           out("vor");
                           letzter befehl := "vor"
      CASE 2, 8: befehl := "links um";
                           out("links um");
                           letzter befehl := "links um"
      CASE 3, 9: befehl := "nimm";
                           out("nimm");
                           letzter befehl := "nimm"
      CASE 4,10: befehl := "gib";
                           out("gib");
                           letzter befehl := "gib"

      CASE 5,11: out("protokoll");
                 letzter befehl := "protokoll";
                 FILE VAR p :: sequential file (modify,protokollname);
                 headline(p, protokollname + "  (Verlassen: <ESC><q>)");
                 cursor on; show(p); cursor off;
                 zeige landschaft; befehl := "";
                 output(protokoll);
                 LEAVE arbeiten
      CASE 6,12: out("ende"); kommandomodus; befehl := "";
                 LEAVE steuere interaktiv

    END SELECT.
   hamsterform:
     erscheinungsform SUB hamster.form.
   fuehre befehl aus:
     BOOL VAR korrekt;
     disable stop;
     do (befehl);
     cursor (1,24);
     korrekt := NOT is error;
     IF is error
        THEN IF errormessage > ""
                THEN out (inv (text (errormessage, 65)) + piep);
                     pause(30);
             FI;
             clear error
     FI;
     IF korrekt AND befehl <> ""
        THEN protokolliere (befehl)
     FI;
     enable stop;

END PROC steuere interaktiv;
PROC protokolliere (TEXT CONST befehl):
  putline (protokoll, befehl + ";")
END PROC protokolliere;
PROC drucke landschaft (TEXT CONST landschaftsname):
  initialize hamstersystem;
  ROW max y TEXT VAR drucklandschaft;
  BOUND LANDSCHAFT VAR al;
  INT VAR i, hamsterx, hamstery;
  TEXT VAR hamsterzeichen;
  landschaftsdatei holen;
  drucklandschaft erzeugen;
  hamster in drucklandschaft einsetzen;
  druckdatei erzeugen;
  disable stop;
  TEXT VAR datname := std;

  do ("print (""druckdatei"")");
  IF is error
      THEN menuinfo (inv (errormessage));
           clear error;
  FI;
  last param (datname);
  enable stop;
  druckdatei loeschen;
  cursor on.
  landschaftsdatei holen:
    IF exists (praefix + landschaftsname) AND
       (type (old (praefix + landschaftsname)) = flaechentype)
       THEN hole landschaft;
       ELSE LEAVE drucke landschaft
    FI.
  hole landschaft:
    al             := old (praefix + landschaftsname);
    hamsterx       := al.xpos;

    hamstery       := al.ypos;
    hamsterzeichen := erscheinungsform SUB al.blickrichtung.
  drucklandschaft erzeugen:
    TEXT VAR zeile; INT VAR  x;
    FOR i FROM 1 UPTO max y REP
        zeile := "";
        FOR x FROM 1 UPTO maxx REP
            zeile erzeugen
        PER;
        drucklandschaft[i] :=  zeile
    PER.
  zeile erzeugen:
    INT CONST zeichen :: al.flaeche [x] [i];
    IF   zeichen = besetzt THEN zeile CAT hinderniszeichen
    ELIF zeichen = frei    THEN zeile CAT " ."

                           ELSE zeile CAT " o"
    FI.
  hamster in drucklandschaft einsetzen:
    change (drucklandschaft [hamstery], hamsterx*2-1, hamsterx*2-1,
            hamsterzeichen).
  druckdatei erzeugen:
    FILE VAR p::sequential file(output, "druckdatei");
    INT VAR blankzahl;
    line(p);
    putline(p,"#type (""" + schrifttyp + """)#");
    putline(p,"#start(" + text(xstart) + "," + text(ystart) + ")#");
    putline(p,"#limit(20.8)#");
    blankzahl := ( 80 - (8 + length (landschaftsname))) DIV 2;

    putline(p, blankzahl * " " + praefix + landschaftsname + " ");
    putline(p, "  ");
    FOR i FROM 1 UPTO maxy REP
      putline(p, drucklandschaft[i] + " ")
    PER.
  druckdatei loeschen:
    forget("druckdatei", quiet)
END PROC drucke landschaft;
PROC drucke landschaft:
  initialize hamstersystem;
  IF ist hamster
     THEN drucke landschaft (erfragter landschaftsname (anwendungstext (36)))
     ELSE drucke landschaft (erfragter landschaftsname (anwendungstext (37)))
  FI;
  cursor on

END PROC drucke landschaft;
PROC druckereinstellung fuer flaechenausdruck:
  initialize hamstersystem;
  page;
  IF ist hamster
     THEN putline (center (invers (anwendungstext (71))))
     ELSE putline (center (invers (anwendungstext (72))))
  FI;
  line (3);
  put (anwendungstext (73));
  editget (schrifttyp);
  line (2);
  schrifttyp := compress (schrifttyp);
  putline (anwendungstext (74));
  putline (anwendungstext (75)); line (2);
  putline (anwendungstext (76) + text (xstart) + "," + text (ystart) +

           anwendungstext (77)); line;
  put (anwendungstext (78)); get (xstart); line;
  put (anwendungstext (79)); get (ystart); line (2);
  IF yes (anwendungstext (80) + hinderniszeichen + anwendungstext (81))
     THEN line;
          put (anwendungstext (82)); inchar (hinderniszeichen); line (2);
          hinderniszeichen CAT hinderniszeichen;
          IF hinderniszeichen = "##"
             THEN hinderniszeichen := "\#\#"
          FI
  FI;
  line;
  put (anwendungstext (83))
END PROC druckereinstellung fuer flaechenausdruck;

PROC hamster druckerstart einstellen (REAL CONST xpos, ypos):
  xstart := xpos; ystart := ypos
END PROC hamster druckerstart einstellen;
REAL PROC hamster drucker xstart:
  xstart
END PROC hamster drucker xstart;
REAL PROC hamster drucker ystart:
  ystart
END PROC hamster drucker ystart;
PROC hamster landschaftsschrifttyp einstellen (TEXT CONST typ):
  schrifttyp := typ
END PROC hamster landschaftsschrifttyp einstellen;
TEXT PROC hamster landschaftsschrifttyp:
  schrifttyp
END PROC hamster landschaftsschrifttyp;

PROC drucke arbeitsfeld (TEXT CONST arbeitsfeldname):
  drucke landschaft (arbeitsfeldname)
END PROC drucke arbeitsfeld;
PROC drucke arbeitsfeld:
  drucke landschaft
END PROC drucke arbeitsfeld;
TEXT PROC taste:
  eingabezeichen
END PROC taste;
TEXT PROC landschaftsauskunftstext:
  initialize hamstersystem;
  IF ist hamster
     THEN anwendungstext (52)
     ELSE anwendungstext (53)
  FI
END PROC landschaftsauskunftstext;
TEXT PROC laufauskunftstext:
  initialize hamstersystem;

  anwendungstext (51)
END PROC  laufauskunftstext;
TEXT PROC befehlsauskunftstext:
  initialize hamstersystem;
  IF ist hamster
     THEN anwendungstext (54)
     ELSE anwendungstext (55)
  FI
END PROC befehlsauskunftstext;
TEXT PROC testauskunftstext 1:
  initialize hamstersystem;
  IF befehlssatz erweitert
     THEN langer testauskunftstext
     ELSE kurzer testauskunftstext
  FI.
  kurzer testauskunftstext:
    IF ist hamster
       THEN anwendungstext (56)
       ELSE anwendungstext (57)

    FI.
  langer testauskunftstext:
    IF ist hamster
       THEN anwendungstext (58)
       ELSE anwendungstext (60)
    FI.
END PROC testauskunftstext 1;
TEXT PROC testauskunftstext 2:
  initialize hamstersystem;
  IF befehlssatz erweitert
     THEN eintragung
     ELSE niltext
  FI.
  eintragung:
    IF ist hamster
       THEN anwendungstext (59)
       ELSE anwendungstext (61)
    FI
END PROC testauskunftstext 2;
PROC befehlssatz erweitern (BOOL CONST status):
  befehlssatz erweitert := status

END PROC befehlssatz erweitern;
BOOL PROC befehlssatz ist erweitert:
  befehlssatz erweitert
END PROC befehlssatz ist erweitert;
END PACKET ls herbert und robbi 1;