home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / Pascal / MAXONPASCAL3.DMS / in.adf / DEMOS-OS1.3 / showiff.p < prev    next >
Encoding:
Text File  |  1994-07-23  |  19.9 KB  |  696 lines
  1. PROGRAM IFF;
  2.  
  3. { Lade - und Anzeigeprogramm für ILBM-Bilder
  4.   Jens "Himpelsoft" Gelhar 1989/90
  5.  
  6.   Dieses Programm kennen Sie vielleicht schon als Demo der frühen Versionen
  7.   von KICK-Pascal. Es ist aber inzwischen stark verbessert worden. Zum
  8.   einen konnte die Ladegeschwindigkeit auf ein recht gutes Niveau
  9.   gesteigert werden, so daß man das lauffähige Programm wirklich sinnvoll
  10.   benutzen kann. Außerdem kann man es jetzt auch direkt von der Workbench
  11.   starten, indem man es entweder als "Default Tool" im Icon eines Bildes
  12.   einträgt oder zuerst das Bild-Icon und dann mit "geSHIFTetem" Doppelklick
  13.   ein Exe-File von "IFF.p" startet.
  14.   Beim Start aus dem CLI kann man jetzt den Dateinamen als Parameter
  15.   angeben, etwa
  16.  
  17.     Iff Bild
  18.  
  19.   Es gibt eine ganze Menge Optionen, die beim Start aus dem CLI gewählt
  20.   werden können, indem man ihre Kennbuchstaben mit einem vorangestellten
  21.   "-" in beliebiger Reihenfolge vor oder hinter dem Dateinamen angibt,
  22.   etwa:
  23.  
  24.     IFF Bild -n -t
  25.  
  26.   Die Optionen kann man auch beim Workbench-Start benutzen, indem man
  27.   im Icon des Bildes als "Tool Type" ein bestimmtes Wort schreibt.
  28.   Hier ist eine Liste aller Optionen:
  29.   -n  Das Bild wird auf keinen Fall im Interlace-Modus dargestellt (ist
  30.       besser für die Augen). Als Tool Type ist "NoInter" oder "NoLace"
  31.       zu wählen.
  32.   -i  Das Bild WIRD im Interlace-Modus ausgegeben. Tool Type: "INTER"
  33.       oder "LACE".
  34.   -h  erzwingt Hold-And-Modify-Modus. Tool Type: "HAM". Diese Option
  35.       ist weitgehend überflüssig, denn bei Lo-Res-Bildern mit 6 Planes
  36.       wird defaultmäßig der HAM-Mode gewählt.
  37.   -l  Option für Lo-Res-Modus (320*256 Punkte). Tool Type: "LoRes".
  38.   -m  schaltet auf hohe Auflösung (640 Punkte breit). Tool Type: "HiRes"
  39.       oder "MedRes".
  40.   -x  wählt den Extra-Halfbrite-Modus, was aber nur bei Lo-Res-Bildern
  41.       mit 6 Bitplanes geht. Beim Start von der Workbench ist "XHALF"
  42.       als Tool Type anzugeben.
  43.   -t  "Talk"-Option: Während des Ladens werden Informationen über das
  44.       Bild und die Bilddaten ausgegeben. Diese Option ist nur beim
  45.       CLI-Start anwählbar.
  46.  
  47.   Das Bild wird so lange angezeigt, bis eine der Tasten Space, Return,
  48.   Enter oder Escape gedrückt wird. Wenn das Bild größer als die
  49.   Bildschirmauflösung ist, z. B. weil ein Hi-Res-Interlace-Bild mit der
  50.   Option "-l" geladen wurde, kann der angezeigte Bildausschnitt mit den
  51.   Cursortasten gescrollt werden.
  52.  
  53.   Die Bilddaten werden in der vorliegenden Version nicht mehr direkt
  54.   auf den Bildschirm geladen, sondern zuerst in einen Puffer abgelegt,
  55.   von wo jeweils der gerade aktuelle Ausschnitt (bei übergroßen Bildern)
  56.   mit Zuhilfenahme des Blitters auf den Screen kopiert wird.
  57.  
  58.   Dieses Programm ist nicht nur ungemein nützlich - welcher Amiganer
  59.   hat nicht im Laufe der Zeit eine mehr oder weniger umfangreiche
  60.   IFF-Bildersammlung angelegt und will sie des öfteren ansehen, ohne
  61.   erst ein Malprogramm o. Ä. zu laden - sondern auch lehrreich: es
  62.   demonstriert folgende immer wiederkehrende Programmieraufgaben:
  63.   - Parameterübernahme vom CLI und der Workbench. Wie Sie sehen können,
  64.     ist es überhaupt nicht schwierig, einen Dateinamen von der Workbench
  65.     zu holen. Man muß nur die Include-Datei "workbench/startup.h"
  66.     einlesen und ein wenig mit Zeigern und Records hantieren.
  67.   - Schnelle Dateihandhabung: Die alte Version von "IFF.p" war allein
  68.     deshalb so lahm, weil die Daten in kleinen Portionen - Byte für
  69.     Byte, teilweise auch Langwortweise - aus der Bilddatei gelesen
  70.     wurden. Dabei macht sich dann bemerkbar, daß das DOS des Amiga nicht
  71.     gerade schnell ist. In der neuen Version legt "IFF.p" einen 10 KByte
  72.     großen Pufferspeicher an, aus dem dann byteweise gelesen werden
  73.     kann, bis er leer ist und neu geladen werden muß.
  74.   - Benutzung des Blitters. Aus einem Pufferspeicher, in den die
  75.     Bilddaten zunächst geladen werden, werden sie mit dem Blitter
  76.     blit(t)zschnell in die Bitmap des Screens kopiert.
  77. }
  78.  
  79. { MaxonPascal3-Anpassung:  Falk Zühlsdorff (PackMAN) 1994 
  80.  
  81.   benutzt: geänderte 'Workbench/startup.h' © by PackMAN
  82.  
  83.   bei Tooltype z.B. HAM=TRUE im Icon angeben...                        }
  84.  
  85. {$opt q}
  86.  
  87. USES Graphics,Intuition,Custom,DOS;
  88. {$incl "workbench/startup.h","icon.lib",'workbench/Workbench.h'}
  89.  
  90. CONST
  91.   BufSize = 10000;      { Länge des Datei-Buffers }
  92.   ScreenBar = 11;       { Höhe Screen-Titelbalken }
  93.   ScreenW = 336;        { Breite Lo-Res-Screen }
  94.   ScreenH = 250;        { Höhe Lo-Res-Screen ohne Titelbalken}
  95.   MaxPlane = 11;        { höchstens 12 Planes }
  96.  
  97. TYPE
  98.   BitMapHeader = RECORD
  99.     Width, Height: Word;
  100.     dX, dY: Integer;
  101.     Depth, Mask: Byte;
  102.     Kompr, Pad: Boolean;
  103.     transcolor: Word;
  104.     XAspect, YAspect: Byte;
  105.     SWidth, SHeight: integer
  106.   END;
  107.  
  108. VAR
  109.   Fil: FILE OF BYTE;            { IFF-Datei }
  110.   FName: STRING;                { Dateiname }
  111.   FilLen, FilPos: Long;         { Merker für "FileSize" und "FilePos" }
  112.  
  113.   ScrMode: Word;
  114.   SBreite, SHoehe, Tiefe: integer;   { Maße des geöffneten Screens }
  115.   RGB: ARRAY [ 0..63 ] OF RECORD
  116.                             R,G,B: Byte
  117.                        END;
  118.  
  119.   Ende, FileEnde, ErrorFlag:Boolean;
  120.   Talky, Inter, NonInter, HamMode, XHalf, LoRes, Res640: Boolean;
  121.  
  122.   HeadFlag, BodyFlag, CamgFlag, CmapFlag: Boolean;  { Flags: Hunk gelesen ? }
  123.   BMHD: BitMapHeader;           { Inhalt des BMHD-Hunks }
  124.  
  125.   BitMaps: ARRAY[0..11] OF Long;
  126.   BytesProZeile: integer;
  127.  
  128.   XOffs, YOffs: integer;        { Scroll-Position }
  129.   XStep, YStep: integer;        { Scrool-Schrittweite }
  130.  
  131.   MyWindow: p_Window;
  132.   MyScreen: p_Screen;
  133.  
  134.   Msg: p_IntuiMessage;          { RAWKEY-Message }
  135.  
  136.  
  137.  
  138. PROCEDURE ParameterAuswerten;
  139.   { Bei Start von Workbench oder CLI Dateinamen des Bildes ermitteln }
  140.  
  141.   VAR Para:    STRING;
  142.       i:       integer;
  143.  
  144.   PROCEDURE OverRead;
  145.     BEGIN
  146.       WHILE (Para[i] > chr(0) ) AND (Para[i] <= ' ') DO i:=i+1;
  147.       IF (Para[i]='-') AND (Upcase( Para[ i+1 ] ) IN ['A'..'Z'] ) THEN
  148.         BEGIN
  149.           CASE Upcase( Para[ i+1] ) OF
  150.           'H': HamMode := true;
  151.           'I': Inter := true;
  152.           'L': LoRes := true;
  153.           'M': Res640 := true;
  154.           'N': NonInter := true;
  155.           'T': Talky := true;
  156.           'X': XHalf := true;
  157.           OTHERWISE
  158.             i := i-2
  159.           END;
  160.           i := i + 2;
  161.           OverRead
  162.         END;
  163.     END;
  164.  
  165.   PROCEDURE StartVonWorkbench;       {einige Änderungen © by PackMAN}
  166.     TYPE mytooltype = ^char;
  167.     VAR  StMess    : p_WBStartup;
  168.          DiskObj   : p_DiskObject;
  169.          OldLock   : BPTR;
  170.          i, j      : integer;
  171.          St        : STRING[10];         
  172.          toolarray : ^mytooltype;
  173.     BEGIN
  174.       OpenLib(IconBase,'icon.library',0);
  175.       StMess := StartupMessage;
  176.       IF StMess^.sm_NumArgs < 2 THEN
  177.        FName := ''
  178.       ELSE
  179.         WITH StMess^.sm_ArgList^[2] DO
  180.           BEGIN
  181.             { Als Datei wird das Argument Nr. #2 genommen. Falls noch
  182.               mehr Icons aktiviert sing (z. B. durch "Shift-Klick",
  183.               werden diese ignoroert. }
  184.             FName := wa_Name;
  185.             { reiner Name ohne Pfad! Deshalb muss das aktuelle Verzeichnis
  186.               entsprechend gewählt werden:  }
  187.             OldLock := CurrentDir( wa_Lock );
  188.             { "ToolTypes" holen }
  189.             DiskObj := GetDiskObject( FName );  { Icon laden }
  190.             IF DiskObj<>NIL THEN
  191.               BEGIN
  192.                 toolarray:=DiskObj^.do_ToolTypes;
  193.                 St:=FindToolType(toolarray,'HAM');
  194.                 IF St='true' THEN HamMode:=true;
  195.                 St:=FindToolType(toolarray,'NOLACE');
  196.                 IF St='true' THEN NonInter:=true;
  197.                 St:=FindToolType(toolarray,'NOINTER');
  198.                 IF St='true' THEN NonInter:=true;
  199.                 St:=FindToolType(toolarray,'LACE');
  200.                 IF St='true' THEN Inter:=true;
  201.                 St:=FindToolType(toolarray,'INTER');
  202.                 IF St='true' THEN Inter:=true;
  203.                 St:=FindToolType(toolarray,'HIRES');
  204.                 IF St='true' THEN Res640:=true;
  205.                 St:=FindToolType(toolarray,'MEDRES');
  206.                 IF St='true' THEN res640:=true;
  207.                 St:=FindToolType(toolarray,'LORES');
  208.                 IF St='true' THEN LoRes:=true;
  209.               
  210.                 FreeDiskObject( DiskObj );
  211.               END;
  212.           END;
  213.       CloseLib(IconBase);
  214.     END;
  215.  
  216.   BEGIN
  217.     Talky := false;     { Defaultwerte für }
  218.     Inter := false;     { Optionen }
  219.     NonInter := false;
  220.     HamMode := false;
  221.     LoRes := false;
  222.     Res640 := false;
  223.     XHalf := false;
  224.     IF FromWB THEN
  225.       StartVonWorkbench
  226.     ELSE     { Start vom CLI }
  227.       BEGIN
  228.         FName := '';
  229.         IF ParameterLen < 80 THEN
  230.           BEGIN
  231.             Para := ParameterStr;
  232.             Para[ ParameterLen+1 ] := chr(0);
  233.             i := 1;
  234.             OverRead;
  235.             IF Para[i] IN [chr(0),'?'] THEN
  236.               BEGIN  { Kein Parameter angegeben }
  237.                 writeln(#27'[33mIFF'#27'[31m - Laden und Anzeigen von IFF-Bildern');
  238.                 writeln('Geschrieben von '#27'[33mJens Gelhar'#27'[31m 1990 mit '#27'[33mKICK-Pascal'#27'[31m.');
  239.                 write  ('<Dateiname> [-h] [-i] [-l] [-m] [-n] [-t] [-x] : ' );
  240.                 readln( Para );
  241.                 i := 1;
  242.                 OverRead
  243.               END;
  244.             WHILE Para[i] > ' ' DO
  245.               BEGIN
  246.                 FName := FName+Para[i];
  247.                 i := i+1
  248.               END;
  249.             OverRead;
  250.             IF Para[i] <> chr(0) THEN Error( 'Falscher Parameter!' )
  251.           END
  252.       END;
  253.   END;
  254.  
  255.  
  256.  
  257. PROCEDURE DateiOeffnen;
  258.   BEGIN
  259.     Reset ( Fil, FName );
  260.     IF IOResult<>0 THEN
  261.       Error('Datei konnte nicht geöffnet werden.');
  262.     Buffer ( Fil, BufSize );
  263.     FilLen := FileSize( Fil );
  264.     FilPos := 0;
  265.     ErrorFlag := false;
  266.     FileEnde := false;
  267.   END;
  268.  
  269.  
  270.  
  271. PROCEDURE CloseAll;
  272.   { Datei, Screen usw. Schließen }
  273.   VAR i: integer;
  274.   BEGIN
  275.     Close( Fil );
  276.     FOR i:=0 TO MaxPlane DO
  277.       IF BitMaps[i]<>0 THEN
  278.         Free_Mem( BitMaps[i], BytesProZeile*BMHD.Height );
  279.     IF MyWindow<>NIL THEN
  280.       Close_Window( MyWindow );
  281.     IF MyScreen<>NIL THEN
  282.       Close_Screen( MyScreen );
  283.     IF NOT FromWB THEN Writeln;
  284.   END;
  285.  
  286.  
  287. PROCEDURE LoadILBM;
  288.   VAR Hunkname: STRING[5];
  289.       LongWord: Long;
  290.       i, Zeile, Plane, Count: integer;
  291.       IntText: IntuiText;
  292.       CamgWord: Word;
  293.       FormLen:  Long;
  294.       HunkEnd:  Long;
  295.  
  296.  
  297.   PROCEDURE FileError;
  298.     BEGIN
  299.       IF NOT ErrorFlag THEN
  300.         BEGIN
  301.           Writeln('File Error!');
  302.           ErrorFlag:=true;
  303.           FileEnde := true
  304.         END
  305.     END;
  306.  
  307.  
  308.   PROCEDURE Lies ( p: Ptr; L: Long);
  309.     { "L" Bytes nach Adresse "p" laden }
  310.     VAR p2: ^ARRAY[1..MaxLong] OF BYTE;
  311.         i : Long;
  312.     BEGIN
  313.       p2 := p;
  314.       IF ErrorFlag THEN
  315.         { Fehler bereits aufgetreten => alles mit Nullen füllen }
  316.         BEGIN
  317.           FOR i:=1 TO L DO p2^[i]:=0;
  318.         END
  319.       ELSE
  320.         BEGIN
  321.           BlockRead(Fil, p2^, L);
  322.           FileEnde := EoF(Fil);
  323.           ErrorFlag := IoResult<>0
  324.         END;
  325.     END;
  326.  
  327.  
  328.   PROCEDURE OverRead (L:Long);
  329.     { "L" Bytes überlesen }
  330.     VAR buf:String[50];
  331.     BEGIN
  332.       WHILE (L>50) and not ErrorFlag Do
  333.         BEGIN
  334.           Lies(^buf,50);
  335.           L:=L-50;
  336.         END;
  337.       Lies(^Buf,L mod 50)
  338.     END;
  339.  
  340.  
  341.   PROCEDURE ReadHunkName;
  342.     BEGIN
  343.       Hunkname[5]:=chr(0);
  344.       Lies(^Hunkname,4)
  345.     END;
  346.  
  347.  
  348.   PROCEDURE ReadLong;
  349.     BEGIN
  350.       Lies(^Longword,4);
  351.     END;
  352.  
  353.  
  354.   PROCEDURE LiesZeile(Adr:Long);
  355.     Var Size:  integer;
  356.         i,j:   integer;
  357.         Head:  Short;
  358.         Body:  Byte;
  359.         Zeile: ^ARRAY[0..MaxInt] OF Byte;
  360.     BEGIN
  361.       IF Not ErrorFlag THEN
  362.         BEGIN
  363.           Zeile := Ptr(Adr);
  364.           Size := ((BMHD.Width + 15) SHR 3) AND $FFE;
  365.           IF not BMHD.Kompr THEN
  366.             Lies(Ptr(Adr),Size)
  367.           ELSE
  368.             BEGIN
  369.               i:=0;
  370.               WHILE (i < Size) and not ErrorFlag Do
  371.                 BEGIN
  372.                   Lies( ^Head, 1 );
  373.                   IF Head >= 0 THEN
  374.                     BEGIN
  375.                       Lies(Ptr(Adr+i),Head+1);
  376.                       i:=i+Head+1
  377.                     END
  378.                   ELSE
  379.                     IF Head <> -128 THEN
  380.                       BEGIN
  381.                         Lies( ^Body, 1 );
  382.                         FOR j := i TO i-Head DO Zeile^[j] := Body;
  383.                         i := 1 + i - Head;
  384.                       END
  385.                 END
  386.             END;
  387.       END
  388.     END;
  389.  
  390.   PROCEDURE Hunk_BMHD;
  391.     BEGIN
  392.       IF HeadFlag THEN FileError;
  393.  
  394.       Lies( ^BMHD, SizeOf(BitMapHeader) );
  395.       OverRead( LongWord-SizeOf(BitMapHeader) );
  396.  
  397.       WITH BMHD DO
  398.         BEGIN
  399.           IF Talky THEN
  400.             BEGIN
  401.               Writeln('Breite:  ',Width);
  402.               Writeln('Höhe:    ',Height);
  403.               Writeln('Tiefe:   ',Depth);
  404.               Writeln('Screen:  ',SWidth,'*',SHeight);
  405.               Writeln('Maske:   ',Mask);
  406.               IF Kompr THEN
  407.                 Writeln('Komprimiert')
  408.             END;
  409.  
  410.           SBreite := ScreenW;
  411.           SHoehe := ScreenH;
  412.           ScrMode:=GENLOCK_VIDEO;
  413.           Tiefe := Depth;
  414.  
  415.           { Grafikmodus und Auflösung ermitteln: }
  416.  
  417.           IF SHeight > ScreenH THEN      { Interlace erforderlich }
  418.             BEGIN
  419.               ScrMode := ScrMode+LACE;
  420.               SHoehe := 2*SHoehe
  421.             END;
  422.  
  423.           IF SWidth>ScreenW THEN
  424.             BEGIN
  425.               ScrMode := ScrMode+HIRES;
  426.               SBreite := 2*SBreite
  427.             END;
  428.  
  429.           IF (SBreite=ScreenW) AND (Tiefe=6) THEN
  430.             ScrMode := ScrMode+HAM;
  431.             { Bei 6 Planes Lo-Res wird HAM vermutet. }
  432.  
  433.           BytesProZeile := ((Width+15) AND $fff0) SHR 3;
  434.           FOR i:=0 TO Depth-1 DO
  435.             Bitmaps[i] :=
  436.               Alloc_Mem( BytesProZeile*Height, 2);
  437.         END;
  438.       HeadFlag := true;
  439.     END;
  440.  
  441.  
  442.   PROCEDURE Hunk_CMAP;
  443.     VAR i: integer;
  444.     BEGIN
  445.       Cmapflag := true;
  446.       FOR i:=0 TO LongWord DIV 3-1 DO
  447.         Lies( ^RGB[i AND $3f], 3 );
  448.     END;
  449.  
  450.  
  451.   PROCEDURE Hunk_BODY;
  452.     BEGIN
  453.       IF Bodyflag OR NOT HeadFlag THEN FileError;
  454.  
  455.       FOR Zeile := 0 TO BMHD.Height-1 DO
  456.         FOR Plane := 0 TO BMHD.Depth-1 DO
  457.           LiesZeile( Bitmaps[Plane] + Zeile*BytesProZeile );
  458.       BodyFlag := true
  459.     END;
  460.  
  461.  
  462.   PROCEDURE Hunk_CAMG;
  463.     VAR i: integer;
  464.       PROCEDURE Hexx(n: Word);
  465.         BEGIN
  466.           IF n>15 THEN Hexx(n DIV 16);
  467.           write('0123456789abcdef'.[n AND $f +1]);
  468.         END;
  469.     BEGIN
  470.       CamgFlag := true;
  471.       FOR i:=1 TO (LongWord+1) DIV 2 DO
  472.         BEGIN
  473.           Lies(^CamgWord,2);
  474.         END;
  475.       IF Talky THEN
  476.         BEGIN
  477.           write('  Viewmode: '); Hexx(CamgWord); writeln;
  478.         END;
  479.     END;
  480.  
  481.   BEGIN  { Proc LoadILBM }
  482.     HeadFlag := false;
  483.     Bodyflag := false;
  484.     CamgFlag := false;
  485.     CmapFlag := false;
  486.  
  487.     FOR i:=0 TO MaxPlane DO Bitmaps[i] := 0;
  488.  
  489.     ReadHunkName;
  490.     IF HunkName<>'FORM' THEN
  491.        BEGIN
  492.          CloseAll;
  493.          Error('Kein IFF-Format.')
  494.        END;
  495.     IF NOT FromWB THEN
  496.       Write('Loading ',FName,'...');
  497.     IF Talky THEN Writeln;
  498.  
  499.     ReadLong;
  500.     FormLen := LongWord;
  501.  
  502.     ReadHunkName;
  503.     IF HunkName<>'ILBM' THEN
  504.       BEGIN
  505.         CloseAll;
  506.         Error('Kein ILBM-File.')
  507.       END;
  508.  
  509.     WHILE FilePos(Fil)+12 < FileSize(Fil) DO
  510.       BEGIN
  511.         ReadHunkName;
  512.         ReadLong;
  513.         IF Talky THEN
  514.           Writeln( HunkName, LongWord:8, ' Bytes' );
  515.  
  516.         { Nur Hunks gerader Länge: }
  517.         LongWord := (LongWord + 1) AND $FFFFFe;
  518.         HunkEnd := FilePos(Fil) + LongWord;
  519.  
  520.         IF HunkName='BMHD' THEN
  521.           Hunk_BMHD
  522.         ELSE
  523.         IF HunkName='CMAP' THEN
  524.           Hunk_CMAP
  525.         ELSE
  526.         IF HunkName='BODY' THEN
  527.           Hunk_BODY
  528.         ELSE
  529.         IF HunkName='CAMG' THEN
  530.           Hunk_CAMG;
  531.  
  532.         IF ( FilePos(Fil) < HunkEnd ) AND ( HunkEnd < FileSize(Fil) ) THEN
  533.           OverRead( HunkEnd-FilePos(Fil) );
  534.  
  535.       END;
  536.  
  537.     IF NOT HeadFlag THEN Exit;
  538.  
  539.     { Grafikmodus, Auflösung und Bildschirmgröße ermitteln }
  540.  
  541.     IF CamgFlag THEN ScrMode:=CamgWord;
  542.  
  543.     IF HAMMode AND (Tiefe=6) THEN
  544.       BEGIN
  545.         SBreite := ScreenW; ScrMode := ScrMode OR HAM
  546.       END;
  547.     IF LoRes THEN
  548.       BEGIN
  549.         SBreite := ScreenW; SHoehe := ScreenH;
  550.         ScrMode := Scrmode AND NOT(HIRES OR LACE)
  551.       END;
  552.     IF Res640 THEN
  553.       BEGIN
  554.         SBreite := 2*ScreenW;
  555.         ScrMode := ScrMode OR HIRES;
  556.       END;
  557.     IF Inter THEN
  558.       BEGIN
  559.         SHoehe := 2*ScreenH; ScrMode := ScrMode OR LACE
  560.       END;
  561.     IF NonInter THEN
  562.       BEGIN
  563.         SHoehe := ScreenH; ScrMode := ScrMode AND NOT LACE
  564.       END;
  565.     IF XHalf AND (Tiefe=6) THEN
  566.       BEGIN
  567.         SBreite := ScreenW;
  568.         ScrMode := ScrMode OR EXTRA_HALFBRITE AND NOT HAM
  569.       END;
  570.  
  571.     IF SHoehe > BMHD.Height THEN SHoehe := BMHD.Height;
  572.     IF SBreite > BMHD.Width THEN SBreite := BMHD.Width;
  573.  
  574.     XOffs := (BMHD.Width-SBreite) DIV 2;
  575.     YOffs := (BMHD.Height-SHoehe) DIV 2;
  576.     XStep := (BMHD.Width DIV 80 + 15) AND $7ff0;
  577.     YStep := BMHD.Height DIV 40;
  578.   END;
  579.  
  580.  
  581. PROCEDURE OeffneScreen;
  582.   { Nach Ergebnissen von LoadILBM Bildschirm öffnen }
  583.   VAR i      : integer;
  584.       MyView : Ptr;
  585.   BEGIN
  586.     MyScreen:=Open_Screen( 0, 0, SBreite, SHoehe+ScreenBar, Tiefe,
  587.               0, 1, ScrMode, FName);
  588.     MyWindow:=Open_Window( 0, ScreenBar, SBreite, SHoehe, 1,
  589.               RAWKEY,ACTIVATE+BORDERLESS, Nil, MyScreen,
  590.               SBreite, SHoehe, SBreite, SHoehe );
  591.     MyView := ^MyScreen^.ViewPort;
  592.     FOR i:=0 TO 1 SHL Tiefe -1 DO
  593.       WITH RGB[i] DO
  594.          SetRGB4( MyView, i, r div 16, g div 16, b div 16)
  595.   END;
  596.  
  597.  
  598. PROCEDURE DisplayPicture;
  599.   VAR Plane: integer;
  600.       Wort: Word;
  601.  
  602.   PROCEDURE BlitIt (Von, Nach: Long; x,y,Mod1,Mod2: integer);
  603.     { Anfangsadressen "Von", "Nach", "x" Worte breit, "y" Zeilen,
  604.       Modulowerte in Bytes (!) }
  605.     VAR i, j, k: integer;
  606.         v, n: ^ARRAY[0..MaxInt] OF Word;
  607.         C: Custom ABSOLUTE $dff000;
  608.     BEGIN
  609.       OwnBlitter;
  610.       { Zitat A. Krämer: "OwnBlitter! Hör' mir bloß auf mit Ownblitter!"
  611.         Eigentlich sollte jene Funktion warten, bis der Blitter mit
  612.         seiner vorherigen Operation fertig ist. Macht sie aber nicht
  613.         immer. Deshalb sorgen wir selbst dafür, daß mit dem Erteilen des
  614.         nächsten Auftrags gewartet wird:                                }
  615.       WHILE C.DMACONR AND $4000 <> 0 DO;
  616.  
  617.       C.BLTAPT := Ptr(Von);
  618.       C.BLTDPT := Ptr(Nach);
  619.       C.BLTAMOD := Mod1;
  620.       C.BLTDMOD := Mod2;
  621.       C.BLTCON0 := %0000100111110000;
  622.       C.BLTCON1 := 0;
  623.       C.BLTAFWM := $ffff;
  624.       C.BLTALWM := $ffff;
  625.       C.BLTSIZE := (y AND $3FF) SHL 6 + (x AND $3F);
  626.       DisownBlitter
  627.     END;
  628.  
  629.   BEGIN
  630.     Wort := (SBreite+15) shr 4;
  631.     WITH MyScreen^.Bitmap DO
  632.       FOR Plane:=0 TO BMHD.Depth-1 DO
  633.         BlitIt ( BitMaps[Plane] + 2*(XOffs SHR 4) + YOffs*BytesProZeile,
  634.                  Long( Planes[Plane] ) + ScreenBar*BytesPerRow,
  635.                  Wort,
  636.                  SHoehe,
  637.                  BytesProZeile- 2 * Wort,
  638.                  (BytesPerRow+1)AND $FFE  - 2*Wort );
  639.   END;
  640.  
  641.  
  642.  
  643. BEGIN
  644.   MyScreen := NIL;
  645.   MyWindow := NIL;
  646.  
  647.   ParameterAuswerten;
  648.   IF FName='' THEN Exit;
  649.   DateiOeffnen;
  650.   LoadILBM;
  651.  
  652.   IF NOT (HeadFlag AND Bodyflag) THEN Exit;  { Kein Bild geladen!! }
  653.   OeffneScreen;
  654.   DisplayPicture;
  655.  
  656.   Ende := false;
  657.   REPEAT
  658.     Msg := Wait_Port(MyWindow^.UserPort);
  659.     Msg := Get_Msg(MyWindow^.UserPort);
  660.     CASE Msg^.Code OF
  661.      $4c: BEGIN
  662.             IF YOffs >= YStep THEN YOffs := YOffs-YStep
  663.                               ELSE YOffs := 0;
  664.             DisplayPicture
  665.           END;
  666.      $4d: BEGIN
  667.             IF YOffs+YStep+SHoehe <= BMHD.Height THEN
  668.               YOffs := YOffs+YStep
  669.             ELSE YOffs := BMHD.Height-SHoehe;
  670.             DisplayPicture
  671.           END;
  672.      $4e: BEGIN
  673.             IF XOffs+XStep+SBreite <= BMHD.Width THEN
  674.               XOffs := XOffs+XStep
  675.             ELSE XOffs := BMHD.Width-SBreite;
  676.             DisplayPicture
  677.           END;
  678.      $4f: BEGIN
  679.             IF XOffs >= XStep THEN XOffs := XOffs-XStep
  680.                               ELSE XOffs := 0;
  681.             DisplayPicture
  682.           END;
  683.      $40, $43, $44, $45: Ende := true;
  684.     OTHERWISE
  685.       { andere Taste }
  686.     END;
  687.  
  688.     REPEAT  { Nachlaufen vermeiden! }
  689.       Msg := Get_Msg(MyWindow^.UserPort)
  690.     UNTIL Msg=NIL;
  691.  
  692.   UNTIL Ende;
  693.   CloseAll
  694. END.
  695.  
  696.