home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1988 / 05 / zahlwurm.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1988-02-23  |  11.2 KB  |  469 lines
  1.  
  2. (*----------------------------------------------*)
  3. (*               ZAHLWURM.PAS                   *)
  4. (* Spiel zum Kennenlernen des Zahlenraums 1 - 9 *)
  5. (* Copyright 1988 by B. Freier & PASCAL Int.    *)
  6.  
  7. PROGRAM Zahlwurm;
  8.  
  9. CONST            (* Bei Bedarf bitte ändern !!! *)
  10.   kopf = 0;                  (* Farbe der Figur *)
  11.   grundfarbe = 15;     (* Farbe des Spielfeldes *)
  12.   randfarbe = 3;         (* Farbe der Umrandung *)
  13.   ziffernfarbe = 1; (* Farbe bei Ziffernausgabe *)
  14.   randzeichen = 177;
  15.                  (* ASCII-Zeichen für Umrandung *)
  16.   kopfzeichen = 1;   (* ASCII-Zeichen für Figur *)
  17.   schlange = 6;   (* Farbe des Schlangenkörpers *)
  18.   schlangenzeichen = 233;
  19.                     (* ASCII-Zeichen für Körper *)
  20.  
  21. TYPE
  22.   schirmposition = ARRAY[1..40,1..22] OF INTEGER;
  23.   position       = ARRAY[1..300,1..2] OF INTEGER;
  24.  
  25. VAR
  26.   schirm : schirmposition;
  27.                  (* Bildschirmkoordinatenpaare  *)
  28.   posi   : position;
  29.   level,         (* Verweildauer,evtl. anpassen *)
  30.   speisezahl,             (* Anzahl der Ziffern *)
  31.   untergrenze,
  32.                  (* Untergrenze bei den Ziffern *)
  33.   obergrenze,
  34.   richtung,      (* Aktuelle Richtung der Figur *)
  35.   waag,                (* Waagrechte Koordinate *)
  36.   senk,                (* Senkrechte Koordinate *)
  37.   anfang,
  38.   schluss,
  39.   stufe  : INTEGER;
  40.   geschafft,     (* Schalter, wenn Stufe fertig *)
  41.   kollision,     (* Schalter, falls angestoßen  *)
  42.   ende,
  43.   mehr   : BOOLEAN;
  44.                  (* Schalter für Programmende   *)
  45.   ch     : CHAR;
  46.                  (* Buchstaben bei den Eingaben *)
  47.  
  48.  
  49. PROCEDURE aufbau;   (* Rand zeichnen und werten *)
  50.  
  51. VAR  i, j: INTEGER;
  52.      ch  : CHAR;
  53.  
  54. BEGIN
  55.   Randomize; ClrScr; TextColor(randfarbe);
  56.   FOR i := 1 TO 40 DO BEGIN
  57.     FOR j := 1 TO 22 DO BEGIN
  58.       IF (i=1) OR (j=1) OR (i=40) OR (j=22) THEN
  59.       BEGIN
  60.         schirm[i,j] := randzeichen;
  61.         GotoXY(i,j);
  62.         Write(Chr(randzeichen));
  63.       END;
  64.     END;
  65.   END;
  66. END;
  67.  
  68.  
  69. PROCEDURE cursoroff;  (* Cursor wird unsichtbar *)
  70.  
  71. BEGIN            (* Bei Monochrom-Monitor statt
  72.                     $b800 bitte $b000 einsetzen *)
  73.   GotoXY(1,23);  Mem[$b800:$06e0]:=219;
  74.   Mem[$b800:$06e1]:=grundfarbe;
  75. END;
  76.  
  77.  
  78. PROCEDURE zuweisung;
  79.                  (* Festlegen der Anfangswerte  *)
  80. VAR i,j : INTEGER;
  81.  
  82. BEGIN            (* Initialisierung Bildschirm  *)
  83.   FOR i := 1 TO 40 DO
  84.     FOR j := 1 TO 22 DO
  85.       schirm[i,j] := 0;
  86.                  (* Schalter Voreinstellungen   *)
  87.   untergrenze:= 48;
  88.   obergrenze := 57;
  89.   waag := 18;
  90.   senk := 2;
  91.   richtung := 75;
  92.   anfang := 6;
  93.   schluss := 1;
  94.   ende := FALSE;
  95.   kollision := FALSE;
  96.   geschafft := FALSE;
  97.  
  98. END;
  99.  
  100.  
  101. PROCEDURE grundstellung;
  102.                     (* Startaufstellung belegen *)
  103. VAR i,j : INTEGER;
  104.  
  105. BEGIN
  106.   TextColor(kopf);
  107.   schirm[waag,senk] := kopfzeichen;
  108.   posi[6,1] := waag;
  109.   posi[6,2] := senk;
  110.   GotoXY(waag,senk);
  111.   Write(Chr(kopfzeichen));
  112.   textcolor(schlange);
  113.   j := 14;
  114.   for i := 19 to 23 do begin
  115.     schirm[i,2] := schlangenzeichen;
  116.     posi[i-j,1] := i;
  117.     posi[i-j,2] := 2;  j := j + 2;
  118.     gotoxy(i,2);
  119.     write(chr(schlangenzeichen));
  120.   end;
  121.   cursoroff;
  122. END;
  123.  
  124.  
  125. PROCEDURE speise_aufb;    (* Aufbau der Ziffern *)
  126.  
  127. VAR  i,j,x : INTEGER;
  128.  
  129. BEGIN
  130.   speisezahl := 0;  x := untergrenze;
  131.   REPEAT
  132.     i := Random(36)+3; j := Random(waag)+3;
  133.                               (* Zufallsauswahl *)
  134.     TextColor(ziffernfarbe);
  135.     IF schirm[i,j] = 0 THEN BEGIN
  136.       speisezahl := speisezahl+1;
  137.       schirm[i,j] := x;
  138.       GotoXY(i,j);  Write(Chr(x));  x:=x+1;
  139.     END;
  140.   UNTIL x>obergrenze;
  141.   cursoroff;
  142. END;
  143.  
  144.  
  145. PROCEDURE schwanz;  (* zeichnen aktuelle Schlange *)
  146.  
  147. BEGIN
  148.   anfang := anfang + 1;
  149.   if anfang > 300 then anfang := 1;
  150.   posi[anfang,1] := waag;
  151.   posi[anfang,2] := senk;
  152.   if not mehr then begin
  153.     gotoxy(posi[schluss,1],posi[schluss,2]);
  154.     write(chr(32));
  155.     schirm[posi[schluss,1],posi[schluss,2]] := 0;
  156.     schluss := schluss + 1;
  157.     if schluss > 300 then schluss := 1;
  158.     textcolor(kopf);
  159.   end;
  160. END;
  161.  
  162.  
  163. PROCEDURE links;         (* Bewegung nach links *)
  164.  
  165. BEGIN
  166.   waag := waag -1;
  167.   IF schirm[waag,senk] = untergrenze THEN BEGIN
  168.     untergrenze:=untergrenze+1;
  169.     speisezahl := speisezahl -1; SOUND(500);
  170.     mehr := true;
  171.   END
  172.   ELSE SOUND(300);             (* bischen Krach *)
  173.   IF (schirm[waag,senk] = 0)
  174.   OR (schirm[waag,senk] = untergrenze-1) THEN BEGIN
  175.     schirm[waag+1,senk] := schlangenzeichen;
  176.     schirm[waag,senk]   := kopfzeichen;
  177.     GotoXY(waag+1,senk); textcolor(schlange);
  178.     Write(Chr(schlangenzeichen));
  179.     GotoXY(waag,senk); textcolor(kopf);
  180.     Write(Chr(kopfzeichen));
  181.     schwanz;
  182.     cursoroff;
  183.   END
  184.   ELSE kollision:=TRUE;
  185.   NOSOUND; Delay(level); (* Krach aus und Pause *)
  186.   IF speisezahl = 0 THEN geschafft := TRUE;
  187.   mehr := false;
  188. END;
  189.  
  190.  
  191. PROCEDURE rechts;        (* Bewegung nach rechts *)
  192.  
  193. BEGIN
  194.   waag := waag +1;
  195.   IF schirm[waag,senk] = untergrenze THEN BEGIN
  196.     untergrenze:=untergrenze+1;
  197.     speisezahl := speisezahl -1; SOUND(500);
  198.     mehr := true;
  199.   END
  200.   ELSE SOUND(300);
  201.   IF (schirm[waag,senk] = 0)
  202.   OR (schirm[waag,senk] = untergrenze-1) THEN BEGIN
  203.     schirm[waag-1,senk] := schlangenzeichen;
  204.     schirm[waag,senk]   := kopfzeichen;
  205.     gotoxy(waag-1,senk);  textcolor(schlange);
  206.     Write(Chr(schlangenzeichen));
  207.     GotoXY(waag,senk); textcolor(kopf);
  208.     Write(Chr(kopfzeichen));
  209.     schwanz;
  210.     cursoroff;
  211.   END
  212.   ELSE kollision:=TRUE;
  213.   NOSOUND; Delay(level);
  214.   IF speisezahl = 0 THEN geschafft := TRUE;
  215.   mehr := false;
  216. END;
  217.  
  218.  
  219. PROCEDURE auf;            (* Bewegung nach oben *)
  220.  
  221. BEGIN
  222.   senk := senk -1;
  223.   IF schirm[waag,senk] = untergrenze THEN BEGIN
  224.     untergrenze:=untergrenze+1;
  225.     speisezahl := speisezahl -1; SOUND(500);
  226.     mehr := true;
  227.   END
  228.   ELSE SOUND(300);
  229.   IF (schirm[waag,senk] = 0)
  230.   OR (schirm[waag,senk] = untergrenze-1) THEN BEGIN
  231.     schirm[waag,senk+1] := schlangenzeichen;
  232.     schirm[waag,senk]   := kopfzeichen;
  233.     GotoXY(waag,senk+1); textcolor(schlange);
  234.     Write(Chr(schlangenzeichen));
  235.     GotoXY(waag,senk); textcolor(kopf);
  236.     Write(Chr(kopfzeichen));
  237.     schwanz;
  238.     cursoroff;
  239.   END
  240.   ELSE kollision:=TRUE;
  241.   NOSOUND; Delay(level);
  242.   IF speisezahl = 0 THEN geschafft := TRUE;
  243.   mehr := false;
  244. END;
  245.  
  246.  
  247. PROCEDURE ab;            (* Bewegung nach unten *)
  248.  
  249. BEGIN
  250.   senk := senk +1;
  251.   IF schirm[waag,senk] = untergrenze THEN BEGIN
  252.     untergrenze:=untergrenze+1;
  253.     speisezahl := speisezahl -1; SOUND(500);
  254.     mehr := true;
  255.   END
  256.   ELSE SOUND(300);
  257.   IF (schirm[waag,senk] = 0)
  258.   OR (schirm[waag,senk] = untergrenze-1) THEN BEGIN
  259.     schirm[waag,senk-1] := schlangenzeichen;
  260.     GotoXY(waag,senk-1); textcolor(schlange);
  261.     Write(Chr(schlangenzeichen));
  262.     schirm[waag,senk] := kopfzeichen;
  263.     GotoXY(waag,senk); textcolor(kopf);
  264.     Write(Chr(kopfzeichen));
  265.     schwanz;
  266.     cursoroff;
  267.   END
  268.   ELSE kollision:=TRUE;
  269.   NOSOUND; Delay(level);
  270.   IF speisezahl = 0 THEN geschafft := TRUE;
  271.   mehr := false;
  272. END;
  273.  
  274.  
  275. PROCEDURE wiederholung;
  276.                  (* Frage der Spielwiederholung *)
  277. BEGIN
  278.   GotoXY(7,11);
  279.   Write('Noch ein Spiel (J/N)'); cursoroff;
  280.   REPEAT
  281.     Read(Kbd,ch);
  282.   UNTIL ch IN ['J','j','N','n',' '];
  283.   IF UpCase(ch)='N' THEN ende := TRUE;
  284. END;
  285.  
  286.  
  287. PROCEDURE tastaturabfrage;
  288.                       (* Abfrage der Bewegungen *)
  289. BEGIN
  290.   Read(Kbd,ch);
  291.   IF (ch=Chr(27)) AND KeyPressed THEN Read(Kbd,ch);
  292.   IF ch IN ['K','M','H','P']  THEN
  293.     richtung := Ord(ch);
  294. END;
  295.  
  296.  
  297. PROCEDURE spiel;       (* Verwaltung des Spiels *)
  298. BEGIN
  299.   TextColor(kopf);
  300.   REPEAT
  301.     Read (Kbd,ch);
  302.   UNTIL (ch=Chr(32));
  303.   REPEAT
  304.     IF KeyPressed THEN tastaturabfrage;
  305.     CASE Ord(richtung) OF
  306.       75 : links;
  307.       77 : rechts;
  308.       72 : auf;
  309.       80 : ab;
  310.     END;
  311.   UNTIL kollision OR geschafft;
  312. END;
  313.  
  314.  
  315.  
  316.  
  317.  
  318. PROCEDURE kollision_behandlung;
  319.                         (* Zusammenstoß anzeigen *)
  320. var i,j : integer;
  321.  
  322. BEGIN
  323.   ClrScr;  GotoXY(5,5);
  324.   Write('Schade, Du bist angestoßen !');
  325.   cursoroff;
  326.   j := 910;
  327.   for i := 1 to 10 do begin
  328.     sound(j); delay(300);
  329.     j := j - 100;
  330.   end;
  331.   nosound;
  332.   wiederholung;
  333. END;
  334.  
  335.  
  336. procedure fanfare;  (* Siegerehrung, wenn geschafft *)
  337.  
  338. var i : integer;
  339.  
  340. BEGIN
  341.   clrscr;
  342.   gotoxy(5,5);
  343.   write('Prima, Du hast es geschafft!');
  344.   cursoroff;
  345.   for i := 1 to 20 do begin
  346.     sound(i*100);
  347.     delay(300);
  348.   end;
  349.   nosound;
  350. end;
  351.  
  352.  
  353. PROCEDURE nextlevel;  (* Übergang nächste Spielstufe *)
  354.  
  355. BEGIN
  356.   if stufe + 1 < 6 then begin
  357.     stufe := stufe + 1;
  358.     gotoxy(5,11);
  359.     write('Du kommst in die nächste');
  360.     gotoxy(5,13);
  361.     write('Schwierigkeitsstufe:  ',stufe:1);
  362.     cursoroff;
  363.     level := (5-stufe)*50 + 30;
  364.     delay(10000);
  365.   end
  366.   else wiederholung;
  367. END;
  368.  
  369.  
  370. PROCEDURE levelabfrage; (* Benutzerabfrage Anfangslevel *)
  371.  
  372. var j : integer;
  373.  
  374. begin
  375.   clrscr;
  376.   gotoxy(4,3);
  377.   write('Welche Schwierigkeitsstufe: (1..5)');
  378.   gotoxy(9,6);
  379.   write('1  ganz langsam');
  380.   gotoxy(9,8);
  381.   write('2  langsam');
  382.   gotoxy(9,10);
  383.   write('3  mittel');
  384.   gotoxy(9,12);
  385.   write('4  schnell');
  386.   gotoxy(9,14);
  387.   write('5  sehr schnell');
  388.   gotoxy(4,18);
  389.   write('Bitte die gewählte Ziffer drücken !');
  390.   cursoroff;
  391.   repeat
  392.     read(kbd,ch);
  393.   until ch in ['1'..'5',' '];
  394.   if (stufe = 0) and (ch = ' ') then stufe := 1;
  395.   if (ch <> ' ') then val(ch,stufe,j);
  396.   level := (5-stufe)*50 + 30;
  397.   anfang := 6;
  398. end;
  399.  
  400.  
  401. PROCEDURE spielvorb;
  402.                  (* Hauptverwaltung des Spieles *)
  403. BEGIN
  404.   zuweisung;  aufbau;
  405.   grundstellung; cursoroff;
  406.   speise_aufb;
  407.   textcolor(kopf);
  408.   gotoxy(7,24);
  409.   write('Schwierigkeitsstufe: ',stufe:2);
  410.   cursoroff;
  411.   spiel;
  412.   IF kollision THEN kollision_behandlung;
  413.   IF geschafft THEN begin
  414.     fanfare;
  415.     nextlevel;
  416.   end;
  417.   if (ende = false) and (geschafft = false) then begin
  418.     levelabfrage;
  419.     REPEAT
  420.       spielvorb;
  421.     UNTIL ende = true;
  422.   end;
  423. END;
  424.  
  425.  
  426. PROCEDURE spielerklaerung; (* Erklärung des Ablaufs *)
  427.  
  428. BEGIN
  429.   textbackground(grundfarbe);
  430.   textcolor(kopf);
  431.   clrscr;
  432.   gotoxy(6,2);
  433.   write('Z A H L E N S C H L A N G E');
  434.   gotoxy(1,6);
  435.   writeln(' Bei diesem Spiel geht es darum, eine ');
  436.   writeln(' Schlange durch einen Raum zu führen, ');
  437.   writeln(' in dem die Zahlen von 1 bis 9 stehen.');
  438.   writeln(' Die Schlange muß die Zahlen in genau ');
  439.   writeln(' der richtigen Reihenfolge fressen,   ');
  440.   writeln(' wobei mit jeder Ziffer die Länge der ');
  441.   writeln(' Schlange zunimmt.                    ');
  442.   writeln(' Die Außenwand sowie die Schlange     ');
  443.   writeln(' selbst dürfen nicht angeknabbert wer-');
  444.   writeln(' den. Ein Bremsen ist ebenfalls nicht ');
  445.   writeln(' möglich, da sie sich dadurch selbst  ');
  446.   writeln(' verschluckt.                         ');
  447.   writeln; writeln;
  448.   writeln('   Steuerung mit den Pfeiltasten      ');
  449.   writeln('   oder mit dem Joystick möglich.     ');
  450.   writeln('   Leertaste zum Starten benutzen.    ');
  451.   gotoxy(8,25); write('Bitte eine Taste drücken !');
  452.   cursoroff;
  453.   repeat until keypressed;
  454.   clrscr;
  455. END;
  456.  
  457.  
  458. BEGIN                          (* Hauptprogramm *)
  459.   TextMode(c40);
  460.   spielerklaerung;
  461.   stufe := 1;
  462.   levelabfrage;
  463.   Randomize;
  464.   REPEAT
  465.     spielvorb;
  466.   UNTIL ende;
  467.   TextMode(c80);
  468. END.
  469.