Richard Russell
Administrator
member is offline
Posts: 1348
|
|
Sine Cube
« Thread started on: Oct 13th, 2015, 7:09pm » |
|
Copied from the Just BASIC forum, a clever technique for creating more 'sprites' than would normally be possible (actually I don't think LBB limits the number of sprites, but it's interesting none the less). This code works without modification in LB, JB and LBB (runs about 20% faster in LBB):
Code:'sinecube 2006 mennonite
'public domain
'2015.10.7 converted to JB
NoMainWin
Dim b(11,11), qbc$(15)
Global sw,sh
sw = 640: sh = 480 'Size of screen desired
'open a temporary graphics window to determine the
' size a frame surrounding a Window.
WindowWidth=300:WindowHeight=300
Open "." For Graphics_nsb_nf As #x
'find the coordinates of the center of temporary window
#x "Home; PosXY x y"
'calculate and assign actual dimensions needed to obtain
'the desired graphics window size
winx = sw+(300-2*x) : winy = sh+(300-2*y-2)
Close #x
WindowWidth = winx
WindowHeight = winy
h$ = "#g"
Open "Sine Cube by mennonite" For graphics_nsb_nf As #g
#g "Down;Fill black;Trapclose [xit]"
#g "when leftButtonDown [xit]"
Call QBColors
Call setCubeColors h$
Call gradient h$
Call setSprites h$
sizeL=8
sizeY=4
sizeX=8
maxVal=31
maxSize=maxVal+1
skipSize = maxSize-4
'==============================================================================
'2 = 1 circle/side; 4 = 2 circles; 6 = 3 circles; 8 = 4 circles; 10 = 5 circles
'==============================================================================
circlesPerSide = 63 'values of 1 to 63 are interesting
'==============================================================================
circlesOnSide = 3.14159265/maxSize * circlesPerSide
st = Time$("ms")
counter = 1
For l = 0 To maxVal
For y = 0 To maxVal
For x = 0 To maxVal
If l < skipSize And y < skipSize And x < skipSize Then
'==========================================
'Do nothing here. Eliminates implicit GOTO
'==========================================
Else
mm = Sin(x*y*l*circlesOnSide)
If mm < 0 Then
ox=( maxVal-x)*sizeX+y*sizeY+111
oy=y*sizeY+(maxVal-l)*sizeL+38
#g "SpriteXY c";counter;" ";ox;" ";oy
#g "SpriteVisible c";counter;" on"
counter=counter + 1
If counter > 500 Then
#g "DrawSprites"
#g "GetBMP bknd 0 0 640 480"
#g "Background bknd"
For i = 1 To 500
#g "SpriteVisible c";i;" off"
Next
counter = 1
End If
End If
End If
Next x
#g "Discard"
Next y
Next l
#g "DrawSprites"
#g "GetBMP bknd 0 0 640 480"
#g "drawbmp bknd 0 0"
et$ = Using("###.##",((Time$("ms"))-st)/1000)
#g "BackColor black;Color white;Place 600 15;\";et$
Wait
[xit]
UnloadBMP "cube"
UnloadBMP "bknd"
Close #g
End
Sub QBColors
For i = 0 to 15
Read c$
qbc$(i) = c$
Next
Data "0 0 1"'<--- front of cube 0
Data "40 21 0"'<-- color of cube edges 1 'Data "0 0 168"
Data "128 128 128"'<--- color of left side 2 'Data "8 168 8"
Data "64 64 64"'<--- color of top 3 'Data "0 168 168"
Data "168 0 0"
Data "168 0 168"
Data "168 84 0"
Data "168 168 168"
Data "0 0 0"'<--- used for masking 'Data "84 84 84"
Data "84 84 252"
Data "84 252 84"
Data "84 252 252"
Data "252 84 84"
Data "248 84 248"
Data "252 252 84"
Data "252 252 252"
End Sub
Sub gradient h$
#h$ "Fill black"
br = 82: bg = 82: bb = 82
For i = 0 To 632 Step 8
#h$ "Color ";br;" ";bg;" ";bb
#h$ "BackColor ";br;" ";bg;" ";bb
#h$ "Place ";i;" 0"
#h$ "BoxFilled ";i+8;" 479"
br = br - 1: bg = bg - 1: bb = bb - 1
Next
#h$ "GetBMP bknd 0 0 640 480"
#h$ "Background bknd"
End Sub
Sub setCubeColors h$
#h$ "Color white;BackColor white"
#h$ "Place 1 1;BoxFilled 11 11"
For j = 1 To 11
For i = 1 To 11
Read num
b(i,j) = num
If num<9 Then
#h$ "Color black;Set ";i;" ";j
End If
#h$ "Color ";qbc$(num);";Set ";i;" ";j+11
Next
Next
#h$ "GetBMP cube 1 1 11 22"
Data 0,0,0,0,0,0,0,0,9,9,9
Data 1,1,3,3,3,3,3,3,1,9,9
Data 1,2,1,3,3,3,3,3,3,1,9
Data 1,2,2,1,1,1,1,1,1,1,1
Data 1,2,2,1,0,0,0,0,0,0,1
Data 1,2,2,1,0,0,0,0,0,0,1
Data 1,2,2,1,0,0,0,0,0,0,1
Data 1,2,2,1,0,0,0,0,0,0,1
Data 9,1,2,1,0,0,0,0,0,0,1
Data 9,9,1,1,0,0,0,0,0,0,1
Data 9,9,9,1,1,1,1,1,1,1,1
End Sub
Sub setSprites h$
For i = 1 To 500
#h$ "AddSprite c";i;" cube"
Next
End Sub Richard.
|