05-01-2022, 05:45 AM
And, after much brain melting, I think I've finally pieced together a suitable method to convert 32-bit images down to 256 colors for use with QB64. Needless to say, you'll need the attached files to run this demo:
As this works, it does 3 things for us:
First, it checks to see if the image has 256 colors or less in it.
If it does, then it checks to see if those 256 colors match the original QB64 256 color palette. If they do, we convert the image to a standard QB64 256-color image, and at this point you can work with it with the normal color values you know and love.
If there's colors which aren't in the QB64 standard palette, then it alters the palette to match the image and then converts it to work with that palette. (How you'd know what colors are what, I dunno, but I'll leave that up to the end user to sort out. I suppose if you have a palette which you normally use, you could scan the colors in this one and swap them back and forth with the ones which you normally use, until the values match as originally intended.)
The results seem more than reasonable to me, and this will be a tool which I'll probably make use of quite a bit in the future. With it, loading and using 256 color images are now available once again with QB64!
[i][b]NOTE: Don't forget the attached files![/b][/i]
In the demo, the first pass uses the standard QB64 256 color palette. As you notice, the white text which we print to the screen with, continues to remain white, with no issues.
The second pass uses a random set of colors, which certainly won't match the standard 256 color palette, forcing us to save the palette in use, which (more than likely) is going to change the default value of white. The text which pops up in the top left of the converted screen is going to whatever the NEW palette tells us white is, for that image.
The third pass takes a large numbers of colors, dithers them down to 256 colors, and then saves the palette for them as closely as possible to the original. Since we attempted to save the image, converted down using the QB64 standard palette, the colors should be the ones that you're used to seeing normally. The white text should still look white, just as normal for us.
Play around with it. Kick it about a bit. See how it performs for you, and if there's any issues or problems.
And don't forget to thank RhoSigma, whose graphic library I borrowed (stole really
) heavily from to get this working the way it is now.
Code: (Select All)
_Define A-Z As _UNSIGNED LONG
ws = _NewImage(640, 480, 32) 'A 32 bit screen
ts = _NewImage(640, 480, 256) 'A 256 color screen, which is only used so I can get the standard 256 color paletter from it.
Screen ws
Randomize Timer
Dim color256 As _Unsigned Long
Const ConvertToStandard256Palette = -1 'Change to 0 and you can see that we preseve the second pass's
' color information perfectly.
' If the CONST is set, then we convert our colors on the screen
' to as close of a match as possible, while preserving the standard
' QB64 256-color palette.
Cls , _RGB32(0, 0, 0)
For j = 1 To 2
If j = 1 Then
For i = 1 To 100 '100 random colors
'if we want to use the standard 256 color screen palette, we can do so as below
color256 = _RGB32(_Red(i, ts), _Green(i, ts), _Blue(i, ts))
Line (Rnd * 640, Rnd * 480)-(Rnd * 640, Rnd * 480), color256, BF
Next
Else 'we can go with completely random colors with the following instead:
For i = 1 To 100 '100 random colors
Line (Rnd * 640, Rnd * 480)-(Rnd * 640, Rnd * 480), &HF0000000 + Rnd * &HFFFFFFF, BF
Next
End If
Print "This is the original screen, pass"; j
Sleep 'show the original screen
t = Image32To256(ws)
Screen t 'show the standard 256 image screen with the image converted over
' this keeps us from having to learn or use any new/unique palettes the image may have
' but, it does cause us to lose details and hues.
Print "This is the 256-color screen, pass"; j
Sleep
Screen ws
_FreeImage t
Cls
Next
l = _LoadImage("Beautiful_colorful_bird_wallpaper01.jpg", 32)
Screen l
_ScreenMove 0, 0 'move the screen to use as much of the screen as possible, since it's so damn huge!
Print "This is the original 32-bit screen."
Sleep 'to show the 32-bit image of the colorful bird I found
t = Image32To256(l)
Screen t 'show the 256 image screen with the image converted over
_ScreenMove 0, 0 'move this one too!
Print "This is the converted 256 color screen."
'And we're done. You should now be seeing a pretty little 256 color version of the bird
Function Image32To256 (image&)
Dim o As _Offset
Dim a As _Unsigned _Byte, r As _Unsigned _Byte
Dim g As _Unsigned _Byte, b As _Unsigned _Byte
Dim t As _Unsigned Long, color256 As _Unsigned Long
Dim index256 As _Unsigned Long
Type Pal_type
c As _Unsigned Long 'color index
n As Long 'number of times it appears
End Type
Dim Pal(255) As _Unsigned Long
I256 = _NewImage(_Width(image&), _Height(image&), 256)
Dim m(1) As _MEM: m(0) = _MemImage(image&): m(1) = _MemImage(I256)
Do 'get the palette and number of colors used
_MemGet m(0), m(0).OFFSET + o, t 'Get the colors from the original screen
For i = 0 To colors 'check to see if they're in the existing palette we're making
If Pal(i) = t Then Exit For
Next
If i > colors Then
Pal(colors) = t
colors = colors + 1 'increment the index for the new color found
If colors > 255 Then 'no need to check any further; it's not a normal QB64 256 color image
Image32To256 = RemapImageFS(image&, I256)
_FreeImage I256
_MemFree m()
Exit Function 'and we're done, with 100% image compatability saved
End If
End If
o = o + 4
Loop Until o >= m(0).SIZE
' we might be working with a standard qb64 256 color screen
' check for that first
colors = colors - 1 'back up one, as we found our limit and aren't needing to set another
For i = 0 To colors 'comparing palette against QB64 256 color palette
t = Pal(i)
index256 = _RGBA(_Red(t), _Green(t), _Blue(t), _Alpha(t), I256)
color256 = _RGBA32(_Red(index256, I256), _Green(index256, I256), _Blue(index256, I256), _Alpha(index256, I256))
If t <> color256 Then NSCU = -1: Exit For
Next
If NSCU Then 'it's not a standard QB64 256 color palette, but it's still less than 256 total colors.
If ConvertToStandard256Palette Then
TI256 = RemapImageFS(image&, I256)
_MemFree m(1) 'free the old memory
_FreeImage I256 'and the old image
I256 = TI256 'replace with the new image
m(1) = _MemImage(I256) 'and point the mem block to the new image
Else
For i = 0 To colors: _PaletteColor i, Pal(i), I256: Next 'set the palette
End If
End If
'If we didn't change the palette above, we should work 100% with qb64's internal 256 color palette
o = 0
Do 'Get the colors, put them to a 256 color screen, as is
_MemGet m(0), m(0).OFFSET + o + 3, a
_MemGet m(0), m(0).OFFSET + o + 2, r
_MemGet m(0), m(0).OFFSET + o + 1, g
_MemGet m(0), m(0).OFFSET + o + 0, b
_MemPut m(1), m(1).OFFSET + o \ 4, _RGBA(r, g, b, a, I256) As _UNSIGNED _BYTE
o = o + 4
Loop Until o >= m(0).SIZE
_MemFree m()
Image32To256 = I256
End Function
Function RemapImageFS& (ohan&, dhan&)
RemapImageFS& = -1 'so far return invalid handle
shan& = ohan& 'avoid side effect on given argument
If shan& < -1 Then
'--- check/adjust source image & get new 8-bit image ---
swid% = _Width(shan&): shei% = _Height(shan&)
If _PixelSize(shan&) <> 4 Then
than& = _NewImage(swid%, shei%, 32)
If than& >= -1 Then Exit Function
_PutImage , shan&, than&
shan& = than&
Else
than& = -1 'avoid freeing below
End If
nhan& = _NewImage(swid%, shei%, 256)
'--- Floyd-Steinberg error distribution arrays ---
rhan& = _NewImage(swid%, 2, 32) 'these are missused as LONG arrays,
ghan& = _NewImage(swid%, 2, 32) 'with CHECKING:OFF this is much faster
bhan& = _NewImage(swid%, 2, 32) 'than real QB64 arrays
'--- curr/next row offsets (for distribution array access) ---
cro% = 0: nro% = swid% * 4 'will be swapped after each pixel row
'--- the matrix values are extended by 16384 to avoid slow floating ---
'--- point ops and to allow for integer storage in the above arrays ---
'--- also it's a power of 2, which may be optimized into a bitshift ---
seven% = (7 / 16) * 16384 'X+1,Y+0 error fraction
three% = (3 / 16) * 16384 'X-1,Y+1 error fraction
five% = (5 / 16) * 16384 'X+0,Y+1 error fraction
one% = (1 / 16) * 16384 'X+1,Y+1 error fraction
'--- if all is good, then start remapping ---
$Checking:Off
If nhan& < -1 And rhan& < -1 And ghan& < -1 And bhan& < -1 Then
_CopyPalette dhan&, nhan& 'dest palette to new image
'--- for speed we do direct memory access ---
Dim sbuf As _MEM: sbuf = _MemImage(shan&): soff%& = sbuf.OFFSET
Dim nbuf As _MEM: nbuf = _MemImage(nhan&): noff%& = nbuf.OFFSET
Dim rbuf As _MEM: rbuf = _MemImage(rhan&): roff%& = rbuf.OFFSET
Dim gbuf As _MEM: gbuf = _MemImage(ghan&): goff%& = gbuf.OFFSET
Dim bbuf As _MEM: bbuf = _MemImage(bhan&): boff%& = bbuf.OFFSET
'--- iterate through pixels ---
For y% = 0 To shei% - 1
For x% = 0 To swid% - 1
'--- curr/prev/next pixel offsets ---
cpo% = x% * 4: ppo% = cpo% - 4: npo% = cpo% + 4
'--- get pixel ARGB value from source ---
srgb~& = _MemGet(sbuf, soff%&, _Unsigned Long)
'--- add distributed error, shrink by 16384, clear error ---
'--- current pixel X+0, Y+0 (= cro% (current row offset)) ---
poff% = cro% + cpo% 'pre-calc full pixel offset
sr% = ((srgb~& And &HFF0000~&) \ 65536) + (_MemGet(rbuf, roff%& + poff%, Long) \ 16384) 'red
sg% = ((srgb~& And &HFF00~&) \ 256) + (_MemGet(gbuf, goff%& + poff%, Long) \ 16384) 'green
sb% = (srgb~& And &HFF~&) + (_MemGet(bbuf, boff%& + poff%, Long) \ 16384) 'blue
_MemPut rbuf, roff%& + poff%, 0 As LONG 'clearing each single pixel error using _MEMPUT
_MemPut gbuf, goff%& + poff%, 0 As LONG 'turns out even faster than clearing the entire
_MemPut bbuf, boff%& + poff%, 0 As LONG 'pixel row using _MEMFILL at the end of the loop
'--- find nearest color ---
crgb~& = _RGBA32(sr%, sg%, sb%, 0) 'used for fast value clipping + channel merge
npen% = _RGB(sr%, sg%, sb%, nhan&)
'--- put colormapped pixel to dest ---
_MemPut nbuf, noff%&, npen% As _UNSIGNED _BYTE
'------------------------------------------
'--- Floyd-Steinberg error distribution ---
'------------------------------------------
'--- You may comment this block out, to see the
'--- result without applied FS matrix.
'-----
'--- get dest palette RGB value, calc error to clipped source ---
nrgb~& = _PaletteColor(npen%, nhan&)
er% = ((crgb~& And &HFF0000~&) - (nrgb~& And &HFF0000~&)) \ 65536
eg% = ((crgb~& And &HFF00~&) - (nrgb~& And &HFF00~&)) \ 256
eb% = (crgb~& And &HFF~&) - (nrgb~& And &HFF~&)
'--- distribute error according to FS matrix ---
If x% > 0 Then
'--- X-1, Y+1 (= nro% (next row offset)) ---
poff% = nro% + ppo% 'pre-calc full pixel offset
_MemPut rbuf, roff%& + poff%, _MemGet(rbuf, roff%& + poff%, Long) + (er% * three%) As LONG 'red
_MemPut gbuf, goff%& + poff%, _MemGet(gbuf, goff%& + poff%, Long) + (eg% * three%) As LONG 'green
_MemPut bbuf, boff%& + poff%, _MemGet(bbuf, boff%& + poff%, Long) + (eb% * three%) As LONG 'blue
End If
'--- X+0, Y+1 (= nro% (next row offset)) ---
poff% = nro% + cpo% 'pre-calc full pixel offset
_MemPut rbuf, roff%& + poff%, _MemGet(rbuf, roff%& + poff%, Long) + (er% * five%) As LONG 'red
_MemPut gbuf, goff%& + poff%, _MemGet(gbuf, goff%& + poff%, Long) + (eg% * five%) As LONG 'green
_MemPut bbuf, boff%& + poff%, _MemGet(bbuf, boff%& + poff%, Long) + (eb% * five%) As LONG 'blue
If x% < (swid% - 1) Then
'--- X+1, Y+0 (= cro% (current row offset)) ---
poff% = cro% + npo% 'pre-calc full pixel offset
_MemPut rbuf, roff%& + poff%, _MemGet(rbuf, roff%& + poff%, Long) + (er% * seven%) As LONG 'red
_MemPut gbuf, goff%& + poff%, _MemGet(gbuf, goff%& + poff%, Long) + (eg% * seven%) As LONG 'green
_MemPut bbuf, boff%& + poff%, _MemGet(bbuf, boff%& + poff%, Long) + (eb% * seven%) As LONG 'blue
'--- X+1, Y+1 (= nro% (next row offset)) ---
poff% = nro% + npo% 'pre-calc full pixel offset
_MemPut rbuf, roff%& + poff%, _MemGet(rbuf, roff%& + poff%, Long) + (er% * one%) As LONG 'red
_MemPut gbuf, goff%& + poff%, _MemGet(gbuf, goff%& + poff%, Long) + (eg% * one%) As LONG 'green
_MemPut bbuf, boff%& + poff%, _MemGet(bbuf, boff%& + poff%, Long) + (eb% * one%) As LONG 'blue
End If
'------------------------------------------
'--- End of FS ----------------------------
'------------------------------------------
noff%& = noff%& + 1 'next dest pixel
soff%& = soff%& + 4 'next source pixel
Next x%
tmp% = cro%: cro% = nro%: nro% = tmp% 'exchange distribution array row offsets
Next y%
'--- memory cleanup ---
_MemFree bbuf
_MemFree gbuf
_MemFree rbuf
_MemFree nbuf
_MemFree sbuf
'--- set result ---
RemapImageFS& = nhan&
nhan& = -1 'avoid freeing below
End If
$Checking:On
'--- remapping done or error, cleanup remains ---
If bhan& < -1 Then _FreeImage bhan&
If ghan& < -1 Then _FreeImage ghan&
If rhan& < -1 Then _FreeImage rhan&
If nhan& < -1 Then _FreeImage nhan&
If than& < -1 Then _FreeImage than&
End If
End FunctionAs this works, it does 3 things for us:
First, it checks to see if the image has 256 colors or less in it.
If it does, then it checks to see if those 256 colors match the original QB64 256 color palette. If they do, we convert the image to a standard QB64 256-color image, and at this point you can work with it with the normal color values you know and love.
If there's colors which aren't in the QB64 standard palette, then it alters the palette to match the image and then converts it to work with that palette. (How you'd know what colors are what, I dunno, but I'll leave that up to the end user to sort out. I suppose if you have a palette which you normally use, you could scan the colors in this one and swap them back and forth with the ones which you normally use, until the values match as originally intended.)
The results seem more than reasonable to me, and this will be a tool which I'll probably make use of quite a bit in the future. With it, loading and using 256 color images are now available once again with QB64!
[i][b]NOTE: Don't forget the attached files![/b][/i]
In the demo, the first pass uses the standard QB64 256 color palette. As you notice, the white text which we print to the screen with, continues to remain white, with no issues.
The second pass uses a random set of colors, which certainly won't match the standard 256 color palette, forcing us to save the palette in use, which (more than likely) is going to change the default value of white. The text which pops up in the top left of the converted screen is going to whatever the NEW palette tells us white is, for that image.
The third pass takes a large numbers of colors, dithers them down to 256 colors, and then saves the palette for them as closely as possible to the original. Since we attempted to save the image, converted down using the QB64 standard palette, the colors should be the ones that you're used to seeing normally. The white text should still look white, just as normal for us.
Play around with it. Kick it about a bit. See how it performs for you, and if there's any issues or problems.
And don't forget to thank RhoSigma, whose graphic library I borrowed (stole really
) heavily from to get this working the way it is now.