Code: Select all
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