PACKET lind wurm DEFINES lindwurm:
deklaration; 
LET max = 500,zeilen = 23,spalten = 77;
 
PROC kriech :
  speicher := stelle;
  REP
   putline(""1"Punkte:"+text(punkte + bonus) + ""6""0""30"Zeit:" + zeit);
   IF punkte <> 0 
      THEN ende INCR 1;
           IF ende > max THEN ende := 1 FI;
           laenge := laenge + 1 - zaehler;
           IF laenge > max THEN laenge := 1 FI;
           wurm(ende) := speicher;
           IF zaehler = 0 AND wurm(laenge) >= basis AND wurm(laenge) < (basis+(spalten*zeilen)) 
              THEN poke(wurm(laenge),leerzeichen) 
           FI;
           IF speicher >= basis AND speicher < (basis+(spalten*zeilen)) THEN 
              poke(speicher,char1)
           FI
      ELSE IF speicher >= basis AND speicher < (basis+(spalten*zeilen)) 
              THEN poke (speicher,leerzeichen)
           FI;
   FI;
   zaehler := 0;
   speicher INCR richtung;
   IF peek(speicher) <> leerzeichen THEN nahrung oder gift FI; 
   IF speicher >= basis AND speicher < (basis+(spalten*zeilen)) THEN poke(speicher,char2) FI;
   tastaturabfrage;
   IF punkte > begrenzung THEN x := int(zeit); index := 1 FI;
   IF zeit > stopzeit THEN index := 2 FI;
  UNTIL index <> 0 PER
ENDPROC kriech;

PROC nahrung oder gift :
     IF peek(speicher) <> char 3 THEN index := 3 
       ELSE punkte INCR 10; zaehler := 1
     FI;
ENDPROC nahrung oder gift;

PROC tastaturabfrage :
    taste := incharety(9 DIV geschwindigkeit);
    feuer := taste = ""13"";
    IF feuer THEN richtung := 0
    ELIF taste = ""10"" THEN richtung INCR spalten
    ELIF taste = ""8""  THEN richtung DECR 1 
    ELIF taste = ""2""  THEN richtung INCR 1
    ELIF taste = ""3""  THEN richtung DECR spalten
    FI
ENDPROC tastatur abfrage;

PROC bonus erreicht :
     x := (int(stopzeit)-x) * schwierigkeit;
     cspalte := 10;
     czeile  := 10;
     cursorpositionieren;
     putline("B O N U S ! ! !");
     line;
     putline(""15"          "+text(x)+" Punkte !!!"14"");
     bonus := bonus + punkte + x;
ENDPROC bonus erreicht;

PROC poke (INT CONST stelle,wert) :
     INT VAR x pos := 1 + ((stelle - basis) MOD spalten),
             y pos := 1 + ((stelle - basis) DIV spalten); 
     cursor(x pos,y pos);
     IF wert = 126 THEN out(""15""8""14"") ELSE
        out(code(wert));
     FI;
     bildschirm (x pos)(y pos) := wert;
ENDPROC poke;

INT PROC peek (INT CONST stelle) :
    INT VAR x pos := 1 + ((stelle - basis) MOD spalten),
            y pos := 1 + ((stelle - basis) DIV spalten);
    bildschirm (x pos)(y pos)
ENDPROC peek;

PROC cursorpositionieren :
     bildschirm zeile := basis + spalten*czeile;
     cursor(cspalte+1,czeile+1);
ENDPROC cursor positionieren;

PROC highscore und platznummer :
     punkte := punkte + bonus;
     bonus := 0;
     IF punkte > highscore THEN highscore := punkte FI;
     player counter INCR 1;
     q := player counter + 1;
     spieler punkte(playercounter) := punkte;
     FOR i FROM 1 UPTO playercounter REP
         IF punkte > spielerpunkte (i) THEN q DECR 1 FI;
     PER;
     c spalte :=10;
     czeile := 10;
     cursorpositionieren;
     putline("Hoechstpunktzahl "+text(highscore));line;
     putline("           Punkte :"+text(punkte));
     putline("           Platznr.:"+text(q-1));
     IF q-1 >= 10 THEN inchar(hilf)
        ELSE put("Name des Gewinners:");
        getline(hilf);
        disablestop;
        FOR i FROM playercounter DOWNTO q REP
            spielername(i+1) := spielername(i);
            IF iserror THEN clearerror; spielername(i+1) := "" FI;
        PER;
        enablestop;
        spielername(q-1) := "(" +text(punkte) + " Punkte: " + hilf+")";
     FI;
     page;
     putline("Die ersten 10 Gewinner :");
     disablestop;
     FOR i FROM 1 UPTO min(playercounter,10) REP
         putline(text(i)+"."+spielername(i));
         IF iserror THEN clearerror;spielername(i) := "" FI
     PER;
     enablestop;
     putline("Druecken Sie eine Taste");
     inchar(hilf);
ENDPROC highscore und platznummer;

PROC explosion :
   out(""7"");
   FOR i FROM ende DOWNTO laenge +1REP
       IF wurm (i) >= basis AND wurm(i) < (basis+spalten*zeilen) THEN poke(wurm(i),leerzeichen);
       FI;
   PER;
   highscore und platznummer
ENDPROC explosion;

PROC lindwurm :
   bonus := 0;

   REP
    clearscreen;
    out(""14""1""4"");
    IF bonus = 0 THEN neues spiel FI;
    IF bonus > 0 THEN bonusspiel FI;
    page;
    rahmen;
    lebensraum generieren;
    lindwurm kopf setzen;
    reset time;
    kriech;
    SELECT index OF 
       CASE 1 : bonus erreicht
       CASE 2 : highscore und platznummer
       CASE 3 : explosion
    ENDSELECT
  UNTIL bonus<= 0 COR no(""1""4""10""10"Noch ein Spiel") PER

ENDPROC lindwurm;

PROC neues spiel :
     basis := 0;
     stelle := basis + spalten*zeilen DIV 2;
     schwierigkeit := 4;
     geschwindigkeit :=9;
     char 1:= 126;
     char 2:= 79;
     char 3:= 42;
     char 4:= 124;
     leerzeichen := 32;
     index := 0;
     ende := 0;
     laenge := 0;
     richtung := 0;
     zaehler := 0;
     bonus := 0;
     punkte := 0;
     stopzeit :="3:00";
     vorwahl;
     begrenzung := 120 * schwierigkeit;
ENDPROC neues spiel;

PROC liste aller spieler :
     page;
     FOR i FROM 1 UPTO playercounter REP
        putline(text(i)+"."+spielername(i));
        IF i > 24 THEN pause(20) FI;
     PER;
     putline("ENDE");
     inchar(hilf);
     page;
ENDPROC liste aller spieler;


PROC vorwahl :
     spielregeln;
     page;
     REP
       out(""1"");
       putline(""142"                                    Lindwurm                               "143"");
       czeile :=12;
       cspalte:=3;
       cursorpositionieren;
       putline("Schwierigkeitsgrad (1/2) "+ text(schwierigkeit,3));
       czeile :=14;
       cspalte:=3;
       cursorpositionieren;
       putline("Geschwindigkeit    (3/4) "+ text(geschwindigkeit,3));
       czeile :=16;
       cspalte:=3;
       cursorpositionieren;
       putline("Liste aller Spieler (5)  ");
       czeile :=18;
       cspalte:=3;
       cursorpositionieren;
       putline("Start mit RETURN");
       x := 0;
       inchar(hilf);
       IF hilf = ""13""THEN LEAVE vorwahl
       ELIF hilf = "1" THEN schwierigkeit INCR 1
       ELIF hilf = "2" THEN schwierigkeit DECR 1
       ELIF hilf = "3" THEN geschwindigkeit INCR 1
       ELIF hilf = "4" THEN geschwindigkeit DECR 1
       ELIF hilf = "5" THEN liste aller spieler 
       ELSE out(""7"") 
       FI;
       IF schwierigkeit > 26 THEN schwierigkeit := 1 
       ELIF schwierigkeit < 1 THEN schwierigkeit := 26 FI; 
       IF geschwindigkeit > 9 THEN geschwindigkeit := 1 
       ELIF geschwindigkeit < 1 THEN geschwindigkeit := 9 FI; 
     PER

ENDPROC vorwahl;

PROC spielregeln :
     putline(code(char1)+" = Rahmen (Mauer)");
     line;
     putline(code(char2)+" = Lindwurmkopf");
     line;
     putline(code(char3)+" = Nahrung");
     line;
     putline(""15""8""14" = Lindwurm"); 
     line;
     putline(". = Gift");
     line;
     putline ("Ziel des Spiels ist es, den Wurm mit Nahrung zu versorgen. Gift ist tödlich.");
     line;
     putline ("Der Wurm kann mit den Pfeiltasten gesteuert werden. Wird eine Taste mehrmals");
     line;
     putline ("gedrückt, wird der Wurm schneller. Vorsicht: Der Wurm darf nicht auf eine");
     line;
     putline ("Mauer treffen. Mit jedem gefressenen Nahrungsteilchen wird der Wurm etwas");
     line;
     putline ("länger. Du hast 3 Minuten Zeit, den Wurm zu füttern.");
     line;
     putline ("Viel Erfolg. Bitte drücke jetzt eine Taste.");
     pause(6000);
ENDPROC spielregeln;

PROC bonusspiel :
    stelle := basis+zeilen*spaltenDIV2;
    index := 0;
    punkte := 0;
    richtung := 0;
    zaehler := 0;
    ende := 0;
    laenge := 0;
    schwierigkeit INCR 1;
    IF schwierigkeit > 26 THEN schwierigkeit := 26 FI;
    begrenzung := 120 * schwierigkeit 

ENDPROC bonusspiel;

PROC lebensraum generieren :
    FOR i FROM 1 UPTO 16 * schwierigkeit REP
        REP
           x := int(random * real((zeilen-2)*spalten) + real(spalten));
        UNTIL peek(basis+x) = leerzeichen PER;
        poke(basis+x,char3)
    PER;
    FOR i FROM 1 UPTO schwierigkeit REP
        REP
           x := int(random * real((zeilen-2)*spalten) + real(spalten));
        UNTIL peek(basis+x) = leerzeichen PER;
        poke(basis+x,46)
    PER;
ENDPROC lebensraum generieren;

PROC lindwurmkopf setzen :
    WHILE peek(stelle) <> leerzeichen REP stelle INCR 1 PER;
    poke(stelle,char2);
    out(""7"");

ENDPROC lindwurmkopf setzen;

PROC rahmen :
   FOR i FROM basis UPTO basis + spalten-1 REP
       poke(i,char4);
       poke(i+(zeilen-1)*spalten,char4);
   PER;
   i := basis + spalten;
   REP poke(i ,char4); 
       poke(i+spalten-1,char4);
       i INCR spalten
   UNTIL i >( basis + (zeilen-1)*spalten )PER

ENDPROC rahmen;

PROC clearscreen :
   INT VAR x,y;
       putline ("Nun markiert der Wurm sein Revier.");
       line ;
       put("Es ist");put(spalten);put("qm gross.");line;
       FOR x FROM 1 UPTO spalten REP
           cout(x);
           FOR y FROM 1 UPTO zeilen REP
               bildschirm(x)(y) := leerzeichen
           PER
       PER
ENDPROC clearscreen;

TEXT PROC zeit :
     subtext(time(clock(1)-uhr),5,8)
ENDPROC zeit;

PROC reset time :
     uhr := clock(1)
ENDPROC reset time;.

deklaration :
   ROW spalten ROW zeilen INT VAR bildschirm;
   ROW 300 INT VAR spielerpunkte;
   ROW 300 TEXT VAR spielername;
   ROW max INT VAR wurm;
   TEXT VAR hilf,taste,stopzeit;
   INT VAR basis:=0,playercounter:=0,highscore:=0,q:=0,i:=0,x:=0,y:=0,stelle:=1000,richtung,
           punkte:=0,bonus:=0,index:=0,cspalte,czeile,bildschirmzeile,zaehler:=0,ende:=0,
           laenge:=0,speicher:=1,leerzeichen:=32,begrenzung:=480,schwierigkeit:=4,
           geschwindigkeit:=9,c:=90,char1:=90,char2:=90,char3:=90,char4:=90;

   REAL VAR uhr;
   BOOL VAR feuer;
ENDPACKET lindwurm