triangle world try

General FreeBASIC programming questions.
bluatigro
Posts: 621
Joined: Apr 25, 2012 10:35
Location: netherlands

triangle world try

Postby bluatigro » Feb 10, 2020 13:57

i want to create a triangle world lib
why ?
i want to steer points of a triangle indepently

first try
error :
only a black screen
shoot show a wire cube tilted

Code: Select all

''bluatigro 10 feb 2020
''triangle world

#ifndef TRIANGLES_H
#define TRIANGLES_H

screen 18 , 32
dim shared as integer winx , winy
screeninfo winx , winy

const as double pi    = atn( 1.0 ) * 4.0
const as double golden_ratio = ( sqr(5.0) - 1.0 ) / 2.0

function rad( x as double ) as double
''help function degrees to radians
  return x * pi / 180
end function

function degrees( x as double ) as double
  return x * 180 / pi
end function

function range( l as double , h as double ) as double
  return rnd * ( h - l ) + l
end function

sub rotate( byref k as double , byref l as double , deg as double )
  dim as double s , c , hk , hl
  s = sin( rad( deg ) )
  c = cos( rad( deg ) )
  hk = k * c - l * s
  hl = k * s + l * c
  k = hk
  l = hl
end sub

#include "fbgfx.bi"
#if __FB_LANG__ = "fb"
  Using FB '' Scan code constants are stored in the FB namespace in lang FB
#endif

''create matrix type to hold position & orentation
type matrix
  dim as double m( 3 , 3 )
end type
''create multyplycation operator for matrix
operator * ( a as matrix , b as matrix ) as matrix
  dim as integer i , j , k
  dim uit as matrix
  for i = 0 to 3
    for j = 0 to 3
''      uit.m( i , j ) = 0
      for k = 0 to 3
''        uit.m( i , j ) += a.m( i , k ) * b.m( k , j )
        uit.m( j , k ) += a.m( j , i ) * b.m( i , k )
      next k
    next j
  next i
  return uit
end operator
''create array of matrix's
dim shared as matrix v( 20 )
''create unity matrix
v( 0 ).m( 0 , 0 ) = 1
v( 0 ).m( 1 , 1 ) = 1
v( 0 ).m( 2 , 2 ) = 1
v( 0 ).m( 3 , 3 ) = 1
''create array to hold skeletal angles
dim shared as double sk( 64 , 2 )
''create some stuf for 3D engine
declare sub link( no as integer , x as double , y as double , z as double _
, pan as double , tilt as double , rol as double , ax as integer , p as integer )
declare sub child( no as integer , x as double , y as double , z as double _
, lim as integer , ax as integer , p as integer )
declare sub spot( byref x as double , byref y as double , byref z as double )
dim shared as integer number
dim shared as double cam( 6 )
declare sub camara( x as double , y as double , z as double _
, pan as double , tilt as double , rol as double , zoom as double )
declare function pend( f as double , a as double ) as double
declare sub skelet( no as integer , x as double , y as double , z as double )

const as integer xyz = 0
const as integer xzy = 1
const as integer yxz = 2
const as integer yzx = 3
const as integer zxy = 4
const as integer zyx = 5




function pend( f as double , a as double ) as double
''pendular motion for animation
''looks verry natural
  return sin( rad( f ) ) * a
end function
sub skelet( lim as integer , x as double , y as double , z as double )
''set angles of skeletal lim
''for animated avatars
  if lim < 0 or lim > 64 then exit sub
  sk( lim , 0 ) = x
  sk( lim , 1 ) = y
  sk( lim , 2 ) = z
end sub
sub camara( x as double , y as double , z as double _
, pan as double , tilt as double , rol as double , zoom as double )
''set look from point & look angles
  cam( 0 ) = x
  cam( 1 ) = y
  cam( 2 ) = z
  cam( 3 ) = pan
  cam( 4 ) = tilt
  cam( 5 ) = rol
  cam( 6 ) = zoom
end sub
Sub link( no As Integer, x As double, y As double, z As double, pan As double, tilt As double, rol As double, ax As Integer, p As Integer )
''set curent matrix wil afect folowing drawing comands
   If no < 1 Or no > 20 Then Exit Sub
   If p < 0 Or p > 20 Then Exit Sub
   If p = no Then Exit Sub
   ''create some lokal matrix's and fill them
   Dim As matrix mp, rotx, roty, rotz, translate
   mp = v( p )
   rotx = v( 0 )
   roty = v( 0 )
   rotz = v( 0 )
   translate = v( 0 )
   rotz.m( 0, 0 ) = Cos( rad( rol ))
   rotz.m( 0, 1 ) = -Sin( rad( rol ))
   rotz.m( 1, 0 ) = Sin( rad( rol ))
   rotz.m( 1, 1 ) = Cos( rad( rol ))
   roty.m( 0, 0 ) = Cos( rad( pan ))
   roty.m( 0, 2 ) = -Sin( rad( pan ))
   roty.m( 2, 0 ) = Sin( rad( pan ))
   roty.m( 2, 2 ) = Cos( rad( pan ))
   rotx.m( 1, 1 ) = Cos( rad( tilt ))
   rotx.m( 1, 2 ) = -Sin( rad( tilt ))
   rotx.m( 2, 1 ) = Sin( rad( tilt ))
   rotx.m( 2, 2 ) = Cos( rad( tilt ))
   translate.m( 3, 0 ) = x
   translate.m( 3, 1 ) = y
   translate.m( 3, 2 ) = z
   ''angles can permutate 6 ways
   Select Case ax
      Case xyz
         v( no ) = rotx * roty * rotz * translate * mp
      Case xzy
         v( no ) = rotx * rotz * roty * translate * mp
      Case yxz
         v( no ) = roty * rotx * rotz * translate * mp
      Case yzx
         v( no ) = roty * rotz * rotx * translate * mp
      Case zxy
         v( no ) = rotz * rotx * roty * translate * mp
      Case zyx
         v( no ) = rotz * roty * rotx * translate * mp
      Case Else
   End Select
   number = no
End Sub
sub child( no as integer , x as double , y as double , z as double _
, lim as integer , ax as integer , p as integer )
''set curent matrix for lim of animated avatar
''wil efect folowing drawings
  if lim < 0 or lim > 64 then exit sub
  link no , x , y , z , sk( lim , 1 ) , sk( lim , 0 ) , sk( lim , 2 ), ax , p
end sub
sub spot( byref x as double , byref y as double , byref z as double )
''calulate world coordinates from lokal coordinates
''using curent matrix
  dim as double hx , hy , hz
  dim as integer i
  ''use curent matrix
  i = number
  hx = x * v( i ).m( 0 , 0 ) + y * v( i ).m( 1 , 0 ) _
  + z * v( i ).m( 2 , 0 ) + v( i ).m( 3 , 0 )
  hy = x * v( i ).m( 0 , 1 ) + y * v( i ).m( 1 , 1 ) _
  + z * v( i ).m( 2 , 1 ) + v( i ).m( 3 , 1 )
  hz = x * v( i ).m( 0 , 2 ) + y * v( i ).m( 1 , 2 ) _
  + z * v( i ).m( 2 , 2 ) + v( i ).m( 3 , 2 )
  x = hx
  y = hy
  z = hz
  ''use camara matrix
  x += - cam( 0 )
  y += - cam( 1 )
  z += - cam( 2 )
  rotate x , z , -cam( 3 )
  rotate y , z , -cam( 4 )
  rotate x , y , -cam( 5 )
  x *= cam( 6 )
  y *= cam( 6 )
  z *= cam( 6 )
end sub
sub movecam( a as double , b as double , c as double , d as double )
  rotate a , c , cam( 3 )
  cam( 0 ) += a
  cam( 1 ) += b
  cam( 2 ) += c
  cam( 3 ) = ( cam( 3 ) + d ) mod 360

end sub

''vector 3d


type t3d
  x as double
  y as double
  z as double
  declare constructor()
  declare constructor ( x as double , y as double, z as double )
  declare sub fill( x as double , y as double , z as double )
  declare sub normalize
end type
constructor t3d()
  this.x = 0
  this.y = 0
  this.z = 0
end constructor
constructor t3d( x as double , y as double , z as double )
  this.x = x
  this.y = y
  this.z = z
end constructor
operator +( a as t3d , b as t3d ) as t3d
  return type( a.x + b.x , a.y + b.y , a.z + b.z )
end operator
operator *( a as t3d , d as double ) as t3d
  return type( a.x * d , a.y * d , a.z * d )
end operator
operator \( a as t3d , b as t3d ) as t3d
  return type( a.y * b.z - a.z * b.y _
             , a.z * b.x - a.x * b.z _
             , a.x * b.y - a.y * b.x )
end operator
operator -( a as t3d , b as t3d ) as t3d
  return type( a.x - b.x , a.y - b.y , a.z - b.z )
end operator
operator /( a as t3d , d as double ) as t3d
  return type( a.x / d , a.y / d , a.z / d )
end operator
sub t3d.fill( x as double , y as double , z as double )
  this.x = x
  this.y = y
  this.z = z
end sub
function dot( a as t3d , b as t3d ) as double
  return a.x * b.x + a.y * b.y + a.z * b.z
end function
function length( q as t3d ) as double
   return sqr( q.x * q.x + q.y * q.y + q.z * q.z ) + 1e-7
end function 
function getangle( a as t3d , b as t3d ) as double
  return acos( dot( a , b ) _
  / ( length( a ) * length( b ) ) )
end function
sub t3d.normalize
  this /= length( this )
end sub

''colors
dim shared as t3d black , red , green , yellow
dim shared as t3d blue , magenta , cyan , white
function tocolor( v as t3d ) as ulong
  return rgb( int(v.x*255)and 255 , int(v.y*255)and 255 , int(v.z*255)and 255 )
end function

type triangle
public :
  as t3d p(2),n,led,kl
  declare sub show( fast as integer = 0 )
end type
sub triangle.show( fast as integer )
  dim as integer x(2),y(2),i
  dim as double angle
  for i = 0 to 2
    if p(i).z < -900 then exit sub
    x(i)=winx/2+p(i).x/(p(i).z+1000)*1000
    y(i)=winy/2-p(i).y/(p(i).z+1000)*1000
  next i
  n=(p(1)-p(0))\(p(2)-p(0))
  n.normalize
  angle = getangle(n,t3d(0,1,0))
''  kl = kl * (cos( angle ) / 2 + .5)
  line(x(0),y(0))-(x(1),y(1)),tocolor(kl)
  line(x(2),y(2))-(x(1),y(1)),tocolor(kl)
  line(x(0),y(0))-(x(2),y(2)),tocolor(kl)
  led = (p(0)+p(1)+p(2))/3
  if not fast then
    x(0)=winx/2+led.x/(led.z+1000)*1000
    y(0)=winy/2-led.y/(led.z+1000)*1000
''    paint ( x(0),y(0) ) , kl
  end if
end sub

dim shared as t3d pnt( 255 )
dim shared as integer tritel = 0
dim shared as triangle tris( 200 )

sub setpoint( no as integer , x as double , y as double , z as double )
  spot x , y , z
  pnt( no ) = t3d( x , y , z )
end sub

sub tri( p1 as integer , p2 as integer , p3 as integer , kl as t3d )
  tris( tritel ).p(0) = pnt( p1 )
  tris( tritel ).p(1) = pnt( p2 )
  tris( tritel ).p(2) = pnt( p3 )
  tris( tritel ).kl = kl
  tritel += 1
end sub

sub quad( p1 as integer , p2 as integer , p3 as integer , p4 as integer , kl as t3d )
  tri p1 , p2 , p3 , kl
  tri p1 , p3 , p4 , kl
end sub

dim shared as double box( 5 )
sub setbox( x as double , y as double , z as double , dx as double , dy as double , dz as double )
  box(0)=x
  box(1)=y
  box(2)=z
  box(3)=dx
  box(4)=dy
  box(5)=dz
end sub

sub cube( kl as t3d )
  setpoint 0 ,box(0)+box(3),box(1)+box(4),box(2)+box(5)
  setpoint 1 ,box(0)+box(3),box(1)+box(4),box(2)-box(5)
  setpoint 2 ,box(0)+box(3),box(1)-box(4),box(2)+box(5)
  setpoint 3 ,box(0)+box(3),box(1)-box(4),box(2)-box(5)
  setpoint 4 ,box(0)-box(3),box(1)+box(4),box(2)+box(5)
  setpoint 5 ,box(0)-box(3),box(1)+box(4),box(2)-box(5)
  setpoint 6 ,box(0)-box(3),box(1)-box(4),box(2)+box(5)
  setpoint 7 ,box(0)-box(3),box(1)-box(4),box(2)-box(5)
 
  quad 0,1,3,2 , kl
  quad 7,6,4,5 , kl
  quad 0,1,5,4 , kl
  quad 7,6,2,3 , kl
  quad 0,2,6,4 , kl
  quad 7,5,1,3 , kl
 
end sub

sub draw_all( fast as integer = 0 )
  if not fast then
    dim as integer i , j
    for i = 1 to tritel
      for j = 0 to i - 1
        if tris( i ).led.z < tris( j ).led.z then
          swap tris( i ) , tris( j )
        end if
      next j
    next i
    for i = 0 to tritel
      tris(i).show 1
    next i
  else
    dim as integer i
    for i = 0 to tritel
      tris(i).show
    next i
  end if
end sub

sub test
  tritel = 0
  link 1 , 0,0,0 , 30,45,0 , xyz , 0
  setbox 0,0,0 , 50,50,50
  cube red
  draw_all
  sleep
end sub

test
#endif

badidea
Posts: 1779
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: triangle world try

Postby badidea » Feb 10, 2020 18:31

bluatigro wrote:error :
only a black screen
shoot show a wire cube tilted

You code is difficult to follow. Not well structured.
Anyway, if you add print x(i), y(i) to triangle.show, then all points are (320, 240). And tocolor(kl) is &hFF000000 (black).
bluatigro
Posts: 621
Joined: Apr 25, 2012 10:35
Location: netherlands

Re: triangle world try

Postby bluatigro » Feb 11, 2020 13:54

update :
colors initailniced
camara zoom on 1

error :
my triangles do not sort right
somtimes a black triangle gets on front [ fast = 0 ]

rem :
fast was added to test complex animations
whit many triangles

i m trying to build a lib for triangle animations

i know that i m not perfect whit my code
i was never tutored in coding
i m not used to plan my code
this is a proof of concept

Code: Select all

''bluatigro 10 feb 2020
''triangle world

#ifndef TRIANGLES_H
#define TRIANGLES_H

screen 18 , 32 , 2
dim shared as integer winx , winy
screeninfo winx , winy

const as double pi           = atn( 1.0 ) * 4.0
const as double golden_ratio = ( sqr(5.0) - 1.0 ) / 2.0

function rad( x as double ) as double
''help function degrees to radians
  return x * pi / 180
end function

function degrees( x as double ) as double
  return x * 180 / pi
end function

function range( l as double , h as double ) as double
  return rnd * ( h - l ) + l
end function

sub rotate( byref k as double , byref l as double , deg as double )
  dim as double s , c , hk , hl
  s = sin( rad( deg ) )
  c = cos( rad( deg ) )
  hk = k * c - l * s
  hl = k * s + l * c
  k = hk
  l = hl
end sub

#include "fbgfx.bi"
#if __FB_LANG__ = "fb"
  Using FB '' Scan code constants are stored in the FB namespace in lang FB
#endif

''create matrix type to hold position & orentation
type matrix
  dim as double m( 3 , 3 )
end type
''create multyplycation operator for matrix
operator * ( a as matrix , b as matrix ) as matrix
  dim as integer i , j , k
  dim uit as matrix
  for i = 0 to 3
    for j = 0 to 3
''      uit.m( i , j ) = 0
      for k = 0 to 3
''        uit.m( i , j ) += a.m( i , k ) * b.m( k , j )
        uit.m( j , k ) += a.m( j , i ) * b.m( i , k )
      next k
    next j
  next i
  return uit
end operator
''create array of matrix's
dim shared as matrix v( 20 )
''create unity matrix
v( 0 ).m( 0 , 0 ) = 1
v( 0 ).m( 1 , 1 ) = 1
v( 0 ).m( 2 , 2 ) = 1
v( 0 ).m( 3 , 3 ) = 1
''create array to hold skeletal angles
dim shared as double sk( 64 , 2 )
''create some stuf for 3D engine
declare sub link( no as integer , x as double , y as double , z as double _
, pan as double , tilt as double , rol as double , ax as integer , p as integer )
declare sub child( no as integer , x as double , y as double , z as double _
, lim as integer , ax as integer , p as integer )
declare sub spot( byref x as double , byref y as double , byref z as double )
dim shared as integer number
dim shared as double cam( 6 )
declare sub camara( x as double , y as double , z as double _
, pan as double , tilt as double , rol as double , zoom as double )
declare function pend( f as double , a as double ) as double
declare sub skelet( no as integer , x as double , y as double , z as double )

const as integer xyz = 0
const as integer xzy = 1
const as integer yxz = 2
const as integer yzx = 3
const as integer zxy = 4
const as integer zyx = 5




function pend( f as double , a as double ) as double
''pendular motion for animation
''looks verry natural
  return sin( rad( f ) ) * a
end function
sub skelet( lim as integer , x as double , y as double , z as double )
''set angles of skeletal lim
''for animated avatars
  if lim < 0 or lim > 64 then exit sub
  sk( lim , 0 ) = x
  sk( lim , 1 ) = y
  sk( lim , 2 ) = z
end sub
sub camara( x as double , y as double , z as double _
, pan as double , tilt as double , rol as double , zoom as double )
''set look from point & look angles
  cam( 0 ) = x
  cam( 1 ) = y
  cam( 2 ) = z
  cam( 3 ) = pan
  cam( 4 ) = tilt
  cam( 5 ) = rol
  cam( 6 ) = zoom
end sub
Sub link( no As Integer, x As double, y As double, z As double, pan As double, tilt As double, rol As double, ax As Integer, p As Integer )
''set curent matrix wil afect folowing drawing comands
   If no < 1 Or no > 20 Then Exit Sub
   If p < 0 Or p > 20 Then Exit Sub
   If p = no Then Exit Sub
   ''create some lokal matrix's and fill them
   Dim As matrix mp, rotx, roty, rotz, translate
   mp = v( p )
   rotx = v( 0 )
   roty = v( 0 )
   rotz = v( 0 )
   translate = v( 0 )
   rotz.m( 0, 0 ) = Cos( rad( rol ))
   rotz.m( 0, 1 ) = -Sin( rad( rol ))
   rotz.m( 1, 0 ) = Sin( rad( rol ))
   rotz.m( 1, 1 ) = Cos( rad( rol ))
   roty.m( 0, 0 ) = Cos( rad( pan ))
   roty.m( 0, 2 ) = -Sin( rad( pan ))
   roty.m( 2, 0 ) = Sin( rad( pan ))
   roty.m( 2, 2 ) = Cos( rad( pan ))
   rotx.m( 1, 1 ) = Cos( rad( tilt ))
   rotx.m( 1, 2 ) = -Sin( rad( tilt ))
   rotx.m( 2, 1 ) = Sin( rad( tilt ))
   rotx.m( 2, 2 ) = Cos( rad( tilt ))
   translate.m( 3, 0 ) = x
   translate.m( 3, 1 ) = y
   translate.m( 3, 2 ) = z
   ''angles can permutate 6 ways
   Select Case ax
      Case xyz
         v( no ) = rotx * roty * rotz * translate * mp
      Case xzy
         v( no ) = rotx * rotz * roty * translate * mp
      Case yxz
         v( no ) = roty * rotx * rotz * translate * mp
      Case yzx
         v( no ) = roty * rotz * rotx * translate * mp
      Case zxy
         v( no ) = rotz * rotx * roty * translate * mp
      Case zyx
         v( no ) = rotz * roty * rotx * translate * mp
      Case Else
   End Select
   number = no
End Sub
sub child( no as integer , x as double , y as double , z as double _
, lim as integer , ax as integer , p as integer )
''set curent matrix for lim of animated avatar
''wil efect folowing drawings
  if lim < 0 or lim > 64 then exit sub
  link no , x , y , z , sk( lim , 1 ) , sk( lim , 0 ) , sk( lim , 2 ), ax , p
end sub
sub spot( byref x as double , byref y as double , byref z as double )
''calulate world coordinates from lokal coordinates
''using curent matrix
  dim as double hx , hy , hz
  dim as integer i
  ''use curent matrix
  i = number
  hx = x * v( i ).m( 0 , 0 ) + y * v( i ).m( 1 , 0 ) _
  + z * v( i ).m( 2 , 0 ) + v( i ).m( 3 , 0 )
  hy = x * v( i ).m( 0 , 1 ) + y * v( i ).m( 1 , 1 ) _
  + z * v( i ).m( 2 , 1 ) + v( i ).m( 3 , 1 )
  hz = x * v( i ).m( 0 , 2 ) + y * v( i ).m( 1 , 2 ) _
  + z * v( i ).m( 2 , 2 ) + v( i ).m( 3 , 2 )
  x = hx
  y = hy
  z = hz
  ''use camara matrix
  x += - cam( 0 )
  y += - cam( 1 )
  z += - cam( 2 )
  rotate x , z , -cam( 3 )
  rotate y , z , -cam( 4 )
  rotate x , y , -cam( 5 )
  x *= cam( 6 )
  y *= cam( 6 )
  z *= cam( 6 )
end sub
sub movecam( a as double , b as double , c as double , d as double )
  rotate a , c , cam( 3 )
  cam( 0 ) += a
  cam( 1 ) += b
  cam( 2 ) += c
  cam( 3 ) = ( cam( 3 ) + d ) mod 360

end sub

''vector 3d


type t3d
  x as double
  y as double
  z as double
  declare constructor()
  declare constructor ( x as double , y as double, z as double )
  declare sub fill( x as double , y as double , z as double )
  declare sub normalize
end type
constructor t3d()
  this.x = 0
  this.y = 0
  this.z = 0
end constructor
constructor t3d( x as double , y as double , z as double )
  this.x = x
  this.y = y
  this.z = z
end constructor
operator +( a as t3d , b as t3d ) as t3d
  return type( a.x + b.x , a.y + b.y , a.z + b.z )
end operator
operator *( a as t3d , d as double ) as t3d
  return type( a.x * d , a.y * d , a.z * d )
end operator
operator \( a as t3d , b as t3d ) as t3d
  return type( a.y * b.z - a.z * b.y _
             , a.z * b.x - a.x * b.z _
             , a.x * b.y - a.y * b.x )
end operator
operator -( a as t3d , b as t3d ) as t3d
  return type( a.x - b.x , a.y - b.y , a.z - b.z )
end operator
operator /( a as t3d , d as double ) as t3d
  return type( a.x / d , a.y / d , a.z / d )
end operator
sub t3d.fill( x as double , y as double , z as double )
  this.x = x
  this.y = y
  this.z = z
end sub
function dot( a as t3d , b as t3d ) as double
  return a.x * b.x + a.y * b.y + a.z * b.z
end function
function length( q as t3d ) as double
   return sqr( q.x * q.x + q.y * q.y + q.z * q.z ) + 1e-7
end function 
function getangle( a as t3d , b as t3d ) as double
  return acos( dot( a , b ) _
  / ( length( a ) * length( b ) ) )
end function
sub t3d.normalize
  this /= length( this )
end sub

''colors
dim shared as t3d black , red , green , yellow
dim shared as t3d blue , magenta , cyan , white
black.fill 0 , 0 , 0
red.fill 1 , 0 , 0
green.fill 0 , 1 , 0
yellow.fill 1 , 1 , 0
blue.fill 0 , 0 , 1
magenta.fill 1 , 0 , 1
cyan.fill 0 , 1 , 1
white.fill 1 , 1 , 1
function tocolor( v as t3d ) as ulong
  return rgb( int(v.x*255)and 255 , int(v.y*255)and 255 , int(v.z*255)and 255 )
end function

type triangle
public :
  as t3d p(2),n,led,kl
  declare sub show( fast as integer )
end type
sub triangle.show( fast as integer )
  dim as double x(2),y(2),i,a,b,angle
  for i = 0 to 2
    if p(i).z < -900 then exit sub
    x(i)=winx/2+p(i).x/(p(i).z+1000)*1000
    y(i)=winy/2-p(i).y/(p(i).z+1000)*1000
  next i
  led = (p(0)+p(1)+p(2))/3
  if fast then
    line(x(0),y(0))-(x(1),y(1)),tocolor(kl)
    line(x(2),y(2))-(x(1),y(1)),tocolor(kl)
    line(x(0),y(0))-(x(2),y(2)),tocolor(kl)
  else
    n=(p(1)-p(0))\(p(2)-p(0))
    n.normalize
    angle = getangle(n,t3d(0,1,0))
    kl = kl * (cos( angle ) / 2 + .5)
    if abs( y(0) - y(1) ) < 1e-5 then y(0) = y(0) - 1e-3
    if abs( y(1) - y(2) ) < 1e-5 then y(2) = y(2) + 1e-3
    if y(0) > y(2) then
      swap y(0) , y(2)
      swap x(0) , x(2)
    end if
    if y(0) > y(1) then
      swap y(0) , y(1)
      swap x(0) , x(1)
    end if
    if y(1) > y(2) then
      swap y(1) , y(2)
      swap x(1) , x(2)
    end if
    for i = y(0) to y(2)
      a = x(0) + ( x(2) - x(0) ) * (i-y(0)) / ( y(2) - y(0) )
      if i < y(1) then
        b = x(0) + ( x(1) - x(0) ) * (i-y(0)) / ( y(1) - y(0) )
      else
        b = x(1) + ( x(2) - x(1) ) * (i-y(1)) / ( y(2) - y(1) )
      end if
      line ( a , i ) - ( b , i ) , tocolor( kl )
    next i
  end if
end sub

dim shared as t3d pnt( 255 )
dim shared as integer tritel = 0
dim shared as triangle tris( 200 )

sub setpoint( no as integer , x as double , y as double , z as double )
  spot x , y , z
  pnt( no ) = t3d( x , y , z )
end sub

sub tri( p1 as integer , p2 as integer , p3 as integer , kl as t3d )
  tris( tritel ).p(0) = pnt( p1 )
  tris( tritel ).p(1) = pnt( p2 )
  tris( tritel ).p(2) = pnt( p3 )
  tris( tritel ).kl = kl
  tritel += 1
end sub

sub quad( p1 as integer , p2 as integer , p3 as integer , p4 as integer , kl as t3d )
  tri p1 , p2 , p3 , kl
  tri p1 , p3 , p4 , kl
end sub

dim shared as double box( 5 )
sub setbox( x as double , y as double , z as double , dx as double , dy as double , dz as double )
  box(0)=x
  box(1)=y
  box(2)=z
  box(3)=dx
  box(4)=dy
  box(5)=dz
end sub

sub cube( kl as t3d )
  setpoint 0 ,box(0)+box(3),box(1)+box(4),box(2)+box(5)
  setpoint 1 ,box(0)+box(3),box(1)+box(4),box(2)-box(5)
  setpoint 2 ,box(0)+box(3),box(1)-box(4),box(2)+box(5)
  setpoint 3 ,box(0)+box(3),box(1)-box(4),box(2)-box(5)
  setpoint 4 ,box(0)-box(3),box(1)+box(4),box(2)+box(5)
  setpoint 5 ,box(0)-box(3),box(1)+box(4),box(2)-box(5)
  setpoint 6 ,box(0)-box(3),box(1)-box(4),box(2)+box(5)
  setpoint 7 ,box(0)-box(3),box(1)-box(4),box(2)-box(5)
 
  quad 0,1,3,2 , red
  quad 7,6,4,5 , cyan
  quad 0,1,5,4 , green
  quad 7,6,2,3 , magenta
  quad 0,2,6,4 , blue
  quad 7,5,1,3 , yellow
 
end sub

sub draw_all( fast as integer )
  if not fast then
    dim as integer i , j
    for i = 1 to tritel
      for j = 0 to i - 1
        if tris( i ).led.z > tris( j ).led.z then
          swap tris( i ) , tris( j )
        end if
      next j
    next i
    for i = 0 to tritel
      tris(i).show fast
    next i
  else
    dim as integer i
    for i = 0 to tritel
      tris(i).show fast
    next i
  end if
end sub

sub test
  dim as double angle
  dim as integer fast = 0 ''whit fast you can troggle the speed of drawing
  do
    cls
    tritel = 0
    camara 0,0,0 , 0,0,0 , 1
    link 1 , 0,0,0 , angle,0,0 , xyz , 0
    setbox 0,0,0 , 50,50,50
    cube white
    draw_all fast
    angle += 5
    flip
    if fast then
      sleep 40
    else
      sleep 1000
    end if
  loop while inkey = ""
end sub

test
#endif

badidea
Posts: 1779
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: triangle world try

Postby badidea » Feb 11, 2020 21:27

In sub draw_all( fast as integer ), make all loops: for i = 0 to tritel-1

Also in sub draw_all( fast as integer ) you compare led.z values before showing, but led valves are calculated in triangle.show.
Move this calculation outside triangle.show.

To improve the code readability (and lower change of weird bugs), try to get rid of most shared (global) variables.

Something like dim shared as integer number hidden between other stuff is a nightmare.
No one will know what this number means and where it is used, without going through all the code.

dim shared as integer winx , winy is less a problem, but better use something with width and height in it. x and y suggests a position.

I general, try to use variable names that others understand as well. I can guess what tritel means because I am Dutch. I suggest something like numTriangles or numTri.
bluatigro
Posts: 621
Joined: Apr 25, 2012 10:35
Location: netherlands

Re: triangle world try

Postby bluatigro » Feb 12, 2020 11:12

@ badidea :
thanks for clearing what is not clear

update :
winx , winy => winwidth , winheight
number => nowmatrix
tritel => tricount
triangle.led now caculated in sub tri
added some rem

error :
my cubes look strange somtimes

if somthing is not clear jet please ask

rem :
i m using bublesort on the moment
that is not the fastest metod
this is not a problem jet
on the moment i m sorting 72 triangles
it wil be a problem whit many more
help whit that is welkom

Code: Select all

''bluatigro 10 feb 2020
''triangle world

#ifndef TRIANGLES_H
#define TRIANGLES_H

screen 18 , 32 , 2
dim shared as integer winwidth , winheight
screeninfo winwidth , winheight

const as double pi           = atn( 1.0 ) * 4.0
const as double golden_ratio = ( sqr(5.0) - 1.0 ) / 2.0

function rad( x as double ) as double
''help function degrees to radians
  return x * pi / 180
end function

function degrees( x as double ) as double
  return x * 180 / pi
end function

function range( l as double , h as double ) as double
  return rnd * ( h - l ) + l
end function

sub rotate( byref k as double , byref l as double , deg as double )
  dim as double s , c , hk , hl
  s = sin( rad( deg ) )
  c = cos( rad( deg ) )
  hk = k * c - l * s
  hl = k * s + l * c
  k = hk
  l = hl
end sub

#include "fbgfx.bi"
#if __FB_LANG__ = "fb"
  Using FB '' Scan code constants are stored in the FB namespace in lang FB
#endif

''create matrix type to hold position & orentation
type matrix
  dim as double m( 3 , 3 )
end type
''create multyplycation operator for matrix
operator * ( a as matrix , b as matrix ) as matrix
  dim as integer i , j , k
  dim uit as matrix
  for i = 0 to 3
    for j = 0 to 3
''      uit.m( i , j ) = 0
      for k = 0 to 3
''        uit.m( i , j ) += a.m( i , k ) * b.m( k , j )
        uit.m( j , k ) += a.m( j , i ) * b.m( i , k )
      next k
    next j
  next i
  return uit
end operator
''create array of matrix's
dim shared as matrix v( 20 )
''create unity matrix
v( 0 ).m( 0 , 0 ) = 1
v( 0 ).m( 1 , 1 ) = 1
v( 0 ).m( 2 , 2 ) = 1
v( 0 ).m( 3 , 3 ) = 1
''create array to hold skeletal angles
dim shared as double sk( 64 , 2 )
''create some stuf for 3D engine
declare sub link( no as integer , x as double , y as double , z as double _
, pan as double , tilt as double , rol as double , ax as integer , p as integer )
declare sub child( no as integer , x as double , y as double , z as double _
, lim as integer , ax as integer , p as integer )
declare sub spot( byref x as double , byref y as double , byref z as double )
dim shared as integer nowmatrix
dim shared as double cam( 6 )
declare sub camara( x as double , y as double , z as double _
, pan as double , tilt as double , rol as double , zoom as double )
declare function pend( f as double , a as double ) as double
declare sub skelet( no as integer , x as double , y as double , z as double )

const as integer xyz = 0
const as integer xzy = 1
const as integer yxz = 2
const as integer yzx = 3
const as integer zxy = 4
const as integer zyx = 5




function pend( f as double , a as double ) as double
''pendular motion for animation
''looks verry natural
  return sin( rad( f ) ) * a
end function
sub skelet( lim as integer , x as double , y as double , z as double )
''set angles of skeletal lim
''for animated avatars
  if lim < 0 or lim > 64 then exit sub
  sk( lim , 0 ) = x
  sk( lim , 1 ) = y
  sk( lim , 2 ) = z
end sub
sub camara( x as double , y as double , z as double _
, pan as double , tilt as double , rol as double , zoom as double )
''set look from point & look angles
  cam( 0 ) = x
  cam( 1 ) = y
  cam( 2 ) = z
  cam( 3 ) = pan
  cam( 4 ) = tilt
  cam( 5 ) = rol
  cam( 6 ) = zoom
end sub
Sub link( no As Integer, x As double, y As double, z As double, pan As double, tilt As double, rol As double, ax As Integer, p As Integer )
''set curent matrix wil afect folowing drawing comands
   If no < 1 Or no > 20 Then Exit Sub
   If p < 0 Or p > 20 Then Exit Sub
   If p = no Then Exit Sub
   ''create some lokal matrix's and fill them
   Dim As matrix mp, rotx, roty, rotz, translate
   mp = v( p )
   rotx = v( 0 )
   roty = v( 0 )
   rotz = v( 0 )
   translate = v( 0 )
   rotz.m( 0, 0 ) = Cos( rad( rol ))
   rotz.m( 0, 1 ) = -Sin( rad( rol ))
   rotz.m( 1, 0 ) = Sin( rad( rol ))
   rotz.m( 1, 1 ) = Cos( rad( rol ))
   roty.m( 0, 0 ) = Cos( rad( pan ))
   roty.m( 0, 2 ) = -Sin( rad( pan ))
   roty.m( 2, 0 ) = Sin( rad( pan ))
   roty.m( 2, 2 ) = Cos( rad( pan ))
   rotx.m( 1, 1 ) = Cos( rad( tilt ))
   rotx.m( 1, 2 ) = -Sin( rad( tilt ))
   rotx.m( 2, 1 ) = Sin( rad( tilt ))
   rotx.m( 2, 2 ) = Cos( rad( tilt ))
   translate.m( 3, 0 ) = x
   translate.m( 3, 1 ) = y
   translate.m( 3, 2 ) = z
   ''angles can permutate 6 ways
   Select Case ax
      Case xyz
         v( no ) = rotx * roty * rotz * translate * mp
      Case xzy
         v( no ) = rotx * rotz * roty * translate * mp
      Case yxz
         v( no ) = roty * rotx * rotz * translate * mp
      Case yzx
         v( no ) = roty * rotz * rotx * translate * mp
      Case zxy
         v( no ) = rotz * rotx * roty * translate * mp
      Case zyx
         v( no ) = rotz * roty * rotx * translate * mp
      Case Else
   End Select
   nowmatrix = no
End Sub
sub child( no as integer , x as double , y as double , z as double _
, lim as integer , ax as integer , p as integer )
''set curent matrix for lim of animated avatar
''wil efect folowing drawings
  if lim < 0 or lim > 64 then exit sub
  link no , x , y , z , sk( lim , 1 ) , sk( lim , 0 ) , sk( lim , 2 ), ax , p
end sub
sub spot( byref x as double , byref y as double , byref z as double )
''calulate world coordinates from lokal coordinates
''using curent matrix
  dim as double hx , hy , hz
  dim as integer i
  ''use curent matrix
  i = nowmatrix
  hx = x * v( i ).m( 0 , 0 ) + y * v( i ).m( 1 , 0 ) _
  + z * v( i ).m( 2 , 0 ) + v( i ).m( 3 , 0 )
  hy = x * v( i ).m( 0 , 1 ) + y * v( i ).m( 1 , 1 ) _
  + z * v( i ).m( 2 , 1 ) + v( i ).m( 3 , 1 )
  hz = x * v( i ).m( 0 , 2 ) + y * v( i ).m( 1 , 2 ) _
  + z * v( i ).m( 2 , 2 ) + v( i ).m( 3 , 2 )
  x = hx
  y = hy
  z = hz
  ''use camara matrix
  x += - cam( 0 )
  y += - cam( 1 )
  z += - cam( 2 )
  rotate x , z , -cam( 3 )
  rotate y , z , -cam( 4 )
  rotate x , y , -cam( 5 )
  x *= cam( 6 )
  y *= cam( 6 )
  z *= cam( 6 )
end sub
sub movecam( a as double , b as double , c as double , d as double )
  rotate a , c , cam( 3 )
  cam( 0 ) += a
  cam( 1 ) += b
  cam( 2 ) += c
  cam( 3 ) = ( cam( 3 ) + d ) mod 360

end sub

''vector 3d


type t3d
  x as double
  y as double
  z as double
  declare constructor()
  declare constructor ( x as double , y as double, z as double )
  declare sub fill( x as double , y as double , z as double )
  declare sub normalize
end type
constructor t3d()
  this.x = 0
  this.y = 0
  this.z = 0
end constructor
constructor t3d( x as double , y as double , z as double )
  this.x = x
  this.y = y
  this.z = z
end constructor
operator +( a as t3d , b as t3d ) as t3d
  return type( a.x + b.x , a.y + b.y , a.z + b.z )
end operator
operator *( a as t3d , d as double ) as t3d
  return type( a.x * d , a.y * d , a.z * d )
end operator
operator \( a as t3d , b as t3d ) as t3d
  return type( a.y * b.z - a.z * b.y _
             , a.z * b.x - a.x * b.z _
             , a.x * b.y - a.y * b.x )
end operator
operator -( a as t3d , b as t3d ) as t3d
  return type( a.x - b.x , a.y - b.y , a.z - b.z )
end operator
operator /( a as t3d , d as double ) as t3d
  return type( a.x / d , a.y / d , a.z / d )
end operator
sub t3d.fill( x as double , y as double , z as double )
  this.x = x
  this.y = y
  this.z = z
end sub
function dot( a as t3d , b as t3d ) as double
  return a.x * b.x + a.y * b.y + a.z * b.z
end function
function length( q as t3d ) as double
   return sqr( q.x * q.x + q.y * q.y + q.z * q.z ) + 1e-7
end function 
function getangle( a as t3d , b as t3d ) as double
  return acos( dot( a , b ) _
  / ( length( a ) * length( b ) ) )
end function
sub t3d.normalize
  this /= length( this )
end sub

''colors
dim shared as t3d black , red , green , yellow
dim shared as t3d blue , magenta , cyan , white
black.fill 0 , 0 , 0
red.fill 1 , 0 , 0
green.fill 0 , 1 , 0
yellow.fill 1 , 1 , 0
blue.fill 0 , 0 , 1
magenta.fill 1 , 0 , 1
cyan.fill 0 , 1 , 1
white.fill 1 , 1 , 1
function tocolor( v as t3d ) as ulong
  return rgb( int(v.x*255)and 255 , int(v.y*255)and 255 , int(v.z*255)and 255 )
end function

type triangle
public :
  as t3d p(2),n,led,kl
  declare sub show( fast as integer )
end type
sub triangle.show( fast as integer )
  dim as double x(2),y(2),i,a,b,angle
  for i = 0 to 2
    if p(i).z < -900 then exit sub
    x(i)=winwidth/2+p(i).x/(p(i).z+1000)*1000
    y(i)=winheight/2-p(i).y/(p(i).z+1000)*1000
  next i
  if fast then
    line(x(0),y(0))-(x(1),y(1)),tocolor(kl)
    line(x(2),y(2))-(x(1),y(1)),tocolor(kl)
    line(x(0),y(0))-(x(2),y(2)),tocolor(kl)
  else
    n=(p(1)-p(0))\(p(2)-p(0))
    n.normalize
    angle = getangle(n,t3d(0,1,0))
    kl = kl * (cos( angle ) / 2 + .5)
    if abs( y(0) - y(1) ) < 1e-5 then y(0) = y(0) - 1e-3
    if abs( y(1) - y(2) ) < 1e-5 then y(2) = y(2) + 1e-3
    if y(0) > y(2) then
      swap y(0) , y(2)
      swap x(0) , x(2)
    end if
    if y(0) > y(1) then
      swap y(0) , y(1)
      swap x(0) , x(1)
    end if
    if y(1) > y(2) then
      swap y(1) , y(2)
      swap x(1) , x(2)
    end if
    for i = y(0) to y(2)
      a = x(0) + ( x(2) - x(0) ) * (i-y(0)) / ( y(2) - y(0) )
      if i < y(1) then
        b = x(0) + ( x(1) - x(0) ) * (i-y(0)) / ( y(1) - y(0) )
      else
        b = x(1) + ( x(2) - x(1) ) * (i-y(1)) / ( y(2) - y(1) )
      end if
      line ( a , i ) - ( b , i ) , tocolor( kl )
    next i
  end if
end sub

dim shared as t3d pnt( 255 ) ''points for the swarm
dim shared as integer tricount = 0 ''for counting triangles
dim shared as triangle tris( 200 ) ''for storing triangles

sub setpoint( no as integer , x as double , y as double , z as double )
'' set a point in the swarm
  spot x , y , z
  pnt( no ) = t3d( x , y , z )
end sub

sub tri( p1 as integer , p2 as integer , p3 as integer , kl as t3d )
'' use points in swarm to fill triangle
  tris( tricount ).p(0) = pnt( p1 )
  tris( tricount ).p(1) = pnt( p2 )
  tris( tricount ).p(2) = pnt( p3 )
  tris( tricount ).kl = kl
  tris( tricount ).led = (pnt(p1)+pnt(p2)+pnt(p3))/3
  tricount += 1
end sub

sub quad( p1 as integer , p2 as integer , p3 as integer , p4 as integer , kl as t3d )
  tri p1 , p2 , p3 , kl
  tri p1 , p3 , p4 , kl
end sub

dim shared as double box( 5 )
sub setbox( x as double , y as double , z as double , dx as double , dy as double , dz as double )
'' set bounding box middle and size
  box(0)=x
  box(1)=y
  box(2)=z
  box(3)=dx
  box(4)=dy
  box(5)=dz
end sub

sub cube( kl as t3d )
'' example mesh

'' first fil swarm
  setpoint 0 ,box(0)+box(3),box(1)+box(4),box(2)+box(5)
  setpoint 1 ,box(0)+box(3),box(1)+box(4),box(2)-box(5)
  setpoint 2 ,box(0)+box(3),box(1)-box(4),box(2)+box(5)
  setpoint 3 ,box(0)+box(3),box(1)-box(4),box(2)-box(5)
  setpoint 4 ,box(0)-box(3),box(1)+box(4),box(2)+box(5)
  setpoint 5 ,box(0)-box(3),box(1)+box(4),box(2)-box(5)
  setpoint 6 ,box(0)-box(3),box(1)-box(4),box(2)+box(5)
  setpoint 7 ,box(0)-box(3),box(1)-box(4),box(2)-box(5)

'' use swarm points for polygons for mesh
  quad 0,1,3,2 , kl
  quad 7,6,4,5 , kl
  quad 0,1,5,4 , kl
  quad 7,6,2,3 , kl
  quad 0,2,6,4 , kl
  quad 7,5,1,3 , kl
 
end sub

sub draw_all( fast as integer )
  if not fast then
    dim as integer i , j
    for i = 1 to tricount - 1
      for j = 0 to i - 1
        if tris( i ).led.z > tris( j ).led.z then
          swap tris( i ) , tris( j )
        end if
      next j
    next i
    for i = 0 to tricount - 1
      tris(i).show fast
    next i
  else
    dim as integer i
    for i = 0 to tricount - 1
      tris(i).show fast
    next i
  end if
end sub

sub test
  dim as double angle
  dim as integer fast = 0 ''whit fast you can troggle the speed of drawing
  do
    cls
    tricount = 0
    camara 0,0,0 , 0,0,0 , 1
    link 1 , -170,100,0 , angle,angle,angle , xyz , 0
    setbox 0,0,0 , 50,50,50
    cube red
    link 1 , 0,100,0 , angle,angle,angle , xzy , 0
    cube green
    link 1 , 170,100,0 , angle,angle,angle , yxz , 0
    cube blue
    link 1 , -170,-100,0 , angle,angle,angle , yzx , 0
    cube cyan
    link 1 , 0,-100,0 , angle,angle,angle , zxy , 0
    cube magenta
    link 1 , 170,-100,0 , angle,angle,angle , zyx , 0
    cube yellow
    draw_all fast
    angle += 5
    flip
    if fast then
      sleep 40
    else
      sleep 1000
    end if
  loop while inkey = ""
end sub

test
#endif

paul doe
Posts: 1067
Joined: Jul 25, 2017 17:22
Location: Argentina

Re: triangle world try

Postby paul doe » Feb 12, 2020 12:59

@bluatigro: looking good so far! To badidea's sound advice, I'd also add:

  • To avoid the 'seams' you get when drawing faces composed of more than two triangles, you need to make your triangle rasterizer support sub-pixel accuracy.
  • The 'popping' of the triangles you observe when you rotate the cubes is due to the Painter's algorithm you use to render triangles. To completely avoid it, you'll need to implement both back-face culling (this will also help with rendering speed; cache the info this part of the pipeline generates as it'll come in handy if you want to implement shading later) and some sort of Z-coverage (such as Z-buffering). Sorting the triangles back-to-front won't help you here unfortunately, no matter what sorting algorithm you use: the algorithm can't properly deal with cyclic overlap.
bluatigro
Posts: 621
Joined: Apr 25, 2012 10:35
Location: netherlands

Re: triangle world try

Postby bluatigro » Feb 13, 2020 13:12

@badidea :
ever bin at a hcc gadering ?
i m member of AI , programeren , digifoto
www.ai.hcc.nl/nieuws.html [ look for titus ]

@paul doe :
i draw CW and CCW polygons for i must be sure that they Always been drawn
so i dont undestant the advantage of back culling jet
and a z buffer i wil only need / get by raytracing
i already sort the triangles
[ it is posible that i do not understand it all jet ]

idea :
use opengl and my own 3d engine to create the animations
good or bad ?

update :
i got rid of the seems
but now i get lines of whitch i do not know where they came from

Code: Select all

''bluatigro 10 feb 2020
''triangle world

#ifndef TRIANGLES_H
#define TRIANGLES_H

screen 18 , 32 , 2
dim shared as integer winwidth , winheight
screeninfo winwidth , winheight

const as double pi           = atn( 1.0 ) * 4.0
const as double golden_ratio = ( sqr(5.0) - 1.0 ) / 2.0

function rad( x as double ) as double
''help function degrees to radians
  return x * pi / 180
end function

function degrees( x as double ) as double
  return x * 180 / pi
end function

function range( l as double , h as double ) as double
  return rnd * ( h - l ) + l
end function

sub rotate( byref k as double , byref l as double , deg as double )
  dim as double s , c , hk , hl
  s = sin( rad( deg ) )
  c = cos( rad( deg ) )
  hk = k * c - l * s
  hl = k * s + l * c
  k = hk
  l = hl
end sub

#include "fbgfx.bi"
#if __FB_LANG__ = "fb"
  Using FB '' Scan code constants are stored in the FB namespace in lang FB
#endif

''create matrix type to hold position & orentation
type matrix
  dim as double m( 3 , 3 )
end type
''create multyplycation operator for matrix
operator * ( a as matrix , b as matrix ) as matrix
  dim as integer i , j , k
  dim uit as matrix
  for i = 0 to 3
    for j = 0 to 3
''      uit.m( i , j ) = 0
      for k = 0 to 3
''        uit.m( i , j ) += a.m( i , k ) * b.m( k , j )
        uit.m( j , k ) += a.m( j , i ) * b.m( i , k )
      next k
    next j
  next i
  return uit
end operator
''create array of matrix's
dim shared as matrix v( 20 )
''create unity matrix
v( 0 ).m( 0 , 0 ) = 1
v( 0 ).m( 1 , 1 ) = 1
v( 0 ).m( 2 , 2 ) = 1
v( 0 ).m( 3 , 3 ) = 1
''create array to hold skeletal angles
dim shared as double sk( 64 , 2 )
''create some stuf for 3D engine
declare sub link( no as integer , x as double , y as double , z as double _
, pan as double , tilt as double , rol as double , ax as integer , p as integer )
declare sub child( no as integer , x as double , y as double , z as double _
, lim as integer , ax as integer , p as integer )
declare sub spot( byref x as double , byref y as double , byref z as double )
dim shared as integer nowmatrix
dim shared as double cam( 6 )
declare sub camara( x as double , y as double , z as double _
, pan as double , tilt as double , rol as double , zoom as double )
declare function pend( f as double , a as double ) as double
declare sub skelet( no as integer , x as double , y as double , z as double )

const as integer xyz = 0
const as integer xzy = 1
const as integer yxz = 2
const as integer yzx = 3
const as integer zxy = 4
const as integer zyx = 5




function pend( f as double , a as double ) as double
''pendular motion for animation
''looks verry natural
  return sin( rad( f ) ) * a
end function
sub skelet( lim as integer , x as double , y as double , z as double )
''set angles of skeletal lim
''for animated avatars
  if lim < 0 or lim > 64 then exit sub
  sk( lim , 0 ) = x
  sk( lim , 1 ) = y
  sk( lim , 2 ) = z
end sub
sub camara( x as double , y as double , z as double _
, pan as double , tilt as double , rol as double , zoom as double )
''set look from point & look angles
  cam( 0 ) = x
  cam( 1 ) = y
  cam( 2 ) = z
  cam( 3 ) = pan
  cam( 4 ) = tilt
  cam( 5 ) = rol
  cam( 6 ) = zoom
end sub
Sub link( no As Integer, x As double, y As double, z As double, pan As double, tilt As double, rol As double, ax As Integer, p As Integer )
''set curent matrix wil afect folowing drawing comands
   If no < 1 Or no > 20 Then Exit Sub
   If p < 0 Or p > 20 Then Exit Sub
   If p = no Then Exit Sub
   ''create some lokal matrix's and fill them
   Dim As matrix mp, rotx, roty, rotz, translate
   mp = v( p )
   rotx = v( 0 )
   roty = v( 0 )
   rotz = v( 0 )
   translate = v( 0 )
   rotz.m( 0, 0 ) = Cos( rad( rol ))
   rotz.m( 0, 1 ) = -Sin( rad( rol ))
   rotz.m( 1, 0 ) = Sin( rad( rol ))
   rotz.m( 1, 1 ) = Cos( rad( rol ))
   roty.m( 0, 0 ) = Cos( rad( pan ))
   roty.m( 0, 2 ) = -Sin( rad( pan ))
   roty.m( 2, 0 ) = Sin( rad( pan ))
   roty.m( 2, 2 ) = Cos( rad( pan ))
   rotx.m( 1, 1 ) = Cos( rad( tilt ))
   rotx.m( 1, 2 ) = -Sin( rad( tilt ))
   rotx.m( 2, 1 ) = Sin( rad( tilt ))
   rotx.m( 2, 2 ) = Cos( rad( tilt ))
   translate.m( 3, 0 ) = x
   translate.m( 3, 1 ) = y
   translate.m( 3, 2 ) = z
   ''angles can permutate 6 ways
   Select Case ax
      Case xyz
         v( no ) = rotx * roty * rotz * translate * mp
      Case xzy
         v( no ) = rotx * rotz * roty * translate * mp
      Case yxz
         v( no ) = roty * rotx * rotz * translate * mp
      Case yzx
         v( no ) = roty * rotz * rotx * translate * mp
      Case zxy
         v( no ) = rotz * rotx * roty * translate * mp
      Case zyx
         v( no ) = rotz * roty * rotx * translate * mp
      Case Else
   End Select
   nowmatrix = no
End Sub
sub child( no as integer , x as double , y as double , z as double _
, lim as integer , ax as integer , p as integer )
''set curent matrix for lim of animated avatar
''wil efect folowing drawings
  if lim < 0 or lim > 64 then exit sub
  link no , x , y , z , sk( lim , 1 ) , sk( lim , 0 ) , sk( lim , 2 ), ax , p
end sub
sub spot( byref x as double , byref y as double , byref z as double )
''calulate world coordinates from lokal coordinates
''using curent matrix
  dim as double hx , hy , hz
  dim as integer i
  ''use curent matrix
  i = nowmatrix
  hx = x * v( i ).m( 0 , 0 ) + y * v( i ).m( 1 , 0 ) _
  + z * v( i ).m( 2 , 0 ) + v( i ).m( 3 , 0 )
  hy = x * v( i ).m( 0 , 1 ) + y * v( i ).m( 1 , 1 ) _
  + z * v( i ).m( 2 , 1 ) + v( i ).m( 3 , 1 )
  hz = x * v( i ).m( 0 , 2 ) + y * v( i ).m( 1 , 2 ) _
  + z * v( i ).m( 2 , 2 ) + v( i ).m( 3 , 2 )
  x = hx
  y = hy
  z = hz
  ''use camara matrix
  x += - cam( 0 )
  y += - cam( 1 )
  z += - cam( 2 )
  rotate x , z , -cam( 3 )
  rotate y , z , -cam( 4 )
  rotate x , y , -cam( 5 )
  x *= cam( 6 )
  y *= cam( 6 )
  z *= cam( 6 )
end sub
sub movecam( a as double , b as double , c as double , d as double )
  rotate a , c , cam( 3 )
  cam( 0 ) += a
  cam( 1 ) += b
  cam( 2 ) += c
  cam( 3 ) = ( cam( 3 ) + d ) mod 360

end sub

''vector 3d


type t3d
  x as double
  y as double
  z as double
  declare constructor()
  declare constructor ( x as double , y as double, z as double )
  declare sub fill( x as double , y as double , z as double )
  declare sub normalize
end type
constructor t3d()
  this.x = 0
  this.y = 0
  this.z = 0
end constructor
constructor t3d( x as double , y as double , z as double )
  this.x = x
  this.y = y
  this.z = z
end constructor
operator +( a as t3d , b as t3d ) as t3d
  return type( a.x + b.x , a.y + b.y , a.z + b.z )
end operator
operator *( a as t3d , d as double ) as t3d
  return type( a.x * d , a.y * d , a.z * d )
end operator
operator \( a as t3d , b as t3d ) as t3d
  return type( a.y * b.z - a.z * b.y _
             , a.z * b.x - a.x * b.z _
             , a.x * b.y - a.y * b.x )
end operator
operator -( a as t3d , b as t3d ) as t3d
  return type( a.x - b.x , a.y - b.y , a.z - b.z )
end operator
operator /( a as t3d , d as double ) as t3d
  return type( a.x / d , a.y / d , a.z / d )
end operator
sub t3d.fill( x as double , y as double , z as double )
  this.x = x
  this.y = y
  this.z = z
end sub
function dot( a as t3d , b as t3d ) as double
  return a.x * b.x + a.y * b.y + a.z * b.z
end function
function length( q as t3d ) as double
   return sqr( q.x * q.x + q.y * q.y + q.z * q.z ) + 1e-7
end function 
function getangle( a as t3d , b as t3d ) as double
  return acos( dot( a , b ) _
  / ( length( a ) * length( b ) ) )
end function
sub t3d.normalize
  this /= length( this )
end sub

''colors
dim shared as t3d black , red , green , yellow
dim shared as t3d blue , magenta , cyan , white
black.fill 0 , 0 , 0
red.fill 1 , 0 , 0
green.fill 0 , 1 , 0
yellow.fill 1 , 1 , 0
blue.fill 0 , 0 , 1
magenta.fill 1 , 0 , 1
cyan.fill 0 , 1 , 1
white.fill 1 , 1 , 1
function tocolor( v as t3d ) as ulong
  return rgb( int(v.x*255)and 255 , int(v.y*255)and 255 , int(v.z*255)and 255 )
end function

type triangle
public :
  as t3d p(2),n,led,kl
  declare sub show( fast as integer )
end type
sub triangle.show( fast as integer )
  dim as integer x(2),y(2),i,a,b
  dim as double angle
  for i = 0 to 2
    if p(i).z < -900 then exit sub
    x(i)=winwidth/2+p(i).x/(p(i).z+1000)*1000
    y(i)=winheight/2-p(i).y/(p(i).z+1000)*1000
  next i
  if fast then
    line(x(0),y(0))-(x(1),y(1)),tocolor(kl)
    line(x(2),y(2))-(x(1),y(1)),tocolor(kl)
    line(x(0),y(0))-(x(2),y(2)),tocolor(kl)
  else
    n=(p(1)-p(0))\(p(2)-p(0))
    n.normalize
    angle = getangle(n,t3d(0,1,0))
    kl = kl * (cos( angle ) / 2 + .5)
    if abs( y(0) - y(1) ) < 1e-5 then y(0) = y(0) - 1e-3
    if abs( y(1) - y(2) ) < 1e-5 then y(2) = y(2) + 1e-3
    if y(0) > y(2) then
      swap y(0) , y(2)
      swap x(0) , x(2)
    end if
    if y(0) > y(1) then
      swap y(0) , y(1)
      swap x(0) , x(1)
    end if
    if y(1) > y(2) then
      swap y(1) , y(2)
      swap x(1) , x(2)
    end if
    for i = y(0) to y(2)
      a = x(0) + ( x(2) - x(0) ) * (i-y(0)) / ( y(2) - y(0) )
      if i < y(1) then
        b = x(0) + ( x(1) - x(0) ) * (i-y(0)) / ( y(1) - y(0) )
      else
        b = x(1) + ( x(2) - x(1) ) * (i-y(1)) / ( y(2) - y(1) )
      end if
      line ( a , i ) - ( b , i ) , tocolor( kl )
    next i
  end if
end sub

dim shared as t3d pnt( 255 ) ''points for the swarm
dim shared as integer tricount = 0 ''for counting triangles
dim shared as triangle tris( 200 ) ''for storing triangles

sub setpoint( no as integer , x as double , y as double , z as double )
'' set a point in the swarm
  spot x , y , z
  pnt( no ) = t3d( x , y , z )
end sub

sub tri( p1 as integer , p2 as integer , p3 as integer , kl as t3d )
'' use points in swarm to fill triangle
  tris( tricount ).p(0) = pnt( p1 )
  tris( tricount ).p(1) = pnt( p2 )
  tris( tricount ).p(2) = pnt( p3 )
  tris( tricount ).kl = kl
  tris( tricount ).led = (pnt(p1)+pnt(p2)+pnt(p3))/3
  tricount += 1
end sub

sub quad( p1 as integer , p2 as integer , p3 as integer , p4 as integer , kl as t3d )
  tri p1 , p2 , p3 , kl
  tri p1 , p3 , p4 , kl
end sub

dim shared as double box( 5 )
sub setbox( x as double , y as double , z as double , dx as double , dy as double , dz as double )
'' set bounding box middle and size
  box(0)=x
  box(1)=y
  box(2)=z
  box(3)=dx
  box(4)=dy
  box(5)=dz
end sub

sub cube( kl as t3d )
'' example mesh

'' first fil swarm
  setpoint 0 ,box(0)+box(3),box(1)+box(4),box(2)+box(5)
  setpoint 1 ,box(0)+box(3),box(1)+box(4),box(2)-box(5)
  setpoint 2 ,box(0)+box(3),box(1)-box(4),box(2)+box(5)
  setpoint 3 ,box(0)+box(3),box(1)-box(4),box(2)-box(5)
  setpoint 4 ,box(0)-box(3),box(1)+box(4),box(2)+box(5)
  setpoint 5 ,box(0)-box(3),box(1)+box(4),box(2)-box(5)
  setpoint 6 ,box(0)-box(3),box(1)-box(4),box(2)+box(5)
  setpoint 7 ,box(0)-box(3),box(1)-box(4),box(2)-box(5)

'' use swarm points for polygons for mesh
  quad 0,1,3,2 , kl
  quad 7,6,4,5 , kl
  quad 0,1,5,4 , kl
  quad 7,6,2,3 , kl
  quad 0,2,6,4 , kl
  quad 7,5,1,3 , kl
 
end sub

sub draw_all( fast as integer )
  if not fast then
    dim as integer i , j
    for i = 1 to tricount - 1
      for j = 0 to i - 1
        if tris( i ).led.z > tris( j ).led.z then
          swap tris( i ) , tris( j )
        end if
      next j
    next i
    for i = 0 to tricount - 1
      tris(i).show fast
    next i
  else
    dim as integer i
    for i = 0 to tricount - 1
      tris(i).show fast
    next i
  end if
end sub

sub test
  dim as double angle
  dim as integer fast = 0 ''whit fast you can troggle the speed of drawing
  do
    cls
    tricount = 0
    camara 0,0,0 , 0,0,0 , 1
    link 1 , -170,100,0 , angle,angle,angle , xyz , 0
    setbox 0,0,0 , 50,50,50
    cube red
    link 1 , 0,100,0 , angle,angle,angle , xzy , 0
    cube green
    link 1 , 170,100,0 , angle,angle,angle , yxz , 0
    cube blue
    link 1 , -170,-100,0 , angle,angle,angle , yzx , 0
    cube cyan
    link 1 , 0,-100,0 , angle,angle,angle , zxy , 0
    cube magenta
    link 1 , 170,-100,0 , angle,angle,angle , zyx , 0
    cube yellow
    draw_all fast
    angle += 5
    flip
    if fast then
      sleep 40
    else
      sleep 1000
    end if
  loop while inkey = ""
end sub

test
#endif

badidea
Posts: 1779
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: triangle world try

Postby badidea » Feb 13, 2020 19:14

bluatigro wrote:@badidea :
ever bin at a hcc gadering ?

Yes, once, about 25 years ago. It was a way for me to get a copy of PowerBasic 3.0 for free (not legal).
Without that copy, you would probably be a C-programmer now.

bluatigro wrote:idea :
use opengl and my own 3d engine to create the animations
good or bad ?

There is openb3d which uses opengl.
See: viewtopic.php?f=14&t=15409
And: viewtopic.php?f=14&t=27233
If I understand correctly, openb3d is an open source rewrite of the 3d-library in BlitzBasic.
Documentation of openb3d is a bit limited I think. Partly because BlitzBasic has disappeared.

bluatigro wrote:i got rid of the seems
but now i get lines of whitch i do not know where they came from

If you change line 314 to for i = y(0) to y(2) - 1 (so 1 line less) these lines disappear.
Also insert ScreenSet 1,0 after screen 18 , 32 , 2 to remove the flicker.
D.J.Peters
Posts: 7941
Joined: May 28, 2005 3:28

Re: triangle world try

Postby D.J.Peters » Feb 17, 2020 5:17

Code: Select all

   5----------4        +Y  +Z
  /|         /|         |  /
 / |        / |         | /
0----------1  |         |/
|  |       |  | -X -----+----- +X   
|  6-------|--7        /|
| /        | /        / |
|/         |/        /  |
3----------2       -Z  -Y

Code: Select all

#include once "crt.bi" ' memcopy ...

#ifndef __FB_64BIT__

#else
 #define USE_DOUBLE
#endif

#ifndef USE_DOUBLE
  type Real as single
  #define rAtan  atanf
  #define rAtan2 atan2f
  #define rAcos  acosf
  #define rAsin  asinf
  #define rCeil  ceilf
  #define rCos   cosf
  #define rExp   expf
  #define rExp2  exp2f
  #define rFloor floorf
  #define rLog   logf
  #define rLog2  log2f
  #define rPow   powf
  #define rSin   sinf
  #define rSqrt  sqrtf
  #define rTan   tanf
#else
  type Real as double
  #define rAtan  atan_
  #define rAtan2 atan2_
  #define rAcos  acos_
  #define rAsin  asin_
  #define rCos   cos_
  #define rCeil  ceil
  #define rExp   exp_
  #define rExp2  exp2
  #define rFloor floor
  #define rlog   log_
  #define rLog2  log2
  #define rPow   pow
  #define rSin   sin_
  #define rSqrt  sqrt
  #define rTan   tan_
#endif

const as Real rPI      = M_PI
const as Real rPI2     = M_PI*2
const as Real rDeg2Rad = rPI/180
const as Real rRad2Deg = 180/rPI

#define rAbs(x) iif((x)<0,-(x),(x))
#define rMin(x,y) iif((x)<(y),(x),(y))
#define rMax(x,y) iif((x)>(y),(x),(y))

#define RGB8(_r,_g,_b) ( (_r and &B11100000) or ((_g and &B11100000) shr 3) or ((_b and &B11000000) shr 6) )
#define RGB16(_r,_g,_b) (((_r shr 3) shl 11) or ((_g shr 2) shl 5) or (_b shr 3))
#define RGB32 RGB
#define Map(fromMin,fromMax,value,toMin,toMax) ((toMax)-(toMin))*((value)-(fromMin)) / ((fromMax)-(fromMin))+(toMin)

const as Real ZNEAR  = 1
const as Real ZFAR   = 80
const as Real ZSPACE = ZFAR-ZNEAR
const as Real ZSCALE = 512

' create 8-bit Palette (rrrgggbb)
sub Palette332()
  dim as integer i,r,g,b
  for i = 0 to 255
    r=(((i shr 5) and &H07) * 255) / 7
    g=(((i shr 2) and &H07) * 255) / 7
    b=(((i shr 0) and &H03) * 255) / 3
    palette i,r,g,b
  next
end sub

type Vector2i
  as integer x,y
end type 
type Vector2f
  as Real x,y
end type 
type Vector3f  ' 3d coords   
  as Real x,y,z
end type

type Vertex
  as Vector3f w       ' 3d world coords
  as Vector2i s       ' 2d screen coords
  as boolean bClipped ' true if is a clipped vertex
end type


'sub VertexClipZ(byref oP as Vertex, byref cP as const Vertex, byref nP as const Vertex, byval zPlane as Real)
#macro VertexClipZ(_oP,_cP,_nP,_zPlane)
  ' t = (plane-start) / ((plane-start) - (plane-end))
  ' clipped = start + t * (end-start)
  var _CA=_zPlane-_cP.w.z
  var _CB=_zPlane-_nP.w.z
  var _t=_CA/(_CA - _CB)
  _oP.bClipped = true
  _oP.w.x = _cP.w.x + _t * (_nP.w.x - _cP.w.x)
  _oP.w.y = _cP.w.y + _t * (_nP.w.y - _cP.w.y)
  _oP.w.z = _zPlane
#endmacro

'sub CopyVertex(byref oP as Vertex, byref iP as const Vertex)
#macro CopyVertex(_oP,_iP)
  memcpy(@_oP.w.x,@_iP.w.x,sizeof(Vector3f))
  _oP.bClipped=false
#endmacro

#macro defZClipping(_NAME_,_TRUE_OP_,_FALSE_OP_)
function _NAME_(oP() as       Vertex, _ ' output verticies
                iP() as const Vertex, _ ' input verticies
                byval nP as integer , _ ' number of verticies
                byval ZClip as const Real) as integer
  dim as integer n,r,c,i,j,nc,l = nP-1
  if nP<1 then return 0
  if nP=1 then
    if iP(0).w.z _TRUE_OP_##= ZClip then CopyVertex(oP(r),iP(n)) : return 1
    return 0
     
  end if
  ' more then one input vertex
  l = nP-1 ' [l]ast vertex = n verticies -1
  c=-1
  for i=0 to l
    if iP(i).w.z _TRUE_OP_##= ZClip then
      n+=1 : if c=-1 then c=i
    end if
  next
  if n=0 then return 0 ' all false
  if n=nP then ' all true
    for i=0 to l
      CopyVertex(oP(i),iP(i))     
    next
    return nP
  end if
  ' [n]ext vertex = [c]urrent vertex + 1
  n=(c+1) mod nP
  for i=0 to l ' 0 to [l]ast vertex
    if iP(c).w.z _TRUE_OP_##= ZClip andalso iP(n).w.z _TRUE_OP_##= zClip then
      CopyVertex(oP(r),iP(n))
      r+=1
    elseif iP(c).w.z _FALSE_OP_ zClip andalso iP(n).w.z _FALSE_OP_ zClip then   
      ' do nothing :-)
    else
      VertexClipZ(oP(r),iP(c),iP(n),zClip)
      r+=1
      if iP(c).w.z _FALSE_OP_ zClip then
        CopyVertex(oP(r),iP(n))
        r+=1
      end if 
    end if
    c=n : n=(c+1) mod nP
  next
  return r
end function
#endmacro
defZClipping(ZNearClipping,>,<)
defZClipping(ZFarClipping,<,>)
#undef defZClipping

#macro defFlatLine(_NAME_,_TYPE_)
sub _NAME_(byval pPixels as _TYPE_ ptr, _
           byval iPitch as integer, _
           byval x1 as integer, byval y1 as integer, _
           byval x2 as integer, byval y2 as integer, _
           byval colour as _TYPE_)
  dim as integer xy=any,E=any,EX=any,EY=any
  dim as integer dx=any,dy=any,x=any,y=any
  dim as _TYPE_ ptr ps=any,pe=any
  dx=x2-x1 : dy=y2-y1
  ps = pPixels : pe = pPixels
  if dx=0 andalso dy=0 then
    ps[y1*iPitch+x1]=colour
    exit sub
  end if
  if (dx<0) then dx=-dx : x=-1 else x=1 
  if (dy<0) then dy=-dy : y=-iPitch  else y=iPitch 
  xy = x+y
  ps=@ps[y1*iPitch+x1]
  pe=@pe[y2*iPitch+x2]
  if dy>dx then
    E=-dy : EY=E shl 1 : EX=dx shl 1 : dx=dy shr 1
    do
      E+=EX : *ps=Colour : *pe=Colour : dx-=1
      if E<0 then ps+=y  : pe-=y else ps+=xy : pe-=xy : E+=EY
    loop while dx>0
    *ps=Colour : if dy and 1 then *pe=Colour
  else
    E=-dx : EX=E shl 1 : EY=dy shl 1 : dy=dx shr 1
    do
      E+=EY : *ps=Colour : *pe=Colour : dy-=1
      if E<0 then ps+=x : pe-=x else ps+=xy: pe-=xy : E+=EX
    loop while dy>0
    *ps=Colour : if dx and 1 then *pe=Colour
  end if
end sub
#endmacro
defFlatLine(_FlatLine1,UBYTE)
defFlatLine(_FlatLine2,USHORT)
defFlatLine(_FlatLine4,ULONG)
#undef defFlatLine

enum eClipCode
  eYMAX=1
  eYMIN=2
  eXMAX=4
  eXMIN=8
end enum 
#define findXCode(x) iif((x)<iLeft,eXMIN,iif((x)>iRight,eXMAX,0))
#define findYCode(y) iif((y)<iTop ,eYMIN,iif((y)>iBottom,eYMAX,0))
#define findRegion(x,y) findXCode((x)) or findYCode((y))
sub FlatLine(byval pPixels as any ptr=0, _
             byval x1 as Real, byval y1 as Real, _
             byval x2 as Real, byval y2 as Real, _
             byval r as ulong, _
             byval g as ulong, _
             byval b as ulong)
  dim as integer iWidth=any,iHeight=any,iLeft=any,iTop=any,iRight=any,iBottom=any,iBytes=any,iPitch=any
  dim as Real x=any,y=any,xd=any,yd=any
  dim as integer accept, done
 
  if pPixels=0 then
    pPixels = screenptr() ' first pixel top left on screen
    if pPixels=0 then exit sub
    ScreenInfo iWidth, _
               iHeight,, _
               iBytes, _
               iPitch
  else
    if ImageInfo(pPixels, _
                 iWidth , _
                 iHeight, _
                 iBytes , _
                 iPitch , _
                 pPixels) then exit sub
  end if
 
  iLeft  =0
  iTop   =0
  iRight =iWidth-1
  iBottom=iHeight-1
   
 
  var code1 = findRegion(x1, y1)
  var code2 = findRegion(x2, y2)
  do
    if (code1 or code2)=0 then
      accept = 1 : done = 1
    elseif code1 and code2 then
      done = 1
    else
      xd = x2 - x1
      yd = y2 - y1
      var codeout = iif(code1,code1,code2)
      if (codeout and eXMIN) then
        y = y1 + yd *(iLeft-x1)/xd : x = iLeft
      elseif (codeout and eXMAX) then
        y = y1 + yd *(iRight-x1)/xd : x = iRight
      elseif (codeout and eYMIN) then
        x = x1 + xd *(iTop-y1)/yd : y = iTop
      elseif (codeout and eYMAX) then
        x = x1 + xd *(iBottom-y1)/yd : y = iBottom
      end if 
      if codeout = code1 then
        x1 = x : y1 = y : code1 = findRegion(x1, y1)
      else
        x2 = x : y2 = y : code2 = findRegion(x2, y2)
      end if
    end if
  loop while (done=0)
  if (accept) then
    select case as const iBytes
    case 1 :              : _FlatLine1(pPixels,iPitch,x1,y1,x2,y2,RGB8(r,g,b))
    case 2 : iPitch shr=1 : _FlatLine2(pPixels,iPitch,x1,y1,x2,y2,RGB16(r,g,b))
    case 4 : iPitch shr=2 : _FlatLine4(pPixels,iPitch,x1,y1,x2,y2,RGB32(r,g,b))
    end select
  end if 
end sub

#macro defFlatPolygon(_NAME_,_TYPE_)
sub _NAME_(byval pPixels as any ptr, _
           byval iLeft   as integer, _
           byval iTop    as integer, _
           byval iRight  as integer, _
           byval iBottom as integer, _
           byval iPitch  as integer, _
           p()           as Vertex, _
           byval n       as integer, _
           byval colour  as _TYPE_)
  dim as integer f=any,t=any,b=any,l=any,r=any
  dim as integer lc=any,nlc=any,rc=any,nrc=any
  dim as integer fixL,fixLS,fixR,fixRS
  dim as _TYPE_ ptr row=any,s=any,e=any
 
  n-=1 : t=2^30 : b=-t : l=t : r=-t
  for nc as integer=0 to n
    with p(nc)
      if .s.y<t then t=.s.y:f=nc ' top
      if .s.y>b then b=.s.y      ' bottom
      if .s.x<l then l=.s.x      ' left
      if .s.x>r then r=.s.x      ' right
    end with
  next
  ' clip
  if l>iRight    then exit sub  ' left is outside
  if r<iLeft     then exit sub  ' right is outside
  if t>iBottom   then exit sub  ' top is outside
  if b<iTop      then exit sub  ' bottom is outside
  if (r-l)<1     then exit sub  ' 0 pixels width
  if b>iBottom   then b=iBottom ' clip bottom
  if (b-t)<1     then exit sub  ' 0 pixels height
  ' left and next left counter
  lc=f:nlc=lc-1:if nlc<0 then nlc=n
  ' right and next right counter
  rc=f:nrc=rc+1:if nrc>n then nrc=0
  ' first pixel row in image or screen
  row=pPixels : row+=t*iPitch
  #define SHIFTS 10 ' fixed point format
  ' from [t]op scanline to [b]ottom scanline
  while t<b
    ' if top = curent left y then get next left y
    if t=p(lc).s.y then
      ' ignore a horizontal edge
      while p(lc).s.y=p(nlc).s.y
        lc=nlc : nlc-=1 : if nlc<0 then nlc=n
      wend
      ' x start of the left edge in fixed point
      fixL=p(lc).s.x : fixL shl= SHIFTS
      ' x step of the left edge in fixed point
      fixLS=p(nlc).s.x-p(lc).s.x : fixLS shl=SHIFTS : fixLS/=(p(nlc).s.y-p(lc).s.y)
      ' left vertex counter = next left vertex counter
      lc=nlc
    end if
    ' if top = curent right y then get next right y
    if t=p(rc).s.y then
      ' ignore a horizontal edge
      while p(rc).s.y=p(nrc).s.y
        rc=nrc : nrc+=1 : if nrc>n then nrc=0
      wend
      ' x start of the right edge in fixed point
      fixR=p(rc).s.x : fixR shl= SHIFTS
      ' x step of the right edge in fixed point
      fixRS= p(nrc).s.x-p(rc).s.x: fixRS shl= SHIFTS : fixRS/=(p(nrc).s.y-p(rc).s.y)
      ' right vertex counter = next right vertex counter
      rc=nrc
    end if
    ' if top (current y scanline) on screen or image
    if t>=iTop then
      l = fixL shr SHIFTS ' get most left  pixel from fixed point
      r = fixR shr SHIFTS ' get most right pixel from fixed point
      if l>r then return ' swap l,r
      ' on screen
      if l<=iRight andalso r>=iLeft then
        if l<iLeft  then l=iLeft
        if r>iRight then r=iRight
        s=row+l : e=row+r : e+=1
        while s<e : *s=colour : s+=1:wend
      end if
    end if
    t+=1 ' top (current scanline) = next scanline
    fixL+=fixLS : fixR+=fixRS : row+=iPitch
  wend
  #undef SHIFTS
end sub
#endmacro
defFlatPolygon(_FlatPolygon1,UBYTE)
defFlatPolygon(_FlatPolygon2,USHORT)
defFlatPolygon(_FlatPolygon4,ULONG)
#undef defFlatPolygon

sub FlatPolygon(byval pPixels as any ptr=0, _
                v() as Vertex, _
                byval n as integer, _
                byval r as long, _
                byval g as long, _
                byval b as long)
  dim as integer iWidth=any,iHeight=any,iLeft=any,iTop=any,iRight=any,iBottom=any,iBytes=any,iPitch=any
  if n<3 then exit sub
  if pPixels=0 then
    pPixels = screenptr() ' first pixel top left on screen
    if pPixels=0 then exit sub
    ScreenInfo iWidth, _
               iHeight,, _
               iBytes, _
               iPitch
  else
    if ImageInfo(pPixels   , _
                 iWidth , _
                 iHeight, _
                 iBytes , _
                 iPitch , _
                 pPixels) then exit sub
  end if
  iLeft=0 : iTop=0 : iRight=iWidth-1 : iBottom=iHeight-1 
  select case as const iBytes
  case 1 :              : _FlatPolygon1(pPixels,iLeft,iTop,iRight,iBottom,iPitch,v(),n,rgb8(r,g,b))
  case 2 : iPitch shr=1 : _FlatPolygon2(pPixels,iLeft,iTop,iRight,iBottom,iPitch,v(),n,rgb16(r,g,b))
  case 4 : iPitch shr=2 : _FlatPolygon4(pPixels,iLeft,iTop,iRight,iBottom,iPitch,v(),n,rgb32(r,g,b))
  end select
 
end sub

dim shared as Vertex   tmp(5-1)     ' 5=4+1 a quad clipped by one plane can have one more vertex 
dim shared as Vertex   clipped(5-1) ' 6=4+2 a quad clipped by two planes can have two more vertex 
function DrawPolygon(img as any ptr=0, _
                     world() as vertex, _
                     nc as integer, _
                     r as ulong, _
                     g as ulong, _
                     b as ulong, _
                     nNear as integer,_
                     nFar as integer) as boolean
  dim as integer xCenter,yCenter
  if nc<3 then return false
  ' all outside z clip space
  if nNear=nc orelse nFar=nc then return false
  if img=0 then
    screeninfo xCenter,yCenter
  else
    imageinfo img,xCenter,yCenter
  end if   
 
  xCenter/=2 : yCenter/=2
  ' do Z clipping
  if nNear>0 then
    if nFar>0 then
      ' clip world coords by the near plane to the tmp() array
      nc=ZNearClipping(tmp(),world(),nc, ZNEAR)
      ' clip tmp() array by the far plane to the clipped() array
      if nc>2 then nc=ZFarClipping(clipped(),tmp(),nc,ZFAR)
    else
      ' clip world coords by the near plane to the clipped() array
      nc = ZNearClipping(clipped(),world(),nc, ZNEAR)
    end if   
  elseif nFar>0 then
    ' clip world coords by the far plane to the clipped() array
    nc=ZFarClipping(clipped(),world(),nc, ZFAR)
  else
    ' no clipping copy only
    ' copy world coords to the clipped() array
    memcpy(@clipped(0).w.x,@world(0).w.x,nc*sizeof(Vertex))
  end if 
  ' is the clip result a triangle or polygon
  if nc<3 then return false

  ' get screen coords (as float's NOT integer)
  dim as Real dx10=any,dy10=any,dxn0=any,dyn0=any,TriangleAreaTimes2=any
  for i as integer=0 to nc-1
    clipped(i).w.z = 1.0/clipped(i).w.z
    clipped(i).w.x=clipped(i).w.x*ZSCALE*clipped(i).w.z
    clipped(i).w.y=clipped(i).w.y*ZSCALE*clipped(i).w.z
  next
  dx10 = clipped(1   ).w.x - clipped(0).w.x
  dy10 = clipped(1   ).w.y - clipped(0).w.y
  dyn0 = clipped(nc-1).w.y - clipped(0).w.y
  dxn0 = clipped(nc-1).w.x - clipped(0).w.x
  TriangleAreaTimes2 = dx10*dyn0 - dxn0*dy10
  ' is it CW = Frontface ?
  if TriangleAreaTimes2>0 then return false
 
  ' NOTE: screen xy is integer !
  for i as integer=0 to nc-1
    clipped(i).s.x=rCeil((xCenter + clipped(i).w.x)-.5)
    clipped(i).s.y=rCeil((yCenter- clipped(i).w.y)-.5)
  next
  ' draw the filled polygon
  FlatPolygon(img,clipped(),nc,r,g,b)
  ' optional draw the polygon edges
  dim as integer c,n=1
  for i as integer=0 to nc-1
    if clipped(c).bClipped=true andalso clipped(n).bClipped=true then
      ' both are clipped it isn't a edge of the original polygon
    else
      FlatLine(img,clipped(c).s.x,clipped(c).s.y,clipped(n).s.x,clipped(n).s.y,255,255,64)
    end if           
    c=n : n=(c+1) mod nc
  next 
  return true
end function

'sub Scale(vo() as Vector3f,vi() as Vector3f,nv as integer,sx as Real=1,sy as Real=1,sz as Real=1)
#macro Scale(_vo,_vi,_nv,_sx,_sy,_sz)
  for i as integer=0 to _nv-1
    _vo(i).x=_vi(i).x*_sx
    _vo(i).y=_vi(i).y*_sy
    _vo(i).z=_vi(i).z*_sz
  next 
#endmacro

'sub Rotate(vo() as Vector3f, vi() as Vector3f, nv as integer, rx as Real,ry as Real,rz as Real)
#macro Rotate(_vo,_vi,_nv,_rx,_ry,_rz)
scope
  dim as Real _r_cx,_r_cy,_r_cz
  dim as Real _r_sx,_r_sy,_r_sz
  dim as Real _r_rx,_r_ry,_r_rz
  dim as Real _r_x,_r_y,_r_z
  _r_rx=_rx*rDeg2Rad : _r_ry=_ry*rDeg2Rad : _r_rz=_rz*rDeg2Rad
  _r_cx=rCos(_r_rx) : _r_cy=rCos(_r_ry) : _r_cz=rCos(_r_rz)
  _r_sx=rSin(_r_rx) : _r_sy=rSin(_r_ry) : _r_sz=rSin(_r_rz) 
  for i as integer=0 to _nv-1
    ' rotation around x axis
    _r_y     = _vi(i).y*_r_cx - _vi(i).z*_r_sx
    _r_z     = _vi(i).y*_r_sx + _vi(i).z*_r_cx
    ' rotation around y axis
    _r_x     = _vi(i).x*_r_cy + _r_z*_r_sy
    _vo(i).z =-_vi(i).x*_r_sy + _r_z*_r_cy
    ' rotation around z axis
    _vo(i).x =     _r_x*_r_cz + _r_y*_r_sz
    _vo(i).y =    -_r_x*_r_sz + _r_y*_r_cz
  next 
end scope 
#endmacro 

'sub Move(vo() as Vector3f,vi() as Vector3f,nv as integer,mx as Real=0,my as Real=0,mz as Real=0)
#macro Move(vo,vi,nv,mx,my,mz)
  for i as integer=0 to nv-1
    vo(i).x=vi(i).x+mx
    vo(i).y=vi(i).y+my
    vo(i).z=vi(i).z+mz
  next
#endmacro

'    5------4      +Y  +Z
'   /|     /|       | /
'  0------1 |       |/
'  | |    | | -X ---+--- +X   
'  | 6----|-7      /|
'  |/     |/      / |
'  3------2     -Z -Y

dim as Vector3f BoxVectors(7) => { _
  (-.5, .5,-.5), _ ' 0
  ( .5, .5,-.5), _ ' 1
  ( .5,-.5,-.5), _ ' 2
  (-.5,-.5,-.5), _ ' 3
  ( .5, .5, .5), _ ' 4
  (-.5, .5, .5), _ ' 5
  (-.5,-.5, .5), _ ' 6
  ( .5,-.5, .5) }  ' 7

dim as integer BoxQuads(5,3) => { _ ' CW
  { 0,1,2,3}, _ ' front
  { 1,4,7,2}, _ ' right
  { 4,5,6,7}, _ ' back
  { 5,0,3,6}, _ ' left
  { 5,4,1,0}, _ ' top
  { 3,2,7,6} }  ' bottom

dim as Vector3f BoxNormals(5) => { _
  ( 0, 0,-1), _ ' front
  ( 1, 0, 0), _ ' right
  ( 0, 0, 1), _ ' back
  (-1, 0, 0), _ ' left
  ( 0, 1, 0), _ ' top
  ( 0,-1, 0) }  ' bottom

dim as long FaceRGB(5,2) => { _
  { 64,16,16}, _
  { 16,64,16}, _
  { 16,16,64}, _
  { 64,64,16}, _
  { 16,64,64}, _
  { 64,64,64} }
dim as Vector3f cube(7)    ' 8 vectors
dim as Vector3f normal(5)  ' 6 quads
dim as Vector3f camera
dim as Vector3f light=type(1,1,-1)
dim as Real l

dim as integer nc
dim as Real xr, yr, zr
dim as Real ZXScale, ZYScale

dim as integer iWidth,iHeight,iBits,iBytes
dim as integer iWidthHalf,iHeightHalf
const as integer iUpdateFrame = 6
dim as integer frame,iFPS=64
dim as double tNow,timescale=1/iFPS,tDiff,tLast


' optional enable fullscreen
dim as boolean bFullscreen = false
' optional enable pages (flip vs. screenlock)
dim as boolean bPages      = false
' optional enable a 2d image as clip region
dim as boolean bRegion     = false
dim as any ptr imgRegion
dim as integer imgLeft,imgTop,imgWidth,imgHeight

' normalize light direction
l=1.0/rSqrt(light.x*light.x + light.y*light.y + light.z*light.z)
light.x*=l : light.y*=l : light.z*=l

dim as Real deg,rad
dim as boolean bExit
dim as Vertex vert(4-1)   ' 4 vertices for 1 quad

'
' main
'
screeninfo iWidth,iHeight,iBits
if bFullscreen=false then iWidth*=0.75:iHeight*=0.75

screenres iWidth,iHeight,32,iif(bPages,2,1),iif(bFullscreen,1,0)
if bPages then screenset 1

scale(BoxVectors,BoxVectors,8,10,10,10)

' get current settings
screeninfo iWidth,iHeight,,iBytes
' in 8-bit mode use a RGB palette
if iBytes<2 then Palette332()

if bRegion then
  imgWidth =iWidth *0.75
  imgHeight=iHeight*0.75
end if 

' is screen clipping region enabled ?
if bRegion then
  ' get width and height from region
  iWidthHalf=imgWidth : iHeightHalf=imgHeight
  imgRegion=ImageCreate(imgWidth,imgHeight,0)
  imgLeft=iWidth /2-imgWidth/2
  imgTop =iHeight/2-imgHeight/2
else
  ' get width and height from screen
  iWidthHalf=iWidth : iHeightHalf=iHeight
end if 

iWidthHalf/=2 : iHeightHalf/=2 ' the half
ZXScale = iWidthHalf/ZSCALE
ZYScale = iHeightHalf/ZSCALE

tLast=timer()
deg=180
while bExit = false
 
  rad=deg*rDEG2RAD
  camera.x=rCos(rad)*10
  camera.y=rSin(rad)*10
  camera.z= 20 + 35 + rSin(rad)*35
 
  rotate(Cube  ,BoxVectors ,8,xr,yr,zr)
  rotate(normal,BoxNormals,6,xr,yr,zr)
 
  move(cube,cube,8,camera.x,camera.y,camera.z)
 
  if bPages=false then screenlock 
 
  ' clear screen
  line (0,0)-(iWidth-1,iHeight-1),0,BF
 
 
  if bRegion then
    ' clear image
    line imgRegion,(0,0)-(imgWidth-1,imgHeight-1),0,BF
  end if 

 
  for qc as integer = 0 to 5 ' six quads
    dim as Real clipValue
    dim as integer nNear,nFar,nxMin,nxMax,nyMin,nyMax
    dim as Real cosi
    dim as long r,g,b   
   
    for fi as integer = 0 to 3 ' four vertices per quad
      ' copy vector to vertex
      memcpy(@vert(fi).w.x,@cube(BoxQuads(qc,fi)).x,sizeof(Vector3f))
      ' get nearesr and farest Z coord
      if vert(fi).w.z<ZNEAR then nNear+=1
      if vert(fi).w.z>ZFAR  then nFar+=1
      ' reset clipping flag
      vert(fi).bClipped=false
    next
    ' all outside z clip space ?
    if nNear=4 then
      'locate 20+qc,1 : print "quad[" & qc & "] -z out"
      continue for
    end if 
    if nFar=4 then
      'locate 20+qc,1 : print "quad[" & qc & "] +z out"
      continue for
    end if     
   
   
    for i as integer=0 to 3
      clipvalue=vert(i).w.z*ZXScale
      if vert(i).w.x> clipvalue then nxMax+=1
      if vert(i).w.x<-clipvalue then nxMin+=1
    next
    ' all outside x clip space
    if nxMin=4 then
      'locate 4+qc,1 : print "quad[" & qc & "] -x out"
      continue for
    end if     
    if nxMax=4 then
      'locate 4+qc,1 : print "quad[" & qc & "] +x out"
      continue for
    end if 
       
    for i as integer=0 to 3
      clipvalue=vert(i).w.z*ZYScale
      if vert(i).w.y<-clipvalue then nyMin+=1
      if vert(i).w.y> clipvalue then nyMax+=1
    next
    ' all outside y clip space ?
    if nyMin=4 then
      'locate 12+qc,1 : print "quad[" & qc & "] -y out"
      continue for
    end if     
    if nyMax=4 then
      'locate 12+qc,1 : print "quad[" & qc & "] +y out"
      continue for
    end if 
       
    ' simple lighting   
    r=faceRGB(qc,0) : g=faceRGB(qc,1) : b=faceRGB(qc,2)
    cosi = normal(qc).x*light.x + normal(qc).y*light.y + normal(qc).z*light.z
    if cosi<=0 then
      ' in shadow ambient only
    elseif cosi>=1 then
      ' full bright
      r+=190 : g+=190 : b+=190     
    else ' angle
      cosi*=cosi : cosi*=cosi
      r+=190*cosi : g+=190*cosi : b+=190*cosi
    end if 
    DrawPolygon(imgRegion,vert(),4,r,g,b,nNear,nFar)
  next
 
  locate 1,1 : print "frame: " & frame & " fps: " & iFPS & " timescale: " & timescale
 
  ' put result on screen
  if bRegion then
    ' draw a boarder
    line imgRegion,(0,0)-(imgWidth-1,imgHeight-1),&HFFFFFFFF,B
    put (imgLeft,imgTop),imgRegion,pset
  end if 
 
  ' use flip or unlock
  if bPages then flip else screenunlock 

  sleep 10
  frame+=1
  if frame mod iUpdateFrame=0 then
    tNow = Timer() : tDiff = tNow-tLast
    iFPS = iif(tDiff<>0.0,iUpdateFrame/tDiff,60) : tLast = tNow
    TimeScale=TimeScale * 0.9 + 1.0/iFPS * 0.1
    if asc(inkey())=27 then bExit=true
  end if
 
  xr +=  5*TimeScale
  yr += 10*TimeScale
  zr += 15*TimeScale
  deg+= 10*TimeScale
wend
bluatigro
Posts: 621
Joined: Apr 25, 2012 10:35
Location: netherlands

Re: triangle world try

Postby bluatigro » Feb 21, 2020 13:31

update :
SKIN in opengl

now we can create skined legs of animals

how to do a tail ?

Code: Select all


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


const as double PI = atn( 1 ) * 4
const as double GOLDEN_RATIO = ( sqr( 5 ) - 1 ) / 2


type dbl3d
  x as double
  y as double
  z as double
  declare constructor()
  declare constructor ( x as double , y as double, z as double )
  declare sub fill( x as double , y as double , z as double )
  declare sub normalize
end type
constructor dbl3d()
  this.x = 0
  this.y = 0
  this.z = 0
end constructor
constructor dbl3d( x as double , y as double , z as double )
  this.x = x
  this.y = y
  this.z = z
end constructor
operator +( a as dbl3d , b as dbl3d ) as dbl3d
  return type( a.x + b.x , a.y + b.y , a.z + b.z )
end operator
operator *( a as dbl3d , d as double ) as dbl3d
  return type( a.x * d , a.y * d , a.z * d )
end operator
operator \( a as dbl3d , b as dbl3d ) as dbl3d
  return type( a.y * b.z - a.z * b.y _
             , a.z * b.x - a.x * b.z _
             , a.x * b.y - a.y * b.x )
end operator
operator -( a as dbl3d , b as dbl3d ) as dbl3d
  return type( a.x - b.x , a.y - b.y , a.z - b.z )
end operator
operator /( a as dbl3d , d as double ) as dbl3d
  return type( a.x / d , a.y / d , a.z / d )
end operator
sub dbl3d.fill( x as double , y as double , z as double )
  this.x = x
  this.y = y
  this.z = z
end sub
declare function dot( a as dbl3d , b as dbl3d ) as double
function dot( a as dbl3d , b as dbl3d ) as double
  return a.x * b.x + a.y * b.y + a.z * b.z
end function
declare function length( q as dbl3d ) as double
function length( q as dbl3d ) as double
   return sqr( q.x * q.x + q.y * q.y + q.z * q.z ) + 1e-7
end function 
declare function anlge( a as dbl3d , b as dbl3d ) as double
function getangle( a as dbl3d , b as dbl3d ) as double
  return acos( dot( a , b ) _
  / ( length( a ) * length( b ) ) )
end function
sub dbl3d.normalize
  this /= length( this )
end sub


function rad( x as double ) as double
''help function degrees to radians
  return x * pi / 180
end function

function degrees( x as double ) as double
  return x * 180 / pi
end function

function range( l as double , h as double ) as double
  return rnd * ( h - l ) + l
end function

sub rotate( byref k as double , byref l as double , deg as double )
  dim as double s , c , hk , hl
  s = sin( rad( deg ) )
  c = cos( rad( deg ) )
  hk = k * c - l * s
  hl = k * s + l * c
  k = hk
  l = hl
end sub

''CAMARA

type t_camara
public :
  dim as double x,y,z,pan,tilt
  declare sub move( dx as double _
  , dy as double , dz as double , dpan as double )
  declare sub use()
end type
sub t_camara.move( dx as double _
  , dy as double , dz as double , dpan as double )
  rotate dx , dz , -pan
  x += dx
  y += dy
  z += dz
  pan += dpan
end sub
sub t_camara.use
  glLoadIdentity
  glRotated -tilt , 0 , 0 , 1
  glRotated -pan , 0 , 1 , 0
  glTranslated -x , -y , -z
end sub

dim shared as t_camara camara

''3DENGINE

declare sub child( x as double , y as double , z as double , ax as integer , lim as integer )
declare function pend( fase as double , amp as double ) as double
declare sub skelet( no as integer , x as double , y as double , z as double )

dim shared as dbl3d sk( 64 )


const as integer xyz = 0
const as integer xzy = 1
const as integer yxz = 2
const as integer yzx = 3
const as integer zxy = 4
const as integer zyx = 5

sub child( x as double , y as double , z as double , lim as integer , ax as integer )
  glTranslatef x , y , z
  select case ax
    case xyz
      glrotated sk( lim ).x , 1 , 0 , 0
      glrotated sk( lim ).y , 0 , 1 , 0
      glrotated sk( lim ).z , 0 , 0 , 1
    case xzy
      glrotated sk( lim ).x , 1 , 0 , 0
      glrotated sk( lim ).z , 0 , 0 , 1
      glrotated sk( lim ).y , 0 , 1 , 0
    case yxz
      glrotated sk( lim ).y , 0 , 1 , 0
      glrotated sk( lim ).x , 1 , 0 , 0
      glrotated sk( lim ).z , 0 , 0 , 1
    case yzx
      glrotated sk( lim ).y , 0 , 1 , 0
      glrotated sk( lim ).z , 0 , 0 , 1
      glrotated sk( lim ).x , 1 , 0 , 0
    case zxy
      glrotated sk( lim ).z , 0 , 0 , 1
      glrotated sk( lim ).x , 1 , 0 , 0
      glrotated sk( lim ).y , 0 , 1 , 0
    case zyx
      glrotated sk( lim ).z , 0 , 0 , 1
      glrotated sk( lim ).y , 0 , 1 , 0
      glrotated sk( lim ).x , 1 , 0 , 0
    case else
  end select 
end sub

function pend( fase as double , amp as double ) as double
  return sin( fase * PI / 180 ) * amp
end function

sub skelet( lim as integer , x as double , y as double , z as double )
  sk( lim and 63 ) = dbl3d( x , y , z )
end sub

#include "fbgfx.bi"
#if __FB_LANG__ = "fb"
  Using FB
#endif
SCREEN 18 , 32 , , 2

DIM shared AS INTEGER winx , winy
SCREENINFO winx , winy
''SCREENRES winx , winy , 32 , 2 , FB.GFX_FULLSCREEN

'' ReSizeGLScene
glViewport 0, 0, winx , winy                      '' Reset The Current Viewport
glMatrixMode GL_PROJECTION                     '' Select The Projection Matrix
glLoadIdentity                                 '' Reset The Projection Matrix
gluPerspective 45.0, csng(winx/winy), 0.1, 100.0   '' Calculate The Aspect Ratio Of The Window
glMatrixMode GL_MODELVIEW                      '' Select The Modelview Matrix
glLoadIdentity                                 '' Reset The Modelview Matrix
   
'' All Setup For OpenGL Goes Here
glShadeModel GL_SMOOTH                         '' Enable Smooth Shading
glClearColor 0.0, 0.0, 0.0, 1.0                '' Black Background
glClearDepth 1.0                               '' Depth Buffer Setup
glEnable GL_DEPTH_TEST                         '' Enables Depth Testing
glDepthFunc GL_LEQUAL                          '' The Type Of Depth Testing To Do
glHint GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST    '' Really Nice Perspective Calculations

glEnable( gl_lighting )
dim as single lightpos( 3 ) = { -50 , 50 , 50 , 1 }
dim as single diffuse( 3 ) = { 1 , 1 , 1 , 1 }
glLightfv( gl_light0 , gl_position, @lightpos(0) )
glLightfv( gl_light0 , gl_diffuse , @diffuse(0) )
glEnable( gl_light0 )

''COLORS

type sng4d
  dim as single x , y , z , w
  declare constructor ()
  declare constructor ( nx as single , ny as single , nz as single , nw as single )
  declare sub fill( nx as single , ny as single , nz as single , nw as single )
end type
constructor sng4d()
end constructor
constructor sng4d( nx as single , ny as single , nz as single , nw as single )
  x = nx
  y = ny
  z = nz
  w = nw
end constructor
operator + ( a as sng4d , b as sng4d ) as sng4d
  return sng4d(a.x+b.x,a.y+b.y,a.z+b.z,1)
end operator
operator - ( a as sng4d , b as sng4d ) as sng4d
  return sng4d(a.x-b.x,a.y-b.y,a.z-b.z,1)
end operator
operator / ( a as sng4d , b as single ) as sng4d
  return sng4d(a.x/b,a.y/b,a.z/b,1)
end operator
operator * ( a as sng4d , b as single ) as sng4d
  return sng4d(a.x*b,a.y*b,a.z*b,1)
end operator
function rainbow( deg as double ) as sng4d
  return sng4d( sin( rad( deg ) ) / 2 + .5 _
              , sin( rad( deg - 120 ) ) / 2 + .5 _
              , sin( rad( deg + 120 ) ) / 2 + .5 , 1 )
end function
sub sng4d.fill( nx as single , ny as single , nz as single , nw as single )
  x = nx
  y = ny
  z = nz
  w = nw
end sub

dim shared as sng4d black , red , green , yellow _
, blue , magenta , cyan , white _
, orange , gray , pink
black.fill   0,0,0,1
red.fill     1,0,0,1
green.fill   0,1,0,1
yellow.fill  1,1,0,1
blue.fill    0,0,1,1
magenta.fill 1,0,1,1
cyan.fill    0,1,1,1
white.fill   1,1,1,1

orange.fill   1,.5, 0,1
gray.fill    .5,.5,.5,1
pink.fill     1,.5,.5,1

function mix( a as sng4d , f as double , b as sng4d ) as sng4d
  dim uit as sng4d
  uit.x = a.x + ( b.x - a.x ) * f
  uit.y = a.y + ( b.y - a.y ) * f
  uit.z = a.z + ( b.z - a.z ) * f
  uit.w = 1
  return uit
end function

''MATERIAL

type t_material
  dim as sng4d ambient , diffuse , specular , emision
  dim as single shininess
end type
dim shared as t_material material
sub setMaterial( a as long , m as t_material )
  glMaterialfv a , GL_AMBIENT , @m.ambient.x
  glMaterialfv a , GL_DIFFUSE , @m.diffuse.x
  glMaterialfv a , GL_SPECULAR , @m.specular.x
  glMaterialfv a , GL_EMISSION , @m.emision.x
  glMaterialf a , GL_SHININESS , m.shininess
end sub


''create matrix type to hold position & orentation
type matrix
  dim as double m( 3 , 3 )
end type
''create multyplycation operator for matrix
operator * ( a as matrix , b as matrix ) as matrix
  dim as integer i , j , k
  dim uit as matrix
  for i = 0 to 3
    for j = 0 to 3
''      uit.m( i , j ) = 0
      for k = 0 to 3
''        uit.m( i , j ) += a.m( i , k ) * b.m( k , j )
        uit.m( j , k ) += a.m( j , i ) * b.m( i , k )
      next k
    next j
  next i
  return uit
end operator
''create array of matrix's
dim shared as matrix v( 20 )
''create unity matrix
v( 0 ).m( 0 , 0 ) = 1
v( 0 ).m( 1 , 1 ) = 1
v( 0 ).m( 2 , 2 ) = 1
v( 0 ).m( 3 , 3 ) = 1
''create some stuf for 3D engine
declare sub link( no as integer , x as double , y as double , z as double _
, pan as double , tilt as double , rol as double , ax as integer , p as integer )
declare sub ido( no as integer , x as double , y as double , z as double _
, lim as integer , ax as integer , p as integer )
declare sub spot( byref x as double , byref y as double , byref z as double )
dim shared as integer nowmatrix

Sub link( no As Integer, x As double, y As double, z As double, pan As double, tilt As double, rol As double, ax As Integer, p As Integer )
''set curent matrix wil afect folowing drawing comands
   If no < 1 Or no > 20 Then Exit Sub
   If p < 0 Or p > 20 Then Exit Sub
   If p = no Then Exit Sub
   ''create some lokal matrix's and fill them
   Dim As matrix mp, rotx, roty, rotz, translate
   mp = v( p )
   rotx = v( 0 )
   roty = v( 0 )
   rotz = v( 0 )
   translate = v( 0 )
   rotz.m( 0, 0 ) = Cos( rad( rol ))
   rotz.m( 0, 1 ) = -Sin( rad( rol ))
   rotz.m( 1, 0 ) = Sin( rad( rol ))
   rotz.m( 1, 1 ) = Cos( rad( rol ))
   roty.m( 0, 0 ) = Cos( rad( pan ))
   roty.m( 0, 2 ) = -Sin( rad( pan ))
   roty.m( 2, 0 ) = Sin( rad( pan ))
   roty.m( 2, 2 ) = Cos( rad( pan ))
   rotx.m( 1, 1 ) = Cos( rad( tilt ))
   rotx.m( 1, 2 ) = -Sin( rad( tilt ))
   rotx.m( 2, 1 ) = Sin( rad( tilt ))
   rotx.m( 2, 2 ) = Cos( rad( tilt ))
   translate.m( 3, 0 ) = x
   translate.m( 3, 1 ) = y
   translate.m( 3, 2 ) = z
   ''angles can permutate 6 ways
   Select Case ax
      Case xyz
         v( no ) = rotx * roty * rotz * translate * mp
      Case xzy
         v( no ) = rotx * rotz * roty * translate * mp
      Case yxz
         v( no ) = roty * rotx * rotz * translate * mp
      Case yzx
         v( no ) = roty * rotz * rotx * translate * mp
      Case zxy
         v( no ) = rotz * rotx * roty * translate * mp
      Case zyx
         v( no ) = rotz * roty * rotx * translate * mp
      Case Else
   End Select
   nowmatrix = no
End Sub
sub ido( no as integer , x as double , y as double , z as double _
, lim as integer , ax as integer , p as integer )
''set curent matrix for lim of animated avatar
''wil efect folowing drawings
  if lim < 0 or lim > 64 then exit sub
  link no , x , y , z , sk( lim ).y , sk( lim ).x , sk( lim ).z, ax , p
end sub
sub spot( byref x as double , byref y as double , byref z as double )
''calulate world coordinates from lokal coordinates
''using curent matrix
  dim as double hx , hy , hz
  dim as integer i
  ''use curent matrix
  i = nowmatrix
  hx = x * v( i ).m( 0 , 0 ) + y * v( i ).m( 1 , 0 ) _
  + z * v( i ).m( 2 , 0 ) + v( i ).m( 3 , 0 )
  hy = x * v( i ).m( 0 , 1 ) + y * v( i ).m( 1 , 1 ) _
  + z * v( i ).m( 2 , 1 ) + v( i ).m( 3 , 1 )
  hz = x * v( i ).m( 0 , 2 ) + y * v( i ).m( 1 , 2 ) _
  + z * v( i ).m( 2 , 2 ) + v( i ).m( 3 , 2 )
  x = hx
  y = hy
  z = hz
end sub

dim shared as dbl3d pnt( 255 ) ''points for the swarm

sub setpunt( no as integer , x as double , y as double , z as double )
'' set a point in the swarm
  spot x , y , z
  pnt( no ) = dbl3d( x , y , z )
end sub

sub setpoint( no as integer , x as double , y as double , z as double )
  if no < 0 or no > ubound( pnt ) then exit sub
  pnt( no ) = dbl3d( x , y , z )
end sub


sub tri( p1 as integer , p2 as integer , p3 as integer )
  if p1 < 0 or p1 > 255 then exit sub
  if p2 < 0 or p2 > 255 then exit sub
  if p3 < 0 or p3 > 255 then exit sub
  dim as dbl3d n = ( pnt( p2 ) - pnt( p1 ) ) _
               \ ( pnt( p3 ) - pnt( p1 ) )
  n.normalize()
  glbegin gl_triangles
    glnormal3d n.x , n.y , n.z
    glvertex3d pnt( p1 ).x , pnt( p1 ).y , pnt( p1 ).z
    glvertex3d pnt( p2 ).x , pnt( p2 ).y , pnt( p2 ).z
    glvertex3d pnt( p3 ).x , pnt( p3 ).y , pnt( p3 ).z
  glend
end sub

sub quad( p1 as integer , p2 as integer , p3 as integer , p4 as integer )
  if p1 < 0 or p1 > 255 then exit sub
  if p2 < 0 or p2 > 255 then exit sub
  if p3 < 0 or p3 > 255 then exit sub
  if p4 < 0 or p4 > 255 then exit sub
  dim as dbl3d n = ( pnt( p2 ) - pnt( p1 ) ) _
               \ ( pnt( p3 ) - pnt( p1 ) )
  n.normalize()
  glbegin gl_quads
    glnormal3d n.x , n.y , n.z
    glvertex3d pnt( p1 ).x , pnt( p1 ).y , pnt( p1 ).z
    glvertex3d pnt( p2 ).x , pnt( p2 ).y , pnt( p2 ).z
    glvertex3d pnt( p3 ).x , pnt( p3 ).y , pnt( p3 ).z
    glvertex3d pnt( p4 ).x , pnt( p4 ).y , pnt( p4 ).z
  glend
end sub

dim shared as double box( 5 )
sub setbox( x as double , y as double , z as double , dx as double , dy as double , dz as double )
'' set bounding box middle and size
  box(0)=x
  box(1)=y
  box(2)=z
  box(3)=dx
  box(4)=dy
  box(5)=dz
end sub


sub cube( kl as sng4d )
'' example mesh
  material.diffuse = kl
  material.ambient = kl
  setmaterial gl_front , material
'' first fil swarm
  setpoint 0 ,box(0)+box(3),box(1)+box(4),box(2)+box(5)
  setpoint 1 ,box(0)+box(3),box(1)+box(4),box(2)-box(5)
  setpoint 2 ,box(0)+box(3),box(1)-box(4),box(2)+box(5)
  setpoint 3 ,box(0)+box(3),box(1)-box(4),box(2)-box(5)
  setpoint 4 ,box(0)-box(3),box(1)+box(4),box(2)+box(5)
  setpoint 5 ,box(0)-box(3),box(1)+box(4),box(2)-box(5)
  setpoint 6 ,box(0)-box(3),box(1)-box(4),box(2)+box(5)
  setpoint 7 ,box(0)-box(3),box(1)-box(4),box(2)-box(5)

'' use swarm points for polygons for mesh
  quad 0,1,3,2
  quad 7,6,4,5
  quad 0,1,5,4
  quad 7,6,2,3
  quad 0,2,6,4
  quad 7,5,1,3
 
end sub


sub flex( sides as integer , m as integer , lim as integer , p as integer , kl as sng4d )
  dim as integer i
  dim as double x , y , z
  for i = 0 to sides
    x = box(0) + sin( i * pi * 2 / sides ) * box(3)
    y = box(1) + box(4)
    z = box(2) + cos( i * pi * 2 / sides ) * box(5)
    setpunt i , x , y , z
  next i
  ido m , 0,0,0 , lim , xyz , p
  for i = 0 to sides
    x = box(0) + sin( i * pi * 2 / sides ) * box(3)
    y = box(1) - box(4)
    z = box(2) + cos( i * pi * 2 / sides ) * box(5)
    setpunt i + sides + 1 , x , y , z
  next i
  material.diffuse = kl
  material.ambient = kl
  setmaterial gl_front , material
  for i = 0 to sides - 1
    quad i , i + 1 , i + sides + 2 , i + sides + 1
  next
end sub

sub flex2( sides as integer , m as integer , lim as integer , p as integer , kl as sng4d )
  dim as integer i
  dim as double x , y , z
  for i = 0 to sides
    pnt(i) = pnt(i+sides+1)
  next i
  ido m , 0,-box(4),0 , lim , xyz , p
  for i = 0 to sides
    x = box(0) + sin( i * pi * 2 / sides ) * box(3)
    y = box(1) - box(4)
    z = box(2) + cos( i * pi * 2 / sides ) * box(5)
    setpunt i + sides + 1 , x , y , z
  next i
  material.diffuse = kl
  material.ambient = kl
  setmaterial gl_front , material
  for i = 0 to sides - 1
    quad i , i + 1 , i + sides + 2 , i + sides + 1
  next
end sub

sub test2
  dim as double angle
  dim as integer fast = 1 ''whit fast you can troggle the speed of drawing
  do
    glclear gl_color_buffer_bit or gl_depth_buffer_bit
    camara.use
    link 1 , 0,.5,-3 , 0,0,0 , xyz , 0
    setbox 0,0,0 , .5,.5,.5
    skelet 0 , pend( angle + 90 , 30 ) , 0 , pend( angle , 30 )
    flex 6 , 2 , 0 , 1 , red
    flex2 6 , 3 , 0 , 2 , green
    flex2 6 , 4 , 0 , 3 , blue
    angle += 1
    flip
    sleep 40
  loop while inkey = ""
end sub

test2



bluatigro
Posts: 621
Joined: Apr 25, 2012 10:35
Location: netherlands

Re: triangle world try

Postby bluatigro » Feb 23, 2020 15:04

update :
try at dinosaurier

[ i m a big fan of walking whit dinosoars ]

first step :
body + tail

error :
my tail moves not good the hole time

Code: Select all


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


const as double PI = atn( 1 ) * 4
const as double GOLDEN_RATIO = ( sqr( 5 ) - 1 ) / 2


type dbl3d
  x as double
  y as double
  z as double
  declare constructor()
  declare constructor ( x as double , y as double, z as double )
  declare sub fill( x as double , y as double , z as double )
  declare sub normalize
end type
constructor dbl3d()
  this.x = 0
  this.y = 0
  this.z = 0
end constructor
constructor dbl3d( x as double , y as double , z as double )
  this.x = x
  this.y = y
  this.z = z
end constructor
operator +( a as dbl3d , b as dbl3d ) as dbl3d
  return type( a.x + b.x , a.y + b.y , a.z + b.z )
end operator
operator *( a as dbl3d , d as double ) as dbl3d
  return type( a.x * d , a.y * d , a.z * d )
end operator
operator \( a as dbl3d , b as dbl3d ) as dbl3d
  return type( a.y * b.z - a.z * b.y _
             , a.z * b.x - a.x * b.z _
             , a.x * b.y - a.y * b.x )
end operator
operator -( a as dbl3d , b as dbl3d ) as dbl3d
  return type( a.x - b.x , a.y - b.y , a.z - b.z )
end operator
operator /( a as dbl3d , d as double ) as dbl3d
  return type( a.x / d , a.y / d , a.z / d )
end operator
sub dbl3d.fill( x as double , y as double , z as double )
  this.x = x
  this.y = y
  this.z = z
end sub
declare function dot( a as dbl3d , b as dbl3d ) as double
function dot( a as dbl3d , b as dbl3d ) as double
  return a.x * b.x + a.y * b.y + a.z * b.z
end function
declare function length( q as dbl3d ) as double
function length( q as dbl3d ) as double
   return sqr( q.x * q.x + q.y * q.y + q.z * q.z ) + 1e-7
end function 
declare function anlge( a as dbl3d , b as dbl3d ) as double
function getangle( a as dbl3d , b as dbl3d ) as double
  return acos( dot( a , b ) _
  / ( length( a ) * length( b ) ) )
end function
sub dbl3d.normalize
  this /= length( this )
end sub


function rad( x as double ) as double
''help function degrees to radians
  return x * pi / 180
end function

function degrees( x as double ) as double
  return x * 180 / pi
end function

function range( l as double , h as double ) as double
  return rnd * ( h - l ) + l
end function

sub rotate( byref k as double , byref l as double , deg as double )
  dim as double s , c , hk , hl
  s = sin( rad( deg ) )
  c = cos( rad( deg ) )
  hk = k * c - l * s
  hl = k * s + l * c
  k = hk
  l = hl
end sub

''CAMARA

type t_camara
public :
  dim as double x,y,z,pan,tilt
  declare sub move( dx as double _
  , dy as double , dz as double , dpan as double )
  declare sub use()
end type
sub t_camara.move( dx as double _
  , dy as double , dz as double , dpan as double )
  rotate dx , dz , -pan
  x += dx
  y += dy
  z += dz
  pan += dpan
end sub
sub t_camara.use
  glLoadIdentity
  glRotated -tilt , 0 , 0 , 1
  glRotated -pan , 0 , 1 , 0
  glTranslated -x , -y , -z
end sub

dim shared as t_camara camara

''3DENGINE

declare sub child( x as double , y as double , z as double , ax as integer , lim as integer )
declare function pend( fase as double , amp as double ) as double
declare sub skelet( no as integer , x as double , y as double , z as double )

dim shared as dbl3d sk( 64 )


const as integer xyz = 0
const as integer xzy = 1
const as integer yxz = 2
const as integer yzx = 3
const as integer zxy = 4
const as integer zyx = 5

sub child( x as double , y as double , z as double , lim as integer , ax as integer )
  glTranslatef x , y , z
  select case ax
    case xyz
      glrotated sk( lim ).x , 1 , 0 , 0
      glrotated sk( lim ).y , 0 , 1 , 0
      glrotated sk( lim ).z , 0 , 0 , 1
    case xzy
      glrotated sk( lim ).x , 1 , 0 , 0
      glrotated sk( lim ).z , 0 , 0 , 1
      glrotated sk( lim ).y , 0 , 1 , 0
    case yxz
      glrotated sk( lim ).y , 0 , 1 , 0
      glrotated sk( lim ).x , 1 , 0 , 0
      glrotated sk( lim ).z , 0 , 0 , 1
    case yzx
      glrotated sk( lim ).y , 0 , 1 , 0
      glrotated sk( lim ).z , 0 , 0 , 1
      glrotated sk( lim ).x , 1 , 0 , 0
    case zxy
      glrotated sk( lim ).z , 0 , 0 , 1
      glrotated sk( lim ).x , 1 , 0 , 0
      glrotated sk( lim ).y , 0 , 1 , 0
    case zyx
      glrotated sk( lim ).z , 0 , 0 , 1
      glrotated sk( lim ).y , 0 , 1 , 0
      glrotated sk( lim ).x , 1 , 0 , 0
    case else
  end select 
end sub

function pend( fase as double , amp as double ) as double
  return sin( fase * PI / 180 ) * amp
end function

sub skelet( lim as integer , x as double , y as double , z as double )
  sk( lim and 63 ) = dbl3d( x , y , z )
end sub

#include "fbgfx.bi"
#if __FB_LANG__ = "fb"
  Using FB
#endif
SCREEN 18 , 32 , , 2

DIM shared AS INTEGER winx , winy
SCREENINFO winx , winy
''SCREENRES winx , winy , 32 , 2 , FB.GFX_FULLSCREEN

'' ReSizeGLScene
glViewport 0, 0, winx , winy                      '' Reset The Current Viewport
glMatrixMode GL_PROJECTION                     '' Select The Projection Matrix
glLoadIdentity                                 '' Reset The Projection Matrix
gluPerspective 45.0, csng(winx/winy), 0.1, 100.0   '' Calculate The Aspect Ratio Of The Window
glMatrixMode GL_MODELVIEW                      '' Select The Modelview Matrix
glLoadIdentity                                 '' Reset The Modelview Matrix
   
'' All Setup For OpenGL Goes Here
glShadeModel GL_SMOOTH                         '' Enable Smooth Shading
glClearColor 0.0, 0.0, 0.0, 1.0                '' Black Background
glClearDepth 1.0                               '' Depth Buffer Setup
glEnable GL_DEPTH_TEST                         '' Enables Depth Testing
glDepthFunc GL_LEQUAL                          '' The Type Of Depth Testing To Do
glHint GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST    '' Really Nice Perspective Calculations

glEnable( gl_lighting )
dim as single lightpos( 3 ) = { -50 , 50 , 50 , 1 }
dim as single diffuse( 3 ) = { 1 , 1 , 1 , 1 }
glLightfv( gl_light0 , gl_position, @lightpos(0) )
glLightfv( gl_light0 , gl_diffuse , @diffuse(0) )
glEnable( gl_light0 )

''COLORS

type sng4d
  dim as single x , y , z , w
  declare constructor ()
  declare constructor ( nx as single , ny as single , nz as single , nw as single )
  declare sub fill( nx as single , ny as single , nz as single , nw as single )
end type
constructor sng4d()
end constructor
constructor sng4d( nx as single , ny as single , nz as single , nw as single )
  x = nx
  y = ny
  z = nz
  w = nw
end constructor
operator + ( a as sng4d , b as sng4d ) as sng4d
  return sng4d(a.x+b.x,a.y+b.y,a.z+b.z,1)
end operator
operator - ( a as sng4d , b as sng4d ) as sng4d
  return sng4d(a.x-b.x,a.y-b.y,a.z-b.z,1)
end operator
operator / ( a as sng4d , b as single ) as sng4d
  return sng4d(a.x/b,a.y/b,a.z/b,1)
end operator
operator * ( a as sng4d , b as single ) as sng4d
  return sng4d(a.x*b,a.y*b,a.z*b,1)
end operator
function rainbow( deg as double ) as sng4d
  return sng4d( sin( rad( deg ) ) / 2 + .5 _
              , sin( rad( deg - 120 ) ) / 2 + .5 _
              , sin( rad( deg + 120 ) ) / 2 + .5 , 1 )
end function
sub sng4d.fill( nx as single , ny as single , nz as single , nw as single )
  x = nx
  y = ny
  z = nz
  w = nw
end sub

dim shared as sng4d black , red , green , yellow _
, blue , magenta , cyan , white _
, orange , gray , pink
black.fill   0,0,0,1
red.fill     1,0,0,1
green.fill   0,1,0,1
yellow.fill  1,1,0,1
blue.fill    0,0,1,1
magenta.fill 1,0,1,1
cyan.fill    0,1,1,1
white.fill   1,1,1,1

orange.fill   1,.5, 0,1
gray.fill    .5,.5,.5,1
pink.fill     1,.5,.5,1

function mix( a as sng4d , f as double , b as sng4d ) as sng4d
  dim uit as sng4d
  uit.x = a.x + ( b.x - a.x ) * f
  uit.y = a.y + ( b.y - a.y ) * f
  uit.z = a.z + ( b.z - a.z ) * f
  uit.w = 1
  return uit
end function

''MATERIAL

type t_material
  dim as sng4d ambient , diffuse , specular , emision
  dim as single shininess
end type
dim shared as t_material material
sub setMaterial( a as long , m as t_material )
  glMaterialfv a , GL_AMBIENT , @m.ambient.x
  glMaterialfv a , GL_DIFFUSE , @m.diffuse.x
  glMaterialfv a , GL_SPECULAR , @m.specular.x
  glMaterialfv a , GL_EMISSION , @m.emision.x
  glMaterialf a , GL_SHININESS , m.shininess
end sub


''create matrix type to hold position & orentation
type matrix
  dim as double m( 3 , 3 )
end type
''create multyplycation operator for matrix
operator * ( a as matrix , b as matrix ) as matrix
  dim as integer i , j , k
  dim uit as matrix
  for i = 0 to 3
    for j = 0 to 3
''      uit.m( i , j ) = 0
      for k = 0 to 3
''        uit.m( i , j ) += a.m( i , k ) * b.m( k , j )
        uit.m( j , k ) += a.m( j , i ) * b.m( i , k )
      next k
    next j
  next i
  return uit
end operator
''create array of matrix's
dim shared as matrix v( 20 )
''create unity matrix
v( 0 ).m( 0 , 0 ) = 1
v( 0 ).m( 1 , 1 ) = 1
v( 0 ).m( 2 , 2 ) = 1
v( 0 ).m( 3 , 3 ) = 1
''create some stuf for 3D engine
declare sub link( no as integer , x as double , y as double , z as double _
, pan as double , tilt as double , rol as double , ax as integer , p as integer )
declare sub ido( no as integer , x as double , y as double , z as double _
, lim as integer , ax as integer , p as integer )
declare sub spot( byref x as double , byref y as double , byref z as double )
dim shared as integer nowmatrix

Sub link( no As Integer, x As double, y As double, z As double, pan As double, tilt As double, rol As double, ax As Integer, p As Integer )
''set curent matrix wil afect folowing drawing comands
   If no < 1 Or no > 20 Then Exit Sub
   If p < 0 Or p > 20 Then Exit Sub
   If p = no Then Exit Sub
   ''create some lokal matrix's and fill them
   Dim As matrix mp, rotx, roty, rotz, translate
   mp = v( p )
   rotx = v( 0 )
   roty = v( 0 )
   rotz = v( 0 )
   translate = v( 0 )
   rotz.m( 0, 0 ) = Cos( rad( rol ))
   rotz.m( 0, 1 ) = -Sin( rad( rol ))
   rotz.m( 1, 0 ) = Sin( rad( rol ))
   rotz.m( 1, 1 ) = Cos( rad( rol ))
   roty.m( 0, 0 ) = Cos( rad( pan ))
   roty.m( 0, 2 ) = -Sin( rad( pan ))
   roty.m( 2, 0 ) = Sin( rad( pan ))
   roty.m( 2, 2 ) = Cos( rad( pan ))
   rotx.m( 1, 1 ) = Cos( rad( tilt ))
   rotx.m( 1, 2 ) = -Sin( rad( tilt ))
   rotx.m( 2, 1 ) = Sin( rad( tilt ))
   rotx.m( 2, 2 ) = Cos( rad( tilt ))
   translate.m( 3, 0 ) = x
   translate.m( 3, 1 ) = y
   translate.m( 3, 2 ) = z
   ''angles can permutate 6 ways
   Select Case ax
      Case xyz
         v( no ) = rotx * roty * rotz * translate * mp
      Case xzy
         v( no ) = rotx * rotz * roty * translate * mp
      Case yxz
         v( no ) = roty * rotx * rotz * translate * mp
      Case yzx
         v( no ) = roty * rotz * rotx * translate * mp
      Case zxy
         v( no ) = rotz * rotx * roty * translate * mp
      Case zyx
         v( no ) = rotz * roty * rotx * translate * mp
      Case Else
   End Select
   nowmatrix = no
End Sub
sub ido( no as integer , x as double , y as double , z as double _
, lim as integer , ax as integer , p as integer )
''set curent matrix for lim of animated avatar
''wil efect folowing drawings
  if lim < 0 or lim > 64 then exit sub
  link no , x , y , z , sk( lim ).y , sk( lim ).x , sk( lim ).z, ax , p
end sub
sub spot( byref x as double , byref y as double , byref z as double )
''calulate world coordinates from lokal coordinates
''using curent matrix
  dim as double hx , hy , hz
  dim as integer i
  ''use curent matrix
  i = nowmatrix
  hx = x * v( i ).m( 0 , 0 ) + y * v( i ).m( 1 , 0 ) _
  + z * v( i ).m( 2 , 0 ) + v( i ).m( 3 , 0 )
  hy = x * v( i ).m( 0 , 1 ) + y * v( i ).m( 1 , 1 ) _
  + z * v( i ).m( 2 , 1 ) + v( i ).m( 3 , 1 )
  hz = x * v( i ).m( 0 , 2 ) + y * v( i ).m( 1 , 2 ) _
  + z * v( i ).m( 2 , 2 ) + v( i ).m( 3 , 2 )
  x = hx
  y = hy
  z = hz
end sub

dim shared as dbl3d pnt( 255 ) ''points for the swarm

sub setpunt( no as integer , x as double , y as double , z as double )
'' set a point in the swarm
  spot x , y , z
  pnt( no ) = dbl3d( x , y , z )
end sub

sub setpoint( no as integer , x as double , y as double , z as double )
  if no < 0 or no > ubound( pnt ) then exit sub
  pnt( no ) = dbl3d( x , y , z )
end sub


sub tri( p1 as integer , p2 as integer , p3 as integer )
  if p1 < 0 or p1 > 255 then exit sub
  if p2 < 0 or p2 > 255 then exit sub
  if p3 < 0 or p3 > 255 then exit sub
  dim as dbl3d n = ( pnt( p2 ) - pnt( p1 ) ) _
               \ ( pnt( p3 ) - pnt( p1 ) )
  n.normalize()
  glbegin gl_triangles
    glnormal3d n.x , n.y , n.z
    glvertex3d pnt( p1 ).x , pnt( p1 ).y , pnt( p1 ).z
    glvertex3d pnt( p2 ).x , pnt( p2 ).y , pnt( p2 ).z
    glvertex3d pnt( p3 ).x , pnt( p3 ).y , pnt( p3 ).z
  glend
end sub

sub quad( p1 as integer , p2 as integer , p3 as integer , p4 as integer )
  if p1 < 0 or p1 > 255 then exit sub
  if p2 < 0 or p2 > 255 then exit sub
  if p3 < 0 or p3 > 255 then exit sub
  if p4 < 0 or p4 > 255 then exit sub
  dim as dbl3d n = ( pnt( p2 ) - pnt( p1 ) ) _
               \ ( pnt( p3 ) - pnt( p1 ) )
  n.normalize()
  glbegin gl_quads
    glnormal3d n.x , n.y , n.z
    glvertex3d pnt( p1 ).x , pnt( p1 ).y , pnt( p1 ).z
    glvertex3d pnt( p2 ).x , pnt( p2 ).y , pnt( p2 ).z
    glvertex3d pnt( p3 ).x , pnt( p3 ).y , pnt( p3 ).z
    glvertex3d pnt( p4 ).x , pnt( p4 ).y , pnt( p4 ).z
  glend
end sub

dim shared as double box( 5 )
sub setbox( x as double , y as double , z as double , dx as double , dy as double , dz as double )
'' set bounding box middle and size
  box(0)=x
  box(1)=y
  box(2)=z
  box(3)=dx
  box(4)=dy
  box(5)=dz
end sub


sub cube( kl as sng4d )
'' example mesh
  material.diffuse = kl
  material.ambient = kl
  setmaterial gl_front , material
'' first fil swarm
  setpoint 0 ,box(0)+box(3),box(1)+box(4),box(2)+box(5)
  setpoint 1 ,box(0)+box(3),box(1)+box(4),box(2)-box(5)
  setpoint 2 ,box(0)+box(3),box(1)-box(4),box(2)+box(5)
  setpoint 3 ,box(0)+box(3),box(1)-box(4),box(2)-box(5)
  setpoint 4 ,box(0)-box(3),box(1)+box(4),box(2)+box(5)
  setpoint 5 ,box(0)-box(3),box(1)+box(4),box(2)-box(5)
  setpoint 6 ,box(0)-box(3),box(1)-box(4),box(2)+box(5)
  setpoint 7 ,box(0)-box(3),box(1)-box(4),box(2)-box(5)

'' use swarm points for polygons for mesh
  quad 0,1,3,2
  quad 7,6,4,5
  quad 0,1,5,4
  quad 7,6,2,3
  quad 0,2,6,4
  quad 7,5,1,3
 
end sub

sub cilinder( sides as integer , dx as double , dy as double , top as integer , bot as integer )
  dim f as double
  if sides < 3 then sides = 3
  if sides > 64 then sides = 64
  for f = 0 to sides + 2
    setpoint f , box(0) + sin( f * pi * 2 / sides ) * box(3) _
               , box(1) - box(4) _
               , box(2) + cos( f * pi * 2 / sides ) * box(5)
    setpoint f + sides + 1 , box(0) + sin( f * pi * 2 / sides ) * dx _
                           , box(1) + box(4) _
                           , box(2) + cos( f * pi * 2 / sides ) * dy
  next f
  for f = 0 to sides + 1
    quad f , f + 1 , f + 2 + sides , f + 1 + sides
  next f
  if top then
    setpoint 255 , 0 , box(1) + box(4) , 0
    for f = 0 to sides
        setpoint f , box(0) + sin( f * pi * 2 / sides ) * dx _
               , box(1) + box(4) _
               , box(2) + cos( f * pi * 2 / sides ) * dy 
    next f
    for f = 0 to sides
      tri 255 , f , f + 1
    next f
  end if
  if bot then
    setpoint 255 , 0 , box(1) - box(4) , 0
    for f = 0 to sides + 2
        setpoint f , box(0) - sin( f * pi * 2 / sides ) * box(3) _
               , box(1) - box(4) _
               , box(2) + cos( f * pi * 2 / sides ) * box(5) 
    next f
    for f = 0 to sides + 2
      tri 255 , f , f + 1
    next f
  end if
end sub

sub flex( sides as integer , m as integer , lim as integer , p as integer , kl as sng4d )
  dim as integer i
  dim as double x , y , z
  for i = 0 to sides
    x = box(0) + sin( i * pi * 2 / sides ) * box(3)
    y = box(1) + box(4)
    z = box(2) + cos( i * pi * 2 / sides ) * box(5)
    setpunt i , x , y , z
  next i
  ido m , 0,0,0 , lim , xyz , p
  for i = 0 to sides
    x = box(0) + sin( i * pi * 2 / sides ) * box(3)
    y = box(1) - box(4)
    z = box(2) + cos( i * pi * 2 / sides ) * box(5)
    setpunt i + sides + 1 , x , y , z
  next i
  material.diffuse = kl
  material.ambient = kl
  setmaterial gl_front , material
  for i = 0 to sides - 1
    quad i , i + sides + 1 , i + sides + 2 , i + 1
  next
end sub

sub flex2( sides as integer , m as integer , lim as integer , p as integer , kl as sng4d )
  dim as integer i
  dim as double x , y , z
  for i = 0 to sides
    pnt(i) = pnt(i+sides+1)
  next i
  ido m , 0,-box(4),0 , lim , xyz , p
  for i = 0 to sides
    x = box(0) + sin( i * pi * 2 / sides ) * box(3)
    y = box(1) - box(4)
    z = box(2) + cos( i * pi * 2 / sides ) * box(5)
    setpunt i + sides + 1 , x , y , z
  next i
  material.diffuse = kl
  material.ambient = kl
  setmaterial gl_front , material
  for i = 0 to sides - 1
    quad i , i + sides + 1 , i + sides + 2 , i + 1
  next
end sub

const as integer rightno = 32
const as integer leftno = 0
const as integer darm = 31
const as integer delbow = 30
const as integer dwrist = 29
const as integer dleg = 28
const as integer dknee = 27
const as integer denkle = 26
const as integer dhead = 25
const as integer deye = 24

sub dino( sides as integer , kl as sng4d )
  dim as integer i
  material.diffuse = kl
  material.ambient = kl
  setmaterial gl_front_and_back , material
  glpushmatrix
    glrotated 90 , 1,0,0
    setbox 0,0,0 , 1,1,1
    cilinder sides , 1,1 , 0,0
    setbox 0,1.5,0 , 1,.5,1
    cilinder sides , .8,.8 , 0,0
    setbox 0,3.5,0 , .6,.5,.6
    flex2 sides , 1 , leftno , 0 , kl
    setbox 0,4.5,0 , .4,.5,.4
    flex2 sides , 2 , leftno + 1 , 1 , kl
    setbox 0,5.5,0 , .2,.5,.2
    flex2 sides , 3 , leftno + 2 , 2 , kl
    setbox 0,6.5,0 , .01,.5,.01
    flex2 sides , 4 , leftno + 3 , 3 , kl
  glpopmatrix
end sub
camara.z = 10
sub test2
  dim as double angle
  dim as integer fast = 1 , i ''whit fast you can troggle the speed of drawing
  do
    glclear gl_color_buffer_bit or gl_depth_buffer_bit
    camara.use
    glrotated angle/10 , 0,1,0
    for i = 0 to 3
      skelet leftno + i , 0,0,pend(angle*3-45*i,10)
    next i
    dino 6 , white
    angle += 1
    flip
    sleep 40
  loop while inkey = ""
end sub

test2



Last edited by bluatigro on Feb 24, 2020 11:44, edited 1 time in total.
dafhi
Posts: 1324
Joined: Jun 04, 2005 9:51

Re: triangle world try

Postby dafhi » Feb 23, 2020 20:43

hahaha .. that's great. It's interesting what people build once they have the tools.

[edit] I thought your previous demo looked a bit "off" but now I understand
bluatigro
Posts: 621
Joined: Apr 25, 2012 10:35
Location: netherlands

Re: triangle world try

Postby bluatigro » Feb 24, 2020 13:13

update :
dino has neck and legs

error :
knee's do not flex

Code: Select all

'' BLUATIGRO 24 feb 2020
'' walking whit dinosaurs try

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


const as double PI = atn( 1 ) * 4
const as double GOLDEN_RATIO = ( sqr( 5 ) - 1 ) / 2


type dbl3d
  x as double
  y as double
  z as double
  declare constructor()
  declare constructor ( x as double , y as double, z as double )
  declare sub fill( x as double , y as double , z as double )
  declare sub normalize
end type
constructor dbl3d()
  this.x = 0
  this.y = 0
  this.z = 0
end constructor
constructor dbl3d( x as double , y as double , z as double )
  this.x = x
  this.y = y
  this.z = z
end constructor
operator +( a as dbl3d , b as dbl3d ) as dbl3d
  return type( a.x + b.x , a.y + b.y , a.z + b.z )
end operator
operator *( a as dbl3d , d as double ) as dbl3d
  return type( a.x * d , a.y * d , a.z * d )
end operator
operator \( a as dbl3d , b as dbl3d ) as dbl3d
  return type( a.y * b.z - a.z * b.y _
             , a.z * b.x - a.x * b.z _
             , a.x * b.y - a.y * b.x )
end operator
operator -( a as dbl3d , b as dbl3d ) as dbl3d
  return type( a.x - b.x , a.y - b.y , a.z - b.z )
end operator
operator /( a as dbl3d , d as double ) as dbl3d
  return type( a.x / d , a.y / d , a.z / d )
end operator
sub dbl3d.fill( x as double , y as double , z as double )
  this.x = x
  this.y = y
  this.z = z
end sub
declare function dot( a as dbl3d , b as dbl3d ) as double
function dot( a as dbl3d , b as dbl3d ) as double
  return a.x * b.x + a.y * b.y + a.z * b.z
end function
declare function length( q as dbl3d ) as double
function length( q as dbl3d ) as double
   return sqr( q.x * q.x + q.y * q.y + q.z * q.z ) + 1e-7
end function 
declare function anlge( a as dbl3d , b as dbl3d ) as double
function getangle( a as dbl3d , b as dbl3d ) as double
  return acos( dot( a , b ) _
  / ( length( a ) * length( b ) ) )
end function
sub dbl3d.normalize
  this /= length( this )
end sub


function rad( x as double ) as double
''help function degrees to radians
  return x * PI / 180
end function

function degrees( x as double ) as double
  return x * 180 / PI
end function

function range( l as double , h as double ) as double
  return rnd * ( h - l ) + l
end function

sub rotate( byref k as double , byref l as double , deg as double )
  dim as double s , c , hk , hl
  s = sin( rad( deg ) )
  c = cos( rad( deg ) )
  hk = k * c - l * s
  hl = k * s + l * c
  k = hk
  l = hl
end sub

''CAMARA

type t_camara
public :
  dim as double x,y,z,pan,tilt
  declare sub move( dx as double _
  , dy as double , dz as double , dpan as double )
  declare sub use()
end type
sub t_camara.move( dx as double _
  , dy as double , dz as double , dpan as double )
  rotate dx , dz , -pan
  x += dx
  y += dy
  z += dz
  pan += dpan
end sub
sub t_camara.use
  glLoadIdentity
  glRotated -tilt , 0 , 0 , 1
  glRotated -pan , 0 , 1 , 0
  glTranslated -x , -y , -z
end sub

dim shared as t_camara camara

''3DENGINE

declare sub child( x as double , y as double , z as double , ax as integer , lim as integer )
declare function pend( fase as double , amp as double ) as double
declare sub skelet( no as integer , x as double , y as double , z as double )

dim shared as dbl3d sk( 64 )


const as integer xyz = 0
const as integer xzy = 1
const as integer yxz = 2
const as integer yzx = 3
const as integer zxy = 4
const as integer zyx = 5

sub child( x as double , y as double , z as double , lim as integer , ax as integer )
  glTranslatef x , y , z
  select case ax
    case xyz
      glrotated sk( lim ).x , 1 , 0 , 0
      glrotated sk( lim ).y , 0 , 1 , 0
      glrotated sk( lim ).z , 0 , 0 , 1
    case xzy
      glrotated sk( lim ).x , 1 , 0 , 0
      glrotated sk( lim ).z , 0 , 0 , 1
      glrotated sk( lim ).y , 0 , 1 , 0
    case yxz
      glrotated sk( lim ).y , 0 , 1 , 0
      glrotated sk( lim ).x , 1 , 0 , 0
      glrotated sk( lim ).z , 0 , 0 , 1
    case yzx
      glrotated sk( lim ).y , 0 , 1 , 0
      glrotated sk( lim ).z , 0 , 0 , 1
      glrotated sk( lim ).x , 1 , 0 , 0
    case zxy
      glrotated sk( lim ).z , 0 , 0 , 1
      glrotated sk( lim ).x , 1 , 0 , 0
      glrotated sk( lim ).y , 0 , 1 , 0
    case zyx
      glrotated sk( lim ).z , 0 , 0 , 1
      glrotated sk( lim ).y , 0 , 1 , 0
      glrotated sk( lim ).x , 1 , 0 , 0
    case else
  end select 
end sub

function pend( fase as double , amp as double ) as double
  return sin( fase * PI / 180 ) * amp
end function

sub skelet( lim as integer , x as double , y as double , z as double )
  sk( lim and 63 ) = dbl3d( x , y , z )
end sub

#include "fbgfx.bi"
#if __FB_LANG__ = "fb"
  Using FB
#endif
SCREEN 20 , 32 , , 2

DIM shared AS INTEGER winx , winy
SCREENINFO winx , winy
''SCREENRES winx , winy , 32 , 2 , FB.GFX_FULLSCREEN

'' ReSizeGLScene
glViewport 0, 0, winx , winy                      '' Reset The Current Viewport
glMatrixMode GL_PROJECTION                     '' Select The Projection Matrix
glLoadIdentity                                 '' Reset The Projection Matrix
gluPerspective 45.0, csng(winx/winy), 0.1, 100.0   '' Calculate The Aspect Ratio Of The Window
glMatrixMode GL_MODELVIEW                      '' Select The Modelview Matrix
glLoadIdentity                                 '' Reset The Modelview Matrix
   
'' All Setup For OpenGL Goes Here
glShadeModel GL_SMOOTH                         '' Enable Smooth Shading
glClearColor 0.0, 0.0, 0.0, 1.0                '' Black Background
glClearDepth 1.0                               '' Depth Buffer Setup
glEnable GL_DEPTH_TEST                         '' Enables Depth Testing
glDepthFunc GL_LEQUAL                          '' The Type Of Depth Testing To Do
glHint GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST    '' Really Nice Perspective Calculations

glEnable( gl_lighting )
dim as single lightpos( 3 ) = { -50 , 50 , 50 , 1 }
dim as single diffuse( 3 ) = { 1 , 1 , 1 , 1 }
glLightfv( gl_light0 , gl_position, @lightpos(0) )
glLightfv( gl_light0 , gl_diffuse , @diffuse(0) )
glEnable( gl_light0 )

''COLORS

type sng4d
  dim as single x , y , z , w
  declare constructor ()
  declare constructor ( nx as single , ny as single , nz as single , nw as single )
  declare sub fill( nx as single , ny as single , nz as single , nw as single )
end type
constructor sng4d()
end constructor
constructor sng4d( nx as single , ny as single , nz as single , nw as single )
  x = nx
  y = ny
  z = nz
  w = nw
end constructor
operator + ( a as sng4d , b as sng4d ) as sng4d
  return sng4d(a.x+b.x,a.y+b.y,a.z+b.z,1)
end operator
operator - ( a as sng4d , b as sng4d ) as sng4d
  return sng4d(a.x-b.x,a.y-b.y,a.z-b.z,1)
end operator
operator / ( a as sng4d , b as single ) as sng4d
  return sng4d(a.x/b,a.y/b,a.z/b,1)
end operator
operator * ( a as sng4d , b as single ) as sng4d
  return sng4d(a.x*b,a.y*b,a.z*b,1)
end operator
function rainbow( deg as double ) as sng4d
  return sng4d( sin( rad( deg ) ) / 2 + .5 _
              , sin( rad( deg - 120 ) ) / 2 + .5 _
              , sin( rad( deg + 120 ) ) / 2 + .5 , 1 )
end function
sub sng4d.fill( nx as single , ny as single , nz as single , nw as single )
  x = nx
  y = ny
  z = nz
  w = nw
end sub

dim shared as sng4d black , red , green , yellow _
, blue , magenta , cyan , white _
, orange , gray , pink
black.fill   0,0,0,1
red.fill     1,0,0,1
green.fill   0,1,0,1
yellow.fill  1,1,0,1
blue.fill    0,0,1,1
magenta.fill 1,0,1,1
cyan.fill    0,1,1,1
white.fill   1,1,1,1

orange.fill   1,.5, 0,1
gray.fill    .5,.5,.5,1
pink.fill     1,.5,.5,1

function mix( a as sng4d , f as double , b as sng4d ) as sng4d
  dim uit as sng4d
  uit.x = a.x + ( b.x - a.x ) * f
  uit.y = a.y + ( b.y - a.y ) * f
  uit.z = a.z + ( b.z - a.z ) * f
  uit.w = 1
  return uit
end function

''MATERIAL

type t_material
  dim as sng4d ambient , diffuse , specular , emision
  dim as single shininess
end type
dim shared as t_material material
sub setMaterial( a as long , m as t_material )
  glMaterialfv a , GL_AMBIENT , @m.ambient.x
  glMaterialfv a , GL_DIFFUSE , @m.diffuse.x
  glMaterialfv a , GL_SPECULAR , @m.specular.x
  glMaterialfv a , GL_EMISSION , @m.emision.x
  glMaterialf a , GL_SHININESS , m.shininess
end sub


''create matrix type to hold position & orentation
type matrix
  dim as double m( 3 , 3 )
end type
''create multyplycation operator for matrix
operator * ( a as matrix , b as matrix ) as matrix
  dim as integer i , j , k
  dim uit as matrix
  for i = 0 to 3
    for j = 0 to 3
''      uit.m( i , j ) = 0
      for k = 0 to 3
''        uit.m( i , j ) += a.m( i , k ) * b.m( k , j )
        uit.m( j , k ) += a.m( j , i ) * b.m( i , k )
      next k
    next j
  next i
  return uit
end operator
''create array of matrix's
dim shared as matrix v( 20 )
''create unity matrix
v( 0 ).m( 0 , 0 ) = 1
v( 0 ).m( 1 , 1 ) = 1
v( 0 ).m( 2 , 2 ) = 1
v( 0 ).m( 3 , 3 ) = 1
''create some stuf for 3D engine
declare sub link( no as integer , x as double , y as double , z as double _
, pan as double , tilt as double , rol as double , ax as integer , p as integer )
declare sub ido( no as integer , x as double , y as double , z as double _
, lim as integer , ax as integer , p as integer )
declare sub spot( byref x as double , byref y as double , byref z as double )
dim shared as integer nowmatrix

Sub link( no As Integer, x As double, y As double, z As double, pan As double, tilt As double, rol As double, ax As Integer, p As Integer )
''set curent matrix wil afect folowing drawing comands
   If no < 1 Or no > 20 Then Exit Sub
   If p < 0 Or p > 20 Then Exit Sub
   If p = no Then Exit Sub
   ''create some lokal matrix's and fill them
   Dim As matrix mp, rotx, roty, rotz, translate
   mp = v( p )
   rotx = v( 0 )
   roty = v( 0 )
   rotz = v( 0 )
   translate = v( 0 )
   rotz.m( 0, 0 ) = Cos( rad( rol ))
   rotz.m( 0, 1 ) = -Sin( rad( rol ))
   rotz.m( 1, 0 ) = Sin( rad( rol ))
   rotz.m( 1, 1 ) = Cos( rad( rol ))
   roty.m( 0, 0 ) = Cos( rad( pan ))
   roty.m( 0, 2 ) = -Sin( rad( pan ))
   roty.m( 2, 0 ) = Sin( rad( pan ))
   roty.m( 2, 2 ) = Cos( rad( pan ))
   rotx.m( 1, 1 ) = Cos( rad( tilt ))
   rotx.m( 1, 2 ) = -Sin( rad( tilt ))
   rotx.m( 2, 1 ) = Sin( rad( tilt ))
   rotx.m( 2, 2 ) = Cos( rad( tilt ))
   translate.m( 3, 0 ) = x
   translate.m( 3, 1 ) = y
   translate.m( 3, 2 ) = z
   ''angles can permutate 6 ways
   Select Case ax
      Case xyz
         v( no ) = rotx * roty * rotz * translate * mp
      Case xzy
         v( no ) = rotx * rotz * roty * translate * mp
      Case yxz
         v( no ) = roty * rotx * rotz * translate * mp
      Case yzx
         v( no ) = roty * rotz * rotx * translate * mp
      Case zxy
         v( no ) = rotz * rotx * roty * translate * mp
      Case zyx
         v( no ) = rotz * roty * rotx * translate * mp
      Case Else
   End Select
   nowmatrix = no
End Sub
sub ido( no as integer , x as double , y as double , z as double _
, lim as integer , ax as integer , p as integer )
''set curent matrix for lim of animated avatar
''wil efect folowing drawings
  if lim < 0 or lim > 64 then exit sub
  link no , x , y , z , sk( lim ).y , sk( lim ).x , sk( lim ).z, ax , p
end sub
sub spot( byref x as double , byref y as double , byref z as double )
''calulate world coordinates from lokal coordinates
''using curent matrix
  dim as double hx , hy , hz
  dim as integer i
  ''use curent matrix
  i = nowmatrix
  hx = x * v( i ).m( 0 , 0 ) + y * v( i ).m( 1 , 0 ) _
  + z * v( i ).m( 2 , 0 ) + v( i ).m( 3 , 0 )
  hy = x * v( i ).m( 0 , 1 ) + y * v( i ).m( 1 , 1 ) _
  + z * v( i ).m( 2 , 1 ) + v( i ).m( 3 , 1 )
  hz = x * v( i ).m( 0 , 2 ) + y * v( i ).m( 1 , 2 ) _
  + z * v( i ).m( 2 , 2 ) + v( i ).m( 3 , 2 )
  x = hx
  y = hy
  z = hz
end sub

dim shared as dbl3d pnt( 255 ) ''points for the swarm

sub setpunt( no as integer , x as double , y as double , z as double )
'' set a point in the swarm
  spot x , y , z
  pnt( no ) = dbl3d( x , y , z )
end sub

sub setpoint( no as integer , x as double , y as double , z as double )
  if no < 0 or no > ubound( pnt ) then exit sub
  pnt( no ) = dbl3d( x , y , z )
end sub


sub tri( p1 as integer , p2 as integer , p3 as integer )
  if p1 < 0 or p1 > 255 then exit sub
  if p2 < 0 or p2 > 255 then exit sub
  if p3 < 0 or p3 > 255 then exit sub
  dim as dbl3d n = ( pnt( p2 ) - pnt( p1 ) ) _
               \ ( pnt( p3 ) - pnt( p1 ) )
  n.normalize()
  glbegin gl_triangles
    glnormal3d n.x , n.y , n.z
    glvertex3d pnt( p1 ).x , pnt( p1 ).y , pnt( p1 ).z
    glvertex3d pnt( p2 ).x , pnt( p2 ).y , pnt( p2 ).z
    glvertex3d pnt( p3 ).x , pnt( p3 ).y , pnt( p3 ).z
  glend
end sub

sub quad( p1 as integer , p2 as integer , p3 as integer , p4 as integer )
  if p1 < 0 or p1 > 255 then exit sub
  if p2 < 0 or p2 > 255 then exit sub
  if p3 < 0 or p3 > 255 then exit sub
  if p4 < 0 or p4 > 255 then exit sub
  dim as dbl3d n = ( pnt( p2 ) - pnt( p1 ) ) _
               \ ( pnt( p3 ) - pnt( p1 ) )
  n.normalize()
  glbegin gl_quads
    glnormal3d n.x , n.y , n.z
    glvertex3d pnt( p1 ).x , pnt( p1 ).y , pnt( p1 ).z
    glvertex3d pnt( p2 ).x , pnt( p2 ).y , pnt( p2 ).z
    glvertex3d pnt( p3 ).x , pnt( p3 ).y , pnt( p3 ).z
    glvertex3d pnt( p4 ).x , pnt( p4 ).y , pnt( p4 ).z
  glend
end sub

dim shared as double box( 5 )
sub setbox( x as double , y as double , z as double , dx as double , dy as double , dz as double )
'' set bounding box middle and size
  box(0)=x
  box(1)=y
  box(2)=z
  box(3)=dx
  box(4)=dy
  box(5)=dz
end sub


sub cube( kl as sng4d )
'' example mesh
  material.diffuse = kl
  material.ambient = kl
  setmaterial gl_front , material
'' first fil swarm
  setpoint 0 ,box(0)+box(3),box(1)+box(4),box(2)+box(5)
  setpoint 1 ,box(0)+box(3),box(1)+box(4),box(2)-box(5)
  setpoint 2 ,box(0)+box(3),box(1)-box(4),box(2)+box(5)
  setpoint 3 ,box(0)+box(3),box(1)-box(4),box(2)-box(5)
  setpoint 4 ,box(0)-box(3),box(1)+box(4),box(2)+box(5)
  setpoint 5 ,box(0)-box(3),box(1)+box(4),box(2)-box(5)
  setpoint 6 ,box(0)-box(3),box(1)-box(4),box(2)+box(5)
  setpoint 7 ,box(0)-box(3),box(1)-box(4),box(2)-box(5)

'' use swarm points for polygons for mesh
  quad 0,1,3,2
  quad 7,6,4,5
  quad 0,1,5,4
  quad 7,6,2,3
  quad 0,2,6,4
  quad 7,5,1,3
 
end sub

sub cilinder( sides as integer , dx as double , dy as double , top as integer , bot as integer )
  dim f as double
  if sides < 3 then sides = 3
  if sides > 64 then sides = 64
  for f = 0 to sides + 2
    setpunt f , box(0) + sin( f * pi * 2 / sides ) * box(3) _
               , box(1) - box(4) _
               , box(2) + cos( f * pi * 2 / sides ) * box(5)
    setpunt f + sides + 1 , box(0) + sin( f * pi * 2 / sides ) * dx _
                           , box(1) + box(4) _
                           , box(2) + cos( f * pi * 2 / sides ) * dy
  next f
  for f = 0 to sides + 1
    quad f , f + 1 , f + 2 + sides , f + 1 + sides
  next f
  if top then
    setpunt 255 , 0 , box(1) + box(4) , 0
    for f = 0 to sides
        setpunt f , box(0) + sin( f * pi * 2 / sides ) * dx _
               , box(1) + box(4) _
               , box(2) + cos( f * pi * 2 / sides ) * dy 
    next f
    for f = 0 to sides
      tri 255 , f , f + 1
    next f
  end if
  if bot then
    setpunt 255 , 0 , box(1) - box(4) , 0
    for f = 0 to sides + 2
        setpunt f , box(0) - sin( f * pi * 2 / sides ) * box(3) _
               , box(1) - box(4) _
               , box(2) + cos( f * pi * 2 / sides ) * box(5) 
    next f
    for f = 0 to sides + 2
      tri 255 , f , f + 1
    next f
  end if
end sub

sub flex( sides as integer , m as integer , lim as integer , p as integer , kl as sng4d )
  dim as integer i
  dim as double x , y , z
  for i = 0 to sides
    x = box(0) + sin( i * pi * 2 / sides ) * box(3)
    y = box(1) + box(4)
    z = box(2) + cos( i * pi * 2 / sides ) * box(5)
    setpunt i , x , y , z
  next i
  ido m , 0,0,0 , lim , xyz , p
  for i = 0 to sides
    x = box(0) + sin( i * pi * 2 / sides ) * box(3)
    y = box(1) - box(4)
    z = box(2) + cos( i * pi * 2 / sides ) * box(5)
    setpunt i + sides + 1 , x , y , z
  next i
  material.diffuse = kl
  material.ambient = kl
  setmaterial gl_front , material
  for i = 0 to sides - 1
    quad i , i + sides + 1 , i + sides + 2 , i + 1
  next
end sub

sub flex2( sides as integer , m as integer , lim as integer , p as integer , kl as sng4d )
  dim as integer i
  dim as double x , y , z
  for i = 0 to sides
    pnt(i) = pnt(i+sides+1)
  next i
  ido m , 0,-box(4),0 , lim , xyz , p
  for i = 0 to sides
    x = box(0) + sin( i * pi * 2 / sides ) * box(3)
    y = box(1) - box(4)
    z = box(2) + cos( i * pi * 2 / sides ) * box(5)
    setpunt i + sides + 1 , x , y , z
  next i
  material.diffuse = kl
  material.ambient = kl
  setmaterial gl_front , material
  for i = 0 to sides - 1
    quad i , i + 1 , i + sides + 2 , i + sides + 1
  next
end sub

const as integer rightno = 32
const as integer leftno = 0
const as integer darm = 31
const as integer delbow = 30
const as integer dwrist = 29
const as integer dleg = 28
const as integer dknee = 27
const as integer denkle = 26
const as integer dhead = 25
const as integer deye = 24

sub dino( sides as integer , kl as sng4d )
  dim as integer i
  material.diffuse = kl
  material.ambient = kl
  setmaterial gl_front_and_back , material
    link 2 , 0,0,0 , 0,90,0 , xyz , 1
    setbox 0,0,0 , 1,1,1
    cilinder sides , 1,1 , 0,0
    setbox 0,1.5,0 , 1,.5,1
    cilinder sides , .8,.8 , 0,0
    setbox 0,3.5,0 , .6,.5,.6
    flex2 sides , 3 , leftno , 2 , kl
    setbox 0,4.5,0 , .4,.5,.4
    flex2 sides , 4 , leftno + 1 , 3 , kl
    setbox 0,5.5,0 , .2,.5,.2
    flex2 sides , 5 , leftno + 2 , 4 , kl
    setbox 0,6.5,0 , .01,.5,.01
    flex2 sides , 6 , leftno + 3 , 5 , kl
    link 3 , 0,.5,0 , 0,180,0 , xyz , 2
    setbox 0,2,0 , 1,.5,1
    cilinder sides , .8,.8 , 0,0
    setbox 0,4,0 , .6,.5,.6
    flex2 sides , 4 , rightno , 3 , kl
    setbox 0,6,0 , .4,.5,.4
    flex2 sides , 5 , rightno + 1 , 4 , kl
    setbox 0,8,0 , .2,.5,.2
    flex2 sides , 6 , rightno + 2 , 5 , kl
    setbox 0,10,0 , .5,1,.5
    cube kl
    link 3 , .5,-1,-.5 , 0,90,0 , xyz , 2
    setbox 0,0,0 , .5,.5,.5
    flex sides , 4 , dleg + leftno , 3 , kl
    setbox 0,2,0 , .5,.5,.5
    flex2 sides , 5 , dknee + leftno , 4 , kl
    setbox 0,4,0 , .5,.5,.5
    flex2 sides , 6 , denkle + leftno , 5 , kl
    link 3 , .5,1,-.5 , 0,90,0 , xyz , 2
    setbox 0,0,0 , .5,.5,.5
    flex sides , 4 , darm + leftno , 3 , kl
    setbox 0,2,0 , .5,.5,.5
    flex2 sides , 5 , delbow + leftno , 4 , kl
    setbox 0,4,0 , .5,.5,.5
    flex2 sides , 6 , dwrist + leftno , 5 , kl
    link 3 , -.5,-1,-.5 , 0,90,0 , xyz , 2
    setbox 0,0,0 , .5,.5,.5
    flex sides , 4 , dleg + rightno , 3 , kl
    setbox 0,2,0 , .5,.5,.5
    flex2 sides , 5 , dknee + rightno , 4 , kl
    setbox 0,4,0 , .5,.5,.5
    flex2 sides , 6 , denkle + rightno , 5 , kl
    link 3 , -.5,1,-.5 , 0,90,0 , xyz , 2
    setbox 0,0,0 , .5,.5,.5
    flex sides , 4 , darm + rightno , 3 , kl
    setbox 0,2,0 , .5,.5,.5
    flex2 sides , 5 , delbow + rightno , 4 , kl
    setbox 0,4,0 , .5,.5,.5
    flex2 sides , 6 , dwrist + rightno , 5 , kl
end sub
camara.z = 10
sub test2
  dim as double angle
  dim as integer i
  do
    glclear gl_color_buffer_bit or gl_depth_buffer_bit
    camara.use
    for i = 0 to 3
      skelet leftno + i , 0,0,pend(angle*3-45*i,10)
    next i
    skelet rightno , 5,0,0
    skelet rightno + 1 , 0,0,0
    skelet rightno + 2 , -5,0,0
    skelet leftno + darm , pend(angle*3,10),0,0
    skelet leftno + delbow , pend(angle*3-90,10)-10,0,0
    skelet rightno + darm , pend(angle*3+180,10),0,0
    skelet rightno + delbow , pend(angle*3+90,10)-10,0,0
    skelet leftno + dleg , pend(angle*3,10),0,0
    skelet leftno + dknee , pend(angle*3-90,10)-10,0,0
    skelet rightno + dleg , pend(angle*3+180,10),0,0
    skelet rightno + dknee , pend(angle*3+90,10)-10,0,0
    link 1 , 0,0,0 , angle,0,0 , xyz , 0
    dino 12 , white
    angle += 1
    flip
    sleep 40
  loop while inkey = ""
end sub

test2





Return to “General”

Who is online

Users browsing this forum: No registered users and 1 guest