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