home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / spezial / 06 / inverso / inverso.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-10-12  |  7.7 KB  |  258 lines
  1. PROGRAM  INVERSO;
  2. (*  System   : MS-DOS       Sprache   : Turbo Pascal 4.0  *)
  3. (*  V.1.0.b  - 12.10.88     CGA-Version                   *)
  4.  
  5. {$R+,S-,I+,D+,T-,F+,V+,B+,N-,L+ }
  6. {$M 16384,0,655360 }
  7.  
  8. USES CRT, DOS, Graph, SpieleGraph, InvSpr1, InvSpr2;
  9. (* in Spielegraph : GraphDir an die eigenen Verzeichnisse anpassen ! *)
  10. (* InvSpr1   : UNIT mit Sprite-Daten des ersten Steines  *)
  11. (* InvSpr2   : UNIT mit Sprite-Daten des zweiten Steines *)
  12. (* jeder Sprite hat die Abmessungen 16 * 16              *)
  13.  
  14. CONST            Max        = 63;         (* 8 * 8 - Spielfeld *)
  15.                  Stein      = #32;        (* zur Anzeige in INTRO *)
  16.  
  17.                  StartX : INTEGER = 20;
  18.                  DeltaX : INTEGER = 21;
  19.                  Zeilen : INTEGER = 8;
  20.                  StartY : INTEGER = 30;
  21.                  DeltaY : INTEGER = 21;
  22.                  Spalten: INTEGER = 8;
  23.  
  24.  
  25. VAR              Feld         : ARRAY [0..Max] OF 0..1;
  26.                  Von1, Von2,
  27.                  Nach1, Nach2 : CHAR;
  28.                  Korrekt      : BOOLEAN;
  29.                  Space2       : POINTER;
  30.                  Anzahl,
  31.          Verwandelt   : INTEGER;
  32. (*-----------------------------------------------*)
  33. FUNCTION Wirklich (Frage : STRING) : BOOLEAN;
  34. (* Ja oder Nein *)
  35. VAR Ch    : CHAR;
  36.  
  37. BEGIN
  38.   SetViewPort (MinX+1, MaxY-19, MaxX-1, MaxY-1, ClipOff);
  39.   ClearViewPort;
  40.   SetColor (2);  OutTextXY (5, 5, Frage);
  41.  
  42.   REPEAT
  43.     Ch := ReadKey
  44.   UNTIL UpCase (Ch) IN ['J', 'N'];
  45.   Wirklich := Ch IN ['J', 'j'];
  46. END;
  47. (*-----------------------------------------------*)
  48. PROCEDURE Initialisierung;
  49. (* die mittleren 16 Felder sind bereits umgewandelt *)
  50. (* mit der RANDOM-Function kann man eine zufällige  *)
  51. (* Start-Konstellation ausgeben lassen              *)
  52.  
  53. VAR I, J : INTEGER;
  54.  
  55. BEGIN
  56.   FillChar (Feld, SizeOf (Feld), #1);    (* normaler Stein *)
  57.   I := 17;
  58.   REPEAT
  59.     FOR J := 1 TO 4 DO Feld [I+J] := 0;  (* verwandelter Stein *)
  60.     I := I + 8;                           (* Feld 18 - 21 usw   *)
  61.   UNTIL I > 41;
  62.   Anzahl := 1;    Verwandelt := 16;
  63.  
  64.   GraphikInit (CGA, CGAC2);
  65.   SetTextStyle (SmallFont, HorizDir, 4);
  66.   SetColor (2);
  67.   MachRaster (StartX, Spalten, DeltaX, StartY, Zeilen, DeltaY, TRUE);
  68.   SetColor (3);    OutTextXY (130, 1, 'I N V E R S O');
  69. END;
  70. (*-----------------------------------------------*)
  71. PROCEDURE ZeigSteine;
  72.  
  73. VAR   TempZeile, TempSpalte, HilfX, HilfY : INTEGER;
  74.  
  75. BEGIN
  76.  
  77.   FOR TempZeile := 0 TO 7 DO BEGIN
  78.     HilfY := StartY + 3 + DeltaY * TempZeile;
  79.     FOR TempSpalte := 0 TO 7 DO BEGIN
  80.       HilfX := StartX + 3 + DeltaX * TempSpalte;
  81.       CASE Feld [TempZeile * 8 + TempSpalte] OF
  82.        1 : PutImage (HilfX, HilfY, Sprite1^, NormalPut)
  83.         ELSE   PutImage (HilfX, HilfY, Sprite2^, NormalPut);
  84.       END;    (* CASE Feld [..] *)
  85.     END;      (* FOR TempSpalte *)
  86.   END;        (* FOR TempZeile  *)
  87.  
  88.   SetColor (0);    (* alte Werte löschen *)
  89.   OutTextXY (200, 150, 'Zuege      : ' + Int2Str (Anzahl - 2, 4));
  90.   OutTextXY (200, 170, 'Verwandelt : ' + Int2Str (Verwandelt - 1, 4));
  91.  
  92.   SetColor (1);
  93.   OutTextXY (200, 150, 'Zuege      : ' + Int2Str (Anzahl - 1, 4));
  94.   OutTextXY (200, 170, 'Verwandelt : ' + Int2Str (Verwandelt, 4));
  95.  
  96.   Anzahl := SUCC(Anzahl);
  97.   Verwandelt := SUCC(Verwandelt);
  98.  
  99. END;
  100. (*-----------------------------------------------*)
  101. PROCEDURE INTRO;
  102. (*----------*)
  103. PROCEDURE Stein_1_Setzen;
  104.  BEGIN
  105.    TextBackGround (Green);  WRITE (Stein);  TextBackGround (Black);
  106.  END;
  107. (*----------*)
  108. PROCEDURE Stein_2_Setzen;
  109.  BEGIN
  110.    TextBackGround (Red);   WRITE (Stein);  TextBackGround (Black);
  111.  END;
  112. (*----------*)
  113. BEGIN
  114.    TextMode (C80);
  115.    CLRSCR; GOTOXY (36,1);  INVERS;  WRITE (' INVERSO ');  Normal;
  116.    TextColor (White);
  117.    GOTOXY (3,5);
  118.    WRITE ('Ihre Aufgabe bei diesem Spiel ist es, auf einem');
  119.    WRITE (' Brett mit 64 Feldern alle');
  120.    GOTOXY (3,6);
  121.    WRITE ('durch "');  Stein_1_Setzen;  WRITE ('" angezeigten Steine in "');
  122.    Stein_2_Setzen;
  123.    WRITE ('" Spielsteine zu verwandeln.');
  124.    GOTOXY (26,9);
  125.  
  126.    WRITE ('Dabei gelten folgende REGELN :');
  127.  
  128.    GOTOXY (3,11);
  129.    WRITE ('1 - Es darf nur diagonal gesprungen werden.');
  130.    GOTOXY (3,12);
  131.    WRITE ('2 - Es darf nur mit "');  Stein_1_Setzen;  WRITE ('" über "');
  132.    Stein_1_Setzen;
  133.    WRITE ('" in ein Feld mit "');
  134.    Stein_2_Setzen;
  135.    WRITE ('" gesprungen werden.');
  136.    GOTOXY (1,14);
  137.    WRITE ('>>> Das Feld mit "');
  138.    Stein_2_Setzen;
  139.    WRITE ('" wird dabei zu "');    Stein_1_Setzen;
  140.    WRITE ('", die 2 Felder mit "'); Stein_1_Setzen;  WRITE ('" werden zu "');
  141.    Stein_2_Setzen;
  142.    WRITE ('". <<<');
  143.    GOTOXY (30,17);  WRITE ('Spiel-Abbruch mit CTRL-Q');
  144.    GOTOXY (30,23);
  145.    INVERS;
  146.    WRITE (' Weiter mit Tastendruck ');
  147.    NORMAL;
  148.    REPEAT UNTIL KEYPRESSED;
  149. END;
  150. (*-----------------------------------------------*)
  151. PROCEDURE EingabeFeld;
  152.  
  153. BEGIN
  154.   SetColor (1);
  155.   BAR (195, 25, 305, 65);
  156.   (* Space zum Löschen definieren *)
  157.   GetMem (Space2, ImageSize (0, 0, 20, 10));
  158.   GetImage (280, 40, 300, 50, Space2^);
  159.   SetColor (0);
  160.   OutTextXY (225, 30, 'Zugeingabe :');
  161.   OutTextXY (205, 40, 'von Feld  :');
  162.   OutTextXY (205, 50, 'nach Feld :');
  163.   SetColor (1);
  164. END;
  165. (*-----------------------------------------------*)
  166. PROCEDURE ZugEingabe  (Start : BYTE; Zulaessig : BYTE ;
  167.                        VAR Zug1, Zug2 : CHAR);
  168.  
  169. VAR     PositionNeu, PNZeile, PNSpalte,
  170.         PositionAlt, PAZeile, PASpalte,
  171.         AktZeile                        : INTEGER;
  172.         OK                              : BOOLEAN;
  173. (*----------*)
  174. PROCEDURE Kontrolle;
  175. (* überprüft den eingegebenen Zug und wandelt *)
  176. (* die Steine um                              *)
  177.  
  178. BEGIN
  179.   PositionNeu := (ORD(Zug2) - 49) * 8 + (ORD(Zug1) - 65);
  180.   PNZeile  := PositionNeu DIV 8 ;
  181.   PNSpalte := PositionNeu AND 7;      (* entspricht MOD 8 *)
  182.   IF Feld [PositionNeu] = Zulaessig THEN Korrekt := TRUE;
  183.   IF (Zulaessig = 0) AND Korrekt THEN
  184.      BEGIN
  185.        Korrekt :=
  186.          (ABS (PNZeile - PAZeile) = 2) AND (ABS (PNSpalte - PASpalte) = 2);
  187.  
  188.        IF Korrekt THEN
  189.           BEGIN                            (* Neue Belegung *)
  190.              Feld [ROUND((PositionNeu + PositionAlt)/2)] := 0;
  191.              Feld [PositionAlt] := 0;
  192.              Feld [PositionNeu] := 1;
  193.           END
  194.           ELSE Beep (400, 200);
  195.  
  196.      END
  197.      ELSE BEGIN
  198.             PositionAlt := PositionNeu;    (* Zwischenspeicherung *)
  199.             PAZeile     := PNZeile;
  200.             PASpalte    := PNSpalte;
  201.           END
  202. END;
  203. (*----------*)
  204. BEGIN
  205.   Korrekt := FALSE;
  206.  
  207.   IF Start = 1 THEN
  208.      BEGIN
  209.        AktZeile := 40;
  210.        PutImage (280, AktZeile + 10, Space2^, NormalPut);
  211.      END
  212.      ELSE AktZeile := 50;
  213.  
  214.   PutImage (280, AktZeile, Space2^, NormalPut);
  215.   REPEAT  (* Eingabe der Spalte *)
  216.     HolZeichen (Zug1);  Zug1 := UpCase (Zug1);
  217.     OK := Zug1 IN ['A'..'H', ^Q];
  218.   UNTIL OK;
  219.   IF Zug1 = ^Q THEN BEGIN  Korrekt := TRUE;  EXIT;  END;
  220.   OutTextXY (280, AktZeile, Zug1);
  221.  
  222.   REPEAT                                  (* Eingabe der Zeile *)
  223.     HolZeichen (Zug2);
  224.     OK := Zug2 IN ['1'..'8'];
  225.   UNTIL OK;
  226.  
  227.   OutTextXY (287, AktZeile, Zug2);
  228.   Kontrolle;
  229. END;
  230. (*-----------------------------------------------*)
  231. PROCEDURE Spielen;
  232. (* Abbruch mit CTRL-Q *)
  233. BEGIN
  234.   REPEAT
  235.     REPEAT
  236.       ZugEingabe (1, 1, Von1, Von2);       (* Start-Feld *)
  237.       IF Von1 <> ^Q THEN
  238.      ZugEingabe (2, 0, Nach1, Nach2);  (* Ziel-Feld *)
  239.          IF NOT Korrekt THEN Beep (400, 200);
  240.      IF (Von1 = ^Q) OR (Nach1 = ^Q)  THEN EXIT;
  241.     UNTIL (Korrekt);
  242.     ZeigSteine;
  243.    UNTIL Verwandelt = SUCC (Max);
  244. END;
  245. (*-----------------------------------------------*)
  246. BEGIN
  247.   REPEAT
  248.     INTRO;
  249.     Initialisierung;
  250.     ZeigSteine;
  251.     EingabeFeld;
  252.  
  253.     Spielen;
  254.  
  255.   UNTIL NOT Wirklich ('Noch ein Spiel ? <J> / <N> : ');
  256.   GraphikEnde;
  257. END.
  258.