LB Booster
« Sine Cube »

Welcome Guest. Please Login or Register.
Apr 1st, 2018, 04:38am



ATTENTION MEMBERS: Conforums will be closing it doors and discontinuing its service on April 15, 2018.
We apologize Conforums does not have any export functions to migrate data.
Ad-Free has been deactivated. Outstanding Ad-Free credits will be reimbursed to respective payment methods.

Thank you Conforums members.
Speed up Liberty BASIC programs by up to ten times!
Compile Liberty BASIC programs to compact, standalone executables!
Overcome many of Liberty BASIC's bugs and limitations!
LB Booster Resources
LB Booster documentation
LB Booster Home Page
LB Booster technical Wiki
Just BASIC forum
BBC BASIC Home Page
Liberty BASIC forum (the original)

« Previous Topic | Next Topic »
Pages: 1  Notify Send Topic Print
 thread  Author  Topic: Sine Cube  (Read 348 times)
Richard Russell
Administrator
ImageImageImageImageImage


member is offline

Avatar




Homepage PM


Posts: 1348
xx 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.
User IP Logged

Pages: 1  Notify Send Topic Print
« Previous Topic | Next Topic »

| |

This forum powered for FREE by Conforums ©
Terms of Service | Privacy Policy | Conforums Support | Parental Controls