'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