Save GIF file from Screen in FreeBASIC (TODO: error handling, tidy up, etc.)

savegif.bas

'' https://gist.github.com/countingpine/4e70fc94aab6aae041ade9a443863ba0
'' see also http://giflib.sourceforge.net/gif_lib.html
'' see also https://gassend.net/spaceelevator/breaks/index.html -> https://gassend.net/spaceelevator/breaks/oscil2.c
'' see also https://cpp.hotexamples.com/examples/-/-/gif_save/cpp-gif_save-function-examples.html ?

#include "crt.bi"
#include "gif_lib.bi"

#define WID 100
#define HEI 32

'const NULL as any ptr = 0

screenres WID, HEI, 8

dim shared as GifFileType ptr GIFfile

sub closeGIF()
	dim as long giferr
	'print (!"closeGIF\n")
	EGifCloseFile(GIFfile, @giferr)
end sub

sub openGIF(byref filename as const string, byval allow_overwrite as boolean = true)
	dim as integer i
	dim as long giferr
	dim as ColorMapObject ptr GIFcmap

	GIFcmap = GifMakeMapObject(256, NULL)
	GIFfile = EGifOpenFileName("savegif.gif", 0, @giferr)
	'EGifSetGifVersion(GIFfile, 1) '' GIF89A

	'for i = 0 to 255
	'  dim as integer r, g, b
	'  palette get i,  r, g ,b

	'  GIFcmap->Colors[i].Red   = r
	'  GIFcmap->Colors[i].Green = g
	'  GIFcmap->Colors[i].Blue  = b
	'next i

	'EGifPutScreenDesc(GIFfile, WID, HEI, 128, 0, GIFcmap)
end sub

sub saveFrame()'int predelay as integer)
	static frames(0 to 1, 0 to HEI-1, 0 to WID-1) as ubyte
	static gpal(0 to 255) as long, lpal(0 to 1, 0 to 255) as long

	static firstframe as boolean = true
	static curframe as integer = 0, prevframe as integer = 1

	dim as ColorMapObject ptr colormap = NULL

	screenlock

	dim as ubyte ptr p = screenptr
	dim as integer pitch
	screeninfo(0,0,0,0, pitch)

	for y as integer = 0 to HEI-1
		memcpy(@frames(curframe, y, 0), p, WID)
		p += pitch
	next y

	screenunlock

	if firstframe then
		'' global palette
		colormap = GifMakeMapObject(256, NULL)
		for i as integer = 0 to 255
			dim as integer r, g, b
			palette get i, r, g, b
			gpal(i) = RGB(r, g, b)

			colormap->Colors[i].Red   = r
			colormap->Colors[i].Green = g
			colormap->Colors[i].Blue  = b
		next i
		memcpy(@lpal(curframe, 0), @gpal(0), 256 * sizeof(long))

		EGifPutScreenDesc(GIFfile, WID, HEI, 256, 0, colormap)
		GifFreeMapObject(colormap)
		EGifPutImageDesc(GIFfile, 0, 0, WID, HEI, 0, NULL)

		for y as integer = 0 to HEI-1
			EGifPutLine(GIFfile, @frames(curframe, y, 0), WID)
			'for x as integer = 0 to WID-1
			'	dim as integer col = frames(curframe, y, x) 'point(x, y)
			'	EGifPutPixel(GIFfile, col)
			'next x
		next y

		firstframe = false
	else
		'' local palette
		for i as integer = 0 to 255
			dim as integer r, g, b
			palette get i, r, g, b
			lpal(curframe, i) = RGB(r, g, b)
		next i

		'' different from global palette?
		if memcmp(@lpal(curframe, 0), @gpal(0), 256 * sizeof(long)) then
			colormap = GifMakeMapObject(256, NULL)
			for i as integer = 0 to 255
				colormap->Colors[i].Red   = lpal(curframe, i) shr 16 and 255
				colormap->Colors[i].Green = lpal(curframe, i) shr  8 and 255
				colormap->Colors[i].Blue  = lpal(curframe, i)        and 255
			next i
		end if

		dim as integer x1 = 0, y1 = 0, x2 = WID-1, y2 = HEI-1

		'' Same as previous palette?  Shrink image to changed region
		if memcmp(@lpal(curframe, 0), @lpal(prevframe, 0), 256 * sizeof(long)) = 0 then
			while y2 > y1
				dim as boolean rowdiff = false
				'for x as integer = x1 to x2
				'	dim as ubyte c1 = frames(curframe, y2, x), c2 = frames(prevframe, y2, x)
				'	if c1 <> c2 then rowdiff = true: exit for
				'next x
				rowdiff = memcmp(@frames(curframe, y2, 0), @frames(prevframe, y2, 0), WID)
				if rowdiff then exit while
				y2 -= 1
			wend
			while y1 < y2
				dim as boolean rowdiff = false
				'for x as integer = x1 to x2
				'	dim as ubyte c1 = frames(curframe, y1, x), c2 = frames(prevframe, y1, x)
				'	if c1 <> c2 then rowdiff = true: exit for
				'next x
				rowdiff = memcmp(@frames(curframe, y1, 0), @frames(prevframe, y1, 0), WID)
				if rowdiff then exit while
				y1 += 1
			wend

			while x2 > x1
				dim as boolean coldiff = false
				for y as integer = y1 to y2
					dim as ubyte c1 = frames(curframe, y, x2), c2 = frames(prevframe, y, x2)
					if c1 <> c2 then coldiff = true: exit for
				next y
				if coldiff then exit while
				x2 -= 1
			wend
			while x1 < x2
				dim as boolean coldiff = false
				for y as integer = y1 to y2
					dim as ubyte c1 = frames(curframe, y, x1), c2 = frames(prevframe, y, x1)
					if c1 <> c2 then coldiff = true: exit for
				next y
				if coldiff then exit while
				x1 += 1
			wend
		end if

		'printf(!"%lld..%lld, %lld..%lld\n", x1, x2, y1, y2)
		puts x1 & ".." & x2 & ", " & y1 & ".." & y2
		
		'' Maybe we don't need this
		''dim gcb as GraphicsControlBlock
		''with gcb
		''	.DisposalMode = 

		EGifPutImageDesc(GIFfile, x1, y1, x2-x1+1, y2-y1+1, 0, colormap)
		if colormap <> NULL then GifFreeMapObject(colormap)

		for y as integer = y1 to y2
			EGifPutLine(GIFfile, @frames(curframe, y, x1), x2-x1+1)
			'for x as integer = x1 to x2
			'	dim as integer col = frames(curframe, y, x) 'point(x, y)
			'	EGifPutPixel(GIFfile, col)
			'next x
		next y

	end if

	swap prevframe, curframe
end sub


sub saveGIF()
	dim as integer x, y
	dim as ubyte img(0 to WID * HEI - 1)

	'print (!"saveGIF\n")

	EGifPutImageDesc(GIFfile, 0, 0, WID, HEI, 0, NULL)
	for y = 0 to HEI-1
		for x = 0 to WID-1
			dim as integer col = point(x, y)
			EGifPutPixel(GIFfile, col)
		next x
	next y
	'print (!"saveGIF - done\n")
end sub

sub main()

	openGIF("savegif.gif")

	dim as string text = !"Hello\nworld"

	for i as integer = 1 to len(text)
		print mid(text, i, 1);

		puts (i & "th")
		'saveGIF()
		saveFrame()
		palette 15, 255,128,0
	next i

	closeGIF()

end sub

main()
'sleep 1000