home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1988 / 06_07 / spiel / memory.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1988-03-15  |  8.7 KB  |  287 lines
  1. (* ------------------------------------------------------ *)
  2. (*                    MEMORY.PAS                          *)
  3. (*        Ein Spielprogramm in Turbo Pascal 3.0           *)
  4. (*    (c) 1988 by Gerd Kraus & PASCAL International       *)
  5. (* ------------------------------------------------------ *)
  6.  
  7. PROGRAM Memory;
  8.  
  9. TYPE    EineKarte  = STRING[2];         (* Farbe und Wert *)
  10. VAR     SpielFeld  : ARRAY [1..64] OF EineKarte;
  11.                                   (* 2 Spielkarten-Saetze *)
  12.         Punkte     : ARRAY [1..2] OF BYTE;
  13.         Spieler,
  14.         Runde      : INTEGER;
  15.         Position_K1,
  16.         Position_K2 : BYTE;   (* Nummern der aufgedeckten *)
  17.                               (* Karten, 1 .. 64          *)
  18.         RueckSeite,                    (* Karten-Ruecken  *)
  19.         LeereKarte  : EineKarte;       (* gefundene Karte *)
  20.  
  21. (* ------------------------------------------------------ *)
  22. PROCEDURE Invers;                     (* LOWVIDEO bei CPM *)
  23.  
  24. BEGIN
  25.   TextColor(0); TextBackGround(15);
  26. END;
  27.  
  28. (* ------------------------------------------------------ *)
  29. PROCEDURE Normal;                    (* NORMVIDEO bei CPM *)
  30.  
  31. BEGIN
  32.   TextColor(15); TextBackGround(0);
  33. END;
  34.  
  35. (* ------------------------------------------------------ *)
  36. PROCEDURE Bell;                    (* WRITE (^G) fuer CPM *)
  37.  
  38. BEGIN
  39.   Sound (800); Delay (50); NoSound;
  40. END;
  41. (* ------------------------------------------------------ *)
  42. PROCEDURE ZeigKarte (Spalte, Zeile : BYTE;
  43.                      Karte : EineKarte);
  44.                   (* Spielkarte auf dem Bildschirm zeigen *)
  45. BEGIN
  46.   GotoXY (16 + 3 * Spalte, 6 + 2 * Zeile);
  47.      (* fuer Farb-Monitore : Bildschirm-Farben auswaehlen *)
  48.   Write (Karte);
  49. END;
  50.  
  51. (* ------------------------------------------------------ *)
  52. PROCEDURE Initialisierung;
  53.                 (* Zusammenstellen und Mischen der Karten *)
  54.  
  55. VAR   i, j, k,                      (* Schleifen-Variable *)
  56.       ZufallsZahl,                  (* mischen der Karten *)
  57.       Max        : BYTE;            (* 64 .. 1 Karte      *)
  58.       SpielKarte : ARRAY[1..64] OF EineKarte;
  59.                          (* 32-mal je 2 identische Karten *)
  60.  
  61. CONST Farbe   : ARRAY [1..4] OF BYTE = (3, 4, 5, 6);
  62.              (* die Spielkarten-Farben im IBM-Zeichensatz *)
  63.       Wert    : ARRAY [1..8] OF CHAR
  64.                  = ('7', '8', '9', 'Z', 'A', 'B', 'D', 'K');
  65.                                       (* die Karten-Werte *)
  66.  
  67. (* ------------------------------------------------------ *)
  68. PROCEDURE SpielBrett;
  69.  
  70. BEGIN
  71.   ClrScr;
  72.   GotoXY (36,1); Invers;
  73.   Write (' MEMORY '); Normal;
  74.   GotoXY (16,4);  Invers;
  75.   Write ('A  B  C  D  E  F  G  H ');  Normal;
  76.   FOR i := 0 TO 7 DO BEGIN
  77.     GotoXY (11, 6 + 2 * i);  Invers;
  78.     Write (' ', Succ(i), ' ');  Normal;
  79.     FOR k := 0 TO 7 DO
  80.              (* Write (LST, SpielFeld [Succ(k) + i * 8]); *)
  81.              (* WriteLn (LST); nur zum mogeln !           *)
  82.              (* BEGIN / END nicht vergessen !             *)
  83.       ZeigKarte (k, i, RueckSeite);
  84.   END;       (* i := 0 TO 7 *)
  85. END;
  86.  
  87. (* ------------------------------------------------------ *)
  88. PROCEDURE Anzeigen;
  89.  
  90. BEGIN
  91.   Invers;
  92.   GotoXY (50,5);  Write (' Kartenwahl Spieler ');
  93.   GotoXY (50,7);  Write (' ':11);
  94.   GotoXY (50,8);  Write (' Karte 1 : ');
  95.   GotoXY (50,9);  Write (' ':11);
  96.   GotoXY (50,10); Write (' Karte 2 : ');
  97.   GotoXY (50,11); Write (' ':11);
  98.   Normal;
  99.  
  100.   GotoXY (5, 23); Write ('Punkte Spieler 1 : ', Punkte [1]);
  101.   GotoXY (5, 24); Write ('Punkte Spieler 2 : ', Punkte [2]);
  102.  
  103.   Invers; GotoXY (60, 1); Write ('Runde : ', Runde); Normal;
  104.  
  105.   GotoXY (52,23);  Write ('Eingabebeispiel : A1');
  106.   GotoXY (52,24);  Write ('Ende mit "^Q"');
  107. END;
  108.  
  109. (* ------------------------------------------------------ *)
  110. BEGIN   (* Initialisierung *)
  111.   Normal;           (* bei Farb-Monitor Farben auswaehlen *)
  112.   Max := 64;        (* der Karten-Stapel zu Beginn        *)
  113.  
  114.   i := 1;
  115.   FOR j := 1 TO 8 DO     (* 2 Spielkarten-Saetze aufbauen *)
  116.     FOR k :=1 TO 4 DO BEGIN
  117.       SpielKarte [i]    := Chr(Farbe [k]) + Wert [j];
  118.       SpielKarte [i+32] := SpielKarte [i];
  119.       i := Succ (i);
  120.     END;  (* FOR k :=1 TO 4 *)
  121.  
  122.   FOR I := 1 TO 64 DO BEGIN         (* Mischen der Karten *)
  123.     ZufallsZahl   :=  Random(Max) + 1;
  124.     SpielFeld [i] :=  SpielKarte [ZufallsZahl];
  125.     IF ZufallsZahl < Max THEN
  126.       SpielKarte [ZufallsZahl] := SpielKarte [Max];
  127.             (* gezogene Karte durch letzte Karte ersetzen *)
  128.       Max := Pred(Max);   (* Kartenstapel um 1 reduzieren *)
  129.    END;  (* FOR i := 1 TO 64 *)
  130.  
  131.    RueckSeite := Chr (177) + Chr (177);
  132.    LeereKarte := Chr (249) + Chr (249);
  133.           (* Zeichen aus dem IBM-Grafiksatz, ev. anpassen *)
  134.           (* Start-Werte *)
  135.    Punkte [1] := 0;  Punkte [2] := 0;
  136.    Spieler := 1;     Runde := 1;
  137.  
  138.    SpielBrett;
  139.    Anzeigen;
  140. END;
  141.  
  142. (* ------------------------------------------------------ *)
  143. PROCEDURE KartenWahl  (Karte : BYTE; VAR Position : BYTE);
  144.  
  145. VAR   OK, Korrekt : BOOLEAN;
  146.       Wahl1, Wahl2  : CHAR;
  147.  
  148. (* ------------------------------------------------------ *)
  149. PROCEDURE Kontrolle;
  150. (* ueberprueft eingegebenen Wert und dreht die Karte um   *)
  151.  
  152. VAR   Y, X : BYTE;
  153.  
  154. BEGIN
  155.   Korrekt := FALSE;
  156.   Y := Ord(Wahl2) - 49;  X := Ord(Wahl1) - 65;
  157.   Position := Y * 8 + X + 1;
  158.  
  159.   Korrekt := (SpielFeld [Position] <> LeereKarte);
  160.     (* vgl. PROCEDURE SpielEnde, Karte bereits abgelegt ! *)
  161.  
  162.   IF (Karte = 2) AND Korrekt THEN
  163.      Korrekt := (Position <> Position_K1);
  164.                   (* 2-mal die gleiche Karte gilt nicht ! *)
  165.  
  166.   IF Korrekt THEN
  167.     ZeigKarte (X , Y, SpielFeld [Position]);
  168.  
  169. END;
  170.  
  171. (* ------------------------------------------------------ *)
  172.  
  173. BEGIN   (* KartenWahl *)
  174.   Invers;  GotoXY (70, 5);  Write (Spieler, ' : ');  Normal;
  175.   REPEAT
  176.     IF Karte = 1 THEN BEGIN
  177.        GotoXY (62, 10); ClrEol;
  178.        GotoXY (62, 8); ClrEol
  179.     END
  180.     ELSE GotoXY (62, 10);
  181.  
  182.     REPEAT                         (* Eingabe der Spalte *)
  183.       Read (KBD, Wahl1);
  184.       Wahl1 := UpCase (Wahl1);
  185.       ok := Wahl1 IN ['A'..'H',^Q];
  186.     UNTIL ok;
  187.     IF Wahl1 = ^Q THEN Halt;
  188.     Write (Wahl1);
  189.  
  190.     REPEAT                         (* Eingabe der Zeile *)
  191.       Read (KBD,Wahl2);
  192.       ok := Wahl2 IN ['1'..'8'];
  193.     UNTIL ok;
  194.     Write (Wahl2);
  195.     Kontrolle;
  196.     IF NOT Korrekt THEN Bell
  197.   UNTIL Korrekt
  198. END;
  199.  
  200. (* ------------------------------------------------------ *)
  201. PROCEDURE Weiter;
  202.                   (* dreht die gezeigten Karten wieder um *)
  203. VAR  Karte : EineKarte;
  204.  
  205. (* ------------------------------------------------------ *)
  206. FUNCTION Zeile (Position : BYTE) : BYTE;
  207.  
  208. BEGIN   Zeile := (Position - 1) DIV 8;  END;
  209.  
  210. (* ------------------------------------------------------ *)
  211. FUNCTION Spalte (Position : BYTE) : BYTE;
  212.  
  213. BEGIN   Spalte := (Position - 1) AND 7;  END;
  214.                                       (* entspricht MOD 8 *)
  215.  
  216. (* ------------------------------------------------------ *)
  217. FUNCTION Welche (Position : BYTE) : EineKarte;
  218.  
  219. BEGIN
  220.   IF SpielFeld [Position] <> LeereKarte THEN
  221.     Welche := RueckSeite
  222.   ELSE Welche := LeereKarte;
  223. END;
  224.  
  225. (* ------------------------------------------------------ *)
  226.  
  227. BEGIN   (* Weiter *)
  228.   Invers;
  229.   GotoXY (30,25); Write (' Weiter mit RETURN ');
  230.   Normal;
  231.   REPEAT UNTIL KeyPressed;
  232.   GotoXY (1,25);  ClrEol;
  233.  
  234.   ZeigKarte (Spalte(Position_K1), Zeile(Position_K1),
  235.              Welche(Position_K1));
  236.   ZeigKarte (Spalte(Position_K2), Zeile(Position_K2),
  237.              Welche(Position_K1));
  238.  
  239. END;
  240.  
  241. (* ------------------------------------------------------ *)
  242. FUNCTION SpielEnde : BOOLEAN;
  243.  
  244. BEGIN
  245.   SpielEnde := FALSE;
  246.  
  247.   IF SpielFeld [Position_K1] =
  248.                           SpielFeld [Position_K2] THEN BEGIN
  249.  
  250.     Punkte [Spieler] := Succ (Punkte [Spieler]);
  251.     SpielFeld [Position_K1] := LeereKarte;
  252.     SpielFeld [Position_K2] := SpielFeld [Position_K1]
  253.     (* gefundene Kartenfelder mit anderem Zeichen belegen *)
  254.   END;  (* IF SpielFeld *)
  255.  
  256.   GotoXY (5, 23); Write ('Punkte Spieler 1 : ', Punkte [1]);
  257.   GotoXY (5, 24); Write ('Punkte Spieler 2 : ', Punkte [2]);
  258.  
  259.   IF Punkte [Spieler] > 15 THEN BEGIN
  260.     GotoXY (31, 24);
  261.     Invers; Write (' Sieger : Spieler', Spieler);  Normal;
  262.     SpielEnde := TRUE
  263.   END;
  264.  
  265.   IF Spieler = 2 THEN BEGIN
  266.     Runde := Succ (Runde);
  267.     Invers;  GotoXY (60, 1); Write ('Runde : ', Runde);
  268.     Normal;
  269.     Spieler := 1; END
  270.   ELSE Spieler := 2;
  271.  
  272.   Weiter;
  273. END;
  274.  
  275. (* ------------------------------------------------------ *)
  276.  
  277. BEGIN
  278.   Initialisierung;
  279.   REPEAT
  280.     KartenWahl (1, Position_K1);    (* Karte 1 *)
  281.     KartenWahl (2, Position_K2);    (* Karte 2 *)
  282.   UNTIL SpielEnde;
  283.   REPEAT UNTIL KeyPressed;
  284. END.
  285.  
  286. (* ------------------------------------------------------ *)
  287. (*                   MEMORY.PAS                           *)