Code archives/Graphics/Seamless tile creator

; Seamless texture creator.
; 2005 MentalIllusion.
; http://www.mentalillusion.co.uk
;
;
; This is not designed to take a texture and make it seamless. It creates a texture from
; a complete image, ie, if you've got a picture of a lawn you load the lawn into this,
; pick the area you want to turn into a texture and it does the rest.

; Once you've picked the area it will save out a BMP file called tile_[yourfilename].bmp




; Please add to and improve this code!
;
;
; A few bits need doing to improve this:
; * contrast needs to increase on the blendy bits
; * Front end
; * Able to use images bigger than the screen



Graphics 1024,768,32,1

font = LoadFont("Arial.ttf",20,True)
SetFont font

filename$="[your image.jpg]"

i = LoadImage(filename)

size = 256
hsize = size/2

; set this to adjust the overhang
qsize = size/4

; set this to make it noiser!
; The noise variable makes the blends imperfect, however, it tends to make it look better
; have a play with this value, a value of 1 will just give a dither pattern which will look crap.
; .1 or .2 on most things looks pretty good, if you're doing grass or something that's almost a
; noise pattern anyway push it up to about .5... basically have a play.
noise# = .2

; RGB Functions
Global gotr#=0
Global gotg#=0
Global gotb#=0

SetBuffer BackBuffer()

Repeat
	x=MouseX()
	y=MouseY()
	
	If x-hsize<0 Then x=hsize
	If x+hsize+qsize>ImageWidth(i) Then x = ImageWidth(i)-hsize-qsize
	If y-hsize<0 Then y=hsize
	If y+hsize+qsize>ImageHeight(i) Then y = ImageHeight(i)-hsize-qsize
	
	Color c,0,0
	c=(c+10) Mod 256
	DrawBlock i,0,0
	Rect x-hsize,y-hsize,size+qsize,size+qsize,False
	Color 0,c,0
	Rect x-hsize,y-hsize,size,size,False
	oText MouseX(),MouseY(),"X",True,True
	oText GraphicsWidth()/2,10,"Select area for tile",True
	Flip


Until MouseDown(1)

x=x - hsize
y=y - hsize

j = CreateImage(size+qsize,size+qsize)
CopyRect x,y,size+qsize,size+qsize,0,0,ImageBuffer(i),ImageBuffer(j)
k = CreateImage(size,size)

LockBuffer ImageBuffer(i)
LockBuffer ImageBuffer(j)

; sort left hand edge from right hand stuff
For yy=0 To size+qsize
For xx=0 To qsize
	; create a bit of noise to make it imperfect
	disturb# = Rnd(-noise,noise)
	offset# = Float(xx) / Float(qsize) + disturb
	If offset>1 Then offset = 1
	If offset<0 Then offset = 0
	noffset# = 1 - offset
	
	GetRGB(i,x+size+xx,y+yy)
	r1# = gotr * noffset
	g1# = gotg * noffset
	b1# = gotb * noffset
	
	GetRGB(j,xx,yy)
	r2# = gotr * offset
	g2# = gotg * offset
	b2# = gotb * offset
	
	r# = r1 + r2
	g# = g1 + g2
	b# = b1 + b2
	
	WriteRGB(j,xx,yy,r,g,b)
Next
Next

UnlockBuffer ImageBuffer(i)
UnlockBuffer ImageBuffer(j)

CopyRect 0,0,size,size,0,0,ImageBuffer(j),ImageBuffer(k) 

LockBuffer ImageBuffer(j)
LockBuffer ImageBuffer(k)

; sort top edge from stuff below
For xx=0 To size
For yy=0 To qsize
	; create a bit of noise to make it imperfect
	disturb# = Rnd(-noise,noise)
	offset# = Float(yy) / Float(qsize) + disturb
	If offset>1 Then offset = 1
	If offset<0 Then offset = 0
	noffset# = 1 - offset
	
	GetRGB(j,xx,yy+size)
	r1# = gotr * noffset
	g1# = gotg * noffset
	b1# = gotb * noffset
	
	GetRGB(k,xx,yy)
	r2# = gotr * offset
	g2# = gotg * offset
	b2# = gotb * offset
	
	r# = r1 + r2
	g# = g1 + g2
	b# = b1 + b2
	
	WriteRGB(k,xx,yy,r,g,b)
Next
Next

UnlockBuffer ImageBuffer(j)
UnlockBuffer ImageBuffer(k)

SaveImage(k,"tile_"+Left(filename,Instr(filename,"."))+"bmp")


Cls
For x=0 To (GraphicsWidth()/size)+1
For y=0 To (GraphicsHeight()/size)+1
DrawBlock k,x*size,y*size
Next
Next
oText GraphicsWidth()/2+x,GraphicsHeight()/2+y,"Tile saved, Press any Key",True

Flip
WaitKey

Function Otext(xp,yp,t$,xcen=False,ycen=False)

Color 0,0,0
For x=-2 To 2
For y=-2 To 2
	Text xp+x,yp+y,t$,xcen,ycen
Next
Next
Color 255,255,255
Text xp,yp,t$,xcen,ycen

End Function


Function WriteRGB(image_name,x,y,red,green,blue)
; Writes a pixel to an image.
; The imagebuffer needs to be locked as it does a write pixel fast.
argb=(blue Or (green Shl 8) Or (red Shl 16) Or ($ff000000))
WritePixelFast x,y,argb,ImageBuffer(image_name)
End Function

Function GetRGB(image_name,x,y)
; Gets the RGB components from an image.
; The imagebuffer needs to be locked as it does a read pixel fast.
; The components are put into the global varibles gotr, gotg and gotb
	argb=ReadPixelFast(x,y,ImageBuffer(image_name))
	gotr=(ARGB Shr 16) And $ff 
	gotg=(ARGB Shr 8) And $ff 
	gotb=ARGB And $ff
End Function