3D Geometry , basics

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
fxm
Moderator
Posts: 12081
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: 3D Geometry , basics

Post by fxm »

Why 'end' in the middle of the main code?
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Re: 3D Geometry , basics

Post by D.J.Peters »

You can give select case a try.

Joshy

Code: Select all

function pal_spectra(I as integer, M as integer, ap as ubyte) as ulong
  const as single GAMMA =.8
  const as integer MAX = 255
  dim as single WL,R,G,B,HST
  WL = 380 + (i*400/M)
  select case WL
  case 380 to 440 : G = 0 : B = 1 : R = (WL-440)/(440-380)*-1 
  case 440 to 490 : R = 0 : B = 1 : G = (WL-440)/(490-440)
  case 490 to 510 : R = 0 : G = 1 : B = (WL-510)/(510-490)*-1
  case 510 to 580 : G = 1 : B = 0 : R = (WL-510)/(580-510)
  case 580 to 645 : R = 1 : B = 0 : G = (WL-645)/(645-580)*-1
  case 645 to 780 : R = 1 : G = 0 : B = 0
  end select
  IF (WL>700.) THEN
    HST=.3+.7* (780.-WL)/(780.-700.)
  ELSEIF (WL<420.) THEN
    HST=.3+.7*(WL-380.)/(420.-380.)
  ELSE
    HST=1.
  ENDIF
  R=(HST*R)^GAMMA : G=(HST*G)^GAMMA : B=(HST*B)^GAMMA
  return RGBA(255*R,255*G,255*B,ap)
end function
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: 3D Geometry , basics

Post by dodicat »

Luxan
You need to define a screen to utilize alpha
Either flag 64 or GFX_ALPHA_PRIMITIVES from fbgfx.bi.

Code: Select all


'same dimensions as screen 14
screenres 320,240, 32,,64    '  32 bit  color  depth  with alpha primitives flagged (64) .

circle(100,120),50,rgba(200,0,0,255),,,,f 'Or just rgb(200,0,0)

circle(150,120),50,rgba(0,200,0,155),,,,f
sleep 
Luxan
Posts: 222
Joined: Feb 18, 2009 12:47
Location: New Zealand

Re: 3D Geometry , basics

Post by Luxan »

fxm

The 'end' in the middle of the code is to signify the
last part of the main portion; after that the subroutines
and functions are in some respects separate, like you
have when you load a library.
I know some coders have their functions and subroutines
first, without declaring them, then the main part of the
code; for some dialects of Basic this might be appropriate.

For FreeBasic I tend to follow the layout of C programs,
header, routines, main; or possibly header, main, routines.

I find this is an easy way to keep track of routines and
helps when you want to construct libraries and header, *.bi,
files from portions of your code.

Also I put various 'end' commands in the code when I'm just
trying out notions; in the final edit I remove all except
one of these.



dodicat

Your example , with the flag 64 enabled,
does indeed work.

Using this with the previous code produces a
visible range of changing color brightness.
The background is white, so low values of alpha
may allow that to show through.

Code: Select all


 
'      Hu_color2.bas

'       palette values , based upon the human response to light 
 
declare function pal_spectra(I as integer, M as integer, ap as ubyte) as ulong

'
' ----------------------------------------------------------------------
'
'screen 14, 32    '  32 bit  color  depth  .

screenres 320,240, 32,,64    '  32 bit  color  depth  with alpha primitives flagged (64) .
view (20,20)-(620,320)

'  reccomend , M > = 400, to avoid artifacts .

dim as integer M,i,j
M = 400
window(-10,-10)-(M+10,110) 
line(-10,-10)-(M+10,110),11,b
line(0,0)-(M,100),rgb(255,255,255),bf
'sleep
dim as ulong pal(0 to M), pxc
'
'dim img As Any Ptr = ImageCreate( M, 100, RGB(0, 0, 0))

dim as ubyte a, k
a = 32
 for k = 0 to 100
     a = k
  for i = 1 to M    
   pxc = pal_spectra(i, M , a )
 '  pset(i-1,j),pxc
 '  circle(i-1,j),1,pxc,0,6.28,F
   circle(i-1,k),2,pxc,,,,f  
 '  Circle (i-1, k), 2, pxc, , , 1, F
 next i
next k

line(0,0)-(M,100),rgb(255,255,255),b

sleep
end
'
' ======================================================================
' 
 function pal_spectra(I as integer, M as integer, ap as ubyte) as ulong
 '
 '        Generate a particular palette value with alpha a
 '  
static as integer MAX 
static as single GAMMA ,WL,R,G,B,HST
static as ulong pxc
 '     
'       M=1024  '  I  limit
         
 '     
       MAX=255
       GAMMA=.80
'
'         WAVELENGTH = WL
'
            WL = 380. + csng(I * 400. / M)

            IF ((WL>=380.) AND (WL<=440.)) THEN 
              R = -1.*(WL-440.)/(440.-380.)
              G = 0.
              B = 1.
            ENDIF
            IF ((WL>=440.) AND (WL<=490.)) THEN
              R = 0.
              G = (WL-440.)/(490.-440.)
              B = 1.
            ENDIF
            IF ((WL>=490.) AND (WL<=510.)) THEN 
              R = 0.
              G = 1.
              B = -1.*(WL-510.)/(510.-490.)
            ENDIF
            IF ((WL>=510.) AND (WL<=580.)) THEN 
              R = (WL-510.)/(580.-510.)
              G = 1.
              B = 0.
            ENDIF
            IF ((WL>=580.) AND (WL<=645.)) THEN
              R = 1.
              G = -1.*(WL-645.)/(645.-580.)
              B = 0.
            ENDIF
            IF ((WL>=645.) AND (WL<=780.)) THEN
              R = 1.
              G = 0.
              B = 0.
            ENDIF
'
'      LET THE INTENSITY HST FALL OFF NEAR THE VISION LIMITS
'
         IF (WL>700.) THEN
            HST=.3+.7* (780.-WL)/(780.-700.)
         ELSEIF (WL<420.) THEN
            HST=.3+.7*(WL-380.)/(420.-380.)
         ELSE
            HST=1.
         ENDIF
'
'      GAMMA ADJUST AND WRITE  TO A ulong variable .
'
         R=(HST*R)^GAMMA
         G=(HST*G)^GAMMA
         B=(HST*B)^GAMMA
        pxc=RGBA(255*R,255*G,255*B,ap)
       '  pxc=RGB(255*R,255*G,255*B)
' 
        return pxc
' 
 end function
'
' ----------------------------------------------------------------------
' 

Luxan
Posts: 222
Joined: Feb 18, 2009 12:47
Location: New Zealand

Re: 3D Geometry , basics

Post by Luxan »

D J Peters

Thank you for the suggestion and code.

The Select Case method is one of my favorites and produces tidy
code, without the ' bird's nest ' of if then else statements.

Little busy today, intend to post new code soon.
Luxan
Posts: 222
Joined: Feb 18, 2009 12:47
Location: New Zealand

Re: 3D Geometry , basics

Post by Luxan »

Returning to the 3d Geometry basics, an illustration of
how these basic routines are used to construct an animated
scene.

I corrected a routine and adjusted a few numerical values in
the persp() routine to produce a more gradual perspective view.

About the copyright stuff, don't know whether this is really
necessary as I'm just attempting to illustrate ideas.

Code: Select all



'                       xyz_1.bas

'    x, y, z  planes .

'
' -----------------------------------------------------------------------------
'
'   My graf 3d 
'
'    (c) copyright 2015 , sciwise@ihug.co.nz ,
'
'             Edward.Q.Montigue.  [ alias]
'
'
'
'
'
' -----------------------------------------------------------------------------
'
type point
         x as single
         y as single
         z as single
         u as single '  possible extension for special coord system
end type
'
const Pi=4*atn(1)
'
dim as single x1,y1,z1,x2,y2,z2
dim as integer i,j,k
'
'
'
dim as point p1(1 to 8)
dim as integer edge(1 to 12,0 to 1)
'
'                  Looking at a cube .
'
'               -1,1 _______<_______  1,1    start         z = -1
'                   |               |        back face.
'                   |               |
'                  v                ^
'                   |               |
'                   |_______________|
'                -1,-1        >        1,-1
'                
'
' -----------------------------------------------------------------------------
'
declare function rotx(q as point,angx as single) as point
declare function roty(q as point,angy as single) as point
declare function rotz(q as point,angz as single) as point
declare function tranx(q as point,movx as single) as point
declare function trany(q as point,movy as single) as point
declare function tranz(q as point,movz as single) as point
declare function persp(q as point,d as single) as point
'
declare function Trall( p1() as point,n as integer,edge() as integer, div as integer ) as integer
declare sub drw_vertices(p1() as point, thi as single, colour as integer)
declare sub drw_cube(p1() as point,edge() as integer, thi as single)

'
' ==============================
'
restore store1
for i=1 to 8
   read p1(i).x
   read p1(i).y
   read p1(i).z
next i
'
restore store2
for i=1 to 12
   read edge(i,0)
   read edge(i,1)
next i
'
' -----------------------------------------------------------------------------
'
screen 12,2
screen ,1,1

window (-1.5,-1.5)-(1.5,1.5)
line (-1.4,-1.4)-(1.4,1.4),11,b
'
'cls
'
' ------------------------------------------------------
'
dim as point p2(1 to 8)
dim as single theta,thi

dim as integer i1,j1,k1

theta = Pi/5
drw_cube(p1(), edge(), theta)    

sleep 100

dim as point p3(1 to 5)
dim as point p4(1 to 5)
dim as point p5(1 to 5)
'
restore planexy
for i=1 to 5
   read p3(i).x
   read p3(i).y
   read p3(i).z
next i
'
restore planeyz
for i=1 to 5
   read p4(i).x
   read p4(i).y
   read p4(i).z
next i
'
restore planexz
for i=1 to 5
   read p5(i).x
   read p5(i).y
   read p5(i).z
next i
'
drw_vertices(p3(),theta,11) ' xy
drw_vertices(p4(),theta,12) ' yz
drw_vertices(p5(),theta,10) ' xz


print " We control the y"
print " We control the z"
print " We control the x"

sleep 5

'  generate translated coord' , clear then write to hidden screen, 

' ...........         planexz , moved along y axis
dim as single movy
dim as point q5(1 to 5)
' moved up or down
movy=0 ' [-1,1]

' Screen , [active_page] [, [visible_page]]]

for movy=-1 to 1 step 0.01
drw_vertices(q5(),theta,0)
drw_cube(p1(), edge(), theta)
screen ,0,1
for i=1 to 5
    q5(i)=trany(p5(i),movy)
next i
drw_vertices(q5(),theta,10)
screen ,1,0
sleep 30
next movy
' ...........         planexy , moved along z axis
dim as single movz
dim as point q6(1 to 5)
' moved up or down
movz=0 ' [-1,1]

' Screen , [active_page] [, [visible_page]]]

for movz=-1 to 1 step 0.01
drw_vertices(q6(),theta,0)
drw_cube(p1(), edge(), theta)
screen ,0,1
for i=1 to 5
    q6(i)=tranz(p3(i),movz)
next i
drw_vertices(q6(),theta,11)
screen ,1,0
sleep 30
next movz
' ...........         planeyz , moved along x axis
dim as single movx
dim as point q7(1 to 5)
' moved up or down
movx=0 ' [-1,1]

' Screen , [active_page] [, [visible_page]]]

for movx=-1 to 1 step 0.01
drw_vertices(q7(),theta,0)
drw_cube(p1(), edge(), theta)
screen ,0,1
for i=1 to 5
    q7(i)=tranx(p4(i),movx)
next i
drw_vertices(q7(),theta,12)
screen ,1,0
sleep 30
next movx
'
' ..................  
'
'Trall( p1() ,8,edge(), 32 )
sleep
end
'
' ===================================
'
'     vertex data , easier to keep track of
'  data when we use multiple data statements.
'
store1: 
data  1,1,1
data -1,1,1
data-1,-1,1
data 1,-1,1
data 1,1,-1
data -1,1,-1
data -1,-1,-1
data 1,-1,-1
'
'  edge data 
'
store2:
data 1,2
data 1,4
data 1,5
data 2,3
data 2,6
data 3,4
data 3,7
data 4,8
data 5,6
data 5,8
data 6,7
data 7,8
'
' vertex data
'
planexy:  ' [-1,-1,0],[-1,1,0],[1,1,0],[1,-1,0]
data -1,-1,0
data -1,1,0
data  1,1,0
data  1,-1,0
data -1,-1,0
'
planeyz:  ' [0,1,1],[0,-1,1],[0,-1,-1],[0,1,-1],[0,1,1]
data  0,1,1
data  0,-1,1
data  0,-1,-1
data  0,1,-1
data  0,1,1 
'
planexz: ' [1,0,1],[-1,0,1],[-1,0,-1],[1,0,-1],[1,0,1]
data -1,0,-1
data -1,0,1
data  1,0,1
data  1,0,-1
data -1,0,-1
'
' -------------------------------------------------------------------------------
'
function rotx(q as point,angx as single) as point
'
'
'
static as point p
'
             p.x = q.x
             p.y= q.y*cos(angx)-sin(angx)*q.z
             p.z= q.z*cos(angx)+sin(angx)*q.y
'
             return p
'
end function 
'
' -----------------------------------------------------------------------------
'
function roty(q as point,angy as single) as point
'
'
'
static as point p
'
            p.x = sin(angy)*q.z + cos(angy)*q.x
            p.y = q.y
            p.z = cos(angy)*q.z -sin(angy)*q.x
'
            return p
'
end function
'
' -----------------------------------------------------------------------------
'
function rotz(q as point,angz as single) as point
'
'                         Rotate around z axis .
'
static as point p
'
            p.x = sin(angz)*q.y + cos(angz)*q.x
            p.y = cos(angz)*q.y-sin(angz)*q.x
            p.z = q.z
'
            return p
'
end function
'
' -----------------------------------------------------------------------------
'
function tranx(q as point,movx as single) as point
'
'              Translate point along x axis
'
static as point p
'
              p.x=q.x + movx
              p.y=q.y 
              p.z=q.z 
'
              return p
'
end function
'
' -----------------------------------------------------------------------------
'
function trany(q as point,movy as single) as point
'
'
'
static as point p
'
              p.x=q.x
              p.y=q.y + movy
              p.z=q.z 
'
              return p
'
end function
'
' -----------------------------------------------------------------------------
'
function tranz(q as point,movz as single) as point
'
'
'
static as point p
'
              p.x=q.x
              p.y=q.y
              p.z=q.z + movz
'
              return p
'
end function
'
' -----------------------------------------------------------------------------
'
function persp(q as point,d as single) as point
'
'     3d  perspective .  
'
'    Add 2 to the numerator when using any negative z value.
'
static as point p
'
     p.x = d*q.x/(q.z*0.25+1)
     p.y = d*q.y/(q.z*0.25+1)
     p.z = d
'
     return p
'
end function
'
' -----------------------------------------------------------------------------
'
function Trall( p1() as point,n as integer,edge() as integer, div as integer ) as integer
'
'  Translate and rotate all vertices .
'     as an animation ,  for  n  cycles .
'
'   With  div number of angle divisions .
'
static as point p2(1 to 8)
static as single theta,thi,x1,y1,z1,x2,y2,z2
static as integer i,j,k
static as integer i1,j1,k1
'
theta = Pi/div
'
for i=1 to n
  for j = 0 to div
  cls
       thi = j*theta
   for k = 1 to 8
     p2(k) = roty(p1(k),thi)
     p2(k)=persp(p2(k),0.8)
   next k     
'
for i1 = 1 to 12
      j1 = edge(i1,0)
     k1 = edge(i1,1)
   x1 = p2(j1).x
   y1 = p2(j1).y
'   z1 = p2(j1).z    
   x2 = p2(k1).x
   y2 = p2(k1).y
'   z2 = p2(k1).z    
line(x1,y1)-(x2,y2),14 
next i1     
'
sleep 100
  next j
next i
'
     return 0
'
end function
'
' ----------------------------------------------------------------------
'
sub drw_cube(p1() as point,edge() as integer, thi as single)
'
'                draw encompassing cube .
'
static as integer lv, k
static as single x1, y1, x2, y2
static as integer i1,j1,k1
'
       lv = ubound(p1,1)
'       
dim p2(1 to lv) as point   

   for k = 1 to 8
     p2(k) = roty(p1(k),thi)
     p2(k) = rotx(p2(k),-thi/4)
     p2(k) = persp(p2(k),0.8)
   next k     
'
for i1 = 1 to 12
    j1 = edge(i1,0)
    k1 = edge(i1,1)
    x1 = p2(j1).x
    y1 = p2(j1).y
'   z1 = p2(j1).z    
    x2 = p2(k1).x
    y2 = p2(k1).y
'   z2 = p2(k1).z    
line(x1,y1)-(x2,y2),14 
next i1   
'
end sub
'
' ----------------------------------------------------------------------
'
sub drw_vertices(p1() as point, thi as single, colour as integer)
'
'   draw a connected set of vertices, without using edge data .
'
static as integer lv, k
static as single x1, y1, x2, y2

       lv = ubound(p1,1)
       
dim p4(1 to lv) as point       
       
 for k = 1 to lv
   p4(k) = roty(p1(k),thi)
   p4(k) = rotx(p4(k),-thi/4)
   p4(k) = persp(p4(k),0.8)
next k 

for k = 1 to lv-1
    x1 = p4(k).x
    y1 = p4(k).y
    x2 = p4(k+1).x
    y2 = p4(k+1).y
 line(x1,y1)-(x2,y2),colour
next k          
'
end sub
'
' ----------------------------------------------------------------------
'
Luxan
Posts: 222
Joined: Feb 18, 2009 12:47
Location: New Zealand

Re: 3D Geometry , basics

Post by Luxan »

Now new code for Hu_color, larger window, rectangular portions and the pal_spectra routine from Joshy .

There may well be a better way to display this alpha adjusted spectra, for now this conveys most of the information.

Code: Select all


 
'       Hu_color4.bas

'       palette values , based upon the human response to light , with alpha adjustment .
 
declare function pal_spectra(I as integer, M as integer, ap as ubyte) as ulong
'
' ----------------------------------------------------------------------
'
'screen 14, 32    '  32 bit  color  depth  .

'screenres 320,240, 32,,64    '  32 bit  color  depth  with alpha primitives flagged (64) .
dim as integer scr_x,scr_y
scr_x=1024
scr_y=764
screenres scr_x,scr_y, 32,,64    '  32 bit  color  depth  with alpha primitives flagged (64) .
'view (20,20)-(scr_x+20,scr_y+20)
view (0,0)-(scr_x,scr_y)
'  reccomend , M > = 400, to avoid artifacts .

dim as integer M,i,j,na
M = 400
na=255 ' number of alpha levels.
'screenres M+10,na+10, 32,,64    '  32 bit  color  depth  with alpha primitives flagged (64) .
'view (0,0)-(M+10,na+10)

'window(0,0)-(M+10,na+10) 
'line(0,0)-(M+10,na+10),11,b
'line(0,0)-(M,na),rgb(255,255,255),bf

'dim as ulong pal(0 to M)
dim as ulong pxc
dim as ubyte a, k
'
'  divide screen into rectangles .
'
dim as integer nx, ny, idx
nx=int(scr_x/M)
ny=int(scr_y/na)

'print "nx=";nx;"  ny=";ny

k=0
for j=0 to scr_y-2*ny step ny+1
  idx=0
  for i=0 to scr_x-2*nx step nx+1
    pxc = pal_spectra(idx, M , k )
    line(i,j)-(i+nx,j+ny),pxc,bf
    idx = idx + 1
    if idx> M then idx = M
  next i
  k=k+1
  if k> na then k=na
next j

'print " idx = ";idx

sleep

end
'
' ======================================================================
' 
function pal_spectra(I as integer, M as integer, ap as ubyte) as ulong
  const as single GAMMA =.8
  const as integer MAX = 255
  dim as single WL,R,G,B,HST
  WL = 380 + (i*400/M)
  select case WL
  case 380 to 440 : G = 0 : B = 1 : R = (WL-440)/(440-380)*-1 
  case 440 to 490 : R = 0 : B = 1 : G = (WL-440)/(490-440)
  case 490 to 510 : R = 0 : G = 1 : B = (WL-510)/(510-490)*-1
  case 510 to 580 : G = 1 : B = 0 : R = (WL-510)/(580-510)
  case 580 to 645 : R = 1 : B = 0 : G = (WL-645)/(645-580)*-1
  case 645 to 780 : R = 1 : G = 0 : B = 0
  end select
  IF (WL>700.) THEN
    HST=.3+.7* (780.-WL)/(780.-700.)
  ELSEIF (WL<420.) THEN
    HST=.3+.7*(WL-380.)/(420.-380.)
  ELSE
    HST=1.
  ENDIF
  R=(HST*R)^GAMMA : G=(HST*G)^GAMMA : B=(HST*B)^GAMMA
  return RGBA(255*R,255*G,255*B,ap)
end function
'
' ----------------------------------------------------------------------
'
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: 3D Geometry , basics

Post by dodicat »

Here's another.

Code: Select all

const pi=3.14159,offset=1.2
#define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)
Function spectrum(x As Single,al As Ubyte=255) As Ulong
     return rgba((Sin(x)*127+128),_
                 (Sin((x-2.0944))*127+128),_
                 (Sin((x+2.0944))*127+128),al)
End Function
Screen 20,32,,64
For x As Long=0 To 1023
    For y As Long=0 To 767
         Pset(x,y),spectrum(map(0,1023,x,0,(1.5*pi))+offset,map(0,767,y,0,255))
    Next
Next
Sleep 
Luxan
Posts: 222
Joined: Feb 18, 2009 12:47
Location: New Zealand

Re: 3D Geometry , basics

Post by Luxan »

dodicat

That's pretty smooth, approaching an art.
Your purples aren't all that pronounced.
Luxan
Posts: 222
Joined: Feb 18, 2009 12:47
Location: New Zealand

Re: 3D Geometry , basics

Post by Luxan »

dodicat

I'm using your spectrum function with this code.
Your colours [ English pronounciation ] don't appear to
follow the order you'd expect for the spectrum of light; there might be
a way to correct for that via another index function.

A couple of observations, the screen flickers whenever I apply the cls
command, I did try using two screens and switching between them; maybe I
resolved this elsewhere.

For now I'm just drawing lines upon the plane, eventually I may need to
set individual values along each of those lines.

The influence of alpha upon the planes is either less pronounced because
of how some lines are drawn over others when filling the rectangle, or
an exponential change in alpha is necessary to readily observe a difference.


Code: Select all




'                       xyz_3colour.bas

'    x, y, z  planes .

'
' -----------------------------------------------------------------------------
'
'   My graf 3d 
'
'    (c) copyright 2022 , sciwise@ihug.co.nz ,
'
'             Edward.Q.Montague.  [ alias]
'
'
'
'
'
' -----------------------------------------------------------------------------
'
type point
         x as single
         y as single
         z as single
         u as single '  possible extension for special coord system
end type
'
const Pi = 4*atn(1)
'
dim as single x1,y1,z1,x2,y2,z2
dim as integer i,j,k
'
'
'
dim as point p1(1 to 8)
dim as integer edge(1 to 12,0 to 1)
'
'                  Looking at a cube .
'
'               -1,1 _______<_______  1,1    start         z = -1
'                   |               |        back face.
'                   |               |
'                  v                ^
'                   |               |
'                   |_______________|
'              -1,-1        >         1,-1
'                
'
' -----------------------------------------------------------------------------
'
declare function rotx(q as point,angx as single) as point
declare function roty(q as point,angy as single) as point
declare function rotz(q as point,angz as single) as point
declare function tranx(q as point,movx as single) as point
declare function trany(q as point,movy as single) as point
declare function tranz(q as point,movz as single) as point
declare function persp(q as point,d as single) as point
'
declare function Trall( p1() as point,n as integer,edge() as integer, div as integer ) as integer
declare sub drw_vertices(p1() as point, thi as single, colour as single, al as single)

declare sub drw_cube(p1() as point,edge() as integer, thi as single)
declare sub xz_plane(p5() as point,movy as single,theta as single)
declare sub xy_plane(p3() as point,movz as single,theta as single)
declare sub yz_plane(p4() as point,movx as single,theta as single)

declare Function spectrum(x As Single,al As Ubyte=255) As Ulong


'
' ================================================================
'
restore store1
for i=1 to 8
   read p1(i).x
   read p1(i).y
   read p1(i).z
next i
'
restore store2
for i=1 to 12
   read edge(i,0)
   read edge(i,1)
next i
'
' -----------------------------------------------------------------------------
'
'screen 12,2
'screen ,1,1

Screen 20,32,,64

window (-1.5,-1.5)-(1.5,1.5)
line (-1.4,-1.4)-(1.4,1.4),11,b
'
'cls
'
' ------------------------------------------------------
'
dim as point p2(1 to 8)
dim as single theta,thi
dim as integer i1,j1,k1
'
theta = Pi/5
'
dim as point p3(1 to 5)
dim as point p4(1 to 5)
dim as point p5(1 to 5)
'
restore planexy
for i=1 to 5
   read p3(i).x
   read p3(i).y
   read p3(i).z
next i
'
restore planeyz
for i=1 to 5
   read p4(i).x
   read p4(i).y
   read p4(i).z
next i
'
restore planexz
for i=1 to 5
   read p5(i).x
   read p5(i).y
   read p5(i).z
next i
'

print " We control the y"
print " We control the z"
print " We control the x"


line(-1,-0.5)-(1,0.5),rgb(255,255,255),b

for x1=-1 to 1-0.01 step 0.01
   line(x1,-0.5)-(x1+0.01,0.5),spectrum((-x1+0.5)*3,200),bf
next x1
line(-1,-0.5)-(1,0.5),rgb(255,255,255),b

'sleep

'end
sleep 2022

dim as single movy,movx,movz

'  generate translated coord' , clear then write to hidden screen, 

' ...........         planexz , moved along y axis

for movy=-1.0 to 1.0 step 0.01
sleep 50
cls
drw_cube(p1(), edge(), theta)
xz_plane(p5() ,movy, theta)
next movy

'sleep

' ..............     planexy , moved along z axis

for movz=-1 to 1 step 0.01
sleep 50
cls
drw_cube(p1(), edge(), theta)
xy_plane(p3() ,movz, theta)
next movz

'sleep

' ..............     planeyz , moved along x axis

for movx=-1.0 to 1.0 step 0.01
sleep 50
cls
drw_cube(p1(), edge(), theta)
yz_plane(p4() ,movx, theta)
next movx

sleep
end

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

redim as point q7(1 to 2)

'
for movx=-1 to 1 step 0.01
'drw_vertices(q7(),theta,0)
drw_cube(p1(), edge(), theta)
'screen ,0,1
for i=1 to 2
    q7(i)=tranx(p4(i),movx)
next i
drw_vertices(q7(),theta,0.2,126)
'screen ,1,0
sleep 30
next movx

sleep

end
'
' ===================================
'
'     vertex data , easier to keep track of
'  data when we use multiple data statements.
'
store1:         '  --> p1() , global
data  1,1,1
data -1,1,1
data-1,-1,1
data 1,-1,1
data 1,1,-1
data -1,1,-1
data -1,-1,-1
data 1,-1,-1
'
'  edge data 
'
store2:        '   --> edge()
data 1,2
data 1,4
data 1,5
data 2,3
data 2,6
data 3,4
data 3,7
data 4,8
data 5,6
data 5,8
data 6,7
data 7,8
'
' vertex data
'
planexy:  ' [-1,-1,0],[-1,1,0],[1,1,0],[1,-1,0],[-1,-1,0] --> P3() , global
data -1,-1,0
data -1,1,0
data  1,1,0
data  1,-1,0
data -1,-1,0
'
planeyz:  ' [0,1,1],[0,-1,1],[0,-1,-1],[0,1,-1],[0,1,1]  --> P4() , global
data  0,-1,-1
data  0,1,-1
data  0,1,1
data  0,-1,1
data  0,-1,-1
'data  0,1,1 
'
planexz: ' [-1,0,-1],[-1,0,1],[1,0,1],[1,0,-1],[-1,0,-1] --> P5() , global
data -1,0,-1
data -1,0,1
data  1,0,1
data  1,0,-1
data -1,0,-1
'
' -------------------------------------------------------------------------------
'
function rotx(q as point,angx as single) as point
'
'                         Rotate around x axis .
'
static as point p
'
             p.x = q.x
             p.y= q.y*cos(angx)-sin(angx)*q.z
             p.z= q.z*cos(angx)+sin(angx)*q.y
'
             return p
'
end function 
'
' -----------------------------------------------------------------------------
'
function roty(q as point,angy as single) as point
'
'                         Rotate around y axis .
'
static as point p
'
            p.x = sin(angy)*q.z + cos(angy)*q.x
            p.y = q.y
            p.z = cos(angy)*q.z -sin(angy)*q.x
'
            return p
'
end function
'
' -----------------------------------------------------------------------------
'
function rotz(q as point,angz as single) as point
'
'                         Rotate around z axis .
'
static as point p
'
            p.x = sin(angz)*q.y + cos(angz)*q.x
            p.y = cos(angz)*q.y-sin(angz)*q.x
            p.z = q.z
'
            return p
'
end function
'
' -----------------------------------------------------------------------------
'
function tranx(q as point,movx as single) as point
'
'              Translate point along x axis
'
static as point p
'
              p.x=q.x + movx
              p.y=q.y 
              p.z=q.z 
'
              return p
'
end function
'
' -----------------------------------------------------------------------------
'
function trany(q as point,movy as single) as point
'
'              Translate point along y axis
'
static as point p
'
              p.x=q.x
              p.y=q.y + movy
              p.z=q.z 
'
              return p
'
end function
'
' -----------------------------------------------------------------------------
'
function tranz(q as point,movz as single) as point
'
'              Translate point along z axis
'
static as point p
'
              p.x=q.x
              p.y=q.y
              p.z=q.z + movz
'
              return p
'
end function
'
' -----------------------------------------------------------------------------
'
function persp(q as point,d as single) as point
'
'     3d  perspective .  
'
'    Add 2 to the numerator when using any negative z value.
'
static as point p
'
     p.x = d*q.x/(q.z*0.25+1)
     p.y = d*q.y/(q.z*0.25+1)
     p.z = d
'
     return p
'
end function
'
' -----------------------------------------------------------------------------
'
function Trall( p1() as point,n as integer,edge() as integer, div as integer ) as integer
'
'  Translate and rotate all vertices .
'     as an animation ,  for  n  cycles .
'
'   With  div number of angle divisions .
'
static as point p2(1 to 8)
static as single theta,thi,x1,y1,z1,x2,y2,z2
static as integer i,j,k
static as integer i1,j1,k1
'
theta = Pi/div
'
for i=1 to n
  for j = 0 to div
  cls
       thi = j*theta
   for k = 1 to 8
     p2(k) = roty(p1(k),thi)
     p2(k)=persp(p2(k),0.8)
   next k     
'
for i1 = 1 to 12
      j1 = edge(i1,0)
     k1 = edge(i1,1)
   x1 = p2(j1).x
   y1 = p2(j1).y
'   z1 = p2(j1).z    
   x2 = p2(k1).x
   y2 = p2(k1).y
'   z2 = p2(k1).z    
line(x1,y1)-(x2,y2),14 
next i1     
'
sleep 100
  next j
next i
'
     return 0
'
end function
'
' ----------------------------------------------------------------------
'
sub drw_cube(p1() as point,edge() as integer, thi as single)
'
'                draw encompassing cube .
'
static as integer lv, k
static as single x1, y1, x2, y2
static as integer i1,j1,k1
'
       lv = ubound(p1,1)
'       
dim p2(1 to lv) as point   

   for k = 1 to 8
     p2(k) = roty(p1(k),thi)
     p2(k) = rotx(p2(k),-thi/4)
     p2(k) = persp(p2(k),0.8)
   next k     
'
for i1 = 1 to 12
    j1 = edge(i1,0)
    k1 = edge(i1,1)
    x1 = p2(j1).x
    y1 = p2(j1).y
'   z1 = p2(j1).z    
    x2 = p2(k1).x
    y2 = p2(k1).y
'   z2 = p2(k1).z    
line(x1,y1)-(x2,y2),rgb(200,180,20) 
next i1   
'
end sub
'
' ----------------------------------------------------------------------
'
sub drw_vertices(p1() as point, thi as single, colour as single, al as single)
'
'   draw a connected set of vertices, without using edge data .
'
static as integer lv, k
static as single x1, y1, x2, y2
static as ulong pxc

       lv = ubound(p1,1)
       
static p8(1 to lv) as point       
       
 for k = 1 to lv
   p8(k) = roty(p1(k),thi)
   p8(k) = rotx(p8(k),-thi/4)
   p8(k) = persp(p8(k),0.8)
next k 

pxc = spectrum(colour,al) ' [colour,[0,1]] , [al,[0,255]] ?


for k = 1 to lv-1
    x1 = p8(k).x
    y1 = p8(k).y
    x2 = p8(k+1).x
    y2 = p8(k+1).y
 line(x1,y1)-(x2,y2),pxc
next k          
'
end sub
'
' ----------------------------------------------------------------------
'
sub xz_plane(p5() as point,movy as single,theta as single)
'
' draw a filled in xz plane, starting vertices at [][] 
'
static as single movx,i
static as point q5(1 to 2)

for movx=0 to 2 step 0.001
for i=1 to 2
    q5(i)=trany(p5(i),movy)   
    q5(i)=tranx(q5(i),movx)   
next i
drw_vertices(q5(),theta,(-movx+0.5)*3,200) '(-movx+0.5)*127
next movx
'
end sub
'
' ----------------------------------------------------------------------
'
sub xy_plane(p3() as point,movz as single,theta as single)
'
' draw a filled in xy plane, starting vertices at [][] 
'
static as single movx,i
static as point q5(1 to 2)

for movx=0 to 2 step 0.001
for i=1 to 2
    q5(i)=tranz(p3(i),movz)   
    q5(i)=tranx(q5(i),movx)   
next i
drw_vertices(q5(),theta,(-movx+0.5)*3,200)
next movx
'
end sub
'
' ----------------------------------------------------------------------
'
sub yz_plane(p4() as point,movx as single,theta as single)
'
' draw a filled in yz plane, starting vertices at [][] 
'
static as single movz,i
static as point q5(1 to 2)
'
for movz=0 to 2 step 0.001
for i=1 to 2
    q5(i)=tranx(p4(i),movx)   
    q5(i)=tranz(q5(i),movz)   
next i
drw_vertices(q5(),theta,(-movz+0.5)*3,200)
next movz
'
end sub
'
' ----------------------------------------------------------------------
'
Function spectrum(x As Single,al As Ubyte=255) As Ulong

'    from dodicat, FreeBasic community .


     return rgba((Sin(x)*127+128),_
                 (Sin((x-2.0944))*127+128),_
                 (Sin((x+2.0944))*127+128),al)
End Function
'
' ----------------------------------------------------------------------
'



dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: 3D Geometry , basics

Post by dodicat »

If you put screenlock at the beginning and screenunlock at the end of these subs:
drw_cube
drw_vertices
xz_plane
xy_plane
yz_plane
It looks better.

For general graphics loops (I use do loop for example here)
do

screenlock
cls (if needed)

GRAPHICS

screenunlock
sleep 1 (or more if required)

loop

So try an organise to suit.
A sleep() is always needed for the next graphics run.
Avoid putting a sleep() command inside
screenlock
screenunlock

To use screenset and flip you need to define
Screen 20,32,2,64 or similar
(But it is easier using screenlock/screenunlock)
Luxan
Posts: 222
Joined: Feb 18, 2009 12:47
Location: New Zealand

Re: 3D Geometry , basics

Post by Luxan »

dodicat

I used the pcopy command and a shorter delay, I'm not
even using OpenGL specific commands and the results are fairly good.

Apply similar for other planes.

Code: Select all

ScreenSet 1, 0

'  generate translated coord' , clear then write to hidden screen, 

' ...........         planexz , moved along y axis

for movy=-1.0 to 1.0 step 0.01
line (-1.5,-1.5)-(1.5,1.5),rgb(0,0,0),bf
drw_cube(p1(), edge(), theta)
xz_plane(p5() ,movy, theta)
PCopy 1, 0  
sleep 20
next movy

Luxan
Posts: 222
Joined: Feb 18, 2009 12:47
Location: New Zealand

Re: 3D Geometry , basics

Post by Luxan »

dodicat

Two versions are under construction, one using your
spectrum function, the other the pal_spectra.
Luxan
Posts: 222
Joined: Feb 18, 2009 12:47
Location: New Zealand

Re: 3D Geometry , basics

Post by Luxan »

dodicat

Try this with your spectrum function,
closer to what the spectrum of light looks like .

Code: Select all


Function spectrum(x As Single,al As Ubyte=255) As Ulong

'    from dodicat, FreeBasic community .

'  [x, [-1, 1]]

'  a = -2.528
'  b = 3.808
'  y = a*x + b

'  purple,blue,cyan,green,yellow,orange,red .
      x = -2.528*x + 3.808

     return rgba((Sin(x)*127+128),_
                 (Sin((x-2.0944))*127+128),_
                 (Sin((x+2.0944))*127+128),al)
End Function
'

dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: 3D Geometry , basics

Post by dodicat »

A rainbow structure.

Code: Select all


Enum version
    inner
    outer
End Enum

Type rainbow 
    Const pi=4*Atn(1)
    As Long min,max
    As Long alph
    As Long cx,cy
    As version v
    Declare Sub Draw(As Any Ptr=0)
    Declare Function colours(x As Single,a1 As Ubyte=255) As Ulong
    Declare Static Sub filter(As Any Ptr,As Long)
End Type

#define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)
#define distance(cx,cy,px,py) Sqr((cx-px)*(cx-px)+(cy-py)*(cy-py))

Function rainbow.colours(x As Single,al As Ubyte) As Ulong
    Return Rgba((Sin(x)*127+128),_
    (Sin((x-2.0944))*127+128),_
    (Sin((x+2.0944))*127+128),al)
End Function

Sub rainbow.draw(im As Any Ptr)
    Dim As Long w,h
    Dim As Double s
    Screeninfo w,h
    For x As Long=0 To w
        For y As Long=0 To h
            Var d=distance(cx,cy,x,y)
            If d>min And d < max Then
                If v=inner Then
                    s=map(max,min,d,0,(1.5*pi))+1.2
                Else
                    s=map(min,max,d,0,(1.5*pi))+1.2
                End If
                Pset im,(x,y),colours(s,alph)
            End If
        Next y
    Next x
End Sub

Sub cloud(x As Integer, y As Integer,length As Integer=100,Alpha As Integer=105, Zoom As Single = 0,im As Any Pointer=0)
    Dim As Integer r=255
    Dim As Integer b=255
    Dim As Integer g=255
    Dim As Double pi=3.14159
    #define mp(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)
    If Length<=1 Or Alpha<=1 Then Exit Sub
    Dim As Single rnded = -pi+Rnd*1*pi/2
    Dim As Single rnded2 = -pi+Rnd*-3*pi
    If Alpha<25 Then
        For i As Integer = 0 To 255-Alpha Step 100
            Var c=mp((0),(1500),y,0,400)
            Line im,(-(Zoom/2)+x-length/2,y)-((Zoom/2)+x+Length/6+length*Cos(-pi/2+rnded*PI/3),y+Length/6+length*Sin(-pi/2+rnded*PI/3)),Rgba(R-c,G-c,B-c,Alpha)
            Line im,(-(Zoom/2)+x-length/2,y)-((Zoom/2)+x+Length/6+length*Cos(-pi/2+rnded2*PI/3),y+Length/6+length*Sin(pi/2+rnded2*PI/3)),Rgba(R-c,G-c,B-c,Alpha)
        Next
    End If
    cloud(-(Zoom/2)+x+length*Cos(-pi/2+rnded*PI/3),(Zoom/2)+y+length*Sin(-pi/2+rnded*PI/3),length/1.4,Alpha/1.2,Zoom,im)
    cloud(-(Zoom/2)+x+length*Cos(-pi/2+rnded2*PI/3),(Zoom/2)+y+length*Sin(pi/2+rnded2*PI/3),length/1.4,Alpha/1.2,Zoom,im)
    cloud(-(Zoom/2)+x+length*Cos(pi/3+rnded2*PI/3),(Zoom/2)+y+length*Sin(pi+rnded2*PI/3),length/1.4,Alpha/2,Zoom,im)
End Sub

Static Sub rainbow.filter(i As Any Ptr,n As Long)
    #macro setP(z)
    p(0)=z
    p(1)=Point(x,y-1,i)
    p(2)=Point(x+1,y,i)
    p(3)=Point(x,y+1,i)
    p(4)=Point(x-1,y,i)
    #endmacro
    
    #macro setC
    r+=Cast(Ubyte Ptr,@p(n))[2]
    g+=Cast(Ubyte Ptr,@p(n))[1]
    b+=Cast(Ubyte Ptr,@p(n))[0]
    a+=Cast(Ubyte Ptr,@p(n))[3]
    #endmacro
    
    Dim As Long ix,iy
    Imageinfo i,ix,iy
    Dim As Long p(0 To 4)
    Dim As Long k,x,y,r,g,b,a
    For k =1 To n
        For x =1 To ix-2
            For y =1 To iy-2
                r=0:g=0:b=0:a=0
                setP(Point(x,y,i))
                For n As Long=0 To 4
                    setC
                Next
                Pset i,(x,y),Rgba(r\5,g\5,b\5,a\5)
            Next y
        Next x
    Next k
End Sub

Sub setbackground(Byref im As Any Ptr)
    Dim As Long w,h
    Dim As Double s
    Screeninfo w,h
    im=Imagecreate(w,h)
    For n As Long=0 To h
        Var red=map(0,h,n,0,255)
        Var green=map(0,h,n,0,255)
        Var blue=map(0,h,n,100,255)
        For m As Long=0 To w
            If n<h-70 +(30*Sin(m/100)+20*cos(3*m/100)) Then
                Pset im,(m,n),Rgb(red,green,blue)
            Else
                Var g=map(255,200,green,50,200)
                Pset im,(m,n),Rgb(0,g,0)  
            End If
        Next
    Next
End Sub


Dim As rainbow r1,r2
With r1
    .min=350
    .max=400
    .alph=120
    .cx=512
    .cy=800
    .v=inner
End With

With r2
    .min=700
    .max=800
    .alph=70
    .cx=512
    .cy=800
    .v=outer
End With

Screen 20,32,,64
Locate 5,20
Print "please wait . . ."
Dim As Any Ptr im

setbackground(im)
cloud(300,340,150/2,250,1,im)
cloud(500,340,150/2,250,1,im)
cloud(800,340,150/2,250,1,im)

r1.draw(im)
r2.draw(im)
rainbow.filter(im,5)

Put(0,0),im,Pset
Sleep
Imagedestroy im

 
Post Reply