LB Booster
Programming >> BASIC code examples >> Sine Cube
http://lbb.conforums.com/index.cgi?board=code&action=display&num=1444763387

Sine Cube
Post by Richard Russell 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.