home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1988 / 04 / zahlwurm.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1988-01-26  |  6.8 KB  |  281 lines
  1. PROGRAM zahlenwurm;
  2.  
  3. (* Spiel zum Kennenlernen des Zahlenraums 1 - 9 *)
  4. (* Copyright 1988 by B. Freier & PASCAL Int.    *)
  5.  
  6. CONST            (* Bei Bedarf bitte ändern !!! *)
  7.   kopf = 0;                  (* Farbe der Figur *)
  8.   grundfarbe = 15;     (* Farbe des Spielfeldes *)
  9.   randfarbe = 3;         (* Farbe der Umrandung *)
  10.   ziffernfarbe = 1; (* Farbe bei Ziffernausgabe *)
  11.   randzeichen = 177;
  12.                  (* ASCII-Zeichen für Umrandung *)
  13.   kopfzeichen = 233; (* ASCII-Zeichen für Figur *)
  14.   obergrenze = 57;(* Obergrenze bei den Ziffern *)
  15.  
  16. TYPE
  17.   schirmposition = ARRAY[1..40,1..22] OF INTEGER;
  18.  
  19. VAR
  20.   schirm : schirmposition;
  21.                  (* Bildschirmkoordinatenpaare  *)
  22.   level,         (* Verweildauer,evtl. anpassen *)
  23.   speisezahl,             (* Anzahl der Ziffern *)
  24.   untergrenze,
  25.                  (* Untergrenze bei den Ziffern *)
  26.   richtung,      (* Aktuelle Richtung der Figur *)
  27.   waag,                (* Waagrechte Koordinate *)
  28.   senk   : INTEGER;
  29.                        (* Senkrechte Koordinate *)
  30.   geschafft,     (* Schalter, wenn Stufe fertig *)
  31.   kollision,     (* Schalter, falls angestoßen  *)
  32.   ende   : BOOLEAN;
  33.                  (* Schalter für Programmende   *)
  34.   ch     : CHAR;
  35.                  (* Buchstaben bei den Eingaben *)
  36.  
  37.  
  38. PROCEDURE aufbau;   (* Rand zeichnen und werten *)
  39.  
  40. VAR  i, j: INTEGER;
  41.      ch  : CHAR;
  42.  
  43. BEGIN
  44.   Randomize; ClrScr; TextColor(randfarbe);
  45.   FOR i := 1 TO 40 DO BEGIN
  46.     FOR j := 1 TO 22 DO BEGIN
  47.       IF (i=1) OR (j=1) OR (i=40) OR (j=22) THEN
  48.       BEGIN
  49.         schirm[i,j] := randzeichen;
  50.         GotoXY(i,j);
  51.         Write(Chr(randzeichen));
  52.       END;
  53.     END;
  54.   END;
  55. END;
  56.  
  57.  
  58. PROCEDURE cursoroff;  (* Cursor wird unsichtbar *)
  59.  
  60. BEGIN            (* Bei Monochrom-Monitor statt
  61.                     $b800 bitte $b000 einsetzen *)
  62.   GotoXY(1,23);  Mem[$b800:$06e0]:=219;
  63.   Mem[$b800:$06e1]:=grundfarbe;
  64. END;
  65.  
  66.  
  67. PROCEDURE zuweisung;
  68.                  (* Festlegen der Anfangswerte  *)
  69. VAR i,j : INTEGER;
  70.  
  71. BEGIN            (* Initialisierung Bildschirm  *)
  72.   FOR i := 1 TO 40 DO
  73.     FOR j := 1 TO 22 DO
  74.       schirm[i,j] := 0;
  75.                  (* Schalter Voreinstellungen   *)
  76.   waag := 18;  senk := 2;  untergrenze:=49;
  77.   richtung := 75;  ende := FALSE;
  78.   kollision := FALSE;  geschafft := FALSE;
  79. END;
  80.  
  81.  
  82. PROCEDURE grundstellung;
  83.                     (* Startaufstellung belegen *)
  84. VAR i,j : INTEGER;
  85.  
  86. BEGIN
  87.   TextColor(kopf);
  88.   schirm[waag,senk] := kopfzeichen;
  89.   GotoXY(waag,senk); Write(Chr(kopfzeichen));
  90.   cursoroff;
  91. END;
  92.  
  93.  
  94. PROCEDURE speise_aufb;    (* Aufbau der Ziffern *)
  95.  
  96. VAR  i,j,x : INTEGER;
  97.  
  98. BEGIN
  99.   speisezahl := 0;  x := untergrenze;
  100.   REPEAT
  101.     i := Random(36)+3; j := Random(waag)+3;
  102.                               (* Zufallsauswahl *)
  103.     TextColor(ziffernfarbe);
  104.     IF schirm[i,j] = 0 THEN BEGIN
  105.       speisezahl := speisezahl+1;
  106.       schirm[i,j] := x;
  107.       GotoXY(i,j);  Write(Chr(x));  x:=x+1;
  108.     END;
  109.   UNTIL x>obergrenze;
  110.   cursoroff;
  111. END;
  112.  
  113.  
  114. PROCEDURE links;         (* Bewegung nach links *)
  115.  
  116. BEGIN
  117.   waag := waag -1;
  118.   IF schirm[waag,senk] = untergrenze THEN BEGIN
  119.     untergrenze:=untergrenze+1;
  120.     speisezahl := speisezahl -1; SOUND(500);
  121.   END
  122.   ELSE SOUND(300);             (* bischen Krach *)
  123.   IF (schirm[waag,senk] = 0)
  124.   OR (schirm[waag,senk] = untergrenze-1) THEN
  125.   BEGIN
  126.     schirm[waag+1,senk] := 0;
  127.     GotoXY(waag+1,senk); Write(Chr(32));
  128.     GotoXY(waag,senk);   Write(Chr(kopfzeichen));
  129.     cursoroff;
  130.   END
  131.   ELSE kollision:=TRUE;
  132.   NOSOUND; Delay(level); (* Krach aus und Pause *)
  133.   IF speisezahl = 0 THEN geschafft := TRUE;
  134. END;
  135.  
  136.  
  137. PROCEDURE rechts;        (* Bewegung nach rechts *)
  138.  
  139. BEGIN
  140.   waag := waag +1;
  141.   IF schirm[waag,senk] = untergrenze THEN BEGIN
  142.     untergrenze:=untergrenze+1;
  143.     speisezahl := speisezahl -1; SOUND(500);
  144.   END
  145.   ELSE SOUND(300);
  146.   IF (schirm[waag,senk] = 0)
  147.   OR (schirm[waag,senk] = untergrenze-1) THEN
  148.   BEGIN
  149.     schirm[waag-1,senk] := 0;
  150.     GotoXY(waag-1,senk); Write(Chr(32));
  151.     GotoXY(waag,senk);   Write(Chr(kopfzeichen));
  152.     cursoroff;
  153.   END
  154.   ELSE kollision:=TRUE;
  155.   NOSOUND; Delay(level);
  156.   IF speisezahl = 0 THEN geschafft := TRUE;
  157. END;
  158.  
  159.  
  160. PROCEDURE auf;            (* Bewegung nach oben *)
  161.  
  162. BEGIN
  163.   senk := senk -1;
  164.   IF schirm[waag,senk] = untergrenze THEN BEGIN
  165.     untergrenze:=untergrenze+1;
  166.     speisezahl := speisezahl -1; SOUND(500);
  167.   END
  168.   ELSE SOUND(300);
  169.   IF (schirm[waag,senk] = 0)
  170.   OR (schirm[waag,senk] = untergrenze-1) THEN
  171.   BEGIN
  172.     schirm[waag,senk+1] := 0;
  173.     GotoXY(waag,senk+1); Write(Chr(32));
  174.     GotoXY(waag,senk);   Write(Chr(kopfzeichen));
  175.     cursoroff;
  176.   END
  177.   ELSE kollision:=TRUE;
  178.   NOSOUND; Delay(level);
  179.   IF speisezahl = 0 THEN geschafft := TRUE;
  180. END;
  181.  
  182.  
  183. PROCEDURE ab;            (* Bewegung nach unten *)
  184.  
  185. BEGIN
  186.   senk := senk +1;
  187.   IF schirm[waag,senk] = untergrenze THEN BEGIN
  188.     untergrenze:=untergrenze+1;
  189.     speisezahl := speisezahl -1; SOUND(500);
  190.   END
  191.   ELSE SOUND(300);
  192.   IF (schirm[waag,senk] = 0)
  193.   OR (schirm[waag,senk] = untergrenze-1) THEN
  194.   BEGIN
  195.     schirm[waag,senk-1] := 0;
  196.     GotoXY(waag,senk-1); Write(Chr(32));
  197.     GotoXY(waag,senk);   Write(Chr(kopfzeichen));
  198.     cursoroff;
  199.   END
  200.   ELSE kollision:=TRUE;
  201.   NOSOUND; Delay(level);
  202.   IF speisezahl = 0 THEN geschafft := TRUE;
  203. END;
  204.  
  205.  
  206. PROCEDURE wiederholung;
  207.                  (* Frage der Spielwiederholung *)
  208. BEGIN
  209.   GotoXY(7,11);
  210.   Write('Noch ein Spiel (J/N)'); cursoroff;
  211.   REPEAT
  212.     Read(Kbd,ch);
  213.   UNTIL ch IN ['J','j','N','n',' '];
  214.   IF UpCase(ch)='N' THEN ende := TRUE;
  215. END;
  216.  
  217.  
  218. PROCEDURE tastaturabfrage;
  219.                       (* Abfrage der Bewegungen *)
  220. BEGIN
  221.   Read(Kbd,ch);
  222.   IF (ch=Chr(27)) AND KeyPressed THEN Read(Kbd,ch);
  223.   IF ch IN ['K','M','H','P']  THEN
  224.     richtung := Ord(ch);
  225. END;
  226.  
  227.  
  228. PROCEDURE spiel;       (* Verwaltung des Spiels *)
  229. BEGIN
  230.   TextColor(kopf);
  231.   REPEAT
  232.     Read (Kbd,ch);
  233.   UNTIL (ch=Chr(32));
  234.   REPEAT
  235.     IF KeyPressed THEN tastaturabfrage;
  236.     CASE Ord(richtung) OF
  237.       75 : links;
  238.       77 : rechts;
  239.       72 : auf;
  240.       80 : ab;
  241.     END;
  242.   UNTIL kollision OR geschafft;
  243. END;
  244.  
  245.  
  246. PROCEDURE kollision_behandlung;
  247.                         (* Figur ist angestoßen *)
  248. BEGIN
  249.   ClrScr;  GotoXY(5,5);
  250.   Write('Schade, Du bist angestoßen !');
  251.   cursoroff;
  252.   wiederholung;
  253. END;
  254.  
  255.  
  256. PROCEDURE spielvorb;
  257.                  (* Hauptverwaltung des Spieles *)
  258. BEGIN
  259.   zuweisung;  aufbau;
  260.   grundstellung;  speise_aufb;  spiel;
  261.   IF kollision THEN kollision_behandlung;
  262.   IF geschafft THEN wiederholung;
  263.   IF NOT (ende OR geschafft) THEN BEGIN
  264.     REPEAT
  265.       spielvorb;
  266.     UNTIL ende;
  267.   END;
  268. END;
  269.  
  270.  
  271. BEGIN                          (* Hauptprogramm *)
  272.   TextMode(c40);
  273.   TextBackGround(grundfarbe);
  274.   TextColor(kopf);
  275.   level:=300;  Randomize;
  276.   REPEAT
  277.     spielvorb;
  278.   UNTIL ende;
  279.   TextMode(c80);
  280. END.
  281.