Gem Sprites

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

Jayenkai	Created : 06 September 2017 Edited : 06 September 2017 Gem Sprites
A generator for 'Gems'. They're not the best looking gems in the world, but if you pick and choose the better output and add a bit of shine to them, you could probably use them in some kind of Match-3 game or something..!? Example Output Download (.bmx source included) Generator_Gems_2017 (.zip) 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=64 ; SpriteWidth=FromINI(SpriteWidth,"Sprite Size","Size","Sprite Width","Width") Global SpriteHeight=64 ; SpriteHeight=FromINI(SpriteHeight,"Sprite Size","Size","Sprite Height","Height") Global colcycle=0 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+(Cos(ang)150.0))bright Local fg#=(150+(Cos(ang+240)150.0))bright Local fb#=(150+(Cos(ang+120)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() sides#=Rand(3,6) sides#=Rand(8,16) sidepoint#=3600.0/sides points=Rand(3,6) Local p#[150] far#=Rnd(0.25,0.5) cy#=0.5-(Float(points)/12.0) For n=1 To points p[n]=far If n<points/2 Then far=far+Rnd(0.15,0.25) If n>points/2 Then far=far-Rnd(0.15,0.25) If far>0.95 Then far=0.95 If far<0.05 Then far=0.05 p[n+10]=(Float(n)0.15)+cy p[n+20]=Float(1.0-((Float(n)/Float(points))0.4))+Rnd(0.0,0.2) If p[n+20]<0.25 Then p[n+20]=0.25 If p[n+20]>1.0 Then p[n+20]=1.0 ' If n=1 Then p[n+20]=0.95 Repeat p[n+30]=Float(Rand(-1,1))(sidepoint/10.0) Until p[n+30]<>0 Next SetColor(0,0,0) DrawRect(0,0,w,h) col=Rand(0,360) col=colcycle colcycle=(colcycle+30) Mod 360 r#=185.0+(Sin(col)255.0) g#=185.0+(Sin(col+120)255.0) b#=185.0+(Sin(col+240)255.0) If r<0 Then r=0 If r>255 Then r=255 If g<0 Then g=0 If g>255 Then g=255 If b<0 Then b=0 If b>255 Then b=255 crisp#=Rnd(1.0,4.0) SetLineWidth crisp spin=Rnd(0,360) turn#=Rand(0,5)15.0 For blend=0 To 1 SetBlend(ALPHABLEND) If blend=1 Then SetBlend(MULTIPLYBLEND) For rot#=0 To 3600 SetAlpha(0.0115) If (Int(rot) Mod sidepoint)=0 Delay 2 Flip False EndIf If (Int(rot) Mod sidepoint)=0 For m=1 To points-1 p[m+50]=Rnd(0.7,1.5) Next EndIf For n=1 To points-1 nr#=rp[n+20]p[n+50] ng#=gp[n+20]p[n+50] nb#=bp[n+20]p[n+50] If nr<0 Then nr=0 If nr>255 Then nr=255 If ng<0 Then ng=0 If ng>255 Then ng=255 If nb<0 Then nb=0 If nb>255 Then nb=255 SetColor(nr,ng,nb) SetAlpha(0.0075);If (Int(rot) Mod sidepoint)=0 Then SetAlpha(0.1) x1#=Float(w/2)+(Cos(spin+(rot/10.0))p[n]Float(w/2)) x2#=Float(w/2)+(Cos(spin+(rot/10.0)+p[n+30])p[n+1]Float(w/2)) y1#=Float(h)p[n+10] y2#=Float(h)p[n+11] DrawLine x1,y1,x2,y2 x1#=Float(w/2)+(Cos(spin+(rot/10.0)+turn)p[n]Float(w/2)) x2#=Float(w/2)+(Cos(spin+((rot/10.0)-p[n+30])+turn)p[n+1]Float(w/2)) DrawLine x1,y1,x2,y2 SetAlpha(GetAlpha()0.25) x1#=Float(w/2)+(Cos(spin+(rot/10.0))p[n]Float(w/2)) x2#=Float(w/2)+(Cos(spin+(rot/10.0))p[n+1]Float(w/2)) y1#=Float(h)p[n+10] y2#=Float(h)p[n+11] DrawLine x1,y1,x2,y2 x1#=Float(w/2)+(Cos(spin+(rot/10.0)+turn)p[n]Float(w/2)) x2#=Float(w/2)+(Cos(spin+((rot/10.0))+turn)p[n+1]*Float(w/2)) DrawLine x1,y1,x2,y2 If KeyHit(KEY_ESCAPE) Then End Next Next Next End Function --v

Comments
Monday, 11 September 2017, 06:27
Pakz	No they do not look that nice. Kind of oldskool 8 bit. I would add some light and shadow. I sometimes watch the alodare music video with those trees you coded. I really like those.
Monday, 11 September 2017, 06:56
Jayenkai	They're a simple random style, and although they might look a bit pants in their natural output style, it's extremely easy to add post-effects in your tool of choice. They're a good enough starting point, and at the time I wrote this, that's all I needed! Feel free to improve upon it, and post your own results.
Monday, 11 September 2017, 07:05
Pakz	I might try something like this with mojo3d later on. I am still waiting on the new binaries release though. Mark mentioned releasing a new version last week.

Example Output

Download (.bmx source included)

Comments