appears fine when showing the first frame, but when the next frames are showed the image appears incomplete, as we can see on the screenshot:
is identical. All the other gif-files are working well.
Code: Select all
;(c) Wilbert 2013-12-14
; GifDecoder v1.0.6
DeclareModule GifDecoder; v1.0.6
Structure GIF_Frame
image.i
left.u
top.u
width.u
height.u
delay.u ; frame delay (1/100 sec)
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 = 0, Mode = 0); Get all prerendered frames with delay set in msec.
EndDeclareModule
Module GifDecoder
Structure CodeTableEntry
*prev
color.l
size.l
EndStructure
Structure MultiType
l.l[0]
u.u[0]
a.a[0]
EndStructure
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 = 0, Mode = 0)
Protected.i w, h, f, f_end, d, state, pr_state
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 = 2
state = CreateSprite(#PB_Any, w, h, #PB_Sprite_AlphaBlending)
StartDrawing(SpriteOutput(state))
DrawingMode(#PB_2DDrawing_AllChannels)
Box(0, 0, w, h, 0)
StopDrawing()
ElseIf \dispose = 3
state = pr_state
Else
state = CopySprite(state, #PB_Any)
EndIf
\left = 0 : \top = 0 : \width = w : \height = h
\delay * 10 : d + \delay : \dispose = 0
EndWith
Next
FreeSprite(state)
Else
If BgColor = 0
BgColor = BackgroundColor(*GIF_Data)
EndIf
state = CreateImage(#PB_Any, w, h, 24, BgColor)
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 = 2
state = CreateImage(#PB_Any, w, h, 24, BgColor)
ElseIf \dispose = 3
state = pr_state
Else
state = CopyImage(state, #PB_Any)
EndIf
\left = 0 : \top = 0 : \width = w : \height = h
\delay * 10 : d + \delay : \dispose = 0
EndWith
Next
FreeImage(state)
EndIf
If d = 0
For f = 0 To f_end : Frames(f)\delay = 100 : Next
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
EndModule
EnableExplicit
;IncludeFile "GifDecoder.pbi"
InitSprite()
Define Event, Item, FileName.s
Define f, frame_count, *m
Dim Frames.GifDecoder::GIF_Frame(0)
If OpenWindow(0, 0, 0, 720, 420, "[Animated] GIF explorer", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
;SetWindowColor(0,$000000); *******
ExplorerListGadget(0, 10, 10, 280, 400, GetHomeDirectory())
;SetGadgetColor(0,#PB_Gadget_BackColor,$000000); *******
;SetGadgetColor(0,#PB_Gadget_FrontColor,$FFFFFF); *******
OpenWindowedScreen(WindowID(0), 310, 10, 400, 400)
ClearScreen($D8D8D8); $000000); $D8D8D8); *******
FlipBuffers()
f = 0
Repeat
Event = WindowEvent()
If EventType() = #PB_EventType_Change
Item = GetGadgetState(0)
If Item >= 0
FileName.s = GetGadgetText(0) + GetGadgetItemText(0, Item)
If FileSize(FileName) > 32 And ReadFile(0, FileName)
*m = AllocateMemory(Lof(0), #PB_Memory_NoClear)
ReadData(0, *m, Lof(0))
CloseFile(0)
If GifDecoder::FrameCount(*m)
; remove existing sprites
For f = 0 To ArraySize(Frames())
If Frames(f)\image
FreeSprite(Frames(f)\image)
EndIf
Next
; get new sprites
GifDecoder::GetRenderedFrames(Frames(), *m, 0, 1)
frame_count = ArraySize(Frames()) + 1
If Frames(0)\width > 400 Or Frames(0)\height > 400
For f = 0 To frame_count - 1
With Frames(f)
If \width > \height
ZoomSprite(\image, 400, 400 * \height / \width)
Else
ZoomSprite(\image, 400 * \width / \height, 400)
EndIf
EndWith
Next
EndIf
; single frame ?, display now
If frame_count = 1
ClearScreen($D8D8D8)
DisplayTransparentSprite(frames(0)\image, 0, 0)
FlipBuffers()
Else
f = 0
EndIf
EndIf
FreeMemory(*m)
EndIf
EndIf
EndIf
If frame_count > 1
While frames(f)\delay = 0
f = (f + 1) % frame_count
Wend
With frames(f)
ClearScreen($D8D8D8)
DisplayTransparentSprite(\image, 0, 0)
FlipBuffers()
Delay(\delay)
EndWith
f = (f + 1) % frame_count
EndIf
Until Event = #PB_Event_CloseWindow
EndIf