home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / spezial / 06 / spred.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-10-12  |  31.7 KB  |  1,057 lines
  1. PROGRAM SpriteEditor;
  2. (* Programm zum Erstellen von Sprites für CGA-Karte im 320*200-Modus *)
  3.  
  4. (* V.1.0.c - 12.10.88 *)
  5.  
  6. {$R+,S+,I+,D+,T-,F+,V+,B+,N-,L+ }
  7. {$M 16384,0,655360 }
  8. (* die Compiler-Optionen werden mit CTRL-F7 in den Quelltext übernommen *)
  9.  
  10. USES
  11.   CRT, Graph, SpieleGraph;
  12. (* in Spielegraph GraphDir an die eigenen Verzeichnisse anpassen ! *)
  13. CONST
  14.   StartX  : INTEGER = 8;    (* Editierfeld linke Linie           *)
  15.   Spalten : INTEGER = 24;   (*             max. 24 Spalten breit *)
  16.   DeltaX  : INTEGER = 8;    (*             8 Pixel / Spalte      *)
  17.  
  18.   StartY : INTEGER = 18;    (* Editierfeld obere Linie           *)
  19.   Zeilen : INTEGER = 16;    (*             max. 16 Zeilen hoch   *)
  20.   DeltaY : INTEGER = 9;     (*             9 Pixel / Zeile       *)
  21.  
  22.   Offset : INTEGER = 4;     (* Byte 1..4 = Sprite-Abmessungen    *)
  23.  
  24.   TempFile : STRING = 'Sprite.TMP';
  25.       (* ^ zur "Zwischenlagerung" beim Spiegeln; *)
  26.       (*   eine RamDisk ist hier recht nützlich   *)
  27.  
  28. VAR   AktFarbe,                 (* aktuelle Farbe     *)
  29.       HgFarbe,                  (* Hintergrund-Farbe  *)
  30.       SprFLinks,                (* Koordinaten des Sprite-Fensters .. *)
  31.       SprFOben,                 (* .. = in der Ecke rechts unten ..   *)
  32.       SprFRechts,               (* .. *)
  33.       SprFUnten,                (* .. *)
  34.       AktSpalten,               (* gewaehlte Abmessungen .. *)
  35.       AktZeilen    : INTEGER;   (* .. des Sprites           *)
  36. (*-----------------------------------------------*)
  37. PROCEDURE ViewPort (VPNummer : INTEGER);
  38. (* Feld-Grenzen festlegen *)
  39. BEGIN
  40.   SetColor (MaxFarbe);
  41.   CASE VPNummer OF
  42.     1: BEGIN   (* EingabeFenster *)
  43.          SetViewPort (StartX + 1, EndY + 5,
  44.                   EndX - 1, EndY + 13 + 2 * DeltaY, ClipOn);
  45.          ClearViewPort;
  46.        END;
  47.     2: BEGIN   (* ges. Bildschirm *)
  48.      SetViewPort (MinX, MinY, MaxX, MaxY, ClipOn);
  49.        END;
  50.     3: BEGIN   (* SpriteFenster *)
  51.      SetViewPort (SprFLinks + 2,  SprFOben + 2,
  52.                       SprFRechts - 2, SprFUnten - 2, ClipOn);
  53.        END;
  54.  
  55.  END;  (* CASE VPNummer *)
  56.  
  57. END;
  58. (*-----------------------------------------------*)
  59. FUNCTION HolFileName (Ext : STRING) : STRING;
  60. (* Eingabe des Namens, eine Extension wird vorgegeben *)
  61. (* Beachten : bei einer UNIT (PRC MachUnit steht dieser Name in der ersten *)
  62. (* Zeile, ein hier ev. angegeb. Unterverzeichnis muss später "von Hand"    *)
  63. (* gelöscht werden !                                            *)
  64. VAR Temp : STRING;
  65.  
  66. BEGIN
  67.   ViewPort (1);
  68.   OutTextXY (10, 6, 'Filename : ');
  69.   MoveTo (10,16);
  70.   HolString (Temp, 20);
  71.   IF Temp = '' THEN Beep (200,40);
  72.   IF (POS( '.', Temp) = 0) AND (Temp <> '') THEN Temp := Temp + Ext;
  73.   HolFileName := Temp;
  74.   ClearViewPort;
  75.   ViewPort (2);
  76. END;
  77. (*-----------------------------------------------*)
  78. FUNCTION Wirklich (Frage : STRING) : BOOLEAN;
  79. (* Ja oder Nein *)
  80. VAR Ch    : CHAR;
  81.  
  82. BEGIN
  83.   ViewPort (1);
  84.   OutTextXY (5, 6, Frage);
  85.  
  86.   REPEAT
  87.     Ch := ReadKey
  88.   UNTIL UpCase (Ch) IN ['J', 'N'];
  89.   ClearViewPort;
  90.   ViewPort (2);
  91.   Wirklich := Ch IN ['J', 'j'];
  92. END;
  93. (*-----------------------------------------------*)
  94. PROCEDURE Abbruch;
  95. (* akustische Fehlermeldung, man könnte noch zusätzlich auf Text .. *)
  96. (* .. umschalten und den Fehler mitteilen                           *)
  97. BEGIN
  98.   Beep (300,100);   Beep (500,150);
  99.   ViewPort (2);
  100. END;
  101. (*-----------------------------------------------*)
  102. PROCEDURE Dimensionierung (VAR Sprite : POINTER; VAR Groesse : INTEGER);
  103. (* Sprite mit akt. Abmessungen dimensionieren und Fensterinhalt speichern *)
  104. BEGIN
  105.   Groesse := ImageSize (1, 1, AktSpalten, AktZeilen);
  106.   GetMem (Sprite, Groesse);
  107.   GetImage (1, 1, AktSpalten, AktZeilen, Sprite^);
  108. END;
  109. (*-----------------------------------------------*)
  110. PROCEDURE SaveEditSprite (Name : STRING);
  111. (* Sprite abspeichern *)
  112.  
  113. VAR F          : FILE;
  114.     DatFehler,
  115.     Size       : INTEGER;
  116.     Sprite     : POINTER;
  117.  
  118. BEGIN
  119.   IF Name = '' THEN EXIT;
  120.   ViewPort (3);
  121.   Dimensionierung (Sprite, Size);
  122.  
  123.   ASSIGN (F, Name);
  124.   {$I-} REWRITE (F,1); {$I+}
  125.   DatFehler := IOResult;
  126.   IF DatFehler <> 0 THEN BEGIN Abbruch; EXIT; END;
  127.  
  128.   BlockWrite (F, Sprite^, Size);
  129.   CLOSE (F);
  130.   FreeMem (Sprite, Size);
  131.   ViewPort (2);
  132.   Beep (800,100);
  133. END;
  134. (*-----------------------------------------------*)
  135. PROCEDURE LoadEditSprite (Name : STRING);
  136. (* Laden eines Sprites, ein ev. vorhandenes Bild wird .. *)
  137. (* .. hierbei n i c h t gelöscht !                       *)
  138. VAR F          : FILE;
  139.     DatFehler,
  140.     Size,
  141.     Ergebnis   : INTEGER;
  142.     Sprite     : POINTER;
  143.     Block      : ARRAY [1..128] OF BYTE;
  144.     (* ^ Sprite-Daten, nur zum Klötzchen-Setzen nötig     *)
  145.     (* die Pixels sind hier "komprimiert" gespeichert, .. *)
  146.     (* .. d.h. Block [n] enthält den Wert von 4 Pixels !  *)
  147. (*---------------*)
  148. PROCEDURE ZeigKloetzchen;
  149. (* Aufbau des Editierbildes *)
  150. VAR    Pixel,
  151.        Breite,
  152.        TempHoehe,
  153.        Farbe,               (* .. eines Pixels *)
  154.        X, Y,                (* Klötzchen-Koordinaten  *)
  155.        AktByte,             (* akt. Byte mit 4 Pixels *)
  156.        Bitt     : INTEGER;  (* 2 bit eines Bytes .. *)
  157.                             (* .. enthält die Farbe eines Pixels *)
  158.  
  159. CONST  Dual : ARRAY [1..4] OF BYTE = (6, 4, 2, 0);
  160.        (* ^ zum schnellen Umrechnen der Zweierpotenzen *)
  161.  
  162. BEGIN
  163.   INC (Block [1], 1);
  164.   (* im Sprite-Feld [1] werden die um 1 erniedrigten Spalten gespeichert *)
  165.   AktSpalten := Block [1];
  166.   (* ^ Breite des Sprites in Editier-Spalten  = 1..24 *)
  167.   Breite := (Block [1] DIV 4) +  ORD (Block [1] MOD 4 > 0);
  168.   (* ^ Breite des Sprites in 4er-Bytes = 1..6 *)
  169.   (* 1 Byte kann 4 Pixel aufnehmen *)
  170.  
  171.   INC (Block [3], 1);
  172.   (* im Sprite-Feld [3] werden die um 1 erniedrigten Zeilen gespeichert *)
  173.   AktZeilen := Block [3];
  174.   (* ^ Höhe des Sprites in Editier-Zeilen = 1..16 *)
  175.  
  176.   TempHoehe := 1;
  177.  
  178.   REPEAT
  179.      FOR Pixel := 1 TO Breite DO
  180.         BEGIN
  181.           AktByte := Block [Offset + Pixel + Breite * (PRED (TempHoehe))];
  182.           (* das erste Daten-Byte hat die Nr. 5 *)
  183.           (* jetzt wird Block [n] in die 4 Pixels "zerlegt" *)
  184.           FOR Bitt := 1 TO 4 DO
  185.             BEGIN
  186.               Farbe := AktByte SHR Dual [Bitt];
  187.               X := StartX + 3 + (PRED (Pixel) * 4 + PRED (Bitt)) * DeltaX;
  188.               Y := StartY + 3 + PRED (TempHoehe) * DeltaY;
  189.  
  190.               IF Farbe <> 0 THEN BEGIN
  191.                  SetFillStyle (SolidFill, Farbe);
  192.                  BAR (X, Y, X + DeltaX - 6, Y + DeltaY - 6);
  193.               END;  (* IF Farbe <> 0 *)
  194.  
  195.               AktByte := AktByte - (Farbe SHL (Dual [Bitt]));
  196.             END;   (* FOR Bitt := 1 TO 4 *)
  197.         END;   (* FOR Pixel := 1 TO Breite *)
  198.      INC (TempHoehe, 1);
  199.   UNTIL TempHoehe > AktZeilen;
  200. END;  (* ZeigKloetzchen *)
  201. (*------------------*)
  202. BEGIN   (* LoadEditSprite *)
  203.   IF Name = '' THEN EXIT;
  204.   (* ev. hier Sprite- u. Editierfenster löschen ! *)
  205.   ViewPort (3);
  206.   Size := ImageSize (1, 1, Spalten, Zeilen);
  207.   GetMem (Sprite, Size);
  208.   (* die Abmessungen des zu ladenden Sprites sind noch unbekannt .. *)
  209.   (* .. also wird für die max. Abmessungen "dimensioniert"          *)
  210.   ASSIGN (F, Name);
  211.   {$I-} RESET (F,1); {$I+}
  212.   DatFehler := IOResult;
  213.   IF DatFehler <> 0 THEN BEGIN Abbruch; EXIT; END;
  214.  
  215.   BlockRead (F, Sprite^, Size, Ergebnis);
  216.   CLOSE (F);
  217.  
  218.   PutImage (1, 1, Sprite^, XorPut);
  219.   (* Überlagerung der Farben im SpriteFenster                   *)
  220.   (* im EditierFenster Ueberlagerung mit "falschen" Farben      *)
  221.   (* erst nach Hor.- o. Vert.spiegeln stimmen hier die Farben ! *)
  222.   (* Will man beide Fenster komplett neu aufbauen, dann vor ..  *)
  223.   (* .. dem Laden wie bei "NEU" alles löschen                   *)
  224.  
  225.   ViewPort (2);
  226.  
  227.   (* vom Pointer in das BYTE-ARRAY  : *)
  228.   MOVE (Sprite^, Block, Size);
  229.   ZeigKloetzchen;   (* .. im Editierfeld *)
  230.   FreeMem (Sprite, Size);
  231.   Beep (800,100);
  232. END;
  233. (*-----------------------------------------------*)
  234. PROCEDURE ZeigFarben;
  235. (* zeigt die 3 möglichen Farben auf dem Bildschirm, .. *)
  236. (* Wahl mit der entsprechenden Ziffern-Taste           *)
  237.  
  238. VAR  Farbe    : INTEGER;
  239.      Temp     : STRING;
  240.  
  241. BEGIN
  242.   SetColor (MaxFarbe);
  243.   FOR Farbe := 0 TO MaxFarbe DO
  244.     BEGIN
  245.       SetFillStyle (SolidFill, Farbe);
  246.       Bar (EndX + 72 + Farbe * 8, EndY + 12,
  247.            EndX + 80 + Farbe * 8, EndY + 12 + DeltaY);
  248.       Rectangle (EndX + 72 + Farbe * 8, EndY + 12,
  249.                  EndX + 80 + Farbe * 8, EndY + 12 + DeltaY);
  250.       STR (Farbe, Temp);
  251.       OutTextXY (EndX + 72 + Farbe * 8 + 1, EndY + 12 + DeltaY + 4, Temp);
  252.      END;
  253.  
  254.   STR (GraphMode, Temp);
  255.   OutTextXY (EndX + 60, EndY + 4 + DeltaY, Temp);
  256. END;
  257. (*-----------------------------------------------*)
  258. PROCEDURE Bildschirm;
  259. (* Bildschirm-Aufbau *)
  260. VAR    Menue      : INTEGER;
  261. CONST  MaxMenue   = 12;
  262.        MenuePunkt : ARRAY [1..MaxMenue] OF STRING =
  263.                    ('<N>eu', '<G>rösse', '<P>alette', 'H<i>ntergr.',
  264.            '<F>üllen', '<L>aden', '<S>peichern', '<U>nit',
  265.            '<H>or.spieg.', '<V>er.spieg.', '<Z>usammenf.', '<E>nde');
  266.  
  267. BEGIN
  268.   MachRaster (StartX, Spalten, DeltaX, StartY, Zeilen, DeltaY, FALSE);
  269.   Rectangle (MinX, MinY, MaxX, MaxY);                      (* Umrandung *)
  270.  
  271.   Rectangle (MinX + 2, MinY + 2, EndX, 12);                (* Status *)
  272.   OutTextXY (8, 4, 'X :    --  Y :');
  273.  
  274.   Rectangle (EndX + 8, MinY + 2, MaxX - 2, 16);            (* Titel *)
  275.   OutTextXY (EndX + 11, 6, 'SPRITTY V.1.0');
  276.  
  277.   Rectangle (EndX + 8, StartY , MaxX - 2, EndY);           (* Befehle *)
  278.  
  279.                                                            (* Eingaben *)
  280.   Rectangle (StartX, EndY + 4, EndX, EndY + 14 + 2 * DeltaY);
  281.  
  282.   SprFLinks  := EndX + 8;
  283.   SprFOben   := EndY + 8;
  284.   SprFRechts := SprFLinks + 2 + Spalten + 3;
  285.   SprFUnten  := SprFOben + 2 + Zeilen + 3;
  286.   Rectangle (SprFLinks, SprFOben, SprFRechts, SprFUnten);  (* Sprite *)
  287.  
  288.   FOR Menue := 1 TO MaxMenue DO
  289.     BEGIN
  290.       OutTextXY (EndX + 16, 20 + Menue * 10, MenuePunkt [Menue]);
  291.     END;
  292.  
  293.   ZeigFarben;
  294. END;
  295. (*-----------------------------------------------*)
  296. PROCEDURE HolAbmessungen;
  297. (* Grösse des Arbeitsfeldes festlegen *)
  298. VAR Temp   : STRING;
  299.     Fehler : INTEGER;
  300.  
  301. BEGIN
  302.   ViewPort (1);
  303.   OutTextXY (10, 6, 'Breite <1..24> : ');
  304.  
  305.   REPEAT
  306.      SchreibSpace (148, 6);
  307.      SchreibSpace (156, 6);
  308.      MoveTo (148, 6);
  309.      HolString (Temp, 2);
  310.      VAL (Temp, AktSpalten, Fehler);
  311.   UNTIL ((AktSpalten IN [1..24]) AND (Fehler = 0)) OR (Temp = '');
  312.  
  313.   IF Temp = '' THEN BEGIN Abbruch; EXIT; END;
  314.  
  315.   OutTextXY (10, 16, 'Höhe   <1..16> : ');
  316.    REPEAT
  317.      SchreibSpace (148, 16);
  318.      SchreibSpace (156, 16);
  319.      MoveTo (148, 16);
  320.      HolString (Temp, 2);
  321.      VAL (Temp, AktZeilen, Fehler);
  322.    UNTIL (AktZeilen IN [1..16]) AND (Fehler = 0);
  323.  
  324.   ViewPort (2);
  325. END;
  326. (*-----------------------------------------------*)
  327. PROCEDURE HolPalette;
  328. (* Palette 0..3 auswählen, kann  n i c h t  abgespeichert werden ! *)
  329. VAR Temp    : STRING;
  330.     Fehler  : INTEGER;
  331.  
  332. BEGIN
  333.   ViewPort (1);
  334.   OutTextXY (10, 6, 'Palette <0..3> : ');
  335.  
  336.   REPEAT
  337.      SchreibSpace (148, 6);
  338.      MoveTo (148, 6);
  339.      HolString (Temp, 1);
  340.      VAL (Temp, GraphMode, Fehler);
  341.   UNTIL (GraphMode IN [0..3]) AND (Fehler = 0);
  342.  
  343.   ClearViewPort;
  344.   ViewPort (2);
  345.  
  346.   ScreenToRam (2);
  347.  
  348.   InitGraph (GraphDriver, GraphMode, '');
  349.   RamToScreen (2);
  350.  
  351.   SchreibSpace (EndX + 60, EndY + 4 + DeltaY);
  352.     STR (GraphMode, Temp);
  353.   OutTextXY (EndX + 60, EndY + 4 + DeltaY, Temp);
  354. END;
  355. (*-----------------------------------------------*)
  356. PROCEDURE HolFarbe;
  357. (* füllt den kompletten Sprite mit einer Farbe *)
  358. VAR Fehler, Farbe, Size : INTEGER;
  359.     Temp                : STRING;
  360.     Sprite              : POINTER;
  361.  
  362. BEGIN
  363.   ViewPort (1);
  364.   OutTextXY (10, 6, 'Farbe <0..3> : ');
  365.  
  366.   REPEAT
  367.      SchreibSpace (148, 6);
  368.      MoveTo (148, 6);
  369.      HolString (Temp, 1);
  370.      VAL (Temp, Farbe, Fehler);
  371.   UNTIL ((Farbe IN [0..3]) AND (Fehler = 0)) OR (Temp = '');
  372.  
  373.   ClearViewPort;
  374.   IF Temp = '' THEN BEGIN Beep (200, 40); EXIT; END;
  375.  
  376.   ViewPort (3);
  377.   SetFillStyle (SolidFill, Farbe);
  378.   BAR (1, 1, AktSpalten, AktZeilen);
  379.  
  380.   SaveEditSprite (TempFile);
  381.   IF Farbe = 0 THEN RamToScreen (1);
  382.     (* bei Farbe 0 werden die Klötzchen nicht gesetzt ! *)
  383.   ViewPort (3);  ClearViewPort;   (* wg. XorPut bei LoadEditSprite ! *)
  384.   LoadEditSprite (TempFile);
  385. END;
  386. (*-----------------------------------------------*)
  387. PROCEDURE HorizontalSpiegeln;
  388. (* spiegelt am nächsten Byte = 4 Pixels  *)
  389. (* Abmessungen beachten !                *)
  390. VAR Block, Temp : ARRAY [1..128] OF BYTE;
  391.     DatFehler,
  392.     Pixel,
  393.     Size,
  394.     TempHoehe,
  395.     Breite,
  396.     Ziel,
  397.     Ursprung,
  398.     Quelle,
  399.     Hilf, Bitt: INTEGER;
  400.     Sprite    : POINTER;
  401.     F         : File;
  402.     Farbe     : ARRAY [1..4] OF BYTE;
  403.  
  404. CONST  Dual : ARRAY [1..4] OF BYTE = (6, 4, 2, 0);
  405.        (* zum schnellen Umrechnen der Zweierpotenzen *)
  406.  
  407. BEGIN
  408.   FillChar (Temp, SizeOF (Temp), 0);     (* Zwischenspeicher *)
  409.   FillChar (Block, SizeOF (Block), 0);
  410.  
  411.   ViewPort (3);
  412.   Dimensionierung (Sprite, Size);
  413.  
  414.   ViewPort (2);
  415.   MOVE (Sprite^, Block, Size);   (* vom Sprite ins ARRAY *)
  416.   INC (Block [1]);
  417.   Breite := (Block [1] DIV 4) +  ORD (Block [1] MOD 4 > 0);
  418.   DEC (Block [1]);
  419.   TempHoehe := 1;
  420.  
  421.   REPEAT
  422.      Ursprung := TempHoehe * Breite + Offset + 1;
  423.      FOR Pixel := 1 TO Breite DO
  424.         BEGIN
  425.           Ziel := (TempHoehe - 1) * Breite + Pixel + Offset;
  426.           Quelle := Ursprung - Pixel;
  427.           Temp [Ziel] := Block [Quelle];
  428.  
  429.           Hilf := Temp [Ziel];
  430.           FOR Bitt := 1 TO 4 DO  (* Byte --> 4 Farben *)
  431.             BEGIN
  432.                Farbe [5 - Bitt] := Hilf SHR Dual [Bitt];
  433.                Hilf := Hilf - (Farbe [5-Bitt] SHL (Dual [Bitt] ));
  434.             END;
  435.           Hilf := 0;
  436.           FOR Bitt := 1 TO 4 DO
  437.                       Hilf := Hilf + Farbe [Bitt] SHL Dual [Bitt];
  438.           Temp [Ziel] := Hilf;
  439.         END;   (* FOR Pixel := 1 TO Breite *)
  440.  
  441.      INC (TempHoehe, 1);
  442.   UNTIL TempHoehe > AktZeilen;
  443.  
  444.   FillChar (Block, SizeOF (Block), 0);
  445.   Block := Temp;
  446.   Block [1] := PRED (AktSpalten);  Block [3] := PRED (AktZeilen);
  447.   MOVE (Block, Sprite^, Size);  (* .. und wieder zurück *)
  448.  
  449.   (* das Editierbild muss jetzt neu aufgebaut werden, warum sollen wir .. *)
  450.   (* .. uns die Arbeit machen ? Beim Laden eines Bildes erledigt das der  *)
  451.   (* .. Rechner, also wird im TempFile zwischengelagert ! Eine Ramdisk .. *)
  452.   (* .. beschleunigt das Ganze erheblich !                             .. *)
  453.  
  454.   ASSIGN (F, TempFile);
  455.   {$I-} REWRITE (F,1); {$I+}
  456.   DatFehler := IOResult;
  457.   IF DatFehler <> 0 THEN BEGIN Abbruch; EXIT; END;
  458.  
  459.   BlockWrite (F, Sprite^, Size);
  460.   CLOSE (F);
  461.  
  462.   RamToScreen (1);
  463.   LoadEditSprite (TempFile);   (* Laden und somit Editierbild aufbauen ! *)
  464. END;
  465. (*-----------------------------------------------*)
  466. PROCEDURE VertikalSpiegeln;
  467. (* analog HorizontalSpiegeln       *)
  468. (* gewählte Abmessungen beachten ! *)
  469. VAR Block, Temp  : ARRAY [1..128] OF BYTE;
  470.     DatFehler,
  471.     Pixel,
  472.     Size,
  473.     TempHoehe,
  474.     Breite,
  475.     Ziel, Quelle : INTEGER;
  476.     Sprite       : POINTER;
  477.     F            : File;
  478.  
  479. BEGIN
  480.   FillChar (Temp, SizeOF (Temp), 0);
  481.   FillChar (Block, SizeOF (Block), 0);
  482.  
  483.   ViewPort (3);
  484.   Dimensionierung (Sprite, Size);
  485.  
  486.   ViewPort (2);
  487.   MOVE (Sprite^, Block, Size);
  488.   INC (Block [1], 1);
  489.   Breite := (Block [1] DIV 4) +  ORD (Block [1] MOD 4 > 0);
  490.   DEC (Block [1], 1);
  491.   TempHoehe := 1;
  492.  
  493.   REPEAT
  494.      FOR Pixel := 1 TO Breite  DO
  495.         BEGIN
  496.           Ziel := (TempHoehe - 1) * Breite + Pixel + Offset;
  497.           Quelle := (AktZeilen - TempHoehe) * Breite + Pixel + Offset;
  498.           Temp [Ziel] := Block [Quelle];
  499.      END;   (* FOR Pixel := 1 TO Breite *)
  500.  
  501.      INC (TempHoehe, 1);
  502.   UNTIL TempHoehe > AktZeilen;
  503.  
  504.   FillChar (Block, SizeOF (Block), 0);
  505.   Block := Temp;
  506.   Block [1] := PRED (AktSpalten);  Block [3] := PRED (AktZeilen);
  507.   MOVE (Block, Sprite^, Size);
  508.   ASSIGN (F, TempFile);
  509.   {$I-} REWRITE (F, 1); {$I+}
  510.   DatFehler := IOResult;
  511.   IF DatFehler <> 0 THEN BEGIN Abbruch; EXIT; END;
  512.  
  513.   BlockWrite (F, Sprite^, Size);
  514.   CLOSE (F);
  515.  
  516.   RamToScreen (1);
  517.   LoadEditSprite (TempFile);
  518. END;
  519. (*-----------------------------------------------*)
  520. PROCEDURE MachUnit (DateiName : STRING);
  521. (* Sprite-Daten in UNIT speichern *)
  522. (* ev. nachzubearbeiten :         *)
  523. (* - VAR Sprite u. SpriteFeld : Variablennamen ändern *)
  524. (* - Name der UNIT                                    *)
  525.  
  526. VAR     Datei     : TEXT;
  527.         DatFehler,
  528.     Size,
  529.     I, J      : INTEGER;
  530.         Sprite    : POINTER;
  531.         Block     : ARRAY [1..128] OF BYTE;
  532.  
  533. BEGIN
  534.   IF DateiName = '' THEN EXIT;
  535.  
  536.   ViewPort (3);
  537.   Dimensionierung (Sprite, Size);
  538.  
  539.   ViewPort (2);
  540.   Size := Size - 2;   (* die ominösen letzten beiden Bytes ausblenden *)
  541.   MOVE (Sprite^, Block, Size);
  542.  
  543.   ASSIGN (Datei, DateiName);
  544.   {$I-} REWRITE (Datei); {$I+}
  545.   DatFehler := IOResult;
  546.   IF DatFehler <> 0 THEN BEGIN Abbruch; EXIT; END;
  547.  
  548.   DEC (DateiName [0], 4);     (* DateiName ohne Extension *)
  549.       (* ev. Dir.pfad später im UNIT-Namen löschen !! *)
  550.   WRITELN (Datei, 'UNIT ', DateiName, ';');
  551.   WRITELN (Datei, 'INTERFACE');
  552.   WRITELN (Datei, 'USES CRT, Graph, SpieleGraph;');
  553.   WRITELN (Datei);
  554.   WRITELN (Datei, 'VAR     Sprite     : POINTER;');
  555.   (* bei mehreren Sprites natürlich den Namen der Variablen ändern ! *)
  556.   WRITELN (Datei, 'CONST   Size       : INTEGER = ', Size, ';');
  557.   WRITELN (Datei, 'CONST   SpriteFeld : ARRAY [1..', Size, '] OF BYTE =');
  558.   WRITE   (Datei, '(');
  559.   FOR I := 1 TO Offset DO
  560.       WRITE (Datei, Block [I], ',' );
  561.   (* Breite und Höhe des Sprites *)
  562.   WRITELN (Datei);
  563.  
  564.   (* Anzahl der Spalten in Bytes *)
  565.   J := (Block [1] + 1) DIV 4;
  566.   IF ((Block [1] + 1) MOD 4) > 0 THEN INC (J, 1);
  567.  
  568.                     (* 1..4 = Abmessungen, letztes Byte mit ')' *);
  569.   FOR I := 1 TO (Size - Offset - 1) DO
  570.      BEGIN
  571.        WRITE (Datei, Block [(I + Offset)]);
  572.        IF I MOD J = 0 THEN WRITELN (Datei, ',') ELSE WRITE (Datei, ',')
  573.      END;
  574.   WRITE (Datei, Block [I + Offset + 1]); (* beim letzten Byte ')' statt ',' *)
  575.   WRITELN (Datei, ');');
  576.   WRITELN (Datei);
  577.   WRITELN (Datei, 'IMPLEMENTATION');
  578.   WRITELN (Datei, 'BEGIN');
  579.   WRITELN (Datei, '   GetMem (Sprite, Size);');
  580.   WRITELN (Datei, '   MOVE (SpriteFeld, Sprite^, Size);');
  581.   (* die nächsten beiden Zeilen sind nur "Gedächtnisstütze" und *)
  582.   (* können gelöscht werden                          *)
  583.   WRITELN (Datei, '   { GraphikInit; }');
  584.   WRITELN (Datei, '   { PutImage (100, 100, Sprite^, XorPut); }');
  585.   WRITELN (Datei, 'END.');
  586.   CLOSE (Datei);
  587.   Beep (800,100);
  588. END;
  589. (*-----------------------------------------------*)
  590. PROCEDURE MachGrossenSprite;
  591. (* max. 9 Bilder lassen sich zusammenfassen *)
  592. (* einiges liesse sich mit den vorigen Routinen zusammenfassen *)
  593. (* aber so ist es etwas übersichtlicher !                      *)
  594. VAR    Taste      : CHAR;
  595.        Nummer     : INTEGER;
  596.  
  597. CONST  StartPixX  : INTEGER = 51;
  598.        StartPixY  : INTEGER = 51;
  599.        AktBreite  : INTEGER = 24;
  600.        AktHoehe   : INTEGER = 16;
  601. (*---------------*)
  602. PROCEDURE Initialisierung;
  603. (* Bildschirm-Aufbau *)
  604. VAR    Menue      : INTEGER;
  605. CONST  MaxMenue   = 6;
  606.        MenuePunkt : ARRAY [1..MaxMenue] OF STRING =
  607.                    ('<N>eu', '<G>rösse',
  608.            '<L>aden', '<S>peichern', '<U>nit',
  609.            '<Z>urück');
  610.  
  611. BEGIN
  612.   ScreenToRam (2);
  613.  
  614.   SetColor (PRED (MaxFarbe));
  615.  
  616.   SetViewPort (MinX + 3, MinY + 3, EndX - 1, 11, ClipOn);  (* Status *)
  617.   ClearViewPort;
  618.   OutTextXY (35,1, 'Sprite-Kollektor');
  619.  
  620.   ViewPort (1);
  621.   SetColor (MaxFarbe);
  622.   SetViewPort (StartX + 1, StartY + 1, EndX - 1, EndY -1, ClipOn);
  623.   ClearViewPort;        (* EditierFeld *)
  624.  
  625.   SetViewPort (EndX + 9, StartY + 1, MaxX - 3, EndY -1, ClipOn); (* Befehle *)
  626.   ClearViewPort;
  627.  
  628.   ViewPort (2);
  629.  
  630.   FOR Menue := 1 TO MaxMenue DO
  631.     BEGIN
  632.       OutTextXY (EndX + 16, 20 + Menue * 10, MenuePunkt [Menue]);
  633.     END;
  634.  
  635.   OutTextXy (EndX + 35, 100, 'Blöcke :');
  636.   OutTextXy (EndX + 40, 110, '1 2 3');
  637.   OutTextXy (EndX + 40, 120, '4 5 6');
  638.   OutTextXy (EndX + 40, 130, '7 8 9');
  639. END;  (* Initialisierung *)
  640. (*---------------*)
  641. PROCEDURE HolGroesse;
  642. (* Grösse des Arbeitsfeldes in Pixeln festlegen *)
  643. VAR Temp   : STRING;
  644.     Fehler : INTEGER;
  645.  
  646. BEGIN
  647.   ViewPort (1);
  648.   OutTextXY (10, 6, 'Breite <1..72> : ');
  649.  
  650.   REPEAT
  651.      SchreibSpace (148, 6);
  652.      SchreibSpace (156, 6);
  653.      MoveTo (148, 6);
  654.      HolString (Temp, 2);
  655.      VAL (Temp, AktBreite, Fehler);
  656.   UNTIL ((AktBreite IN [1..72]) AND (Fehler = 0)) OR (Temp = '');
  657.  
  658.   IF Temp = '' THEN BEGIN Abbruch; EXIT; END;
  659.  
  660.   OutTextXY (10, 16, 'Höhe   <1..48> : ');
  661.    REPEAT
  662.      SchreibSpace (148, 16);
  663.      SchreibSpace (156, 16);
  664.      MoveTo (148, 16);
  665.      HolString (Temp, 2);
  666.      VAL (Temp, AktHoehe, Fehler);
  667.    UNTIL (AktHoehe IN [1..48]) AND (Fehler = 0);
  668.   ClearViewPort;
  669.   ViewPort (2);
  670. END;
  671. (*---------------*)
  672. PROCEDURE HolFeld (VAR Nummer : INTEGER);
  673. (* Nummer des Blocks, der besetzt werden soll *)
  674. VAR Temp   : STRING;
  675.     Fehler : INTEGER;
  676.  
  677. BEGIN
  678.   ViewPort (1);
  679.   OutTextXY (10, 6, 'Nummer <1..9> : ');
  680.  
  681.   REPEAT
  682.      SchreibSpace (148, 6);
  683.      MoveTo (148, 6);
  684.      HolString (Temp, 1);
  685.      VAL (Temp, Nummer, Fehler);
  686.   UNTIL ((Nummer IN [1..9]) AND (Fehler = 0)) OR (Temp = '');
  687.   ClearViewPort;
  688.   ViewPort (2);
  689. END;    (* HolNummer *)
  690. (*---------------*)
  691. PROCEDURE LoadSprite (Name : STRING);
  692. (* Sprite laden *)
  693. VAR F          : FILE;
  694.     DatFehler,
  695.     Size,
  696.     Ergebnis   : INTEGER;
  697.     Sprite     : POINTER;
  698.  
  699. CONST StartX : ARRAY [0..2] OF BYTE = (99, 51, 75);
  700.       StartY : ARRAY [0..2] OF BYTE = (51, 67, 83);
  701.  
  702. BEGIN
  703.   IF Name = '' THEN EXIT;
  704.  
  705.   Size := ImageSize (0, 0, 72, 48);
  706.   GetMem (Sprite, Size);
  707.   (* die Abmessungen des zu ladenden Sprites sind unbekannt ..             *)
  708.   (* .. also wird fuer die max. Grösse "dimensioniert"                     *)
  709.   (* .. und zwar so, dass man auch einen 3 * 3-Sprite testweise laden kann *)
  710.   (* .. ev. wird dann allerdings der ViewPort überschritten !              *)
  711.  
  712.   ASSIGN (F, Name);
  713.   {$I-} RESET (F,1); {$I+}
  714.   DatFehler := IOResult;
  715.   IF DatFehler <> 0 THEN BEGIN Abbruch; EXIT; END;
  716.  
  717.   BlockRead (F, Sprite^, Size, Ergebnis);
  718.   CLOSE (F);
  719.  
  720.   ViewPort (2);
  721.   PutImage
  722.      (StartX [Nummer MOD 3], StartY [PRED (Nummer) DIV 3],
  723.       Sprite^, NormalPut);
  724.   Beep (800,100);
  725. END;    (* LoadSprite *)
  726. (*---------------*)
  727. PROCEDURE SaveSprite (Name : STRING);
  728. (* grossen Sprite abspeichern *)
  729. VAR F          : FILE;
  730.     DatFehler,
  731.     Size,
  732.     Breite,
  733.     Hoehe      : INTEGER;
  734.     Sprite     : POINTER;
  735.  
  736. BEGIN
  737.   IF Name = '' THEN EXIT;
  738.  
  739.   Breite := StartPixX + AktBreite;
  740.   Hoehe  := StartPixY + AktHoehe;
  741.  
  742.   SetViewPort (StartPixX, StartPixY, Breite, Hoehe, ClipOn);
  743.  
  744.   DEC (AktBreite);   DEC (AktHoehe);
  745.   Size := ImageSize (0, 0, AktBreite, AktHoehe);
  746.   GetMem (Sprite, Size);
  747.   GetImage (0, 0, AktBreite, AktHoehe, Sprite^);
  748.   INC (AktBreite);   INC (AktHoehe);
  749.   ASSIGN (F, Name);
  750.   {$I-} REWRITE (F,1); {$I+}
  751.   DatFehler := IOResult;
  752.   IF DatFehler <> 0 THEN BEGIN Abbruch; EXIT; END;
  753.  
  754.   BlockWrite (F, Sprite^, Size);
  755.   CLOSE (F);
  756.   FreeMem (Sprite, Size);
  757.   ViewPort (2);
  758.   Beep (800,100);
  759. END;    (* SaveSprite *)
  760. (*---------------*)
  761. PROCEDURE MachGrUnit (DateiName : STRING);
  762. (* grosser Sprite als UNIT *)
  763. VAR     Datei     : TEXT;
  764.         DatFehler,
  765.         Size,
  766.     I, J,
  767.         Breite,
  768.         Hoehe     : INTEGER;
  769.         Sprite    : POINTER;
  770.         Block     : ARRAY [1..870] OF BYTE;
  771.  
  772. BEGIN
  773.   IF DateiName = '' THEN EXIT;
  774.  
  775.   Breite := StartPixX + AktBreite;
  776.   Hoehe  := StartPixY + AktHoehe;
  777.  
  778.   SetViewPort (StartPixX, StartPixY, Breite, Hoehe, ClipOn);
  779.  
  780.   DEC (AktBreite);   DEC (AktHoehe);
  781.   Size := ImageSize (0, 0, AktBreite, AktHoehe);
  782.   GetMem (Sprite, Size);
  783.   GetImage (0, 0, AktBreite, AktHoehe, Sprite^);
  784.   INC (AktBreite);   INC (AktHoehe);
  785.   Size := Size - 2;   (* die ominösen letzten beiden Bytes ausblenden *)
  786.   MOVE (Sprite^, Block, Size);
  787.  
  788.   ASSIGN (Datei, DateiName);
  789.   {$I-} REWRITE (Datei); {$I+}
  790.   DatFehler := IOResult;
  791.   IF DatFehler <> 0 THEN BEGIN Abbruch; EXIT; END;
  792.  
  793.   DEC (DateiName [0], 4);     (* DateiName ohne Extension *)
  794.       (* ev. Dir.pfad im UNIT-Namen löschen ! *)
  795.   WRITELN (Datei, 'UNIT ', DateiName, ';');
  796.   WRITELN (Datei, 'INTERFACE');
  797.   WRITELN (Datei, 'USES CRT, Graph, SpieleGraph;');
  798.   WRITELN (Datei);
  799.   WRITELN (Datei, 'VAR     Sprite     : POINTER;');
  800.   WRITELN (Datei, 'CONST   Size       : INTEGER = ', Size, ';');
  801.   WRITELN (Datei, 'CONST   SpriteFeld : ARRAY [1..', Size, '] OF BYTE =');
  802.   WRITE   (Datei, '(');
  803.   FOR I := 1 TO Offset DO
  804.       WRITE (Datei, Block [I], ',' );
  805.   (* Breite und Hoehe des Sprites *)
  806.   WRITELN (Datei);
  807.  
  808.   (* Anzahl der Spalten in Bytes *)
  809.   J := (Block [1] + 1) DIV 4;
  810.   IF ((Block [1] + 1) MOD 4) > 0 THEN INC (J, 1);
  811.  
  812.                     (* 1..4 = Abmessungen, letztes Byte mit ')' *);
  813.   FOR I := 1 TO (Size - Offset - 1) DO
  814.      BEGIN
  815.        WRITE (Datei, Block [(I + Offset)]);
  816.        IF I MOD J = 0 THEN WRITELN (Datei, ',') ELSE WRITE (Datei, ',')
  817.      END;
  818.   WRITE (Datei, Block [I + Offset + 1]); (* beim letzten Byte ')' statt ',' *)
  819.   WRITELN (Datei, ');');
  820.   WRITELN (Datei);
  821.   WRITELN (Datei, 'IMPLEMENTATION');
  822.   WRITELN (Datei, 'BEGIN');
  823.   WRITELN (Datei, '   GetMem (Sprite, Size);');
  824.   WRITELN (Datei, '   MOVE (SpriteFeld, Sprite^, Size);');
  825.   WRITELN (Datei, '   { GraphikInit; }');
  826.   WRITELN (Datei, '   { PutImage (100, 100, Sprite^, XorPut); }');
  827.   WRITELN (Datei, 'END.');
  828.   CLOSE (Datei);
  829.   FreeMem (Sprite, Size);
  830.   ViewPort (2);
  831.   Beep (800,100);
  832. END;   (* MachGrUnit *)
  833. (*---------------*)
  834. BEGIN   (* MachGrossenSprite *)
  835.   Initialisierung;
  836.   RamToScreen (3);
  837.  
  838. REPEAT
  839.  HolZeichen (Taste);
  840.  
  841.  CASE UpCase (Taste) OF
  842.  
  843.   'N'    : BEGIN       (* Neu --> alles loeschen *)
  844.             IF Wirklich ('Löschen       <J> / <N>') THEN
  845.               BEGIN
  846.                 SetViewPort
  847.            (StartX + 1, StartY + 1, EndX - 1, EndY - 1, ClipOn);
  848.                 ClearViewPort;
  849.               END;   (* IF Neu *)
  850.            END;
  851.  
  852.   'G'    : (* Abmessungen festlegen *)
  853.            HolGroesse;
  854.  
  855.   'S'    : (* Sprite in FILE (OF BYTE) speichern *)
  856.            SaveSprite  (HolFilename ('.GSP'));
  857.  
  858.   'L'    : BEGIN       (* Sprite laden *)
  859.          HolFeld (Nummer);
  860.              IF Nummer > 0 THEN LoadSprite  (HolFilename ('.SPR'))
  861.                ELSE BEGIN Beep (200,40); END;
  862.            END;
  863.  
  864.   'U'    : (* Sprite in UNIT speichern *)
  865.        MachGrUnit (HolFilename ('.PAS'));
  866.  
  867.   'Z'    : IF Wirklich ('Zurück   <J> / <N>') THEN Taste := 'Z';
  868.  
  869.   END;  (* CASE Taste OF *)
  870. UNTIL Taste = 'Z';
  871.  
  872.   ViewPort (2);
  873.   ScreenToRam (3);   (* akt. Bildschirm speichern ..   *)
  874.   RamToScreen (2);   (* .. und Editierbild zurückholen *)
  875. END;  (* MachGrossenSprite *)
  876. (*-----------------------------------------------*)
  877. (*-----------------------------------------------*)
  878. PROCEDURE Bewegung;
  879. (* die Schaltzentrale *)
  880. VAR      Taste        : CHAR;
  881.          X_Alt, Y_Alt,
  882.          X_Neu, Y_Neu,
  883.          Delta        : INTEGER;  (* 0..1 *)
  884. (*-----------------*)
  885. PROCEDURE SetzCursor (X, Y : INTEGER; Loeschen : BOOLEAN);
  886. (* Cursor bewegen *)
  887. BEGIN
  888.   X := StartX + 1 + PRED (X) * DeltaX;
  889.   Y := StartY + 1 + PRED (Y) * DeltaY;
  890.   IF Loeschen THEN SetColor (0) ELSE SetColor (MaxFarbe);
  891.  
  892.   Rectangle (X, Y, X + DeltaX - 2, Y + DeltaY - 2);
  893. END;
  894. (*-----------------*)
  895. PROCEDURE Farbe (X, Y : INTEGER);
  896. (* Farbe 0..3 setzen *)
  897. BEGIN
  898.   X := StartX + 3 + PRED (X) * DeltaX;
  899.   Y := StartY + 3 + PRED (Y) * DeltaY;
  900.   SetFillStyle (SolidFill, AktFarbe);
  901.   BAR (X, Y, X + DeltaX - 6, Y + DeltaY - 6);
  902.  
  903.   (* SpriteFenster *)
  904.   ViewPort (3);
  905.   PutPixel (X_Neu, Y_Neu, AktFarbe);
  906.  
  907.   ViewPort (2);
  908. END;
  909. (*-----------------*)
  910. PROCEDURE ZeigerWechsel;
  911. (* Cursor-Verwaltung u. Koordinaten-Angabe *)
  912. VAR Hilf : STRING;
  913.  
  914. BEGIN
  915.   SetzCursor (X_Alt, Y_Alt, TRUE);
  916.   SetzCursor (X_Neu, Y_Neu, FALSE);
  917.   (* löschen des alten Wertes ginge auch mit SchreibSpace ! *)
  918.   STR (X_ALt, Hilf); SetColor (0); OutTextXY (40, 4, Hilf);
  919.   STR (X_Neu, Hilf); SetColor (1); OutTextXY (40, 4, Hilf);
  920.   STR (Y_ALt, Hilf); SetColor (0); OutTextXY (128, 4, Hilf);
  921.   STR (Y_Neu, Hilf); SetColor (1); OutTextXY (128, 4, Hilf);
  922. END;
  923. (*-----------------*)
  924. BEGIN  (* Bewegung *)
  925.  
  926.   AktSpalten := Spalten;   AktZeilen := Zeilen;
  927.   X_Alt := 1; Y_Alt := 1;
  928.   X_Neu := 1; Y_Neu := 1;
  929.   SetzCursor (X_Alt, Y_Alt, FALSE); ZeigerWechsel;
  930.   ScreenToRam (1);
  931.   HgFarbe := 0;  SetBkColor (HgFarbe);
  932.  
  933. REPEAT
  934.  X_Alt := X_Neu;  Y_Alt := Y_Neu;
  935.  HolZeichen (Taste);
  936.  
  937.  CASE UpCase (Taste) OF
  938.   ^D : BEGIN   (* Rechts *)
  939.          Delta := ORD ((X_Alt + 1 <= AktSpalten));
  940.          X_Neu := X_Alt + Delta;
  941.          ZeigerWechsel;
  942.        END;
  943.  
  944.   ^S : BEGIN    (* Links *)
  945.          Delta := ORD ((X_Alt - 1 >= 1));
  946.          X_Neu := X_Alt - Delta;
  947.          ZeigerWechsel;
  948.       END;
  949.  
  950.   ^E : BEGIN   (* Oben *)
  951.          Delta := ORD ((Y_Alt - 1 >= 1));
  952.          Y_Neu := Y_Alt - Delta;
  953.          ZeigerWechsel;
  954.       END;
  955.  
  956.   ^X : BEGIN    (* Unten *)
  957.          Delta := ORD ((Y_Alt + 1 <= AktZeilen));
  958.          Y_Neu := Y_Alt + Delta;
  959.          ZeigerWechsel;
  960.       END;
  961.  
  962.   ^W : BEGIN    (* Links oben *)
  963.          X_Neu := 1;   Y_Neu := 1;
  964.          ZeigerWechsel;
  965.       END;
  966.  
  967.   ^C : BEGIN    (* Rechts unten *)
  968.          X_Neu := AktSpalten;   Y_Neu := AktZeilen;
  969.          ZeigerWechsel;
  970.       END;
  971.  
  972.   '0'..'3' :   BEGIN   (* Farben *)
  973.                  AktFarbe := ORD (Taste) - 48;
  974.                  Farbe (X_Neu, Y_Neu);
  975.                END;
  976.  
  977.   'N'    : BEGIN       (* Neu --> alles löschen *)
  978.             IF Wirklich ('Löschen       <J> / <N>') THEN
  979.               BEGIN
  980.                 GraphMode := CGAC0;
  981.                 InitGraph (GraphDriver, GraphMode, GraphDir);
  982.                 RamToScreen (1);
  983.                 X_Neu := 1; Y_Neu := 1;
  984.                 AktSpalten := Spalten; AktZeilen := Zeilen;
  985.               END;   (* IF Neu *)
  986.            END;
  987.  
  988.   'G'    : BEGIN       (* Abmessungen festlegen *)
  989.              HolAbMessungen;
  990.              X_Neu := 1; Y_Neu := 1; ZeigerWechsel;
  991.            END;
  992.  
  993.   'S'    : BEGIN       (* Sprite in FILE (OF BYTE) speichern *)
  994.              SaveEditSprite  (HolFilename ('.SPR'));
  995.              X_Neu := 1; Y_Neu := 1; ZeigerWechsel;
  996.            END;
  997.  
  998.   'L'    : BEGIN       (* Sprite laden *)
  999.              LoadEditSprite  (HolFilename ('.SPR'));
  1000.              X_Neu := 1; Y_Neu := 1; ZeigerWechsel;
  1001.            END;
  1002.  
  1003.   'U'    : (* Sprite in UNIT speichern *)
  1004.        MachUnit (HolFilename ('.PAS'));
  1005.  
  1006.   'P'    : (* Palette wechseln *)
  1007.            HolPalette;
  1008.  
  1009.   'F'    : (* Sprite komplett mit Farbe füllen *)
  1010.            HolFarbe;
  1011.  
  1012.   'H'    : BEGIN
  1013.              HorizontalSpiegeln;
  1014.              X_Neu := 1; Y_Neu := 1;
  1015.            END;
  1016.  
  1017.   'V'    : BEGIN
  1018.              VertikalSpiegeln;
  1019.              X_Neu := 1; Y_Neu := 1;
  1020.            END;
  1021.  
  1022.   'I'    : BEGIN  (* Hintergrundfarbe wechseln *)
  1023.          INC (HgFarbe, 1);  SetBkColor (HgFarbe MOD 15);
  1024.        END;
  1025.  
  1026.   'D'    :  BEGIN (* Directory,  Grafik --> Text                        *)
  1027.       {
  1028.             (* hier nur die Angabe der Routinen                     *)
  1029.          ScreenToRam (2);
  1030.              TextMode (C80);  (* nicht RestoreCrtMode wg. 40-Zeichen ! *)
  1031.              WRITELN ('Directory-Unit s. PASCAL 6/7 88 !');
  1032.              WRITE ('Zurück zur Grafik mit einem beliebigen Tastendruck...');
  1033.              REPEAT UNTIL KeyPressed;
  1034.              SetGraphMode (GetGraphMode);
  1035.              RamToScreen (2);
  1036.        }
  1037.            END;
  1038.  
  1039.   'Z'    : (* grosser Sprite *)
  1040.        MachGrossenSprite;
  1041.  
  1042.   'E'    : IF Wirklich ('Programm-Ende <J> / <N>') THEN Taste := 'E';
  1043.  
  1044.   END;            (* CASE Taste OF *)
  1045. UNTIL Taste = 'E';
  1046.  
  1047. END;  (* Bewegung *)
  1048. (*-----------------------------------------------*)
  1049. BEGIN
  1050.   GraphDriver := CGA;   GraphMode := 0;
  1051.   GraphikInit (GraphDriver, GraphMode);
  1052.   Bildschirm;
  1053.   Bewegung;
  1054.   GraphikEnde;
  1055. END.
  1056.  
  1057.