1
1
Fork 0
mirror of https://github.com/FellippeHeitor/InForm.git synced 2024-05-12 06:50:12 +00:00

Implement LZW decoder

This commit is contained in:
Samuel Gomes 2023-11-23 09:17:14 +05:30
parent 47f51909a8
commit 338232bab2
10 changed files with 403 additions and 87 deletions

View file

@ -10,7 +10,7 @@ $END IF
$LET INFORM_BI = TRUE
DECLARE LIBRARY
FUNCTION __UI_GetPID ALIAS getpid ()
FUNCTION __UI_GetPID ALIAS getpid
END DECLARE
DECLARE CUSTOMTYPE LIBRARY

View file

@ -91,8 +91,8 @@ $END IF
ContextMenuIcon = LoadEditorImage("contextmenu.bmp")
__UI_ClearColor ContextMenuIcon, 0, 0
'$INCLUDE:'InForm.bi'
'$INCLUDE:'extensions/GIFPlay.bi'
'$INCLUDE:'InForm.bi'
'$INCLUDE:'xp.uitheme'
'$INCLUDE:'UiEditorPreview.frm'
@ -165,7 +165,7 @@ SUB __UI_BeforeUpdateDisplay
END IF
FOR i = 1 TO UBOUND(AutoPlayGif)
IF AutoPlayGif(i) THEN GIF_Draw i
IF AutoPlayGif(i) THEN GIF_Draw i, True
NEXT
STATIC prevDefaultButton AS LONG, prevMenuPanelActive AS INTEGER
@ -2218,7 +2218,7 @@ SUB DeleteSelectedControls
IF __UI_TotalActiveMenus > 0 AND __UI_ParentMenu(__UI_TotalActiveMenus) = Control(i).ID THEN
__UI_CloseAllMenus
END IF
GIF_Close i
GIF_Free i
__UI_DestroyControl Control(i)
IF MustRefreshMenuBar THEN __UI_RefreshMenuBar
IF MustRefreshContextMenus THEN RefreshContextMenus
@ -2388,7 +2388,7 @@ SUB LoadPreview (Destination AS _BYTE)
IF Disk THEN
FOR i = UBOUND(Control) TO 1 STEP -1
IF LEFT$(Control(i).Name, 5) <> "__UI_" THEN
GIF_Close i
GIF_Free i
__UI_DestroyControl Control(i)
END IF
NEXT
@ -2407,7 +2407,7 @@ SUB LoadPreview (Destination AS _BYTE)
ELSEIF UndoBuffer THEN
FOR i = UBOUND(Control) TO 1 STEP -1
IF LEFT$(Control(i).Name, 5) <> "__UI_" THEN
GIF_Close i
GIF_Free i
__UI_DestroyControl Control(i)
END IF
NEXT
@ -2764,7 +2764,7 @@ SUB LoadPreview (Destination AS _BYTE)
IF NOT CorruptedData THEN
__UI_FirstSelectedID = FirstToBeSelected
ELSE
GIF_Close TempValue
GIF_Free TempValue
__UI_DestroyControl Control(TempValue)
__UI_TotalSelectedControls = __UI_TotalSelectedControls - 1
END IF
@ -2810,7 +2810,7 @@ SUB LoadPreviewText
__UI_AutoRefresh = False
FOR i = UBOUND(Control) TO 1 STEP -1
IF LEFT$(Control(i).Name, 5) <> "__UI_" THEN
GIF_Close i
GIF_Free i
__UI_DestroyControl Control(i)
END IF
NEXT
@ -3062,7 +3062,7 @@ SUB LoadPreviewText
DIM RegisterResult AS _BYTE
DummyText$ = nextParameter(b$) 'discard first parameter
DummyText$ = nextParameter(b$)
RegisterResult = GIF_OpenFile(TempValue, DummyText$)
RegisterResult = GIF_LoadFromFile(TempValue, DummyText$)
IF RegisterResult THEN
IF LogFileLoad THEN PRINT #LogFileNum, "LOAD SUCCESSFUL"
Text(TempValue) = DummyText$ 'indicates image loaded successfully
@ -3070,7 +3070,7 @@ SUB LoadPreviewText
_FREEIMAGE Control(TempValue).HelperCanvas
END IF
Control(TempValue).HelperCanvas = _NEWIMAGE(GIF_GetWidth(TempValue), GIF_GetHeight(TempValue), 32)
GIF_Draw TempValue
GIF_Draw TempValue, True
END IF
ELSEIF b$ = "IF __UI_RegisterResult THEN PlayGif __UI_NewID" OR LEFT$(b$, 8) = "PlayGif " THEN
IF LogFileLoad THEN PRINT #LogFileNum, "AUTOPLAY GIF"
@ -3159,11 +3159,11 @@ END SUB
SUB PreviewLoadImage (This AS __UI_ControlTYPE, fileName$)
IF LCASE$(RIGHT$(fileName$, 4)) = ".gif" THEN
DIM tryGif AS _BYTE
GIF_Close This.ID
tryGif = GIF_OpenFile(This.ID, fileName$)
GIF_Free This.ID
tryGif = GIF_LoadFromFile(This.ID, fileName$)
IF tryGif THEN
IF GIF_GetTotalFrames(This.ID) = 1 THEN
GIF_Close This.ID
GIF_Free This.ID
ELSE
Text(This.ID) = fileName$ 'indicates image loaded successfully
IF This.HelperCanvas < -1 THEN
@ -3171,12 +3171,12 @@ SUB PreviewLoadImage (This AS __UI_ControlTYPE, fileName$)
END IF
This.HelperCanvas = _NEWIMAGE(GIF_GetWidth(This.ID), GIF_GetHeight(This.ID), 32)
AutoPlayGif(This.ID) = False
GIF_Draw This.ID
GIF_Draw This.ID, True
EXIT SUB
END IF
END IF
END IF
GIF_Close This.ID
GIF_Free This.ID
LoadImage This, fileName$
END SUB
@ -3581,7 +3581,7 @@ SUB SavePreview (Destination AS _BYTE)
b$ = MKI$(-44) + MKI$(LEN(RTRIM$(__UI_KeyCombo(Control(i).KeyCombo).FriendlyCombo))) + RTRIM$(__UI_KeyCombo(Control(i).KeyCombo).FriendlyCombo)
IF Disk THEN PUT #BinFileNum, , b$ ELSE Clip$ = Clip$ + b$
END IF
IF GIF_GetIndex(i) > 0 THEN
IF GIF_IsLoaded(i) THEN
'PictureBox has an animated GIF loaded
b$ = MKI$(-45)
IF Disk THEN

View file

@ -8,77 +8,393 @@ $IF GIFPLAY_BAS = UNDEFINED THEN
'$INCLUDE:'GIFPlay.bi'
FUNCTION GIF_OpenFile%% (Id AS LONG, fileName AS STRING)
' This is an internal loading function common for both memory and file loaders
FUNCTION __GIF_Load%% (Id AS LONG, sf AS StringFileType)
END FUNCTION
' Opens a GIF file from a buffer in memory
FUNCTION GIF_LoadFromMemory%% (Id AS LONG, buffer AS STRING)
_MESSAGEBOX , "GIF_LoadFromMemory%%"
DIM sf AS StringFileType
StringFile_Create sf, buffer
GIF_LoadFromMemory = __GIF_Load(Id, sf)
END FUNCTION
FUNCTION GIF_OpenMemory%% (Id AS LONG, buffer AS STRING)
' Opens a GIF file from a file on disk
FUNCTION GIF_LoadFromFile%% (Id AS LONG, fileName AS STRING)
_MESSAGEBOX STR$(Id), "GIF_LoadFromFile%%"
DIM sf AS StringFileType
IF StringFile_Load(sf, fileName) THEN
GIF_LoadFromFile = __GIF_Load(Id, sf)
END IF
END FUNCTION
SUB GIF_Close (Id AS LONG)
' Free a GIF and all associated resources
SUB GIF_Free (Id AS LONG)
_MESSAGEBOX STR$(Id), "GIF_Free"
END SUB
FUNCTION GIF_GetHeight~% (Id AS LONG)
END FUNCTION
' Returns the width of the animation in pixels
FUNCTION GIF_GetWidth~% (Id AS LONG)
_MESSAGEBOX STR$(Id), "GIF_LoadFromFile%%"
SHARED __GIFPlayHashTable() AS HashTableType
SHARED __GIFPlay() AS __GIFPlayType
GIF_GetWidth = __GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).W
END FUNCTION
' Returns the height of the animation in pixels
FUNCTION GIF_GetHeight~% (Id AS LONG)
_MESSAGEBOX STR$(Id), "GIF_GetHeight~%"
SHARED __GIFPlayHashTable() AS HashTableType
SHARED __GIFPlay() AS __GIFPlayType
GIF_GetHeight = __GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).H
END FUNCTION
' Returns the number of currently playing frame
FUNCTION GIF_GetCurrentFrame~& (Id AS LONG)
_MESSAGEBOX STR$(Id), "GIF_GetCurrentFrame~&"
SHARED __GIFPlayHashTable() AS HashTableType
SHARED __GIFPlay() AS __GIFPlayType
GIF_GetCurrentFrame = __GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).currentFrameNumber
END FUNCTION
' Returns the total frames in the GIF. If this is 1 then it is a static image
FUNCTION GIF_GetTotalFrames~& (Id AS LONG)
_MESSAGEBOX STR$(Id), "GIF_GetTotalFrames~&"
SHARED __GIFPlayHashTable() AS HashTableType
SHARED __GIFPlay() AS __GIFPlayType
GIF_GetTotalFrames = __GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).totalFrames
END FUNCTION
' Sets the playback direction. direction should be -1 or 1
SUB GIF_SetPlaybackDirection (Id AS LONG, direction AS _BYTE)
_MESSAGEBOX STR$(Id), "GIF_SetPlaybackDirection"
SHARED __GIFPlayHashTable() AS HashTableType
SHARED __GIFPlay() AS __GIFPlayType
IF direction <> 0 THEN __GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).direction = SGN(direction)
END SUB
' Gets the current playback direction. This can be -1 or 1
FUNCTION GIF_GetPlaybackDirection%% (Id AS LONG)
_MESSAGEBOX STR$(Id), "GIF_GetPlaybackDirection%%"
SHARED __GIFPlayHashTable() AS HashTableType
SHARED __GIFPlay() AS __GIFPlayType
GIF_GetPlaybackDirection = __GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).direction
END FUNCTION
' Resume or starts playback
SUB GIF_Play (Id AS LONG)
_MESSAGEBOX STR$(Id), "GIF_Play"
SHARED __GIFPlayHashTable() AS HashTableType
SHARED __GIFPlay() AS __GIFPlayType
__GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).isPlaying = TRUE
END SUB
' Pauses playback. That same frame is served as long as playback is paused
SUB GIF_Pause (Id AS LONG)
_MESSAGEBOX STR$(Id), "GIF_Pause"
SHARED __GIFPlayHashTable() AS HashTableType
SHARED __GIFPlay() AS __GIFPlayType
__GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).isPlaying = FALSE
END SUB
' Stops playing the GIF and resets the cursor to the first frame
SUB GIF_Stop (Id AS LONG)
_MESSAGEBOX STR$(Id), "GIF_Stop"
SHARED __GIFPlayHashTable() AS HashTableType
SHARED __GIFPlay() AS __GIFPlayType
DIM idx AS LONG: idx = HashTable_LookupLong(__GIFPlayHashTable(), Id)
__GIFPlay(idx).isPlaying = FALSE
__GIFPlay(idx).currentFrame = __GIFPlay(idx).firstFrame
END SUB
' Return True if GIF is currently playing
FUNCTION GIF_IsPlaying%% (Id AS LONG)
_MESSAGEBOX STR$(Id), "GIF_IsPlaying%%"
SHARED __GIFPlayHashTable() AS HashTableType
SHARED __GIFPlay() AS __GIFPlayType
GIF_IsPlaying = __GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).isPlaying
END FUNCTION
SUB GIF_Draw (Id AS LONG)
' This draws the current frame on the destination surface @ (0, 0) (stretching the frame if needed)
' This will also draw the overlay if the playback is stopped / paused
SUB GIF_Draw (Id AS LONG, shouldStretch AS _BYTE)
' TODO
END SUB
SUB GIF_DrawPro (Id AS LONG, x AS LONG, y AS LONG)
' This draws the current frame at the specified x, y location on the destination surface (preserving aspect ratio)
' This will also draw the overlay if the playback is stopped / paused
SUB GIF_DrawAt (Id AS LONG, x AS LONG, y AS LONG)
_MESSAGEBOX STR$(Id), "GIF_DrawAt"
END SUB
' This returns the current frame (QB64 image) to be played
' Playback is time sensitive so frames may be skipped or the last frame maybe returned
' Only use this if you want to do your own rendering
' Also do not free the image. The library will do that when it is no longer needed
FUNCTION GIF_GetFrame& (Id AS LONG)
_MESSAGEBOX STR$(Id), "GIF_GetFrame&"
END FUNCTION
' Sets the GIF overlay to enable / disable
SUB GIF_EnableOverlay (Id AS LONG, isEnabled AS _BYTE)
_MESSAGEBOX STR$(Id), "GIF_EnableOverlay"
SHARED __GIFPlayHashTable() AS HashTableType
SHARED __GIFPlay() AS __GIFPlayType
__GIFPlay(HashTable_LookupLong(__GIFPlayHashTable(), Id)).overlayEnabled = isEnabled
END SUB
' Returns the __GIFPlay index of a loaded GIF using it's ID
' TODO: Fix line in UiEditorPreview: IF GIF_GetIndex(i) > 0 THEN
FUNCTION GIF_GetIndex~& (Id AS LONG)
' Returns TRUE if a GIF with Id is loaded
FUNCTION GIF_IsLoaded%% (Id AS LONG)
SHARED __GIFPlayHashTable() AS HashTableType
GIF_IsLoaded = HashTable_IsKeyPresent(__GIFPlayHashTable(), Id)
END FUNCTION
SUB __GIF_CreateBitmap (bmp AS __GIFBitmapType, w AS LONG, h AS LONG)
bmp.W = w
bmp.H = h
bmp.pixels = STRING$(w * h, 0)
END SUB
SUB __GIF_BlitBitmap (src AS __GIFBitmapType, dst AS __GIFBitmapType, srcX AS LONG, srcY AS LONG, dstX AS LONG, dstY AS LONG, bW AS LONG, bH AS LONG)
IF bW <= 0 OR bH <= 0 THEN EXIT SUB
DIM AS LONG w, xs, xd: w = bW: xs = srcX: xd = dstX
DIM AS LONG h, ys, yd: h = bH: ys = srcY: yd = dstY
IF xs < 0 THEN
w = w + xs
xd = xd - xs
xs = 0
END IF
IF ys < 0 THEN
h = h + ys
yd = yd - ys
ys = 0
END IF
IF xs + w > src.W THEN w = src.W - xs
IF ys + h > src.H THEN h = src.H - ys
IF xd < 0 THEN
w = w + xd
xs = xs - xd
xd = 0
END IF
IF yd < 0 THEN
h = h + yd
ys = ys - yd
yd = 0
END IF
IF xd + w > dst.W THEN w = dst.W - xd
IF yd + h > dst.H THEN h = dst.H - yd
IF w <= 0 OR h <= 0 THEN EXIT SUB
DIM ps AS LONG: ps = 1 + ys * src.W
DIM pd AS LONG: pd = 1 + yd * dst.W
DIM i AS LONG: FOR i = 1 TO h
MID$(dst.pixels, pd + xd, w) = MID$(src.pixels, ps + xs, w)
ps = ps + src.W
pd = pd + dst.W
NEXT i
END SUB
FUNCTION __GIF_ReadLZWCode& (sf AS StringFileType, buffer AS STRING, bitPos AS LONG, bitSize AS LONG)
DIM code AS LONG, p AS LONG: p = 1
DIM i AS LONG: FOR i = 1 TO bitSize
DIM bytePos AS LONG: bytePos = _SHR(bitPos, 3) AND 255
IF bytePos = 0 THEN
DIM dataLen AS LONG: dataLen = StringFile_ReadByte(sf)
IF dataLen = 0 THEN
__GIF_ReadLZWCode = -1
EXIT FUNCTION
END IF
MID$(buffer, 257 - dataLen) = StringFile_ReadString(sf, dataLen)
bytePos = 256 - dataLen
bitPos = _SHL(bytePos, 3)
END IF
IF ASC(buffer, 1 + bytePos) AND _SHL(1, (bitPos AND 7)) THEN code = code + p
p = p + p
bitPos = bitPos + 1
NEXT i
__GIF_ReadLZWCode = code
END FUNCTION
FUNCTION __GIF_DecodeLZW& (sf AS StringFileType, bmp AS __GIFBitmapType)
TYPE __LZWCodeType
prefix AS LONG
c AS LONG
ln AS LONG
END TYPE
DIM codes(0 TO 4095) AS __LZWCodeType
DIM origBitSize AS LONG: origBitSize = StringFile_ReadByte(sf)
DIM n AS LONG: n = 2 + _SHL(1, origBitSize)
DIM i AS LONG: WHILE i < n
codes(i).c = i
codes(i).ln = 0
i = i + 1
WEND
DIM clearMarker AS LONG: clearMarker = n - 2
DIM endMarker AS LONG: endMarker = n - 1
DIM buffer AS STRING: buffer = SPACE$(256)
DIM bitSize AS LONG: bitSize = origBitSize + 1
DIM bitPos AS LONG
DIM prev AS LONG: prev = __GIF_ReadLZWCode(sf, buffer, bitPos, bitSize)
IF prev = -1 THEN
__GIF_DecodeLZW = -1
EXIT FUNCTION
END IF
DO
DIM code AS LONG: code = __GIF_ReadLZWCode(sf, buffer, bitPos, bitSize)
IF code = -1 THEN
__GIF_DecodeLZW = -1
EXIT FUNCTION
END IF
IF code = clearMarker THEN
bitSize = origBitSize
n = _SHL(1, bitSize)
n = n + 2
bitSize = bitSize + 1
prev = code
_CONTINUE
END IF
IF code = endMarker THEN EXIT DO
DIM c AS LONG: IF code < n THEN c = code ELSE c = prev
DIM outPos AS LONG: outPos = outPos + codes(c).ln
i = 0
DO
ASC(bmp.pixels, 1 + outPos - i) = codes(c).c
IF codes(c).ln THEN
c = codes(c).prefix
ELSE
EXIT DO
END IF
i = i + 1
LOOP
outPos = outPos + 1
IF code >= n THEN
ASC(bmp.pixels, 1 + outPos) = codes(c).c
outPos = outPos + 1
END IF
IF prev <> clearMarker THEN
codes(n).prefix = prev
codes(n).ln = codes(prev).ln + 1
codes(n).c = codes(c).c
n = n + 1
END IF
IF _SHL(1, bitSize) = n THEN
IF bitSize < 12 THEN bitSize = bitSize + 1
END IF
prev = code
LOOP
END FUNCTION
' This load the GIF overload image
FUNCTION __GIF_LoadOverlayImage&
CONST SIZE_GIFOVERLAYIMAGE_BMP_16506 = 16506
CONST COMP_GIFOVERLAYIMAGE_BMP_16506 = -1
CONST DATA_GIFOVERLAYIMAGE_BMP_16506 = _
"eNpy8q1yYACDKiDOAWIHKGZkUGBgZsAF/kMQjDM4gRSgfbsGjt+I4jgexj+2YU57nd27H0Nl6htD6wkzJ31hqFyFWkMVZmZm5rzjMyjfzcwLvEKj" + _
"tXTnFbyZjxn0O60WBBjDdVjDU/gAP0LwK77CW3gKa7gOY+B3c1k13Ic3ICm9gftQQ8h1BIt4GdInL2MRRxBKHcd1+BIyIF/iehzHYdWpmMXnkEPy" + _
"OWZxKgZZV2AbEohtXI5B1Di+hQTmW4z3ub3fBQncXX04Hs7CKiQnVnFWhtkfh+TM4zgrgza/AsmplZTHwh2QnLszRT8vheA/LlyObyAF8Q0u9zjm" + _
"tyEFs52wL5iFFNRsgrXMZ5CC+gwnY/JfBym462LW719BCu4rHIGtRUhJLNo+H29ASuINMxYMQ1JooIUOekYHLTQgFpromJ8V1NFGV7+HOiQjw9C6" + _
"L0VumzlOB02TvWehhTZ6VoavwX3QehXixWz7ysrK7rPPPrsXmXJfc98zGdqoa8bNzc2/f++tt97a19dJ9/tPP/20H1EPPfSQ/o0mJAOvwdVFabK7" + _
"bFHCeuSRR/ZMWxh4fuMiTBygzff+u9267XY/X3vttT33Nc3gyn08NTW1474fQP4J3ATx0LH7/eabbzbt24D7mUajEWmWQPLfhHXffT8yMrJjs6Nr" + _
"+3k00LZZAsq/jqcgCbX+u+8/++yzfc2OOgR1bSNWgPmfwoe+bd/ljig93tGCOLrd/ctvwM4dPLyL7yAJ9Rxt+/Pz8ztmnzTRc1+PYirT/Ibna/AF" + _
"5KD56Qc0f72v+ROU+V1J6JeM89v2Hy+A/Inav8mm45ht/7b/i9FBPZD2n0X/107ye0YnhP4vzfjnti3BuqShc0FdC7iPQxn/fOc/msX2ZTr/Qd2u" + _
"be2cIaD5/3oW81/tByzl5vsRZecM2R//3ucJbsLYQdc/bnv/u8616wCX2635Isrse6eRYX6r67H+uRDiqYWeo/mSjE8cN6aPzm78i5mTxbkIrl5J" + _
"8xroOlfHBbvmN+2iAwkg/6vQuhfixfRvCWj/KN7nv/x1Pc9/DfX5/GcD9ZTnP5Fp/zdkzn+/Xsrz39X1D63z8SWk4L7Eker6Z2mvfx9HXM2U+P4H" + _
"HQu2IAVDJrIlq8uKd/8TmfxqrMT3v2ndBsm526v7X6v7n6v736vnH6rnX6rnnzI+HmYCeP5tBqeW8PnH63A8wOdfX4L0yUvm+ddQq4a78QokpVdw" + _
"N2rIY+nz70tYxZN431x3/g7v40msYmlQz7//BcxY2A4="
STATIC overlayImage AS LONG
' Only do this once
IF overlayImage = 0 THEN
overlayImage = _LOADIMAGE(Base64_LoadResourceString(DATA_GIFOVERLAYIMAGE_BMP_16506, SIZE_GIFOVERLAYIMAGE_BMP_16506, COMP_GIFOVERLAYIMAGE_BMP_16506), 32, "memory")
END IF
__GIF_LoadOverlayImage = overlayImage
END FUNCTION
'$INCLUDE:'HashTable.bas'

View file

@ -6,41 +6,55 @@
$IF GIFPLAY_BI = UNDEFINED THEN
$LET GIFPLAY_BI = TRUE
$IF INFORM_BI = UNDEFINED THEN
DEFLNG A-Z
OPTION _EXPLICIT
' TODO: remove this once done
'$IF INFORM_BI = UNDEFINED THEN
' DEFLNG A-Z
' OPTION _EXPLICIT
CONST FALSE = 0, TRUE = NOT FALSE
$END IF
' CONST FALSE = 0, TRUE = NOT FALSE
'$END IF
'$INCLUDE:'HashTable.bi'
'$INCLUDE:'StringFile.bi'
' This is the master GIF type that holds info about a single GIF file
TYPE __GIFPlayType
id AS LONG ' handle supplied by the user (do we need this?)
W AS _UNSIGNED INTEGER ' GIF global width (this needs to be 16-bit)
H AS _UNSIGNED INTEGER ' GIF global height (this needs to be 16-bit)
bgColor AS _UNSIGNED _BYTE ' background color
colors AS _UNSIGNED INTEGER ' total colors in the global palette
pal AS STRING * 768 ' global palette - 256 colors * 3 components
frame AS LONG ' index of the first frame in the frame data array
frames AS LONG ' total frames in the animation
hideOverlay AS _BYTE ' should the "GIF" overlay be hidden when it is not playing
firstFrame AS LONG ' index of the first frame in the frame data array
currentFrame AS LONG ' index of the current frame being played
totalFrames AS LONG ' total number of frames counted while loading
currentFrameNumber AS LONG ' this is simply the number of current frame since playback (re)started
isPlaying AS _BYTE ' set to true if the GIF is currently playing
direction AS _BYTE ' playback direction (-1 or +1)
overlayEnabled AS _BYTE ' should the "GIF" overlay be shown / hidden when it is not playing
END TYPE
' This is the a GIF frame type that holds info about an individual GIF frame
TYPE __GIFPlayFrameType
id AS LONG ' which GIF handle does this belong to?
id AS LONG ' index to __GIFPlay that this frame belongs to (do we really need this?)
image AS LONG ' QB64 image handle
L AS _UNSIGNED INTEGER ' frame left (this needs to be 16-bit) (do we need these?)
T AS _UNSIGNED INTEGER ' frame top (this needs to be 16-bit)
W AS _UNSIGNED INTEGER ' frame width (this needs to be 16-bit)
H AS _UNSIGNED INTEGER ' frame height (this needs to be 16-bit)
pre AS LONG ' previous frame (this will link back to the last frame if this is the first one)
nxt AS LONG ' next frame (this will link back to the first frame if this is the last one)
delayMs AS SINGLE ' frame delay time
direction AS _BYTE ' playback direction
prevFrame AS LONG ' previous frame (this will link back to the last frame if this is the first one)
nextFrame AS LONG ' next frame (this will link back to the first frame if this is the last one)
timeMs AS SINGLE ' frame time
END TYPE
REDIM __GIFPlayHashTable(0 TO 0) AS HashTableType
REDIM __GIFPlay(0 TO 0) AS __GIFPlayType
REDIM __GIFPlayFrame(0 TO 0) AS __GIFPlayFrameType
' This is used by temporary variables during the decoding step to store the raw data for a single frame
TYPE __GIFBitmapType
W AS LONG
H AS LONG
pixels AS STRING
END TYPE
REDIM __GIFPlayHashTable(0 TO 0) AS HashTableType ' shared hash table to keep user supplied IDs (the values here points to indexes in __GIFPlay)
REDIM __GIFPlay(0 TO 0) AS __GIFPlayType ' main GIFPlay array - each array element is for a single GIF
REDIM __GIFPlayFrame(0 TO 0) AS __GIFPlayFrameType ' shared GIF frame array - this holds GIF frame and frame information for all loaded GIFs
$END IF

View file

@ -90,25 +90,33 @@ $IF HASHTABLE_BAS = UNDEFINED THEN
'PRINT "Value for key 7:"; HashTable_LookupLong(MyHashTable(), 7)
'PRINT "Value for key 21:"; HashTable_LookupLong(MyHashTable(), 21)
'PRINT HashTable_IsKeyPresent(MyHashTable(), 100)
'END
'-------------------------------------------------------------------------------------------------------------------
' Simple hash function: k is the 32-bit key and l is the upper bound of the array
FUNCTION __HashTable_GetHash~& (k AS _UNSIGNED LONG, l AS _UNSIGNED LONG)
__HashTable_GetHash = k MOD (l + 1) ' + 1 is needed for 0 based arrays
$CHECKING:OFF
' Actually this should be k MOD (l + 1)
' However, we can get away using AND because our arrays size always doubles in multiples of 2
' So, if l = 255, then (k MOD (l + 1)) = (k AND l)
' Another nice thing here is that we do not need to do the addition :)
__HashTable_GetHash = k AND l
$CHECKING:ON
END FUNCTION
' Subroutine to resize and rehash the elements in a hash table
SUB __HashTable_ResizeAndRehash (hashTable() AS HashTableType)
DIM UB AS _UNSIGNED LONG: UB = UBOUND(hashTable)
DIM uB AS _UNSIGNED LONG: uB = UBOUND(hashTable)
' Resize the array to double its size while preserving contents
DIM newUB AS _UNSIGNED LONG: newUB = _SHL(UB + 1, 1) - 1
DIM newUB AS _UNSIGNED LONG: newUB = _SHL(uB + 1, 1) - 1
REDIM _PRESERVE hashTable(0 TO newUB) AS HashTableType
' Rehash and swap all the elements
DIM i AS _UNSIGNED LONG: FOR i = 0 TO UB
DIM i AS _UNSIGNED LONG: FOR i = 0 TO uB
IF hashTable(i).U THEN SWAP hashTable(i), hashTable(__HashTable_GetHash(hashTable(i).K, newUB))
NEXT i
END SUB
@ -117,8 +125,8 @@ $IF HASHTABLE_BAS = UNDEFINED THEN
' This returns an array index in hashTable where k can be inserted
' If there is a collision it will grow the array, re-hash and copy all elements
FUNCTION __HashTable_GetInsertIndex& (hashTable() AS HashTableType, k AS _UNSIGNED LONG)
DIM ub AS _UNSIGNED LONG: ub = UBOUND(hashTable)
DIM idx AS _UNSIGNED LONG: idx = __HashTable_GetHash(k, ub)
DIM uB AS _UNSIGNED LONG: uB = UBOUND(hashTable)
DIM idx AS _UNSIGNED LONG: idx = __HashTable_GetHash(k, uB)
IF hashTable(idx).U THEN
' Used slot
@ -139,8 +147,8 @@ $IF HASHTABLE_BAS = UNDEFINED THEN
' This function returns the index from hashTable for the key k if k is in use
FUNCTION __HashTable_GetLookupIndex& (hashTable() AS HashTableType, k AS _UNSIGNED LONG)
DIM ub AS _UNSIGNED LONG: ub = UBOUND(hashTable)
DIM idx AS _UNSIGNED LONG: idx = __HashTable_GetHash(k, ub)
DIM uB AS _UNSIGNED LONG: uB = UBOUND(hashTable)
DIM idx AS _UNSIGNED LONG: idx = __HashTable_GetHash(k, uB)
IF hashTable(idx).U THEN
' Used slot
@ -158,6 +166,12 @@ $IF HASHTABLE_BAS = UNDEFINED THEN
END FUNCTION
' Return TRUE if k is available in the hash table
FUNCTION HashTable_IsKeyPresent%% (hashTable() AS HashTableType, k AS _UNSIGNED LONG)
HashTable_IsKeyPresent = (__HashTable_GetLookupIndex(hashTable(), k) >= 0)
END FUNCTION
' Remove an element from the hash table
SUB HashTable_Remove (hashTable() AS HashTableType, k AS _UNSIGNED LONG)
DIM idx AS LONG: idx = __HashTable_GetLookupIndex(hashTable(), k)

View file

@ -6,23 +6,16 @@
$IF HASHTABLE_BI = UNDEFINED THEN
$LET HASHTABLE_BI = TRUE
$IF INFORM_BI = UNDEFINED THEN
DEFLNG A-Z
OPTION _EXPLICIT
CONST FALSE = 0, TRUE = NOT FALSE
$END IF
CONST __HASHTABLE_KEY_EXISTS = -1
CONST __HASHTABLE_KEY_UNAVAILABLE = -2
' Hash table entry type
' To extended supported data types, add other value types after V and then write
' wrappers around __HashTable_GetInsertIndex() & __HashTable_GetLookupIndex()
TYPE HashTableType
U AS _BYTE ' used?
K AS _UNSIGNED LONG ' key
V AS LONG ' value
' <- add other value types here and then write wrappers
' around __HashTable_GetInsertIndex() & __HashTable_GetLookupIndex()
END TYPE
$END IF

View file

@ -7,13 +7,6 @@
$IF INI_BI = UNDEFINED THEN
$LET INI_BI = TRUE
$IF INFORM_BI = UNDEFINED THEN
DEFLNG A-Z
OPTION _EXPLICIT
CONST FALSE = 0, TRUE = NOT FALSE
$END IF
' TODO:
' We should put all of this stuff into a single state type and then have just a single global to avoid possible name collisions.
' INI routines without namespace like prefix should also be prefixed with the "Ini_" prefix

View file

@ -6,13 +6,6 @@
$IF MESSAGEBOX_BI = UNDEFINED THEN
$LET MESSAGEBOX_BI = TRUE
$IF INFORM_BI = UNDEFINED THEN
DEFLNG A-Z
OPTION _EXPLICIT
CONST FALSE = 0, TRUE = NOT FALSE
$END IF
'Messagebox constants
CONST MsgBox_OkOnly = 1
CONST MsgBox_OkCancel = 2

View file

@ -6,13 +6,6 @@
$IF STRINGFILE_BI = UNDEFINED THEN
$LET STRINGFILE_BI = TRUE
$IF INFORM_BI = UNDEFINED THEN
DEFLNG A-Z
OPTION _EXPLICIT
CONST FALSE = 0, TRUE = NOT FALSE
$END IF
' Simplified QB64-only memory-file
TYPE StringFileType
buffer AS STRING

View file

@ -14,8 +14,8 @@ DIM SHARED LoadBT AS LONG
DIM SHARED PlayBT AS LONG
': External modules: ---------------------------------------------------------------
'$INCLUDE:'../../InForm/InForm.bi'
'$INCLUDE:'../../InForm/extensions/GIFPlay.bi'
'$INCLUDE:'../../InForm/InForm.bi'
'$INCLUDE:'../../InForm/extensions/MessageBox.bi'
'$INCLUDE:'GIFPlaySample.frm'
@ -28,7 +28,7 @@ SUB __UI_OnLoad
END SUB
SUB __UI_BeforeUpdateDisplay
GIF_Update PictureBox1
GIF_Draw PictureBox1, True
END SUB
SUB __UI_BeforeUnload
@ -42,7 +42,7 @@ SUB __UI_Click (id AS LONG)
DIM fileName AS STRING: fileName = _OPENFILEDIALOG$(Caption(gifplaySample), , "*.gif|*.GIF|*.Gif", "GIF Files")
IF LEN(fileName) > 0 THEN
IF GIF_Open(PictureBox1, fileName) THEN
IF GIF_LoadFromFile(PictureBox1, fileName) THEN
Control(PlayBT).Disabled = False
@ -67,7 +67,7 @@ SUB __UI_Click (id AS LONG)
END IF
CASE PictureBox1
GIF_HideOverlay PictureBox1
GIF_EnableOverlay PictureBox1, False
END SELECT
END SUB