RGB Support in 256 Color Modes.

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
D.J.Peters
Posts: 8631
Joined: May 28, 2005 3:28
Contact:
Contact D.J.Peters

RGB Support in 256 Color Modes.

Post by D.J.Peters »

RGB colors in palette mode.

with dithering
good for 24BPP pictures in 256 color modes.

give it an try.

Joshy

Code: Select all


dim shared as integer rtab(2,16) = { {-16,  4, -1, 11,-14,  6, -3,  9,-15,  5, -2, 10,-13,  7, -4,  8},{ 15, -5,  0,-12, 13, -7,  2,-10, 14, -6,  1,-11, 12, -8,  3, -9}}
dim shared as integer gtab(2,16) = { { 11,-15,  7, -3,  8,-14,  4, -2, 10,-16,  6, -4,  9,-13,  5, -1},{-12, 14, -8,  2, -9, 13, -5,  1,-11, 15, -7,  3,-10, 12, -6,  0}}
dim shared as integer btab(2,16) = { { -3,  9,-13,  7, -1, 11,-15,  5, -4,  8,-14,  6, -2, 10,-16,  4},{  2,-10, 12, -8,  0,-12, 14, -6,  3, -9, 13, -7,  1,-11, 15, -5} }

declare sub Palette332()
declare sub rgb332 overload (byval x as single,byval y as single,byval col32 as integer)
declare sub rgb332          (byval x as single,byval y as single,byval r as integer,byval g as integer,byval b as integer)
declare sub rgb332          (byval x as single,byval y as single,byval r1 as single ,byval g1 as single ,byval b1 as single )

declare sub dither332 overload (byval x as single,byval y as single,byval col32 as integer)
declare sub dither332          (byval x as single,byval y as single,byval r as integer,byval g as integer,byval b as integer) 
declare sub dither332          (byval x as single,byval y as single,byval r1 as single ,byval g1 as single ,byval b1 as single )

'create an RRGGBB Palette (rrrgggbb)
sub Palette332()
  dim as integer i,r,g,b
  for i = 0 to 255
    r=(((i shr 5) and &H07) * 255) / 7
    g=(((i shr 2) and &H07) * 255) / 7
    b=((i        and &H03) * 255) / 3
    palette i,r,g,b
  next
end sub
'rrrrrrrrggggggggbbbbbbbb to rrrgggbb
sub rgb332(byval x as integer,byval y as integer,byval col32 as integer)
  dim as integer r,g,b
  b = col32 and &HFF:col32 = col32 shr 8
  g = col32 and &HFF:col32 = col32 shr 8
  r = col32 and &HFF
  r=r and &HE0
  g=(g and &HE0) shr 3
  b=(b and &HC0) shr 6
  col32=g or b or r
  pset(x,y),col32
end sub
'r,g,b to rrrgggbb
sub rgb332(byval x as single,byval y as single,byval r as integer,byval g as integer,byval b as integer)
  if (r > 255) then 
    r=224 ' &HE0 
  elseif r>0 then
    r=r and &HE0
  else
    r=0  
  end if
  if (g > 255) then 
    g=28 ' &HE0 shr 3
  elseif g>0 then
    g=(g and &HE0) shr 3
  else 
    g=0  
  end if
  if (b > 255) then 
    b=3 ' &HC0 shr 6
  elseif b>0 then
    b=(b and &HC0) shr 6
  else 
    b=0  
  end if
  r=r or g or b
  pset(x,y),r
end sub
'r,g,b to rrrgggbb
sub rgb332(byval x as single,byval y as single,byval r1 as single,byval g1 as single,byval b1 as single)
  dim as integer r,g,b
  r=int(255.0*r1):g=int(255.0*g1):b=int(255.0*b1)
  if (r > 255) then 
    r=224 ' &HE0 
  elseif r>0 then
    r=r and &HE0
  else
    r=0  
  end if
  if (g > 255) then 
    g=28 ' &HE0 shr 3
  elseif g>0 then
    g=(g and &HE0) shr 3
  else 
    g=0  
  end if
  if (b > 255) then 
    b=3 ' &HC0 shr 6
  elseif b>0 then
    b=(b and &HC0) shr 6
  else 
    b=0  
  end if
  r=r or g or b
  pset(x,y),r
end sub
'rrrrrrrrggggggggbbbbbbbb dithering to rrrgggbb
sub dither332(byval x as single,byval y as single,byval col32 as integer)
  
  dim as integer i,j,r,g,b
  i=int(x) mod 16:j=int(y) mod 2
 
  b = col32 and &HFF:col32 = col32 shr 8
  g = col32 and &HFF:col32 = col32 shr 8
  r = col32 and &HFF
   
  r+=rtab(j,i):g+=gtab(j,i):b+=btab(j,i)
  if (r > 255) then 
    r=224 ' &HE0 
  elseif r>0 then
    r=r and &HE0
  else
    r=0  
  end if
  if (g > 255) then 
    g=28 ' &HE0 shr 3
  elseif g>0 then
    g=(g and &HE0) shr 3
  else 
    g=0  
  end if
  if (b > 255) then 
    b=3 ' &HC0 shr 6
  elseif b>0 then
    b=(b and &HC0) shr 6
  else 
    b=0  
  end if
  col32=r or g or b
  pset (x,y),col32
end sub
'r,g,b dithering to rrrgggbb
sub dither332(byval x as single,byval y as single,byval r as integer,byval g as integer,byval b as integer)
  dim as integer i,j
  i=int(x) mod 16:j=int(y) mod 2
  r+=rtab(j,i):g+=gtab(j,i):b+=btab(j,i)
  if (r > 255) then 
    r=224 ' &HE0 
  elseif r>0 then
    r=r and &HE0
  else
    r=0  
  end if
  if (g > 255) then 
    g=28 ' &HE0 shr 3
  elseif g>0 then
    g=(g and &HE0) shr 3
  else 
    g=0  
  end if
  if (b > 255) then 
    b=3 ' &HC0 shr 6
  elseif b>0 then
    b=(b and &HC0) shr 6
  else 
    b=0  
  end if
  i=r or g or b
  pset(x,y),i
end sub

'r,g,b dithering to rrrgggbb
sub dither332(byval x as single,byval y as single,byval r1 as single,byval g1 as single,byval b1 as single)
  dim as integer i,j,r,g,b
  r=int(255.0*r1):g=int(255.0*g1):b=int(255.0*b1)
  i=int(x) mod 16:j=int(y) mod 2
  r+=rtab(i,j):g+=gtab(j,i):b+=btab(j,i)
  if (r > 255) then 
    r=224 ' &HE0 
  elseif r>0 then
    r=r and &HE0
  else
    r=0  
  end if
  if (g > 255) then 
    g=28 ' &HE0 shr 3
  elseif g>0 then
    g=(g and &HE0) shr 3
  else 
    g=0  
  end if
  if (b > 255) then 
    b=3 ' &HC0 shr 6
  elseif b>0 then
    b=(b and &HC0) shr 6
  else 
    b=0  
  end if
  i=r or g or b
  pset(x,y),i
end sub



''' main
dim as integer x,y,z,col32,r,g,b
dim as single xs,ys 

ScreenRes 640,480,8
windowtitle "press any key ..."
Palette332

for y = 0 to 255:for x = 0 to 255:rgb332    (x    ,y, x,0,0):next x,y
for y = 0 to 255:for x = 0 to 255:dither332 (x+256,y, x,0,0):next x,y 
sleep
for y = 0 to 255:for x = 0 to 255:rgb332    (x    ,y, 0,x,0):next x,y
for y = 0 to 255:for x = 0 to 255:dither332 (x+256,y, 0,x,0):next x,y 
sleep
for y = 0 to 255:for x = 0 to 255:rgb332    (x    ,y, 0,0,x):next x,y
for y = 0 to 255:for x = 0 to 255:dither332 (x+256,y, 0,0,x):next x,y 
sleep
for y = 0 to 255:for x = 0 to 255:rgb332    (x    ,y, x,x,x):next x,y
for y = 0 to 255:for x = 0 to 255:dither332 (x+256,y, x,x,x):next x,y 
sleep

for y = 0 to 255:for x = 0 to 255:rgb332    (x    ,y, x,x,0):next x,y
for y = 0 to 255:for x = 0 to 255:dither332 (x+256,y, x,x,0):next x,y 
sleep
for y = 0 to 255:for x = 0 to 255:rgb332    (x    ,y, 0,x,x):next x,y
for y = 0 to 255:for x = 0 to 255:dither332 (x+256,y, 0,x,x):next x,y 
sleep
for y = 0 to 255:for x = 0 to 255:rgb332    (x    ,y, x,0,x):next x,y
for y = 0 to 255:for x = 0 to 255:dither332 (x+256,y, x,0,x):next x,y 
sleep

for y = 0 to 255:for x = 0 to 255:rgb332    (x    ,y, x,x,255):next x,y
for y = 0 to 255:for x = 0 to 255:dither332 (x+256,y, x,x,255):next x,y 
sleep
for y = 0 to 255:for x = 0 to 255:rgb332    (x    ,y, 255,x,x):next x,y
for y = 0 to 255:for x = 0 to 255:dither332 (x+256,y, 255,x,x):next x,y 
sleep
for y = 0 to 255:for x = 0 to 255:rgb332    (x    ,y, x,255,x):next x,y
for y = 0 to 255:for x = 0 to 255:dither332 (x+256,y, x,255,x):next x,y 
sleep

for y = 0 to 255:for x = 0 to 255:rgb332    (x    ,y, x,255,255):next x,y
for y = 0 to 255:for x = 0 to 255:dither332 (x+256,y, x,255,255):next x,y 
sleep
for y = 0 to 255:for x = 0 to 255:rgb332    (x    ,y, 255,x,255):next x,y
for y = 0 to 255:for x = 0 to 255:dither332 (x+256,y, 255,x,255):next x,y 
sleep
for y = 0 to 255:for x = 0 to 255:rgb332    (x    ,y, 255,255,x):next x,y
for y = 0 to 255:for x = 0 to 255:dither332 (x+256,y, 255,255,x):next x,y 
sleep

for z=0 to 255:y=0
  for x=0 to 255:rgb332(x+z,y+z, x,y,z):next:x=0
  for y=0 to 255:rgb332(x+z,y+z, x,y,z):next
next
for y=0 to 255:for x=0 to 255:rgb332(x+z,y+z, x,y,z):next:next
sleep

for z=0 to 255
  y=0:for x=0 to 255:dither332(x+z,y+z, x,y,z):next
  x=0:for y=0 to 255:dither332(x+z,y+z, x,y,z):next
next
for y=0 to 255:for x=0 to 255:dither332(x+z,y+z, x,y,z):next x,y
sleep

for z=0 to 255:y=0
  for x=0 to 255:rgb332(x+z,y+z, z,x,y):next:x=0
  for y=0 to 255:rgb332(x+z,y+z, z,x,y):next
next
for y=0 to 255:for x=0 to 255:rgb332(x+z,y+z, z,x,y):next:next
sleep

for z=0 to 255
  y=0:for x=0 to 255:dither332(x+z,y+z, z,x,y):next
  x=0:for y=0 to 255:dither332(x+z,y+z, z,x,y):next
next
for y=0 to 255:for x=0 to 255:dither332(x+z,y+z, z,x,y):next x,y
sleep

for z=0 to 255:y=0
  for x=0 to 255:rgb332(x+z,y+z, y,z,x):next:x=0
  for y=0 to 255:rgb332(x+z,y+z, y,z,x):next
next
for y=0 to 255:for x=0 to 255:rgb332(x+z,y+z, x,z,x):next:next
sleep

for z=0 to 255
  y=0:for x=0 to 255:dither332(x+z,y+z, y,z,x):next
  x=0:for y=0 to 255:dither332(x+z,y+z, y,z,x):next
next
for y=0 to 255:for x=0 to 255:dither332(x+z,y+z, y,z,x):next x,y
windowtitle "thats all ..."
sleep
Last edited by D.J.Peters on Oct 17, 2015 23:46, edited 3 times in total.
Top
MystikShadows
Posts: 613
Joined: Jun 15, 2005 13:22
Location: Upstate NY
Contact:
Contact MystikShadows

Post by MystikShadows »

Good going :-)....seems to do a pretty good job with the dithering too...excellent :-)
Top
jofers
Posts: 1525
Joined: May 27, 2005 17:18

Post by jofers »

Heh... Good ol' 332 palettes. Reminds me of the good ol' days when I was trying to mix colors in 320x400 mode to fake 13-bit color.
Top
Adigun A. Polack
Posts: 234
Joined: May 27, 2005 15:14
Contact:
Contact Adigun A. Polack

Excellent work there, D.J.Peters! (^-^)//

Post by Adigun A. Polack »

D.J.Peters, I am gonna agree up front with both MystikShadows and Jofers. You really did quite an excellent job on your 332-based palette routines here using a 256-color mode in FB. Ahhh, I can fondly remember first watching this while checking out the Allegro lib in DOS mode quite some number of years back, man, and it was *truly* both impressive and amazing in its day, to be 100% honest with you!! ^_-=b !

Man, excellent job indeed on it, and if you want now, could you present an example of a 24-bit BMP being used for your 332 palette in a 256-color mode? I am looking forward really to seeing this type of amazing magic being done here, D.J.Peters! :D
Top
D.J.Peters
Posts: 8631
Joined: May 28, 2005 3:28
Contact:
Contact D.J.Peters

Post by D.J.Peters »

(Sorry bad english!)

hi all,
i'm work on an very large project car simulator/game and others things too and under Linux FreeBASIC GFXLIB2 can't change the videomode in higer BPP's if the dectop is in an lower BPP mode (in Windows FB use DirectX and it works).

If i write programs with pictures,overlays,textures,sprites and colorfonts i must save it in two difrent sets one with 8BPP and the other in 24BPP but that is not the only problem.

If the target dectop is in 8BPP and you use bmp's every picture has it's own color palette and you can't use two pictures with difrent pallet's together on the screen.

BLOAD is not soo good for this things.

This is why i write an independent palette support.
This night i write an DIB,DDB loader the source pictures can be in 1,4,16,256,24 BPP and the target desctop can be in 8,15,16,24,32 BPP later i will add compresses bitmaps too.

All a nice time and fun with FreeBASIC.

Joshy
Last edited by D.J.Peters on Aug 03, 2005 22:22, edited 1 time in total.
Top
v1ctor
Site Admin
Posts: 3804
Joined: May 27, 2005 8:08
Location: SP / Bra[s]il
Contact:
Contact v1ctor

Post by v1ctor »

The dithering looked great, good job.
Top
D.J.Peters
Posts: 8631
Joined: May 28, 2005 3:28
Contact:
Contact D.J.Peters

Post by D.J.Peters »

Thanx
Last edited by D.J.Peters on Jan 17, 2008 17:21, edited 2 times in total.
Top
Merri
Posts: 35
Joined: Jun 19, 2005 5:18
Location: Finland
Contact:
Contact Merri

Post by Merri »

Do I need a somewhat newer version of the compiler? I get "Expected End-of-Line, found: 'overload'

I'm using 0.13 Beta under Windows.
Top
DrV
Site Admin
Posts: 2116
Joined: May 27, 2005 18:39
Location: Midwestern USA
Contact:
Contact DrV

Post by DrV »

OVERLOAD is new in 0.14. :)
Top
Post Reply

Return to “Sources, Examples, Tips and Tricks”