home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1988 / 03 / hasen.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-01-11  |  8.0 KB  |  269 lines
  1. (* -------------------------------------------- *)
  2. (*                   HASEN.PAS                  *)
  3. (* ein Spiel fuer Kinder zum Kennenlernen der   *)
  4. (* der Tastatur fuer Turbo Pascal unter MS-DOS. *)
  5. (*        (C)1988 B.Freier & PASCAL INT.        *)
  6. PROGRAM Hasen;
  7. CONST
  8.   hasenzahl = 6;            (* Anzahl der Hasen *)
  9.   gras      = 10;           (* Farbe des Rasens *)
  10.   fell      = 6;        (* Farbe des Hasenfells *)
  11.   papier    = 15;    (* Farbe des Hintergrundes *)
  12.   schrift   = 1;           (* Farbe der Schrift *)
  13.  
  14. TYPE                              (* Spielfeld: *)
  15.   spfeld = ARRAY[1..15,1..4] OF BOOLEAN;
  16.  
  17. VAR
  18.   x,y,                  (* aktuelle Koordinaten *)
  19.   xalt,yalt,           (* vorherige Koordinaten *)
  20.   richtung,            (* Richtung der Bewegung *)
  21.   i,                (* allgemeine Zaehlvariable *)
  22.   freie,gefangen,        (* Zahl der Hasenarten *)
  23.   farbe          : INTEGER;     (* Farbvariable *)
  24.   spielfeld      : spfeld;
  25.                  (* allgemeine Eingabevariable: *)
  26.   ch             : CHAR;
  27.   ende,           (* Schalter fuer Programmende *)
  28.           (* Schalter fuer Loesung der Aufgabe: *)
  29.   geschafft      : BOOLEAN;
  30.  
  31. (* -------------------------------------------- *)
  32. (*             Cursor wird unsichtbar           *)
  33. (* Bei Monochrom-Monitor statt $B800 bitte      *)
  34. (* $B000 einsetzen:                             *)
  35. PROCEDURE CursorOff;
  36. BEGIN
  37.   GotoXY(1,25);
  38.   Mem[$B800:$06E0] := 32;
  39.   Mem[$B800:$06E1] := papier;
  40. END;
  41.  
  42. (* -------------------------------------------- *)
  43. (*             Erklaerung des Ablaufes          *)
  44. PROCEDURE spielerklaerung;
  45. BEGIN
  46.   TextBackGround(papier);  TextColor(schrift);
  47.   ClrScr;
  48.   GotoXY(7,3);  Write ('H A S E N F A N G E N');
  49.   GotoXY(2,6);
  50.   Write ('Oh Schreck! Dem Nachbarn sind seine');
  51.   GotoXY(2,8);
  52.   Write ('6 Hasen aus dem Stall entkommen. Sie');
  53.   GotoXY(2,10);
  54.   Write ('sitzen unbewacht im Garten.');
  55.   GotoXY(2,12);
  56.   Write ('Nimm schnell einen Rahmen und hilf');
  57.   GotoXY(2,14);
  58.   Write ('beim Fangen der Hasen.');
  59.   GotoXY(2,18);
  60.   Write ('Steuere den Rahmen mit den Pfeilta-');
  61.   GotoXY(2,20);
  62.   Write ('sten und drücke die Eingabetaste,');
  63.   GotoXY(2,22);
  64.   Write ('wenn der Rahmen um den Hasen liegt.');
  65.   GotoXY(2,25);
  66.   Write ('Drücke jetzt eine beliebige Taste !');
  67.   REPEAT UNTIL KeyPressed;
  68.   ClrScr;
  69. END;
  70.  
  71. (* -------------------------------------------- *)
  72. PROCEDURE spielfeldfrei
  73.          (VAR spielfeld :spfeld ; x,y : INTEGER );
  74. BEGIN
  75.   FOR x:=1 TO 15 DO
  76.     FOR y:=1 TO 4 DO
  77.       spielfeld[x,y]:=FALSE;
  78. END;
  79.  
  80. (* -------------------------------------------- *)
  81. (*               zeichnet den Hasen             *)
  82. PROCEDURE hase (x,y : INTEGER);
  83.  
  84. BEGIN
  85.   TextBackGround(gras);  TextColor(fell);
  86.   GotoXY(x*5-1,y*5-2);
  87.   Write (Chr(222)+Chr(32)+Chr(32)+Chr(221));
  88.   GotoXY(x*5-1,y*5-1);
  89.   Write (Chr(32)+Chr(219)+Chr(219));
  90.   GotoXY(x*5-1,y*5);
  91.   Write (Chr(219)+Chr(219)+Chr(219)+Chr(219));
  92.   GotoXY(x*5-1,y*5+1);
  93.   Write (Chr(219)+Chr(219)+Chr(219)+Chr(219));
  94.   TextBackGround(fell);  TextColor(0);
  95.   GotoXY(x*5,y*5+1);
  96.   Write (Chr(201)+Chr(187));    (* Schwaenzchen *)
  97.   TextBackGround(papier);  CursorOff;
  98. END;
  99.  
  100. (* -------------------------------------------- *)
  101. (*              zeichnet den Rahmen             *)
  102. PROCEDURE rahmen (x,y,farbe : INTEGER);
  103.  
  104. BEGIN
  105.   TextBackGround(farbe);
  106.   GotoXY(x*5-2,y*5-3);  Write('      ');
  107.   FOR i:=1 TO 4 DO BEGIN
  108.     GotoXY(x*5-2,y*5-3+i);  Write(' ');
  109.     GotoXY(x*5+3,y*5-3+i);  Write(' ');
  110.   END;
  111.   GotoXY(x*5-2,y*5+2);  Write('      ');
  112.   TextBackGround(papier);  CursorOff;
  113. END;
  114.  
  115. (* -------------------------------------------- *)
  116. (*          Zufallsverteilung der Hasen         *)
  117. PROCEDURE hasenverteilen (VAR spielfeld : spfeld);
  118.  
  119. LABEL nocheinmal;
  120. VAR   zufallx,zufally : INTEGER;
  121.  
  122. BEGIN
  123.   WINDOW(3,2,78,22);  (* Feld in gruener Farbe: *)
  124.   TextBackGround(gras);
  125.   ClrScr;  WINDOW(1,1,80,25);
  126.   Randomize;    (* Setzen des Zufallsgenerators *)
  127.   FOR i:=1 TO hasenzahl DO BEGIN
  128. nocheinmal:   (* Auswahl der Zufallspositionen: *)
  129.     zufallx:=Random(15)+1;  zufally:=Random(4)+1;
  130.     IF NOT spielfeld[zufallx,zufally] THEN BEGIN
  131.              (* Platz im Spielfeld ist unbelegt *)
  132.       spielfeld[zufallx,zufally]:=TRUE;
  133.       hase(zufallx,zufally);
  134.     END
  135.     ELSE       (* Platz im Spielfeld ist belegt *)
  136.       GOTO nocheinmal;
  137.   END;
  138. END;
  139.  
  140. (* -------------------------------------------- *)
  141. (*         Ausgabe des aktuellen Standes        *)
  142. PROCEDURE wertausgabe (freie,gefangen : INTEGER);
  143. BEGIN
  144.   GotoXY(2,1);
  145.   Write('Noch frei : ',freie);
  146.   GotoXY(60,1);
  147.   Write('Schon gefangen : ',gefangen);
  148. END;
  149.  
  150. (* -------------------------------------------- *)
  151. (*          Frage der Spielwiederholung         *)
  152. PROCEDURE wiederholung (VAR ende : BOOLEAN);
  153.  
  154. VAR ch : CHAR;
  155.  
  156. BEGIN
  157.   ClrScr;
  158.   GotoXY(17,3);
  159.   Write('PRIMA, Du hast alle Hasen eingefangen!');
  160.   GotoXY(27,21);  Write('Noch ein Spiel (J/N)');
  161.   REPEAT
  162.     Read(Kbd,ch);
  163.   UNTIL ch IN ['J','j','N','n'];
  164.   ende := (UpCase(ch)='N');
  165. END;
  166.  
  167. (* -------------------------------------------- *)
  168. (*        Prueft, ob wirklich Hase dort         *)
  169. PROCEDURE kontrolle
  170.   (VAR freie,gefangen : INTEGER;
  171.    VAR geschafft      : BOOLEAN;
  172.    VAR spielfeld      : spfeld ;  x,y : INTEGER);
  173.  
  174. BEGIN
  175.   IF NOT geschafft THEN
  176.     IF spielfeld[x,y] THEN BEGIN
  177.       spielfeld[x,y] := FALSE; (* Hase loeschen *)
  178.       WINDOW(x*5-1,y*5-2,x*5+2,y*5+1);
  179.       TextBackGround(gras);
  180.       ClrScr;  WINDOW(1,1,80,25);
  181.       TextBackGround(papier);
  182.       GotoXY (12,24);
  183.       Write('Prima, Du hast wieder einen ',
  184.             'Hasen gefangen !');
  185.       freie := freie-1;  gefangen := gefangen+1;
  186.       wertausgabe(freie,gefangen);
  187.       IF freie = 0 THEN BEGIN
  188.         geschafft := TRUE;
  189.         wiederholung(ende);
  190.       END
  191.       ELSE
  192.         REPEAT UNTIL KeyPressed;
  193.       GotoXY (2,24);  ClrEol;
  194.     END
  195.     ELSE BEGIN
  196.       GotoXY(22,24);
  197.       Write('Schade, hier ist kein Hase !');
  198.       REPEAT UNTIL KeyPressed;
  199.       GotoXY(2,24);  ClrEol;
  200.     END;
  201. END;
  202.  
  203. (* -------------------------------------------- *)
  204. (*          Hauptsteuerung des Spieles          *)
  205. PROCEDURE spiel
  206.   (VAR x,y,xalt,yalt : INTEGER;
  207.    VAR ch            : CHAR;
  208.    VAR geschafft     : BOOLEAN);
  209.  
  210. BEGIN
  211.   WHILE NOT geschafft DO BEGIN
  212.     Read(Kbd,ch);
  213.     IF ch = Chr(13) THEN
  214.       kontrolle(freie,gefangen,geschafft,
  215.                 spielfeld,x,y)
  216.     ELSE IF (ch=Chr(27)) AND KeyPressed THEN BEGIN
  217.       Read(Kbd,ch);
  218.       IF ch IN ['K','M','H','P'] THEN BEGIN
  219.         richtung := Ord(ch);
  220.         xalt := x;  yalt := y;
  221.         CASE Ord(richtung) OF
  222.           75 : IF x > 1 THEN BEGIN     (* Links *)
  223.                  x := x-1;
  224.                  rahmen(xalt,yalt,gras);
  225.                  rahmen(x,y,schrift);
  226.                END;
  227.           77 : IF x < 15 THEN BEGIN   (* Rechts *)
  228.                  x := x+1;
  229.                  rahmen(xalt,yalt,gras);
  230.                  rahmen(x,y,schrift);
  231.                END;
  232.           72 : IF y > 1 THEN BEGIN (* Aufwaerts *)
  233.                  y := y-1;
  234.                  rahmen(xalt,yalt,gras);
  235.                  rahmen(x,y,schrift);
  236.                END;
  237.           80 : IF y < 4 THEN BEGIN  (* Abwaerts *)
  238.                  y := y+1;
  239.                  rahmen(xalt,yalt,gras);
  240.                  rahmen(x,y,schrift);
  241.                END;
  242.         END;
  243.       END;
  244.     END;
  245.   END;
  246. END;
  247.  
  248. (* -------------------------------------------- *)
  249. BEGIN (* Hasen *)
  250.   ende := FALSE;
  251.   REPEAT                       (* Spielschleife *)
  252.     TextMode(C40);
  253.     spielerklaerung;
  254.     TextMode(C80);  TextBackGround(papier);
  255.     TextColor(fell);  ClrScr;
  256.     geschafft := FALSE;    (* Initialisierungen *)
  257.     spielfeldfrei(spielfeld,x,y);
  258.     hasenverteilen(spielfeld);
  259.     x := 7;  y := 2;  xalt := 1;  yalt := 1;
  260.     i := 1;  ch := 'A';
  261.     freie := 6;  gefangen := 0;
  262.     wertausgabe(freie,gefangen);
  263.     rahmen(x,y,schrift);
  264.     spiel(x,y,xalt,yalt,ch,geschafft);
  265.   UNTIL ende AND geschafft;
  266.   TextMode(C80);
  267.   ClrScr;
  268. END.
  269.