; =====================================================
; gif.pbi - standalone GIF decoder and encoder
; =====================================================

DeclareModule GIF
  EnableExplicit

  Structure IndexedFrame
    Width.i
    Height.i
    *Indices
    *PaletteRGB
    ColorCount.i
  EndStructure

  Declare.i Catch(*Buffer, BufferSize.i, ImageID.i = #PB_Any, FrameIndex.i = 0)
  Declare.i Load(Filename.s, ImageID.i = #PB_Any, FrameIndex.i = 0)
  Declare.i CountMemory(*Buffer, BufferSize.i)
  Declare.i Count_Images(Filename.s)
  Declare.i LZWEncode(*Indices, PixelCount.i, MinCodeSize.i, *OutSize.Integer)
  Declare.i SaveWriteByte(File.i, Value.i)
  Declare.i ClampInt(Value.i, MinValue.i, MaxValue.i)
  Declare.i NextPowerOfTwo(Value.i)
  Declare.i IntLog2(Value.i)
  Declare Build332Palette(Array PaletteR.i(1), Array PaletteG.i(1), Array PaletteB.i(1))
  Declare.i QuantizeImage332(ImageID.i, *Indices)
  Declare BuildPaletteLevels(MaxColors.i, *LevelR.Integer, *LevelG.Integer, *LevelB.Integer)
  Declare BuildPaletteFromLevels(LevelR.i, LevelG.i, LevelB.i, Array PaletteR.i(1), Array PaletteG.i(1), Array PaletteB.i(1), *UsedColors.Integer, StartIndex.i = 0)
  Declare.i CreateScaledCopy(SourceImageID.i, TargetWidth.i, TargetHeight.i)
  Declare.i QuantizeImageToLevels(ImageID.i, *Indices, LevelR.i, LevelG.i, LevelB.i, BaseIndex.i = 0)
  Declare.i AddExactPaletteColors(ImageID.i, Map ColorToIndex.i(), Array PaletteR.i(1), Array PaletteG.i(1), Array PaletteB.i(1), *UsedColors.Integer, StartIndex.i, MaxEntries.i, *Overflow.Integer)
  Declare.i QuantizeImageExact(ImageID.i, *Indices, Map ColorToIndex.i())
  Declare.i WriteGIFGlobalHeader(File.i, Width.i, Height.i, Array PaletteR.i(1), Array PaletteG.i(1), Array PaletteB.i(1), ColorTableSize.i)
  Declare.i WriteGIFLoopExtension(File.i, LoopCount.i)
  Declare.i WriteGIFFrame(File.i, *LZW, LZWSize.i, Left.i, Top.i, Width.i, Height.i, DelayCS.i, MinCodeSize.i, TransparentFlag.i = #False, TransparentIndex.i = 0, Disposal.i = 1)
  Declare.i WriteGIFFrameLocalPalette(File.i, *LZW, LZWSize.i, Left.i, Top.i, Width.i, Height.i, DelayCS.i, MinCodeSize.i, Array PaletteR.i(1), Array PaletteG.i(1), Array PaletteB.i(1), ColorTableSize.i, Disposal.i = 1)
  Declare.i Encode(ImageID.i, *OutSize.Integer = #Null)
  Declare.i Save(ImageID.i, Filename.s)
  Declare.i Save_Animated(Filename.s, List ImageIDs.i(), DelayCS.i = 5, LoopCount.i = 0, MaxColors.i = 256, FrameStep.i = 1, TargetWidth.i = 0, TargetHeight.i = 0, UseDeltaBBox.i = #False, UseTransparentDelta.i = #False, UseExactPaletteIfPossible.i = #True)
  Declare.i Save_Animated_LocalPalettes(Filename.s, List ImageIDs.i(), DelayCS.i = 5, LoopCount.i = 0, MaxColors.i = 256, FrameStep.i = 1)
  Declare.i Save_Animated_IndexedPalettes(Filename.s, List Frames.IndexedFrame(), DelayCS.i = 5, LoopCount.i = 0)
  Declare.s GetLastError()
  Declare.s GetGIFInfo()
EndDeclareModule

Module GIF
  EnableExplicit

  Structure MemoryWriter
    *Data
    Size.i
    Pos.i
    Capacity.i
  EndStructure

  Global LastError.s = ""

  Procedure.s GetGIFInfo()
    ProcedureReturn "Module: GIF; File: gif.pbi; PureBasic module; standalone GIF decoder and encoder"
  EndProcedure

  Procedure SetLastError(Message.s)
    LastError = Message
  EndProcedure

  Procedure.s GetLastError()
    ProcedureReturn LastError
  EndProcedure

  Procedure.i ReadLEWord(*Memory, Offset.i = 0)
    ProcedureReturn (PeekA(*Memory + Offset) & $FF) | ((PeekA(*Memory + Offset + 1) & $FF) << 8)
  EndProcedure

  Procedure.i ReadWholeFile(Filename.s, *OutSize.Integer)
    Protected Size.i = FileSize(Filename)
    Protected File.i
    Protected *Memory

    If *OutSize : *OutSize\i = 0 : EndIf
    If Size <= 0 : ProcedureReturn 0 : EndIf

    File = ReadFile(#PB_Any, Filename)
    If File = 0 : ProcedureReturn 0 : EndIf

    *Memory = AllocateMemory(Size)
    If *Memory = 0
      CloseFile(File)
      ProcedureReturn 0
    EndIf

    If ReadData(File, *Memory, Size) <> Size
      FreeMemory(*Memory)
      CloseFile(File)
      ProcedureReturn 0
    EndIf

    CloseFile(File)
    If *OutSize : *OutSize\i = Size : EndIf
    ProcedureReturn *Memory
  EndProcedure

  Procedure.i WriteWholeFile(Filename.s, *Memory, MemorySize.i)
    Protected File.i
    Protected Ok.i

    If Filename = "" Or *Memory = 0 Or MemorySize <= 0
      ProcedureReturn #False
    EndIf

    File = CreateFile(#PB_Any, Filename)
    If File = 0 : ProcedureReturn #False : EndIf
    Ok = Bool(WriteData(File, *Memory, MemorySize) = MemorySize)
    CloseFile(File)
    ProcedureReturn Ok
  EndProcedure

  Procedure.i DrawingBufferY(Y.i, Height.i, PixelFormat.i)
    If PixelFormat & #PB_PixelFormat_ReversedY
      ProcedureReturn Height - 1 - Y
    EndIf
    ProcedureReturn Y
  EndProcedure

  Procedure.i InitMemoryWriter(*Writer.MemoryWriter, InitialCapacity.i = 65536)
    If *Writer = 0 : ProcedureReturn #False : EndIf
    If InitialCapacity < 1024 : InitialCapacity = 1024 : EndIf
    *Writer\Data = AllocateMemory(InitialCapacity)
    If *Writer\Data = 0 : ProcedureReturn #False : EndIf
    *Writer\Capacity = InitialCapacity
    *Writer\Size = 0
    *Writer\Pos = 0
    ProcedureReturn #True
  EndProcedure

  Procedure.i MemoryWriterReserve(*Writer.MemoryWriter, NeedSize.i)
    Protected NewCapacity.i
    Protected *NewData

    If *Writer = 0 Or NeedSize < 0 : ProcedureReturn #False : EndIf
    If NeedSize <= *Writer\Capacity : ProcedureReturn #True : EndIf

    NewCapacity = *Writer\Capacity
    While NewCapacity < NeedSize
      NewCapacity * 2
    Wend

    *NewData = ReAllocateMemory(*Writer\Data, NewCapacity)
    If *NewData = 0 : ProcedureReturn #False : EndIf
    *Writer\Data = *NewData
    *Writer\Capacity = NewCapacity
    ProcedureReturn #True
  EndProcedure

  Procedure.i MemoryWriteByte(*Writer.MemoryWriter, Value.i)
    If MemoryWriterReserve(*Writer, *Writer\Pos + 1) = #False
      ProcedureReturn #False
    EndIf
    PokeA(*Writer\Data + *Writer\Pos, Value & $FF)
    *Writer\Pos + 1
    If *Writer\Pos > *Writer\Size : *Writer\Size = *Writer\Pos : EndIf
    ProcedureReturn #True
  EndProcedure

  Procedure.i MemoryWriteWordLE(*Writer.MemoryWriter, Value.i)
    ProcedureReturn Bool(MemoryWriteByte(*Writer, Value) And MemoryWriteByte(*Writer, Value >> 8))
  EndProcedure

  Procedure.i MemoryWriteData(*Writer.MemoryWriter, *Buffer, Size.i)
    If *Buffer = 0 Or Size < 0 Or MemoryWriterReserve(*Writer, *Writer\Pos + Size) = #False
      ProcedureReturn 0
    EndIf
    CopyMemory(*Buffer, *Writer\Data + *Writer\Pos, Size)
    *Writer\Pos + Size
    If *Writer\Pos > *Writer\Size : *Writer\Size = *Writer\Pos : EndIf
    ProcedureReturn Size
  EndProcedure

  Procedure.i FinishMemoryWriter(*Writer.MemoryWriter)
    Protected *Result

    If *Writer = 0 Or *Writer\Data = 0 Or *Writer\Size <= 0
      ProcedureReturn 0
    EndIf
    *Result = ReAllocateMemory(*Writer\Data, *Writer\Size)
    If *Result : *Writer\Data = *Result : EndIf
    ProcedureReturn *Writer\Data
  EndProcedure

  Procedure.i SkipSubBlocks(*Buffer, BufferSize.i, *Pos.Integer)
    Protected BlockSize.i
    
    While #True
      If *Pos\i >= BufferSize
        ProcedureReturn #False
      EndIf
      
      BlockSize = PeekA(*Buffer + *Pos\i) & $FF
      *Pos\i + 1
      
      If BlockSize = 0
        ProcedureReturn #True
      EndIf
      
      If *Pos\i + BlockSize > BufferSize
        ProcedureReturn #False
      EndIf
      
      *Pos\i + BlockSize
    Wend
    
    ProcedureReturn #False
  EndProcedure
  
  Procedure.i ReadSubBlocks(*Buffer, BufferSize.i, *Pos.Integer, *OutSize.Integer)
    Protected Capacity.i = 1024
    Protected Used.i = 0
    Protected BlockSize.i
    Protected *Data = AllocateMemory(Capacity)
    Protected *NewData
    
    *OutSize\i = 0
    If *Data = 0
      ProcedureReturn 0
    EndIf
    
    While #True
      If *Pos\i >= BufferSize
        FreeMemory(*Data)
        ProcedureReturn 0
      EndIf
      
      BlockSize = PeekA(*Buffer + *Pos\i) & $FF
      *Pos\i + 1
      
      If BlockSize = 0
        Break
      EndIf
      
      If *Pos\i + BlockSize > BufferSize
        FreeMemory(*Data)
        ProcedureReturn 0
      EndIf
      
      If Used + BlockSize > Capacity
        While Used + BlockSize > Capacity
          Capacity * 2
        Wend
        *NewData = ReAllocateMemory(*Data, Capacity)
        If *NewData = 0
          FreeMemory(*Data)
          ProcedureReturn 0
        EndIf
        *Data = *NewData
      EndIf
      
      CopyMemory(*Buffer + *Pos\i, *Data + Used, BlockSize)
      Used + BlockSize
      *Pos\i + BlockSize
    Wend
    
    *OutSize\i = Used
    ProcedureReturn *Data
  EndProcedure
  
  Procedure.i ReadColorTable(*Buffer, BufferSize.i, *Pos.Integer, Colors.i, Array Palette.l(1))
    Protected i.i
    Protected R.i, G.i, B.i
    Protected Need.i = Colors * 3
    
    If *Pos\i + Need > BufferSize
      ProcedureReturn #False
    EndIf
    
    For i = 0 To Colors - 1
      R = PeekA(*Buffer + *Pos\i) & $FF : *Pos\i + 1
      G = PeekA(*Buffer + *Pos\i) & $FF : *Pos\i + 1
      B = PeekA(*Buffer + *Pos\i) & $FF : *Pos\i + 1
      Palette(i) = RGBA(R, G, B, 255)
    Next
    
    ProcedureReturn #True
  EndProcedure
  
  Procedure.i LZWDecode(*Data, DataSize.i, MinCodeSize.i, ExpectedSize.i, *Out)
    Protected ClearCode.i
    Protected EndCode.i
    Protected CodeSize.i
    Protected NextCode.i
    Protected OldCode.i
    Protected InCode.i
    Protected FirstChar.i
    Protected Code.i
    Protected BytePos.i = 0
    Protected BitBuffer.q = 0
    Protected BitMask.q = $00FFFFFFFFFFFFFF
    Protected BitCount.i = 0
    Protected OutPos.i = 0
    Protected Top.i
    Protected i.i
    Dim Prefix.i(4095)
    Dim Suffix.i(4095)
    Dim Stack.i(4095)
    
    If MinCodeSize < 2 Or MinCodeSize > 8
      ProcedureReturn 0
    EndIf
    
    ClearCode = 1 << MinCodeSize
    EndCode = ClearCode + 1
    CodeSize = MinCodeSize + 1
    NextCode = EndCode + 1
    OldCode = -1
    
    For i = 0 To 4095
      Prefix(i) = -1
      Suffix(i) = 0
    Next
    
    For i = 0 To ClearCode - 1
      Suffix(i) = i
    Next
    
    While OutPos < ExpectedSize
      While BitCount < CodeSize
        If BytePos >= DataSize
          ProcedureReturn OutPos
        EndIf
        BitBuffer | ((PeekA(*Data + BytePos) & $FF) << BitCount)
        BytePos + 1
        BitCount + 8
      Wend
      
      Code = BitBuffer & ((1 << CodeSize) - 1)
      BitBuffer = (BitBuffer >> CodeSize) & BitMask
      BitCount - CodeSize
      
      If Code = ClearCode
        CodeSize = MinCodeSize + 1
        NextCode = EndCode + 1
        OldCode = -1
        Continue
      EndIf
      
      If Code = EndCode
        Break
      EndIf
      
      If OldCode = -1
        If Code >= 4096
          ProcedureReturn OutPos
        EndIf
        PokeA(*Out + OutPos, Suffix(Code) & $FF)
        OutPos + 1
        FirstChar = Suffix(Code)
        OldCode = Code
        Continue
      EndIf
      
      InCode = Code
      Top = 0
      
      If Code >= NextCode
        Stack(Top) = FirstChar : Top + 1
        Code = OldCode
      EndIf
      
      While Code >= ClearCode
        If Code < 0 Or Code > 4095
          ProcedureReturn OutPos
        EndIf
        Stack(Top) = Suffix(Code) : Top + 1
        If Top > 4095
          ProcedureReturn OutPos
        EndIf
        Code = Prefix(Code)
        If Code < 0
          ProcedureReturn OutPos
        EndIf
      Wend
      
      FirstChar = Suffix(Code)
      Stack(Top) = FirstChar : Top + 1
      
      While Top > 0
        Top - 1
        If OutPos >= ExpectedSize
          Break
        EndIf
        PokeA(*Out + OutPos, Stack(Top) & $FF)
        OutPos + 1
      Wend
      
      If NextCode < 4096
        Prefix(NextCode) = OldCode
        Suffix(NextCode) = FirstChar
        NextCode + 1
        
        If (NextCode = (1 << CodeSize)) And (CodeSize < 12)
          CodeSize + 1
        EndIf
      EndIf
      
      OldCode = InCode
    Wend
    
    ProcedureReturn OutPos
  EndProcedure
  
  Procedure BuildInterlaceMap(Height.i, Array RowMap.i(1))
    Protected Row.i
    Protected i.i = 0
    
    For Row = 0 To Height - 1 Step 8
      RowMap(i) = Row : i + 1
    Next
    For Row = 4 To Height - 1 Step 8
      RowMap(i) = Row : i + 1
    Next
    For Row = 2 To Height - 1 Step 4
      RowMap(i) = Row : i + 1
    Next
    For Row = 1 To Height - 1 Step 2
      RowMap(i) = Row : i + 1
    Next
  EndProcedure
  
  Procedure.i RenderToImage(Array Canvas.l(1), Width.i, Height.i, ImageID.i)
    Protected Img.i
    Protected x.i, y.i
    Protected *framebuffer, *row, *px, pitch.i, pf.i, isBGR.i, pixelBytes.i
    Protected c.i
    
    If ImageID = #PB_Any
      Img = CreateImage(#PB_Any, Width, Height, 32)
    Else
      Img = CreateImage(ImageID, Width, Height, 32)
    EndIf
    
    If Img = 0
      SetLastError("Unable to create output image.")
      ProcedureReturn 0
    EndIf
    
    If StartDrawing(ImageOutput(Img))
      DrawingMode(#PB_2DDrawing_AllChannels)
      *framebuffer = DrawingBuffer()
      pitch = DrawingBufferPitch()
      pf = DrawingBufferPixelFormat()
      isBGR = Bool((pf & #PB_PixelFormat_32Bits_BGR) Or (pf & #PB_PixelFormat_24Bits_BGR))
      pixelBytes = 4
      If (pf & #PB_PixelFormat_24Bits_RGB) Or (pf & #PB_PixelFormat_24Bits_BGR)
        pixelBytes = 3
      EndIf
      For y = 0 To Height - 1
        *row = *framebuffer + DrawingBufferY(y, Height, pf) * pitch
        For x = 0 To Width - 1
          c = Canvas(y * Width + x)
          *px = *row + x * pixelBytes
          If isBGR
            PokeA(*px + 0, Blue(c))
            PokeA(*px + 1, Green(c))
            PokeA(*px + 2, Red(c))
          Else
            PokeA(*px + 0, Red(c))
            PokeA(*px + 1, Green(c))
            PokeA(*px + 2, Blue(c))
          EndIf
          If pixelBytes = 4
            PokeA(*px + 3, Alpha(c))
          EndIf
        Next
      Next
      StopDrawing()
    Else
      If ImageID = #PB_Any
        FreeImage(Img)
      EndIf
      SetLastError("Unable to draw to output image.")
      ProcedureReturn 0
    EndIf
    
    ProcedureReturn Img
  EndProcedure
  
  Procedure.i Catch(*Buffer, BufferSize.i, ImageID.i = #PB_Any, FrameIndex.i = 0)
    Protected Pos.i
    Protected Signature.s
    Protected Width.i, Height.i
    Protected LSDPacked.i
    Protected HasGCT.i
    Protected GCTSize.i
    Protected BGIndex.i
    Protected Block.i
    Protected Label.i
    Protected i.i
    Protected FrameCount.i = 0
    Protected Target.i = FrameIndex
    
    Protected GCE_Disposal.i = 0
    Protected GCE_TransparentFlag.i = 0
    Protected GCE_TransparentIndex.i = 0
    
    Protected PendingDisposal.i = 0
    Protected PendingLeft.i = 0
    Protected PendingTop.i = 0
    Protected PendingW.i = 0
    Protected PendingH.i = 0
    
    Protected Left.i, Top.i, W.i, H.i, Packed.i
    Protected HasLCT.i, Interlaced.i, LCTSize.i
    Protected LZWMin.i
    Protected DataSize.i
    Protected *Compressed
    Protected *Indices
    Protected Decoded.i
    Protected srcX.i, srcY.i, dstX.i, dstY.i
    Protected idx.i
    Protected OutputImage.i
    Protected Found.i = #False
    Protected Color.i
    
    Protected BGColor.i = RGBA(0, 0, 0, 255)
    Protected *Backup = 0
    
    SetLastError("")
    
    If *Buffer = 0 Or BufferSize < 13
      SetLastError("Invalid input buffer.")
      ProcedureReturn 0
    EndIf
    
    Signature = PeekS(*Buffer, 6, #PB_Ascii)
    If Signature <> "GIF87a" And Signature <> "GIF89a"
      SetLastError("Not a GIF stream.")
      ProcedureReturn 0
    EndIf
    
    Width = ReadLEWord(*Buffer, 6)
    Height = ReadLEWord(*Buffer, 8)
    If Width <= 0 Or Height <= 0
      SetLastError("Invalid GIF logical screen size.")
      ProcedureReturn 0
    EndIf
    
    LSDPacked = PeekA(*Buffer + 10) & $FF
    BGIndex = PeekA(*Buffer + 11) & $FF
    HasGCT = Bool((LSDPacked & $80) <> 0)
    GCTSize = 1 << ((LSDPacked & $07) + 1)
    
    Dim GlobalPalette.l(255)
    Dim ActivePalette.l(255)
    Dim Canvas.l(Width * Height - 1)
    
    For i = 0 To 255
      GlobalPalette(i) = RGBA(0, 0, 0, 255)
      ActivePalette(i) = RGBA(0, 0, 0, 255)
    Next
    
    Pos = 13
    If HasGCT
      If ReadColorTable(*Buffer, BufferSize, @Pos, GCTSize, GlobalPalette()) = #False
        SetLastError("GIF global color table is truncated.")
        ProcedureReturn 0
      EndIf
      BGColor = GlobalPalette(BGIndex)
    EndIf
    
    For i = 0 To Width * Height - 1
      Canvas(i) = BGColor
    Next
    
    While Pos < BufferSize
      Block = PeekA(*Buffer + Pos) & $FF
      Pos + 1
      
      Select Block
        Case $21 ; Extension
          If Pos >= BufferSize
            SetLastError("Truncated extension block.")
            Break
          EndIf
          
          Label = PeekA(*Buffer + Pos) & $FF
          Pos + 1
          
          If Label = $F9 ; Graphic Control Extension
            If Pos + 5 > BufferSize
              SetLastError("Truncated graphic control extension.")
              Break
            EndIf
            
            If (PeekA(*Buffer + Pos) & $FF) <> 4
              SetLastError("Invalid GCE block size.")
              Break
            EndIf
            Pos + 1
            
            Packed = PeekA(*Buffer + Pos) & $FF : Pos + 1
            GCE_Disposal = (Packed >> 2) & 7
            GCE_TransparentFlag = Packed & 1
            Pos + 2 ; delay
            GCE_TransparentIndex = PeekA(*Buffer + Pos) & $FF : Pos + 1
            
            If Pos >= BufferSize Or (PeekA(*Buffer + Pos) & $FF) <> 0
              SetLastError("Invalid GCE terminator.")
              Break
            EndIf
            Pos + 1
          Else
            If SkipSubBlocks(*Buffer, BufferSize, @Pos) = #False
              SetLastError("Truncated extension sub-blocks.")
              Break
            EndIf
          EndIf
          
        Case $2C ; Image descriptor
          ; apply previous frame disposal before rendering this frame
          If PendingDisposal = 2
            For dstY = PendingTop To PendingTop + PendingH - 1
              If dstY < 0 Or dstY >= Height : Continue : EndIf
              For dstX = PendingLeft To PendingLeft + PendingW - 1
                If dstX < 0 Or dstX >= Width : Continue : EndIf
                Canvas(dstY * Width + dstX) = BGColor
              Next
            Next
          ElseIf PendingDisposal = 3 And *Backup
            CopyMemory(*Backup, @Canvas(0), Width * Height * SizeOf(Long))
          EndIf
          
          If Pos + 9 > BufferSize
            SetLastError("Truncated image descriptor.")
            Break
          EndIf
          
          Left = ReadLEWord(*Buffer, Pos) : Pos + 2
          Top = ReadLEWord(*Buffer, Pos) : Pos + 2
          W = ReadLEWord(*Buffer, Pos) : Pos + 2
          H = ReadLEWord(*Buffer, Pos) : Pos + 2
          Packed = PeekA(*Buffer + Pos) & $FF : Pos + 1
          
          If W <= 0 Or H <= 0
            SetLastError("Invalid image frame dimensions.")
            Break
          EndIf
          
          HasLCT = Bool((Packed & $80) <> 0)
          Interlaced = Bool((Packed & $40) <> 0)
          LCTSize = 1 << ((Packed & $07) + 1)
          
          For i = 0 To 255
            ActivePalette(i) = GlobalPalette(i)
          Next
          
          If HasLCT
            If ReadColorTable(*Buffer, BufferSize, @Pos, LCTSize, ActivePalette()) = #False
              SetLastError("Truncated local color table.")
              Break
            EndIf
          EndIf
          
          If Pos >= BufferSize
            SetLastError("Missing LZW minimum code size.")
            Break
          EndIf
          
          LZWMin = PeekA(*Buffer + Pos) & $FF
          Pos + 1
          
          DataSize = 0
          *Compressed = ReadSubBlocks(*Buffer, BufferSize, @Pos, @DataSize)
          If *Compressed = 0
            SetLastError("Truncated image LZW data.")
            Break
          EndIf
          
          *Indices = AllocateMemory(W * H)
          If *Indices = 0
            FreeMemory(*Compressed)
            SetLastError("Out of memory while decoding frame.")
            Break
          EndIf
          
          Decoded = LZWDecode(*Compressed, DataSize, LZWMin, W * H, *Indices)
          FreeMemory(*Compressed)
          
          If Decoded < W * H
            FreeMemory(*Indices)
            SetLastError("LZW decode error or truncated frame.")
            Break
          EndIf
          
          ; save canvas if this frame wants restore-to-previous disposal
          If GCE_Disposal = 3
            If *Backup = 0
              *Backup = AllocateMemory(Width * Height * SizeOf(Long))
            EndIf
            If *Backup = 0
              FreeMemory(*Indices)
              SetLastError("Out of memory for disposal buffer.")
              Break
            EndIf
            CopyMemory(@Canvas(0), *Backup, Width * Height * SizeOf(Long))
          EndIf
          
          If Interlaced
            Dim RowMap.i(H - 1)
            BuildInterlaceMap(H, RowMap())
            For srcY = 0 To H - 1
              dstY = Top + RowMap(srcY)
              If dstY < 0 Or dstY >= Height : Continue : EndIf
              
              For srcX = 0 To W - 1
                dstX = Left + srcX
                If dstX < 0 Or dstX >= Width : Continue : EndIf
                
                idx = PeekA(*Indices + srcY * W + srcX) & $FF
                If GCE_TransparentFlag And idx = GCE_TransparentIndex
                  Continue
                EndIf
                Color = ActivePalette(idx)
                Canvas(dstY * Width + dstX) = Color
              Next
            Next
          Else
            For srcY = 0 To H - 1
              dstY = Top + srcY
              If dstY < 0 Or dstY >= Height : Continue : EndIf
              
              For srcX = 0 To W - 1
                dstX = Left + srcX
                If dstX < 0 Or dstX >= Width : Continue : EndIf
                
                idx = PeekA(*Indices + srcY * W + srcX) & $FF
                If GCE_TransparentFlag And idx = GCE_TransparentIndex
                  Continue
                EndIf
                Color = ActivePalette(idx)
                Canvas(dstY * Width + dstX) = Color
              Next
            Next
          EndIf
          
          FreeMemory(*Indices)
          
          If FrameCount = Target
            OutputImage = RenderToImage(Canvas(), Width, Height, ImageID)
            If OutputImage = 0
              Break
            EndIf
            Found = #True
            Break
          EndIf
          
          PendingDisposal = GCE_Disposal
          PendingLeft = Left
          PendingTop = Top
          PendingW = W
          PendingH = H
          
          GCE_Disposal = 0
          GCE_TransparentFlag = 0
          GCE_TransparentIndex = 0
          
          FrameCount + 1
          
        Case $3B ; trailer
          Break
          
        Default
          SetLastError("Unknown GIF block encountered.")
          Break
      EndSelect
    Wend
    
    If *Backup
      FreeMemory(*Backup)
    EndIf
    
    If Found
      ProcedureReturn OutputImage
    EndIf
    
    If LastError = ""
      SetLastError("Requested frame index not found.")
    EndIf
    ProcedureReturn 0
  EndProcedure
  
  Procedure.i Load(Filename.s, ImageID.i = #PB_Any, FrameIndex.i = 0)
    Protected Size.i
    Protected *Data
    Protected Img.i
    
    SetLastError("")
    *Data = ReadWholeFile(Filename, @Size)
    If *Data = 0
      SetLastError("Cannot read GIF file: " + Filename)
      ProcedureReturn 0
    EndIf
    
    Img = Catch(*Data, Size, ImageID, FrameIndex)
    FreeMemory(*Data)
    ProcedureReturn Img
  EndProcedure
  
  Procedure.i CountMemory(*Buffer, BufferSize.i)
    Protected Pos.i
    Protected Signature.s
    Protected LSDPacked.i
    Protected HasGCT.i
    Protected GCTSize.i
    Protected Block.i
    Protected Label.i
    Protected Count.i = 0
    Protected SizeByte.i
    
    If *Buffer = 0 Or BufferSize < 13
      ProcedureReturn -1
    EndIf
    
    Signature = PeekS(*Buffer, 6, #PB_Ascii)
    If Signature <> "GIF87a" And Signature <> "GIF89a"
      ProcedureReturn -1
    EndIf
    
    LSDPacked = PeekA(*Buffer + 10) & $FF
    HasGCT = Bool((LSDPacked & $80) <> 0)
    GCTSize = 1 << ((LSDPacked & $07) + 1)
    
    Pos = 13
    If HasGCT
      Pos + GCTSize * 3
      If Pos > BufferSize
        ProcedureReturn -1
      EndIf
    EndIf
    
    While Pos < BufferSize
      Block = PeekA(*Buffer + Pos) & $FF
      Pos + 1
      
      Select Block
        Case $2C ; image
          Count + 1
          
          If Pos + 9 > BufferSize
            ProcedureReturn -1
          EndIf
          
          LSDPacked = PeekA(*Buffer + Pos + 8) & $FF
          Pos + 9
          
          If LSDPacked & $80
            GCTSize = 1 << ((LSDPacked & $07) + 1)
            Pos + GCTSize * 3
            If Pos > BufferSize
              ProcedureReturn -1
            EndIf
          EndIf
          
          If Pos >= BufferSize
            ProcedureReturn -1
          EndIf
          Pos + 1 ; LZW minimum code size
          
          If SkipSubBlocks(*Buffer, BufferSize, @Pos) = #False
            ProcedureReturn -1
          EndIf
          
        Case $21 ; extension
          If Pos >= BufferSize
            ProcedureReturn -1
          EndIf
          
          Label = PeekA(*Buffer + Pos) & $FF
          Pos + 1
          
          If Label = $F9
            ; fixed-size GCE
            If Pos + 6 > BufferSize
              ProcedureReturn -1
            EndIf
            SizeByte = PeekA(*Buffer + Pos) & $FF
            If SizeByte <> 4
              ProcedureReturn -1
            EndIf
            Pos + 6
          Else
            If SkipSubBlocks(*Buffer, BufferSize, @Pos) = #False
              ProcedureReturn -1
            EndIf
          EndIf
          
        Case $3B ; trailer
          Break
          
        Default
          ProcedureReturn -1
      EndSelect
    Wend
    
    ProcedureReturn Count
  EndProcedure
  
  Procedure.i Count_Images(Filename.s)
    Protected Size.i
    Protected *Data
    Protected Result.i
    
    SetLastError("")
    *Data = ReadWholeFile(Filename, @Size)
    If *Data = 0
      SetLastError("Cannot read GIF file: " + Filename)
      ProcedureReturn -1
    EndIf
    
    Result = CountMemory(*Data, Size)
    FreeMemory(*Data)
    
    If Result < 0
      SetLastError("Failed to parse GIF stream for frame counting.")
    EndIf
    
    ProcedureReturn Result
  EndProcedure

  Procedure.i AppendByte(*Buffer.Integer, *Size.Integer, *Capacity.Integer, Value.i)
    Protected *New
    
    If *Size\i + 1 > *Capacity\i
      *Capacity\i * 2
      *New = ReAllocateMemory(*Buffer\i, *Capacity\i)
      If *New = 0
        ProcedureReturn #False
      EndIf
      *Buffer\i = *New
    EndIf
    
    PokeA(*Buffer\i + *Size\i, Value & $FF)
    *Size\i + 1
    ProcedureReturn #True
  EndProcedure
  
  Procedure.i LZWEncodeFallback(*Indices, PixelCount.i, MinCodeSize.i, *OutSize.Integer)
    Protected ClearCode.i
    Protected EndCode.i
    Protected CodeSize.i
    Protected NextCode.i
    Protected i.i
    Protected BitBuffer.q = 0
    Protected BitMask.q = $00FFFFFFFFFFFFFF
    Protected BitCount.i = 0
    Protected Capacity.i = 4096
    Protected Size.i = 0
    Protected *Out = AllocateMemory(Capacity)
    Protected Literal.i
    Protected HasOldCode.i = #False
    Protected LiteralsSinceClear.i = 0
    
    *OutSize\i = 0
    If *Out = 0 Or PixelCount <= 0
      If *Out
        FreeMemory(*Out)
      EndIf
      ProcedureReturn 0
    EndIf
    
    If MinCodeSize < 2 Or MinCodeSize > 8
      FreeMemory(*Out)
      ProcedureReturn 0
    EndIf
    
    ClearCode = 1 << MinCodeSize
    EndCode = ClearCode + 1
    CodeSize = MinCodeSize + 1
    NextCode = EndCode + 1
    
    ; Emit clear code
    BitBuffer | (ClearCode << BitCount)
    BitCount + CodeSize
    While BitCount >= 8
      If AppendByte(@*Out, @Size, @Capacity, BitBuffer & $FF) = #False
        FreeMemory(*Out)
        ProcedureReturn 0
      EndIf
      BitBuffer = (BitBuffer >> 8) & BitMask
      BitCount - 8
    Wend
    
    CodeSize = MinCodeSize + 1
    NextCode = EndCode + 1
    HasOldCode = #False
    LiteralsSinceClear = 0
    
    ; Conservative literal-stream LZW:
    ; emits periodic clear codes to keep code-size/dictionary states simple and robust.
    For i = 0 To PixelCount - 1
      
      If LiteralsSinceClear >= 200
        BitBuffer | (ClearCode << BitCount)
        BitCount + CodeSize
        While BitCount >= 8
          If AppendByte(@*Out, @Size, @Capacity, BitBuffer & $FF) = #False
            FreeMemory(*Out)
            ProcedureReturn 0
          EndIf
          BitBuffer = (BitBuffer >> 8) & BitMask
          BitCount - 8
        Wend
        
        CodeSize = MinCodeSize + 1
        NextCode = EndCode + 1
        HasOldCode = #False
        LiteralsSinceClear = 0
      EndIf
      
      Literal = PeekA(*Indices + i) & $FF
      BitBuffer | (Literal << BitCount)
      BitCount + CodeSize
      While BitCount >= 8
        If AppendByte(@*Out, @Size, @Capacity, BitBuffer & $FF) = #False
          FreeMemory(*Out)
          ProcedureReturn 0
        EndIf
        BitBuffer = (BitBuffer >> 8) & BitMask
        BitCount - 8
      Wend
      
      If HasOldCode
        If NextCode < 4096
          NextCode + 1
          If NextCode = (1 << CodeSize) And CodeSize < 12
            CodeSize + 1
          EndIf
        EndIf
      Else
        HasOldCode = #True
      EndIf
      
      LiteralsSinceClear + 1
    Next
    
    BitBuffer | (EndCode << BitCount)
    BitCount + CodeSize
    While BitCount >= 8
      If AppendByte(@*Out, @Size, @Capacity, BitBuffer & $FF) = #False
        FreeMemory(*Out)
        ProcedureReturn 0
      EndIf
      BitBuffer = (BitBuffer >> 8) & BitMask
      BitCount - 8
    Wend
    
    If BitCount > 0
      If AppendByte(@*Out, @Size, @Capacity, BitBuffer & $FF) = #False
        FreeMemory(*Out)
        ProcedureReturn 0
      EndIf
    EndIf
    
    *OutSize\i = Size
    ProcedureReturn *Out
  EndProcedure
  
  Procedure.i LZWEncode(*Indices, PixelCount.i, MinCodeSize.i, *OutSize.Integer)

    Protected initDictLen.i
    Protected initCodeLen.i
    Protected MAX_DICT_LEN.i = 4096
    Protected MAX_CODE_LEN.i = 12
    Protected dictPos.i
    Protected mapPos.i
    Protected lzwPos.i = 0
    Protected strPos.i = 0
    Protected parentIndex.i
    Protected nextParent.i
    Protected nextColor.i
    Protected mapPosParent.i
    Protected emitted.i
    Protected i.i
    Protected entriesPerCycle.i
    Protected maxResets.i
    Protected maxLZWCodes.i
    Protected maxByteLen.i
    Protected *Out
    Protected outSize.i
    

    Protected bytePos.i = 0
    Protected bitOffset.i = 0
    Protected lzwCodeLen.i
    Protected n.i
    Protected dictCount.i
    Protected correctLater.i
    Protected code.i
    Protected curByte.i
    Protected tmp.i
    
    *OutSize\i = 0
    If *Indices = 0 Or PixelCount <= 0
      ProcedureReturn 0
    EndIf
    If MinCodeSize < 2 Or MinCodeSize > 8
      ProcedureReturn 0
    EndIf
    
    initDictLen = 1 << MinCodeSize
    initCodeLen = MinCodeSize + 1
    If initCodeLen < 3
      initCodeLen = 3
    EndIf
    
    entriesPerCycle = MAX_DICT_LEN - initDictLen - 2
    If entriesPerCycle <= 0
      entriesPerCycle = 1
    EndIf
    maxResets = PixelCount / entriesPerCycle
    maxLZWCodes = PixelCount + 2 + maxResets + 8
    
    Dim TreeInit.i(initDictLen * initDictLen - 1)
    Dim TreeList.i(MAX_DICT_LEN * 3 - 1)
    Dim TreeMap.i(((MAX_DICT_LEN / 2) + 1) * initDictLen - 1)
    Dim LZWData.i(maxLZWCodes - 1)
    
    ; reset dictionary and emit clear code
    dictPos = initDictLen + 2
    mapPos = 1
    FillMemory(@TreeInit(0), (ArraySize(TreeInit()) + 1) * SizeOf(Integer), 0)
    FillMemory(@TreeList(0), (ArraySize(TreeList()) + 1) * SizeOf(Integer), 0)
    LZWData(lzwPos) = initDictLen
    lzwPos + 1
    
    ; Generate LZW codes
    While strPos < PixelCount
      parentIndex = PeekA(*Indices + strPos) & $FF
      emitted = #False
      
      If strPos < PixelCount - 1
        nextColor = PeekA(*Indices + strPos + 1) & $FF
        nextParent = TreeInit(parentIndex * initDictLen + nextColor)
        If nextParent
          parentIndex = nextParent
          strPos + 1
        Else
          LZWData(lzwPos) = parentIndex
          lzwPos + 1
          
          If dictPos < MAX_DICT_LEN
            TreeInit(parentIndex * initDictLen + nextColor) = dictPos
            dictPos + 1
          Else
            dictPos = initDictLen + 2
            mapPos = 1
            FillMemory(@TreeInit(0), (ArraySize(TreeInit()) + 1) * SizeOf(Integer), 0)
            FillMemory(@TreeList(0), (ArraySize(TreeList()) + 1) * SizeOf(Integer), 0)
            LZWData(lzwPos) = initDictLen
            lzwPos + 1
          EndIf
          
          strPos + 1
          emitted = #True
        EndIf
      EndIf
      
      If emitted = #False
        While strPos < PixelCount - 1
          nextColor = PeekA(*Indices + strPos + 1) & $FF
          
          ; try tree list first
          If TreeList(parentIndex * 3 + 2) <> 0 And TreeList(parentIndex * 3 + 1) = nextColor
            parentIndex = TreeList(parentIndex * 3 + 2)
            strPos + 1
            Continue
          EndIf
          
          ; then mapping table
          mapPosParent = TreeList(parentIndex * 3 + 0)
          If mapPosParent
            nextParent = TreeMap((mapPosParent - 1) * initDictLen + nextColor)
            If nextParent
              parentIndex = nextParent
              strPos + 1
              Continue
            EndIf
          EndIf
          
          ; not found -> emit and add child
          LZWData(lzwPos) = parentIndex
          lzwPos + 1
          
          If dictPos < MAX_DICT_LEN
            mapPosParent = TreeList(parentIndex * 3 + 0)
            If mapPosParent = 0
              If TreeList(parentIndex * 3 + 2)
                ; switch parent node to map mode
                FillMemory(@TreeMap((mapPos - 1) * initDictLen), initDictLen * SizeOf(Integer), 0)
                TreeMap((mapPos - 1) * initDictLen + nextColor) = dictPos
                TreeList(parentIndex * 3 + 0) = mapPos
                mapPos + 1
              Else
                ; use list slot
                TreeList(parentIndex * 3 + 1) = nextColor
                TreeList(parentIndex * 3 + 2) = dictPos
              EndIf
            Else
              TreeMap((mapPosParent - 1) * initDictLen + nextColor) = dictPos
            EndIf
            dictPos + 1
          Else
            ; dictionary full -> reset and emit clear code
            dictPos = initDictLen + 2
            mapPos = 1
            FillMemory(@TreeInit(0), (ArraySize(TreeInit()) + 1) * SizeOf(Integer), 0)
            FillMemory(@TreeList(0), (ArraySize(TreeList()) + 1) * SizeOf(Integer), 0)
            LZWData(lzwPos) = initDictLen
            lzwPos + 1
          EndIf
          
          strPos + 1
          emitted = #True
          Break
        Wend
      EndIf
      
      If emitted = #False
        ; reached end while crawling dictionary path
        LZWData(lzwPos) = parentIndex
        lzwPos + 1
        strPos + 1
      EndIf
    Wend
    
    ; termination code
    LZWData(lzwPos) = initDictLen + 1
    lzwPos + 1
    
    ; Pack codes into byte stream
    maxByteLen = (MAX_CODE_LEN * lzwPos) / 8 + 8
    *Out = AllocateMemory(maxByteLen)
    If *Out = 0
      ProcedureReturn 0
    EndIf
    FillMemory(*Out, maxByteLen, 0)
    
    n = 2 * initDictLen
    dictCount = 1
    lzwCodeLen = initCodeLen
    bytePos = 0
    bitOffset = 0
    correctLater = #False
    
    For i = 0 To lzwPos - 1
      If lzwCodeLen < MAX_CODE_LEN And (n - initDictLen) = dictCount
        lzwCodeLen + 1
        n * 2
      EndIf
      
      correctLater = #False
      code = LZWData(i)
      
      curByte = PeekA(*Out + bytePos) & $FF
      curByte | ((code << bitOffset) & $FF)
      PokeA(*Out + bytePos, curByte)
      
      If lzwCodeLen + bitOffset >= 8
        If lzwCodeLen + bitOffset = 8
          bytePos + 1
          PokeA(*Out + bytePos, 0)
          correctLater = #True
        ElseIf lzwCodeLen + bitOffset < 16
          bytePos + 1
          tmp = (code >> (8 - bitOffset)) & $FF
          PokeA(*Out + bytePos, tmp)
        ElseIf lzwCodeLen + bitOffset = 16
          bytePos + 1
          tmp = (code >> (8 - bitOffset)) & $FF
          PokeA(*Out + bytePos, tmp)
          bytePos + 1
          PokeA(*Out + bytePos, 0)
          correctLater = #True
        Else
          bytePos + 1
          tmp = (code >> (8 - bitOffset)) & $FF
          PokeA(*Out + bytePos, tmp)
          bytePos + 1
          tmp = (code >> (16 - bitOffset)) & $FF
          PokeA(*Out + bytePos, tmp)
        EndIf
      EndIf
      
      bitOffset = (lzwCodeLen + bitOffset) % 8
      dictCount + 1
      
      If code = initDictLen
        lzwCodeLen = initCodeLen
        n = 2 * initDictLen
        dictCount = 1
      EndIf
    Next
    
    If correctLater
      bytePos - 1
    EndIf
    
    outSize = bytePos + 1
    *OutSize\i = outSize
    ProcedureReturn *Out
  EndProcedure

  Procedure.i SaveWriteByte(File.i, Value.i)
    ProcedureReturn WriteByte(File, Value & $FF)
  EndProcedure
  
  Procedure.i SaveWriteWordLE(File.i, Value.i)
    WriteByte(File, Value & $FF)
    WriteByte(File, (Value >> 8) & $FF)
    ProcedureReturn #True
  EndProcedure
  
  Procedure.i ClampInt(Value.i, MinValue.i, MaxValue.i)
    If Value < MinValue : ProcedureReturn MinValue : EndIf
    If Value > MaxValue : ProcedureReturn MaxValue : EndIf
    ProcedureReturn Value
  EndProcedure
  
  Procedure.i NextPowerOfTwo(Value.i)
    Protected p.i = 1
    While p < Value
      p * 2
    Wend
    ProcedureReturn p
  EndProcedure
  
  Procedure.i IntLog2(Value.i)
    Protected n.i = 0
    While (1 << n) < Value
      n + 1
    Wend
    ProcedureReturn n
  EndProcedure
  
  Procedure Build332Palette(Array PaletteR.i(1), Array PaletteG.i(1), Array PaletteB.i(1))
    Protected i.i
    
    For i = 0 To 255
      PaletteR(i) = (((i >> 5) & 7) * 255) / 7
      PaletteG(i) = (((i >> 2) & 7) * 255) / 7
      PaletteB(i) = ((i & 3) * 255) / 3
    Next
  EndProcedure
  
  Procedure.i QuantizeImage332(ImageID.i, *Indices)
    Protected Width.i
    Protected Height.i
    Protected x.i, y.i
    Protected C.i, R.i, G.i, B.i
    Protected idx.i
    
    If IsImage(ImageID) = 0
      ProcedureReturn #False
    EndIf
    
    Width = ImageWidth(ImageID)
    Height = ImageHeight(ImageID)
    If Width <= 0 Or Height <= 0
      ProcedureReturn #False
    EndIf
    
    If StartDrawing(ImageOutput(ImageID)) = 0
      ProcedureReturn #False
    EndIf
    
    For y = 0 To Height - 1
      For x = 0 To Width - 1
        C = Point(x, y)
        R = Red(C)
        G = Green(C)
        B = Blue(C)
        idx = ((R >> 5) << 5) | ((G >> 5) << 2) | (B >> 6)
        PokeA(*Indices + y * Width + x, idx & $FF)
      Next
    Next
    
    StopDrawing()
    ProcedureReturn #True
  EndProcedure
  
  Procedure BuildPaletteLevels(MaxColors.i, *LevelR.Integer, *LevelG.Integer, *LevelB.Integer)
    Protected r.i, g.i, b.i
    Protected bestR.i = 8, bestG.i = 8, bestB.i = 4
    Protected bestCount.i = 256
    Protected score.i
    Protected bestScore.i = -1
    
    MaxColors = ClampInt(MaxColors, 2, 256)
    
    For r = 2 To 8
      For g = 2 To 8
        For b = 2 To 8
          score = r * g * b
          If score <= MaxColors
            ; Prefer higher palette usage, slight green bias.
            If score * 16 + g > bestScore
              bestScore = score * 16 + g
              bestCount = score
              bestR = r
              bestG = g
              bestB = b
            EndIf
          EndIf
        Next
      Next
    Next
    
    *LevelR\i = bestR
    *LevelG\i = bestG
    *LevelB\i = bestB
    ProcedureReturn bestCount
  EndProcedure
  
  Procedure BuildPaletteFromLevels(LevelR.i, LevelG.i, LevelB.i, Array PaletteR.i(1), Array PaletteG.i(1), Array PaletteB.i(1), *UsedColors.Integer, StartIndex.i = 0)
    Protected r.i, g.i, b.i
    Protected idx.i = StartIndex
    Protected i.i
    
    For b = 0 To LevelB - 1
      For g = 0 To LevelG - 1
        For r = 0 To LevelR - 1
          PaletteR(idx) = (r * 255) / (LevelR - 1)
          PaletteG(idx) = (g * 255) / (LevelG - 1)
          PaletteB(idx) = (b * 255) / (LevelB - 1)
          idx + 1
        Next
      Next
    Next
    
    *UsedColors\i = idx
    For i = idx To 255
      PaletteR(i) = 0
      PaletteG(i) = 0
      PaletteB(i) = 0
    Next
  EndProcedure
  
  Procedure.i CreateScaledCopy(SourceImageID.i, TargetWidth.i, TargetHeight.i)
    Protected Temp.i
    Protected SrcW.i = ImageWidth(SourceImageID)
    Protected SrcH.i = ImageHeight(SourceImageID)
    
    If TargetWidth = SrcW And TargetHeight = SrcH
      ProcedureReturn SourceImageID
    EndIf
    
    Temp = CreateImage(#PB_Any, TargetWidth, TargetHeight, 32)
    If Temp = 0
      ProcedureReturn 0
    EndIf
    
    If StartDrawing(ImageOutput(Temp)) = 0
      FreeImage(Temp)
      ProcedureReturn 0
    EndIf
    DrawingMode(#PB_2DDrawing_AllChannels)
    DrawImage(ImageID(SourceImageID), 0, 0, TargetWidth, TargetHeight)
    StopDrawing()
    
    ProcedureReturn Temp
  EndProcedure
  
  Procedure.i QuantizeImageToLevels(ImageID.i, *Indices, LevelR.i, LevelG.i, LevelB.i, BaseIndex.i = 0)
    Protected Width.i
    Protected Height.i
    Protected x.i, y.i
    Protected C.i, R.i, G.i, B.i
    Protected idx.i, rIdx.i, gIdx.i, bIdx.i
    
    If IsImage(ImageID) = 0
      ProcedureReturn #False
    EndIf
    
    Width = ImageWidth(ImageID)
    Height = ImageHeight(ImageID)
    If Width <= 0 Or Height <= 0
      ProcedureReturn #False
    EndIf
    
    If StartDrawing(ImageOutput(ImageID)) = 0
      ProcedureReturn #False
    EndIf
    
    For y = 0 To Height - 1
      For x = 0 To Width - 1
        C = Point(x, y)
        R = Red(C)
        G = Green(C)
        B = Blue(C)
        
        rIdx = (R * (LevelR - 1)) / 255
        gIdx = (G * (LevelG - 1)) / 255
        bIdx = (B * (LevelB - 1)) / 255
        idx = BaseIndex + rIdx + gIdx * LevelR + bIdx * LevelR * LevelG
        PokeA(*Indices + y * Width + x, idx & $FF)
      Next
    Next
    
    StopDrawing()
    ProcedureReturn #True
  EndProcedure
  
  Procedure.i AddExactPaletteColors(ImageID.i, Map ColorToIndex.i(), Array PaletteR.i(1), Array PaletteG.i(1), Array PaletteB.i(1), *UsedColors.Integer, StartIndex.i, MaxEntries.i, *Overflow.Integer)
    Protected Width.i
    Protected Height.i
    Protected x.i, y.i
    Protected C.i
    Protected R.i, G.i, B.i
    Protected Key.s
    
    *Overflow\i = #False
    
    Width = ImageWidth(ImageID)
    Height = ImageHeight(ImageID)
    If Width <= 0 Or Height <= 0
      SetLastError("Invalid image dimensions while building exact palette.")
      ProcedureReturn #False
    EndIf
    
    If StartDrawing(ImageOutput(ImageID)) = 0
      SetLastError("Unable to read image pixels while building exact palette.")
      ProcedureReturn #False
    EndIf
    
    For y = 0 To Height - 1
      For x = 0 To Width - 1
        C = Point(x, y)
        R = Red(C)
        G = Green(C)
        B = Blue(C)
        Key = Str(RGB(R, G, B))
        
        If FindMapElement(ColorToIndex(), Key) = 0
          If *UsedColors\i >= MaxEntries
            *Overflow\i = #True
            StopDrawing()
            ProcedureReturn #False
          EndIf
          ColorToIndex(Key) = *UsedColors\i
          PaletteR(*UsedColors\i) = R
          PaletteG(*UsedColors\i) = G
          PaletteB(*UsedColors\i) = B
          *UsedColors\i + 1
        EndIf
      Next
    Next
    
    StopDrawing()
    ProcedureReturn #True
  EndProcedure
  
  Procedure.i QuantizeImageExact(ImageID.i, *Indices, Map ColorToIndex.i())
    Protected Width.i
    Protected Height.i
    Protected x.i, y.i
    Protected C.i
    Protected Key.s
    
    Width = ImageWidth(ImageID)
    Height = ImageHeight(ImageID)
    If Width <= 0 Or Height <= 0
      ProcedureReturn #False
    EndIf
    
    If StartDrawing(ImageOutput(ImageID)) = 0
      ProcedureReturn #False
    EndIf
    
    For y = 0 To Height - 1
      For x = 0 To Width - 1
        C = Point(x, y)
        Key = Str(RGB(Red(C), Green(C), Blue(C)))
        If FindMapElement(ColorToIndex(), Key) = 0
          StopDrawing()
          ProcedureReturn #False
        EndIf
        PokeA(*Indices + y * Width + x, ColorToIndex() & $FF)
      Next
    Next
    
    StopDrawing()
    ProcedureReturn #True
  EndProcedure
  
  Procedure.i WriteGIFGlobalHeader(File.i, Width.i, Height.i, Array PaletteR.i(1), Array PaletteG.i(1), Array PaletteB.i(1), ColorTableSize.i)
    Protected i.i
    Protected Packed.i
    Protected SizeBits.i
    
    SizeBits = IntLog2(ColorTableSize) - 1
    If SizeBits < 0 : SizeBits = 0 : EndIf
    Packed = $80 | (7 << 4) | (SizeBits & 7)
    
    WriteString(File, "GIF89a", #PB_Ascii)
    SaveWriteWordLE(File, Width)
    SaveWriteWordLE(File, Height)
    SaveWriteByte(File, Packed)
    SaveWriteByte(File, 0)   ; background index
    SaveWriteByte(File, 0)   ; pixel aspect ratio
    
    For i = 0 To ColorTableSize - 1
      SaveWriteByte(File, PaletteR(i))
      SaveWriteByte(File, PaletteG(i))
      SaveWriteByte(File, PaletteB(i))
    Next
    
    ProcedureReturn #True
  EndProcedure
  
  Procedure.i WriteGIFLoopExtension(File.i, LoopCount.i)
    ; Netscape application extension for animation loop control
    SaveWriteByte(File, $21) ; extension introducer
    SaveWriteByte(File, $FF) ; application extension label
    SaveWriteByte(File, 11)  ; block size
    WriteString(File, "NETSCAPE2.0", #PB_Ascii)
    SaveWriteByte(File, 3)   ; sub-block size
    SaveWriteByte(File, 1)   ; data id
    SaveWriteWordLE(File, LoopCount & $FFFF) ; 0 = infinite
    SaveWriteByte(File, 0)   ; terminator
    ProcedureReturn #True
  EndProcedure
  
  Procedure.i WriteGIFFrame(File.i, *LZW, LZWSize.i, Left.i, Top.i, Width.i, Height.i, DelayCS.i, MinCodeSize.i, TransparentFlag.i = #False, TransparentIndex.i = 0, Disposal.i = 1)
    Protected Pos.i
    Protected BlockSize.i
    Protected Packed.i
    
    ; Graphic Control Extension
    SaveWriteByte(File, $21)
    SaveWriteByte(File, $F9)
    SaveWriteByte(File, 4)
    Packed = ((Disposal & 7) << 2)
    If TransparentFlag
      Packed | 1
    EndIf
    SaveWriteByte(File, Packed)
    SaveWriteWordLE(File, DelayCS & $FFFF)
    SaveWriteByte(File, TransparentIndex & $FF)
    SaveWriteByte(File, 0) ; terminator
    
    ; Image Descriptor
    SaveWriteByte(File, $2C)
    SaveWriteWordLE(File, Left)
    SaveWriteWordLE(File, Top)
    SaveWriteWordLE(File, Width)
    SaveWriteWordLE(File, Height)
    SaveWriteByte(File, 0) ; no local color table
    
    SaveWriteByte(File, MinCodeSize)
    
    Pos = 0
    While Pos < LZWSize
      BlockSize = LZWSize - Pos
      If BlockSize > 255
        BlockSize = 255
      EndIf
      SaveWriteByte(File, BlockSize)
      WriteData(File, *LZW + Pos, BlockSize)
      Pos + BlockSize
    Wend
    SaveWriteByte(File, 0) ; image data terminator
    
    ProcedureReturn #True
  EndProcedure

  Procedure.i WriteGIFFrameLocalPalette(File.i, *LZW, LZWSize.i, Left.i, Top.i, Width.i, Height.i, DelayCS.i, MinCodeSize.i, Array PaletteR.i(1), Array PaletteG.i(1), Array PaletteB.i(1), ColorTableSize.i, Disposal.i = 1)
    Protected Pos.i
    Protected BlockSize.i
    Protected Packed.i
    Protected SizeBits.i
    Protected i.i
    
    SizeBits = IntLog2(ColorTableSize) - 1
    
    SaveWriteByte(File, $21)
    SaveWriteByte(File, $F9)
    SaveWriteByte(File, 4)
    Packed = ((Disposal & 7) << 2)
    SaveWriteByte(File, Packed)
    SaveWriteWordLE(File, DelayCS & $FFFF)
    SaveWriteByte(File, 0)
    SaveWriteByte(File, 0)
    
    SaveWriteByte(File, $2C)
    SaveWriteWordLE(File, Left)
    SaveWriteWordLE(File, Top)
    SaveWriteWordLE(File, Width)
    SaveWriteWordLE(File, Height)
    SaveWriteByte(File, $80 | (SizeBits & 7))
    
    For i = 0 To ColorTableSize - 1
      SaveWriteByte(File, PaletteR(i))
      SaveWriteByte(File, PaletteG(i))
      SaveWriteByte(File, PaletteB(i))
    Next
    
    SaveWriteByte(File, MinCodeSize)
    
    Pos = 0
    While Pos < LZWSize
      BlockSize = LZWSize - Pos
      If BlockSize > 255
        BlockSize = 255
      EndIf
      SaveWriteByte(File, BlockSize)
      WriteData(File, *LZW + Pos, BlockSize)
      Pos + BlockSize
    Wend
    SaveWriteByte(File, 0)
    
    ProcedureReturn #True
  EndProcedure

  Procedure.i MemoryWriteASCII(*Writer.MemoryWriter, Text.s)
    Protected i.i
    For i = 1 To Len(Text)
      If MemoryWriteByte(*Writer, Asc(Mid(Text, i, 1))) = #False
        ProcedureReturn #False
      EndIf
    Next
    ProcedureReturn #True
  EndProcedure

  Procedure.i MemoryWriteGIFGlobalHeader(*Writer.MemoryWriter, Width.i, Height.i, Array PaletteR.i(1), Array PaletteG.i(1), Array PaletteB.i(1), ColorTableSize.i)
    Protected i.i
    Protected Packed.i
    Protected SizeBits.i

    SizeBits = IntLog2(ColorTableSize) - 1
    If SizeBits < 0 : SizeBits = 0 : EndIf
    Packed = $80 | (7 << 4) | (SizeBits & 7)

    If MemoryWriteASCII(*Writer, "GIF89a") = #False : ProcedureReturn #False : EndIf
    If MemoryWriteWordLE(*Writer, Width) = #False : ProcedureReturn #False : EndIf
    If MemoryWriteWordLE(*Writer, Height) = #False : ProcedureReturn #False : EndIf
    If MemoryWriteByte(*Writer, Packed) = #False : ProcedureReturn #False : EndIf
    If MemoryWriteByte(*Writer, 0) = #False : ProcedureReturn #False : EndIf
    If MemoryWriteByte(*Writer, 0) = #False : ProcedureReturn #False : EndIf

    For i = 0 To ColorTableSize - 1
      If MemoryWriteByte(*Writer, PaletteR(i)) = #False : ProcedureReturn #False : EndIf
      If MemoryWriteByte(*Writer, PaletteG(i)) = #False : ProcedureReturn #False : EndIf
      If MemoryWriteByte(*Writer, PaletteB(i)) = #False : ProcedureReturn #False : EndIf
    Next

    ProcedureReturn #True
  EndProcedure

  Procedure.i MemoryWriteGIFFrame(*Writer.MemoryWriter, *LZW, LZWSize.i, Width.i, Height.i, MinCodeSize.i)
    Protected Pos.i
    Protected BlockSize.i

    If MemoryWriteByte(*Writer, $21) = #False : ProcedureReturn #False : EndIf
    If MemoryWriteByte(*Writer, $F9) = #False : ProcedureReturn #False : EndIf
    If MemoryWriteByte(*Writer, 4) = #False : ProcedureReturn #False : EndIf
    If MemoryWriteByte(*Writer, 4) = #False : ProcedureReturn #False : EndIf
    If MemoryWriteWordLE(*Writer, 0) = #False : ProcedureReturn #False : EndIf
    If MemoryWriteByte(*Writer, 0) = #False : ProcedureReturn #False : EndIf
    If MemoryWriteByte(*Writer, 0) = #False : ProcedureReturn #False : EndIf

    If MemoryWriteByte(*Writer, $2C) = #False : ProcedureReturn #False : EndIf
    If MemoryWriteWordLE(*Writer, 0) = #False : ProcedureReturn #False : EndIf
    If MemoryWriteWordLE(*Writer, 0) = #False : ProcedureReturn #False : EndIf
    If MemoryWriteWordLE(*Writer, Width) = #False : ProcedureReturn #False : EndIf
    If MemoryWriteWordLE(*Writer, Height) = #False : ProcedureReturn #False : EndIf
    If MemoryWriteByte(*Writer, 0) = #False : ProcedureReturn #False : EndIf
    If MemoryWriteByte(*Writer, MinCodeSize) = #False : ProcedureReturn #False : EndIf

    Pos = 0
    While Pos < LZWSize
      BlockSize = LZWSize - Pos
      If BlockSize > 255
        BlockSize = 255
      EndIf
      If MemoryWriteByte(*Writer, BlockSize) = #False : ProcedureReturn #False : EndIf
      If MemoryWriteData(*Writer, *LZW + Pos, BlockSize) <> BlockSize : ProcedureReturn #False : EndIf
      Pos + BlockSize
    Wend
    ProcedureReturn MemoryWriteByte(*Writer, 0)
  EndProcedure
  
  Procedure.i Encode(ImageID.i, *OutSize.Integer = #Null)
    Protected writer.MemoryWriter
    Protected Width.i
    Protected Height.i
    Protected *Indices
    Protected *LZW
    Protected LZWSize.i
    Protected *Result
    Dim PaletteR.i(255)
    Dim PaletteG.i(255)
    Dim PaletteB.i(255)
    
    If *OutSize : *OutSize\i = 0 : EndIf
    SetLastError("")
    
    If IsImage(ImageID) = 0
      SetLastError("Invalid image id.")
      ProcedureReturn #False
    EndIf
    
    Width = ImageWidth(ImageID)
    Height = ImageHeight(ImageID)
    If Width <= 0 Or Height <= 0
      SetLastError("Invalid image dimensions.")
      ProcedureReturn #False
    EndIf
    
    *Indices = AllocateMemory(Width * Height)
    If *Indices = 0
      SetLastError("Out of memory while preparing GIF indices.")
      ProcedureReturn #False
    EndIf
    
    Build332Palette(PaletteR(), PaletteG(), PaletteB())
    
    If QuantizeImage332(ImageID, *Indices) = #False
      FreeMemory(*Indices)
      SetLastError("Unable to access image pixels for GIF save.")
      ProcedureReturn #False
    EndIf
    
    *LZW = LZWEncode(*Indices, Width * Height, 8, @LZWSize)
    FreeMemory(*Indices)
    If *LZW = 0
      SetLastError("Failed to LZW encode GIF image data.")
      ProcedureReturn #False
    EndIf
    
    If InitMemoryWriter(@writer, LZWSize + 1024) = #False
      FreeMemory(*LZW)
      SetLastError("Out of memory while preparing GIF output.")
      ProcedureReturn 0
    EndIf

    If MemoryWriteGIFGlobalHeader(@writer, Width, Height, PaletteR(), PaletteG(), PaletteB(), 256) = #False Or MemoryWriteGIFFrame(@writer, *LZW, LZWSize, Width, Height, 8) = #False Or MemoryWriteByte(@writer, $3B) = #False
      FreeMemory(*LZW)
      If writer\Data : FreeMemory(writer\Data) : EndIf
      SetLastError("Failed to write GIF memory output.")
      ProcedureReturn 0
    EndIf

    FreeMemory(*LZW)
    *Result = FinishMemoryWriter(@writer)
    If *Result = 0
      SetLastError("Failed to finish GIF memory output.")
      ProcedureReturn 0
    EndIf
    If *OutSize : *OutSize\i = MemorySize(*Result) : EndIf
    ProcedureReturn *Result
  EndProcedure

  Procedure.i Save(ImageID.i, Filename.s)
    Protected *Data
    Protected Size.i
    Protected ok.i

    *Data = Encode(ImageID, @Size)
    If *Data = 0 Or Size <= 0
      ProcedureReturn #False
    EndIf
    ok = WriteWholeFile(Filename, *Data, Size)
    FreeMemory(*Data)
    If ok = #False
      SetLastError("Cannot create output file: " + Filename)
    EndIf
    ProcedureReturn ok
  EndProcedure

  Procedure.i Save_Animated_LocalPalettes(Filename.s, List ImageIDs.i(), DelayCS.i = 5, LoopCount.i = 0, MaxColors.i = 256, FrameStep.i = 1)
    Protected File.i
    Protected Width.i = -1
    Protected Height.i = -1
    Protected CurrentWidth.i
    Protected CurrentHeight.i
    Protected FrameID.i
    Protected FramePos.i
    Protected SelectedFrames.i
    Protected UsedColors.i
    Protected ExactOverflow.i
    Protected TableSize.i
    Protected MinCodeSize.i
    Protected LevelR.i, LevelG.i, LevelB.i
    Protected *Indices
    Protected *LZW
    Protected LZWSize.i
    Dim GlobalR.i(1)
    Dim GlobalG.i(1)
    Dim GlobalB.i(1)
    Dim PaletteR.i(255)
    Dim PaletteG.i(255)
    Dim PaletteB.i(255)
    NewMap ExactColorToIndex.i()
    
    SetLastError("")
    If DelayCS < 0 : DelayCS = 0 : EndIf
    If FrameStep < 1 : FrameStep = 1 : EndIf
    MaxColors = ClampInt(MaxColors, 2, 256)
    
    ForEach ImageIDs()
      FrameID = ImageIDs()
      If IsImage(FrameID) = 0
        SetLastError("Invalid image id in frame list.")
        ProcedureReturn #False
      EndIf
      CurrentWidth = ImageWidth(FrameID)
      CurrentHeight = ImageHeight(FrameID)
      If CurrentWidth <= 0 Or CurrentHeight <= 0
        SetLastError("Invalid frame dimensions in frame list.")
        ProcedureReturn #False
      EndIf
      If Width = -1
        Width = CurrentWidth
        Height = CurrentHeight
      ElseIf CurrentWidth <> Width Or CurrentHeight <> Height
        SetLastError("All frames must have same dimensions for Save_Animated_LocalPalettes.")
        ProcedureReturn #False
      EndIf
    Next
    
    If Width <= 0 Or Height <= 0
      SetLastError("Frame list is empty.")
      ProcedureReturn #False
    EndIf
    
    File = CreateFile(#PB_Any, Filename)
    If File = 0
      SetLastError("Cannot create output file: " + Filename)
      ProcedureReturn #False
    EndIf
    
    GlobalR(0) = 0 : GlobalG(0) = 0 : GlobalB(0) = 0
    GlobalR(1) = 0 : GlobalG(1) = 0 : GlobalB(1) = 0
    WriteGIFGlobalHeader(File, Width, Height, GlobalR(), GlobalG(), GlobalB(), 2)
    WriteGIFLoopExtension(File, LoopCount)
    
    FramePos = 0
    ForEach ImageIDs()
      If (FramePos % FrameStep) <> 0
        FramePos + 1
        Continue
      EndIf
      
      FrameID = ImageIDs()
      *Indices = AllocateMemory(Width * Height)
      If *Indices = 0
        CloseFile(File)
        SetLastError("Out of memory while encoding animated GIF.")
        ProcedureReturn #False
      EndIf
      
      ClearMap(ExactColorToIndex())
      UsedColors = 0
      ExactOverflow = #False
      If AddExactPaletteColors(FrameID, ExactColorToIndex(), PaletteR(), PaletteG(), PaletteB(), @UsedColors, 0, MaxColors, @ExactOverflow)
        If QuantizeImageExact(FrameID, *Indices, ExactColorToIndex()) = #False
          FreeMemory(*Indices)
          CloseFile(File)
          SetLastError("Exact palette mapping failed unexpectedly.")
          ProcedureReturn #False
        EndIf
      ElseIf ExactOverflow
        BuildPaletteLevels(MaxColors, @LevelR, @LevelG, @LevelB)
        BuildPaletteFromLevels(LevelR, LevelG, LevelB, PaletteR(), PaletteG(), PaletteB(), @UsedColors, 0)
        If QuantizeImageToLevels(FrameID, *Indices, LevelR, LevelG, LevelB, 0) = #False
          FreeMemory(*Indices)
          CloseFile(File)
          SetLastError("Unable to read frame pixels for animated GIF.")
          ProcedureReturn #False
        EndIf
      Else
        FreeMemory(*Indices)
        CloseFile(File)
        If GetLastError() = "" : SetLastError("Unable to build frame palette for animated GIF.") : EndIf
        ProcedureReturn #False
      EndIf
      
      TableSize = NextPowerOfTwo(UsedColors)
      If TableSize < 2 : TableSize = 2 : EndIf
      MinCodeSize = IntLog2(TableSize)
      If MinCodeSize < 2 : MinCodeSize = 2 : EndIf
      
      *LZW = LZWEncode(*Indices, Width * Height, MinCodeSize, @LZWSize)
      FreeMemory(*Indices)
      If *LZW = 0
        CloseFile(File)
        SetLastError("Failed to LZW encode one animation frame.")
        ProcedureReturn #False
      EndIf
      
      WriteGIFFrameLocalPalette(File, *LZW, LZWSize, 0, 0, Width, Height, DelayCS, MinCodeSize, PaletteR(), PaletteG(), PaletteB(), TableSize, 1)
      FreeMemory(*LZW)
      
      SelectedFrames + 1
      FramePos + 1
    Next
    
    If SelectedFrames = 0
      CloseFile(File)
      DeleteFile(Filename)
      SetLastError("No frames selected. Adjust FrameStep.")
      ProcedureReturn #False
    EndIf
    
    SaveWriteByte(File, $3B)
    CloseFile(File)
    ProcedureReturn #True
  EndProcedure

  Procedure.i Save_Animated_IndexedPalettes(Filename.s, List Frames.IndexedFrame(), DelayCS.i = 5, LoopCount.i = 0)
    Protected File.i
    Protected Width.i = -1
    Protected Height.i = -1
    Protected TableSize.i
    Protected MinCodeSize.i
    Protected *LZW
    Protected LZWSize.i
    Protected i.i
    Protected SelectedFrames.i
    Dim GlobalR.i(1)
    Dim GlobalG.i(1)
    Dim GlobalB.i(1)
    Dim PaletteR.i(255)
    Dim PaletteG.i(255)
    Dim PaletteB.i(255)
    
    SetLastError("")
    If DelayCS < 0 : DelayCS = 0 : EndIf
    
    ForEach Frames()
      If Frames()\Width <= 0 Or Frames()\Height <= 0 Or Frames()\Indices = 0 Or Frames()\PaletteRGB = 0 Or Frames()\ColorCount < 2 Or Frames()\ColorCount > 256
        SetLastError("Invalid indexed frame.")
        ProcedureReturn #False
      EndIf
      If Width = -1
        Width = Frames()\Width
        Height = Frames()\Height
      ElseIf Frames()\Width <> Width Or Frames()\Height <> Height
        SetLastError("All indexed frames must have same dimensions.")
        ProcedureReturn #False
      EndIf
    Next
    
    If Width <= 0 Or Height <= 0
      SetLastError("Frame list is empty.")
      ProcedureReturn #False
    EndIf
    
    File = CreateFile(#PB_Any, Filename)
    If File = 0
      SetLastError("Cannot create output file: " + Filename)
      ProcedureReturn #False
    EndIf
    
    GlobalR(0) = 0 : GlobalG(0) = 0 : GlobalB(0) = 0
    GlobalR(1) = 0 : GlobalG(1) = 0 : GlobalB(1) = 0
    WriteGIFGlobalHeader(File, Width, Height, GlobalR(), GlobalG(), GlobalB(), 2)
    WriteGIFLoopExtension(File, LoopCount)
    
    ForEach Frames()
      For i = 0 To 255
        If i < Frames()\ColorCount
          PaletteR(i) = PeekA(Frames()\PaletteRGB + i * 3 + 0) & $FF
          PaletteG(i) = PeekA(Frames()\PaletteRGB + i * 3 + 1) & $FF
          PaletteB(i) = PeekA(Frames()\PaletteRGB + i * 3 + 2) & $FF
        Else
          PaletteR(i) = 0
          PaletteG(i) = 0
          PaletteB(i) = 0
        EndIf
      Next
      
      TableSize = NextPowerOfTwo(Frames()\ColorCount)
      If TableSize < 2 : TableSize = 2 : EndIf
      MinCodeSize = IntLog2(TableSize)
      If MinCodeSize < 2 : MinCodeSize = 2 : EndIf
      
      *LZW = LZWEncode(Frames()\Indices, Width * Height, MinCodeSize, @LZWSize)
      If *LZW = 0
        CloseFile(File)
        SetLastError("Failed to LZW encode one indexed animation frame.")
        ProcedureReturn #False
      EndIf
      
      WriteGIFFrameLocalPalette(File, *LZW, LZWSize, 0, 0, Width, Height, DelayCS, MinCodeSize, PaletteR(), PaletteG(), PaletteB(), TableSize, 1)
      FreeMemory(*LZW)
      SelectedFrames + 1
    Next
    
    If SelectedFrames = 0
      CloseFile(File)
      DeleteFile(Filename)
      SetLastError("No indexed frames selected.")
      ProcedureReturn #False
    EndIf
    
    SaveWriteByte(File, $3B)
    CloseFile(File)
    ProcedureReturn #True
  EndProcedure
  
  Procedure.i Save_Animated(Filename.s, List ImageIDs.i(), DelayCS.i = 5, LoopCount.i = 0, MaxColors.i = 256, FrameStep.i = 1, TargetWidth.i = 0, TargetHeight.i = 0, UseDeltaBBox.i = #False, UseTransparentDelta.i = #False, UseExactPaletteIfPossible.i = #True)
    Protected File.i
    Protected Width.i = -1
    Protected Height.i = -1
    Protected CurrentWidth.i
    Protected CurrentHeight.i
    Protected *Indices
    Protected *PrevIndices = 0
    Protected *Region
    Protected *LZW
    Protected LZWSize.i
    Protected FrameID.i
    Protected HasFrames.i = #False
    Protected LevelR.i, LevelG.i, LevelB.i
    Protected UsedColors.i
    Protected TableSize.i
    Protected MinCodeSize.i
    Protected UseLegacy332.i
    Protected UseExactPalette.i = #False
    Protected ExactOverflow.i
    Protected PaletteBaseIndex.i = 0
    Protected FramePos.i = 0
    Protected SelectedFrames.i = 0
    Protected ExactSelectedFrames.i = 0
    Protected EncImage.i
    Protected TransparentIndexFrame.i
    Protected UseTransparentThisFrame.i
    Protected i.i
    Protected x.i, y.i
    Protected Left.i, Top.i, Right.i, Bottom.i
    Protected RegionW.i, RegionH.i
    Protected OwnsRegion.i
    Dim PaletteR.i(255)
    Dim PaletteG.i(255)
    Dim PaletteB.i(255)
    Dim UsedInRegion.i(255)
    NewMap ExactColorToIndex.i()
    
    SetLastError("")
    
    If DelayCS < 0
      DelayCS = 0
    EndIf
    If FrameStep < 1
      FrameStep = 1
    EndIf
    MaxColors = ClampInt(MaxColors, 2, 256)
    
    ; Validate frames and logical screen dimensions.
    ForEach ImageIDs()
      FrameID = ImageIDs()
      If IsImage(FrameID) = 0
        SetLastError("Invalid image id in frame list.")
        ProcedureReturn #False
      EndIf
      
      CurrentWidth = ImageWidth(FrameID)
      CurrentHeight = ImageHeight(FrameID)
      If CurrentWidth <= 0 Or CurrentHeight <= 0
        SetLastError("Invalid frame dimensions in frame list.")
        ProcedureReturn #False
      EndIf
      
      If Width = -1
        Width = CurrentWidth
        Height = CurrentHeight
      ElseIf CurrentWidth <> Width Or CurrentHeight <> Height
        SetLastError("All frames must have same dimensions for Save_Animated.")
        ProcedureReturn #False
      EndIf
      
      HasFrames = #True
    Next
    
    If HasFrames = #False
      SetLastError("Frame list is empty.")
      ProcedureReturn #False
    EndIf
    
    If TargetWidth <= 0 : TargetWidth = Width : EndIf
    If TargetHeight <= 0 : TargetHeight = Height : EndIf
    Width = TargetWidth
    Height = TargetHeight
    
    If UseTransparentDelta = #False Or UseDeltaBBox = #False
      PaletteBaseIndex = 0
    Else
      PaletteBaseIndex = 1
    EndIf
    
    ; Optional exact palette path: best fidelity and often better compression.
    If UseExactPaletteIfPossible
      UsedColors = PaletteBaseIndex
      ExactOverflow = #False
      If PaletteBaseIndex = 1
        PaletteR(0) = 0 : PaletteG(0) = 0 : PaletteB(0) = 0
      EndIf
      
      ClearMap(ExactColorToIndex())
      FramePos = 0
      ForEach ImageIDs()
        FrameID = ImageIDs()
        If (FramePos % FrameStep) <> 0
          FramePos + 1
          Continue
        EndIf
        
        EncImage = CreateScaledCopy(FrameID, Width, Height)
        If EncImage = 0
          SetLastError("Failed to scale frame for exact palette analysis.")
          ProcedureReturn #False
        EndIf
        
        If AddExactPaletteColors(EncImage, ExactColorToIndex(), PaletteR(), PaletteG(), PaletteB(), @UsedColors, PaletteBaseIndex, 256, @ExactOverflow) = #False
          If EncImage <> FrameID : FreeImage(EncImage) : EndIf
          If ExactOverflow = #False
            If GetLastError() = "" : SetLastError("Unable to build exact palette for animated GIF.") : EndIf
            ProcedureReturn #False
          EndIf
          Break
        EndIf
        
        If EncImage <> FrameID : FreeImage(EncImage) : EndIf
        FramePos + 1
        ExactSelectedFrames + 1
      Next
      
      If ExactOverflow = #False And ExactSelectedFrames > 0
        UseExactPalette = #True
      EndIf
    EndIf
    
    If UseExactPalette
      TableSize = NextPowerOfTwo(UsedColors)
      If TableSize < 2 : TableSize = 2 : EndIf
      MinCodeSize = IntLog2(TableSize)
      If MinCodeSize < 2 : MinCodeSize = 2 : EndIf
      UseLegacy332 = #False
    Else
      UseLegacy332 = Bool(MaxColors >= 256 And PaletteBaseIndex = 0)
    EndIf
    
    If UseExactPalette = #False And UseLegacy332
      Build332Palette(PaletteR(), PaletteG(), PaletteB())
      TableSize = 256
      MinCodeSize = 8
    ElseIf UseExactPalette = #False
      ; Reserve index 0 for transparency when requested.
      BuildPaletteLevels(MaxColors - PaletteBaseIndex, @LevelR, @LevelG, @LevelB)
      BuildPaletteFromLevels(LevelR, LevelG, LevelB, PaletteR(), PaletteG(), PaletteB(), @UsedColors, PaletteBaseIndex)
      TableSize = NextPowerOfTwo(UsedColors)
      If TableSize < 2 : TableSize = 2 : EndIf
      MinCodeSize = IntLog2(TableSize)
      If MinCodeSize < 2 : MinCodeSize = 2 : EndIf
    EndIf
    
    If UseDeltaBBox
      *PrevIndices = AllocateMemory(Width * Height)
      If *PrevIndices = 0
        SetLastError("Out of memory for delta buffer.")
        ProcedureReturn #False
      EndIf
      FillMemory(*PrevIndices, Width * Height, 0)
    EndIf
    
    File = CreateFile(#PB_Any, Filename)
    If File = 0
      If *PrevIndices : FreeMemory(*PrevIndices) : EndIf
      SetLastError("Cannot create output file: " + Filename)
      ProcedureReturn #False
    EndIf
    
    WriteGIFGlobalHeader(File, Width, Height, PaletteR(), PaletteG(), PaletteB(), TableSize)
    WriteGIFLoopExtension(File, LoopCount)
    
    FramePos = 0
    ForEach ImageIDs()
      FrameID = ImageIDs()
      If (FramePos % FrameStep) <> 0
        FramePos + 1
        Continue
      EndIf
      
      *Indices = AllocateMemory(Width * Height)
      If *Indices = 0
        If *PrevIndices : FreeMemory(*PrevIndices) : EndIf
        CloseFile(File)
        SetLastError("Out of memory while encoding animated GIF.")
        ProcedureReturn #False
      EndIf
      
      EncImage = CreateScaledCopy(FrameID, Width, Height)
      If EncImage = 0
        FreeMemory(*Indices)
        If *PrevIndices : FreeMemory(*PrevIndices) : EndIf
        CloseFile(File)
        SetLastError("Failed to scale frame for animated GIF.")
        ProcedureReturn #False
      EndIf
      
      If UseExactPalette
        If QuantizeImageExact(EncImage, *Indices, ExactColorToIndex()) = #False
          FreeMemory(*Indices)
          If EncImage <> FrameID : FreeImage(EncImage) : EndIf
          If *PrevIndices : FreeMemory(*PrevIndices) : EndIf
          CloseFile(File)
          SetLastError("Exact palette mapping failed unexpectedly.")
          ProcedureReturn #False
        EndIf
      ElseIf UseLegacy332
        If QuantizeImage332(EncImage, *Indices) = #False
          FreeMemory(*Indices)
          If EncImage <> FrameID : FreeImage(EncImage) : EndIf
          If *PrevIndices : FreeMemory(*PrevIndices) : EndIf
          CloseFile(File)
          SetLastError("Unable to read frame pixels for animated GIF.")
          ProcedureReturn #False
        EndIf
      ElseIf QuantizeImageToLevels(EncImage, *Indices, LevelR, LevelG, LevelB, PaletteBaseIndex) = #False
        FreeMemory(*Indices)
        If EncImage <> FrameID : FreeImage(EncImage) : EndIf
        If *PrevIndices : FreeMemory(*PrevIndices) : EndIf
        CloseFile(File)
        SetLastError("Unable to read frame pixels for animated GIF.")
        ProcedureReturn #False
      EndIf
      
      If EncImage <> FrameID
        FreeImage(EncImage)
      EndIf
      
      Left = 0 : Top = 0 : RegionW = Width : RegionH = Height
      *Region = *Indices
      OwnsRegion = #False
      TransparentIndexFrame = 0
      UseTransparentThisFrame = #False
      If UseDeltaBBox And SelectedFrames > 0
        Left = Width : Top = Height : Right = -1 : Bottom = -1
        
        For y = 0 To Height - 1
          For x = 0 To Width - 1
            If PeekA(*Indices + y * Width + x) <> PeekA(*PrevIndices + y * Width + x)
              If x < Left : Left = x : EndIf
              If y < Top : Top = y : EndIf
              If x > Right : Right = x : EndIf
              If y > Bottom : Bottom = y : EndIf
            EndIf
          Next
        Next
        
        If Right >= Left And Bottom >= Top
          RegionW = Right - Left + 1
          RegionH = Bottom - Top + 1
          *Region = AllocateMemory(RegionW * RegionH)
          If *Region = 0
            FreeMemory(*Indices)
            If *PrevIndices : FreeMemory(*PrevIndices) : EndIf
            CloseFile(File)
            SetLastError("Out of memory while creating delta region.")
            ProcedureReturn #False
          EndIf
          OwnsRegion = #True
          
          If UseTransparentDelta
            For i = 0 To 255
              UsedInRegion(i) = 0
            Next
            
            ; Collect colors used by changed pixels only.
            For y = 0 To RegionH - 1
              For x = 0 To RegionW - 1
                If PeekA(*Indices + (Top + y) * Width + (Left + x)) <> PeekA(*PrevIndices + (Top + y) * Width + (Left + x))
                  UsedInRegion(PeekA(*Indices + (Top + y) * Width + (Left + x)) & $FF) = 1
                EndIf
              Next
            Next
            
            ; Choose a transparent index not used by changed pixels.
            TransparentIndexFrame = -1
            For i = 0 To 255
              If UsedInRegion(i) = 0
                TransparentIndexFrame = i
                Break
              EndIf
            Next
            
            If TransparentIndexFrame >= 0
              UseTransparentThisFrame = #True
            EndIf
          EndIf
          
          For y = 0 To RegionH - 1
            If UseTransparentThisFrame
              For x = 0 To RegionW - 1
                If PeekA(*Indices + (Top + y) * Width + (Left + x)) = PeekA(*PrevIndices + (Top + y) * Width + (Left + x))
                  PokeA(*Region + y * RegionW + x, TransparentIndexFrame)
                Else
                  PokeA(*Region + y * RegionW + x, PeekA(*Indices + (Top + y) * Width + (Left + x)))
                EndIf
              Next
            Else
              CopyMemory(*Indices + (Top + y) * Width + Left, *Region + y * RegionW, RegionW)
            EndIf
          Next
        Else
          ; No visual difference: write a 1x1 harmless frame to preserve timing.
          Left = 0 : Top = 0 : RegionW = 1 : RegionH = 1
          *Region = AllocateMemory(1)
          If *Region = 0
            FreeMemory(*Indices)
            If *PrevIndices : FreeMemory(*PrevIndices) : EndIf
            CloseFile(File)
            SetLastError("Out of memory while creating no-change frame.")
            ProcedureReturn #False
          EndIf
          OwnsRegion = #True
          If UseTransparentDelta
            UseTransparentThisFrame = #True
            TransparentIndexFrame = 0
            PokeA(*Region, TransparentIndexFrame)
          Else
            PokeA(*Region, PeekA(*Indices))
          EndIf
        EndIf
      EndIf
      
      *LZW = LZWEncode(*Region, RegionW * RegionH, MinCodeSize, @LZWSize)
      
      If *LZW = 0
        If OwnsRegion : FreeMemory(*Region) : EndIf
        FreeMemory(*Indices)
        If *PrevIndices : FreeMemory(*PrevIndices) : EndIf
        CloseFile(File)
        SetLastError("Failed to LZW encode one animation frame.")
        ProcedureReturn #False
      EndIf
      
      If UseDeltaBBox And SelectedFrames > 0 And UseTransparentThisFrame
        WriteGIFFrame(File, *LZW, LZWSize, Left, Top, RegionW, RegionH, DelayCS, MinCodeSize, #True, TransparentIndexFrame, 1)
      Else
        WriteGIFFrame(File, *LZW, LZWSize, Left, Top, RegionW, RegionH, DelayCS, MinCodeSize, #False, 0, 1)
      EndIf
      FreeMemory(*LZW)
      If OwnsRegion : FreeMemory(*Region) : EndIf
      
      If UseDeltaBBox
        CopyMemory(*Indices, *PrevIndices, Width * Height)
      EndIf
      FreeMemory(*Indices)
      
      SelectedFrames + 1
      FramePos + 1
    Next
    
    If *PrevIndices : FreeMemory(*PrevIndices) : EndIf
    
    If SelectedFrames = 0
      CloseFile(File)
      DeleteFile(Filename)
      SetLastError("No frames selected. Adjust FrameStep.")
      ProcedureReturn #False
    EndIf
    
    SaveWriteByte(File, $3B) ; trailer
    CloseFile(File)
    
    ProcedureReturn #True
  EndProcedure

EndModule