Program IFF;

Label 98,99;

{$path"ram:include/","pascal:include/"}
{$incl"libraries/dos.h","intuition.lib","graphics.lib"}

Type
 BitMapHeader=Record
   Width,Height:Word;
   dX,dY:Integer;
   Depth,Mask:Byte;
   Kompr,pad:Boolean;
   transcolor:Word;
   XAspect,YAspect:Byte;
   SWidth,SHeight:integer
 End;

Var
  Fhandle:Long;
  MyScreen:p_Screen;
  MyView:p_ViewPort;
  FName:string[80];
  Hunkname:string[5];
  LongWord,Anz,LineSize:Long;
  ErrorFlag,HeadFlag,BodyFlag:Boolean;
  BMHD:BitMapHeader;
  BMap,ScrMode:Long;
  i,Zeile,Plane,Count:integer;
  RGB: Record r,g,b:Byte End;

Procedure FileError;
  Begin
    writeln('File Error!');
    ErrorFlag:=true
  End;

Procedure OverRead(L:Long);
  Var buf:String[50]; Anz:Long;
  Begin
    While (L>50) and not ErrorFlag Do
      Begin
        Anz:=DosRead(Fhandle,^buf,50)
        L:=L-50;
        If Anz<>50 Then FileError
      End;
    Anz:=DosRead(FHandle,^Buf,L mod 50)
  End;

Procedure ReadHunkName;
  Var Anz:Long;
  Begin
    If not ErrorFlag Then
      Begin
        Hunkname[5]:=chr(0);
        Anz:=DosRead(FHandle,^Hunkname,4);
        If Anz<>4 Then FileError
      End
  End;

Procedure ReadLong;
  Var Anz:Long;
  Begin
    If not ErrorFlag Then
      Begin
        Anz:=DosRead(FHandle,^Longword,4);
        If Anz<>4 Then FileError
      End
  End;

Procedure LiesZeile(Adr:Long);
  Var Anz,Count,Size:Long;
      i,j:integer;
      Head,Body:Short;
      Mem:^Short;
  Begin
    If Not ErrorFlag Then
      Begin
        Size:=(BMHD.Width+7)div 8;
        If not BMHD.Kompr Then
          Begin
            Anz:=DosRead(FHandle,ptr(Adr),Size);
            If Anz<>Size Then FileError
          End
        Else
          Begin
            i:=0;
            While (i<Size) and not ErrorFlag Do
              Begin
                Anz:=DosRead(FHandle,^Head,1);
                If Head>=0 Then
                  Begin
                    Anz:=DosRead(FHandle,Ptr(Adr+i),Head+1);
                    If Anz<>Head+1 Then FileError;
                    i:=i+Head+1
                  End
                Else
                  Begin
                    Anz:=DosRead(FHandle,^Body,1);
                    If Anz<>1 Then FileError;
                    For j:=1 to 1-Head Do
                      Begin
                        Mem:=Ptr(Adr+i);
                        Mem^:=Body;
                        i:=i+1
                      End
                  End
              End
          End;
    End
  End;

Begin
  OpenLib(intbase,'intuition.library',0);
  OpenLib(gfxbase,'graphics.library' ,0);
  write('Filename: ');readln(FName);
  If FName='' Then Goto 99;
  ErrorFlag:=false; HeadFlag:=false; Bodyflag:=false;
  Fhandle:=Open(FName,MODE_OLDFILE);
  If FHandle=0 Then
    Begin writeln('Datei konnte nicht geöffnet werden.');
      Goto 99 End;
   ReadHunkName;
   If HunkName<>'FORM' Then
     Begin writeln('Kein IFF-Format.'); Goto 98 End;
   ReadLong; ReadHunkName;
   If HunkName<>'ILBM' Then
     Begin writeln('Kein ILBM-File.'); Goto 98 End;
   ReadHunkName;
   While Not Errorflag Do
     Begin
       ReadLong;
       If not FromWB Then writeln(HunkName,LongWord:8);
       If HunkName='BMHD' Then
         Begin
           Anz:=DosRead(fhandle,^BMHD,SizeOf(BitMapHeader));
           OverRead(LongWord-SizeOf(BitMapHeader));
           If not FromWB Then With BMHD Do
             Begin
               writeln('Breite:  ',Width);
               writeln('Höhe:    ',Height);
               writeln('Tiefe:   ',Depth);
               writeln('Maske:   ',Mask);
               If Kompr Then writeln('Komprimiert')
             End;
           With BMHD Do
             Begin
               ScrMode:=GENLOCK_VIDEO;
               If SWidth>320 Then
                 ScrMode:=ScrMode+HIRES;
               If SHeight>255 Then ScrMode:=ScrMode+LACE;
               MyScreen:=Open_Screen(0,0,SWidth,SHeight+12,Depth,0,1,ScrMode,FName);
             End;
           MyView:=^MyScreen^.ViewPort;
           HeadFlag:=true
         End
       Else
       If HunkName='CMAP' Then
         Begin
           If not Headflag Then FileError;
           For i:=0 to LongWord div 3-1 Do
             Begin
               Anz:=DosRead(FHandle,^RGB,3);
               If Anz<>3 Then FileError;
               SetRGB4(MyView,i,RGB.r div 16,RGB.g div 16,RGB.b div 16)
             End
         End
       Else
       If HunkName='BODY' Then
         Begin
           If Bodyflag or not HeadFlag Then FileError;
           BMap:=Long(^MyScreen^.BitMap);
           LineSize:=(MyScreen^.Width+7) div 8;
           For Zeile:=12 to BMHD.Height+11 Do
             For Plane:=0 to pred(BMHD.Depth) Do
               LiesZeile(Long(MyScreen^.BitMap.Planes[Plane])+Zeile*MyScreen^.BitMap.BytesPerRow);
           BodyFlag:=true;
         End
       Else
         OverRead(LongWord);
       If not ErrorFlag Then
         Begin
           Hunkname[5]:=chr(0);
           Anz:=DosRead(FHandle,^Hunkname,4);
           ErrorFlag:=Anz<>4
         End
     End;
  Delay(100);
  98:DosClose(FHandle);
  If HeadFlag Then Close_Screen(MyScreen);
  99:
End.