Snippet - Socoder

-=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- (c) WidthPadding Industries 1987 0\|701\|0 -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=-
SoCoder -> Snippet Home -> Generators

Jayenkai	Created : 23 July 2016 Edited : 23 July 2016 System : Cross Platform Language : Monkey Code Creates Crates Crikey!
A simple enough generator, which generates generic looking crates for use in your games. Crateness.zip : Includes source, exe and example settings file. (but the code below will happily run from a copy+paste into BlitzMax) Global iniLines Global iniCmd$[512] Global iniParm$[512] GetINI() Global ScreenWidth=512 ; ScreenWidth=FromINI(ScreenWidth,"Screen Width","Sheet Width") Global ScreenHeight=512 ; ScreenHeight=FromINI(ScreenHeight,"Screen Height","Sheet Height") Global SpriteWidth=128 ; SpriteWidth=FromINI(SpriteWidth,"Sprite Size","Size","Sprite Width","Width") Global SpriteHeight=128 ; SpriteHeight=FromINI(SpriteHeight,"Sprite Size","Size","Sprite Height","Height") Global Rescale=0 Temp$=Upper$(FromINItxt$("","Rescale","Make")) If temp$="TRUE" Or temp$="LARGER" Or temp$="BIGGER" Or temp$="GROW" Then Rescale=2 If temp$="SMALLER" Or temp$="SHRINK" Then Rescale=1 Global OutFilename$="Out" ; OutFilename$=FromINItxt$(OutFilename$,"Filename","Save As","Output") outfilename$=Replace(outfilename$,"/","_") outfilename$=Replace(outfilename$,"\","_") outfilename$=Replace(outfilename$,";","_") outfilename$=Replace(outfilename$,":","_") outfilename$=Replace(outfilename$,"","_") outfilename$=Replace(outfilename$,"?","_") outfilename$=Replace(outfilename$,"!","_") outfilename$=Replace(outfilename$,Chr$(34),"") Global MaskColor=$FF00FF Global SpritesX=Floor(ScreenWidth/SpriteWidth) Global SpritesY=Floor(ScreenHeight/SpriteHeight) Function GetIni() iniLines=0 If FileType("settings.ini")=1 DebugLog "Found ini file" quickin=ReadFile("settings.ini") lines=0 Repeat intxt$=ReadLine(quickin) If Instr(intxt,"=") cmd$=iniLeft$(intxt) parm$=iniRight(intxt) cmd=Trim$(cmd$) cmd=Replace$(cmd," ","") cmd=Lower$(cmd) parm$=Trim$(parm$) iniLines=iniLines+1 iniCmd[iniLines]=cmd$ iniParm[iniLines]=parm$ EndIf If iniLines>500 Then fin=1 If Eof(quickin) Then fin=1 Until fin=1 CloseFile quickin EndIf End Function Function FromINI(value,va$="-1",vb$="-1",vc$="-1",vd$="-1",ve$="-1",vf$="-1",vg$="-1") Local fout=value va$=Lower$(Trim$(Replace$(va$," ",""))) vb$=Lower$(Trim$(Replace$(vb$," ",""))) vc$=Lower$(Trim$(Replace$(vc$," ",""))) vd$=Lower$(Trim$(Replace$(vd$," ",""))) ve$=Lower$(Trim$(Replace$(ve$," ",""))) vf$=Lower$(Trim$(Replace$(vf$," ",""))) vg$=Lower$(Trim$(Replace$(vg$," ",""))) For inie=1 To iniLines If va$=inicmd[inie] Then fout=Int(iniparm[inie]) If vb$=inicmd[inie] Then fout=Int(iniparm[inie]) If vc$=inicmd[inie] Then fout=Int(iniparm[inie]) If vd$=inicmd[inie] Then fout=Int(iniparm[inie]) If ve$=inicmd[inie] Then fout=Int(iniparm[inie]) If vf$=inicmd[inie] Then fout=Int(iniparm[inie]) If vg$=inicmd[inie] Then fout=Int(iniparm[inie]) Next Return fout End Function Function FromINItxt$(value$,va$="-1",vb$="-1",vc$="-1",vd$="-1",ve$="-1",vf$="-1",vg$="-1") Local fout$=value va$=Lower$(Trim$(Replace$(va$," ",""))) vb$=Lower$(Trim$(Replace$(vb$," ",""))) vc$=Lower$(Trim$(Replace$(vc$," ",""))) vd$=Lower$(Trim$(Replace$(vd$," ",""))) ve$=Lower$(Trim$(Replace$(ve$," ",""))) vf$=Lower$(Trim$(Replace$(vf$," ",""))) vg$=Lower$(Trim$(Replace$(vg$," ",""))) For inie=1 To iniLines If va$=inicmd[inie] Then fout=iniparm[inie] If vb$=inicmd[inie] Then fout=iniparm[inie] If vc$=inicmd[inie] Then fout=iniparm[inie] If vd$=inicmd[inie] Then fout=iniparm[inie] If ve$=inicmd[inie] Then fout=iniparm[inie] If vf$=inicmd[inie] Then fout=iniparm[inie] If vg$=inicmd[inie] Then fout=iniparm[inie] Next Return fout End Function Function SplitText$(in$,Split$,e,alsospace=0) 'Splits text... Local out:String="" Local start:Int=1 Local nomore:Int=0 Local shift:Int Local size:Int in:String=Trim(in) e=e-1 For shift=1 To e If Instr(in$,Split$,start)+1<=nstart Then nomore=1 If Instr(in$,Split$,start)+1>nstart Then nstart=Instr(in$,Split$,start)+1 If AlsoSpace=1 Then If Instr(in$," ",start)+1<nstart And Instr(in$," ",start)>0 Then nstart=Instr(in$," ",start)+1 start=nstart Next size=(Instr(in$,Split$,start))-start If AlsoSpace=1 Then If (Instr(in$," ",start))-start<size And Instr(in$," ",start)>0 Then size=(Instr(in$," ",start))-start out$=Mid$(in$,start,size) If nomore=1 Then out$="-+-" Return out End Function Function IniLeft$(ftxt$) Return Upper$(Trim$(splittext$(ftxt$,"=",1,0))) End Function Function IniRight$(ftxt$) Return Trim$(splittext$(ftxt$,"=",2,0)) End Function Function Ink(ang#,bright#) Local fr#=(150+(Sin(ang)150.0))bright Local fg#=(150+(Sin(ang+120)150.0))bright Local fb#=(150+(Sin(ang+240)150.0))bright If fr<0 Then fr=0 If fr>255 Then fr=255 If fgr<0 Then fg=0 If fg>255 Then fg=255 If fb<0 Then fb=0 If fb>255 Then fb=255 SetColor(fr,fg,fb) End Function Function ResetDraw() SetRotation 0 SetAlpha(1) SetColor(255,255,255) SetBlend(ALPHABLEND) End Function Graphics ScreenWidth,ScreenHeight Global SpriteX,SpriteY Global w,h w=SpriteWidth;h=SpriteHeight SeedRnd(MilliSecs());For n=0 To 100;r=Rnd(0,10);Next Repeat Cls For SpriteY=0 To SpritesY-1 For SpriteX=0 To SpritesX-1 ResetDraw() SetViewport(SpriteXSpriteWidth,SpriteYSpriteHeight,SpriteWidth,SpriteHeight) SetOrigin(SpriteXSpriteWidth,SpriteYSpriteHeight) w=SpriteWidth;h=SpriteHeight SetColor((MaskColor & $FF0000) Shr 16,(MaskColor & $00FF00) Shr 8,(MaskColor & $0000FF)) DrawRect(dx,dy,w,h) ResetDraw() Generator() SetViewport(0,0,ScreenWidth,ScreenHeight) SetOrigin(0,0) Flip Next Next outimg=GrabPixmap(0,0,ScreenWidth,ScreenHeight) For x=0 To ScreenWidth-1 For y=0 To ScreenHeight-1 argb=ReadPixel(outimg,x,y) If (argb & $00FFFFFF)=MaskColor Then argb=$00000000 WritePixel(outimg,x,y,argb) Next Next If Rescale=0 SavePixmapPNG(outimg,OutFilename+".png") EndIf If Rescale=1 SavePixmapPNG(outimg,OutFilename+"-hd2.png") outimg_2=ResizePixmap(outimg,ScreenWidth/2,ScreenHeight/2) SavePixmapPNG(outimg_2,OutFilename+"-hd.png") outimg_1=ResizePixmap(outimg,ScreenWidth/4,ScreenHeight/4) SavePixmapPNG(outimg_1,OutFilename+".png") EndIf If Rescale=2 SavePixmapPNG(outimg,OutFilename+".png") outimg_2=CreatePixmap(ScreenWidth2,ScreenHeight2,PF_RGBA8888) outimg_4=CreatePixmap(ScreenWidth4,ScreenHeight4,PF_RGBA8888) For x=0 To ScreenWidth-1 For y=0 To ScreenHeight-1 argb=ReadPixel(outimg,x,y) WritePixel(outimg_2,x2,y2,argb) WritePixel(outimg_2,x2,y2+1,argb) WritePixel(outimg_2,x2+1,y2,argb) WritePixel(outimg_2,x2+1,y2+1,argb) For ex=0 To 3 For ey=0 To 3 WritePixel(outimg_4,x4+ex,y4+ey,argb) Next Next Next Next SavePixmapPNG(outimg_2,OutFilename+"-hd.png") SavePixmapPNG(outimg_4,OutFilename+"-hd2.png") EndIf DrawText("Finished : Press any key to Quit",4,ScreenHeight-14) Flip WaitKey() Until Not KeyDown(KEY_R) ' -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= ' Generator code goes below! ' -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= Function Generator() rot=Rand(0,1) gap=(h)/8 dark#=Rnd(0.6,0.70) For n=0 To 7 d=(ngap) r=Rand(200,220) g=Rand(150,r-40) b=Rand(50,g-70) r=Float(r)dark;g=Float(g)dark;b=Float(b)dark c=Rand(12,20) x=0;y=d;x2=w;y2=gap If rot=0 SetColor(r-c2,g-c2,b-c2) DrawRect(x,y,x2,y2) SetColor(r,g,b) DrawRect(x,y,x2-4,y2-4) SetColor(r-c,g-c,b-c) DrawRect(x+4,y+4,x2-8,y2-8) EndIf If rot=1 t=x;x=y;y=t t=x2;x2=y2;y2=t SetColor(r-c2,g-c2,b-c2) DrawRect(x,y,x2,y2) SetColor(r,g,b) DrawRect(x,y,x2-4,y2-4) SetColor(r-c,g-c,b-c) DrawRect(x+4,y+4,x2-8,y2-8) EndIf SetColor(0,0,0);SetAlpha(0.1) For m=0 To 64 xa=Rand(x,x+x2) xb=Rand(x,x+x2) ya=Rand(y,y+y2) yb=Rand(y,y+y2) DrawLine(xa,ya,xb,yb) Next SetAlpha(1) Next thickener=Rand(4,10) rotdo=Rand(0,1) For m=0 To 1 rot=(rotdo+m) Mod 2 r=Rand(200,220) g=Rand(150,r-40) b=Rand(50,g-70) x=0;y=0;x2=w;y2=gap+thickener If rot=1 t=x;x=y;y=t t=x2;x2=y2;y2=t EndIf SetColor(r0.25,g0.25,b0.25);SetAlpha(0.25) DrawRect(x+4,y+4,x2,y2) If m=0 Then r=r0.8;g=g0.8;b=b0.8 If m=1 Then r=r0.9;g=g0.9;b=b0.9 SetColor(r-c2,g-c2,b-c2);SetAlpha(1.0) DrawRect(x,y,x2,y2) SetColor(r,g,b);SetAlpha(1.0) DrawRect(x,y,x2-4,y2-4) SetColor(r-c,g-c,b-c);SetAlpha(1.0) DrawRect(x+4,y+4,x2-8,y2-8) SetColor(0,0,0);SetAlpha(0.1) For mp=0 To 32 xa=Rand(x,x+x2) xb=Rand(x,x+x2) ya=Rand(y,y+y2) yb=Rand(y,y+y2) DrawLine(xa,ya,xb,yb) Next SetAlpha(1) r=Rand(200,220) g=Rand(150,r-40) b=Rand(50,g-70) x=0;y=(h)-(gap+thickener);x2=w;y2=gap+thickener If rot=1 t=x;x=y;y=t t=x2;x2=y2;y2=t EndIf SetColor(r0.25,g0.25,b0.25);SetAlpha(0.25) DrawRect(x+4,y+4,x2,y2) If m=0 Then r=r0.8;g=g0.8;b=b0.8 If m=1 Then r=r0.9;g=g0.9;b=b0.9 SetColor(r-c2,g-c2,b-c*2);SetAlpha(1.0) DrawRect(x,y,x2,y2) SetColor(r,g,b);SetAlpha(1.0) DrawRect(x,y,x2-4,y2-4) SetColor(r-c,g-c,b-c);SetAlpha(1.0) DrawRect(x+4,y+4,x2-8,y2-8) SetColor(0,0,0);SetAlpha(0.1) For mp=0 To 32 xa=Rand(x,x+x2) xb=Rand(x,x+x2) ya=Rand(y,y+y2) yb=Rand(y,y+y2) DrawLine(xa,ya,xb,yb) Next SetAlpha(1) Next End Function --v Note : Although it appears exceedingly lengthy, the actual generator code is all held within the bottom-most "Generator()" function. The rest is my standardised "Generator Maker" code, which accounts for an ini script and other bits and pieces. Typical Output

Comments
Monday, 25 July 2016, 08:08
Pakz	Hey, that is pretty good! The bigger resolution shows how the lines are drawn onto it seemingly randomly. They scale down looking like real wood! I learned something today
Tuesday, 26 July 2016, 07:02
HoboBen	That looks super nice!

Code Creates Crates

Comments