home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / spezial / 06 / schieb / schieb.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1988-10-12  |  9.4 KB  |  319 lines
  1. PROGRAM SCHIEBUNG;
  2. (*  System   : MS-DOS       Sprache   : Turbo Pascal 4.0  *)
  3. (* V.1.0.a - 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;
  9. (* in Spielegraph : GraphDir an die eigenen Verzeichnisse anpassen ! *)
  10. TYPE    STRING24  = STRING[24];
  11.  
  12. VAR     Ist,                       (* das Spielbrett *)
  13.         Soll      : STRING24;      (* das Ergebnis   *)
  14.         Zug       : INTEGER;
  15.  
  16. CONST   StartX : INTEGER = 20;
  17.         DeltaX : INTEGER = 21;
  18.         Zeilen : INTEGER = 4;
  19.         StartY : INTEGER = 40;
  20.         DeltaY : INTEGER = 21;
  21.         Spalten: INTEGER = 6;
  22. (*-----------------------------------------------*)
  23. FUNCTION Wirklich (Frage : STRING) : BOOLEAN;
  24. (* Ja oder Nein *)
  25. VAR Ch    : CHAR;
  26.  
  27. BEGIN
  28.   SetViewPort (MinX+1, MaxY-19, MaxX-1, MaxY-1, ClipOff);
  29.   ClearViewPort;
  30.   SetColor (1);  OutTextXY (5, 1, Frage);
  31.  
  32.   REPEAT
  33.     Ch := ReadKey
  34.   UNTIL UpCase (Ch) IN ['J', 'N'];
  35.   Wirklich := Ch IN ['J', 'j'];
  36. END;
  37. (*-----------------------------------------------*)
  38. PROCEDURE Init;
  39. VAR     X, Y : INTEGER;
  40. CONST   DX   : INTEGER = 5;
  41.         DY   : INTEGER = 5;
  42.  
  43. BEGIN
  44.   GraphikInit (CGA, CGAC2);
  45.   SetTextStyle (SmallFont, HorizDir, 4);
  46.  
  47.   (* Spielfeld farbig einteilen *)
  48.   SetFillStyle (1, 2);  BAR (MinX, MinY, MaxX, 15);
  49.   SetFillStyle (1, 3);  BAR (MinX, 16, 200, MaxY-20);
  50.   SetFillStyle (1, 1);  SetColor (2);
  51.    BAR3D (MinX, MaxY-20, MaxX, MaxY, 0, TopOff);
  52.   SetColor (0); Bar3D (201, 16, MaxX, 85, 0, TopOff);
  53.   SetColor (0); SetFillStyle (1, 2); BAR3D (201, 85, MaxX, MaxY - 21, 0, TopOff);
  54.  
  55.   (* Beschriftung *)
  56.   SetColor (3); OutTextXY (130, 1, 'S c h i e b u n g');
  57.   SetColor (0);
  58.   OutTextXY (15, 180,
  59.             'Bewegung : Pfeil-Tasten --- Schiebung : Leer-Taste');
  60.   OutTextXY (15, 189, 'ENDE     : "CTRL-Q" ');
  61.   SetColor (0);   OutTextXY (220, 30, 'Zuege   :');
  62.           OutTextXY (220, 60, 'Korrekt :');
  63.   SetColor (0);   OutTextXY (250, 90, 'SOLL :');
  64.  
  65.   (* Spielfeld aufbauen *)
  66.    (* Schatten *)
  67.   SetFillStyle (1, 2);
  68.   Bar (StartX + DX, StartY + DY,
  69.       StartX + Spalten * DeltaX + DX, StartY + Zeilen * DeltaY + DY);
  70.    (* Spielfeld *)
  71.   SetColor (1);
  72.   MachRaster (StartX, Spalten, DeltaX, StartY, Zeilen, DeltaY, FALSE);
  73.  
  74.    (* Spielfeld  -  Rechtecke *)
  75.   SetColor (0);
  76.   FOR X := 0 TO 5 DO
  77.     FOR Y := 0 TO 3 DO
  78.       Bar3D (StartX + DeltaX * X + 1, StartY + DeltaY * Y + 1,
  79.          StartX + DeltaX * X + 20, StartY + DeltaY * Y + 20, 0, TopOff);
  80.  
  81. END;
  82. (*-----------------------------------------------*)
  83. (* liefert die beiden Strings 'SOLL' und 'IST'   *)
  84. PROCEDURE ZufallsString (VAR  Zufall : STRING24);
  85. (* Tip für Sprite-Freunde :                        *)
  86. (* 24 (!) Sprites basteln und diese als ARRAY zur  *)
  87. (* Verfügung stellen. Die PRC "ZufallsString kann  *)
  88. (* man belassen, in ZeigeIst, ZeigeSoll und den    *)
  89. (* anderen PRC in "Bewegung" zeigt man die Ist u.  *)
  90. (* Soll-Arrays mit den Sprite-Befehlen statt mit   *)
  91. (* OutTextXY.                                      *)
  92.  
  93. VAR    Original   : STRING24;
  94.        Laenge,
  95.        Nummer     : INTEGER;
  96.  
  97. BEGIN
  98.   Original := 'ABCDEFGHIJKLMNOPQRSTUVW';
  99.   Zufall   := '';
  100.  
  101.   REPEAT
  102.     Laenge   := LENGTH (Original);
  103.     Nummer   := RANDOM (Laenge) + 1;
  104.     Zufall   := Zufall + Original [Nummer];
  105.     DELETE (Original, Nummer, 1);
  106.   UNTIL Laenge = 1;
  107.  
  108.   Zufall := ' ' + Zufall
  109. END;
  110. (*-----------------------------------------------*)
  111. (* das Spielfeld mit dem 'IST'-String            *)
  112. PROCEDURE ZeigeIst;
  113.  
  114. VAR      I, J,
  115.          Zaehler,
  116.          Zeile, Spalte : INTEGER;
  117.  
  118. BEGIN
  119.   Zaehler := 1;
  120.   FOR I := 0 TO 3 DO BEGIN
  121.    Zeile  := StartY + 7 + DeltaY * I;
  122.    FOR J := 0 TO 5 DO
  123.      BEGIN
  124.        Spalte := StartX + 9 + DeltaX * J;
  125.        OutTextXY (Spalte, Zeile, Ist [Zaehler]);
  126.        Zaehler := SUCC(Zaehler);   (* Zaehler := 6 * I + 1 + J; *)
  127.      END;   (* FOR J := 0 *)
  128.    END;     (* FOR I := 0 *)
  129. END;
  130. (*-----------------------------------------------*)
  131. (* schreibt die korrekte Reihenfolge             *)
  132. PROCEDURE ZeigeSoll;
  133.  
  134. VAR      I, J,
  135.          Zaehler,
  136.          Zeile, Spalte : INTEGER;
  137.  
  138. CONST    X1 : INTEGER = 219;
  139.          X2 : INTEGER = 319;
  140.      Y1 : INTEGER = 105;
  141.      Y2 : INTEGER = 170;
  142.  
  143. BEGIN
  144.   (* Schatten *)
  145.   SetColor (3);   SetFillStyle (1, 3); BAR (213, 108, 313, 173);
  146.   (* Feld *)
  147.   SetColor (2);  SetFillStyle (11, 2); BAR (210, 105, 310, 170);
  148.  
  149.   (* Soll-Werte *)
  150.   SetColor (3);
  151.   FOR I := 0 TO 3 DO
  152.     BEGIN
  153.       Zeile  := 110 + 15 * I;
  154.       FOR J := 0 TO 5 DO
  155.         BEGIN
  156.           Spalte := 220 + 15 * J;
  157.           Zaehler := 6 * I + 1 + J;
  158.           OutTextXY (Spalte, Zeile, Soll [Zaehler]);
  159.         END;   (* FOR J := 0 *)
  160.     END;       (* FOR I := 0 *)
  161.  
  162. END;
  163. (*-----------------------------------------------*)
  164. PROCEDURE Bewegung;
  165.  
  166. CONST    LeerFeld     : INTEGER = 32;
  167. VAR      Taste        : Char;
  168.          X_Alt, Y_Alt,
  169.          X_Neu, Y_Neu,
  170.          Neu_Zaehler,
  171.          Zaehler      : INTEGER;
  172.          Delta        : 0..1;
  173.          LINKS, RECHTS, OBEN, UNTEN : BOOLEAN;
  174. (*-----------------*)
  175. PROCEDURE Spielstand;
  176.  
  177. VAR    Schleife,
  178.        X, Y       : INTEGER;
  179. CONST  Korrekt    : INTEGER = 0;   (* alter Wert wird beibehalten *)
  180.  
  181. BEGIN
  182.   SetColor (1);   OutTextXY (270, 30, Int2Str (Zug,4));
  183.   Zug := SUCC(Zug);
  184.   SetColor (0);   OutTextXY (270, 30, Int2Str (Zug,4));
  185.  
  186.   SetColor (1);   OutTextXY (270, 60, Int2Str (Korrekt,4));
  187.   Korrekt := 0;
  188.   FOR Schleife := 1 TO LENGTH(Ist) DO
  189.       IF Ist [Schleife] = Soll [Schleife] THEN Korrekt := SUCC(Korrekt);
  190.   SetColor (2);   OutTextXY (270, 60, Int2Str (Korrekt,4));
  191.  
  192.   IF Korrekt = LENGTH (Ist) THEN
  193.      BEGIN
  194.     Beep (200, 25);
  195.         SetColor (2);
  196.     OutTextXY (20, 150, 'Geschafft in '+ Int2Str(Zug,3) + ' Zuegen !');
  197.         Taste := ^Q;
  198.      END;
  199.   SetColor (0);
  200. END;
  201. (*-----------------*)
  202. PROCEDURE SchreibeBuchstabe (X, Y : INTEGER);
  203.  
  204. BEGIN
  205.   X := StartX + 9 + DeltaX * X;
  206.   Y := StartY + 7 + DeltaY * Y;
  207.   OutTextXY (X, Y, Ist [Zaehler]);
  208. END;
  209. (*-----------------*)
  210. PROCEDURE ZeigerWechsel;
  211.  
  212. BEGIN
  213.   (* alten Wert anschreiben *)
  214.   Setcolor (0); SetFillStyle (1,2);
  215.   Bar3D (StartX+21*X_Alt+1, StartY+21*Y_Alt+1,
  216.      StartX+21*X_Alt+20, StartY+21*Y_Alt+20,0,TopOff);
  217.   SetColor (0);  SchreibeBuchstabe (X_Alt, Y_Alt);
  218.  
  219.   Zaehler := X_Neu + 1 + 6 * Y_Neu;
  220.  
  221.   (* neuen Wert anschreiben *)
  222.   SetColor (0); SetFillStyle (1,3);
  223.   Bar3D (StartX+21*X_Neu+1, StartY+21*Y_Neu+1,
  224.      StartX+21*X_Neu+20, StartY+21*Y_Neu+20,0,TopOff);
  225.   SetColor (1);  SchreibeBuchstabe (X_Neu, Y_Neu);
  226. END;
  227. (*-----------------*)
  228. BEGIN  (* Bewegung *)
  229.   Zug := -1;
  230.   X_Alt := 0; Y_Alt := 0;
  231.   X_Neu := 0; Y_Neu := 0;
  232.   ZeigerWechsel;
  233.   Spielstand;
  234.  
  235. REPEAT
  236.  X_Alt := X_Neu;  Y_Alt := Y_Neu;
  237.  HolZeichen (Taste);
  238.  CASE Taste OF
  239.   ^D : BEGIN    (* rechts *)
  240.          Delta := ORD ((X_Alt + 1 <= 5));
  241.          X_Neu := X_Alt + Delta;
  242.          ZeigerWechsel;
  243.       END;
  244.  ^S : BEGIN     (* links *)
  245.          Delta := ORD ((X_Alt - 1 >= 0));
  246.          X_Neu := X_Alt - Delta;
  247.          ZeigerWechsel;
  248.       END;
  249.   ^E : BEGIN    (* oben *)
  250.          Delta := ORD ((Y_Alt - 1 >= 0));
  251.          Y_Neu := Y_Alt - Delta;
  252.          ZeigerWechsel;
  253.       END;
  254.  ^X : BEGIN     (* unten *)
  255.          Delta := ORD ((Y_Alt + 1 <= 3));
  256.          Y_Neu := Y_Alt + Delta;
  257.          ZeigerWechsel;
  258.       END;
  259.  ' ' : BEGIN    (* Schiebung *)
  260.          Zaehler := X_Neu + 1 + 6 * Y_Neu;
  261.          Neu_Zaehler := Zaehler;
  262.  
  263.          IF ORD(Ist [Zaehler]) <> LeerFeld THEN
  264.           (* nur wenn der Zeiger nicht im leeren Feld steht *)
  265.           (* Kontrolle der zulaessigen Bewegungsrichtungen  *)
  266.            BEGIN
  267.              OBEN   := (Zaehler - 6 > 0);
  268.              UNTEN  := (Zaehler + 6 <= 24);
  269.              LINKS  := (PRED(Zaehler) MOD 6 <> 0);
  270.              RECHTS := (Zaehler MOD 6 <> 0);
  271.  
  272.                (* leeres Feld suchen *)
  273.              IF (OBEN AND (ORD(Ist [Zaehler - 6]) = LeerFeld)) THEN
  274.                BEGIN
  275.                  Y_Neu := PRED(Y_Alt);    Neu_Zaehler := Zaehler - 6;
  276.                END
  277.              ELSE
  278.              IF (UNTEN  AND (ORD(Ist [Zaehler + 6]) = LeerFeld)) THEN
  279.                BEGIN
  280.                  Y_Neu := SUCC(Y_Alt);    Neu_Zaehler := Zaehler + 6;
  281.                 END
  282.              ELSE
  283.              IF (LINKS  AND (ORD(Ist [PRED(Zaehler)]) = LeerFeld)) THEN
  284.                BEGIN
  285.                  X_Neu := PRED(X_Neu);   Neu_Zaehler := PRED(Zaehler);
  286.                END
  287.              ELSE
  288.              IF (RECHTS AND (ORD(Ist [SUCC(Zaehler)]) = LeerFeld)) THEN
  289.                BEGIN
  290.                  X_Neu := SUCC(X_Neu);  Neu_Zaehler :=  SUCC(Zaehler);
  291.                END;
  292.  
  293.              IF Neu_Zaehler <> Zaehler THEN
  294.                BEGIN
  295.                  Ist [Neu_Zaehler] := Ist [Zaehler];
  296.                  Ist [Zaehler] := ' ';
  297.          Zeigerwechsel;
  298.                  Zaehler := Neu_Zaehler;
  299.                  Spielstand;   IF Taste = ^Q THEN EXIT;
  300.              END; (* IF Neu_Zaehler <> Zaehler *)
  301.          END;     (* IF ORD(Ist [Zaehler]) <> LeerFeld *)
  302.        END;       (* CASE ' ' *)
  303.   END;            (* CASE Taste OF *)
  304. UNTIL Taste = ^Q
  305.  
  306. END;  (* Bewegung *)
  307. (*-----------------------------------------------*)
  308. BEGIN
  309.  REPEAT
  310.    Init;
  311.    ZufallsString (Ist);
  312.    ZufallsString (Soll);
  313.    ZeigeIst;
  314.    ZeigeSoll;
  315.    Bewegung;
  316.  UNTIL NOT Wirklich ('Noch ein Spiel ? <J> / <N> : ');
  317.  GraphikEnde;
  318. END.
  319.