Bug with BSAVE?

General FreeBASIC programming questions.
Post Reply
badidea
Posts: 2605
Joined: May 24, 2007 22:10
Location: The Netherlands

Bug with BSAVE?

Post by badidea »

My chm help file (for version 1.0.5) says on BSAVE:

Syntax
Declare Function BSave ( ByRef filename As Const String, ByVal source As Any Ptr, ByVal size As Ulong = 0, ByVal pal As Any Ptr = 0, ByVal bitsperpixel As Long = 0 ) As Long
Usage
result = BSave( filename, source [,[ size ][,[ pal ][, bitsperpixel ]]] )

So if that if want to save a BMP file, 'size' and 'pal' can be left empty while choosing a value for 'bitsperpixel':
bsave ("bla.bmp", img.pFbImg, , , 32)

But this results in:
No matching overloaded function, BSAVE() in 'bsave ("bla.bmp", img.pFbImg, , , 32)'

The following is allowed:
bsave ("bla.bmp", img.pFbImg, , 0, 32)

But shouldn't the first form be ok as well?
badidea
Posts: 2605
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Bug with BSAVE?

Post by badidea »

Oh, and another one. With 32 for 'bitsperpixel', I would expect that it saves the alpha-channel, but it does not.
I'll makes some test code...

This input image:
https://nr100.home.xs4all.nl/badidea/Berlin_sans32.bmp
This code:

Code: Select all

const as integer SCREEN_W = 800
const as integer SCREEN_H = 600

#include once "fbgfx.bi"
#include once "file.bi"

'===============================================================================

type int2d
	dim as integer x, y
end type

type bitmap_header field = 1
	bfType          as ushort
	bfsize          as ulong
	bfReserved1     as ushort
	bfReserved2     as ushort
	bfOffBits       as ulong
	biSize          as ulong
	biWidth         as ulong
	biHeight        as ulong
	biPlanes        as ushort
	biBitCount      as ushort
	biCompression   as ulong
	biSizeImage     as ulong
	biXPelsPerMeter as ulong
	biYPelsPerMeter as ulong
	biClrUsed       as ulong
	biClrImportant  as ulong
end type

type image_type
	dim as any ptr pFbImg
	dim as int2d size
	declare sub create(sizeInit as int2d, colorInit as ulong)
	declare function createFromBmp(fileName as string) as integer
	declare sub destroy()
	declare destructor()
end type

sub image_type.create(sizeInit as int2d, colorInit as ulong)
	pFbImg = imagecreate(sizeInit.x, sizeInit.y, colorInit)
	size = sizeInit
end sub

function image_type.createFromBmp(fileName as string) as integer
	dim as bitmap_header bmp_header
	dim as int2d bmpSize
	if fileExists(filename) then
		open fileName for binary as #1
			get #1, , bmp_header
		close #1
		bmpSize.x = bmp_header.biWidth
		bmpSize.y = bmp_header.biHeight
		create(bmpSize, &hff000000)
		bload fileName, pFbImg
		'print "Bitmap loaded: " & filename
		return 0
	end if
	'print "File not found: " & filename
	return -1
end function

sub image_type.destroy()
	if (pFbImg <> 0) then
		imagedestroy(pFbImg)
		pFbImg = 0
	end if
end sub

destructor image_type()
	destroy()
end destructor

'===============================================================================

screenres SCREEN_W, SCREEN_H, 32
width SCREEN_W \ 8, SCREEN_H \ 16

dim as image_type img

img.createFromBmp("Berlin_sans32.bmp")
'fix color where alpha is zero (error in this bmp)
for y as integer = 0 to img.size.y-1
	for x as integer = 0 to img.size.x-1
		if (point (x, y, img.pFbImg) and &hff000000) = 0 then
			pset img.pFbImg, (x, y), 0
		end if
	next
next

line(0, 0) - (SCREEN_W-1, SCREEN_H-1), &h004080a0, bf
put(0, 0), img.pFbImg, alpha
bsave ("bla123out.bmp", img.pFbImg, , 0, 32)
sleep
Creates "bla123out.bmp" with alpha-channel lost?[/s]

EDIT: Sorry, I does seems to save the alpha-channel, but other programs display the newly created image different. E.g. 'Gimp' does not recognise the alpha channel.
sancho3
Posts: 358
Joined: Sep 30, 2017 3:22

Re: Bug with BSAVE?

Post by sancho3 »

It might be a bug or a documentation issue.
If you include the bit depth you have to include at least a null(0) for palette or you get that error.
There is no matching bug report as yet.

Code: Select all

Dim As Any ptr t 
'Bsave("bla.bmp", t,,,32) 		' error
Bsave("bla.bmp", t,,,)			' no error
Bsave("bla.bmp", t,,0,32)		' no error
Sleep 

fxm
Moderator
Posts: 12344
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Bug with BSAVE?

Post by fxm »

Yes, it seems that currently, the syntax allowed for BSave use (due to existing overload procedures) is rather:
result = BSave( filename, source [,[ size ][, pal | , pal, bitsperpixel ]] )

or:
result = BSave( filename, source [,[ size ][,[ pal | pal, bitsperpixel ]]] )
(maybe more clear)
badidea
Posts: 2605
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Bug with BSAVE?

Post by badidea »

badidea wrote:EDIT: Sorry, I does seems to save the alpha-channel, but other programs display the newly created image different. E.g. 'Gimp' does not recognise the alpha channel.
I ran into this issue again. Of the 5 graphics programs that I have installed, only 1 understands that the image contains alpha data. Also firefox & chromium do not accept the alpha channel in a image saved with freebasic's bsave.

I am pretty sure that it is actually is a bug in freebasic. Bsave does not seem to follow the specification at https://en.wikipedia.org/wiki/BMP_file_format (assuming that this wiki-page is correct). At file position 1E (hex) bsave writes the value 0. This means that "BI_RGB" compression / format is used, where the location of the alpha byte "A" is just padding for 32-bit alignment. For RGBA data, value 3 (BI_BITFIELDS) at location 1E should be used with an additional header (OS22XBITMAPHEADER or BITMAPINFOHEADER2) section to further specify the encoding.
badidea
Posts: 2605
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Bug with BSAVE?

Post by badidea »

BSAVE with alpha (32 bit only):

Code: Select all

#include once "fbgfx.bi"
#include once "file.bi"

const BI_RGB = 0
const BI_BITFIELDS = 3

'BITMAPFILEHEADER ONLY (14 bytes)
type bitmap_file_header field = 1
	bfType          as ushort
	bfSize          as ulong
	bfReserved1     as ushort
	bfReserved2     as ushort
	bfOffBits       as ulong
end type

'BITMAPV5HEADER 124 bytes
type bitmap_info_header_v5 field = 1
	biSize          as ulong
	biWidth         as ulong
	biHeight        as ulong
	biPlanes        as ushort
	biBitCount      as ushort
	biCompression   as ulong
	biSizeImage     as ulong
	biXPelsPerMeter as ulong
	biYPelsPerMeter as ulong
	biClrUsed       as ulong
	biClrImportant  as ulong
	redMask         as ulong
	greenMask       as ulong
	blueMask        as ulong
	alphaMask       as ulong
	csType          as ulong
	endPoints(0 to 8) as ulong '36 bytes (CIEXYZTRIPLE)
	gammaRed        as ulong
	gammaGreen      as ulong
	gammaBlue       as ulong
	'addition:
	intent          as ulong 'Rendering intent enum
	profileData     as ulong
	profileSize     as ulong
	reserved        as ulong
end type

function image2bitmap(filename as const string, pImg as any ptr) as integer
	dim as integer w, h, bypp, pitch
	dim as any ptr pPixData
	if imageInfo (pImg, w, h, bypp, pitch, pPixData) <> 0 then return -1
	if bypp <> 4 then return -2 'for 32 bit only
	dim as bitmap_file_header bmpFileHdr
	dim as bitmap_info_header_v5 bmpInfoHdr
	with bmpFileHdr
		.bfType = &h4D42
		.bfSize = sizeof(bmpFileHdr) + sizeof(bmpInfoHdr) + w * h * bypp
		.bfOffBits = sizeof(bmpFileHdr) + sizeof(bmpInfoHdr)
	end with
	with bmpInfoHdr
		.biSize = sizeof(bmpInfoHdr)
		.biWidth = w
		.biHeight = h '-h 'up-side-down
		.biPlanes = 1
		.biBitCount = 32
		.biCompression = BI_BITFIELDS
		.biSizeImage = w * h * bypp
		.biXPelsPerMeter = 2835 '72 DPI
		.biYPelsPerMeter = 2835 '72 DPI
		.redMask   = &h00FF0000 'big-endian 
		.greenMask = &h0000FF00 'big-endian 
		.blueMask  = &h000000FF 'big-endian 
		.alphaMask = &hFF000000 'big-endian 
		.csType = &h73524742 'sRGB
		.intent = 0
	end with
	if fileExists(fileName) then return -3 'don't overwrite
	dim as integer f = freeFile()
	if open(fileName, for binary, as #f) <> 0 then return -4 'file open error
		put #f, ,bmpFileHdr
		put #f, ,bmpinfoHdr
		'write rows in reverse order w.r.t image in memory
		pPixData += (h * pitch)
		for row as integer = 0 to h - 1
			pPixData -= pitch
			put #f, ,*cptr(ulong ptr, pPixData), w
		next
		'put #f, ,*cptr(ulong ptr, pPixData), w * h
	close #f
	return 0 'ok
end function

const SCR_W = 640, SCR_H = 480, SCR_BPP = 32
screenres SCR_W, SCR_H, SCR_BPP,,FB.GFX_ALPHA_PRIMITIVES 'to make circle work with alpha???

const IMG_W = 300, IMG_H = 200
dim as FB.image ptr pImage = imageCreate(IMG_W, IMG_H, rgba(0, 0, 0, 255)) 'non-transparant black
if pImage = 0 then
	print "Image error"
else
	'Draw some transparant circles (on image)
	for i as integer = 0 to 99
		dim as integer x = int(rnd * (IMG_W - 50)) + 25
		dim as integer y = int(rnd * (IMG_H - 50)) + 25
		dim as integer radius = int(rnd * 20) + 5
		dim as ubyte r = int(rnd * 256)
		dim as ubyte g = int(rnd * 256)
		dim as ubyte b = int(rnd * 256)
		dim as ubyte a = int(rnd * 156) + 50
		circle pImage, (x, y), radius, rgba(r, g, b, a),,,,f
	next
	'show image on screen
	put (150, 100), pImage, alpha
	'save to bitmap
	dim as integer result
	result = image2bitmap("fb_alpha_test_2.bmp", pImage)
	select case result
		case  0: print "Ok, image saved"
		case -1: print "Error, invalid image"
		case -2: print "Error, not 32 bit"
		case -3: print "Error, file exists"
		case -4: print "Error, opening file"
		case else: print "Unknown error"
	end select
	'clean up
	imagedestroy(pImage)
end if

getkey()
end
dodicat
Posts: 8136
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Bug with BSAVE?

Post by dodicat »

Badidea.
Maybe I am not understanding your idea, but bsave seems to work OK with alpha in win 11, fb 1.10.1

Code: Select all


screen 19,32,,64
dim as any ptr i=imagecreate(800,600,0)

for n as long=1 to 70
    circle i,(rnd*800,rnd*600),10+rnd*50,rgba(rnd*255,rnd*255,rnd*255,rnd*255),,,,f
next
draw string i,(20,20),"press a key to exit FreeBASIC and kill the image and bitmap"
bsave "circles.bmp",i
bload "circles.bmp"
shell "circles.bmp"
sleep
kill "circles.bmp"
imagedestroy i
 
badidea
Posts: 2605
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Bug with BSAVE?

Post by badidea »

Your circles are transparent, but the end-result is not. The saves image has no transparency (here).
Also here, your code produces a 40 byte BITMAPINFOHEADER which does not (officially) support per pixel alpha value (although 32 bits per pixel are used). See: https://github.com/freebasic/fbc/blob/m ... fx_bsave.c
My code produces a bitmap with a 124 byte BITMAPV5HEADER, see also: https://en.wikipedia.org/wiki/BMP_file_format
dodicat
Posts: 8136
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Bug with BSAVE?

Post by dodicat »

Hi badidea.
The ins and out of it may be, but the bitmap shows the transparency here on windows.
If I remember, you use Linux?
It opens with photos here with shell, both the photos and bload look exactly the same here.
badidea
Posts: 2605
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Bug with BSAVE?

Post by badidea »

You are right, both Windows and freebasic are happy with alpha data, while most linux tools seem more strict and reject the data depending on which header version is used.

Edit: It is actually only freebasic that is happy with 'incorrect' alpha data. This code produces 2 bitmaps "image_bsave.bmp" and "image_badidea.bmp" that look the same in freebasic when loaded, but different in Windows and Linux:

Code: Select all

#include once "fbgfx.bi"
#include once "file.bi"

const BI_RGB = 0
const BI_BITFIELDS = 3

'BITMAPFILEHEADER ONLY (14 bytes)
type bitmap_file_header field = 1
	bfType          as ushort
	bfSize          as ulong
	bfReserved1     as ushort
	bfReserved2     as ushort
	bfOffBits       as ulong
end type

'BITMAPV5HEADER 124 bytes
type bitmap_info_header_v5 field = 1
	biSize          as ulong
	biWidth         as ulong
	biHeight        as ulong
	biPlanes        as ushort
	biBitCount      as ushort
	biCompression   as ulong
	biSizeImage     as ulong
	biXPelsPerMeter as ulong
	biYPelsPerMeter as ulong
	biClrUsed       as ulong
	biClrImportant  as ulong
	redMask         as ulong
	greenMask       as ulong
	blueMask        as ulong
	alphaMask       as ulong
	csType          as ulong
	endPoints(0 to 8) as ulong '36 bytes (CIEXYZTRIPLE)
	gammaRed        as ulong
	gammaGreen      as ulong
	gammaBlue       as ulong
	'addition:
	intent          as ulong 'Rendering intent enum
	profileData     as ulong
	profileSize     as ulong
	reserved        as ulong
end type

function image2bitmap(filename as const string, pImg as any ptr) as integer
	dim as integer w, h, bypp, pitch
	dim as any ptr pPixData
	if imageInfo (pImg, w, h, bypp, pitch, pPixData) <> 0 then return -1
	if bypp <> 4 then return -2 'for 32 bit only
	dim as bitmap_file_header bmpFileHdr
	dim as bitmap_info_header_v5 bmpInfoHdr
	with bmpFileHdr
		.bfType = &h4D42
		.bfSize = sizeof(bmpFileHdr) + sizeof(bmpInfoHdr) + w * h * bypp
		.bfOffBits = sizeof(bmpFileHdr) + sizeof(bmpInfoHdr)
	end with
	with bmpInfoHdr
		.biSize = sizeof(bmpInfoHdr)
		.biWidth = w
		.biHeight = h '-h 'up-side-down
		.biPlanes = 1
		.biBitCount = 32
		.biCompression = BI_BITFIELDS
		.biSizeImage = w * h * bypp
		.biXPelsPerMeter = 2835 '72 DPI
		.biYPelsPerMeter = 2835 '72 DPI
		.redMask   = &h00FF0000 'big-endian 
		.greenMask = &h0000FF00 'big-endian 
		.blueMask  = &h000000FF 'big-endian 
		.alphaMask = &hFF000000 'big-endian 
		.csType = &h73524742 'sRGB
		.intent = 0
	end with
	if fileExists(fileName) then return -3 'don't overwrite
	dim as integer f = freeFile()
	if open(fileName, for binary, as #f) <> 0 then return -4 'file open error
		put #f, ,bmpFileHdr
		put #f, ,bmpinfoHdr
		'write rows in reverse order w.r.t image in memory
		pPixData += (h * pitch)
		for row as integer = 0 to h - 1
			pPixData -= pitch
			put #f, ,*cptr(ulong ptr, pPixData), w
		next
		'put #f, ,*cptr(ulong ptr, pPixData), w * h
	close #f
	return 0 'ok
end function

const SCR_W = 800, SCR_H = 600, SCR_BPP = 32
screenres SCR_W, SCR_H, SCR_BPP,,FB.GFX_ALPHA_PRIMITIVES 'to make circle work with alpha???

const IMG_W = 300, IMG_H = 200
dim as FB.image ptr pImage = imageCreate(IMG_W, IMG_H, rgba(255, 0, 0, 100)) 'red
'Draw checker board
for x as integer = 0 to (SCR_W - 1) \ 10
	for y as integer = 0 to (SCR_H - 1) \ 10
		dim as ulong c = iif((x+y) and 1, rgba(200, 200, 200, 255), rgba(50, 50, 50, 255))
		line(x*10,y*10)-step(8,8),c,bf
	next
next
'Draw some transparant circles (on image)
circle pImage, (IMG_W\2, IMG_H\2), IMG_H\3, rgba(255, 0, 0, 200),,,,f 'red
'show image on screen
put (50, 50), pImage, alpha
'save to bitmap
bsave("image_bsave.bmp", pImage)
dim as integer result
result = image2bitmap("image_badidea.bmp", pImage)
select case result
	case  0: print "Ok, image saved"
	case -1: print "Error, invalid image"
	case -2: print "Error, not 32 bit"
	case -3: print "Error, file exists"
	case -4: print "Error, opening file"
	case else: print "Unknown error"
end select
'clean up
imagedestroy(pImage)

dim as FB.image ptr pImage1 = imageCreate(IMG_W, IMG_H)
bload("image_bsave.bmp", pImage1)
put (50, 350), pImage1, alpha
imagedestroy(pImage1)

dim as FB.image ptr pImage2 = imageCreate(IMG_W, IMG_H)
bload("image_badidea.bmp", pImage2)
put (450, 350), pImage2, alpha
imagedestroy(pImage2)

getkey()
end
dodicat
Posts: 8136
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Bug with BSAVE?

Post by dodicat »

Do you mean the OS viewers give different images of fb origin, photo/gimp ...?
But fb behaves as expected with bsave/bload without using external apps.
badidea
Posts: 2605
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Bug with BSAVE?

Post by badidea »

Yes, the 2 images ("image_bsave.bmp" and "image_badidea.bmp") are different when viewed with .e.g MS paint or Gimp. (I don't have the possibility any more to quickly link an image for clarification).

I think that freebasic does not follow the specification for BMP file format (how to interpret the data). But at the same time, there is not really a strict specification for the BMP file format, I guess. It can cause confusing situations. A case of 'what you see, is not what you get'.
dodicat
Posts: 8136
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Bug with BSAVE?

Post by dodicat »

Using the text mode _bload and _bsave doesn't seem to use .bmp header at all, nothing from photos here, and the getsize sub gets zero when it reads the header.

Code: Select all

'from help file:
Sub _bsave( file As String, p As Any Ptr, sz As Integer ) 
    
    Dim As Long ff 
    ff = Freefile 
    
    Open file For Binary As ff 
    fb_fileput( ff, 0, Byval p, sz ) 
    
    Close 
    
End Sub 

Sub _bload( file As String, p As Any Ptr ) 
    
    Dim As Long ff 
    ff = Freefile 
    
    Open file For Binary As ff 
    fb_fileget( ff, 0, Byval p, Lof( ff ) ) 
    
    Close 
    
End Sub


Sub getsize(bmp As String,Byref w As Long,Byref h As Long)
    Open bmp For Binary As #1
    Get #1, 19, w
    Get #1, 23, h
    Close #1
End Sub

Screen 19,32,,64
Dim As Any Ptr i=Imagecreate(800,600,rgb(0,20,50))
Dim As Long sz
Imageinfo i,,,,,,sz
Print"image size ";sz
Circle i,(300,300),200,Rgba(Rnd*255,Rnd*255,Rnd*255,100),,,,f
Circle i,(500,300),200,Rgba(Rnd*255,Rnd*255,Rnd*255,100),,,,f
Put(0,0),I,Pset
Print "press a key"
Sleep
Screen 0
Print "using _bsave now"
_bsave("twocircles.bmp",i,sz)
Dim As Long w,h
getsize("twocircles.bmp",w,h)
Print w,h
Print "press a key"
Sleep


Screen 19,32
Dim As Any Ptr p=Imagecreate(800,600)
_bload "twocircles.bmp",p
Put(0,0),p,Pset

Sleep

 
Windows of course here.
Post Reply