Palette Mapped / Raster Bar Examples
Here we have a classic effect recreated using the palette mapped functions. The palette mapped screen is 16bit, so we've 2^16 unique colours where each colour is 32bit. In the demo i'm only using two colours. Colour 0 (the background) and colour 1 the circle colour or foreground colour. When the screen image is rendered out, either the foreground or back ground colours are changed each scan line (left mouse button). This gives us a pretty approximation of classic raster programming without having count a single a cycle.
Example built with PlayBASIC V1.64O Beta 15
[pbcode]
#include "PaletteMapping"
Dim Palette($10000)
SetPalette(Palette())
Palette(1) = $ff0000
Dim Raster(GetScreenHeight()*2)
Dim MasterRaster(0)
for lp =0 to 30
Ypos=DRaw_Raster_Bar(Ypos,32)
next
MasterRaster()=Raster()
Screen=CreateScreen(800,600)
// -------------------------------------------------------------------
// -[ Main Loop ]-----------------------------------------------------
// -------------------------------------------------------------------
Do
rendertoimage Screen
// draw the scene
cls 0
// draw the user object as colour index #1, so this object will
// have raster bars through it, when the mouse button is pressed
Circlec Mousex(),mousey(),230,true,IndexToRgb(1)
RenderScreen(Screen,Xpos,Ypos,Palette())
CopyArrayCells MasterRaster(),RasterBarOffset,1,Raster(),0,1,GetScreenHeight()
RasterBarOffset=mod(RasterBarOffset+1,600)
sync
loop
// -------------------------------------------------------------------
// -[ Main Loop ]-----------------------------------------------------
// -------------------------------------------------------------------
Psub Draw_Raster_Bar(Ypos,Height)
Colour=rndrgb()
scaler#=(180.0/Height)
For lp=0 to Height
Angle#=scaler#*lp
if Ypos>=0
Raster(ypos)=rgbfade(COlour,sin(Angle#)*100)
endif
Ypos++
next
EndPsub Ypos
// -------------------------------------------------------------------
// -[ Create A 16bit surface for the palette mapped Screen]-----------
// -------------------------------------------------------------------
Psub CreateScreen(Width,Height)
; the
local ThisIMage=GetFreeImage()
CreateFXImageEx ThisImage,Width,Height,16
EndPsub ThisImage
// -------------------------------------------------------------------
// - Draw the Screen -----------
// -------------------------------------------------------------------
Psub RenderScreen(Screen,Xpos,Ypos,Palette())
rendertoscreen
PalettePtr=GetarrayPtr(Palette(),true)
RenderScreenUSerPalette(Screen,Xpos,Ypos,PalettePtr)
EndPsub
Psub RenderScreenUSerPalette(Screen,Xpos,Ypos,PalettePtr)
if GetImageStatus(Screen) and Screen>0
if GetImageDepth(Screen)=16
SetPalettePtr PalettePtr
oldSurface=GetSurface()
rendertoimage Screen
lockbuffer
thisrgb=point(0,0)
Width =GetImageWidth(Screen)
HEight=GetImageHeight(Screen)
Ptr =GetImageptr(Screen)
Modulo=GetImagePitch(Screen)
unlockbuffer
rendertoimage OldSurface
lockbuffer
thisrgb=point(0,0)
ColourIndex=LeftMouseButton()=0
For ypos =0 to Height-1
// Change the palette every scan line, dynamically reusing the colour register
Palette(ColourINdex) =Raster(ypos)
// render this scan line out the screen with this colour set
DrawPaletteMappedStrip16(0,ypos,Ptr,Width,$ffff)
ptr+=Modulo
next
unLockbuffer
endif
endif
EndPsub
[/pbcode]
Classic Glenz Vector
Glenz Vectors are by product of bitplanes and palette mapping. Since we have Palette Mapping now, we can actually create such an effect using the OR inkmode.
Here we're drawing the 3 overlapping circles. The circle one the left is drawn in Palette Index colour 1, The one on the right is drawn in colour 2 and the foreground one is drawn in colour 4. So each is on separate bitplane, we've 16 possible bitplanes in a 16bit palette mapped image.
In this first example, we're only setting the palette colours 1,2 and 4. So when any pixel overlaps what happens is the bits are or'd together and we end up with the result. Or is bitwise rule, but if you're not familiar with it you can substube "ADD" in this case. Since when we drawn colour 1 and colour 2 over each other. We end with colour 3. Colour 3 in the palette is black so we get a black output.. If all thread overlap, the pixel colours will be 7 (1+2+4), which is also black..
[pbcode]
#include "PaletteMapping"
Dim Palette($10000)
SetPalette(Palette())
// Set up the palette
Palette(1) = $ff0000
Palette(2) = $00ff00
Palette(4) = $0000ff
Screen=CreateScreen(800,600)
// -------------------------------------------------------------------
// -[ Main Loop ]-----------------------------------------------------
// -------------------------------------------------------------------
Do
rendertoimage Screen
// draw the scene
cls 0
if mousebutton()=0
inkmode 1+512
endif
; or the left circle
Circlec 200,300,230,true,IndexToRgb(2)
; or the right circle
Circlec 600,300,230,true,IndexToRgb(4)
// draw the user object as colour index #1
Circlec Mousex(),mousey(),230,true,IndexToRgb(1)
inkmode 1
RenderScreen(Screen,Xpos,Ypos,Palette())
sync
loop
// -------------------------------------------------------------------
// -[ Create A 16bit surface for the palette mapped Screen]-----------
// -------------------------------------------------------------------
Psub CreateScreen(Width,Height)
; the
local ThisIMage=GetFreeImage()
CreateFXImageEx ThisImage,Width,Height,16
EndPsub ThisImage
// -------------------------------------------------------------------
// - Draw the Screen -----------
// -------------------------------------------------------------------
Psub RenderScreen(Screen,Xpos,Ypos,Palette())
rendertoscreen
PalettePtr=GetarrayPtr(Palette(),true)
RenderScreenUSerPalette(Screen,Xpos,Ypos,PalettePtr)
EndPsub
Psub RenderScreenUSerPalette(Screen,Xpos,Ypos,PalettePtr)
if GetImageStatus(Screen) and Screen>0
if GetImageDepth(Screen)=16
SetPalettePtr PalettePtr
oldSurface=GetSurface()
rendertoimage Screen
lockbuffer
thisrgb=point(0,0)
Width =GetImageWidth(Screen)
HEight=GetImageHeight(Screen)
Ptr =GetImageptr(Screen)
Modulo=GetImagePitch(Screen)
unlockbuffer
rendertoimage OldSurface
lockbuffer
thisrgb=point(0,0)
ColourIndex=LeftMouseButton()=0
For ypos =0 to Height-1
DrawPaletteMappedStrip16(0,ypos,Ptr,Width,$ffff)
ptr+=Modulo
next
unLockbuffer
endif
endif
EndPsub
[/pbcode]
In this version we've defined the resulting colours as 50% blend between the bitplanes. So colour 3 in the palette is the combination of colour 1 and colour 2. Colour 5 is the combination of colour 1+4, Colour 6 ='s Colour 2 +4 and colour 7 is all three blended together.
[pbcode]
#include "PaletteMapping"
Dim Palette($10000)
SetPalette(Palette())
// Set up the palette
Palette(1) = $ff0000
Palette(2) = $00ff00
Palette(4) = $0000ff
// create mixed colours combo's
Palette(3)=rgbalpha50(Palette(1),Palette(2))
Palette(5)=rgbalpha50(Palette(1),Palette(4))
Palette(6)=rgbalpha50(Palette(2),Palette(4))
Palette(7)=rgbalpha50(Palette(5),Palette(6))
Screen=CreateScreen(800,600)
// -------------------------------------------------------------------
// -[ Main Loop ]-----------------------------------------------------
// -------------------------------------------------------------------
Do
rendertoimage Screen
// draw the scene
cls 0
if mousebutton()=0
inkmode 1+512
endif
; or the left circle
Circlec 200,300,230,true,IndexToRgb(2)
; or the right circle
Circlec 600,300,230,true,IndexToRgb(4)
// draw the user object as colour index #1
Circlec Mousex(),mousey(),230,true,IndexToRgb(1)
inkmode 1
RenderScreen(Screen,Xpos,Ypos,Palette())
sync
loop
// -------------------------------------------------------------------
// -[ Create A 16bit surface for the palette mapped Screen]-----------
// -------------------------------------------------------------------
Psub CreateScreen(Width,Height)
; the
local ThisIMage=GetFreeImage()
CreateFXImageEx ThisImage,Width,Height,16
EndPsub ThisImage
// -------------------------------------------------------------------
// - Draw the Screen -----------
// -------------------------------------------------------------------
Psub RenderScreen(Screen,Xpos,Ypos,Palette())
rendertoscreen
PalettePtr=GetarrayPtr(Palette(),true)
RenderScreenUSerPalette(Screen,Xpos,Ypos,PalettePtr)
EndPsub
Psub RenderScreenUSerPalette(Screen,Xpos,Ypos,PalettePtr)
if GetImageStatus(Screen) and Screen>0
if GetImageDepth(Screen)=16
SetPalettePtr PalettePtr
oldSurface=GetSurface()
rendertoimage Screen
lockbuffer
thisrgb=point(0,0)
Width =GetImageWidth(Screen)
HEight=GetImageHeight(Screen)
Ptr =GetImageptr(Screen)
Modulo=GetImagePitch(Screen)
unlockbuffer
rendertoimage OldSurface
lockbuffer
thisrgb=point(0,0)
ColourIndex=LeftMouseButton()=0
For ypos =0 to Height-1
DrawPaletteMappedStrip16(0,ypos,Ptr,Width,$ffff)
ptr+=Modulo
next
unLockbuffer
endif
endif
EndPsub
[/pbcode]
Classic Glenz Vector Cube
This is bit of cut'n'paste from the scrolling cube demo in the project pack and the examples above.
[pbcode]
setfps 60
#include "PaletteMapping"
Dim Palette($10000)
SetPalette(Palette())
// Set up the palette
Palette(1) = $ff0000
Palette(2) = $00ff00
Palette(4) = $0000ff
// create mixed colours combo's
Palette(3)=rgbalpha50(Palette(1),Palette(2))
Palette(5)=rgbalpha50(Palette(1),Palette(4))
Palette(6)=rgbalpha50(Palette(2),Palette(4))
Palette(7)=rgbalpha50(Palette(5),Palette(6))
Screen=CreateScreen(800,600)
Rem create some space for the vertex and face data
Dim points#(8,3)
Dim faces(6,5)
Rem read in the vertex data
For p = 1 To 8
points#(p,1) = ReadData()
points#(p,2) = ReadData()
points#(p,3) = ReadData()
Next p
Rem Read in the face Data
For f = 1 To 6
faces(f,1) = ReadData()
faces(f,2) = ReadData()
faces(f,3) = ReadData()
faces(f,4) = ReadData()
faces(f,5) = ReadData()
Next f
Rem some space To put the rotated points
Dim rotated#(8,3)
// -------------------------------------------------------------------
// -[ Main Loop ]-----------------------------------------------------
// -------------------------------------------------------------------
Do
rendertoimage Screen
// draw the scene
cls 0
if mousebutton()=0
inkmode 1+512
endif
Rotate_Vertex()
Draw_Object()
inkmode 1
RenderScreen(Screen,Xpos,Ypos,Palette())
sync
loop Esckey()=true
End
// -------------------------------------------------------------------
// -[ Create A 16bit surface for the palette mapped Screen]-----------
// -------------------------------------------------------------------
Psub CreateScreen(Width,Height)
; the
local ThisIMage=GetFreeImage()
CreateFXImageEx ThisImage,Width,Height,16
EndPsub ThisImage
// -------------------------------------------------------------------
// - Draw the Screen -----------
// -------------------------------------------------------------------
Psub RenderScreen(Screen,Xpos,Ypos,Palette())
rendertoscreen
PalettePtr=GetarrayPtr(Palette(),true)
RenderScreenUSerPalette(Screen,Xpos,Ypos,PalettePtr)
EndPsub
Psub RenderScreenUSerPalette(Screen,Xpos,Ypos,PalettePtr)
if GetImageStatus(Screen) and Screen>0
if GetImageDepth(Screen)=16
SetPalettePtr PalettePtr
oldSurface=GetSurface()
rendertoimage Screen
lockbuffer
thisrgb=point(0,0)
Width =GetImageWidth(Screen)
HEight=GetImageHeight(Screen)
Ptr =GetImageptr(Screen)
Modulo=GetImagePitch(Screen)
unlockbuffer
rendertoimage OldSurface
lockbuffer
thisrgb=point(0,0)
For ypos =0 to Height-1
DrawPaletteMappedStrip16(0,ypos,Ptr,Width,$ffff)
ptr+=Modulo
next
unLockbuffer
endif
endif
EndPsub
; ----------------------------------------------------------------------------
psub Rotate_Vertex()
; ----------------------------------------------------------------------------
Rem animate the tilt, turn And roll values
tilt# = tilt#+1.01
turn# = turn#+1.02
roll# = roll#+1.03
Rem variables which control the size of the cube
x_scale# = 100.0
y_scale# = 100.0
z_scale# = 100.0
Rem prepare the rotation matrix
A#=Cos(tilt#):B#=Sin(tilt#)
C#=Cos(turn#):D#=Sin(turn#)
E#=Cos(roll#):F#=Sin(roll#)
AD#=A#*D#
BD#=B#*D#
; Calc Rotation Martrix
m11#=C#*E#
m21#=-1*C#*F#
m31#=D#
m12#=BD#*E#+A#*F#
m22#=-1*BD#*F#+A#*E#
m32#=-1*B#*C#
m13#=-1*AD#*E#+B#*F#
m23#=AD#*F#+B#*E#
m33#=A#*C#
Rem rotate all the points using the matrix
For p=1 To 8
; grab the XYZ of this vertex
pointx#=points#(p,1)
pointy#=points#(p,2)
pointz#=points#(p,3)
rotated#(p,1) = (m11# * pointx# + m12# * pointy# + m13# * pointz#) * x_scale#
rotated#(p,2) = (m21# * pointx# + m22# * pointy# + m23# * pointz#) * y_scale#
rotated#(p,3) = (m31# * pointx# + m32# * pointy# + m33# * pointz#)
Rem now Do the perspective calculation
z# = rotated#(p,3) + 400.0
rotated#(p,1) = 400 + (rotated#(p,1) *400 ) / z#
rotated#(p,2) = 300 + (rotated#(p,2) *400)/ z#
Next p
endpsub
Psub Draw_Object()
Backface= getinkmode()=1
lockbuffer
For f=1 To 6
Rem p1 -> p4 are the points On the face
p1 = faces(f,1)
p2 = faces(f,2)
p3 = faces(f,3)
vx1#=rotated#(p1,1)
vy1#=rotated#(p1,2)
vx2#=rotated#(p2,1)
vy2#=rotated#(p2,2)
vx3#=rotated#(p3,1)
vy3#=rotated#(p3,2)
; if the mouse down, apply back face
if Backface
; Cross product
If (((vx2#-vx1#)*(vy3#-vy1#))-((vx3#-vx1#)*(vy2#-vy1#)))<0 then continue
endif
p4 = faces(f,4)
col = faces(f,5)
quadc vx1#,vy1#,vx2#,vy2#,vx3#,vy3#,rotated#(p4,1),rotated#(p4,2),IndextoRGB(col)
Next f
unlockbuffer
EndPsub
Rem vertex Data
Data -1,-1,-1
Data 1,-1,-1
Data 1,1,-1
Data -1,1,-1
Data -1,-1,1
Data 1,-1,1
Data 1,1,1
Data -1,1,1
Rem face Data
;right/left
Data 2,6,7,3, 1 ;RGB(180,150,230)
Data 5,1,4,8, 1 ;RGB(80,100,120)
Data 1,2,3,4, 2 ;RGB(50,70,90)
Data 6,5,8,7, 2 ;RGB(100,140,180)
; top /bot
Data 5,6,2,1, 4 ;RGB(0,100,50)
Data 4,3,7,8, 4 ;RGB(50,160,100)
[/pbcode]
Draw Palette Mapped Strip 8Bit Example
This following example create a conceptual 256 colour screen in memory (in a PlayBASIC bank). The program fills the conceptual screen with colour index byte values. These values are written to form and sinus arc (See SIN) ranging from 0 to 255, where and each row displaced by one pixel. Creating a sort of curved diagonal pattern. Each frame we colour cycle the 256 colour palette with all of the shades of the current random colour. So it appears to move, even though we never have to modify the pixel data once it's created.
[pbcode]
// Include the palette Mapping library
#include "paletteMapping"
// Define
Dim Palette(256)
SetPalette(Palette())
// ------------------------------------
// CReate a palette mapped Screen in memory
// ------------------------------------
Width=800
Height=600
// Alloc a bank that we'll use as the screen
ScreenBank=NewBank(Width*Height)
// Fill the bank with colour values..
For ylp =0 to Height-1
// Compute the address of this strip
RowAddress=GetBankPtr(ScreenBank)+Width*ylp
// Fill this row of bytes with
For Xlp=0 to Width-1
Pos=wrapvalue(Xlp+ylp,0,Width)
// Compute the colour index using sinus
ColourIndex = Sin( (180.0/Width) *Pos)* 255
// copy it to the screen buffer
PokeByte RowAddress+Xlp, ColourINdex
next
next
; Limit the program to 100 frames per second or less
Setfps 100
Do
// ------------------------------------
// Pick the Palette main colour
// ------------------------------------
if ScrollX=0
// pick a random colour that we'll use to seed the palette
ThisColour =RndRgb()
endif
// ------------------------------------
// Fill the palette with all 256 shades
// ------------------------------------
// fill the palette array with all the shades of thsi colour
For lp =0 to 255
Pos=(ScrollX+lp) and 255
Palette(pos)=RgbAlphaMult(ThisColour,rgb(lp,lp,lp))
next
// offset the palette creation it's a little more interesting
ScrollX=(ScrollX-2) and 255
// -----------------------------------------------------------
// Draw this 8bit palette mapped data to the actual screen
// -----------------------------------------------------------
Lockbuffer
; read a point from the output surface to make sure
; it's seeded for raw direct output rendering
ThisRgb=POint(0,0)
; Run down the scan lines and draw them to the screen
For ylp =0 to Height-1
// Compute the address of this strip
RowAddress=GetBankPtr(ScreenBank)+Width*ylp
DrawPaletteMappedStrip8(0,ylp,RowAddress,Width,255)
next
unLockbuffer
Sync
loop EscKey()=true
[/pbcode]
Draw Palette Mapped Strip 16Bit Example
Here's a 16bit example that's using 4096 colour palette. The screen colour indexes are set up so that each pixel on screen is the distance from the screen center. The palette created each frame from 16 banks of 256 colours. Each block of 256 colours is shaded via sinus and offset in the palette table, creating the illusion of motion.
[pbcode]
// Include the palette Mapping library
#include "paletteMapping"
// Define a palette big enough to hold 2^16 colours
Dim Palette($ffff)
SetPalette(Palette())
// ------------------------------------
// CReate a palette mapped Screen in memory
// ------------------------------------
Width=800
Height=600
// Alloc a bank that we'll use as the screen
// Each pixel is a word (2bytes) we compute
// it's size by Width * Height *2
ScreenBank=NewBank(Width*Height*2)
// calc center of surface
CentX = Width/2
CentY = Height/2
// Fill the bank with colour values..
For ylp =0 to Height-1
// Compute the address of this strip
RowAddress=GetBankPtr(ScreenBank)+(Width*2)*ylp
WidthMinus1=Width-1
// Fill this row of bytes with
For Xlp=0 to CEntX
Dist#=GetDistance2D(CentX,CentY,xlp,ylp)
ColourIndex = 4096-(Dist#*2.3)
// copy it to the screen buffer
PokeWord RowAddress+((Xlp)*2), ColourINdex
PokeWord RowAddress+((WidthMinus1-Xlp)*2), ColourINdex
next
DestAddress=GetBankPtr(ScreenBank)+(Width*2)*(Height-1-ylp)
CopyMemory RowAddress,DestAddress,Width*2
next
; Limit the program to 100 frames per second or less
Setfps 100
Dim Colours(16)
For lp =0 to 15
Colours(lp)=rndrgb()
next
Do
// ------------------------------------
// Pick the Palette main colour
// ------------------------------------
if ScrollX=0
// pick a random colour that we'll use to seed the palette
For lp =15 to 0 step -1
Colours(lp+1)=Colours(lp)
next
Colours(0)=RndRGb()
endif
// ------------------------------------
// Fill the palette with all 256 shades
// ------------------------------------
// fill the palette array with all the shades of this colour
Offset=0
For ColourBank=0 to 16
AngleScale#=(180.0/256)
ThisColour =Colours(ColourBank)
For lp =0 to 255
Level=Sin(AngleScale#*lp)*255
; scroll the data in the palette array to create motion
Palette(ScrollX+Offset)=RgbAlphaMult(ThisCOlour,rgb(Level,Level,Level))
Offset++
next
next
// offset the palette creation so it's a little more interesting
ScrollX=(ScrollX+1) and 255
// -----------------------------------------------------------
// Draw this 16bit palette mapped data to the actual screen
// -----------------------------------------------------------
Lockbuffer
; read a point from the output surface to make sure
; it's seeded for raw direct output rendering
ThisRgb=POint(0,0)
; Run down the scan lines and draw them to the screen
For ylp =0 to Height-1
// Compute the address of this strip
RowAddress=GetBankPtr(ScreenBank)+Width*2*ylp
DrawPaletteMappedStrip16(0,ylp,RowAddress,Width,$ffff)
next
unLockbuffer
Sync
loop EscKey()=true
[/pbcode]
Shadows / Recolouring
This example recreates how shadow effects are done with palette mapped displays. The example creates circular banded effect using colours 0 to 1024 in the palette much like the example above. The first 1024 colours are considered the standard colours in our mock up scene, but the creation palette routine also fills in alternatives colours between 1024 and 2048. So our screen is using the first 1024 colours, to swap any pixel to the second bank we use the OR inkmode and OR the pixels with 1024. This effectively make those pixels colour index be in the 1024 to 2048 range. so they appear completely different colours. To make shadows we would 1/2 or dim the brightness of those colours.
[pbcode]
// Include the palette Mapping library
#include "PaletteMapping"
// Define a palette big enough to hold 2^16 colours
Dim Palette($10000)
// Give palette mapping library address of the palette
// we're using.
SetPalette(Palette())
For lp=0 to 1024
Angle=mod(lp,180)
Level=127+Sin(Angle)*127
Level=Rgb(Level,LEvel,Level)
if Angle=0
ThisColour1=Rndrgb()
ThisColour2=Rndrgb()
endif
// First bank of 1024 colours
Palette(lp) =RgbAlphaMult(ThisColour1,Level)
// treat colours 1024-2048 as bank 2 of colours
Palette(1024+lp) =RgbAlphaMult(ThisColour2,Level)
next
// -----------------------------------------------------------------
// -----------------------------------------------------------------
// Create a PB image we'll be using as the Palette Mapped Display
// -----------------------------------------------------------------
// -----------------------------------------------------------------
Screen=NewPaletteMapImage(GetScreenWidth(),GetScreenHeight())
// -----------------------------------------------------------------
//
// -----------------------------------------------------------------
rendertoimage Screen
lockbuffer
thisrgb=point(0,0)
CentX=GetScreenWidth()/2
CentY=GetScreenHeight()/2
For ylp=0 to GetScreenHeight()/2-1
For Xlp=0 to GetScreenWidth()-1
Dist=GetDistance2d(xlp,ylp,CentX,CentY)
PaletteMappedDot(xlp,ylp,Dist*1.5)
next
CopyRect Screen,0,ylp,GetScreenWidth(),ylp+1,Screen,0,599-ylp
next
unlockbuffer
CopyOfScreen=GetFreeimage()
CopyIMage Screen,CopyOfScreen
Do
// direct all Pb rendering to out screen image
RenderToimage Screen
// draw a clone of the screen image to our screen
DrawImage CopyOfScreen,0,0,false
mx =mousex()
my =mousey()
// Set the drawing pens ink mode to OR mode
InkMode 1+512
// draw circle over the frame. So we're OR's the value
// 4096 to the colour indexes in this frame.
// So those pixels will now bew drawn in colours 1024 to 2048
// instead of 00 to 1024
Circlec mx,my,200,true, indexToRgb(1024)
// restore normal ink mode
inkmode 1
// render our palette mapped screen to the actual screen
rendertoscreen
RenderPaletteMapImage(Screen,0,0)
// show everything to the user
Sync
loop esckey()=true
[/pbcode]
Looks very nice!