Sorry your browser is not supported!

` ~ process to create new image ~
makebitmap:

local fn$ as string
local cimg as integer
local fnsv$ as string
local svimg as integer
local xalt as integer
local yalt as integer
local imgwidth2 as integer
local imgheight2 as integer
local bitsh1 as integer
local bitsh2 as integer
local bitsh3 as integer
local xsin as integer
local ysin as integer

` input data for creating the new image
input "name of image to load? ",fn$
cimg = 1
input "name of new image to save? ",fnsv$
svimg = 2
input "x randomness of new image? ",xalt
input "y randomness of new image? ",yalt
input "width of new image? put 0 to use original ",imgwidth2
input "height of new image? put 0 to use original ",imgheight2
input "bitshift for red values in new image? (normal = 0) ",bitsh1
input "bitshift for green values in new image? (normal = 8) ",bitsh2
input "bitshift for blue values in new image? (normal = 16) ",bitsh3
input "x sin value for new image? ",xsin
input "y sin value for new image? ",ysin

` load the bitmap to be altered
load bitmap fn$+".bmp",cimg

` call function to save new bitmap and create file
savebitmapimg(fn$,cimg,fnsv$,svimg,xalt,yalt,imgwidth2,imgheight2,bitsh1,bitsh2,bitsh3,xsin,ysin)

gosub exitprog

` ~ end program on spacekey ~
exitprog:
if spacekey() = true then goto endprogram
return

` ~ end the program ~
endprogram:
end
` END.
` ----> program functions

` ~ save bitmap function ~
function savebitmapimg(fn$,cimg,fnsv$,svimg,xalt,yalt,imgwidth2,imgheight2,bitsh1,bitsh2,bitsh3,xsin,ysin)

` define local perameters
local x as integer
local y as integer
local col as dword
local oldimg as integer
local imgwidth as integer
local imgheight as integer
local padsz as integer
local col2 as dword

` set current bitmap to the loaded image
oldimg = current bitmap()
set current bitmap cimg

imgwidth = bitmap width()
imgheight = bitmap height()

if imgwidth2 <= 0 then imgwidth2 = imgwidth
if imgheight2 <= 0 then imgheight2 = imgheight

padsz = 4-( ( imgwidth2 * 3 ) mod 4)
if padsz = 4 then padsz = 0

` create a file to become the new bitmap.
make file fnsv$+".bmp"
if file exist(fnsv$+".bmp") then delete file fnsv$+".bmp"
open to write svimg,fnsv$+".bmp"

` write header data to file
write byte svimg, asc("B")
write byte svimg, asc("M")
write long svimg, 26+(((imgwidth2*3)+padsz)*imgheight2)
write word svimg, 0
write word svimg, 0
write long svimg, 26
write long svimg, 12
write word svimg, imgwidth2
write word svimg, imgheight2
write word svimg, 1
write word svimg, 24

imgwidth2 = imgwidth2 -1
imgheight2 = imgheight2 -1

` lock pixels to perform changes.
lock pixels

` write new pixel data
for y= imgheight2 to 0 step -1
   for x=0 to imgwidth2

` normal pixels
` col = point(x,y)

` altered pixels
   col2 = point( x+(sin(x+rnd(xalt)))*xsin,y+(sin(y+rnd(yalt)))*ysin )

   write byte svimg,col2 >> bitsh1
   write byte svimg,col2 >> bitsh2
   write byte svimg,col2 >> bitsh3

` next location
` in sequence.
next x

if padsz > 0
   for x=1 to padsz
      write byte svimg,0
   next x
endif

next y

unlock pixels

` close filed at end
close file cimg
close file svimg
set current bitmap oldimg

endfunction

global sizeX as integer
global sizeY as integer

sizeX=128
sizeY=96

	load()

for i=0 to 4
 Blend(0,0,sizeX,sizeY,SizeX+1,0, 1.00-i*0.20, 1.00, sizeX*i,sizeY*2)
next
for i=0 to 4
 Blend(0,0,sizeX,sizeY,SizeX+1,0, 1.00, 1.00-i*0.20, sizeX*i,sizeY*3)
next

for i=1 to 3
 Colored(0,0,sizeX,sizeY, 0.33*i, 1.00, 1.00, sizeX*(i-1), sizeY*4)
next
for i=1 to 3
 Colored(0,0,sizeX,sizeY, 1.00, 0.33*i, 1.00, sizeX*(i-1), sizeY*5)
next
for i=1 to 3
 Colored(0,0,sizeX,sizeY, 1.00, 1.00, 0.33*i, sizeX*(i-1), sizeY*6)
next

set window title "complete!"
wait key
end

function Blend(x,y,w,h,x2,y2 as integer,imageA1 as float,imageA2 as float, resultX, resultY as integer)
local posX as integer
local posY as integer
local Color1 as integer
local Color2 as integer
local r1,g1,b1 as float
local r2,g2,b2 as float

		for posX=x to w
		 for posY = y to h
		 
		  color1 = point(posX,posY)       : r1=rgbr(color1)*imageA1 : g1=rgbg(color1)*imageA1 : b1=rgbb(color1)*imageA1
		  color2 = point(posX+x2,posY+y2) : r2=rgbr(color2)*imageA2 : g2=rgbg(color2)*imageA2 : b2=rgbb(color2)*imageA2
		  
		  ink rgb((r1+r2)*0.5,(g1+g2)*0.5,(b1+b2)*0.5),0
		  dot posX+resultX,posY+resultY
		  
		 next
		next

endfunction

function Colored(x,y,w,h as integer,setR as float, setG as float, setB as float, resultX, resultY as Integer)
local posX as integer
local posY as integer
local Color as integer
local r1,g1,b1 as float
local r2,g2,b2 as float

		for posX=x to w
		 for posY = y to h
		 
		  color = point(posX,posY) : r1=rgbr(color)*setR : g1=rgbg(color)*setG : b1=rgbb(color)*setB
		  
		  ink rgb(r1,g1,b1),0
		  dot posX+resultX,posY+resultY
		  
		 next
		next

endfunction


function load()

	set display mode 640,800,32
	set window on

		sync on
	
		load image "1.png",1
		load image "2.png",2
	
	sprite 1,0,0,1
	sprite 2,0,0,2
	
	size sprite 1,sizeX,sizeY
	size sprite 2,sizeX,sizeY
	
	paste sprite 1,0,0
	paste sprite 2,sizeX+1,0
	
endfunction

   write byte svimg,col2 >> bitsh1
   write byte svimg,col2 >> bitsh2
   write byte svimg,col2 >> bitsh3

col2 = point( x+(sin(x+rnd(xalt)))*xsin,y+(sin(y+rnd(yalt)))*ysin )

set window on
set display mode 800,600,32

load image "media\1.jpg", 1
load image "media\2.bmp", 2
load image "media\3.png", 3

backdrop on
color backdrop rgb(255,255,255)

MixImages(1,2,"MixResult1.png",128,128)
MixImages(3,1,"MixResult2.png",196,64)
MixImages(2,3,"MixResult3.png",255,96)

//Colored(2, 1.00, 0.30, 0.50, "ColoredResult1.png") - slow!

ColoredHighLevel(2, 255, 64, 128,   "ColoredResult1.png")
ColoredHighLevel(2, 0, 255, 128 ,   "ColoredResult2.png")
ColoredHighLevel(2, 128, 64 , 255 , "ColoredResult3.png")

end

	function MixImages(image1,image2 as integer, filename as string, alpha1 as integer, alpha2 as integer)
	
			clear()

		sprite image1,0,0,image1 : hide sprite image1
		set sprite alpha image1,alpha1
		paste sprite image1,0,0
		
		sprite image2,0,0,image2 : hide sprite image2
		set sprite alpha image2,alpha2
		paste sprite image2,0,0

			saveImage(sprite width (image1),sprite height (image1),filename)
		
		delete sprite image1
		delete sprite image2
		
	endfunction
	
	function ColoredHighLevel(image1, setR, setG, setB as integer, filename as string)
	
			clear()
	
		sprite image1,0,0,image1 : hide sprite image1
		set sprite diffuse image1,setR,setG,setB
		paste sprite image1,0,0
		
			saveImage(sprite width (image1),sprite height (image1),filename)
			
		delete sprite image1
		
	endfunction
	
	function Colored(image1 as integer, setR as float, setG as float, setB as float, filename as string) // very slow
	local posX as integer
	local posY as integer
	local Color as integer
	local r1,g1,b1 as float
	local r2,g2,b2 as float

			clear()
	
		sprite image1,0,0,image1 : hide sprite image1
		paste sprite image1,0,0
		
			for posX=0 to sprite width (image1)
				for posY = 0 to sprite height (image1)
					color = point(posX,posY) : r1=rgbr(color)*setR : g1=rgbg(color)*setG : b1=rgbb(color)*setB
					ink rgb(r1,g1,b1),0
					dot posX+resultX,posY+resultY
				next
			next

		saveImage(sprite width (image1),sprite height (image1),filename)
		
		delete sprite image1
		
	endfunction

	`#########################
	` additional functions
	`#########################
	
	function saveImage(sizeX as integer, sizeY as integer, filename as string)
	
		get image 255,0,0,sizeX,sizeY
		 save image filename, 255
		delete image 255
		
	endfunction
	
	function clear()
	
		ink rgb(255,255,255),0
		box 0,0,screen width(),screen height()
		
	endfunction

load image "D:\Programming\Dark Basic\DBPro Source\michelangelo57.jpg", 1

make memblock from image 1, 1
make memblock from image 2, 1

rem get image data
imageWidth = memblock dword(1, 0)
imageHeight = memblock dword(1, 4)
imageDepth = memblock dword(1, 8)
memSize = get memblock size(1)

rem filter matrix
dim filter(5,5)
restore Emboss
for x = 1 to 5
	for y = 1 to 5
		read z
		filter(x, y) = z
	next y
next x
read filterScale
read filterOffset


rem loop through every pixel in source image
for x = 1 to imageWidth
	for y = 1 to imageHeight
		rem variables used for storing the added weights
		r0 = 0
		g0 = 0
		b0 = 0
		rem apply filter
		for i = -2 to 2
			for j = -2 to 2
				x3 = x+i
				y3 = y+j
				weight = filter(i+3, j+3)
				rem cells with 0 weight in the filter are not calculated into filtering process
				rem it would not influence the result in anyway, but it would be needless calculations
				if weight <> 0
					rem make sure to stay within image bounds when checking surrounding pixels
					if x3 > 0 and x3 <= imageWidth and y3 > 0 and y3 <= imageHeight
						rem extract the color components for this pixel
						pos = ((y3-1)*imageWidth + x3-1)*4 + 12
						b = memblock byte(1, pos)
						g = memblock byte(1, pos+1)
						r = memblock byte(1, pos+2)
						rem multiple pixel by the filter weight
						r0 = r0 + r*weight
						g0 = g0 + g*weight
						b0 = b0 + b*weight
					endif
				endif
			next j
		next i
		rem divide the weighted total by the filter scale and add the filter offset
		r0 = r0 / filterScale + filterOffset
		g0 = g0 / filterScale + filterOffset
		b0 = b0 / filterScale + filterOffset
		rem set the filter pixel into memblock 2
		pos = ((y-1)*imageWidth + x-1)*4 + 12
		write memblock dword 2, pos, rgb(r0,g0,b0)
	next y
next x


make image from memblock 2, 2


rem ======================
rem For demo purposes only
rem ======================
sync on
autocam off
backdrop on

position camera 0,0,0

make object plain 1, 300,300
position object 1, -160,0,400
texture object 1, 1

make object plain 2, 300,300
position object 2, 160,0,400
texture object 2,2


do
	set cursor 0,0
	print "FPS: ",screen fps()
sync
loop
rem ======================
rem End demo-only code
rem ======================




rem ======================
rem Filter data
rem ======================
Blur:
data 1, 1, 1, 1, 1
data 1, 1, 1, 1, 1
data 1, 1, 1, 1, 1
data 1, 1, 1, 1, 1
data 1, 1, 1, 1, 1
data 25,0

Gaussian:
data 1, 1, 1, 1, 1
data 1, 2, 2, 2, 1
data 1, 2, 3, 2, 1
data 1, 2, 2, 2, 1
data 1, 1, 1, 1, 1
data 32, 0

Gaussian2:
data 4, 4, 4, 4, 4
data 4, 8, 8, 8, 4
data 4, 8, 1, 8, 4
data 4, 8, 8, 8, 4
data 4, 4, 4, 4, 4
data 129, 0

Sharpen:
data 0, 0, 0, 0, 0
data 0, 0,-1, 0, 0
data 0,-1, 5,-1, 0
data 0, 0,-1, 0, 0
data 0, 0, 0, 0, 0
data 1, 0

Emboss:
data 0, 0, 0, 0, 0
data 0, 0, 0, 0, 0
data 0, 0, 1, 0, 0
data 0, 0, 0,-1, 0
data 0, 0, 0, 0, 0
data 1, 128

Invert:
data 0, 0, 0, 0, 0
data 0, 0, 0, 0, 0
data 0, 0,-1, 0, 0
data 0, 0, 0, 0, 0
data 0, 0, 0, 0, 0
data 1, 255

rem increase scale to darken image
rem 100 = normal, 200 = half brightness, 300 = 1/3 brightness
Darken:
data 0, 0, 0, 0, 0
data 0, 0, 0, 0, 0
data 0, 0,100,0, 0
data 0, 0, 0, 0, 0
data 0, 0, 0, 0, 0
data 300,0