home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / spezial / 06 / spielegr.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-10-12  |  9.7 KB  |  304 lines
  1. UNIT SpieleGraph;
  2. (* UNIT mit allgemeinen Routinen für die Spieleprogrammierung *)
  3. (* 12.10.1988 *)
  4.  
  5. INTERFACE
  6.  
  7. USES
  8.   CRT, Graph;
  9.  
  10. CONST
  11.      MinX = 0;              (* Bildschirm links *)
  12.      MinY = 0;              (* Bildschirm oben  *)
  13.  
  14. VAR   MaxFarbe,                (* Verfuegbare Farben *)
  15.       MaxX, MaxY   : INTEGER;  (* Bildschirm-Koordinaten *)
  16.       Space        : POINTER;  (* Leerzeichen fuer Grafik-Texte *)
  17.       EndX, EndY : INTEGER;    (* rechte bzw. untere Linie des Editierfeldes *)
  18.  
  19. TYPE  Bild         = RECORD
  20.                        BildPtr  : POINTER;
  21.                        Vorh     : BOOLEAN;
  22.                      END;
  23.  
  24. VAR   Screen       : ARRAY [1..3] OF Bild;
  25.                         (* [1] speichert Editier-Bild   *)
  26.                         (* [2] speichert ArbeitsBild    *)
  27.             (* [3] speichert Kollektor-Bild *)
  28. (* vor dem ersten Aufruf "Screen.Vorh" unbedingt auf FALSE Setzen ! *)
  29.  
  30. VAR   GraphDriver,
  31.       GraphMode     : INTEGER;
  32.  
  33. CONST GraphDir      : STRING = 'D:\TP\Grafik';
  34.       (* Verzeichnis mit Graphik-Treibern ! ANPASSEN !! *)
  35.  
  36. PROCEDURE GraphikInit  (GraphDriver, GraphMode : INTEGER);
  37. PROCEDURE GraphikEnde;
  38. FUNCTION Int2Str (Zahl, Stellen : INTEGER) : STRING;
  39. FUNCTION SaveGraphikScreen (Links, Oben, Rechts, Unten : INTEGER;
  40.                             DateiName : STRING) : INTEGER;
  41. FUNCTION LoadGraphikScreen (Links, Oben, Rechts, Unten : INTEGER;
  42.                             DateiName : STRING) : INTEGER;
  43. PROCEDURE ScreenToRam (Nr : INTEGER);
  44. PROCEDURE RamToScreen (Nr : INTEGER);
  45. PROCEDURE PortToRam (Links, Oben, Rechts, Unten, Nr : INTEGER);
  46. PROCEDURE RamToPort (Links, Oben, Nr : INTEGER);
  47. PROCEDURE HolZeichen (VAR Eingabe : CHAR);
  48. PROCEDURE HolString (VAR Text : STRING; Laenge : INTEGER);
  49. PROCEDURE SchreibSpace (Hori, Verti : INTEGER);
  50. PROCEDURE Beep  (Ton, Dauer : INTEGER);
  51. PROCEDURE MachRaster
  52.            (StartX, Spalten, DeltaX, StartY, Zeilen, DeltaY : INTEGER;
  53.         Kennung : BOOLEAN);
  54. PROCEDURE Invers;
  55. PROCEDURE Normal;
  56. (*-----------------------------------------------*)
  57. IMPLEMENTATION
  58. (*-----------------------------------------------*)
  59. PROCEDURE GraphikInit  (GraphDriver, GraphMode : INTEGER);
  60. (* setzt Graphikmodus *)
  61. VAR   GraphikFehler  : INTEGER;
  62.  
  63. BEGIN
  64.   DirectVideo := FALSE;
  65.  
  66.   InitGraph (GraphDriver, GraphMode, GraphDir);
  67.  
  68.   GraphikFehler := GraphResult;
  69.   IF GraphikFehler <> GrOK THEN
  70.      BEGIN
  71.        WRITELN ('Graphik-Fehler : ', GraphErrorMsg (GraphikFehler));
  72.        WRITE   ('Das Programm wird abgebrochen !');
  73.        HALT (1);
  74.      END;
  75.  
  76.   MaxFarbe := GetMaxColor;
  77.   MaxX := GetMaxX;  MaxY := GetMaxY;
  78.  
  79.   GetMem (Space, ImageSize (0,0,7,7)); GetImage (0,0,7,7, Space^);
  80.   (* Space-Zeichen für die Grafik-Ausgabe *)
  81.   Screen [1].Vorh := FALSE;   Screen [2].Vorh := FALSE;
  82.   Screen [3].Vorh := FALSE;
  83. END;
  84. (*-----------------------------------------------*)
  85. PROCEDURE GraphikEnde;
  86. (* von der Graphik wieder in den Text-Modus zurück *)
  87. BEGIN
  88.   CloseGraph;
  89.   TextMode (C80);
  90.   DirectVideo := TRUE;
  91. END;
  92. (*-----------------------------------------------*)
  93. (*-----------------------------------------------*)
  94. FUNCTION Int2Str (Zahl, Stellen : INTEGER) : STRING;
  95. (* Umwandlung für OutChar *)
  96. VAR S: STRING;
  97. BEGIN   STR (Zahl:Stellen, S); Int2Str := S; END;
  98. (*-----------------------------------------------*)
  99. FUNCTION SaveGraphikScreen (Links, Oben, Rechts, Unten : INTEGER;
  100.                             DateiName : STRING) : INTEGER;
  101. (* Sprite auf Disk. speichern *)
  102. (* man kann auch den ganzen Bildschirminhalt abspeichern *)
  103. (* korrekt, wenn Ergebnis = 0 *)
  104. VAR   BildGroesse : INTEGER;
  105.       BildPtr     : POINTER;
  106.       Hilf        : INTEGER;
  107.       Datei       : FILE;
  108. (*------------------*)
  109. PROCEDURE ScreenToPointer;
  110.  
  111. BEGIN
  112.   BildGroesse := ImageSize (Links, Oben, Rechts, Unten);
  113.   GetMem (BildPtr, BildGroesse);
  114.   GetImage (Links, Oben, Rechts, Unten, BildPtr^);
  115. END;
  116. (*------------------*)
  117. BEGIN (* SaveGraphikScreen *)
  118.   ScreenToPointer;
  119.   ASSIGN (Datei, DateiName);
  120.   {$I-} REWRITE (Datei, 1); {$I+}
  121.   Hilf := IOResult;  SaveGraphikScreen := Hilf;
  122.   IF Hilf <> 0 THEN EXIT;
  123.    (* Fehlermeldung kann man noch ergänzen *)
  124.   BlockWrite (Datei, BildPtr^, BildGroesse);
  125.   CLOSE (Datei);
  126. END;
  127. (*-----------------------------------------------*)
  128. FUNCTION LoadGraphikScreen (Links, Oben, Rechts, Unten : INTEGER;
  129.                             DateiName : STRING) : INTEGER;
  130.  
  131. (* Aufruf z. B. mit
  132.   IF LoadGraphikScreen (0,0, GetMaxX, GetMaxY, 'D:test1.scr') <> 0 THEN
  133.      BEGIN CloseGraph; WRITE (fehlermeldung); END;  *)
  134.  
  135. VAR    BildGroesse : INTEGER;
  136.        BildPtr     : POINTER;
  137.        Hilf        : INTEGER;
  138.        Datei       : FILE;
  139.  
  140. BEGIN (* LoadGraphikScreen *)
  141.   BildGroesse := ImageSize (Links, Oben, Rechts, Unten);
  142.   GetMem (BildPtr, BildGroesse);
  143.   ASSIGN (Datei, DateiName);
  144.   {$I-} RESET (Datei, 1); {$I+}
  145.   Hilf := IOResult;  LoadGraphikScreen := Hilf;
  146.   IF Hilf <> 0 THEN EXIT;
  147.   BlockRead (Datei, BildPtr^, BildGroesse);
  148.   CLOSE (Datei);
  149.   PutImage (MinX, MinY, BildPtr^, NormalPut);
  150. END;
  151. (*-----------------------------------------------*)
  152. PROCEDURE ScreenToRam (Nr : INTEGER);
  153. (* Bildschirminhalt im RAM ablegen *)
  154. (* ScreenToRam u. PortToRam lassen sich natürlich zusammenfassen  *)
  155. (* so ist es aber im Hauptprogramm etwas leichter nachvollziehbar *)
  156.  
  157. VAR   Groesse : INTEGER;
  158.  
  159. BEGIN
  160.   Groesse := ImageSize (MinX, MinY, MaxX, MaxY);
  161.   IF Screen [Nr].Vorh THEN
  162.              FreeMem (Screen [Nr].BildPtr, Groesse);
  163.  
  164.   GetMem (Screen [Nr].BildPtr, Groesse);
  165.   GetImage (MinX, MinY, MaxX, MaxY, Screen [Nr].BildPtr^);
  166.   Screen [Nr].Vorh := TRUE;
  167. END;
  168. (*-----------------------------------------------*)
  169. PROCEDURE RamToScreen (Nr : INTEGER);
  170. (* vom RAM auf den Bildschirm *)
  171. BEGIN
  172.    IF Screen [Nr].Vorh THEN
  173.        PutImage (MinX, MinY, Screen [Nr].BildPtr^, NormalPut);
  174. END;
  175. (*-----------------------------------------------*)
  176. PROCEDURE PortToRam (Links, Oben, Rechts, Unten, Nr : INTEGER);
  177. (* Bildschirmausschnitt im RAM ablegen *)
  178. VAR   Groesse : INTEGER;
  179.  
  180. BEGIN
  181.   Groesse := ImageSize (Links, Oben, Rechts, Unten);
  182.   IF Screen [Nr].Vorh THEN
  183.              FreeMem (Screen [Nr].BildPtr, Groesse);
  184.  
  185.   GetMem (Screen [Nr].BildPtr, Groesse);
  186.   GetImage (Links, Oben, Rechts, Unten, Screen [Nr].BildPtr^);
  187.   Screen [Nr].Vorh := TRUE;
  188. END;
  189. (*-----------------------------------------------*)
  190. PROCEDURE RamToPort (Links, Oben, Nr : INTEGER);
  191. (* vom RAM auf den Bildschirm *)
  192. BEGIN
  193.    IF Screen [Nr].Vorh THEN
  194.        PutImage (Links, Oben, Screen [Nr].BildPtr^, NormalPut);
  195. END;
  196. (*-----------------------------------------------*)
  197. PROCEDURE HolZeichen (VAR Eingabe : CHAR);
  198. (* 1 Zeichen inklusive einiger Scan-Codes *)
  199. BEGIN
  200.    Eingabe := ReadKey;
  201.    IF Eingabe = #0 THEN IF KEYPRESSED THEN  (* IBM-Scan-Code *)
  202.      BEGIN
  203.        Eingabe := ReadKey;
  204.        CASE Eingabe OF
  205.           'H' : Eingabe := ^E; (* Cursor hoch   *)
  206.           'K' : Eingabe := ^S; (* Cursor links  *)
  207.           'M' : Eingabe := ^D; (* Cursor rechts *)
  208.           'P' : Eingabe := ^X; (* Cursor tief   *)
  209.           'G' : Eingabe := ^W; (* Home          *)
  210.           'O' : Eingabe := ^C  (* End           *)
  211.          ELSE Eingabe := '0';
  212.       END;
  213.     END
  214. END;
  215. (*-----------------------------------------------*)
  216. PROCEDURE HolString (VAR Text : STRING; Laenge : INTEGER);
  217. (* Texteingabe im Graph-Modus, Korrektur mit BackSpace .. *)
  218. (* .. Abbruch mit ESC                                     *)
  219.  
  220. VAR  Zeichen : CHAR;
  221.  
  222. BEGIN
  223.   Text := '';
  224.   REPEAT
  225.     Zeichen := ReadKey;
  226.     IF (Zeichen >= ' ') AND (BYTE (Text [0]) < Laenge) THEN
  227.     BEGIN
  228.       Text := Text + Zeichen; OutText (Zeichen);
  229.     END
  230.     ELSE IF (Zeichen = #8) THEN    (* BackSpace *)
  231.       IF Text [0] > #0 THEN
  232.       BEGIN
  233.         MoveRel (-8, 0);
  234.         PutImage (GetX, GetY, Space^, NormalPut);
  235.         DEC (Byte (Text [0]));
  236.       END;
  237.     IF Zeichen = #27 THEN Text := '';
  238.   UNTIL (Zeichen = #13) OR (Zeichen = #27);
  239.  
  240. END;
  241. (*-----------------------------------------------*)
  242. PROCEDURE SchreibSpace (Hori, Verti : INTEGER);
  243. BEGIN
  244.   MoveTo (Hori, Verti);
  245.   PutImage (GetX,GetY,Space^,NormalPut);
  246. END;
  247. (*-----------------------------------------------*)
  248. PROCEDURE Beep  (Ton, Dauer : INTEGER);
  249.  
  250. BEGIN
  251.   SOUND (Ton);   DELAY (Dauer);  NoSound;
  252. END;
  253. (*-----------------------------------------------*)
  254. PROCEDURE MachRaster
  255.            (StartX, Spalten, DeltaX, StartY, Zeilen, DeltaY : INTEGER;
  256.         Kennung : BOOLEAN);
  257.  
  258. (* baut ein Spielfeld aus Rechtecken auf *)
  259.  
  260. VAR  Schleife, Hilf : INTEGER;
  261.  
  262. BEGIN
  263.   EndX := StartX + Spalten * DeltaX;
  264.   EndY := StartY + Zeilen * DeltaY;
  265.  
  266.   (* waagrechte Linien *)
  267.   Schleife := 0;
  268.   WHILE Schleife <= Zeilen DO
  269.     BEGIN
  270.       Hilf := StartY + DeltaY * Schleife;
  271.       Line (StartX, Hilf, EndX, Hilf);
  272.       INC (Schleife, 1);
  273.     END;
  274.  
  275.   (* senkrechte Linien *)
  276.   Schleife := 0;
  277.   WHILE Schleife <= Spalten DO
  278.     BEGIN
  279.       Hilf := StartX + DeltaX * Schleife;
  280.       Line (Hilf, StartY, Hilf, EndY);
  281.       INC (Schleife, 1);
  282.     END;
  283.  
  284.   IF Kennung THEN BEGIN
  285.      FOR Schleife := 1 TO Spalten DO
  286.        OutTextXY (StartX + DeltaX * Schleife - DeltaX DIV 2,
  287.           StartY - 12, CHR(64 + Schleife));
  288.  
  289.     FOR Schleife := 1 TO Zeilen DO
  290.        OutTextXY (StartX - 10, StartY + DeltaY * Schleife - DeltaY DIV 2,
  291.           Int2Str (Schleife, 1));
  292.   END;   (* IF Kennung *)
  293.  
  294. END;
  295. (*-----------------------------------------------*)
  296. PROCEDURE Invers;
  297.  BEGIN TextColor(0); TextBackGround(14) END;
  298. (*-----------------------------------------------*)
  299. PROCEDURE Normal;
  300.  BEGIN TextColor(14); TextBackGround(0) END;
  301. (*-----------------------------------------------*)
  302. BEGIN
  303. END.
  304. (*-----------------------------------------------*)