Code archives/Graphics/Procedeual Texture Generation
This code has been declared by its author to be Public Domain code.
Download source code
| |||||
2 Files below Proctexfunc.bb - Functions ProcTex.bb - The demo | |||||
**** Proctexfunc.bb ; RGB Functions Global gotr#=0 Global gotg#=0 Global gotb#=0 Global texsize=256 Function hText(x,y,t$,ax=False,ay=False) Color 0,0,0 Text x-1,y,t$,ax,ay Text x+1,y,t$,ax,ay Text x,y-1,t$,ax,ay Text x,y+1,t$,ax,ay Color 255,255,255 Text x,y,t$,ax,ay End Function Function otext(x,y,t$,ax=False,ay=False) htext x,y,t$,ax,ay htext 256,480,"Press Space to Continue",True 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 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 Clip(x) If x>255 Then x=255 If x<0 Then x=0 Return x End Function Function cosine_interpolate#(a#, b#, x#) f#=(1-Cos(x*180))/2 Return a*(1-f)+(b*f) End Function Function add(source,output,s#=1) tmp = CreateImage(texsize,texsize) LockBuffer ImageBuffer(tmp) LockBuffer ImageBuffer(source) LockBuffer ImageBuffer(output) For x=0 To texsize-1 For y=0 To texsize-1 GetRGB(source,x,y) sr#=Float(gotr)*s sg#=Float(gotg)*s sb#=Float(gotb)*s GetRGB(output,x,y) r#=Clip(sr+gotr) g#=Clip(sg+gotg) b#=Clip(sb+gotb) WriteRGB(tmp,x,y,r,g,b) Next Next UnlockBuffer ImageBuffer(source) UnlockBuffer ImageBuffer(output) UnlockBuffer ImageBuffer(tmp) Return tmp FreeImage tmp End Function Function multiply(source,output,s#=1) tmp = CreateImage(texsize,texsize) LockBuffer ImageBuffer(tmp) LockBuffer ImageBuffer(source) LockBuffer ImageBuffer(output) For x=0 To texsize-1 For y=0 To texsize-1 GetRGB(source,x,y) sr#=1-((Float(255-gotr)/255)*s) sg#=1-((Float(255-gotg)/255)*s) sb#=1-((Float(255-gotb)/255)*s) GetRGB(output,x,y) r#=Float(gotr)*sr g#=Float(gotg)*sg b#=Float(gotb)*sb WriteRGB(tmp,x,y,r,g,b) Next Next UnlockBuffer ImageBuffer(source) UnlockBuffer ImageBuffer(output) UnlockBuffer ImageBuffer(tmp) Return tmp FreeImage tmp End Function Function multiplyx2(source,output,s#=1) tmp = CreateImage(texsize,texsize) LockBuffer ImageBuffer(tmp) LockBuffer ImageBuffer(source) LockBuffer ImageBuffer(output) For x=0 To texsize-1 For y=0 To texsize-1 GetRGB(source,x,y) sr#=2-((Float(255-gotr)/255)*2) sg#=2-((Float(255-gotg)/255)*2) sb#=2-((Float(255-gotb)/255)*2) sr=sr-1 sg=sg-1 sb=sb-1 sr=sr*s sg=sg*s sb=sb*s sr=sr+1 sg=sg+1 sb=sb+1 GetRGB(output,x,y) r#=Clip(Float(gotr)*sr) g#=Clip(Float(gotg)*sg) b#=Clip(Float(gotb)*sb) WriteRGB(tmp,x,y,r,g,b) Next Next UnlockBuffer ImageBuffer(source) UnlockBuffer ImageBuffer(output) UnlockBuffer ImageBuffer(tmp) Return tmp FreeImage tmp End Function Function colorlayer(r,g,b,noise) tmp = CreateImage(texsize,texsize) LockBuffer ImageBuffer(tmp) For x=0 To texsize-1 For y=0 To texsize-1 rad = Rand(-noise,noise) WriteRGB(tmp,x,y,Clip(r+Rad),Clip(g+Rad),Clip(b+Rad)) Next Next UnlockBuffer ImageBuffer(tmp) Return tmp FreeImage tmp End Function Function cracks(qty,length) tmp = CreateImage(texsize,texsize) LockBuffer ImageBuffer(tmp) For x=0 To texsize-1 For y=0 To texsize-1 WriteRGB(tmp,x,y,128,128,128) Next Next ; cracks For y=1 To qty x1#=Rand(0,texsize-1) y1#=Rand(0,texsize-1) d=Rand(0,360) l=Rand(5,50) For x=1 To Rand(1,length) GetRGB(tmp,x1#,y1#+1) gotr=Clip(gotr+(l/2)) gotg=Clip(gotg+(l/2)) gotb=Clip(gotb+(l/2)) WriteRGB(tmp,x1,y1+1,gotr,gotg,gotb) GetRGB(tmp,x1#,y1#) gotr=Clip(gotr-l) gotg=Clip(gotg-l) gotb=Clip(gotb-l) WriteRGB(tmp,x1,y1,gotr,gotg,gotb) x1=(x1+Sin(d)) Mod texsize y1=(y1+Cos(d)) Mod texsize d=d+Rand(-15,15) l=l+Rand(-1,1) Next Next UnlockBuffer ImageBuffer(tmp) Return tmp FreeImage tmp End Function Function streak(qty,scale,noise,shake,rr,gg,bb,hori) tmp = CreateImage(texsize,texsize) LockBuffer ImageBuffer(tmp) For x=0 To texsize-1 For y=0 To texsize-1 WriteRGB(tmp,x,y,128,128,128) Next Next For y=1 To qty rad = Rand(-noise,noise) r=rr+rad g=gg+rad b=bb+rad sc=Rand(1,scale) yy=Rand(0,texsize-1) xx=Rand(0,texsize-1) For x=0 To 180/sc xxx=(xx+x) Mod texsize yyy=(yy+Rnd(-shake,shake)) Mod texsize GetRGB(tmp,xxx,yyy) gotr=Clip(gotr+(Sin(x*sc)*r)) gotg=Clip(gotg+(Sin(x*sc)*g)) gotb=Clip(gotb+(Sin(x*sc)*b)) If hori WriteRGB(tmp,xxx,yyy,gotr,gotg,gotb) Else WriteRGB(tmp,yyy,xxx,gotr,gotg,gotb) EndIf Next Next UnlockBuffer ImageBuffer(tmp) Return tmp FreeImage tmp End Function Function hstreak(qty,scale,noise,shake,rr=0,gg=0,bb=0) Return streak(qty,scale,noise,shake,rr,gg,bb,True) End Function Function vstreak(qty,scale,noise,shake,rr=0,gg=0,bb=0) Return streak(qty,scale,noise,shake,rr,gg,bb,False) End Function Function baseshadow() tmp = CreateImage(texsize,texsize) LockBuffer ImageBuffer(tmp) For x=0 To texsize-1 For y=0 To texsize-1 WriteRGB(tmp,x,y,255,255,255) Next Next height = Rand(texsize/8,texsize/4) inith = height newheight = Rand(texsize/8,texsize/4) width# = Rand(texsize/50,texsize/4) pos#=0 For x=0 To texsize-1 l#=cosine_interpolate(height,newheight,pos/width) pos=pos+1 If pos>=width height=newheight width# = Rand(texsize/50,texsize/4) newheight = newheight + Rand(-texsize/20,texsize/20) If newheight<texsize/8 Then newheight=newheight+(texsize/7) If x+width>texsize-1 width=texsize-1-x newheight = inith EndIf pos=0 EndIf For y=0 To l c = Clip((y/l)*255) WriteRGB(tmp,x,texsize-1-y,c,c,c) Next Next UnlockBuffer ImageBuffer(tmp) Return tmp End Function Function noise(qty,depth,r,g,b,bgr=0,bgg=0,bgb=0) tmp = CreateImage(texsize,texsize) LockBuffer ImageBuffer(tmp) If bgr>0 And bgg>0 And bgb>0 For x=0 To texsize-1 For y=0 To texsize-1 WriteRGB(tmp,x,y,bgr,bgg,bgb) Next Next EndIf For x=1 To qty rad=Rand(-depth,depth) WriteRGB(tmp,Rand(0,texsize-1),Rand(0,texsize-1),r+rad,g+rad,b+rad) Next UnlockBuffer ImageBuffer(tmp) Return tmp End Function -------------------------------------------------------------------------------------------------------------------------- **** ProcTex.bb Graphics 512,512,32,2 ;SeedRnd MilliSecs() font=LoadFont("Arial.tff",15) SetFont font Include "proctexfunc.bb" texsize=256 SetBuffer BackBuffer() AppTitle "Processing..." t1 = colorlayer(126,143,158,10) t1 = multiplyx2(cracks(50,500),t1,.5) t1 = multiplyx2(hstreak(100,1,20,1,0,0,0),t1,.6) t1 = multiplyx2(vstreak(50,20,30,1,-30,0,-30),t1,1) t1 = multiply(baseshadow(),t1,.5) DrawBlock t1,0,0 t1 = colorlayer(50,90,50,30) t1 = add(noise(1000,30,80,70,50),t1) DrawBlock t1,256,0 t1 = colorlayer(50,50,50,20) t1 = multiplyx2(noise(5000,100,128,128,128,128,128,128),t1,1) t1 = multiplyx2(cracks(100,1000),t1,2) DrawBlock t1,0,256 t1 = colorlayer(200,150,100,10) t1 = multiplyx2(hstreak(100,1,20,0,0,0,0),t1,.6) t1 = multiplyx2(vstreak(100,1,20,0,0,0,0),t1,.6) DrawBlock t1,256,256 AppTitle "Procedual Texture Creator" oText 256,0,"Textures created with no media",True Flip WaitKey AppTitle "Processing..." t1 = colorlayer(126,143,158,10) t1 = multiplyx2(cracks(50,500),t1,.5) t1 = multiplyx2(hstreak(100,1,20,1,0,0,0),t1,.6) t1 = multiplyx2(vstreak(50,20,30,1,-30,0,-30),t1,1) DrawBlock t1,0,0 DrawBlock t1,256,0 t1 = multiply(baseshadow(),t1,.5) DrawBlock t1,0,256 DrawBlock t1,256,256 AppTitle "Procedual Texture Creator" oText 256,0,"Texutre created and stored, added to then stored again",True Flip WaitKey AppTitle "Processing..." t1 = colorlayer(50,50,50,20) t1 = multiplyx2(noise(5000,100,128,128,128,128,128,128),t1,1) t1 = multiplyx2(cracks(100,1000),t1,2) DrawBlock t1,0,0 DrawBlock t1,256,0 DrawBlock t1,0,256 DrawBlock t1,256,256 AppTitle "Procedual Texture Creator" oText 256,0,"Textures all 100% tileable",True Flip WaitKey AppTitle "Processing..." texsize=512 t1 = colorlayer(200,150,100,10) t1 = multiplyx2(hstreak(100,1,20,0,0,0,0),t1,.6) t1 = multiplyx2(vstreak(100,1,20,0,0,0,0),t1,.6) DrawBlock t1,0,0 AppTitle "Procedual Texture Creator" oText 256,0,"Any size texture can be created",True Flip WaitKey AppTitle "Processing..." texsize=256 t1 = Colorlayer(128,128,128,20) DrawBlock t1,0,0 t1 = cracks(50,500) DrawBlock t1,256,0 t1 = hstreak(100,1,20,1,0,0,0) DrawBlock t1,0,256 t1 = noise(1000,30,80,70,50) DrawBlock t1,256,256 AppTitle "Procedual Texture Creator" oText 256,0,"FX include, base layer, cracks, streaks and noise",True Flip WaitKey AppTitle "Processing..." t1 = Colorlayer(128,128,128,20) DrawBlock t1,0,0 t2 = cracks(50,500) t2 = add(t2,t1,1) DrawBlock t2,256,0 t2 = cracks(50,500) t2 = multiply(t2,t1,1) DrawBlock t2,0,256 t2 = cracks(50,500) t2 = multiplyx2(t2,t1,1) DrawBlock t2,256,256 AppTitle "Procedual Texture Creator" oText 256,0,"With Add, Multiply and Multiply x n blend modes",True Flip WaitKey AppTitle "Processing..." t1 = colorlayer(128,128,128,20) t2 = cracks(50,500) n#=0 d#=.2 FlushKeys Cls Repeat otext 256,0,"Variable blend power",True t3 = multiplyx2(t2,t1,n) DrawBlock t3,128,128 Flip n=n+d If n>=3 Or n<=0 Then d=-d Until KeyHit(57) |
Comments
| ||
Wow! I have been wondering when something like this would happen! Thanks, Rob :) (Oh, and may this quick response to a brand new, worthy entry be a demonstration to the web people that the code archives forum is a good idea). |
| ||
nice !!! I am obliged to add the 2 lines below because y = -2. After this modification the result is really nice to see. Function GetRGB(image_name,x,y) x = Abs(x) y = Abs(y) .... End Function Function WriteRGB(image_name,x,y,red,green,blue) x = Abs(x) y = Abs(y) .... end function |
| ||
very nice one |
| ||
I was going to take this further and turn it into a full blown app to sell... but then I realised I couldn't be arsed... So free seemed a better option than gathering dust, as it were. Weird that bug, it works with no problems here. Although this is now classed as do anything you want with it if it's used a bit of credit wouldn't go amiss. |
| ||
cool. Thanks, Rob. |
| ||
Absolutely wonderfull! Thanks for sharing this. I also had MAV re Y coordinate being negative. Changing to readPixel /writepixel rather than readpixelfast/writepixelfast allowed me to run the demo. |
Code Archives Forum