Module TinyIFF (Images Amiga IFF ILBM PBM)

Flype · Post by **Flype** » Thu Sep 10, 2015 11:08 pm

This a module to open images encoded in IFF, a very popular format on Amiga 500 / 1200.

Some pics to play with :

A package of about 50 .IFF files (3.4Mb) :
https://www.filepicker.io/api/file/9TWib84jTZCM82hwZeET

Code: Select all

;----------------------------------------------------------
; Name:        Module TinyIFF
; Description: A tiny module for loading IFF images.
; Author:      flype, flype44(at)gmail(dot)com
; Revision:    1.1 (2015-09-10)
;----------------------------------------------------------
; ILBM ::= "FORM" #{ "ILBM" BMHD [CMAP] [CAMG] [BODY] }
; BMHD ::= "BMHD" #{ BitMapHeader }
; CMAP ::= "CMAP" #{ (Red Green Blue)* } [0]
; CAMG ::= "CAMG" #{ LONG }
; BODY ::= "BODY" #{ UBYTE* } [0]
;----------------------------------------------------------
; http://fileformats.archiveteam.org/wiki/ILBM
; http://wiki.amigaos.net/wiki/ILBM_IFF_Interleaved_Bitmap
;----------------------------------------------------------

DeclareModule TinyIFF
  Declare.i Catch(*memory, size.q = #PB_Ignore)
  Declare.i Load(fileName.s)
EndDeclareModule

Module TinyIFF
  
  ;----------------------------------------------------------
  ; INITS
  ;----------------------------------------------------------
  
  EnableExplicit
  
  ;----------------------------------------------------------
  ; PRIVATE MACROS
  ;----------------------------------------------------------
  
  Macro MAKEID(a, b, c, d)
    ((a)|((b)<<8)|((c)<<16)|((d)<<24))
  EndMacro
  
  Macro GetUInt16BE(a)
    ((((a)<<8)&$FF00)|(((a)>>8)&$FF))
  EndMacro
  
  Macro GetUInt32BE(a)
    ((((a)&$FF)<<24)|(((a)&$FF00)<<8)|(((a)>>8)&$FF00)|(((a)>>24)&$FF))
  EndMacro
  
  ;----------------------------------------------------------
  ; PRIVATE CONSTANTS
  ;----------------------------------------------------------
  
  #ID_FORM = MAKEID('F','O','R','M') ; IFF file
  #ID_ILBM = MAKEID('I','L','B','M') ; Interleaved Bitmap (Planar)
  #ID_PBM  = MAKEID('P','B','M',' ') ; Portable Bitmap (Chunky)
  #ID_BMHD = MAKEID('B','M','H','D') ; Bitmap Header
  #ID_CMAP = MAKEID('C','M','A','P') ; ColorMap
  #ID_CAMG = MAKEID('C','A','M','G') ; ViewModes
  #ID_BODY = MAKEID('B','O','D','Y') ; Bitmap Data
  
  Enumeration BitmapHeaderCmp
    #cmpNone     ; No compression
    #cmpByteRun1 ; ByteRun1 encoding
  EndEnumeration
  
  Enumeration BitmapHeaderMsk
    #mskNone                ; Opaque rectangular image
    #mskHasMask             ; Mask plane is interleaved with the bitplanes in the BODY chunk
    #mskHasTransparentColor ; Pixels in source planes matching 'transparentColor' are "transparent"
    #mskLasso               ; Reader may construct a mask by lassoing the image
  EndEnumeration
  
  Enumeration ViewModes
    #camgLace       = $0004 ; Interlaced
    #camgEHB        = $0080 ; Extra Half Bright
    #camgHAM        = $0800 ; Hold And Modify
    #camgHiRes      = $8000 ; High Resolution
    #camgSuperHiRes = $0020 ; Super High Resolution
  EndEnumeration
  
  ;----------------------------------------------------------
  ; PRIVATE STRUCTURES
  ;----------------------------------------------------------
  
  CompilerIf Defined(BYTES, #PB_Structure) = #False
    Structure BYTES
      b.b[0]
    EndStructure
  CompilerEndIf
  
  CompilerIf Defined(UBYTES, #PB_Structure) = #False
    Structure UBYTES
      b.a[0]
    EndStructure
  CompilerEndIf
  
  Structure IFF_RGB8
    r.a
    g.a
    b.a
  EndStructure
  
  Structure IFF_CMAP
    c.IFF_RGB8[0]
  EndStructure
  
  Structure IFF_BMHD
    w.u           ; UWORD
    h.u           ; UWORD
    x.w           ; WORD
    y.w           ; WORD
    nPlanes.a     ; UBYTE
    masking.a     ; UBYTE
    compression.a ; UBYTE
    pad.a         ; UBYTE
    tColor.u      ; UWORD
    xAspect.a     ; UBYTE
    yAspect.a     ; UBYTE
    pageWidth.w   ; WORD
    pageHeight.w  ; WORD
  EndStructure
  
  Structure IFF_Chunk
    code.l
    size.l
    bytes.UBYTES
  EndStructure
  
  Structure IFF_Header
    code.l
    size.l
    format.l
    chunk.UBYTES
  EndStructure
  
  ;----------------------------------------------------------
  ; PRIVATE PROCEDURES
  ;----------------------------------------------------------
  
  Procedure Log2(a)
    Protected b
    While a > ( 1 << b )
      b + 1
    Wend
    ProcedureReturn b
  EndProcedure
  
  Procedure FreeMem(*mem)
    If *mem
      FreeMemory(*mem)
    EndIf
  EndProcedure
  
  Procedure UnPackBitsSize(*bits.BYTES, packedSize)
    
    Protected i, j, k, n
    
    While i < packedSize
      n = *bits\b[i]
      If n >= 0
        For j = 0 To n
          k + 1
        Next
        i + j
      ElseIf n <> -128
        For j = 0 To -n
          k + 1
        Next
        i + 1
      EndIf
      i + 1
    Wend
    
    ProcedureReturn k
    
  EndProcedure
  
  Procedure UnPackBits(*bits.BYTES, packedSize)
    
    Protected i, j, k, n, *buf.BYTES, unpackedSize
    
    unpackedSize = UnPackBitsSize(*bits, packedSize)
    If unpackedSize > 0
      *buf = AllocateMemory(unpackedSize)
      If *buf <> 0
        While i < packedSize
          n = *bits\b[i]
          If n >= 0
            For j = 0 To n
              *buf\b[k] = *bits\b[i + 1 + j]
              k + 1
            Next
            i + j
          ElseIf n <> -128
            For j = 0 To -n
              *buf\b[k] = *bits\b[i + 1]
              k + 1
            Next
            i + 1
          EndIf
          i + 1
        Wend
      EndIf
    EndIf
    
    ProcedureReturn *buf
    
  EndProcedure
  
  Procedure UnInterleaveBits(*planar.UBYTES, width.w, height.w, nPlanes.b)
    
    Protected C0, C1, C2, C3, C4, C5, C6
    Protected bytesPerRow, bit, x, y, z, *chunky.UBYTES
    
    *chunky = AllocateMemory(width * height * nPlanes)
    If *chunky
      bytesPerRow = ( ( width + 15 ) >> 4 ) << 1
      C0 = nPlanes * bytesPerRow
      For y = 0 To height - 1
        C1 = y * C0
        C2 = y * width
        For z = 0 To nPlanes - 1
          C3 = 1 << z
          C4 = C1 + z * bytesPerRow
          For x = 0 To bytesPerRow - 1
            C5 = *planar\b[ C4 + x ]
            C6 = C2 + x << 3
            For bit = 0 To 7
              If C5 & ( 1 << ( 7 - bit ) )
                *chunky\b[ C6 + bit ] | C3
              EndIf
            Next
          Next
        Next
      Next
    EndIf
    
    ProcedureReturn *chunky
    
  EndProcedure
  
  Procedure ColorMapGray(*bmhd.IFF_BMHD)
    
    Protected i.l, numColors.l, *cmap.IFF_CMAP, *c.IFF_RGB8
    
    numColors = 1 << *bmhd\nPlanes
    If numColors > 0
      *cmap = AllocateMemory(numColors * SizeOf(IFF_RGB8), #PB_Memory_NoClear)
      If *cmap
        For i = 0 To numColors - 1
          *c = *cmap\c[i]
          *c\r = i * 255 / numColors
          *c\g = *c\r
          *c\b = *c\r
        Next
      EndIf
    EndIf
    
    ProcedureReturn *cmap
    
  EndProcedure
  
  Procedure ColorMapEHB(*bmhd.IFF_BMHD, *cmap.IFF_CMAP, cmapSize.l)
    
    Protected i.l, count.l, countEHB.l
    Protected *cmapEHB.IFF_CMAP, *c.IFF_RGB8, *d.IFF_RGB8
    
    count = cmapSize / SizeOf(IFF_RGB8)
    If count > 0
      If Log2(count) = *bmhd\nPlanes
        count / 2
      EndIf
      If count And count < ( 1 << *bmhd\nPlanes )
        countEHB = count * 2
        *cmapEHB = AllocateMemory(countEHB * SizeOf(IFF_RGB8), #PB_Memory_NoClear)
        If *cmap And *cmapEHB
          CopyMemory(*cmap, *cmapEHB, cmapSize)
          For i = count To countEHB - 1
            *c   = *cmap\c[i-count]
            *d   = *cmapEHB\c[i]
            *d\r = *c\r >> 1
            *d\g = *c\g >> 1
            *d\b = *c\b >> 1
          Next
        EndIf
      EndIf
    EndIf
    
    ProcedureReturn *cmapEHB
    
  EndProcedure
  
  Procedure GetPixelHAM(*cmap.IFF_CMAP, pixel, color, hbits, mbits, mask)
    
    Protected r, g, b
    
    Select pixel >> hbits
      Case 0 ; rgb
        r = *cmap\c[pixel & mask]\r
        g = *cmap\c[pixel & mask]\g
        b = *cmap\c[pixel & mask]\b
      Case 1 ; rgx
        r = Red(color)
        g = Green(color)
        b = ( pixel & mask ) << mbits
        b | ( b >> mbits )
      Case 2 ; xgb
        r = ( pixel & mask ) << mbits
        r | ( r >> mbits )
        g = Green(color)
        b = Blue(color)
      Case 3 ; rxg
        r = Red(color)
        g = ( pixel & mask ) << mbits
        g | ( g >> mbits )
        b = Blue(color)
    EndSelect
    
    ProcedureReturn RGBA(r, g, b, 255)
    
  EndProcedure
  
  Procedure DrawBitmapHAM(*bmhd.IFF_BMHD, *cmap.IFF_CMAP, *bits.UBYTES, image.i)
    
    Protected x, y, i, j, c, hbits, mbits, mask, tColor
    
    If *bmhd\nPlanes > 6
      hbits = 6
    Else
      hbits = 4
    EndIf
    
    mbits = ( 8  - hbits )
    mask  = ( 1 << hbits ) - 1
    
    tColor = RGBA(*cmap\c[*bmhd\tColor]\r,
                  *cmap\c[*bmhd\tColor]\g,
                  *cmap\c[*bmhd\tColor]\b, 0)
    
    If StartDrawing(ImageOutput(image))
      ;Box(0, 0, *bmhd\w, *bmhd\h, RGB(0, 255, 0))
      For y = 0 To *bmhd\h - 1
        c = RGB(0, 0, 0)
        For x = 0 To *bmhd\w - 1
          j = *bits\b[i]
          If ( *bmhd\masking & #mskHasTransparentColor ) And ( j = *bmhd\tColor )
            c = RGB(0, 0, 0)
            Plot(x, y, tColor)
          Else
            c = GetPixelHAM(*cmap, j, c, hbits, mbits, mask)
            Plot(x, y, c)
          EndIf
          i + 1
        Next
      Next
      StopDrawing()
    EndIf
    
  EndProcedure
  
  Procedure DrawBitmap(*bmhd.IFF_BMHD, *cmap.IFF_CMAP, *bits.UBYTES, image.i)
    
    Protected x.u, y.u, i.l, j.l, *c.IFF_RGB8
    
    If StartDrawing(ImageOutput(image))
      ;Box(0, 0, *bmhd\w, *bmhd\h, RGB(0, 255, 0))
      For y = 0 To *bmhd\h - 1
        For x = 0 To *bmhd\w - 1
          j = *bits\b[i]
          If ( *bmhd\masking & #mskHasTransparentColor ) And ( j = *bmhd\tColor )
            ; Do nothing, Transparent Color = No draw.
          Else
            *c = *cmap\c[j]
            Plot(x, y, RGB(*c\r, *c\g, *c\b))
          EndIf
          i + 1
        Next
      Next
      StopDrawing()
    EndIf
    
  EndProcedure
  
  ;----------------------------------------------------------
  ; PUBLIC PROCEDURES
  ;----------------------------------------------------------
  
  Procedure.i Catch(*mem.IFF_Header, size.q = #PB_Ignore)
    
    Protected image.i, cmapSize.l, xRes.d, yRes.d
    Protected *chunk.IFF_Chunk, *bmhd.IFF_BMHD
    Protected *body, *bodyUnpacked, *bodyUninterleaved
    Protected *eof, *cmap, *cmapEHB, *cmapGray, *camg.Long
    
    If *mem And *mem\code = #ID_FORM And ( *mem\format = #ID_ILBM Or *mem\format = #ID_PBM )
      *mem\size = GetUInt32BE(*mem\size)
      If *mem\size > 0 And *mem\size < size
        *chunk = *mem\chunk
        *eof = *mem + size
        While *chunk
          *chunk\size = GetUInt32BE(*chunk\size)
          If *chunk\size & 1
            *chunk\size + 1
          EndIf
          Select *chunk\code
            Case #ID_BMHD
              *bmhd = *chunk\bytes
              *bmhd\w = GetUInt16BE(*bmhd\w)
              *bmhd\h = GetUInt16BE(*bmhd\h)
              *bmhd\tColor = GetUInt16BE(*bmhd\tColor)
              If *bmhd\masking & #mskNone
                *bmhd\tColor = 0
              EndIf
              If *bmhd\masking & #mskHasMask
                *bmhd\nPlanes + 1
                *bmhd\tColor = 0
              EndIf
            Case #ID_CMAP
              *cmap = *chunk\bytes
              cmapSize = *chunk\size
            Case #ID_CAMG
              *camg = *chunk\bytes
              *camg\l = GetUInt32BE(*camg\l)
            Case #ID_BODY
              Select *mem\format
                Case #ID_ILBM
                  Select *bmhd\compression
                    Case #cmpNone
                      *bodyUninterleaved = UnInterleaveBits(*chunk\bytes, *bmhd\w, *bmhd\h, *bmhd\nPlanes)
                      If *bodyUninterleaved
                        *body = *bodyUninterleaved
                      EndIf
                    Case #cmpByteRun1
                      *bodyUnpacked = UnPackBits(*chunk\bytes, *chunk\size)
                      If *bodyUnpacked
                        *bodyUninterleaved = UnInterleaveBits(*bodyUnpacked, *bmhd\w, *bmhd\h, *bmhd\nPlanes)
                        If *bodyUninterleaved
                          *body = *bodyUninterleaved
                        EndIf
                      EndIf
                  EndSelect
                Case #ID_PBM
                  Select *bmhd\compression
                    Case #cmpNone
                      *body = *chunk\bytes
                    Case #cmpByteRun1
                      *bodyUnpacked = UnPackBits(*chunk\bytes, *chunk\size)
                      If *bodyUnpacked
                        *body = *bodyUnpacked
                      EndIf
                  EndSelect
              EndSelect
              If *camg And *camg\l & #camgEHB
                *cmapEHB = ColorMapEHB(*bmhd, *cmap, cmapSize)
                If *cmapEHB
                  *cmap = *cmapEHB
                EndIf
              EndIf
              If *cmap = #Null
                *cmapGray = ColorMapGray(*bmhd)
                If *cmapGray
                  *cmap = *cmapGray
                EndIf
              EndIf
              If *body And *cmap And *bmhd And *bmhd\w > 0 And *bmhd\h > 0
                image = CreateImage(#PB_Any, *bmhd\w, *bmhd\h, 24, RGB(0, 255, 0))
                If *bmhd\xAspect = 0 Or *bmhd\yAspect = 0
                  *bmhd\xAspect = 10
                  *bmhd\yAspect = 11
                EndIf
                xRes = 1.0 + ( *bmhd\xAspect / *bmhd\yAspect )
                yRes = 1.0 + ( *bmhd\yAspect / *bmhd\xAspect )
                If *camg And *camg\l & #camgHAM
                  DrawBitmapHAM(*bmhd, *cmap, *body, image)
                Else
                  DrawBitmap(*bmhd, *cmap, *body, image)
                EndIf
                ;If *camg And *camg\l & #camgLace
                ;  yRes / 2.0
                ;EndIf
                ResizeImage(image, *bmhd\w * xRes, *bmhd\h * yRes, #PB_Image_Raw)
              EndIf
              FreeMem(*cmapEHB)
              FreeMem(*cmapGray)
              FreeMem(*bodyUninterleaved)
              FreeMem(*bodyUnpacked)
              Break
          EndSelect
          If *chunk < *eof
            *chunk + 8 + *chunk\size
          Else
            *chunk = 0
          EndIf
        Wend
      EndIf
    EndIf
    
    ProcedureReturn image
    
  EndProcedure
  
  Procedure.i Load(fileName.s)
    
    Protected image.i, file.i, fileSize.q, *fileData
    
    file = ReadFile(#PB_Any, fileName)
    If file
      fileSize = Lof(file)
      If fileSize > 0
        *fileData = AllocateMemory(fileSize, #PB_Memory_NoClear)
        If *fileData
          If ReadData(file, *fileData, fileSize)
            image = Catch(*fileData, fileSize)
          EndIf
          FreeMemory(*fileData)
        EndIf
      EndIf
      CloseFile(file)
    EndIf
    
    ProcedureReturn image
    
  EndProcedure
  
EndModule

Flype · Post by **Flype** » Thu Sep 10, 2015 11:10 pm

A small IFF displayer that use the module TinyIFF.pbi,
Open images by drag'n'drop .iff files on the window.

Code: Select all

IncludeFile "TinyIFF.pbi"

EnableExplicit

;==============================================================================

Procedure load(file.s)
  
  Protected image, iw, ih, ww, wh
  
  image = TinyIFF::Load(file)
  
  If image
    ww = WindowWidth(0)
    wh = WindowHeight(0)
    iw = ImageWidth(image)
    ih = ImageHeight(image)
    ResizeGadget(0, ( ww - iw ) / 2, ( wh - ih ) / 2, #PB_Ignore, #PB_Ignore)
    SetWindowTitle(0, GetFilePart(file))
    SetGadgetState(0, ImageID(image))
    FreeImage(image)
  EndIf
  
EndProcedure

;==============================================================================

If OpenWindow(0, 0, 0, 1280, 1024, "", #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_ScreenCentered)
  
  SetWindowColor(0, RGB(0, 0, 0))
  ImageGadget(0, 0, 0, WindowWidth(0), WindowHeight(0), 0)
  EnableWindowDrop(0, #PB_Drop_Files, #PB_Drag_Link)
  
  load("Suny_Bobby.iff") ; <<<<<<<<<<< changer le nom de fichier !!!
  
  Repeat
    Select WaitWindowEvent()
      Case #PB_Event_CloseWindow
        Break
      Case #PB_Event_WindowDrop
        load(StringField(EventDropFiles(), 1, Chr(10)))
    EndSelect
  ForEver
  
EndIf

;==============================================================================

Keya · Post by **Keya** » Fri Sep 11, 2015 1:24 am

Very interesting, thankyou for sharing

btw does it support transparency? Its tricky to tell from this part of the code if you've left it unsupported or if it's simply not filling the pixel because it's transparent heehee:

Code: Select all

If ( *bmhd\masking & #mskHasTransparentColor ) And ( j = *bmhd\tColor )
            ; Transparent Color
          Else
            *c = *cmap\c[j]
            Plot(x, y, RGB(*c\r, *c\g, *c\b))
          EndIf

OldSkoolGamer · Post by **OldSkoolGamer** » Fri Sep 11, 2015 2:20 am

This brings back some memories, thanks for the code.

Bisonte · Post by **Bisonte** » Fri Sep 11, 2015 3:55 am

btw does it support transparency?

Ehm... No.

This "TransparentColor" means something different.

IFF have bitplanes. each bitplain have one color. that means e.g. a whole in bitplane 0 and 1 is to display the color of bitplane 3....and so on.

Thanks flype. I will test it with my archiv

Maybe I can create now my IconConverter

Flype · Post by **Flype** » Fri Sep 11, 2015 7:03 am

From IFF specs, TransparentColor = No draw = Hole.
So it is a supported feature but not visible because of 'black' background.
However, not very really interesting. It would be more useful when using images as sprites.
UnpackBits(), UnInterleaved(), HAM decoding required much more scratching'head

If you found bugs, let me know, i really would like to support maximum cases - and with a link to the buggy .iff file.

Flype · Post by **Flype** » Thu Sep 17, 2015 9:58 am

Hi, i've updated the IFF loader.

Many changes, Easier to use, Big reduce of code,
Fixed HAM8 little bug, and some optimizations,
Added fast loading IFF 24 bits routine,
Added some loading/catching options : ImageID, KeepAspect and ResizeMode.
Removed transparency, not very consistent and useful in this TinyIFF module.

Code: Select all

DeclareModule TinyIFF_EN
  
  ; @TinyIFF::Load()
  ; Load the specified IFF-ILBM or IFF-PBM image from a file.
  ; #ImageID   : A number to identify the loaded image. #PB_Any can be specified to auto-generate this number. 
  ; FileName$  : The name of the file to load. Can be absolute or relative to the current directory. 
  ; KeepAspect : Keep the original aspect (use or not use BitmapHeader xAspect/yAspect).
  ; ResizeMode : The resize method. It can be one of the following values: 
  Declare Load(ImageID.l, FileName$, KeepAspect.l = #True, ResizeMode.l = #PB_Image_Raw)
  
  ; @TinyIFF::Catch()
  ; Load the specified image from the given memory area.
  ; #ImageID   : A number to identify the loaded image. #PB_Any can be specified to auto-generate this number. 
  ; *Memory    : The memory address from which to load the image.
  ; MemSize.q  : The size of the image in bytes. The size is mandatory to prevent from corrupted images.
  ; KeepAspect : Keep the original aspect (use or not use the BitmapHeader xAspect/yAspect).
  ; ResizeMode : The resize method. It can be #PB_Image_Raw or #PB_Image_Smooth
  Declare Catch(ImageID.l, *Memory, MemSize.q, KeepAspect.l = #True, ResizeMode.l = #PB_Image_Raw)
  
  ; @Parameter KeepAspect
  ; #True  : Keep the original aspect (default if not specified).
  ; #False : Resize the image by using the BitmapHeader xAspect/yAspect.
  
  ; @Parameter ResizeMode
  ; #PB_Image_Raw    : Resize the image without any interpolation.
  ; #PB_Image_Smooth : Resize the image with smoothing (default if not specified).
  
EndDeclareModule

Compatible with following formats :

Code: Select all

. [X] FORM ILBM (2 à 256 colors)
. [X] FORM ILBM EHB (64 colors)
. [X] FORM ILBM HAM6 (4096 colors)
. [_] FORM ILBM SHAM (4096 à 9216 colors) (not yet implemented)
. [X] FORM ILBM HAM8 (262144 à 16777216 colors)
. [X] FORM ILBM 24bits (16777216 colors)
. [X] FORM PBM 8bits (2 à 256 colors)
. [X] FORM PBM 24bits (16777216 colors) (not tested)

Code: Select all

DeclareModule TinyIFF_EN
  
  ; @TinyIFF::Load()
  ; Load the specified IFF-ILBM or IFF-PBM image from a file.
  ; #ImageID   : A number to identify the loaded image. #PB_Any can be specified to auto-generate this number. 
  ; FileName$  : The name of the file to load. Can be absolute or relative to the current directory. 
  ; KeepAspect : Keep the original aspect (use or not use BitmapHeader xAspect/yAspect).
  ; ResizeMode : The resize method. It can be one of the following values: 
  Declare Load(ImageID.l, FileName$, KeepAspect.l = #True, ResizeMode.l = #PB_Image_Raw)
  
  ; @TinyIFF::Catch()
  ; Charge une image à partir de l'emplacement mémoire spécifié.
  ; #ImageID   : A number to identify the loaded image. #PB_Any can be specified to auto-generate this number. 
  ; *Memory    : The memory address from which to load the image.
  ; MemSize.q  : The size of the image in bytes. The size is mandatory to prevent from corrupted images.
  ; KeepAspect : Keep the original aspect (use or not use the BitmapHeader xAspect/yAspect).
  ; ResizeMode : The resize method. It can be #PB_Image_Raw or #PB_Image_Smooth
  Declare Catch(ImageID.l, *Memory, MemSize.q, KeepAspect.l = #True, ResizeMode.l = #PB_Image_Raw)
  
  ; @Parameter KeepAspect
  ; #True  : Keep the original aspect (default if not specified).
  ; #False : Resize the image by using the BitmapHeader xAspect/yAspect.
  
  ; @Parameter ResizeMode
  ; #PB_Image_Raw    : Resize the image without any interpolation.
  ; #PB_Image_Smooth : Resize the image with smoothing (default if not specified).
  
EndDeclareModule

;--------------------------------------------------------------------------------------------------
  
Module TinyIFF
  
  ;------------------------------------------------------------------------------------------------
  
  EnableExplicit
  
  ;------------------------------------------------------------------------------------------------
  
  Macro UINT16(a)
    ((((a)<<8)&$FF00)|(((a)>>8)&$FF))
  EndMacro
  
  Macro UINT32(a)
    ((((a)&$FF)<<24)|(((a)&$FF00)<<8)|(((a)>>8)&$FF00)|(((a)>>24)&$FF))
  EndMacro
  
  Macro MAKEID(a, b, c, d)
    ((a)|((b)<<8)|((c)<<16)|((d)<<24))
  EndMacro
  
  ;------------------------------------------------------------------------------------------------
  
  Enumeration ChunkIDs
    #ID_FORM = MAKEID('F','O','R','M') ; IFF file
    #ID_ILBM = MAKEID('I','L','B','M') ; Interleaved Bitmap (Planar)
    #ID_PBM  = MAKEID('P','B','M',' ') ; Portable Bitmap (Chunky)
    #ID_BMHD = MAKEID('B','M','H','D') ; Bitmap Header
    #ID_CMAP = MAKEID('C','M','A','P') ; Color Map
    #ID_CAMG = MAKEID('C','A','M','G') ; View Modes
    #ID_BODY = MAKEID('B','O','D','Y') ; Bitmap Data
  EndEnumeration
  
  Enumeration ViewModes
    #camgLace       = $0004 ; Interlaced
    #camgEHB        = $0080 ; Extra Half Bright
    #camgHAM        = $0800 ; Hold And Modify
    #camgHiRes      = $8000 ; High Resolution
    #camgSuperHiRes = $0020 ; Super High Resolution
  EndEnumeration
  
  Enumeration BitmapHeaderCmp
    #cmpNone     ; No compression
    #cmpByteRun1 ; ByteRun1 encoding
  EndEnumeration
  
  ;------------------------------------------------------------------------------------------------
  
  Structure BYTES
    b.b[0]
  EndStructure
  
  Structure UBYTES
    b.a[0]
  EndStructure
  
  Structure IFF_RGB8
    r.a
    g.a
    b.a
  EndStructure
  
  Structure IFF_BMHD
    w.u           ; UWORD
    h.u           ; UWORD
    x.w           ; WORD
    y.w           ; WORD
    nPlanes.a     ; UBYTE
    masking.a     ; UBYTE
    compression.a ; UBYTE
    pad.a         ; UBYTE
    tColor.u      ; UWORD
    xAspect.a     ; UBYTE
    yAspect.a     ; UBYTE
    pageWidth.w   ; WORD
    pageHeight.w  ; WORD
  EndStructure
  
  Structure IFF_CMAP
    c.IFF_RGB8[0]
  EndStructure
  
  Structure IFF_Chunk
    id.l
    size.l
    bytes.UBYTES
  EndStructure
  
  Structure IFF_Header
    id.l
    size.l
    name.l
    chunk.UBYTES
  EndStructure
  
  ;------------------------------------------------------------------------------------------------
  
  Procedure UnPackBits(*bh.IFF_BMHD, *packedBits.BYTES, packedSize, rowBytes)
    Protected i, j, k, v, unpackedSize, *unpackedBits.BYTES
    unpackedSize = 1 + ( *bh\h * rowBytes * *bh\nPlanes )
    If unpackedSize
      *unpackedBits = AllocateMemory(unpackedSize)
      If *unpackedBits
        While i < packedSize
          v = *packedBits\b[i]
          If v >= 0
            For j = 0 To v
              *unpackedBits\b[k] = *packedBits\b[i + 1 + j]
              k + 1
            Next
            i + j
          ElseIf v <> -128
            For j = 0 To -v
              *unpackedBits\b[k] = *packedBits\b[i + 1]
              k + 1
            Next
            i + 1
          EndIf
          i + 1
        Wend
      EndIf
    EndIf
    ProcedureReturn *unpackedBits
  EndProcedure
  
  ;------------------------------------------------------------------------------------------------
  
  Procedure Catch_PBM_8(*bh.IFF_BMHD, *bp.UBYTES, Array cmap.l(1))
    Protected x, y, i
    For y = 0 To *bh\h - 1
      For x = 0 To *bh\w - 1
        Plot(x, y, cmap(*bp\b[i]))
        i + 1
      Next
    Next
  EndProcedure
  
  Procedure Catch_PBM_24(*bh.IFF_BMHD, *bp.UBYTES)
    Protected x, y, i
    For y = 0 To *bh\h - 1
      For x = 0 To *bh\w - 1
        Plot(x, y, RGB(*bp\b[i], *bp\b[i+1], *bp\b[i+2]))
        i + 3
      Next
    Next
  EndProcedure
  
  ;------------------------------------------------------------------------------------------------
  
  Procedure Catch_ILBM_8(*bh.IFF_BMHD, *bp.UBYTES, rowBytes.w, camg.l, cmapSize.l, Array cmap.l(1))
    Protected i, x, y, c, p, plane, mbits, mask, hbits, Dim pixels(*bh\w)
    If camg & #camgHAM
      hbits = 4
      If *bh\nPlanes > 6 : hbits + 2 : EndIf
      mbits = 8 - hbits
      mask = ( 1 << hbits ) - 1
    EndIf
    If camg & #camgEHB
      For i = 0 To ( cmapSize / 3 ) - 1
        cmap(i+32) = RGB(Red(cmap(i)) >> 1, Green(cmap(i)) >> 1, Blue(cmap(i)) >> 1)
      Next
    EndIf
    For y = 0 To *bh\h - 1
      For plane = 0 To *bh\nPlanes - 1
        For x = 0 To *bh\w - 1
          If *bp\b[x >> 3] & ( 128 >> ( x % 8 ) )
            pixels(x) | ( 1 << plane )
          EndIf
        Next
        *bp + rowBytes
      Next
      For x = 0 To *bh\w - 1
        If camg & #camgHAM
          p = pixels(x)
          Select p >> hbits
            Case 0: c = cmap(p & mask)
            Case 1: c = RGB(Red(c), Green(c), ( p & mask ) << mbits)
            Case 2: c = RGB(( p & mask ) << mbits, Green(c), Blue(c))
            Case 3: c = RGB(Red(c), ( p & mask ) << mbits, Blue(c))
          EndSelect
        Else
          c = cmap(pixels(x))
        EndIf
        Plot(x, y, c)
        pixels(x) = 0
      Next
      c = 0
    Next
  EndProcedure
  
  Procedure Catch_ILBM_24(*bh.IFF_BMHD, *bp.UBYTES, rowBytes.l)
    Protected x, y, w, h, p, plane, p0, p1, p2
    Protected Dim m(*bh\w), Dim r(*bh\w), Dim g(*bh\w), Dim b(*bh\w)
    w = *bh\w - 1 : h = *bh\h - 1 : p = *bh\nPlanes - 1
    For x = 0 To w : m(x) = 128 >> ( x % 8 ) : Next
    For y = 0 To h
      For plane = 0 To p
        p0 = 1 <<   plane
        p1 = 1 << ( plane -  8 )
        p2 = 1 << ( plane - 16 )
        If plane < 8
          For x = 0 To w
            If *bp\b[x >> 3] & m(x) : r(x) | p0 : EndIf
          Next
        ElseIf plane > 15
          For x = 0 To w
            If *bp\b[x >> 3] & m(x) : b(x) | p2 : EndIf
          Next
        Else
          For x = 0 To w
            If *bp\b[x >> 3] & m(x) : g(x) | p1 : EndIf
          Next
        EndIf
        *bp + rowBytes
      Next
      For x = 0 To w
        Plot(x, y, RGB(r(x), g(x), b(x)))
        r(x) = 0 : g(x) = 0 : b(x) = 0
      Next
    Next
  EndProcedure
  
  ;------------------------------------------------------------------------------------------------
  
  Procedure Catch(ImageID.l, *m.IFF_Header, MemSize.q, KeepAspect.l = #True, ResizeMode.l = #PB_Image_Raw)
    Protected i.l, image.i, rowBytes.w, camg.l, cmapSize.l, *imageOutput, *bp, *eof, *bodyUnpacked
    Protected *ck.IFF_Chunk, *bh.IFF_BMHD, *cmap.IFF_CMAP, Dim cmap.l(256)
    If *m And *m\id = #ID_FORM And ( *m\name = #ID_ILBM Or *m\name = #ID_PBM )
      *m\size = UINT32(*m\size)
      If *m\size > 0 And *m\size < MemSize
        *eof = *m + MemSize
        *ck = *m\chunk
        While *ck
          *ck\size = UINT32(*ck\size)
          If *ck\size & 1
            *ck\size + 1
          EndIf
          Select *ck\id
            Case #ID_BMHD
              *bh = *ck\bytes
              *bh\w = UINT16(*bh\w)
              *bh\h = UINT16(*bh\h)
              rowBytes = ( ( ( *bh\w + 15 ) >> 4 ) << 1 )
            Case #ID_CAMG
              camg = UINT32(PeekL(*ck\bytes))
              Debug "camg = %" + RSet(Bin(camg, #PB_Long), 32, "0")
            Case #ID_CMAP
              *cmap = *ck\bytes
              cmapSize = *ck\size
              For i = 0 To ( cmapSize / 3 ) - 1
                cmap(i) = RGB(*cmap\c[i]\r, *cmap\c[i]\g, *cmap\c[i]\b)
              Next
            Case #ID_BODY
              *bp = *ck\bytes
              If *bh\compression = #cmpByteRun1
                *bodyUnpacked = UnPackBits(*bh, *ck\bytes, *ck\size, rowBytes)
                *bp = *bodyUnpacked
              EndIf
              If *bp And *bh
                image = CreateImage(ImageID, *bh\w, *bh\h, 24, RGB(0, 0, 0))
                If image
                  If ImageID = #PB_Any
                    *imageOutput = ImageOutput(image)
                  Else
                    *imageOutput = ImageOutput(ImageID)
                  EndIf
                  If StartDrawing(*imageOutput)
                    Select *m\name
                      Case #ID_ILBM
                        If *bh\nPlanes = 24
                          Catch_ILBM_24(*bh, *bp, rowBytes)
                        Else
                          Catch_ILBM_8(*bh, *bp, rowBytes, camg, cmapSize, cmap())
                        EndIf
                      Case #ID_PBM
                        If *bh\nPlanes = 24
                          Catch_PBM_24(*bh, *bp)
                        Else
                          Catch_PBM_8(*bh, *bp, cmap())
                        EndIf
                    EndSelect
                    StopDrawing()
                  EndIf
                EndIf
                If KeepAspect = #False
                  If *bh\xAspect = 0 Or *bh\yAspect = 0
                    *bh\xAspect = 10 : *bh\yAspect = 11
                  EndIf
                  Protected xRes.d = 1.0 + ( *bh\xAspect / *bh\yAspect )
                  Protected yRes.d = 1.0 + ( *bh\yAspect / *bh\xAspect )
                  If ImageID = #PB_Any
                    ResizeImage(image, *bh\w * xRes, *bh\h * yRes, ResizeMode)
                  Else
                    ResizeImage(ImageID, *bh\w * xRes, *bh\h * yRes, ResizeMode)
                  EndIf
                EndIf
              EndIf
              If *bodyUnpacked
                FreeMemory(*bodyUnpacked)
              EndIf
              Break
          EndSelect
          If *ck < *eof
            *ck + 8 + *ck\size
          Else
            *ck = 0
          EndIf
        Wend
      EndIf
    EndIf
    ProcedureReturn image
  EndProcedure
  
  Procedure Load(ImageID.l, FileName$, KeepAspect.l = #True, ResizeMode.l = #PB_Image_Raw)
    Protected image.i, file.i, fileSize.q, *fileData
    file = ReadFile(#PB_Any, FileName$)
    If file
      fileSize = Lof(file)
      If fileSize > 0
        *fileData = AllocateMemory(fileSize, #PB_Memory_NoClear)
        If *fileData
          If ReadData(file, *fileData, fileSize) > 0
            image = Catch(ImageID, *fileData, fileSize, KeepAspect, ResizeMode)
          EndIf
          FreeMemory(*fileData)
        EndIf
      EndIf
      CloseFile(file)
    EndIf
    ProcedureReturn image
  EndProcedure
  
EndModule

;--------------------------------------------------------------------------------------------------

Flype · Post by **Flype** » Thu Sep 17, 2015 11:52 am

Here is a ready-to-go archive.

Contains Includes + Viewer + about 40 various tests IFF pictures.
https://www.filepicker.io/api/file/3OaoviNtQrmcDHOXsUKX

Contains some others great IFF pictures.
https://www.filepicker.io/api/file/9TWib84jTZCM82hwZeET

Some pics are > 1MB - better disable debugger (loading times are often x20 or more).

I'm quite happy with the fast IFF ILBM 24 bits time loading.
On my machine, the picture ILBM_24Bits_1419x1001_Marble.iff that is
3.4 MB, 1419 x 1001 x 24 bits, 1 420 419 pixels, packed (byteRun1) and interleaved (PlanarToChunky)
load in less than 350 millisecs, that is not bad i think (no ASM for portability).

EDIT: I've uploaded new (removed gtk2 in compiler options).

oakvalley · Post by **oakvalley** » Thu Oct 06, 2016 4:31 pm

Would it also be possible to convert images (like png, bmp, jpg or just internal image in memory) and SAVE it as IFF instead of just loading.

Simply reversing this code somehow?

PureBasic Forums - English

Module TinyIFF (Images Amiga IFF ILBM PBM)

Module TinyIFF (Images Amiga IFF ILBM PBM)

Re: Module TinyIFF (Images Amiga IFF ILBM PBM)

Re: Module TinyIFF (Images Amiga IFF ILBM PBM)

Re: Module TinyIFF (Images Amiga IFF ILBM PBM)

Re: Module TinyIFF (Images Amiga IFF ILBM PBM)

Re: Module TinyIFF (Images Amiga IFF ILBM PBM)

Re: Module TinyIFF (Images Amiga IFF ILBM PBM)

Re: Module TinyIFF (Images Amiga IFF ILBM PBM)

Re: Module TinyIFF (Images Amiga IFF ILBM PBM)