home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1988 / 04 / inverso.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-01-26  |  7.2 KB  |  268 lines
  1. PROGRAM  INVERSO;
  2.  
  3. (*   System: MS-DOS   Sprache: Turbo Pascal 3.0   *)
  4. (*   (C) Gerd Kraus & PASCAL International        *)
  5.  
  6. CONST Max        = 63;       (* 8 * 8 - Spielfeld *)
  7.       Stein_1    = '#';         (* normaler Stein *)
  8.       Stein_2    = ' ';     (* verwandelter Stein *)
  9.  
  10. VAR   Feld         : ARRAY [0..Max] OF 0..1;
  11.       Von1, Von2,
  12.       Nach1, Nach2 : CHAR;
  13.       Korrekt      : BOOLEAN;
  14.       Anzahl,
  15.       Verwandelt   : INTEGER;
  16.  
  17. (*------------------------------------------------*)
  18. (* die mittleren 16 Felder sind bereits umgewan-  *)
  19. (* delt, mit der RANDOM-Function kann man eine    *)
  20. (* zufaellige Startkonstellation ausgeben lassen  *)
  21.  
  22. PROCEDURE Initialisierung;
  23.  
  24. VAR I, J : INTEGER;
  25.  
  26. BEGIN
  27.   Anzahl := 1;  Verwandelt := 16;
  28.                                (* normale Steine: *)
  29.   FOR I := 0 TO Max DO  Feld[I] := 1;
  30.   I := 17;                  (* verwandelter Stein *)
  31.   REPEAT
  32.     FOR J := 1 TO 4 DO Feld [I+J] := 0;
  33.     I := I + 8;            (* Feld 18 - 21 usw.   *)
  34.   UNTIL I > 41;
  35. END;
  36.  
  37. (*------------------------------------------------*)
  38. PROCEDURE INVERS;             (* LOWVIDEO bei CPM *)
  39. BEGIN TextColor(0); TextBackGround(15) END;
  40.  
  41. (*------------------------------------------------*)
  42. PROCEDURE NORMAL;            (* NORMVIDEO bei CPM *)
  43. BEGIN TextColor(15); TextBackGround(0) END;
  44.  
  45. (*------------------------------------------------*)
  46. PROCEDURE Stein_2_Setzen;
  47. BEGIN
  48.   INVERS;  Write (Stein_2);  NORMAL
  49. END;
  50.  
  51. (*------------------------------------------------*)
  52. PROCEDURE ZeigSteine;
  53.  
  54. VAR   Zeile, Spalte, X, Y : INTEGER;
  55.  
  56. BEGIN
  57.   X := 15; Y := 4;
  58.   FOR Zeile := 0 TO 7 DO BEGIN
  59.     FOR Spalte := 0 TO 7 DO BEGIN
  60.       GotoXY (X - 2 + 4 * Spalte, Y+1);
  61.       IF Feld [Zeile * 8 + Spalte] = 1 THEN
  62.         Write (Stein_1)
  63.       ELSE
  64.         Stein_2_Setzen;
  65.     END;
  66.     Y := Y + 2;
  67.   END;
  68.   NORMAL;
  69.   GotoXY (5,22);
  70.   Write(' Anzahl der Zuege    : ',Anzahl-1:5,' ');
  71.   GotoXY (5,23);
  72.   Write(' Umgewandelte Steine : ',Verwandelt:5,' ');
  73.   Anzahl := Succ(Anzahl);
  74.   Verwandelt := Succ(Verwandelt);
  75.   NORMAL
  76. END;
  77.  
  78. (*------------------------------------------------*)
  79. PROCEDURE INTRO;
  80.  
  81. BEGIN
  82.   ClrScr; GotoXY (36,1);
  83.   INVERS;  Write (' INVERSO ');  NORMAL;
  84.   GotoXY (3,5);
  85.   Write ('Ihre Aufgabe bei diesem Spiel ist es,');
  86.   Write (' auf einem Brett mit 64 Feldern alle');
  87.   GotoXY (3,6);
  88.   Write ('durch "', Stein_1, '" angezeigten ',
  89.          'Steine in "');
  90.   Stein_2_Setzen;
  91.   Write ('" Spielsteine zu verwandeln.');
  92.   GotoXY (26,9);
  93.   Write ('Dabei gelten folgende REGELN :');
  94.   NORMAL;  GotoXY (3,11);
  95.   Write
  96.   ('1 - Es darf nur diagonal gesprungen werden.');
  97.   GotoXY (3,12);
  98.   Write
  99.   ('2 - Es darf nur mit "', Stein_1,'" ueber "');
  100.   Write (Stein_1, '" in ein Feld mit "');
  101.   Stein_2_Setzen;
  102.   Write ('" gesprungen werden.');
  103.   GotoXY (1,14);
  104.   Write ('>>> Das Feld mit "');
  105.   Stein_2_Setzen;
  106.   Write ('" wird dabei zu "', Stein_1);
  107.   Write ('", die 2 Felder mit "', Stein_1,
  108.          '" werden zu "');
  109.   Stein_2_Setzen;  Write ('". <<<');
  110.   GotoXY (30,23);  INVERS;
  111.   Write (' Weiter mit Tastendruck ');
  112.   NormVideo;
  113.   REPEAT UNTIL KeyPressed;
  114.   ClrScr; GotoXY (36,1);
  115.   INVERS;  Write (' INVERSO ');  NORMAL;
  116.  
  117. END;
  118.  
  119. (*------------------------------------------------*)
  120. PROCEDURE  SpielBrett;
  121.   (* Linien fuer den erweiterten IBM-Zeichensatz: *)
  122. CONST  E1 = #218;  (* OBEN LINKS *)
  123.        E2 = #191;  (* OBEN  RECHTS *)
  124.        E3 = #192;  (* UNTEN LINKS *)
  125.        E4 = #217;  (* UNTEN RECHTS *)
  126.        VE = #179;  (* VERTIKALE LINIE *)
  127.        HO = #196;  (* HORIZONTALE LINIE *)
  128.        KR = #197;  (* KREUZUNG *)
  129.        ZL = #180;  (* ZEIGER NACH LINKS *)
  130.        ZR = #195;  (* ZEIGER NACH RECHTS *)
  131.        ZO = #193;  (* ZEIGER NACH OBEN *)
  132.        ZU = #194;  (* ZEIGER NACH UNTEN *)
  133.        Leer = #32#32#32;
  134.  
  135. VAR    I, J, K,
  136.        X, Y     : INTEGER;
  137.  
  138.   PROCEDURE ZEILE2;
  139.  
  140.   BEGIN
  141.     Y := Succ(Y);
  142.     GotoXY (X-2, Y); Write(K);
  143.     GotoXY (X, Y);
  144.     FOR J := 1 TO 8 DO Write (VE,Leer);
  145.     Write (VE)
  146.   END;
  147.  
  148.   PROCEDURE ZEILE3;
  149.  
  150.   BEGIN
  151.     Y := Succ(Y);
  152.     GotoXY (X, Y); Write (ZR);
  153.     FOR I := 1 TO 7 DO BEGIN
  154.       FOR J := 1 TO 3 DO Write (HO);
  155.         Write (KR);
  156.     END;
  157.     Write (HO,HO,HO,ZL)
  158.   END;
  159.  
  160. BEGIN  (* SpielBrett *)
  161.   X := 10;  Y := 3;
  162.   FOR I := 1 TO 8 DO BEGIN
  163.     GotoXY (X-1+4*I, Y); Write (Chr(64+I));
  164.   END;
  165.   X := Succ (X);    Y := Succ (Y);
  166.   GotoXY (X, Y);    Write (E1);
  167.   FOR I := 1 TO 7 DO Write (HO,HO,HO,ZU);
  168.   Write (HO,HO,HO,E2);
  169.   FOR K := 1 TO 7 DO BEGIN ZEILE2;  ZEILE3; END;
  170.   K := Succ(K);  ZEILE2;
  171.   Y := Succ (Y);
  172.   GotoXY (X, Y);  Write (E3);
  173.   FOR I := 1 TO 7 DO Write (HO,HO,HO,ZO);
  174.   Write (HO,HO,HO,E4);
  175.   GotoXY (52,14);  Write ('Eingabebeispiel : A1');
  176.   GotoXY (52,16);  Write ('Ende mit "^Q"')
  177. END;
  178.  
  179. (*------------------------------------------------*)
  180. PROCEDURE EingabeFeld;
  181.  
  182. BEGIN
  183.   GotoXY (53,5);  Write ('Zugeingabe :');
  184.   INVERS;
  185.   GotoXY (50,7);  Write (' ':14);
  186.   GotoXY (50,8);  Write ('  von Feld  : ');
  187.   GotoXY (50,9);  Write (' ':14);
  188.   GotoXY (50,10); Write ('  nach Feld : ');
  189.   GotoXY (50,11); Write (' ':14);
  190.   NORMAL
  191. END;
  192.  
  193. (*------------------------------------------------*)
  194. PROCEDURE ZugEingabe (Wo: BYTE; Zulaessig: BYTE;
  195.                       VAR Zug1, Zug2 : CHAR);
  196.  
  197. VAR     PositionNeu, PNZeile, PNSpalte,
  198.         PositionAlt, PAZeile, PASpalte : INTEGER;
  199.         OK                             : BOOLEAN;
  200.  
  201.   PROCEDURE Kontrolle;
  202.   (* ueberprueft den eingegebenen Zug und wandelt *)
  203.   (* die Steine um                                *)
  204.  
  205.   BEGIN
  206.     PositionNeu := (Ord(Zug2) - 49) * 8
  207.                    + (Ord(Zug1) - 65);
  208.     PNZeile  := PositionNeu DIV 8;
  209.     PNSpalte := PositionNeu MOD 8;
  210.     IF Feld [PositionNeu] = Zulaessig THEN
  211.       Korrekt := TRUE;
  212.     IF (Zulaessig = 0) AND Korrekt THEN BEGIN
  213.       Korrekt :=
  214.          (ABS (PNZeile - PAZeile) = 2) AND
  215.          (ABS (PNSpalte - PASpalte) = 2);
  216.  
  217.       IF Korrekt THEN BEGIN      (* Neue Belegung *)
  218.         Feld[Round((PositionNeu+PositionAlt)/2)]:=0;
  219.         Feld [PositionAlt] := 0;
  220.         Feld [PositionNeu] := 1;
  221.       END
  222.       ELSE Write (Chr(7));             (* Piepser *)
  223.     END
  224.     ELSE BEGIN
  225.       PositionAlt := PositionNeu;
  226.       PAZeile     := PNZeile;
  227.       PASpalte    := PNSpalte;
  228.     END
  229.   END;
  230.  
  231. BEGIN
  232.   Korrekt := FALSE;
  233.   IF Wo = 8 THEN GotoXY (65, Wo + 2);
  234.   ClrEol;               (* Bis Zeilenende löschen *)
  235.   GotoXY(65, Wo);  ClrEol;
  236.   REPEAT                    (* Eingabe der Spalte *)
  237.     Read (Kbd,Zug1);
  238.     Zug1 := UpCase(Zug1);
  239.     OK := Zug1 IN ['A'..'H'];
  240.     OK := OK OR (Ord(Zug1) = 17);    (* Control-Q *)
  241.   UNTIL OK;
  242.   IF Ord(Zug1) = 17 THEN Halt;   (* Programm-Ende *)
  243.   Write (Zug1);
  244.   REPEAT                   (* Eingabe der Zeile *)
  245.     Read (Kbd,Zug2);
  246.     OK := Zug2 IN ['1'..'8'];
  247.   UNTIL OK;
  248.   Write (Zug2);
  249.   Kontrolle
  250. END;
  251.  
  252. (*------------------------------------------------*)
  253. BEGIN
  254.   INTRO;
  255.   SpielBrett;
  256.   Initialisierung;
  257.   ZeigSteine;
  258.   EingabeFeld;
  259.   REPEAT
  260.     REPEAT
  261.       ZugEingabe(8,1,Von1,Von2);    (* Start-Feld *)
  262.       ZugEingabe(10,0,Nach1,Nach2);  (* Ziel-Feld *)
  263.       IF NOT Korrekt THEN Write (Chr(7));
  264.     UNTIL Korrekt;
  265.     ZeigSteine;
  266.   UNTIL Verwandelt = Succ (Max)
  267. END.
  268.