SyntaxBomb - Indie Coders

I'm working since two weeks in a converting of MarcCw' code from 2008. This was a single pass gif-to-png converter in 1000 code lines, but written for old BlitzPlus. In 2019 Hardcoal tried to convert it to BlitzMax, but kept the styles of using some dozend of GLOBAL variables instead of translating the code into a modern object oriented style.

I converted the project into a SUPERSTRICT encapsuled class without any global variable. The spaghetti code was divided in senseful functions and methods. The performace is 30% faster. This makes is useable for your own project.

Now, as I'm nearly ready, I hear that Brucey plans to include GIF-support to the next BlitzMax NG update. So, I know, there is no reason anymore for my work. But I decided to publish it anyway....

Here is a first rough version. It is done 95% and can handle at the moment 256color GIF's only. (see "Known Issues" below)


Reference:

Add the Class to your project
SuperStrict
Include "GifClass.bmx"
Global Gif:TGif = TGif.Load(UrL) 

Function Load(UrL)
myGif:TGif = TGif.Load(UrL:String) loads an GIF-file into a TGif object


Method Width()
W:Int = myGif.Width() informs about the width of the gif


Method Height()
H:Int = myGif.Height() informs about the height of the gif


Method HasTransparency()
H:Int = myGif.HasTransparency() informs about existing transparent parts in the gif


Method Frames()
steps:Int = myGif.Frames() informs about the number of frames a animated gif contains


Method Frame:TPixMap(step:Int)
myPixmap:TPixMap = myGif.Frame(n:Int) extracts one single frame of the animated gif to a TPixMap


Method AnimImage:TImage()
myImage:TImage = myGif.AnimImage() return the whole Gif as animated TImage


Method DelayStep(Frame:Int Var, Speed:Double)
myGif.DelayStep curFrame, 2.5 cares about stepping trough the frames related to the GIF's frame timing information. An additional speedfactor accelerates this timing. Here 2.5 times faster.


Method GetPixMapStrip:TPixMap()
SavePix:TPixMap = myGif.GetPixMapStrip() return the whole Gif as long TPixMap-strip for saving purposes.


Example code:

SuperStrict
Include "GifClass.bmx"
Graphics 800,600

Local File:String = "moorhuhn01.Gif"

Local now:Int=MilliSecs()
Global Gif:Tgif = TGif.Load(File)

Print "Frames =" + Gif.Frames
Print "Size   =" + Gif.Width + "x" + gif.Height + "pixels"
Print "Has transparence   =" + Gif.HasTransparency

Global Bild:TImage = Gif.AnimImage()

Global strip:TPixmap = Gif.GetPixMapStrip()
Print "time needed:" + (MilliSecs()-now) + " msecs"
'SavePixmapPNG strip, "chicken2.png", 5

Local steps:Int
Repeat
Cls
DrawPixmap strip,0,0
DrawImage bild,300,300,steps
Flip
Steps = (Steps+1) Mod gif.Frames
Until AppTerminate()

You find a reference GIF here:
http://www.ollis-page-online.de/specials/moorhuhn_x/moorhuhn01.gif



The GifClass:
VERSION 1.00 2022-01-07

' BlitzMax NG: GIF_CLASS.bmk  Version 1.00
' Description: Loads animated gifs
'
' converted from code by: markcw Date 2008
' LZW decoding based on C code by John Findlay for ImageShop32

'------------------
'TRANSFER TO BLITZMAX NG by MIDIMASTER  2022-01-07
'------------------

Type TGif

Field OffX:Int, OffY:Int, _Width:Int, _Height:Int, _Frames:Int
Field IsTransparent:Int, DelayTime:Int[999]
Field Previous:TPixmap, PixMaps:TPixmap[], List:TList=New TList 
'***********************************************************************************
'
'   PUBLIC

Function Load:TGif(URL:String)
'Loads a GIF-File from disc
If FileSize(Url)=0 RuntimeError "File not exist: " + URL
Local locGif:TGif=New TGif
locGif.LoaderB URL
Return locGif
End Function


Method AnimImage:TImage()
' converts a TGif into a TImage
Local Img:TImage=CreateImage(_Width,_Height, _Frames)
For Local i:Int =0 Until _frames
img.PixMaps[i]=PixMaps[i]
Next
Return Img
End Method


Method Frame:TPixmap(Nr:Int)
' returns a single frame from a TGif
If (Nr>=_Frames) Or (nr<0) RuntimeError " wrong frame number: " + nr
Return PixMaps[Nr]
End Method


Method GetPixMapStrip:TPixmap()
' returns a PNG containing all frames in one picture
Local cols:Int = _frames
If cols*_Width>15000
cols=Sqr(_frames)+1
If cols*_Width>15000 Then RuntimeError "gif to big for PNG"
EndIf
Return CalculatePixMapStrip(Cols)
End Method


Method DelayStep:Int(Frame:Int Var, Speed:Double=1)
' returns the next frame number when time is over
Global time:Long=MilliSecs()-1
If MilliSecs()>time
Frame = (Frame +1) Mod _frames
time = time + DelayTime[Frame]/speed
EndIf
Return Frame
End Method


Method Height:Int()
Return _Height
End Method

Method Width:Int()
Return _Width
End Method

Method Frames:Int()
Return _Frames
End Method

Method HasTransparency:Int()
Return IsTransparent
End Method
'
'   END OF PUBLIC
'***********************************************************************************

Method LoaderB(URL:String)
Repeat
'Print "--------------------------------"
'Print "Now frame " + frames

Local FrameGif:TGifFrame = New TGifFrame
FrameGif.Previous=Previous
FrameGif.LoadSingleFrame URL
If FrameGif.pixmap
IsTransparent = FrameGif.IsTransparent
Previous=FrameGif.pixmap
EndIf
Local PixMap:TPixmap = FrameGif.Pixmap
If PixMap=Null Then Exit
_Width=PixMap.Width
_Height=PixMap.Height
DelayTime[_Frames] = FrameGif.DelayTime*10
_Frames = _Frames+1
List.AddLast PixMap
Forever
ListToArray
End Method


Method ListToArray()
Pixmaps= New  TPixmap[_Frames]
Local i:Int
For Local pix:TPixmap=EachIn List
Pixmaps[i]=pix
i=i+1
Next
List=Null
End Method



Method CalculatePixMapStrip:TPixmap(Cols:Int)
Local Zeit:Int=MilliSecs()
' returns a PNG containing all frames in one picture
Local rows:Int=1
If cols<>_Frames
rows=_frames/Cols
EndIf
Local Total:TPixmap = CreatePixmap(cols*_width , rows*_Height , PF_RGBA8888,4)
For Local i:Int=0 Until  _frames
Total.paste PixMaps[i], _Width*offx,  _Height*offY
Next
Print " PNG Zeit " + (MilliSecs()-zeit)
Return Total
End Method



End Type

Type TGifFrame
Global CodeMask:Int[] =[0,$1,$3,$7,$F,$1F,$3F,$7F,$FF,$1FF,$3FF,$7FF,$FFF,$1FFF,$3FFF,$7FFF,$FFFF]
Const PUSH:Int=1, FETCH:Int=2, CHECK:Int=0, FULL:Int=True

Field OffX:Int, OffY:Int, Width:Int, Height:Int, Pitch:Int  , NumColors:Int, GlobalBitDepth:Int
Field ARGBColors:Int[256], WithColorTable:Int, IsInterlaced:Int, IsTransparent:Int, DisposalTyp:Int
Field PixMap:TPixmap,  Previous:TPixmap 
Field BitsLeft:Int, BytesLeft:Int,  Row:Int, TransIndex:Int
Field DelayTime:Int

Private

Function Load:TGif(URL:String)
'Loads a GIF-File from disc
If FileSize(Url)=0 RuntimeError "File not exist: " + URL
Local locGif:TGif=New TGif
locGif.LoaderB URL
Return locGif
End Function


Method HeaderCheck(Stream:TStream)
If Stream=Null
RuntimeError "File could not be opened"
EndIf
Local Sig:String
For Local i:Int=0 To 2
Sig = Sig + Chr(ReadByte(Stream))
Next
If Sig$<>"GIF"
RuntimeError "File is no GIF"
EndIf
Stream.SkipBytes 3 'Skip Version
Width=ReadShort(Stream)
Height=ReadShort(Stream)
End Method


Method ReadAllcolors:Int[](Stream:TStream, Num:Int)
Local Colors:Int[num]
For Local i:Int=0 Until num
Local R:Int = ReadByte(Stream)
Local G:Int = ReadByte(Stream)
Local B:Int = ReadByte(Stream)
Colors[i] = $FF000000 | (R Shl 16) | (G Shl 8) | B
Next
Return Colors
End Method


Method ScanExtensionBlock(Stream:TStream)
Local blocklabel:Int = ReadByte(Stream)
    Local blocksize:Int   = ReadByte(Stream) 'Should be 4
Select BlockLabel
'Case $FE 'Comment Extension block
'Case $FF 'Application Extension block
Case $F9 'Graphic Control Extension block
    Local Flag:Int        = ReadByte(Stream) 'Packed Fields
    DisposalTyp:Int    = (Flag & (4+8+16)) Shr 2

If DisposalTyp=3 Then
RuntimeError "with disposal" + DisposalTyp
EndIf
    IsTransparent:Int = Flag & 1
DelayTime   = ReadShort(Stream)
'Print "Delay time" + Delaytime
    TransIndex:Int  = ReadByte(Stream)
    Local Terminator:Int  = ReadByte(Stream) 'Block Terminator, always 0
Default
' skip all other types
While blocksize>0
Stream.SkipBytes blocksize
blocksize = ReadByte(Stream)
Wend
End Select
End Method


Method ScanImageDescripterBlock(Stream:TStream)
OffX   = ReadShort(Stream)
OffY   = ReadShort(Stream)
Width  = ReadShort(Stream)
Height = ReadShort(Stream)
Local Flag:Int = ReadByte(Stream)
IsInterlaced           = (Flag & 64) Shr 6       'Interlace Flag, bit 6
Local locNum:Int       = 1 Shl ((Flag & 7)+1)    'Number of local colors
If (Flag & 128) Shr 7                            'Local Color Table
ARGBColors = ReadAllColors (Stream, locNum)
EndIf
'Frames =Frames+1
End Method



Method LoadSingleFrame(URL:String)
Global NextFilepos:Int 'kommt nur hier vor  braucht reset auf 0 wenn alle teil-gif saved
Local Stream:TStream = LittleEndianStream(ReadFile(Url))
HeaderCheck Stream

Local bPacked:Int        = ReadByte(Stream)       ' Packed Fields
Local BackIndex:Int  = ReadByte(Stream)       ' Background Color Index, ignored
Local aspectRatio:Int    = ReadByte(Stream)       ' Aspect Ratio

WithColorTable = (bPacked & 128) Shr 7
Local blocksize:Int      = 3*(1 Shl ((bPacked & 7)+1))

NumColors = blocksize/3 'Number of global colors
GlobalBitDepth = BitDepth(NumColors)

If WithColorTable=True
ARGBColors = ReadAllColors (Stream, NumColors)
Else
ARGBColors = SetGrayScaleColors(NumColors)
EndIf
If NextFilePos>0 Then SeekStream(Stream, NextFilePos)

While Eof(Stream)=False
Local dbyte:Int = ReadByte(Stream)
If dbyte = $21 'Extension block (89a)
ScanExtensionBlock Stream

ElseIf dbyte=$2C 'Image Descriptor block (87a)
ScanImageDescripterBlock Stream

ElseIf dbyte>1 And dbyte<13 'Image Data block (87a)
NextFilePos = FindOvernextImageBlockAdress(Stream)
ProcessImageDataBlock Stream, dbyte
Exit
EndIf
Wend
CloseFile Stream 'Close the file
' three disposal images:
' 0 Backup
' 1 Last (contains pixmap from round before)
' 2
'
If DisposalTyp=3 Then
' in this case copy image to Backup (0)
EndIf
End Method


Method ProcessImageDataBlock( Stream:TStream, LZWCodeSize:Int)
PixMap = CreatePixmap(Width, Height, PF_RGBA8888,4)
pixmap.ClearPixels 0
If Previous And DisposalTyp=1
pixmap = CopyPixmap(Previous)
EndIf
DecodeGif(Stream, LZWCodeSize)
End Method


Method DecodeGIF(Stream:TStream, LZWCodeSize:Int)
Local pStack:Int=0, pBuffer:Int
Local BufCount:Int = Width
Local TopSlot:Int, Slot:Int, cc:Int
Local CLEAR_CODE:Int, ENDING_CODE:Int, NEW_CODE:Int
Local Buffer:TBank = CreateBank(Width + 16)
TopSlot             = 1 Shl (LZWCodeSize+1)
CLEAR_CODE          = 1 Shl LZWCodeSize
ENDING_CODE         = CLEAR_CODE+1
NEW_CODE            = CLEAR_CODE+2
Slot                = CLEAR_CODE+2
Local CodeSize:Int  = LZWCodeSize+1
Local Suffix:Int[4096+1] 'Suffix table, max number of LZW codes, bytes
Local Prefix:Int[4096+1] 'Prefix linked list, integers
Local TempOldCode:Int, OldCode:Int, Code:Int

While cc <> ENDING_CODE
cc=GIFNextCode(Stream, CodeSize)
If cc<0 Then Exit

If cc = CLEAR_CODE
CodeSize = LZWCodeSize + 1
Slot = NEW_CODE
TopSlot = 1 Shl CodeSize

While cc = CLEAR_CODE
cc=GIFNextCode(Stream, CodeSize)
Wend
If cc = ENDING_CODE Then Exit 'end loop
If cc >= Slot Then cc = 0

OldCode     = cc
TempOldCode = cc
If PokeBuffer(Buffer, Width, cc, pBuffer, BufCount)=FULL
GIFOutLine(Buffer)
EndIf
Else
Code=cc
If Code=Slot
Code=TempOldCode
Stack PUSH, OldCode
EndIf

While Code>=NEW_CODE
Stack PUSH, Suffix[Code]
Code = Prefix[Code]
Wend
Stack PUSH, Code
If Slot<TopSlot
OldCode=Code
Suffix[Slot]=OldCode
Prefix[Slot] = TempOldCode
Slot=Slot+1
TempOldCode=cc
EndIf

If Slot>=TopSlot
If CodeSize<12
TopSlot=TopSlot Shl 1
CodeSize = CodeSize+1
EndIf
EndIf
While Stack() > 0   ' while pStack > 0
If PokeBuffer(Buffer, Width, Stack(FETCH), pBuffer, BufCount)=FULL
GIFOutLine(Buffer)
EndIf
Wend
EndIf
Wend
If BufCount<>Width
GIFOutLine(Buffer)
EndIf
End Method


Method GIFOutLine(Buffer:TBank)
If Row>=Height Then Return
Local pBits:Int   = 40+(NumColors*4)+(Pitch*(Height-1))
Local Pointer:Int = pBits-(Row*Pitch)

Select GlobalBitDepth
Case 1 '1-bit bmp
CopyBuffers_1 Buffer, Pointer
Case 4 '4-bit bmp
CopyBuffers_4 Buffer, Pointer
Case 8 '8-bit bmp
CopyBuffers_8 Buffer, Pointer, Row
End Select
Row = StepInterlace(IsInterlaced , Row)
End Method


Method GIFNextCodeII:Int(Stream:TStream, BytesLeft:Int Var)
Global CharBuff:Int[279], Pointer:Int
If BytesLeft<= 0
BytesLeft=ReadByte(Stream)
If BytesLeft=0 Then Return -2
If Eof(Stream)<>0 Then RuntimeError "Stream error Or End of file"
Local z:Int = BytesLeft
For Local i:Int=0 Until z
CharBuff[i] = ReadByte(Stream)
Next
Pointer=0
EndIf
Local value:Int= CharBuff[Pointer]
Pointer   = Pointer+1
BytesLeft = BytesLeft-1
Return value
End Method


Method GIFNextCode:Int(Stream:TStream, CodeSize:Int)
Global CurrByte:Int
'Reads the next code from the data stream, Returns the LZW code or error
If BitsLeft=0
CurrByte  = GIFNextCodeII(Stream, BytesLeft )
BitsLeft  = 8
EndIf
Local ret:Int = CurrByte Shr (8-BitsLeft)

While CodeSize>BitsLeft
CurrByte  = GIFNextCodeII(Stream, BytesLeft)
ret           = ret | (CurrByte Shl BitsLeft) 'Add remaining bits to ret
BitsLeft   = BitsLeft+8
Wend
'Subtract the code size from BitsLeft
BitsLeft=BitsLeft-CodeSize
'Mask off the right number of bits
ret=ret & CodeMask[CodeSize]
Return ret
End Method


Method CopyBuffers_1(Buffer:TBank, Adress:Int)
Print "1bit gif"
End
Local Count:Int
For Local pixel:Int=0 Until Width Step 8
Local value:Int
For Local bitcount:Int= 0 To 7
If PeekByte(Buffer,bitcount+pixel)
value = value | (1 Shl (7-bitcount))
EndIf
Next
'PokeByte bmp, Adress+count , Value
Count = Count+1
   Next
End Method


Method CopyBuffers_4(Buffer:TBank, Adress:Int)
Print "4bit gif"
End
Local Count:Int
For Local pixel:Int=0 Until Width Step 2
Local value:Int=PeekByte(Buffer,pixel) Shl 4
value = value | PeekByte(Buffer,pixel+1)
'PokeByte bmp, Adress+count , Value
Count = Count+1
   Next
End Method


Method CopyBuffers_8(Buffer:TBank, Adress:Int, Row:Int)
For Local pixel:Int=0 Until Width
Local value:Int=PeekByte(Buffer,pixel)
If value=TransIndex
Else
pixmap.WritePixel pixel+offX, row+offY, ARGBColors[value]
EndIf
   Next
End Method


Method StepInterlace:Int(IsInterlaced:Int , Line:Int )
Global Add:Int, Pass:Int
If IsInterlaced = False Then Return Line+1

If Line=0 Then Add=8
Line = Line + Add
If Line< Height Return Line

Select Pass
Case 0
Pass=1
Line=4
Add=8
Case 1
Pass=2
Line=2
Add=4
Case 2
Pass=0
Line=1
Add=2
End Select
Return Line
End Method


Method Stack:Int (Mode:Int=CHECK, Value:Int=0)
' 3 methods FETCH: fetch from stack
'           PUSH : push to stack
'           CHECK  : ask for stack depth
Global _Stack:Int[4096], Pointer:Int
Select Mode
Case FETCH
Pointer=Pointer-1
Return _Stack[Pointer]
Case PUSH
_Stack[Pointer]=Value
Pointer=Pointer+1
End Select
Return Pointer
End Method


Function BitDepth:Int(num:Int)
'Use number of colors to set bit depth
If Num<=2
Return  1
ElseIf Num<=16
Return  4
EndIf
Return 8
End Function


Function SetGrayScaleColors:Int[](Num:Int)
Local Colors:Int[num]
For Local i:Int=0 Until num
Local GRAY:Int = (255*i)/(Num-1)
Colors[i] = $FF000000 | (GRAY Shl 16) | (GRAY Shl 8) | GRAY
Next
Return Colors
End Function


Function FindOvernextImageBlockAdress:Int(Stream:TStream)
Local FromPos:Int = StreamPos(Stream)
Local blocksize:Int = ReadByte(Stream)
While blocksize > 0 'Skip sub-blocks
Stream.SkipBytes blocksize
blocksize=ReadByte(Stream)
Wend
Local NextPos:Int = StreamPos(Stream) ' hier geht es später weiter: NextFilePos
SeekStream(Stream, FromPos) 'Return to this block
Return NextPos
End Function


Function PokeBuffer:Int(Buffer:TBank, Width:Int, Value:Int, Pointer:Int Var, Counter:Int Var)
PokeByte Buffer, Pointer , value
Pointer:+1
Counter:-1
If Counter=0
Pointer = 0
Counter = Width
Return FULL
EndIf
Return 0
End Function
End Type


 



Known Issues

As I examined the sense of the 1000 code lines with only one type of GIF (animated, 256color, non interlaced), I could not test every feature, because a lot of the code lines never get touched by those "normal" GIFs. I still do not know all aspects of GIFs.

• 
  I had no change to test the behavior of 2color, 4 color and 16color GIFs.
  
• 
  "Interlaced" should work and also non-animated GIFs.
  
• 
  And I do not understand what is meant with this "Disposal"-feature.
  
• 
  Also I' not sure, what happens if thee GIF has more than one color-table.
  
  

So it would be very helpful, if you test the class with any GIFs you find and send me the GIF when you detected a problem.

I uploaded an update of the GifClass. See the first post to download it.

Now it works also with GIFs that use Disposal=1 and contain sub-frames, which are smaller than the first "master-Frame"

Here is a related main app to test it:
SuperStrict
Include "GifClass.bmx"
Graphics 800,600

Local File:String = "giphy.Gif"

Local now:Int=MilliSecs()
Global Gif:Tgif = TGif.Load(File)

Print "Frames =" + Gif.Frames
Print "Size   =" + Gif.Width + "x" + gif.Height + "pixels"

Global Bild:TImage = Gif.AnimImage()
Print "time needed:" + (MilliSecs()-now) + " msecs"

Local steps:Int
SetClsColor 0,55,0
Repeat
Cls
DrawImage bild,0,30,steps
DrawText"FRAME" +steps, 0,0
If steps>55
Delay 100
Else
Delay 100
EndIf
Flip
Steps = (Steps+1) Mod gif.Frames
Until AppTerminate()


Thanks to Baggey for sending me this GIF that detected the bug:


https://giphy.com/gifs/grayscale-aMKyWnoehsnfi

Please send me your gif if it causes a problem in the Gif-Class!

Update: GIF-Timing

I added a timing feature to Version 0.99. Animated GIFs have a individual display time for each frame. Now you can use this feature in BlitzMax.

Use this command and the GIF take control over the TImage-Frames. No need for care about frame-rate and number of frames:
Local steps:Int
Repeat
Cls
DrawImage myImage , 0, 100, steps
DrawText"FRAME" +steps , 0 , 0
Gif.DelayStep steps                      ' <----- HERE
Flip 0
Until AppTerminate()

additional you can add a floating point speed-factor:
Gif.DelayStep steps , 0.5             '  <----- half speed



Update: PNG-Saving
Now you can convert also big sized GIFs to PNGs. Limitations are only the TPixMap size: Maximum is 16.000x16.000pix. The number of frames does not matter.

Global Gif:Tgif = TGif.Load(File)

Global strip:TPixmap = Gif.GetPixMapStrip()

SavePixmapPNG strip, "giphy2.png", 5

were is the latest version 

Kindest Regards Baggey

Always on top. Look at the first post!

Quote from: Midimaster on January 09, 2022, 16:00:11
Always on top. Look at the first post!

danke mein Freund

Baggey