I was looking through my archives today and found some very useful, old school texture blending snippets by Dr. Avalanche and Guy Savoie written a few years ago for DBC.
These were originally posted on the OLD forum. I did a search on this forum and couldn't find them, so I figured I'd post them again.
These are particularly useful for creating textures to use with a DarkBasic Matrix.
This snippet by Dr. Avalance creates 12 "smooth transitioning" gradient textures from 2 base textures.
Texture Blender:
` Texture Blender
` Original Code By: Rob Farley (Dr. Avalanche)
` Updates By: Brice N. Manuel, Jr.
`disable ESC
disable escapekey
` set to run in DX windowed mode
set window on
` set window size
set window size 640,480
` assign caption to a string
title$="Texture Blender 1.1"
` set window to use icon with min, max and close buttons
set window layout 1,1,1
` put caption in title bar of window
set window title title$
` set to manual sync
sync on
`some error trapping
`assign texture names to strings
t1$="texture1.bmp"
t2$="texture2.bmp"
`see if textures exist and handle accordingly
`see if texture1.bmp exists
if file exist(t1$)=0
`if texture1.bmp does not exist trap and exit
print "texture1.bmp was not found...":sync:sync
print "Your textures must be named texture1.bmp and texture2.bmp...":sync:sync
print "And must be in the same directory as Texture Blender...":sync:sync
print "Press any key to exit...":sync:sync
suspend for key
end
else
`if texture1.bmp is found continue
print "texture1.bmp found...":sync:sync
endif
`see if texture2.bmp exists
if file exist(t2$)=0
`if texture2.bmp does not exist trap and exit
print "texture2.bmp was not found...":sync:sync
print "Your textures must be named texture1.bmp and texture2.bmp...":sync:sync
print "And must be in the same directory as Texture Blender...":sync:sync
print "Press any key to exit...":sync:sync
suspend for key
end
else
`if texture2.bmp is found continue
print "texture2.bmp found...":sync:sync
endif
`more error trapping
`make sure tiles are square and each tile is the same size
`load textures
load bitmap "texture1.bmp", 16
load bitmap "texture2.bmp", 17
`assign texture widths and heights to variables
t1w=bitmap width(16)
t1h=bitmap height(16)
t2w=bitmap width(17)
t2h=bitmap height(17)
`delete bitmaps from memory
delete bitmap 16
delete bitmap 17
`assign texture size to variables
`t1 will be texture size for 1-256 counting
t1=t1w
`t2 will be 1 less than texture size for 0-255 counting
t2=t1-1
`make sure texture1.bmp is square
if t1w<>t1h
`if texture1.bmp is not square trap and exit
print "texture1.bmp is not square...":sync:sync
print "texture1.bmp width and height must be the same...":sync:sync
print "Press any key to exit...":sync:sync
suspend for key
end
else
`if texture1.bmp is square
print "texture1.bmp width and height match...":sync:sync
endif
`make sure texture2.bmp is square
if t2w<>t2h
`if texture2.bmp is not square trap and exit
print "texture2.bmp is not square...":sync:sync
print "texture2.bmp width and height must be the same...":sync:sync
print "Press any key to exit...":sync:sync
suspend for key
end
else
`if texture2.bmp is square
print "texture2.bmp width and height match...":sync:sync
endif
`make sure texture1.bmp and texture2.bmp are the same size
if t1w<>t2w
`if texture1.bmp and texture2.bmp are not the same size trap and exit
print "texture1.bmp and texture2.bmp are not the same size...":sync:sync
print "Textures must be the same size...":sync:sync
print "Press any key to exit...":sync:sync
suspend for key
end
else
`if texture1.bmp and texture2.bmp are the same size
print "texture1.bmp and texture2.bmp are the same size...":sync:sync
endif
`main program
Dim BITMAP(0,0)
print "Blending Textures...":sync:sync
gosub create_transitions
print "Loading Texture 1...":sync:sync
LOADBITMAP("texture1.bmp")
print "Copying Texture 1...":sync:sync
gosub image_a
print "Loading Texture 2...":sync:sync
LOADBITMAP("texture2.bmp")
print "Copying Texture 2...":sync:sync
gosub image_b
cls
create bitmap 1,t1,t1
for t=1 to 12
set current bitmap 0
ink rgb(255,255,255),0
print "Blending Texture ";t;" of 12":sync:sync
set current bitmap 1
for x=0 to t2
for y=0 to t2
reda#=rgbr(image_a(x+1,y+1))
redb#=rgbr(image_b(x+1,y+1))
greena#=rgbg(image_a(x+1,y+1))
greenb#=rgbg(image_b(x+1,y+1))
bluea#=rgbb(image_a(x+1,y+1))
blueb#=rgbb(image_b(x+1,y+1))
reda#=(reda#/t2)*trans_forms(t,x+1,y+1)
redb#=(redb#/t2)*(t2-trans_forms(t,x+1,y+1))
greena#=(greena#/t2)*trans_forms(t,x+1,y+1)
greenb#=(greenb#/t2)*(t2-trans_forms(t,x+1,y+1))
bluea#=(bluea#/t2)*trans_forms(t,x+1,y+1)
blueb#=(blueb#/t2)*(t2-trans_forms(t,x+1,y+1))
red=(reda#+redb#)
green=(greena#+greenb#)
blue=(bluea#+blueb#)
colour=rgb(red,green,blue)
ink colour,0
dot x,y
next y
next x
set current bitmap 0
ink rgb(255,255,255),0
file$=right$("00"+str$(t),2)+".bmp"
print "Saving Texture ";t;" of 12 (";file$;")":sync:sync
set current bitmap 1
save bitmap file$,1
next t
delete bitmap 1
end
rem ** load bitmap **
Function LOADBITMAP(FILE$)
Open To Read 1,FILE$
Read Word 1,FT : Read Long 1,I : Read Long 1,I : Read Long 1,I
Read Long 1,I : Read Long 1,BMPWIDTH : Read Long 1,BMPHEIGHT : Read Word 1,I
Read Word 1,BPP : Read Long 1,COMPRESSION : Read Long 1,I
Read Long 1,I : Read Long 1,I : Read Long 1,I : Read Long 1,I
If BMPWIDTH=0 Or BMPHEIGHT=0 Or FT<>19778 Then Close File 1 : Exitfunction 0
Undim BITMAP(0,0)
Dim BITMAP(BMPWIDTH,BMPHEIGHT)
BITMAP(0,0)=BMPWIDTH : BITMAP(1,0)=BMPHEIGHT : BITMAP(2,0)=BPP
If BPP<=8 : Dim COLOR((2^BPP)-1) : For I=1 To 2^BPP
Read Long 1,J : COLOR(I-1)=J : Next I : Endif
If COMPRESSION=0
PAD=(4-(Int((BMPWIDTH*BPP)/8)&3))&3 : YPOS=BMPHEIGHT
If BPP=1 : If (BMPWIDTH&7)>0 : PAD=(3&(PAD-1)) : Endif
For Y=1 To BMPHEIGHT : BIT=0 : For X=1 To BMPWIDTH
Dec BIT : If BIT=-1 Then Read Byte 1,C : BIT=7
BITMAP(X,YPOS)=COLOR((C&(2^BIT))/(2^BIT))
Next X : Dec YPOS : If PAD>0 : For I=1 To PAD
Read Byte 1,C : Next I : Endif : Next Y : Endif
If BPP=4 : If (BMPWIDTH&1)>0 : PAD=(3&(PAD-1)) : Endif
For Y=1 To BMPHEIGHT : BIT=0 : For X=1 To BMPWIDTH
Dec BIT : If BIT=-1 Then Read Byte 1,C : BIT=1
BITMAP(X,YPOS)=COLOR((C&(15*(16^BIT)))/(16^BIT))
Next X : Dec YPOS : If PAD>0 : For I=1 To PAD
Read Byte 1,C : Next I : Endif : Next Y : Endif
If BPP=8 : For Y=1 To BMPHEIGHT : For X=1 To BMPWIDTH
Read Byte 1,C : BITMAP(X,YPOS)=COLOR(C)
Next X : Dec YPOS : If PAD>0 : For I=1 To PAD
Read Byte 1,C : Next I : Endif : Next Y : Endif
If BPP=16 : For Y=1 To BMPHEIGHT : For X=1 To BMPWIDTH
Read Word 1,C : R=C&64512 : G=C&992 : B=C&31
BITMAP(X,YPOS)=Rgb(R/128,G/4,B*8)
Next X : Dec YPOS : If PAD>0 : For I=1 To PAD
Read Byte 1,C : Next I : Endif : Next Y : Endif
If BPP=24 : For Y=1 To BMPHEIGHT : For X=1 To BMPWIDTH
Read Word 1,GB : Read Byte 1,R
BITMAP(X,YPOS)=Rgb(R,0,GB)
Next X : Dec YPOS : If PAD>0 : For I=1 To PAD
Read Byte 1,C : Next I : Endif : Next Y : Endif
If BPP=32 : For Y=1 To BMPHEIGHT : For X=1 To BMPWIDTH
Read Long 1,C : BITMAP(X,YPOS)=C
Next X : Dec YPOS : Next Y : Endif
Endif
If COMPRESSION=1
X=1 : Y=BMPHEIGHT
Repeat : Read Byte 1,A : Read Byte 1,B
If A=0
If B=0 Then Dec Y : X=1
If B=2 Then Read Byte 1,C : Read Byte 1,A : Inc X,C : Dec Y,A
If B>2 : For I=1 To B : Read Byte 1,C : BITMAP(X,Y)=COLOR(C)
Inc X : Next I : If B&1 : Read Byte 1,C : Endif : Endif
Else
For I=1 To A : BITMAP(X,Y)=COLOR(B) : Inc X : Next I
Endif
Until A=0 And B=1
Endif
If COMPRESSION=2
X=1 : Y=BMPHEIGHT
Repeat : Read Byte 1,A : Read Byte 1,B
If A=0
If B=0 Then Dec Y : X=1
If B=2 Then Read Byte 1,C : Read Byte 1,A : Inc X,C : Dec Y,A
If B>2 : BIT=0 : For I=1 To B : Dec BIT : If BIT=-1 : BIT=3
Read Word 1,C : C=(C&255)*256+Int(C/256) : Endif
BITMAP(X,Y)=COLOR((C&(15*(16^BIT)))/(16^BIT)) : Inc X : Next I : Endif
Else
For I=1 To A : BIT=I&1
BITMAP(X,Y)=COLOR((B&(15*(16^BIT)))/(16^BIT))
Inc X : Next I
Endif
Until A=0 And B=1
Endif
Close File 1
Exitfunction 1
Endfunction
Function DRAWBITMAP()
For X=1 To BITMAP(0,0) : For Y=1 To BITMAP(1,0)
Ink BITMAP(X,Y),0 : Dot X-1,Y-1 : Next Y : Sync : Next X
Exitfunction 1
Endfunction
Image_A:
dim image_a(t1,t1)
For X=1 To t1 : For Y=1 To t1
image_a(x,y)=BITMAP(X,Y): Next y:next x
Return
Image_B:
dim image_b(t1,t1)
For X=1 To t1 : For Y=1 To t1
image_b(x,y)=BITMAP(X,Y): Next y:next x
Return
create_transitions:
dim trans_forms(12,t1,t1)
rem ** Horizonal and Vertical **
for x=0 to t2:for y=0 to t2
trans_forms(1,x+1,y+1)=x
trans_forms(2,x+1,y+1)=t2-x
trans_forms(3,x+1,y+1)=y
trans_forms(4,x+1,y+1)=t2-y
next y:next x
rem ** Corners **
for n=5 to 8
for x=1 to t1:for y=1 to t1
trans_forms(n,x,y)=t2
next y:next x
next n
angle#=0
for n=1 to 900
for r=0 to t2
x=int((sin(angle#)*r))
y=int((cos(angle#)*r))
trans_forms(5,x+1,y+1)=r
next r
angle#=angle#+.1
next n
for x=0 to t2:for y=0 to t2
trans_forms(6,x+1,y+1)=trans_forms(5,t1-x,y+1)
trans_forms(7,x+1,y+1)=trans_forms(5,x+1,t1-y)
trans_forms(8,x+1,y+1)=trans_forms(5,t1-x,t1-y)
trans_forms(9,x+1,y+1)=t2-trans_forms(5,x+1,y+1)
trans_forms(10,x+1,y+1)=t2-trans_forms(6,x+1,y+1)
trans_forms(11,x+1,y+1)=t2-trans_forms(7,x+1,y+1)
trans_forms(12,x+1,y+1)=t2-trans_forms(8,x+1,y+1)
next y:next x
return
This next snippet by Guy Savoie is similar in function to the one above, except instead of programatically generating the gradient mask, it uses a 3rd texture to let the user specify the gradient mask manually.
Texture Blender with Masks:
` Texture Blending Example:
` Written by Guy Savoie
` 19 April 2002
`
` Requirements: 3 bitmaps: a mask value, and 2 textures.
` They must be 24 bit bmps, and XSize evenly divisible by 4, since I didn't add odd size padding to the
` BMP decoder.
` These are acting as constant values for the color arrays.
r = 1
g = 2
b = 3
mask_file$="mask.bmp"
tex1_file$="desert.bmp"
tex2_file$="cliff.bmp"
sync on:sync rate 0 : rem Don't waste time - always turn auto sync OFF!
` There are three duplicate routines here. Normally, I would write a single function
` to save on EXE space, but since we are going for speed, it was faster to just copy
` and paste the code.
` This loads a standard 24 bit BMP file into an array. The array has THREE dimensions:
` xsize, ysize, and color element (r,b, and b)
` The xsize is stored in bytes 19-22, and need to be combined into a 4 byte integer.
` The ysize is stored in bytes 23-26, and need to be combined also.
` The offset to the rgb data is stored in bytes 11-14, and need to be combined also.
` This section loads the bmp into a raw array...
fname$ = mask_file$
size = file size(fname$)
dim bmpbytes(size)
open to read 1,fname$
for i = 1 to size:read byte 1,bmpbytes(i):next i
close file 1
` Now that it's loaded, get the XSize, the YSize, and the Data Offset.
xsize = 0:for i = 22 to 19 step -1:xsize =(xsize*256)+bmpbytes(i):next i
ysize = 0:for i = 26 to 23 step -1:ysize =(ysize*256)+bmpbytes(i):next i
doff = 0:for i = 14 to 11 step -1:doff = (doff*256)+bmpbytes(i):next i
` Now create a smaller array that we can use to store the RGB values, without having to
` offset to the headers and such...
m_xsize = xsize:m_ysize = ysize
dim mask(xsize,ysize,3)
` copy the data into the target array - note that the data is stored BGR, not RGB
dptr = doff+1
for y = 1 to ysize
for x = 0 to xsize-1
mask(x,ysize-y,b) = bmpbytes(dptr):inc dptr
mask(x,ysize-y,g) = bmpbytes(dptr):inc dptr
mask(x,ysize-y,r) = bmpbytes(dptr):inc dptr
next x
next y
print "Loaded: "+fname$
sync
` Free up the raw buffer
undim bmpbytes(0)
` ***********************************************************
` This section is identical to the above, but loads the first texture instead
fname$ = tex1_file$
size = file size(fname$)
dim bmpbytes(size)
open to read 1,fname$
for i = 1 to size:read byte 1,bmpbytes(i):next i
close file 1
xsize = 0:for i = 22 to 19 step -1:xsize =(xsize*256)+bmpbytes(i):next i
ysize = 0:for i = 26 to 23 step -1:ysize =(ysize*256)+bmpbytes(i):next i
doff = 0:for i = 14 to 11 step -1:doff = (doff*256)+bmpbytes(i):next i
t1_xsize = xsize:t1_ysize = ysize
dim tex1(xsize,ysize,3)
dptr = doff+1
for y = 1 to ysize
for x = 0 to xsize-1
tex1(x,ysize-y,b) = bmpbytes(dptr):inc dptr
tex1(x,ysize-y,g) = bmpbytes(dptr):inc dptr
tex1(x,ysize-y,r) = bmpbytes(dptr):inc dptr
next x
next y
print "Loaded: "+fname$
sync
undim bmpbytes(0)
` ***********************************************************
` This section finally loads the second texture
fname$ = tex2_file$
size = file size(fname$)
dim bmpbytes(size)
open to read 1,fname$
for i = 1 to size:read byte 1,bmpbytes(i):next i
close file 1
xsize = 0:for i = 22 to 19 step -1:xsize =(xsize*256)+bmpbytes(i):next i
ysize = 0:for i = 26 to 23 step -1:ysize =(ysize*256)+bmpbytes(i):next i
doff = 0:for i = 14 to 11 step -1:doff = (doff*256)+bmpbytes(i):next i
t2_xsize = xsize:t2_ysize = ysize
dim tex2(xsize,ysize,3)
dptr = doff+1
for y = 1 to ysize
for x = 0 to xsize-1
tex2(x,ysize-y,b) = bmpbytes(dptr):inc dptr
tex2(x,ysize-y,g) = bmpbytes(dptr):inc dptr
tex2(x,ysize-y,r) = bmpbytes(dptr):inc dptr
next x
next y
print "Loaded: "+fname$
sync
undim bmpbytes(0)
` ***********************************************************
`
` OK, It is now time to build the texture onto the screen
cls
` We are going to use the mask size to draw the results
for x=0 to m_xsize-1
for y=0 to m_ysize-1
` We are now going to grab the colors from texture 1 and texture 2, to feed into the
` blending routines. There are some special conditions though, if you have different
` sized textures.
`
` A texture could be too small to get a pixel, so we need to check if it exists, otherwise
` our array access could be out of bounds. If it is out of bounds, we'll mark the T1 and T2
` colors with -1s, so we can check them quickly later.
if (x < t1_xsize-1) and (y < t1_ysize-1)
t1r = tex1(x,y,r):t1g = tex1(x,y,g):t1b = tex1(x,y,b)
else
t1r = -1: t1g = -1: t1b = -1
endif
if (x < t2_xsize-1) and (y < t2_ysize-1)
t2r = tex2(x,y,r):t2g = tex2(x,y,g):t2b = tex2(x,y,b)
else
t2r = -1: t2g = -1: t2b = -1
endif
remstart
Time to blend the colors - there are four possibilities:
T1 and T2 were both big enough to get a pixel,
T1 was too small to get a pixel,
T2 was too small to get a pixel, or
T1 and T2 are both too small to get a pixel
remend
if (t1r < 0) and (t2r < 0) : rem Make it black, since no pixels are available
blend_r = 0
blend_g = 0
blend_b = 0
endif
if (t1r >= 0) and (t2r < 0) : Rem Texture 1 is only color available, so we'll use that.
blend_r = t1r
blend_g = t1g
blend_b = t1b
endif
if (t1r < 0) and (t2r >= 0) : Rem Texture 2 is only color available, so we'll use that.
blend_r = t2r
blend_g = t2g
blend_b = t2b
endif
if (t1r >= 0) and (t2r >= 0) : Rem Do some real blending - 24 bit blending! The Red
Rem value is the alpha value for Reds, Green for Green, etc.
blend_r = ((t1r*mask(x,y,r))+(t2r*(255-mask(x,y,r))))/255
blend_g = ((t1g*mask(x,y,g))+(t2g*(255-mask(x,y,g))))/255
blend_b = ((t1b*mask(x,y,b))+(t2b*(255-mask(x,y,b))))/255
endif
` Now put it on the screen
ink rgb(blend_r,blend_g,blend_b),0
dot x,y
next y
next x
sync
suspend for key
