'******************************************************************
'* Diffusion Example
'* Author: Richard R Betson
'* Date: 11/25/11
'* Language: Monkey
'* Target: HTML5
'******************************************************************
' Linsence - Public Domain
'******************************************************************
' Web Site - <a href="http://redeyeware.uphero.com" target="_blank">http://redeyeware.uphero.com</a>
'******************************************************************
' Canvas Wrapper Mod by Impixi - <a href="http://www.monkeycoder.co.nz/Community/posts.php?topic=1885" target="_blank">http://www.monkeycoder.co.nz/Community/posts.php?topic=1885</a>
'******************************************************************
Import monkey
Import mojo
Import canvaswrapper
Global flag=0
Global clra:Int
Global ang_index_1:Int[360],ang_index_2:Int[360],ang_index_3:Int[360],ang_index_4:Int[360]
Function Main()
New Diffusion
End Function
Class Diffusion Extends App
Field imd:ImageData
Global fps,fp,fps_t
Global mapx:Int[77900]
Global mapx1:Int[77900]
Global mapx2:Int[77900]
Global mapx3:Int[77900]
Global mapx4:Int[77900]
Global clrr:Int[77900]
Global clrb:Int[77900]
Global clrr1:Int[77900]
Global clrb1:Int[77900]
Global ii
Global fxsel_ttl
Global fxsel
Global fred:Int=1,fblue:Int=2
Global qtext:String="Highest Quality",qt:Int=3,widetext:String=""
Global xa:Int=1,xb:Int=319,ya:Int=1,yb:Int=239
Method OnCreate()
fxsel_ttl=Millisecs()+16000
SetUpdateRate(60)
SetLookUp()
imd = xCanvas.CreateImageData(640,480)'640,480)
Local i2:Int
For i2=0 To 359
ang_index_1[i2]=(160 + (Sin(i2)*40) )
ang_index_2[i2]=(120 + (Cos(i2)*40) )
ang_index_3[i2]=(160 + (-Sin(i2)*40) )
ang_index_4[i2]=(120 + (-Cos(i2)*40) )
Next
End Method
Method OnUpdate()
If KeyHit(KEY_F1)
For Local y=0 To 240
'Local y1:Int=320 *y
For Local x= 0 To 320
xCanvas.SetImageDataPixel(imd, x*2,(y*2), 0, 0, 0, 255)
xCanvas.SetImageDataPixel(imd, (x*2)+1,(y*2) ,0, 0, 0, 255)
xCanvas.SetImageDataPixel(imd, (x*2),((y*2)+1), 0, 0, 0, 255)
xCanvas.SetImageDataPixel(imd, ((x*2)+1),((y*2)+1) ,0, 0, 0, 255)
Next
Next
'Cls
qt=qt+1
If qt>5 Then qt=0
If qt=0 Then qtext="Low Quality"
If qt=1 Then qtext="Med Quality"
If qt=2 Then qtext="Med-High Quality"
If qt=3 Then qtext="Highest Quality"
If qt=4 Then qtext="1/4 Screen H-Quality"
If qt=5 Then qtext="1/4 Screen x 4 H-Quality"
Endif
If KeyHit(KEY_F2)
For Local y=0 To 240
'Local y1:Int=320 *y
For Local x= 0 To 320
xCanvas.SetImageDataPixel(imd, x*2,(y*2), 0, 0, 0, 255)
xCanvas.SetImageDataPixel(imd, (x*2)+1,(y*2) ,0, 0, 0, 255)
xCanvas.SetImageDataPixel(imd, (x*2),((y*2)+1), 0, 0, 0, 255)
xCanvas.SetImageDataPixel(imd, ((x*2)+1),((y*2)+1) ,0, 0, 0, 255)
Next
Next
If widetext=""
ya=60
yb=180
widetext="WIDE -"
Else
ya=1
yb=239
widetext=""
Endif
Endif
If fxsel_ttl<millisecs() fxsel="" fxsel_ttl="Millisecs()+14000" if="">4 Then fxsel=0
Select fxsel
Case 0
fred=1
fblue=2
Case 1
fred=50
fblue=4
Case 2
fred=3
fblue=3
Case 3
fred=2
fblue=4
Case 4
fred=3
fblue=4
End Select
Endif
End Method
Method OnRender()
fps=fps+1
If fps_t<millisecs() fp="(fps)" fps_t="1000+Millisecs()" fps="0" endif="" ii="" if="">359 Then ii=0
Local x2:Int=ang_index_1[ii]
Local y2:Int=ang_index_2[ii]
Local x3:Int=ang_index_3[ii]
Local y3:Int=ang_index_4[ii]
'Draw Line
LineB(160,120,x2,y2)
LineB(160,120,x3,y3)
For Local zz=0 To 100
Local xz=Int(Rnd(50))+135
Local yz=Int(Rnd(50))+95
clrb1[ ( 320 *yz ) +xz ]=255
Next
For Local y=ya To yb
Local y2:Int=(320 *y)
For Local x= xa To xb
Local y1:Int=y2+x
'Apply mapping via lookup table
If fxsel=0
clrr[ y1 ] = clrr1[ mapx[ y1 ] ]
clrb[ y1 ] = clrb1[ mapx[ y1 ] ]
Else If fxsel=1
clrr[ y1 ] = clrr1[ mapx1[ y1 ] ]
clrb[ y1 ] = clrb1[ mapx1[ y1 ] ]
Else If fxsel=2
clrr[ y1 ] = clrr1[ mapx2[ y1 ] ]
clrb[ y1 ] = clrb1[ mapx2[ y1 ] ]
Else If fxsel=3
clrr[ y1 ] = clrr1[ mapx3[ y1 ] ]
clrb[ y1 ] = clrb1[ mapx3[ y1 ] ]
Else If fxsel=4
clrr[ y1 ] = clrr1[ mapx4[ y1 ] ]
clrb[ y1 ] = clrb1[ mapx4[ y1 ] ]
Endif
Next
Next
Local sumr,sumb,b,r
For Local y=ya To yb
Local y1:Int=320 *y
Local yn1:Int=y*2
For Local x= xa To xb
Local yn2:Int=y1+x
'Blur Image and Fade Color
r=clrr[yn2]
sumr = ((r*4) + clrr[ yn2+1 ] + clrr[ yn2-1 ] + clrr[ ( y1-1 ) + x ] + clrr[ ( y1+1 ) + x ] ) Shr 3
b=clrb[yn2]
sumb = ((b*4) + clrb[ yn2+1 ] + clrb[ yn2-1 ] + clrb[ ( y1-1 ) + x ] + clrb[ ( y1+1 ) + x ] ) Shr 3
r=sumr-fred
b=sumb-fblue
If r<0 then="" r="" if="">255 Then r=255
If b<0 then="" b="" if="">255 Then b=255
clrr1[ yn2 ]=r
clrb1[ yn2 ]=b
Local xn1:Int=x*2
If qt=0
xCanvas.SetImageDataPixel(imd, xn1,yn1, r, 0, b, 255)
Else If qt=1
xCanvas.SetImageDataPixel(imd, xn1,yn1, r, 0, b, 255)
xCanvas.SetImageDataPixel(imd, xn1,yn1+1, r, 0, b, 255)
Else If qt=2
xCanvas.SetImageDataPixel(imd, xn1,yn1, r, 0, b, 255)
xCanvas.SetImageDataPixel(imd, xn1+1,yn1 ,r, 0, b, 255)
xCanvas.SetImageDataPixel(imd, xn1,yn1+1, r, 0, b, 255)
Else If qt=3
xCanvas.SetImageDataPixel(imd, xn1,yn1, r, 0, b, 255)
xCanvas.SetImageDataPixel(imd, xn1+1,yn1 ,r, 0, b, 255)
xCanvas.SetImageDataPixel(imd, xn1,yn1+1, r, 0, b, 255)
xCanvas.SetImageDataPixel(imd, xn1+1,yn1+1 ,r, 0, b, 255)
Else If qt=4
xCanvas.SetImageDataPixel(imd, x,y, r, 0, b, 255)
Else If qt=5
xCanvas.SetImageDataPixel(imd, x,y, r, 0, b, 255)
xCanvas.SetImageDataPixel(imd, (x+319),y ,r, 0, b, 255)
xCanvas.SetImageDataPixel(imd, x,(y+239), r, 0, b, 255)
xCanvas.SetImageDataPixel(imd, (x+319),(y+239) ,r, 0, b, 255)
Endif
Next
Next
xCanvas.DrawImageData imd, 0, 0
DrawText("Hit F1/F2 Change Qualtity-Size/Wide Screen: "+widetext+" "+qtext,10,440)
DrawText("HTML5 Diffusion - Richard Betson, <a href="http://redeyeware.uphero.com" target="_blank">http://redeyeware.uphero.com</a> - FPS:"+fp,10,460)
End Method
Function LineB(x1,y1,x2,y2)
'Ported
'Bresenham Line Algorithm
'Source - GameDev.Net - Mark Feldman
'Public Domain
Local deltax = Abs(x2 - x1)
Local deltay = Abs(y2 - y1)
Local numpixels,d,dinc1,dinc2,xinc1,xinc2,yinc1,yinc2,x,y,i
If deltax >= deltay
numpixels = deltax + 1
d = (2 * deltay) - deltax
dinc1 = deltay Shl 1
dinc2 = (deltay - deltax) Shl 1
xinc1 = 1
xinc2 = 1
yinc1 = 0
yinc2 = 1
Else
numpixels = deltay + 1
d = (2 * deltax) - deltay
dinc1 = deltax Shl 1
dinc2 = (deltax - deltay) Shl 1
xinc1 = 0
xinc2 = 1
yinc1 = 1
yinc2 = 1
Endif
If x1 > x2
xinc1 = -xinc1
xinc2 = -xinc2
Endif
If y1 > y2
yinc1 = -yinc1
yinc2 = -yinc2
Endif
x = x1
y = y1
For i = 1 To numpixels
If d < 0
d = d + dinc1
x = x + xinc1
y = y + yinc1
Else
d = d + dinc2
x = x + xinc2
y = y + yinc2
Endif
'Draw line
If x>xa And x<xb and="" y="">ya And y<yb clrr1="" 320="" y="0" x="0" endif="" next="" end="" function="" method="" setlookup="" local="" ang="0" for="" lui="0" to="" 4="" 240="" rad="" abs="" y-120="" if="">0
rad= Sqrt(rad)
Else
rad=0
Endif
If rad=0 Then rad=1
Local dx#=((x-160)/(rad))
Local dy#=((y-120)/(rad))
If lui=1
rad= ( ( ( ((Sin(rad*.2)*29.5) ) * ( ((Cos(rad*.81)*9.5) ) ) ) ) )
dx=(dx*Cos(ang) - dy*Sin(ang))
dy=(dy*Cos(ang) + dx*Sin(ang))
Local x1=Int(dx*rad)+(160)
Local y1=Int(dy*rad)+(120)
If y1<1 then="" y1="" if="">240 Then y1=240
If x1<1 then="" x1="" if="">320 Then x1=320
mapx1[ ( 320 *y ) +x ] = ( 320 *y1 ) +x1'Int(x1)
Endif
If lui=2
'Free Float
ang=1
rad= 1-( ( rad- (Sin(rad*900)*-Cos(rad*900)*.5 )*3.1415926 ) * (-Cos((3.1415926) ) )*.9 )
Local x1=Int(dx*rad)+(160)
Local y1=Int(dy*rad)+(120)
x1= ( x1*Cos(ang) - y1*Sin(ang) )
y1= ( x1*Sin(ang) + y1*Cos(ang) )
If y1<1 then="" y1="" if="">240 Then y1=240
If x1<1 then="" x1="" if="">320 Then x1=320
mapx2[ ( 320 *y ) +x ] = ( 320 *y1 ) +x1
Endif
If lui=3
rad= rad-( (Sin(rad*PI)*3)- ((Cos(rad*PI)*3) ) )
dx=(dx*Cos(ang) - dy*Sin(ang))
dy=(dy*Cos(ang) + dx*Sin(ang))
Local x1=Int(dx*rad)+(160)
Local y1=Int(dy*rad)+(120)
If y1<1 then="" y1="" if="">240 Then y1=240
If x1<1 then="" x1="" if="">320 Then x1=320
mapx3[ ( 320 *y ) +x ] = ( 320 *y1 ) +x1
Endif
If lui=0
ang=-3
Local yq:Int=y
If yq<=120
rad= rad-( (Sin(yq)) )
rad= rad-( (Cos(yq)) )
Else
rad= rad-( (Sin((240-yq)) ) )
rad= rad-( (Cos((240-yq)) ) )
Endif
dx=(dx*Cos(ang) - dy*Sin(ang))
dy=(dy*Cos(ang) + dx*Sin(ang))
Local x1=Int(dx*rad)+(160)
Local y1=Int(dy*rad)+(120)
If y1<1 then="" y1="" if="">240 Then y1=240
If x1<1 then="" x1="" if="">320 Then x1=320
mapx[ ( 320 *y ) +x ] = ( 320 *y1 ) +x1
Endif
If lui=39
'Orb
rad= 2-( ( rad- (Sin(rad)*(Cos(rad)) )*3.1415926 ) * (-Cos((3.1415926) ))*.97 )
dx=(dx*Cos(ang) - dy*Sin(ang))
dy=(dy*Cos(ang) + dx*Sin(ang))
Local x1=Int(dx*rad)+(160)
Local y1=Int(dy*rad)+(120)
If y1<1 then="" y1="" if="">240 Then y1=240
If x1<1 then="" x1="" if="">320 Then x1=320
mapx3[ ( 320 *y ) +x ] = ( 320 *y1 ) +x1
Endif
If lui=4
'Swirl
ang=-3
rad= 1-( ( rad- (Sin(rad)*-Cos(rad)*.9 )*3.1415926 ) * (-Cos((3.1415926) ) )*.9 )
dx=(dx*Cos(ang) - dy*Sin(ang))
dy=(dy*Cos(ang) + dx*Sin(ang))
Local x1=Int(dx*rad)+(160)
Local y1=Int(dy*rad)+(120)
If y1<1 then="" y1="" if="">240 Then y1=240
If x1<1 then="" x1="" if="">320 Then x1=320
mapx4[ ( 320 *y ) +x ] = ( 320 *y1 ) +x1
Endif
Next
Next
Next
End Method
End Class