home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1988 / 03 / schieb.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1988-01-08  |  9.5 KB  |  357 lines
  1. (* ------------------------------------------- *)
  2. (*                   SCHIEB.PAS                *)
  3. (* Bringen Sie die Buchstaben auf dem 6*4 Fel- *)
  4. (* der grossen Spielbrett in die vorgegebene   *)
  5. (* Reihenfolge.                                *)
  6. (* System: MS-DOS   Sprache: Turbo Pascal 3.0  *)
  7. (* CP/Mler und Atariisten beachten bitte die   *)
  8. (* Implementations-Hinweise fuer Ihre Systeme! *)
  9.  
  10. PROGRAM Schiebung;
  11.  
  12. TYPE  String24 = STRING[24];
  13.  
  14. VAR   Ist,                   (* das Spielbrett *)
  15.       Soll     : String24;   (* das Ergebnis   *)
  16.       Zug      : INTEGER;
  17.  
  18. (* ------------------------------------------- *)
  19. (* "LowVideo;" bei CP/M,                       *)
  20. (* "Write (Chr(27), 'p');" bei Atari           *)
  21.  
  22. PROCEDURE Invers;
  23. BEGIN TextColor(0); TextBackGround(15) END;
  24.  
  25. (* ------------------------------------------- *)
  26. (* "NormVideo;" bei CP/M,                      *)
  27. (* "Write (Chr(27), 'q');" bei Atari           *)
  28.  
  29. PROCEDURE Normal;
  30. BEGIN TextColor(15); TextBackGround(0) END;
  31.  
  32. (* ------------------------------------------- *)
  33.  
  34. PROCEDURE ClearScreen;
  35. BEGIN
  36.  ClrScr;  (* "Write (Chr(27), 'E');" bei Atari *)
  37. END;
  38.  
  39. (* ------------------------------------------- *)
  40.  
  41. PROCEDURE PosXY (x, y: INTEGER);
  42. BEGIN
  43.   GotoXY (x,y);
  44.   (* fuer Atari:
  45.   Write (Chr(27), 'Y' , Chr(31+y), Chr(31+x));
  46.   *)
  47. END;
  48.  
  49. (* ------------------------------------------- *)
  50.  
  51. FUNCTION my_Random (max: INTEGER): INTEGER;
  52. (* nur fuer Atari:
  53.   FUNCTION do_Random: LONG_INTEGER; XBIOS(17);
  54. *)
  55. BEGIN
  56.   my_Random := Random(max);
  57.     (* "Random" bei Atari: mit XBIOS-Funktion  *)
  58.     (* 17 und ein wenig Rechnerei, da ein Wert *)
  59.     (* im Intervall [0..Laenge-1] erforderlich *)
  60.   (*
  61.   my_Random := TRUNC(do_random/16777216.0*max);
  62.   *)
  63. END;
  64.  
  65. (* ------------------------------------------- *)
  66.  
  67. PROCEDURE TitelBild;
  68.  
  69. BEGIN
  70.   ClearScreen;
  71.   PosXY (35,1);
  72.   Invers;  Write (' SCHIEBUNG ');  Normal;
  73.   PosXY (11,22); Invers;
  74.   Write (' Bewegung mit den Pfeil-Tasten',
  75.          ' --- Schiebung mit Leer-Taste ');
  76.   PosXY (33,24);
  77.   Invers;  Write (' Ende mit "Q" '); Normal;
  78. END;
  79.  
  80. (* ------------------------------------------- *)
  81. (*    liefert die Strings 'SOLL' und 'IST'     *)
  82.  
  83. PROCEDURE Zufalls_String (VAR Zufall: String24);
  84.  
  85. VAR   Original : String24;
  86.       Laenge,
  87.       Nummer   : INTEGER;
  88.  
  89. BEGIN
  90.   Original := 'ABCDEFGHIJKLMNOPQRSTUVW';
  91.   Zufall   := '';
  92.   REPEAT
  93.     Laenge := Length (Original);
  94.     Nummer := my_Random (Laenge) + 1;
  95.     Zufall := Zufall + Original [Nummer];
  96.     Delete (Original, Nummer, 1);
  97.   UNTIL Laenge = 1;
  98.   Zufall := ' ' + Zufall
  99. END;
  100.  
  101. (* ------------------------------------------- *)
  102. (*    das Spielfeld mit dem 'IST'-String       *)
  103.  
  104. PROCEDURE zeige_Ist;
  105.  
  106.            (* Spielfeld-Koordinaten links oben *)
  107. CONST S_Offset = 7;
  108.       Z_Offset = 7;
  109.  
  110. VAR   i, j,
  111.       Zaehler,
  112.       Zeile, Spalte : INTEGER;
  113.  
  114. BEGIN
  115.   Zaehler := 0;
  116.   FOR i := 0 TO 3 DO BEGIN
  117.    Zeile  := 3 * i + Z_Offset;
  118.    FOR j := 0 TO 5 DO BEGIN
  119.      Spalte := 3 * j + S_Offset - 1;
  120.       (* erweiterter IBM-Zeichensatz, schreibt *)
  121.       (* Kaestchen um die einzelnen Buchstaben *)
  122.       (* Kann mit "+", "-" und "|" ersetzt w.  *)
  123.       PosXY (Spalte, Pred(Zeile));
  124.       Write (#218#196#191);
  125.       PosXY (Spalte, Zeile);
  126.       Write (#179#32#179);
  127.       PosXY (Spalte, Succ(Zeile));
  128.       Write (#192#196#217);
  129.                   (* Zaehler := 6 * I + 1 + J: *)
  130.       Zaehler := Succ(Zaehler);
  131.       PosXY (Succ(Spalte), Zeile);
  132.       Write (Ist [Zaehler]);
  133.      END;
  134.    END;
  135. END;
  136.  
  137. (* ------------------------------------------- *)
  138. (*     schreibt die korrekte Reihenfolge       *)
  139.  
  140. PROCEDURE zeige_Soll;
  141.  
  142. CONST S_Offset = 60;
  143.       Z_Offset = 14;
  144.  
  145. VAR   i, j,
  146.       Zaehler,
  147.       Zeile, Spalte : INTEGER;
  148.  
  149. BEGIN
  150.   PosXY (S_Offset + 5, Z_Offset - 2);
  151.   Invers;  Write (' SOLL : ');  Normal;
  152.   FOR i := 0 TO 3 DO
  153.     FOR j := 0 TO 5 DO BEGIN
  154.       Zaehler := 6 * i + 1 + j;
  155.       PosXY (j*3 + S_Offset, 2*i + Z_Offset);
  156.       Write (Soll [Zaehler]);
  157.     END;
  158. END;
  159.  
  160. (* ------------------------------------------- *)
  161.  
  162. PROCEDURE Bewegung;
  163.  
  164. CONST S_Offset = 7;
  165.       Z_Offset = 7;
  166.       LeerFeld = 32;
  167.  
  168. VAR   Taste        : CHAR;
  169.       X_Alt, Y_Alt,
  170.       X_Neu, Y_Neu,
  171.       Neu_Zaehler,
  172.       Zaehler      : INTEGER;
  173.       Delta        : 0..1;
  174.       links, rechts, oben, unten : BOOLEAN;
  175.  
  176.   (* ----------------------------------------- *)
  177.   (* Eingabe mit Cursortasten oder entsprech-  *)
  178.   (* enden Control-Codes:                      *)
  179.  
  180.   PROCEDURE HOL_ZEICHEN (VAR Eingabe : CHAR);
  181.                 (* liefert nur die CTRL-Codes, *)
  182.                 (* fuer CP/M:                  *)
  183.   (*
  184.   BEGIN Read (KBD, Eingabe) END;
  185.   *)
  186.                 (* fuer Atari ST:              *)
  187.   (*
  188.   VAR KBD: TEXT;
  189.   BEGIN
  190.     ReSet (KBD, 'CON:');  Read (KBD, Eingabe);
  191.   END;
  192.   *)
  193.                 (* fuer IBM:                   *)
  194.   BEGIN
  195.     Read (Kbd, Eingabe);
  196.     IF Eingabe = #27 THEN (* erweiterter Code? *)
  197.       IF KeyPressed THEN  (* ja -> Cursortaste *)
  198.       BEGIN
  199.         Read (Kbd, Eingabe);
  200.         CASE Eingabe OF
  201.           'H' : Eingabe := ^E;       (* hoch   *)
  202.           'K' : Eingabe := ^S;       (* links  *)
  203.           'M' : Eingabe := ^D;       (* rechts *)
  204.           'P' : Eingabe := ^X;       (* runter *)
  205.           ELSE  Eingabe := '0';
  206.        END;
  207.      END;
  208.   END;
  209.  
  210.   (* ----------------------------------------- *)
  211.  
  212.   PROCEDURE Spielstand;
  213.  
  214.   VAR Schleife,
  215.       Korrekt : INTEGER;
  216.  
  217.   BEGIN
  218.     Zug := Succ(Zug);
  219.     PosXY (60,4);  Write ('Zuege   : ');
  220.     Invers;  Write (Zug:5, ' ');  Normal;
  221.     Korrekt := 0;
  222.     FOR Schleife := 1 TO Length(Ist) DO
  223.       IF Ist [Schleife] = Soll [Schleife] THEN
  224.         Korrekt := Succ(Korrekt);
  225.     PosXY (60,7);  Write ('Korrekt : ');
  226.     Invers;  Write (Korrekt:5, ' ');  Normal;
  227.     IF Korrekt = Length (Ist) THEN BEGIN
  228.       PosXY (31,24);
  229.       Invers;
  230.       Write(' Geschafft in ', Zug, ' Zuegen ! ');
  231.       Normal;
  232.       Halt;                (* Programm beenden *)
  233.     END;
  234.   END;
  235.  
  236.   (* ----------------------------------------- *)
  237.  
  238.   PROCEDURE SchreibeBuchstabe (x, y : INTEGER);
  239.  
  240.   BEGIN
  241.     x := 3 * x + S_Offset;
  242.     y := 3 * y + Z_Offset;
  243.     PosXY (x, y); Write (Ist [Zaehler]);
  244.   END;
  245.  
  246.   (* ----------------------------------------- *)
  247.  
  248.   PROCEDURE ZeigerWechsel;
  249.  
  250.   BEGIN
  251.     SchreibeBuchstabe (X_Alt, Y_Alt);
  252.     Zaehler := X_Neu + 1 + 6 * Y_Neu;
  253.     Invers; SchreibeBuchstabe (X_Neu, Y_Neu);
  254.     Normal;
  255.   END;
  256.  
  257.   (* ----------------------------------------- *)
  258.  
  259. BEGIN (* Bewegung *)
  260.   Zug := -1;
  261.   X_Alt := 0;  Y_Alt := 0;
  262.   X_Neu := 0;  Y_Neu := 0;
  263.   Zaehler := 6 * Y_Alt + 1 + X_Alt;
  264.   Invers;  SchreibeBuchstabe (X_Alt, Y_Alt);
  265.   Normal;
  266.   Spielstand;
  267.   REPEAT
  268.     X_Alt := X_Neu;  Y_Alt := Y_Neu;
  269.     HOL_ZEICHEN (Taste);
  270.     CASE Ord(Taste) OF
  271.       4 : BEGIN
  272.             Delta := Ord ((X_Alt + 1 <= 5));
  273.             X_Neu := X_Alt + Delta;
  274.             ZeigerWechsel;
  275.           END;
  276.      19 : BEGIN
  277.             Delta := Ord ((X_Alt - 1 >= 0));
  278.             X_Neu := X_Alt - Delta;
  279.             ZeigerWechsel;
  280.           END;
  281.       5 : BEGIN
  282.             Delta := Ord ((Y_Alt - 1 >= 0));
  283.             Y_Neu := Y_Alt - Delta;
  284.             ZeigerWechsel;
  285.           END;
  286.      24 : BEGIN
  287.             Delta := Ord ((Y_Alt + 1 <= 3));
  288.             Y_Neu := Y_Alt + Delta;
  289.             ZeigerWechsel;
  290.           END;
  291.      32 : BEGIN
  292.             Zaehler := X_Neu + 1 + 6 * Y_Neu;
  293.             Neu_Zaehler := Zaehler;
  294.             (* nur wenn der Zeiger nicht im    *)
  295.             (* leeren Feld steht Kontrolle der *)
  296.             (* zulaessigen Bewegungsrichtungen:*)
  297.             IF Ord(Ist[Zaehler]) <> LeerFeld THEN
  298.             BEGIN
  299.               oben   := (Zaehler - 6 > 0);
  300.               unten  := (Zaehler + 6 <= 24);
  301.               links  := (Pred(Zaehler) MOD 6<>0);
  302.               rechts := (Zaehler MOD 6 <> 0);
  303.                          (* leeres Feld suchen *)
  304.               IF (oben AND (Ord(Ist[Zaehler - 6])
  305.                  = LeerFeld)) THEN
  306.               BEGIN
  307.                 Y_Neu := Pred(Y_Alt);
  308.                 Neu_Zaehler := Zaehler - 6;
  309.               END
  310.               ELSE
  311.               IF (unten AND (Ord(Ist[Zaehler+6])
  312.                  = LeerFeld)) THEN
  313.               BEGIN
  314.                 Y_Neu := Succ(Y_Alt);
  315.                 Neu_Zaehler := Zaehler + 6;
  316.               END
  317.               ELSE
  318.               IF (links AND (Ord(Ist[Zaehler-1])
  319.                  = LeerFeld)) THEN
  320.               BEGIN
  321.                 X_Neu := Pred(X_Neu);
  322.                 Neu_Zaehler := Pred(Zaehler);
  323.               END
  324.               ELSE
  325.               IF (rechts AND (Ord(Ist[Zaehler+1])
  326.                  = LeerFeld)) THEN
  327.               BEGIN
  328.                 X_Neu := Succ(X_Neu);
  329.                 Neu_Zaehler :=  Succ(Zaehler);
  330.               END;
  331.               IF Neu_Zaehler <> Zaehler THEN BEGIN
  332.                 Ist [Neu_Zaehler] := Ist [Zaehler];
  333.                 Ist [Zaehler] := ' ';
  334.                 SchreibeBuchstabe (X_Alt, Y_Alt);
  335.                 Zaehler := Neu_Zaehler;
  336.                 Invers;
  337.                 SchreibeBuchstabe (X_Neu, Y_Neu);
  338.                 Normal;
  339.                 Spielstand;
  340.               END;
  341.             END;
  342.           END; (* CASE ' ' *)
  343.     END; (* CASE *)
  344.   UNTIL Taste IN ['Q','q'];
  345. END;
  346.  
  347. (* ------------------------------------------- *)
  348.  
  349. BEGIN
  350.  TitelBild;
  351.  Zufalls_String (Ist);
  352.  Zufalls_String (Soll);
  353.  zeige_Ist;
  354.  zeige_Soll;
  355.  BEWEGUNG;
  356. END.
  357.