Nice work on GIFPlay, @a740g.
Was wondering, did you ever write that FLI/FLC player? I wrote a FLI player in Qbasic years ago (here) which I updated to QB64 code (below). It's very limited but does play FLI's, here it is if it will help at all.
- Dav
Was wondering, did you ever write that FLI/FLC player? I wrote a FLI player in Qbasic years ago (here) which I updated to QB64 code (below). It's very limited but does play FLI's, here it is if it will help at all.
- Dav
Code: (Select All)
PlayFlic "CLOWN.FLI"
SUB PlayFlic (file$)
'open fli/flc file
OPEN file$ FOR BINARY AS #1
IF LOF(1) = 0 THEN
CLOSE 1: KILL file$ 'if file empty, close and delete
EXIT SUB
END IF
'grab fli/flc header
header$ = INPUT$(128, 1) 'read 128 bytes for header info
FlicId = CVI(MID$(header$, 5, 2)) 'flic id
frames = CVI(MID$(header$, 7, 2)) 'number of frames
FlicWidth = CVI(MID$(header$, 9, 2)) 'flic width
FlicHeight = CVI(MID$(header$, 11, 2)) 'flic height
Ticks = CVI(MID$(header$, 17, 2)) 'timing
'validate fli/flc id
IF (FlicId <> &HAF11 AND FlicId <> &HAF12 AND FlicId <> &HAF13) THEN
CLOSE 1: EXIT SUB 'if not, exit
END IF
'setup screen with width and height
SCREEN _NEWIMAGE(FlicWidth, FlicHeight, 32)
DO 'loop animation
SEEK 1, 129 'skip the fli/flc header
FOR f = 1 TO frames 'do all frames
framepos& = SEEK(1) 'save file pointer pos for current frame
FrameHeader$ = INPUT$(16, 1) 'frame header
FrameSize& = CVL(MID$(FrameHeader$, 1, 4)) 'size of the frame
FrameChunks = CVI(MID$(FrameHeader$, 7, 2)) 'number of chunks in frame
d$ = INKEY$: IF d$ <> "" THEN EXIT DO 'exit playback if key pressed
FOR c = 1 TO FrameChunks 'do chunks in frame
chunkpos& = SEEK(1) 'save file pointer pos for current chunk
chunkheader$ = INPUT$(6, 1) 'chunk header
ChunkSize& = CVL(MID$(chunkheader$, 1, 4)) 'size of the chunk
ChunkType = CVI(MID$(chunkheader$, 5, 2)) 'chunk type ID
chunkpos& = chunkpos& + ChunkSize& 'move chunk pos to next chunk
SELECT CASE ChunkType 'do chuck type ID
CASE 11 'set palette chunk
REDIM pal&(255) 'palette array
clr = 0
packs = ASC(INPUT$(2, 1))
FOR d = 1 TO packs
skip = ASC(INPUT$(1, 1))
change = ASC(INPUT$(1, 1))
IF change = 0 THEN change = 256
clr = clr + skip
FOR s = 1 TO change
r = ASC(INPUT$(1, 1)) * 4 'red
g = ASC(INPUT$(1, 1)) * 4 'green
b = ASC(INPUT$(1, 1)) * 4 'blue
pal&(clr) = _RGB(r, g, b)
clr = clr + 1
NEXT
NEXT
CASE 12 'line compressed chunk (LC)
skip = CVI(INPUT$(2, 1)) 'unused lines to skip
change = CVI(INPUT$(2, 1)) 'lines to change
FOR y = skip TO change + (skip - 1)
packpos& = SEEK(1)
PackData$ = INPUT$(500, 1): midpos = 1 'grab all pack data
packs = ASC(MID$(PackData$, midpos, 1)) 'number of packs
midpos = midpos + 1: x = 0 'update midpos
FOR d = 1 TO packs
s% = ASC(MID$(PackData$, midpos, 1)) 'skip value
p = ASC(MID$(PackData$, midpos + 1, 1)) 'pixel value
midpos = midpos + 2: x = x + s% 'update midpos
IF p > 127 THEN 'if packed data
p = (256 - p) 'decode pixel data
LINE (x, y)-STEP(p - 1, 0), pal&(ASC(MID$(PackData$, midpos, 1)))
x = x + p: midpos = midpos + 1 'update position
ELSE 'raw pixel data
Row$ = MID$(PackData$, midpos, p) 'read pixels
midpos = midpos + p
FOR k = 1 TO LEN(Row$)
PSET (x + k - 1, y), pal&(ASC(MID$(Row$, k, 1)))
NEXT
x = x + p 'update position ahead
END IF
NEXT
SEEK #1, packpos& + midpos - 1: 'PackData$ = ""
NEXT
CASE 13 'clear screen chunk
CLS 'clear screen to black
CASE 15 'brun compressed chunk
x = 0
FOR y = 0 TO FlicHeight - 1 'do row
packpos& = SEEK(1) 'save current pack pos
PackData$ = INPUT$(500, 1): midpos = 1 'load pack data
packs = ASC(MID$(PackData$, midpos, 1)) 'number of packs
midpos = midpos + 1 'update for mid$ usage
FOR d = 1 TO packs 'do packs
p = ASC(MID$(PackData$, midpos, 1)): midpos = midpos + 1
IF p < 128 THEN
LINE (x, y)-STEP(p - 1, 0), pal&(ASC(MID$(PackData$, midpos, 1)))
midpos = midpos + 1
ELSE 'if packed data
p = (256 - p)
Row$ = MID$(PackData$, midpos, p) 'raw pixels
midpos = midpos + p
FOR k = 1 TO LEN(Row$)
PSET (x + k - 1, y), pal&(ASC(MID$(Row$, k, 1))) 'draw pixels
NEXT
END IF
x = x + p 'update x position
NEXT
x = 0: SEEK #1, packpos& + midpos - 1 ': PackData$ = ""
NEXT
CASE 16 'raw image data chunk
x = 0
FOR y = 0 TO FlicHeight - 1
Row$ = INPUT$(FlicWidth, 1)
FOR k = 1 TO LEN(Row$)
PSET (x + k - 1, y), pal&(ASC(MID$(Row$, k, 1)))
NEXT
NEXT
CASE ELSE: CLOSE 1: EXIT SUB 'invalid chunk type, exit
END SELECT
SEEK #1, chunkpos& 'move file pos to next chunk
NEXT
SEEK 1, framepos& + FrameSize& 'move to the next frame
_LIMIT Ticks * 8 'playback speed
_DISPLAY
NEXT
LOOP
CLOSE 1
END SUB