3D Geometry , basics
Re: 3D Geometry , basics
Why 'end' in the middle of the main code?
-
- Posts: 8586
- Joined: May 28, 2005 3:28
- Contact:
Re: 3D Geometry , basics
You can give select case a try.
Joshy
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
Re: 3D Geometry , basics
Luxan
You need to define a screen to utilize alpha
Either flag 64 or GFX_ALPHA_PRIMITIVES from fbgfx.bi.
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
Re: 3D Geometry , basics
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.
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
'
' ----------------------------------------------------------------------
'
Re: 3D Geometry , basics
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.
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.
Re: 3D Geometry , basics
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.
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
'
' ----------------------------------------------------------------------
'
Re: 3D Geometry , basics
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.
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
'
' ----------------------------------------------------------------------
'
Re: 3D Geometry , basics
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
Re: 3D Geometry , basics
dodicat
That's pretty smooth, approaching an art.
Your purples aren't all that pronounced.
That's pretty smooth, approaching an art.
Your purples aren't all that pronounced.
Re: 3D Geometry , basics
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.
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
'
' ----------------------------------------------------------------------
'
Re: 3D Geometry , basics
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)
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)
Re: 3D Geometry , basics
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.
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
Re: 3D Geometry , basics
dodicat
Two versions are under construction, one using your
spectrum function, the other the pal_spectra.
Two versions are under construction, one using your
spectrum function, the other the pal_spectra.
Re: 3D Geometry , basics
dodicat
Try this with your spectrum function,
closer to what the spectrum of light looks like .
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
'
Re: 3D Geometry , basics
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