It is currently Thu Oct 17, 2019 9:27 pm

All times are UTC + 1 hour




Post new topic Reply to topic  [ 34 posts ]  Go to page 1, 2, 3  Next
Author Message
 Post subject: GifDecoder module (All OS, single frame & animated gifs)
PostPosted: Sat Dec 07, 2013 6:13 pm 
Offline
PureBasic Expert
PureBasic Expert

Joined: Sun Aug 08, 2004 5:21 am
Posts: 3479
Location: Netherlands
A cross platform module to get an image or sprite from a (animated) gif file that is loaded into memory.
Code:
DeclareModule GifDecoder; v1.2.1
 
  Structure GIF_Frame
    image.i
    left.u
    top.u
    width.u
    height.u
    delay.u   ; frame delay
    dispose.u ; (0 or 1 = do not dispose, 2 = restore to background color, 3 = restore to previous)
  EndStructure
 
  Declare.l BackgroundColor(*GIF_Data); Get the background color
  Declare.i Width(*GIF_Data); Get the width of the gif
  Declare.i Height(*GIF_Data); Get the height of the gif
  Declare.i FrameCount(*GIF_Data); Count the number of frames
  Declare.i LoopCount(*GIF_Data); Get the number of times the animation should loop (0 = infinite)
  Declare.i GetFrame(*Frame.GIF_Frame, *GIF_Data, FrameNumber = 0, Mode = 0); Get a frame. Mode 1 creates Sprites instead of Images
  Declare.i GetRenderedFrames(Array Frames.GIF_Frame(1), *GIF_Data, BgColor.l = $DDDDDD, Mode = 0, *Animation = 0); Get all prerendered frames with delay set in msec.
  Declare.i Animate(Target, *GIF_Data = 0, FreeData = #False, BgColor.l = $DDDDDD, MaxWidth = 0, MaxHeight = 0, MinDelay = 0); Set the animation for Target (an ImageGadget)
 
EndDeclareModule

Module GifDecoder
 
  Structure CodeTableEntry
    *prev
    color.l
    size.l
  EndStructure
 
  Structure MultiType
    l.l[0]
    u.u[0]
    a.a[0]
  EndStructure
 
  Structure Animation
    Target.i  ; image gadget to target
    *GIF_Data
    ThreadID.i
    MaxWidth.i
    MaxHeight.i
    BgColor.l
    MinDelay.l; minimum frame delay in msec
    FreeData.l
    Quit.l    ; quit flag
  EndStructure
 
  NewMap AnimationForTarget.i()
 
  Procedure.i SkipBlock(*m)
    CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
      !mov rax, [p.p_m]
      !gifdecoder_skipblock_loop:
      !movzx rcx, byte [rax]
      !lea rax, [rax + rcx + 1]
    CompilerElse
      !mov eax, [p.p_m]
      !gifdecoder_skipblock_loop:
      !movzx ecx, byte [eax]
      !lea eax, [eax + ecx + 1]
    CompilerEndIf
    !and cl, cl
    !jnz gifdecoder_skipblock_loop
    ProcedureReturn
  EndProcedure
 
  Procedure.l CopyPattern(*ct, *ptr_output_buffer)
    CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
      !mov rcx, [p.p_ct]
      !mov rdx, [p.p_ptr_output_buffer]
      !movzx rax, word [rcx + 12]
      !add [rdx], rax
      !mov rdx, [rdx]
      !gifdecoder_copypattern_loop:
      !sub rdx, 4
      !mov eax, [rcx + 8]
      !mov [rdx], eax
      !mov rcx, [rcx]
      !and rcx, rcx
    CompilerElse
      !mov ecx, [p.p_ct]
      !mov edx, [p.p_ptr_output_buffer]
      !movzx eax, word [ecx + 8]
      !add [edx], eax
      !mov edx, [edx]
      !gifdecoder_copypattern_loop:
      !sub edx, 4
      !mov eax, [ecx + 4]
      !mov [edx], eax
      !mov ecx, [ecx]
      !and ecx, ecx
    CompilerEndIf 
    !jnz gifdecoder_copypattern_loop
    ProcedureReturn 
  EndProcedure
 
  Procedure CopySwapRB(*src, *dst, num_pix)
    !mov ecx, [p.v_num_pix]
    !shl ecx, 2
    !jz gifdecoder_copyswaprb_exit
    !sub ecx, 4
    CompilerIf #PB_Compiler_Processor = #PB_Processor_x64 
      !mov rax, [p.p_src]
      !mov rdx, [p.p_dst]
      !push rsi
      !mov rsi, rax
      !gifdecoder_copyswaprb_loop:
      !mov eax, [rsi + rcx]
      !bswap eax
      !ror eax, 8
      !mov [rdx + rcx], eax
      !sub rcx, 4
      !jnc gifdecoder_copyswaprb_loop
      !pop rsi
    CompilerElse
      !mov eax, [p.p_src]
      !mov edx, [p.p_dst]
      !push esi
      !mov esi, eax
      !gifdecoder_copyswaprb_loop:
      !mov eax, [esi + ecx]
      !bswap eax
      !ror eax, 8
      !mov [edx + ecx], eax
      !sub ecx, 4
      !jnc gifdecoder_copyswaprb_loop
      !pop esi
    CompilerEndIf
    !gifdecoder_copyswaprb_exit:
  EndProcedure
 
  Procedure.i CopyLine(*buffer.Long, y, width, height, *db, fmt, pitch)
    Protected.i x
    If fmt & (#PB_PixelFormat_32Bits_RGB | #PB_PixelFormat_32Bits_BGR)
      If fmt & #PB_PixelFormat_ReversedY
        y = height - y - 1
      EndIf
      If fmt & #PB_PixelFormat_32Bits_RGB
        CopyMemory(*buffer, *db + y * pitch, width << 2)
      Else
        CopySwapRB(*buffer, *db + y * Pitch, width)
      EndIf
      *buffer + width << 2
    Else
      While x < width
        Plot(x, y, *buffer\l)
        x + 1 : *buffer + 4
      Wend
    EndIf
    ProcedureReturn *buffer                 
  EndProcedure
 
  Procedure DecodeImageData(*image_data.MultiType, Array ct.CodeTableEntry(1), *output_buffer.Long)
   
    Protected.i min_code_size = *image_data\a[0]
    Protected.i bits_left, bytes_left = *image_data\a[1]
    Protected.i code_size = min_code_size + 1
    Protected.i localcode, clrcode = 1 << min_code_size
    Protected.i code = clrcode, endcode = clrcode + 1
    Protected.i lastcode = endcode
    Protected.i bits, bit_mask = 1 << code_size - 1
   
    *image_data + 2
   
    Repeat
      ; get next code
      While bits_left < code_size
        If bytes_left > 1
          bits | *image_data\u[0] << bits_left
          bits_left + 16
          bytes_left - 2
          *image_data + 2
          Break
        Else
          If bytes_left = 1
            bits | *image_data\a[0] << bits_left
            bits_left + 8
            *image_data + 1
          EndIf
          bytes_left = *image_data\a[0]
          *image_data + 1
          If bytes_left = 0
            Break 2
          EndIf
        EndIf
      Wend
      localcode = code
      code = bits & bit_mask
      bits >> code_size
      bits_left - code_size
     
      If code <= lastcode
        ; code in table
        If code <> endcode
          If code <> clrcode
            If localcode <> clrcode
              ; handle code in table
              If lastcode < 4095
                lastcode + 1
                ct(lastcode)\prev = @ct(localcode)
                ct(lastcode)\color = CopyPattern(@ct(code), @*output_buffer)
                ct(lastcode)\size = ct(localcode)\size + 4
              Else
                CopyPattern(@ct(code), @*output_buffer)
              EndIf
            Else
              ; handle first code after clear code
              *output_buffer\l = ct(code)\color : *output_buffer + 4
            EndIf
          Else
            ; handle clear code
            lastcode = endcode
            code_size = min_code_size + 1
            bit_mask = 1 << code_size - 1
          EndIf
        Else
          ; handle end code
          Break
        EndIf
      Else
        ; code not in table
        lastcode + 1
        ct(lastcode)\prev = @ct(localcode)
        ct(lastcode)\color = CopyPattern(@ct(localcode), @*output_buffer)
        ct(lastcode)\size = ct(localcode)\size + 4
        *output_buffer\l = ct(lastcode)\color : *output_buffer + 4           
      EndIf
     
      ; increase code_size if required
      If lastcode = bit_mask And code_size < 12
        code_size + 1
        bit_mask = 1 << code_size - 1
      EndIf
     
    ForEver
   
  EndProcedure
 
  Procedure.i GetFrame(*Frame.GIF_Frame, *GIF_Data, FrameNumber = 0, Mode = 0)
   
    Protected a.a, *buffer.Long, *palette.Long, *d.MultiType = *GIF_Data
    Protected.i i, x, y, check, entries, current_frame, loop_cnt, transp_idx = -1
    Protected.i *db, fmt, pitch   
    Dim ct.CodeTableEntry(4095)
   
    If FrameNumber >= 0
      *Frame\image = 0
    EndIf
   
    If *d\l[0] & $FFFFFF = $464947; 'GIF'
      a = *d\a[10] : *d + 13
      If a & $80; global color table present ?
        *palette = *d : entries = 2 << (a & 7) : *d + entries * 3
      EndIf
     
      Repeat
        Select *d\a[0]
          Case $21; extension
            Select *d\a[1]
              Case $F9; graphic control extension
                If current_frame = FrameNumber
                  a = *d\a[3]
                  *Frame\delay = *d\u[2]
                  *Frame\dispose = a >> 2 & 7
                  If a & 1 : transp_idx = *d\a[6] : EndIf
                EndIf
                *d + 8
              Case $FE; comment extension -> skip
                *d = SkipBlock(*d + 2)
              Case $FF; application extension
                If FrameNumber = -2 And PeekS(*d + 3, 11, #PB_Ascii) = "NETSCAPE2.0"
                  *d + 16 : loop_cnt = *d\u[0] : Break
                EndIf
                *d = SkipBlock(*d + 14)
              Case $01; plain text extension
                If current_frame <> FrameNumber
                  *d = SkipBlock(*d + 15) : current_frame + 1
                Else
                  *d + 3
                  *Frame\left = *d\u[0] : *Frame\top = *d\u[1] : *Frame\width = *d\u[2] : *Frame\height = *d\u[3]
                  If Mode = 1
                    *Frame\image = CreateSprite(#PB_Any, *Frame\width, *Frame\height, #PB_Sprite_AlphaBlending)
                  Else
                    *Frame\image = CreateImage(#PB_Any, *Frame\width, *Frame\height, 32, #PB_Image_Transparent)
                  EndIf
                  Break
                EndIf
              Default
                Break
            EndSelect
          Case $2C; image
            If current_frame <> FrameNumber
              a = *d\a[9] : *d + 10
              If a & $80 : *d + 2 << (a & 7) * 3 : EndIf
              *d = SkipBlock(*d + 1) : current_frame + 1
            Else
              *d + 1
              *Frame\left = *d\u[0] : *Frame\top = *d\u[1] : *Frame\width = *d\u[2] : *Frame\height = *d\u[3]
              a = *d\a[8] : *d + 9
              If a & $80; local color table present ?
                *palette = *d : entries = 2 << (a & 7) : *d + entries * 3
              EndIf
              While i < entries
                ct(i)\color = $FF000000 | *palette\l : ct(i)\size = 4 : *palette + 3 : i + 1
              Wend
              If transp_idx >= 0
                ct(transp_idx)\color = 0 
              EndIf
              *buffer = AllocateMemory(*Frame\width * *Frame\height << 2, #PB_Memory_NoClear)
              If *buffer
                DecodeImageData(*d, ct(), *buffer)
                If Mode = 1
                  *Frame\image = CreateSprite(#PB_Any, *Frame\width, *Frame\height, #PB_Sprite_AlphaBlending)
                  If *Frame\image : check = StartDrawing(SpriteOutput(*Frame\image)) : EndIf
                Else
                  *Frame\image = CreateImage(#PB_Any, *Frame\width, *Frame\height, 32)
                  If *Frame\image : check = StartDrawing(ImageOutput(*Frame\image)) : EndIf
                EndIf
                If check
                  *db = DrawingBuffer() : If *db
                    fmt = DrawingBufferPixelFormat()
                    pitch = DrawingBufferPitch()
                  EndIf
                  DrawingMode(#PB_2DDrawing_AllChannels)
                  If a >> 6 & 1
                    ; interlaced
                    For i = 0 To 3
                      y = 1 << (3 - i) & 7
                      While y < *Frame\height
                        *buffer = CopyLine(*buffer, y, *Frame\width, *Frame\height, *db, fmt, pitch)
                        y + (2 << (3 - i) - 1) & 7 + 1
                      Wend
                    Next
                  Else
                    ; non-interlaced
                    y = 0
                    While y < *Frame\height
                      *buffer = CopyLine(*buffer, y, *Frame\width, *Frame\height, *db, fmt, pitch)
                      y + 1
                    Wend
                  EndIf
                  *buffer - *Frame\width * *Frame\height << 2
                  StopDrawing()
                EndIf
               
                FreeMemory(*buffer)
              EndIf
              Break
            EndIf
          Default
            Break
        EndSelect
      ForEver
    EndIf
    If FrameNumber >= 0
      ProcedureReturn *Frame\image
    ElseIf FrameNumber = -2
      ProcedureReturn loop_cnt 
    Else
      ProcedureReturn current_frame
    EndIf
  EndProcedure
 
  Procedure.i GetRenderedFrames(Array Frames.GIF_Frame(1), *GIF_Data, BgColor.l = $DDDDDD, Mode = 0, *Animation.Animation = 0)
    Protected.i w, h, f, fr, f_end, state, pr_state, repair_delay, t, d0, d = -1
    Protected.d s, s0
    w = Width(*GIF_Data)
    h = Height(*GIF_Data)
    f_end = FrameCount(*GIF_Data) - 1
    If f_end >= 0
      ReDim Frames(f_end)
      If Mode = 1
        state = CreateSprite(#PB_Any, w, h, #PB_Sprite_AlphaBlending)
        StartDrawing(SpriteOutput(state))
        DrawingMode(#PB_2DDrawing_AllChannels)
        Box(0, 0, w, h, 0)
        StopDrawing()
        For f = 0 To f_end
          GetFrame(@Frames(f), *GIF_Data, f)
          With Frames(f)
            If \dispose = 3
              pr_state = CopySprite(state, #PB_Any)
            EndIf
            StartDrawing(SpriteOutput(state))
            DrawAlphaImage(ImageID(\image), \left, \top)
            StopDrawing()
            FreeImage(\image)
            \image = state
            If \dispose = 3
              state = pr_state
            Else             
              state = CopySprite(state, #PB_Any)
              If \dispose = 2
                StartDrawing(SpriteOutput(state))
                DrawingMode(#PB_2DDrawing_AllChannels)
                Box(\left, \top, \width, \height, 0)
                StopDrawing()
              EndIf
            EndIf
            If d = 0 And \delay = 0 : repair_delay = #True : EndIf
            \left = 0 : \top = 0 : \width = w : \height = h
            \delay * 10 : \dispose = 0 : d = \delay
          EndWith
        Next
        For fr = 0 To f_end
          If Frames(fr)\delay = 0 : Frames(fr)\delay = 100 : EndIf
        Next
        FreeSprite(state)     
      Else
        t = ElapsedMilliseconds()
        If *Animation
          s0 = *Animation\MaxWidth / w
          s = *Animation\MaxHeight / h
          If s0 < s : s = s0 : EndIf
        EndIf
        state = CreateImage(#PB_Any, w, h, 24)
        StartDrawing(ImageOutput(state))
        Box(0, 0, w, h, BgColor)
        StopDrawing()
        For f = 0 To f_end
          GetFrame(@Frames(f), *GIF_Data, f)
          With Frames(f)
            If \dispose = 3
              pr_state = CopyImage(state, #PB_Any)
            EndIf
            StartDrawing(ImageOutput(state))
            DrawAlphaImage(ImageID(\image), \left, \top)
            StopDrawing()
            FreeImage(\image)
            \image = state
            If \dispose = 3
              state = pr_state
            Else             
              state = CopyImage(state, #PB_Any)
              If \dispose = 2
                StartDrawing(ImageOutput(state))
                Box(\left, \top, \width, \height, BgColor)
                StopDrawing()
              EndIf
            EndIf
            \left = 0 : \top = 0 : \width = w : \height = h : \dispose = 0 : d0 = \delay
            If d0 = 0
              If d = 0
                If repair_delay
                  \delay = 100 
                Else
                  repair_delay = #True
                  For fr = 0 To f
                    If Frames(fr)\delay = 0 : Frames(fr)\delay = 100 : EndIf
                  Next
                EndIf
              EndIf
            Else
              \delay * 10
            EndIf
            d = d0
            If *Animation And IsGadget(*Animation\Target) And GadgetType(*Animation\Target) = #PB_GadgetType_Image
              If *Animation\Quit : ReDim Frames(f) : Break : EndIf
              If s > 0 And s < 1 : ResizeImage(\image, w * s, h * s) : EndIf
              SetGadgetState(*Animation\Target, ImageID(\image))
              t = ElapsedMilliseconds() - t
              If \delay < *Animation\MinDelay : \delay = *Animation\MinDelay : EndIf
              While *Animation\Quit = #False And \delay > t
                If \delay - t > 40
                  Delay(40)
                Else
                  Delay(\delay - t)
                EndIf
                t + 40
              Wend
              t = ElapsedMilliseconds()
            EndIf
          EndWith
        Next
        FreeImage(state)
      EndIf
      ProcedureReturn #True
    Else
      ProcedureReturn #False
    EndIf
  EndProcedure
 
  Procedure.l BackgroundColor(*GIF_Data)
    Protected c.l, i.i, *d.MultiType = *GIF_Data 
    If *d\l[0] & $FFFFFF = $464947 And *d\a[10] & $80; 'GIF'
      i = 13 + *d\a[11] * 3
      c = RGB(*d\a[i], *d\a[i + 1], *d\a[i + 2])
    EndIf
    ProcedureReturn c
  EndProcedure
 
  Procedure.i Width(*GIF_Data)
    Protected *d.MultiType = *GIF_Data 
    If *d\l[0] & $FFFFFF = $464947; 'GIF'
      ProcedureReturn *d\u[3]
    Else
      ProcedureReturn 0
    EndIf
  EndProcedure
 
  Procedure.i Height(*GIF_Data)
    Protected *d.MultiType = *GIF_Data 
    If *d\l[0] & $FFFFFF = $464947; 'GIF'
      ProcedureReturn *d\u[4]
    Else
      ProcedureReturn 0
    EndIf
  EndProcedure
 
  Procedure.i FrameCount(*GIF_Data)
    ProcedureReturn GetFrame(#Null, *GIF_Data, -1)
  EndProcedure
 
  Procedure.i LoopCount(*GIF_Data)
    ProcedureReturn GetFrame(#Null, *GIF_Data, -2)
  EndProcedure
 
  Procedure AnimateSetImage_(Target, Image)
    If IsGadget(Target)
      If Image : Image = ImageID(Image) : EndIf
      CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
        CocoaMessage(0, GadgetID(Target), "setImage:", Image)
      CompilerElse
        SetGadgetState(Target, Image)
      CompilerEndIf
    EndIf
  EndProcedure
   
  Procedure Animate_(*Animation.Animation)
    Protected.i d, fc, f = 0
    Dim Frames.GIF_Frame(0)
    GetRenderedFrames(Frames(), *Animation\GIF_Data, *Animation\BgColor, 0, *Animation)
    If *Animation\FreeData : FreeMemory(*Animation\GIF_Data) : EndIf
    fc = ArraySize(Frames()) + 1
    If fc = 1
      AnimateSetImage_(*Animation\Target, Frames(0)\image)
    EndIf
    While *Animation\Quit = #False
      If fc = 1
        Delay(40)
      Else
        While frames(f)\delay = 0
          f = (f + 1) % fc
        Wend
        AnimateSetImage_(*Animation\Target, Frames(f)\image)
        d = Frames(f)\delay
        While *Animation\Quit = #False And d > 0
          If d > 40
            Delay(40)
          Else
            Delay(d)
          EndIf
          d - 40
        Wend
        f = (f + 1) % fc
      EndIf 
    Wend
    AnimateSetImage_(*Animation\Target, 0)
    For f = 0 To fc - 1
      FreeImage(Frames(f)\image)
    Next
    FreeMemory(*Animation)
  EndProcedure

  Procedure.i Animate(Target, *GIF_Data = 0, FreeData = #False, BgColor.l = $DDDDDD, MaxWidth = 0, MaxHeight = 0, MinDelay = 0)
    CompilerIf #PB_Compiler_Thread = 0
      MessageRequester("","Compile with threadsafe enabled!") : End
    CompilerEndIf
    Shared AnimationForTarget()
    Protected TargetKey.s = Hex(Target)
    Protected *Animation.Animation, *CurrentAnimation.Animation = AnimationForTarget(TargetKey)
    If *CurrentAnimation And IsThread(*CurrentAnimation\ThreadID)
      *CurrentAnimation\Quit = #True
      WaitThread(*CurrentAnimation\ThreadID, 200)
    EndIf
    If *GIF_Data And Width(*GIF_Data)
      *Animation = AllocateMemory(SizeOf(Animation))
      *Animation\Target = Target
      *Animation\GIF_Data = *GIF_Data
      *Animation\FreeData = FreeData
      *Animation\BgColor = BgColor
      *Animation\MinDelay = MinDelay
      *Animation\MaxWidth = MaxWidth
      *Animation\MaxHeight = MaxHeight
      *Animation\ThreadID = CreateThread(@Animate_(), *Animation)
    EndIf
    AnimationForTarget(TargetKey) = *Animation
    ProcedureReturn *Animation
  EndProcedure
 
EndModule

_________________
macOS 10.15 Catalina, PB 5.71 x64


Last edited by wilbert on Mon Sep 07, 2015 12:59 pm, edited 16 times in total.

Top
 Profile  
Reply with quote  
 Post subject: Re: GifDecoder module
PostPosted: Sat Dec 07, 2013 6:14 pm 
Offline
PureBasic Expert
PureBasic Expert

Joined: Sun Aug 08, 2004 5:21 am
Posts: 3479
Location: Netherlands
Example :
Code:
Define Frame.GifDecoder::GIF_Frame

If ReadFile(0, "test.gif")
  Define *m = AllocateMemory(Lof(0), #PB_Memory_NoClear)
  ReadData(0, *m, Lof(0))
 
  Define w = GifDecoder::Width(*m)
  Define h = GifDecoder::Height(*m)
  Define fc = GifDecoder::FrameCount(*m)
 
  Define t1 = ElapsedMilliseconds()
  GifDecoder::GetFrame(@Frame, *m, fc - 1); get last frame
  Define t2 = ElapsedMilliseconds()
 
  If OpenWindow(0, 0, 0, 600, 400, Str(t2 - t1), #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
    ImageGadget(0, 0, 0, w, h, ImageID(Frame\image))
    Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
  EndIf 
 
EndIf

_________________
macOS 10.15 Catalina, PB 5.71 x64


Top
 Profile  
Reply with quote  
 Post subject: Re: GifDecoder module
PostPosted: Sat Dec 07, 2013 9:37 pm 
Offline
Addict
Addict

Joined: Fri Nov 09, 2012 11:04 pm
Posts: 1681
Location: Uttoxeter, UK
Impressive.

I like prefer the Module presentation rather than a plain pbi
Thank you for sharing. :D

_________________
DE AA EB


Top
 Profile  
Reply with quote  
 Post subject: Re: GifDecoder module
PostPosted: Sat Dec 07, 2013 9:59 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Mon Jul 08, 2013 8:43 pm
Posts: 238
Very nice! Thanks!

_________________
If translation=Error: reply="Sorry, Im Spanish": Endif


Top
 Profile  
Reply with quote  
 Post subject: Re: GifDecoder module
PostPosted: Mon Dec 09, 2013 10:33 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Sat Feb 19, 2011 10:06 am
Posts: 778
Location: Denmark
The last time I fiddled with assembler, the Amiga 500 was still new on the market.
VERY nice code and - ahemmm - almost understandable. ;-)
Code works flawlessly.

Thanks for sharing, Wilbert.

_________________
“Tell me and I forget. Teach me and I remember. Involve me and I learn.”
— Benjamin Franklin
Current configurations: Windows 7/10, Intel 6800K, Gtx 970, 32 gb ram.


Top
 Profile  
Reply with quote  
 Post subject: Re: GifDecoder module
PostPosted: Tue Dec 10, 2013 2:34 am 
Offline
Addict
Addict
User avatar

Joined: Tue Sep 23, 2008 11:38 pm
Posts: 856
Location: Belgium (& Luxembourg)
Fan-tas-tic Wilbert!
Now PureBasic has a real GIF decoder for Windows.
Is a version with moving GIF images possible?

GIF encoding is not really necessary, because we can encode images in JPEG or PNG... unless with moving images, of course.

Many thanks for sharing this very valuable piece of code.
Cheers

_________________
- Future conversation forecasting not yet implemented.
- If the future had copied a program from now, they would have called it version -1.


Top
 Profile  
Reply with quote  
 Post subject: Re: GifDecoder module
PostPosted: Tue Dec 10, 2013 10:35 am 
Offline
PureBasic Expert
PureBasic Expert

Joined: Sun Aug 08, 2004 5:21 am
Posts: 3479
Location: Netherlands
charvista wrote:
Is a version with moving GIF images possible?

I chose to implement some basic features that can help you with animated gifs also.

The problem is that everybody's needs might be different. Some might prefer to use an ImageGadget and alter the image it shows, others to use a CanvasGadget or WindowedScreen.
A simple gif that throws away each frame and shows the next one isn't that complicated but if a frame is set to not dispose and the next frame has to be on top of that it gets more complicated.
When looking at cpu load, a WindowedScreen is most efficient.
Here's a small example for this animated gif file
http://upload.wikimedia.org/wikipedia/c ... book_2.gif
It's coded to draw each new frame on top of the previous one. To make a version that works with all animated gifs, you would need a better implementation supporting all dispose methods.
Code:
InitSprite()

Define Event, d, f, w, h, frame_count, *m

If ReadFile(0, "Newtons_cradle_animation_book_2.gif")
  *m = AllocateMemory(Lof(0), #PB_Memory_NoClear)
  ReadData(0, *m, Lof(0))
 
  w = GifDecoder::Width(*m)
  h = GifDecoder::Height(*m)
 
  If OpenWindow(0, 0, 0, w, h, "Animated Gif", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
    OpenWindowedScreen(WindowID(0), 0, 0, w, h)
   
    frame_count = GifDecoder::FrameCount(*m)
    Dim frames.GifDecoder::GIF_Frame(frame_count - 1)
   
    For f = 0 To frame_count - 1
      GifDecoder::GetFrame(@frames(f), *m, f, 1)
    Next
   
    f = 0
    Repeat
      Event = WindowEvent()
     
      With frames(f)
       
        DisplayTransparentSprite(\image, \left, \top)
        FlipBuffers()
        DisplayTransparentSprite(\image, \left, \top)
       
        d = \delay * 10
        If d < 20
          d = 100
        EndIf
        Delay(d)
       
      EndWith
     
      f = (f + 1) % frame_count
     
    Until Event = #PB_Event_CloseWindow
  EndIf 
 
EndIf

_________________
macOS 10.15 Catalina, PB 5.71 x64


Top
 Profile  
Reply with quote  
 Post subject: Re: GifDecoder module
PostPosted: Tue Dec 10, 2013 3:59 pm 
Offline
Addict
Addict
User avatar

Joined: Tue Sep 23, 2008 11:38 pm
Posts: 856
Location: Belgium (& Luxembourg)
Hi Wilbert

Thank you for your updated code!
I think the WindowedScreen will perfectly fulfil my needs.
I have added an example of how to save a frame in BMP-file, after the Until Event = #PB_Event_CloseWindow of your last code:

Code:
            ;example to save image as BMP
            Dim frames.GifDecoder::GIF_Frame(frame_count-1)
            For f=0 To frame_count-1
                GifDecoder::GetFrame(@frames(f), *m, frame_count-1,0); get Image instead of Sprite
            Next
            Result=SaveImage(frames(0)\image,"Newtons_cradle_animation_book_99.bmp",#PB_ImagePlugin_BMP); save frame #0

This means that I understood the principle.

Cheers!

_________________
- Future conversation forecasting not yet implemented.
- If the future had copied a program from now, they would have called it version -1.


Top
 Profile  
Reply with quote  
 Post subject: Re: GifDecoder module
PostPosted: Wed Dec 11, 2013 3:50 am 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Mon Apr 25, 2005 9:28 pm
Posts: 701
Location: $300:20 58 FC 60 - Vietnam
:shock: Wow, really good
Thanks Wilbert

_________________
“Fear is a reaction. Courage is a decision.” - WC


Top
 Profile  
Reply with quote  
 Post subject: Re: GifDecoder module (Cross platform)
PostPosted: Thu Dec 12, 2013 1:33 pm 
Offline
PureBasic Expert
PureBasic Expert

Joined: Sun Aug 08, 2004 5:21 am
Posts: 3479
Location: Netherlands
I added a procedure to get all rendered frames as images.
This way you don't have to worry about the dispose methods yourself.

Code:
IncludeFile "GifDecoder.pbi"

InitSprite()

Define Event, f, w, h, frame_count, *m

If ReadFile(0, "Newtons_cradle_animation_book_2.gif")
  *m = AllocateMemory(Lof(0), #PB_Memory_NoClear)
  ReadData(0, *m, Lof(0))
 
  w = GifDecoder::Width(*m)
  h = GifDecoder::Height(*m)
   
  If OpenWindow(0, 0, 0, w, h, "Animated Gif", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
    OpenWindowedScreen(WindowID(0), 0, 0, w, h)
   
    Dim Frames.GifDecoder::GIF_Frame(0)
    GifDecoder::GetRenderedFrames(Frames(), *m, 0, 1)
    frame_count = ArraySize(Frames()) + 1

    f = 0
    Repeat
      Event = WindowEvent()
     
      ; don't show zero delay frames
      While frames(f)\delay = 0
        f = (f + 1) % frame_count
      Wend
     
      ; display frame
      With frames(f)
        ClearScreen(RGB(240, 240, 240))
        DisplayTransparentSprite(\image, 0, 0)
        FlipBuffers()
        Delay(\delay)
      EndWith
      f = (f + 1) % frame_count
     
    Until Event = #PB_Event_CloseWindow
  EndIf 
 
EndIf

_________________
macOS 10.15 Catalina, PB 5.71 x64


Top
 Profile  
Reply with quote  
 Post subject: Re: GifDecoder module (Cross platform)
PostPosted: Thu Dec 12, 2013 8:22 pm 
Offline
Addict
Addict
User avatar

Joined: Fri Sep 21, 2007 5:52 am
Posts: 3402
Location: New Zealand
works on linux thanks


Top
 Profile  
Reply with quote  
 Post subject: Re: GifDecoder module (Cross platform)
PostPosted: Thu Dec 12, 2013 8:47 pm 
Offline
PureBasic Expert
PureBasic Expert

Joined: Sun Aug 08, 2004 5:21 am
Posts: 3479
Location: Netherlands
idle wrote:
works on linux thanks

Thanks for letting me know :)
I was hoping it would work on Linux but hadn't had a confirmation yet.

_________________
macOS 10.15 Catalina, PB 5.71 x64


Top
 Profile  
Reply with quote  
 Post subject: Re: GifDecoder module (Cross platform)
PostPosted: Fri Dec 13, 2013 12:00 am 
Offline
Addict
Addict
User avatar

Joined: Tue Sep 23, 2008 11:38 pm
Posts: 856
Location: Belgium (& Luxembourg)
Works also on Windows 8, 64-bits, but you already know that.
Now a Mac-man's confirmation, and you know everything ;)

_________________
- Future conversation forecasting not yet implemented.
- If the future had copied a program from now, they would have called it version -1.


Top
 Profile  
Reply with quote  
 Post subject: Re: GifDecoder module (Cross platform)
PostPosted: Fri Dec 13, 2013 6:09 am 
Offline
PureBasic Expert
PureBasic Expert

Joined: Sun Aug 08, 2004 5:21 am
Posts: 3479
Location: Netherlands
charvista wrote:
Works also on Windows 8, 64-bits, but you already know that.
Now a Mac-man's confirmation, and you know everything ;)

I am working on OS X (Mac) :lol:

_________________
macOS 10.15 Catalina, PB 5.71 x64


Top
 Profile  
Reply with quote  
 Post subject: Re: GifDecoder module (All OS, single frame & animated gifs)
PostPosted: Fri Dec 13, 2013 2:18 pm 
Offline
Addict
Addict
User avatar

Joined: Tue Sep 23, 2008 11:38 pm
Posts: 856
Location: Belgium (& Luxembourg)
Very funny indeed :lol:
I did not read your signature :oops:
Keep up the good work, Wilbert ! :wink:

_________________
- Future conversation forecasting not yet implemented.
- If the future had copied a program from now, they would have called it version -1.


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 34 posts ]  Go to page 1, 2, 3  Next

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 5 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye