3D cube drawing

neil · Post by **neil** » Dec 17, 2023 1:08

Here's a 3D cube drawing.

'3D cube drawing by neil

Screenres 500,500
Cls

Line (100,100)-(100,300)
Line (100,100)-(300,100)
Line (300,100)-(300,300)
Line (300,300)-(100,300)

Line (200,200)-(200,400)
Line (200,200)-(400,200)
Line (400,200)-(400,400)
Line (400,400)-(200,400)

Line (100,100)-(200,200)
Line (100,300)-(200,400)
Line (300,100)-(400,200)
Line (300,300)-(400,400)

sleep

Lothar Schirm · Post by **Lothar Schirm** » Dec 17, 2023 15:52

Looks nice, but I would prefer coding with a mathematical background, see viewtopic.php?t=24242. You can create a library with subs and functions for rotating a point around x-, y- or z-axis and projecting it on a 2D screen. Connecing all connected points on the screen by lines gives you a lot of possibilities to create 3D wire models or plots of functions z(x, y). I did that long time ago, see https://www.freebasic-portal.de/downloa ... en-77.html (sorry, in german).

neil · Post by **neil** » Dec 17, 2023 20:43

@Lothar Schirm
I drew the 3D cube on paper first. I wanted to see how to draw it with FreeBasic. I wasn't trying to animate it.

Here's a demo of how to draw it on paper, one line at a time.

Code: Select all

'3D cube drawing by neil

Screenres 500,500
Cls

Line (100,100)-(100,300)
sleep 1000,1
Line (100,100)-(300,100)
sleep 1000,1
Line (300,100)-(300,300)
sleep 1000,1
Line (300,300)-(100,300)
sleep 1000,1
Line (200,200)-(200,400)
sleep 1000,1
Line (200,200)-(400,200)
sleep 1000,1
Line (400,200)-(400,400)
sleep 1000,1
Line (400,400)-(200,400)
sleep 1000,1
Line (100,100)-(200,200)
sleep 1000,1
Line (100,300)-(200,400)
sleep 1000,1
Line (300,100)-(400,200)
sleep 1000,1
Line (300,300)-(400,400)

sleep

neil · Post by **neil** » Jan 06, 2024 2:10

A flight through a digital tunnel.
I am not sure how to program something like this In FreeBasic.
https://www.youtube.com/watch?v=HoA_BkpB4xE

UEZ · Post by **UEZ** » Jan 06, 2024 13:31

You may have a look here: http://lodev.org/cgtutor/tunnel.html

I've implemented it from the tutorial which can be found one my 1drv here: https://1drv.ms/f/s!AiLeZOpaFqSaowcheYd ... P?e=wGvTec

Alternatively have a look here: https://freebasic.net/forum/viewtopic.p ... 89#p278189 and download the AiO package with plenty of graphical examples where also some tunnel examples can be found.

neil · Post by **neil** » Jan 06, 2024 21:24

@UEZ
Thank You!

dodicat · Post by **dodicat** » Jan 07, 2024 19:19

For a solid cube only three faces are visible at any time.

Code: Select all

Screen 19 ' or 20 or 21
Dim As Long xr,yr
Screeninfo xr,yr

Type V3
    As Single x,y,z
End Type

Type angle3D             'FLOATS for angles for rotator
    As Single sx,sy,sz
    As Single cx,cy,cz
    Declare Static Function construct(As Single,As Single,As Single) As Angle3D
End Type

Function Angle3D.construct(x As Single,y As Single,z As Single) As Angle3D
    Return   Type (Sin(x),Sin(y),Sin(z), _
                  Cos(x),Cos(y),Cos(z))
End Function

Function Rotate(c As v3,p As v3,a As Angle3D,scale As v3=Type(1,1,1)) As v3
    Dim As Single dx=p.x-c.x,dy=p.y-c.y,dz=p.z-c.z
    Return Type<v3>((scale.x)*((a.cy*a.cz)*dx+(-a.cx*a.sz+a.sx*a.sy*a.cz)*dy+(a.sx*a.sz+a.cx*a.sy*a.cz)*dz)+c.x,_
    (scale.y)*((a.cy*a.sz)*dx+(a.cx*a.cz+a.sx*a.sy*a.sz)*dy+(-a.sx*a.cz+a.cx*a.sy*a.sz)*dz)+c.y,_
    (scale.z)*((-a.sy)*dx+(a.sx*a.cy)*dy+(a.cx*a.cy)*dz)+c.z)
End Function 

Function perspective(p As v3,eyepoint As v3) As v3
    Dim As Single   w=1+(p.z/eyepoint.z)
    Return Type<v3>((p.x-eyepoint.x)/w+eyepoint.x,_
    (p.y-eyepoint.y)/w+eyepoint.y,_
    (p.z-eyepoint.z)/w+eyepoint.z)
End Function

Sub DrawCubeFace(d() As V3,id As Long,c As Ulong)
'source of c code: http://code-heaven.blogspot.it/2009/10/simple-c-program-for-scan-line-polygon.html
'Some help from Pitto
    Static As v3 p(3)
    For z As Long=1 To 4
        p(z-1)=d(id,z)'transfer to a simple 1 D  array 0 to 3
    Next z
    #define ub Ubound
    Dim As Long Sy=1e6,By=-1e6,i,j,y,k
    Dim As Single a(Ub(p)+1,1),dx,dy
    For i =0 To Ub(p)
        a(i,0)=p(i).x
        a(i,1)=p(i).y
        If Sy>p(i).y Then Sy=p(i).y
        If By<p(i).y Then By=p(i).y
    Next i
    Dim As Single xi(Ub(a,1)),S(Ub(a,1))
    a(Ub(a,1),0) = a(0,0)
    a(Ub(a,1),1) = a(0,1)
    For i=0 To Ub(a,1)-1
        dy=a(i+1,1)-a(i,1)
        dx=a(i+1,0)-a(i,0)
        If dy=0 Then S(i)=1
        If dx=0 Then S(i)=0
        If dy<>0 Andalso dx<>0 Then S(i)=dx/dy
    Next i
    For y=Sy-1 To By+1
        k=0
        For i=0 To Ub(a,1)-1
            If (a(i,1)<=y Andalso a(i+1,1)>y) Orelse _
            (a(i,1)>y Andalso a(i+1,1)<=y) Then
            xi(k)=(a(i,0)+S(i)*(y-a(i,1)))
            k+=1
        End If
    Next i
    For j=0 To k-2
        For i=0 To k-2
            If xi(i)>xi(i+1) Then Swap xi(i),xi(i+1)
        Next i
    Next j
    For i = 0 To k - 2 Step 2
        Line (xi(i)+0,y)-(xi(i+1)+1-0,y),c 
    Next i
Next y
End Sub

Function Regulate(Byval MyFps As Long,Byref fps As Long) As Long
    Static As Double timervalue,lastsleeptime,t3,frames
    Var t=Timer
    frames+=1
    If (t-t3)>=1 Then t3=t:fps=frames:frames=0
    Var sleeptime=lastsleeptime+((1/myfps)-T+timervalue)*1000
    If sleeptime<1 Then sleeptime=1
    lastsleeptime=sleeptime
    timervalue=T
    Return sleeptime
End Function

Sub sort(Normals() As V3,painter() As Long)
    For p1 As Long  = 1 To 5
        For p2 As Long  = p1 + 1 To 6 
            If Normals(p1).z<Normals(p2).z Then Swap painter(p1),painter(p2):Swap Normals(p1),Normals(p2)
        Next p2
    Next p1
End Sub

Sub Expand(p() As V3,b As Single,shift As V3,i As Long)
    For n As Long=1 To 4
        p(i,n).x=b*p(i,n).x+shift.x
        p(i,n).y=b*p(i,n).y+shift.y
        p(i,n).z=b*p(i,n).z+shift.z
    Next n
End Sub
'================================= USE ===============================
'set the cube faces on (0,0,0) as centre
Dim As V3 Cube(1 To 6,1 To 4)= _
{{(-1,-1,-1),(1,-1,-1),(1,1,-1),(-1,1,-1)},_'front
{(1,-1,-1),(1,-1,1),(1,1,1),(1,1,-1)},_ 'right
{(-1,-1,1),(1,-1,1),(1,1,1),(-1,1,1)},_'back
{(-1,-1,-1),(-1,-1,1),(-1,1,1),(-1,1,-1)},_'left
{(1,1,-1),(1,1,1),(-1,1,1),(-1,1,-1)},_'top
{(1,-1,-1),(1,-1,1),(-1,-1,1),(-1,-1,-1)}}'base


'blow up and translate the cube to screen centre
For i As Long=1 To 6
    Expand (Cube(),(xr+yr)/10,Type<v3>(xr/2,yr/2,0),i)
Next i

Dim As V3 W(1 To 6,1 To 4)'the working array  
Dim As V3 eye= Type<V3>(xr/2,yr/2/2,xr+yr/2)          
Dim As V3 fulcrum=Type<V3>(xr/2,yr/2,0)            ' middle of cube
Dim As Long fps
Dim As Long painter(1 To 6)={1,2,3,4,5,6} 'fill order
Dim As Ulong colour(1 To 6)={1,2,3,4,5,6}
Dim As v3 normal(1 To 6) 'normals to cube faces
Dim As Single cx,cy,cz   'centriods for normals
Dim As Single x,y,z      'increments
Do
    x+=.01/2 'increments
    y+=.02/2
    z+=.03/2
    For m As Long=1 To 6
        cx=0:cy=0:cz=0
        For n As Long=1 To 4
            W(m,n)=Rotate(fulcrum,Cube(m,n),Angle3D.construct(x,y,z))
            W(m,n)=perspective(W(m,n),eye)  'apply the eye (perspective)
            'accumulate cx,cy,cz
            cx+=W(m,n).x:cy+=W(m,n).y:cz+=W(m,n).z
        Next n
        normal(m)=Type<v3>(cx/4,cy/4,cz/4) 'dead centre of each face
    Next m
    
    Screenlock
    Cls
    Draw String(10,30),"Frame Rate = " & fps
    'sort the face centriods and re-set the painter
    sort(normal(),painter())
    Locate 6,0
    Print "Painting order"
    For n As Long=1 To 6:Print "face  "; painter(n):Next n 
        For z As Long=4 To 6  'Paint only the closest three faces
              Var p=painter(z)
            DrawCubeFace(W(),p,colour(p))
            Locate p+6,12
            Print "paint"
        Next z
        
        Screenunlock
        'reset painter
        For n As Long=1 To 6:painter(n)=n:Next n 
            Sleep regulate(60,fps),1
        Loop Until Inkey=Chr(27)
        Sleep

neil · Post by **neil** » Jan 07, 2024 22:32

Nice one dodicat.
Here's a wormhole tunnel type effect by UEZ.

Code: Select all

 'Ported from https://codegolf.dweet.net/a/246 by cantelope to FB by UEZ build 2020-10-23

#Include "fbgfx.bi"
#Include "crt/math.bi"

Using FB

#Define Map(Val, source_start, source_stop, dest_start, dest_stop)   ((Val - source_start) * (dest_stop - dest_start) / (source_stop - source_start) + dest_start)
#Define Min(a, b)	(Iif(a < b, a, b))
#Define Max(a, b)	(Iif(a > b, a, b))

Const f23 = 2 / 3, f13 = 1 / 3, f16 = 1 / 6

Function HUE2RGB(p As Single, q As Single, t As Single) As Single
	If t < 0 Then t += 1
	If t > 1 Then t -= 1
	If t < f16 Then Return p + (q - p) * 6 * t
	If t < 0.5 Then Return q
	If t < f23 Then Return p + (q - p) * (f23 - t) * 6
	Return p
End Function

Function HSL2RGB(H As Single, S As Single, L As Single, a As Ubyte = 255) As Ulong
	#Define to255(v)	(Max(0, Min(255, 256 * v)))
	Dim As Single r, g, b
	If S = 0 Then
		r = L : g = L : b = L
	Else
		Dim As Single p, q
		q = Iif(L < 0.5, L * (1 + S), L + S - L * S)
		p = 2 * L - q
		r = HUE2RGB(p, q, H + f13)
		g = HUE2RGB(p, q, H)
		b = HUE2RGB(p, q, H - f13)
	End If
	Return a Shl 24 Or to255(r) Shl 16 Or to255(g) Shl 8 Or to255(b) Shl 0
End Function

Randomize
Dim As Integer w = 1920 Shr 1, h = 1080 Shr 1, w2 = w Shr 1, h2 = h Shr 1

Screenres w, h, 32, 2, GFX_ALWAYS_ON_TOP Or GFX_ALPHA_PRIMITIVES Or GFX_NO_SWITCH
Screenset 1, 0
Color &hFF, &hFF000000
Cls

Const PI = Acos(-1)
Dim As ULong iFPS, cfps = 0
Dim As Double fTimer = Timer, t = 0
Dim As Long sides = 16, depth = 35, i, m
Dim As Single px, py, nx, ny, v = PI * 2 / sides, s = PI * 2 / depth, e, d, f, g, q, qq, o, p, pp, r, x, y, z, zz, j

#Macro DrawLine(k)
	zz = Iif(z > 0.1, z, 0.1)
	If k Then 
		px = w2 + X / zz * w2
		py = h2 + Y / zz * w2
	Else
		nx = w2 + X / zz * w2
		ny = h2 + Y / zz * w2
		Line (px, py) - (nx, ny), HSL2RGB((360 / sides * i + q * 9), 0.10, (0.7 - 0.7 / depth * q), (0.57 + Sin(t * 2) * 0.43) * &hFF)
		px = nx
		py = ny
	End If
#Endmacro

Do
	Cls
	d = t / 2
	j = Sin(d) / 2
	f = j * 12
	e = t * 2
	g = Cos(e) * 1.5
	For m = depth To 0 Step -1
		For i = sides To 0 Step -1
			q = m - fmod(t * 6,  1)
			o = Sin(s * 2 * j * q + d) * 6 - f
			pp = Sin(s * 2 * j * (q + 1) + d) * 6 - f
			qq = Cos(s * 3 * j * q + e) * 1.5 - g
			r = Cos(s * 3 * j * (q + 1) + e) * 1.5 - g
			p = v*i
			x = Sin(p) + o
			y = Cos(p) + qq
			z = q
			DrawLine(1)
			p += v
			x = Sin(p) + o
			y = Cos(p) + qq
			z = q 
			DrawLine(0)
			x = Sin(p) + pp
			y = Cos(p) + r
			q +=1
			z = q
			DrawLine(0)
			p -= v
			x = Sin(p) + pp
			y = Cos(p) + r
			z = q
			DrawLine(0)
			t += 0.00001
		Next
	Next
	Draw String(4, 4), iFPS & " fps", &hFF00FF00
	Flip	
	
	cfps += 1
	If Timer - fTimer > 0.99 Then
		iFPS = cfps
		cfps = 0
		fTimer = Timer
	End If
	Sleep(1)
Loop Until Len(Inkey())

dodicat · Post by **dodicat** » Jan 08, 2024 11:52

Thank you neil.
I have a feeling that UEZ might have actually been on a similar winding journey in real time, or should I say spacetime.

neil · Post by **neil** » Jan 09, 2024 4:11

@dodicat
Here's a demo I found using OpenGL. It's a rotating pyramid with a rotating flat panel. It worked fine using Linux.
I noticed your rotating cube didn't require any external library's like OpenGL.

Code: Select all

#include once "GL/gl.bi"
#include once "GL/glu.bi"
#include once "GL/glut.bi"

''
declare sub         doMain           ( )
declare sub         doShutdown		 ( )

    ''
    '' Entry point
    ''
    doMain

'' ::::::::::::
'' name: doRender
'' desc: Is called by glut to render scene
''
'' ::::::::::::
sub doRender cdecl
    static rtri as single
    static rqud as single
    
    glClear GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT
    glPushMatrix
    
    glLoadIdentity
    glTranslatef -1.5, 0.0, -6.0
    glRotatef rtri, 0, 1, 0
         
    glBegin GL_TRIANGLES
		glColor3f   1.0, 0.0, 0.0			'' Red
		glVertex3f  0.0, 1.0, 0.0			'' Top Of Triangle  Front)
		glColor3f   0.0, 1.0, 0.0			'' Green
		glVertex3f -1.0,-1.0, 1.0			'' Left Of Triangle  Front)
		glColor3f   0.0, 0.0, 1.0			'' Blue
		glVertex3f  1.0,-1.0, 1.0			'' Right Of Triangle  Front)
		glColor3f   1.0, 0.0, 0.0			'' Red
		glVertex3f  0.0, 1.0, 0.0			'' Top Of Triangle  Right)
		glColor3f   0.0, 0.0, 1.0			'' Blue
		glVertex3f  1.0,-1.0, 1.0			'' Left Of Triangle  Right)
		glColor3f   0.0, 1.0, 0.0			'' Green
		glVertex3f  1.0,-1.0,-1.0			'' Right Of Triangle  Right)
        glColor3f   1.0, 0.0, 0.0			'' Red
		glVertex3f  0.0, 1.0, 0.0			'' Top Of Triangle  Back)
		glColor3f   0.0, 1.0, 0.0			'' Green
		glVertex3f  1.0,-1.0,-1.0			'' Left Of Triangle  Back)
		glColor3f   0.0, 0.0, 1.0			'' Blue
		glVertex3f -1.0,-1.0,-1.0			'' Right Of Triangle  Back)
		glColor3f   1.0, 0.0, 0.0			'' Red
		glVertex3f  0.0, 1.0, 0.0			'' Top Of Triangle  Left)
		glColor3f   0.0, 0.0, 1.0			'' Blue
		glVertex3f -1.0,-1.0,-1.0			'' Left Of Triangle  Left)
		glColor3f   0.0, 1.0, 0.0			'' Green
		glVertex3f -1.0,-1.0, 1.0			'' Right Of Triangle  Left)
    glEnd
    
    glColor3f 0.5, 0.5, 1.0
    glLoadIdentity    
    glTranslatef -1.5, 0.0, -6.0
	glTranslatef 3.0,0.0,0.0	
	glRotatef rqud, 1.0, 0.0, 0.0
	
	glBegin GL_QUADS
		glVertex3f -1.0, 1.0, 0.0
		glVertex3f  1.0, 1.0, 0.0
		glVertex3f  1.0,-1.0, 0.0
		glVertex3f -1.0,-1.0, 0.0
	glEnd    

    glPopMatrix            
    glutSwapBuffers
    
    rtri = rtri + 2.0
    rqud = rqud + 1.5
    
end sub


'' ::::::::::::
'' name: doInput
'' desc: Handles input
''
'' ::::::::::::
sub doInput CDECL ( byval kbcode as unsigned byte, _
              byval mousex as integer, _
              byval mousey as integer )
              
    if ( kbcode = 27 ) then
        doShutdown
        end 0
    end if

end sub


'' ::::::::::::
'' name: doInitGL
'' desc: Inits OpenGL
''
'' ::::::::::::
sub doInitGL
    dim i as integer
    dim lightAmb(3) as single
    dim lightDif(3) as single
    dim lightPos(3) as single
    
    ''
    '' Rendering stuff
    ''
    glShadeModel GL_SMOOTH
	glClearColor 0.0, 0.0, 0.0, 0.5
	glClearDepth 1.0
	glEnable GL_DEPTH_TEST
	glDepthFunc GL_LEQUAL
    glEnable GL_COLOR_MATERIAL
	glHint GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST
    
    ''
    '' Light setup ( not used at the moment )
    ''
    for i = 0 to 3
        lightAmb(i) = 0.5
        lightDif(i) = 1.0
        lightPos(i) = 0.0
    next i

    lightAmb(3) = 1.0
    lightPos(2) = 2.0
    lightPos(3) = 1.0    
	
    glLightfv GL_LIGHT1, GL_AMBIENT, @lightAmb(0)
	glLightfv GL_LIGHT1, GL_DIFFUSE, @lightDif(0)
	glLightfv GL_LIGHT1, GL_POSITION,@lightPos(0)
	glEnable GL_LIGHT1

    ''
    '' Blending ( not used at the moment )
    ''
    glColor4f 1.0, 1.0, 1.0, 0.5
    glBlendFunc GL_SRC_ALPHA, GL_ONE

end sub


'' ::::::::::::
'' name: doReshapeGL
'' desc: Reshapes GL window
''
'' ::::::::::::
sub doReshapeGL CDECL ( byval w as integer, _
                        byval h as integer )
    
    glViewport 0, 0, w, h 
    glMatrixMode GL_PROJECTION
    glLoadIdentity
    
    if ( h = 0 ) then
        gluPerspective  80/2, w, 1.0, 5000.0 
    else
        gluPerspective  80/2, w / h, 1.0, 5000.0
    end if
    
    glMatrixMode GL_MODELVIEW
    glLoadIdentity

end sub

'':::::
sub initGLUT
    ''
    '' Setup glut
    ''
    glutInit 1, strptr( " " )    
    
    glutInitWindowPosition 0, 0
    glutInitWindowSize 640, 480
    glutInitDisplayMode GLUT_RGBA or GLUT_DOUBLE or GLUT_DEPTH
    glutCreateWindow "FreeBASIC OpenGL example"
    
    doInitGL
    
    glutDisplayFunc  @doRender
    glutIdleFunc     @doRender
    glutReshapeFunc  @doReshapeGL
    glutKeyboardFunc @doInput

end sub

'':::::
sub doInit
    
	''
	'' Init GLUT
	''
	initGLUT    
	
end sub

'':::::
sub shutdownGLUT

	'' GLUT shutdown will be done automatically by atexit()

end sub

'':::::
sub doShutdown
    
	''
	'' GLUT
	''
	shutdownGLUT
	
end sub

'' ::::::::::::
'' name: doMain
'' desc: Main routine
''
'' ::::::::::::
sub doMain
    
    ''
    '' 
    ''
    doInit
    
    ''
    ''
    ''
    glutMainLoop
    
end sub

neil · Post by **neil** » Jan 09, 2024 8:30

Here's a rotating Rubik's cube by badidea. It requires OpenB3D. It worked with Linux.

Code: Select all

#include "openb3d/openb3d.bi"
#include "fbgfx.bi"

const as integer screen_width = 800, screen_height = 600

'-------------------------------------------------------------------------------

sub object_key_control(obj as any ptr)
   if multikey(FB.SC_UP) then TurnEntity(obj, 0, 0, 2)
   if multikey(FB.SC_DOWN) then TurnEntity(obj, 0, 0,-2)
   if multikey(FB.SC_LEFT) then TurnEntity(obj, 0, 2, 0)
   if multikey(FB.SC_RIGHT) then TurnEntity(obj, 0,-2, 0)
   if multikey(FB.SC_PAGEUP) then TurnEntity(obj, 2, 0, 0)
   if multikey(FB.SC_PAGEDOWN) then TurnEntity(obj, -2, 0, 0)
end sub

'-------------------------------------------------------------------------------

#define RGBA_A(c) (cuint(c) shr 24)
#define RGBA_R(c) ((cuint(c) shr 16) and &hFF)
#define RGBA_G(c) ((cuint(c) shr 8) and &hFF)
#define RGBA_B(c) (cuint(c) and &hFF)

#define rnd_range(low, high) (rnd(1) * ((high) - (low)) + (low))

const as long FACE_FRONT = 0 'red
const as long FACE_BACK = 1 'orange
const as long FACE_LEFT = 2 'green
const as long FACE_RIGHT = 3 'blue
const as long FACE_TOP = 4 'white
const as long FACE_BOTTOM = 5 'yellow

const as ulong CL_RED = &hB80A31 'front
const as ulong CL_ORANGE = &hFF5700 'back
const as ulong CL_GREEN = &h009C46 'left
const as ulong CL_BLUE = &h0044AF 'right
const as ulong CL_WHITE = &hFFFFFF 'top / up
const as ulong CL_YELLOW = &hFFD600 'bottom / down

'-------------------------------------------------------------------------------

type cubie_type
   dim as any ptr entity
   dim as any ptr quad(0 to 5)
   dim as ulong faceColor(0 to 5) '0 for no quad (F,B,L,F,U,D)
end type

dim as cubie_type cubie(-1 to +1, -1 to +1, -1 to +1) 'x,y,z

'set face color, 0 for no face
for x as integer = -1 to +1
   for y as integer = -1 to +1
      for z as integer =-1 to +1
         with cubie(x, y, z)
            if x = -1 then .faceColor(FACE_LEFT) = CL_GREEN
            if x = +1 then .faceColor(FACE_RIGHT) = CL_BLUE
            if y = -1 then .faceColor(FACE_BOTTOM) = CL_YELLOW
            if y = +1 then .faceColor(FACE_TOP) = CL_WHITE
            if z = -1 then .faceColor(FACE_FRONT) = CL_RED
            if z = +1 then .faceColor(FACE_BACK) = CL_ORANGE
         end with
      next
   next
next

'turn 6 quad faces to make a 6-color cube
'order: front, back, left, right, up, down
dim as single quadPitch(0 to 5) = {0, 180,   0,   0, -90, +90}
dim as single quadYaw(0 to 5) =   {0,   0, -90, +90,   0,   0}

' Set video mode
screencontrol(FB.SET_GL_2D_MODE, FB.OGL_2D_MANUAL_SYNC)
screenres(screen_width, screen_height, 32, 1, FB.GFX_OPENGL) 'or GFX_MULTISAMPLE or GFX_ALPHA_PRIMITIVES)
Graphics3d(screen_width, screen_height, 32, 1, 1)

' Setup light and camera
var light1 = CreateLight(1)
var cam1 = CreateCamera()
CameraViewport(cam1, 0, 0, screen_width, screen_height)
PositionEntity(cam1, 0, 0, -5) 'move camera back

dim as string mystr = ""

'central pivot point (to rotate the entire cube)
var pivot = CreatePivot()

dim as integer count = 0
for x as integer = -1 to +1
   for y as integer = -1 to +1
      for z as integer =-1 to +1
         with cubie(x, y, z)
            'build a small cube from 6 quads  with each side a different color
            .entity = CreateCube(pivot) 'has parent pivot, is parent for quads
            ScaleMesh(.entity, 0.48, 0.48, 0.48)
            EntityColor(.entity, 40, 40, 40)
            MoveEntity(.entity, x, y, z)
            for i as integer = 0 to 5
               dim as ulong c = .faceColor(i)
               if c <> 0 then
                  .quad(i) = CreateQuad(.entity) 'child of cubie
                  EntityColor(.quad(i), RGBA_R(c), RGBA_G(c), RGBA_B(c))
                  PositionMesh(.quad(i), 0, 0, -1)
                  ScaleMesh(.quad(i), 0.42, 0.42, 0.50)
                  RotateMesh(.quad(i), quadPitch(i), quadYaw(i), 0)
                  'EntityParent(quad(i), pivot1)
               end if
            next
         end with
         count += 1
         'if count = 3 then exit for,for,for
      next
   next
next

'EntityParent(cubie, pivot2)
'PositionMesh(cubie, 2, 1, 3)
'TurnEntity(pivot, 20, 30, 0)
'RotateEntity(cubie, 20, 30, 0)

'wireframe(1)

'Make freebasic print work on 3d screen (2d2.bi)
'dim as font2d f2d

'-------------------------------------------------------------------------------

randomize timer
dim as single dPitch, dYaw, dRoll
dim as double tUpdate = timer + 1
while not multikey(FB.SC_ESCAPE)
   object_key_control(pivot) ' control cube1 with arrow keys
   TurnEntity(pivot, dPitch, dYaw, dRoll)
   UpdateWorld()
   RenderWorld()
   'f2d.print(10, 10, "Hello Cube! " & mystr)
   flip
   sleep 1
   if timer > tUpdate then
      tUpdate = timer + 3 'change somthing again in 3 second
      dim as integer choice = int(rnd_range(0, 3))
      if choice = 0 then dPitch = rnd_range(-1, +1)
      if choice = 1 then dYaw = rnd_range(-1, +1)
      if choice = 2 then dRoll = rnd_range(-1, +1)
   end if
wend
sleep
end

dodicat · Post by **dodicat** » Jan 09, 2024 12:48

Here is a gold plated cube.

Code: Select all

 
Screen 19,32 ' or 20 or 21
Dim As Long xr,yr
Screeninfo xr,yr
Color Rgb(192,192,192),Rgb(0,0,0)
Windowtitle "Golden cube"
Type V3
    As Single x,y,z
End Type

Type angle3D             'FLOATS for angles for rotator
    As Single sx,sy,sz
    As Single cx,cy,cz
    Declare Static Function construct(As Single,As Single,As Single) As Angle3D
End Type

Function Angle3D.construct(x As Single,y As Single,z As Single) As Angle3D
    Return   Type (Sin(x),Sin(y),Sin(z), _
                  Cos(x),Cos(y),Cos(z))
End Function

Function Rotate(c As v3,p As v3,a As Angle3D,scale As v3=Type(1,1,1)) As v3
    Dim As Single dx=p.x-c.x,dy=p.y-c.y,dz=p.z-c.z
    Return Type<v3>((scale.x)*((a.cy*a.cz)*dx+(-a.cx*a.sz+a.sx*a.sy*a.cz)*dy+(a.sx*a.sz+a.cx*a.sy*a.cz)*dz)+c.x,_
    (scale.y)*((a.cy*a.sz)*dx+(a.cx*a.cz+a.sx*a.sy*a.sz)*dy+(-a.sx*a.cz+a.cx*a.sy*a.sz)*dz)+c.y,_
    (scale.z)*((-a.sy)*dx+(a.sx*a.cy)*dy+(a.cx*a.cy)*dz)+c.z)
End Function 

Function perspective(p As v3,eyepoint As v3) As v3
    Dim As Single   w=1+(p.z/eyepoint.z)
    Return Type<v3>((p.x-eyepoint.x)/w+eyepoint.x,_
    (p.y-eyepoint.y)/w+eyepoint.y,_
    (p.z-eyepoint.z)/w+eyepoint.z)
End Function

Function dot(p As v3,v2 As v3) As Single 'dot product |v1| * |v2| *cos(angle between v1 and v2)
      Dim As Single d1=Sqr(p.x*p.x + p.y*p.y+ p.z*p.z),d2=Sqr(v2.x*v2.x + v2.y*v2.y +v2.z*v2.z)
      Dim As Single v1x=p.x/d1,v1y=p.y/d1,v1z=p.z/d1 'normalize
      Dim As Single v2x=v2.x/d2,v2y=v2.y/d2,v2z=v2.z/d2 'normalize
      Return (v1x*v2x+v1y*v2y+v1z*v2z)
End Function

Sub DrawCubeFace(d() As V3,id As Long,c As Ulong)
'source of c code: http://code-heaven.blogspot.it/2009/10/simple-c-program-for-scan-line-polygon.html
'Some help from Pitto in translation
    Static As v3 p(3)
    For z As Long=1 To 4
        p(z-1)=d(id,z)'transfer to a simple 1 D  array 0 to 3
    Next z
    #define ub Ubound
    Dim As Long Sy=1e6,By=-1e6,i,j,y,k
    Dim As Single a(Ub(p)+1,1),dx,dy
    For i =0 To Ub(p)
        a(i,0)=p(i).x
        a(i,1)=p(i).y
        If Sy>p(i).y Then Sy=p(i).y
        If By<p(i).y Then By=p(i).y
    Next i
    Dim As Single xi(Ub(a,1)),S(Ub(a,1))
    a(Ub(a,1),0) = a(0,0)
    a(Ub(a,1),1) = a(0,1)
    For i=0 To Ub(a,1)-1
        dy=a(i+1,1)-a(i,1)
        dx=a(i+1,0)-a(i,0)
        If dy=0 Then S(i)=1
        If dx=0 Then S(i)=0
        If dy<>0 Andalso dx<>0 Then S(i)=dx/dy
    Next i
    For y=Sy-1 To By+1
        k=0
        For i=0 To Ub(a,1)-1
            If (a(i,1)<=y Andalso a(i+1,1)>y) Orelse _
            (a(i,1)>y Andalso a(i+1,1)<=y) Then
            xi(k)=(a(i,0)+S(i)*(y-a(i,1)))
            k+=1
        End If
    Next i
    For j=0 To k-2
        For i=0 To k-2
            If xi(i)>xi(i+1) Then Swap xi(i),xi(i+1)
        Next i
    Next j
    For i = 0 To k - 2 Step 2
        Line (xi(i)+0,y)-(xi(i+1)+1-0,y),c 
    Next i
Next y
End Sub

Function Regulate(Byval MyFps As Long,Byref fps As Long) As Long
    Static As Double timervalue,lastsleeptime,t3,frames
    Var t=Timer
    frames+=1
    If (t-t3)>=1 Then t3=t:fps=frames:frames=0
    Var sleeptime=lastsleeptime+((1/myfps)-T+timervalue)*1000
    If sleeptime<1 Then sleeptime=1
    lastsleeptime=sleeptime
    timervalue=T
    Return sleeptime
End Function

Sub sort(FaceCentroids() As V3,painter() As Long)
    For p1 As Long  = 1 To 5
        For p2 As Long  = p1 + 1 To 6 
            If FaceCentroids(p1).z<FaceCentroids(p2).z Then Swap painter(p1),painter(p2):Swap FaceCentroids(p1),FaceCentroids(p2)
        Next p2
    Next p1
End Sub

Sub Expand(p() As V3,b As Single,shift As V3,i As Long)
    For n As Long=1 To 4
        p(i,n).x=b*p(i,n).x+shift.x
        p(i,n).y=b*p(i,n).y+shift.y
        p(i,n).z=b*p(i,n).z+shift.z
    Next n
End Sub
'================================= USE ===============================
'set the cube faces on (0,0,0) as centre
Dim As V3 Cube(1 To 6,1 To 4)= _
{{(-1,-1,-1),(1,-1,-1),(1,1,-1),(-1,1,-1)},_'front
{(1,-1,-1),(1,-1,1),(1,1,1),(1,1,-1)},_ 'right
{(-1,-1,1),(1,-1,1),(1,1,1),(-1,1,1)},_'back
{(-1,-1,-1),(-1,-1,1),(-1,1,1),(-1,1,-1)},_'left
{(1,1,-1),(1,1,1),(-1,1,1),(-1,1,-1)},_'top
{(1,-1,-1),(1,-1,1),(-1,-1,1),(-1,-1,-1)}}'base
'blow up and translate the cube to screen centre
For i As Long=1 To 6
    Expand (Cube(),(xr+yr)/10,Type<v3>(xr/2,yr/2,0),i)
Next i

Dim As V3 W(1 To 6,1 To 4)'the working array  
Dim As V3 eye= Type<V3>(xr/2,yr/2/2,xr+yr/2)          
Dim As V3 fulcrum=Type<V3>(xr/2,yr/2,0)       ' middle of cube
Dim As Long fps
Dim As Long painter(1 To 6)={1,2,3,4,5,6} 'fill order
Dim As v3 FaceCentroid(1 To 6) 'Centroids of cube faces
Dim As Single cx,cy,cz   'elements for centroids
Dim As Single x,y,z      'increments
Var colour=Rgb(255,215,0)
Var col=Cptr(Ubyte Ptr,@colour)
Var lightsource=Type<v3>(1,0,0)
#define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)
Do
    x+=.01/2 'increments
    y+=.02/2
    z+=.03/2
    For m As Long=1 To 6
        cx=0:cy=0:cz=0
        For n As Long=1 To 4
            W(m,n)=Rotate(fulcrum,Cube(m,n),Angle3D.construct(x,y,z))
            W(m,n)=perspective(W(m,n),eye)  'apply the eye (perspective)
            cx+=W(m,n).x:cy+=W(m,n).y:cz+=W(m,n).z 'accumulate cx,cy,cz
        Next n
        FaceCentroid(m)=Type(cx/4,cy/4,cz/4)  'dead centre of each face
    Next m
    Screenlock
    Cls
    Draw String(10,30),"Frame Rate = " & fps
    'sort the face centriods by .z value and set the painter
    sort(FaceCentroid(),painter())
    Locate 6,0
    Print "Painting order"
    For n As Long=1 To 6:Print "face  "; painter(n):Next n 
        For z As Long=4 To 6  'Paint only the closest three faces
              Var p=painter(z)
               Var FaceNormal=Type<v3>((FaceCentroid(z).x-fulcrum.x),(FaceCentroid(z).y-fulcrum.y),(FaceCentroid(z).z-fulcrum.z))
             'shading
            Dim As Single dt=dot(FaceNormal,lightsource)
            Var dtt=map(1,-1,dt,.05,1)
            Dim As Ulong clr=Rgb(dtt*col[2],dtt*col[1],dtt*col[0])
            DrawCubeFace(W(),p,clr)
            Locate p+6,12
            Print "paint"
        Next z
        Screenunlock
        For n As Long=1 To 6:painter(n)=n:Next n 'reset the painter
            Sleep regulate(60,fps),1
        Loop Until Inkey=Chr(27)
        Sleep

I had a rubik cube posted a while back,
viewtopic.php?p=253215&hilit=rubik#p253215

I have not tried Badidea's, I dont have openb3d.bi.

Also I don't have glut32.dll, so I cannot test the pyramid.
(Windows 11)
I have opengl.
Here are two cubes, one opengl and the other fb, can you tell them apart?
viewtopic.php?t=28423&hilit=versus
(Windows only)

neil · Post by **neil** » Jan 09, 2024 22:36

@dodicat
Your Rubik's cube and gold cube run fine on Linux. As for your two cubes using Windows 10, I can't tell them apart.
If you or anyone else wants to try OpenB3D, here's the link: https://sourceforge.net/projects/minib3d/files/

Also James Madison University has the missing glut32.dll file. Here's a link to glut32.dll: https://w3.cs.jmu.edu/bernstdh/Web/comm ... -setup.php

Once you are at the university site, click on GLUT 3.7.6 for the zip file.
I tested the glut32.dll on Windows 10, and it works on the OpenGL pyramid example.
It only works with the FreeBasic 32 bit compiler. Using Windows 10 it rotates way too fast.
Maybe you can figure out how to slow it down some.

dodicat · Post by **dodicat** » Jan 10, 2024 16:13

Thanks neil, I got them both working.
For the opengl speed, just put sleep 20 at the end of the dorender sub.

neil · Post by **neil** » Jan 10, 2024 22:11

@dodicat
I read online that OpenGL is OK, but the GLUT library is outdated and abandoned. New code shouldn't be written using GLUT.
I suppose you don't always need external graphic libraries. What's impressive is that your White Dwarf is on the move with hangers on.
You have seven objects in motion; six of them are orbiting a dodecahedron. Also, there is an animated starfield. It runs smoothly with no hiccups. and no external graphic libraries are needed.

3D cube drawing

3D cube drawing

Re: 3D cube drawing

Re: 3D cube drawing

Re: 3D cube drawing

Re: 3D cube drawing

Re: 3D cube drawing

Re: 3D cube drawing

Re: 3D cube drawing

Re: 3D cube drawing

Re: 3D cube drawing

Re: 3D cube drawing

Re: 3D cube drawing

Re: 3D cube drawing

Re: 3D cube drawing

Re: 3D cube drawing