open gl

[bluatigro]

i m trying to create a OOP open gl lib

error :
i got a white screen

Code: Select all

''bluatigro 25 jan 2017
''opengl lib test
''rotating cube

#include "_OPEN-GL.bas"

dim as single hoek

do
  glClear GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT

  glLoadIdentity
  glTranslatef 0 , 0 , -5
  glRotatef hoek , 0 , 1 , 0
  
  material.diffuse = red
  setMaterial GL_FRONT_AND_BACK , material
  
  setbox 0,0,0 , 1,1,1
  cube
  
  hoek += 5
  sleep 40
  
loop until inkey = chr( 27 )
  

Code: Select all

''bluatigro 25 jan 2017
''opengl lib

#ifndef OPENGL_H
#define OPENGL_H

''VECTOR3D

type t3d
  x as single
  y as single
  z as single
  declare constructor()
  declare constructor ( x as single , y as single, z as single )
  declare sub fill( x as single , y as single , z as single )
  declare sub normalize
end type
constructor t3d()
  this.x = 0
  this.y = 0
  this.z = 0
end constructor 
constructor t3d( x as single , y as single , z as single )
  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 single ) 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 single ) as t3d
  return type( a.x / d , a.y / d , a.z / d )
end operator
sub t3d.fill( x as single , y as single , z as single )
  this.x = x
  this.y = y
  this.z = z
end sub
declare function dot( a as t3d , b as t3d ) as single
function dot( a as t3d , b as t3d ) as single
  return a.x * b.x + a.y * b.y + a.z * b.z
end function
declare function length( q as t3d ) as single
function length( q as t3d ) as single
   return sqr( q.x * q.x + q.y * q.y + q.z * q.z ) + 1e-7
end function  
declare function anlge( a as t3d , b as t3d ) as single
function getangle( a as t3d , b as t3d ) as single
  return acos( dot( a , b ) _
  / ( length( a ) * length( b ) ) )
end function
sub t3d.normalize
  this /= length( this )
end sub

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

const as single PI = csng( atn( 1 ) * 4 )

screen 20, 32, , 2

'' ReSizeGLScene
glViewport 0, 0, 1024 , 768                      '' Reset The Current Viewport
glMatrixMode GL_PROJECTION                     '' Select The Projection Matrix
glLoadIdentity                                 '' Reset The Projection Matrix
gluPerspective 45.0, 1024.0/768.0, 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, 0.5                '' 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 ) = { 0 , 50 , 0 , 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 t_4d
  dim as single x , y , z , w
  declare sub fill( nx as single , ny as single , nz as single , nw as single )
end type
sub t_4d.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 t_4d 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

''MATERIAL

type t_material
  dim as t_4d 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

''PRIMATIVS

dim shared as t3d pnt( 256 )

sub setpoint( no as integer , x as single , y as single , z as single )
  if no < 0 or no > 255 then exit sub
  pnt( no ).x = x
  pnt( no ).y = y
  pnt( no ).z = 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 t3d n = ( pnt( p2 ) - pnt( p1 ) ) _
               \ ( pnt( p3 ) - pnt( p1 ) )
  n.normalize()
  glbegin gl_triangles
    glnormal3f n.x , n.y , n.z
    glvertex3f pnt( p1 ).x , pnt( p1 ).y , pnt( p1 ).z
    glvertex3f pnt( p2 ).x , pnt( p2 ).y , pnt( p2 ).z
    glvertex3f 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 t3d zp = ( pnt( p1 ) + pnt( p2 ) _
  + pnt( p3 ) + pnt( p4 ) ) / 4
  dim as t3d n = ( pnt( p2 ) - zp ) _
               \ ( pnt( p3 ) - zp )
  n.normalize()
  glbegin gl_quads
    glnormal3f n.x , n.y , n.z
    glvertex3f pnt( p1 ).x , pnt( p1 ).y , pnt( p1 ).z
    glvertex3f pnt( p2 ).x , pnt( p2 ).y , pnt( p2 ).z
    glvertex3f pnt( p3 ).x , pnt( p3 ).y , pnt( p3 ).z
    glvertex3f pnt( p4 ).x , pnt( p4 ).y , pnt( p4 ).z
  glend 
end sub

''SHAPES

type Tbox
  m as t3d
  d as t3d
end type
dim shared box as Tbox

declare sub isoca( i as integer )
declare sub sphere( h as integer , r as integer _
, a as single , b as single )
declare sub torus( hsides as integer , rsides as integer )
declare sub cilinder( sides as integer _
, dx as single , dy as single , top as integer , bot as integer ) 
declare sub cube( )
declare sub hcube( )
declare sub setbox( mx as single , my as single _
, mz as single , dx as single , dy as single , dz as single )
declare sub geo( no as integer , p1 as integer _
, p2 as integer , p3 as integer )

sub geo( no as integer , p1 as integer _
, p2 as integer , p3 as integer )
  if no < 1 then 
    tri p1 , p2 , p3 
  else
  dim p12 as integer , p13 as integer , p23 as integer
    p12 = 255 - no * 3
    p13 = 255 - no * 3 - 1
    p23 = 255 - no * 3 - 2
    pnt( p12 ) = ( pnt( p1 ) + pnt( p2 ) ) / 2
    pnt( p13 ) = ( pnt( p1 ) + pnt( p3 ) ) / 2
    pnt( p23 ) = ( pnt( p2 ) + pnt( p3 ) ) / 2
    pnt( p12 ).normalize
    pnt( p13 ).normalize
    pnt( p23 ).normalize
    geo no - 1 , p1 , p12 , p13
    geo no - 1 , p2 , p23 , p12
    geo no - 1 , p3 , p13 , p23
    geo no - 1 , p12 , p23 , p13
  end if
end sub

sub isoca( i as integer )
  if i < 0 then i = 0
  if i > 5 then i = 5
  glPushMatrix
  glTranslatef box.m.x , box.m.y , box.m.z 
  glScalef box.d.x , box.d.y , box.d.z
    
  setpoint  1 ,  0       ,  0 , 1.118034
  setpoint  2 ,  1       ,  0         ,  .5 
  setpoint  3 ,  .309017 ,  .95105654 ,  .5 
  setpoint  4 , -.809017 ,  .58778524 ,  .5 
  setpoint  5 , -.809017 , -.58778524 ,  .5 
  setpoint  6 ,  .309017 , -.95105654 ,  .5 
  setpoint  7 ,  .809017 ,  .58778524 , -.5 
  setpoint  8 , -.309017 ,  .95105654 , -.5 
  setpoint  9 , -1       ,  0         , -.5 
  setpoint 10 , -.309017 , -.95105654 , -.5
  setpoint 11 ,  .809017 , -.58778524 , -.5 
  setpoint 12 ,  0       ,  0         , -1.118034
  dim t as integer
  for t = 1 to 12
    pnt( t ).normalize
  next t
  geo i , 1 ,  2 , 3
  geo i , 1 ,  3 ,  4 
  geo i , 1 ,  4 ,  5 
  geo i , 1 ,  5 ,  6 
  geo i , 1 ,  6 ,  2 
  geo i , 2 ,  7 ,  3
  geo i , 3 ,  7 ,  8 
  geo i , 3 ,  8 ,  4
  geo i , 4 ,  8 ,  9 
  geo i , 4 ,  9 ,  5 
  geo i , 5 ,  9 , 10 
  geo i , 5 , 10 ,  6 
  geo i , 6 , 10 , 11 
  geo i , 6 , 11 ,  2
  geo i , 2 , 11 ,  7 
  geo i , 12 ,  8 ,  7
  geo i , 12 ,  9 ,  8
  geo i , 12 , 10 ,  9 
  geo i , 12 , 11 , 10 
  geo i , 12 ,  7 , 11 
  glPopMatrix
end sub

sub sphere( a as integer , b as integer _
, da as single , db as single )
  dim as single i , j , i2 , j2 
  dim as single x , y , z
  if a < 3 then a = 3 
  if a > 64 then a = 64
  if b < 3 then b = 3 
  if b > 64 then b = 64
  glPushMatrix
  glTranslatef box.m.x , box.m.y , box.m.z
  glScalef box.d.x , box.d.y , box.d.z
  for i = -PI to PI  step PI / a * 2 
    i2 = i + PI / a * 2 
    for j = -PI / 2 to PI / 2 - pi / b * 2 step PI / b * 2 
      j2 = j + PI / b * 2 

      x = sin( i ) * cos( j )
      y = sin( j )
      z = cos( i ) * cos( j )
      setpoint 0 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )

      x = sin( i2 ) * cos( j )
      y = sin( j )
      z = cos( i2 ) * cos( j )
      setpoint 1 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )
      
      x = sin( i2 ) * cos( j2 )
      y = sin( j2 )
      z = cos( i2 ) * cos( j2 )
      setpoint 2 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )
      
      x = sin( i ) * cos( j2 )
      y = sin( j2 )
      z = cos( i ) * cos( j2 )
      setpoint 3 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )
      
      quad 0 , 1 , 2 , 3 
    next j
  next i
  glPopMatrix
end sub

sub torus( a as integer , b as integer )
  dim i as single , j as single , i2 as single , j2 as single
  if a < 3 then a = 3 
  if a > 64 then a = 643
  if b < 3 then b = 3 
  if b > 64 then b = 64 
  dim mx as single , my as single , mz as single , dx as single , dy as single , dz as single 
  mx = box.m.x 
  my = box.m.y 
  mz = box.m.z 
  dx = box.d.x 
  dy = box.d.y 
  dz = box.d.z 
  for i = -PI to PI  step PI / a * 2 
    i2 = i + PI / a * 2 
    for j = -PI to PI step PI / b * 2 
      j2 = j + PI / b * 2 
      setpoint 0 _ 
      , mx + ( dx + dy * cos( i ) ) * cos( j ) _
      , my + ( dx + dy * cos( i ) ) * sin( j ) _
      , mz + sin( i ) * dz  
      setpoint 1 _
      , mx + ( dx + dy * cos( i ) ) * cos( j2 ) _
      , my + ( dx + dy * cos( i ) ) * sin( j2 ) _
      , mz + sin( i ) * dz 
      setpoint 2 _
      , mx + ( dx + dy * cos( i2 ) ) * cos( j2 ) _
      , my + ( dx + dy * cos( i2 ) ) * sin( j2 ) _
      , mz + sin( i2 ) * dz 
      setpoint 3 _ 
      , mx + ( dx + dy * cos( i2 ) ) * cos( j ) _
      , my + ( dx + dy * cos( i2 ) ) * sin( j ) _
      , mz + sin( i2 ) * dz 
      quad 0 , 1 , 2 , 3 
    next j
  next i
end sub

sub cilinder( sides as integer , dx as single , dy as single , top as integer , bot as integer )
  dim f as single
  if sides < 3 then sides = 3
  if sides > 64 then sides = 64
  for f = 0 to sides + 2
    setpoint f , box.m.x + sin( f * pi * 2 / sides ) * box.d.x _
               , box.m.y - box.d.y _
               , box.m.z + cos( f * pi * 2 / sides ) * box.d.z
    setpoint f + sides + 1 , box.m.x + sin( f * pi * 2 / sides ) * dx _
                           , box.m.y + box.d.y _
                           , box.m.z + 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.m.y + box.d.y , 0
    for f = 0 to sides
        setpoint f , box.m.x + sin( f * pi * 2 / sides ) * dx _
               , box.m.y + box.d.y _
               , box.m.z + 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.m.y - box.d.y , 0
    for f = 0 to sides + 2
        setpoint f , box.m.x - sin( f * pi * 2 / sides ) * box.d.x _
               , box.m.y - box.d.y _
               , box.m.z + cos( f * pi * 2 / sides ) * box.d.z  
    next f
    for f = 0 to sides + 2
      tri 255 , f , f + 1 
    next f
  end if
end sub

sub cube()
  setpoint 0 , box.m.x + box.d.x , box.m.y + box.d.y , box.m.z + box.d.z
  setpoint 1 , box.m.x + box.d.x , box.m.y + box.d.y , box.m.z - box.d.z
  setpoint 2 , box.m.x + box.d.x , box.m.y - box.d.y , box.m.z + box.d.z
  setpoint 3 , box.m.x + box.d.x , box.m.y - box.d.y , box.m.z - box.d.z
  setpoint 4 , box.m.x - box.d.x , box.m.y + box.d.y , box.m.z + box.d.z
  setpoint 5 , box.m.x - box.d.x , box.m.y + box.d.y , box.m.z - box.d.z
  setpoint 6 , box.m.x - box.d.x , box.m.y - box.d.y , box.m.z + box.d.z
  setpoint 7 , box.m.x - box.d.x , box.m.y - box.d.y , box.m.z - box.d.z
  quad 0 , 2 , 3 , 1 ''right
  quad 7 , 6 , 4 , 5 ''left
  quad 0 , 4 , 5 , 1 ''up
  quad 7 , 3 , 2 , 6 ''down
  quad 0 , 4 , 6 , 2 ''back
  quad 7 , 5 , 1 , 3 ''front
end sub

sub hcube()
  setpoint 1 , box.m.x + box.d.x , box.m.y + box.d.y , box.m.z - box.d.z
  setpoint 2 , box.m.x + box.d.x , box.m.y - box.d.y , box.m.z + box.d.z
  setpoint 3 , box.m.x + box.d.x , box.m.y - box.d.y , box.m.z - box.d.z
  setpoint 4 , box.m.x - box.d.x , box.m.y + box.d.y , box.m.z + box.d.z
  setpoint 5 , box.m.x - box.d.x , box.m.y + box.d.y , box.m.z - box.d.z
  setpoint 6 , box.m.x - box.d.x , box.m.y - box.d.y , box.m.z + box.d.z
  setpoint 7 , box.m.x - box.d.x , box.m.y - box.d.y , box.m.z - box.d.z
  
  setpoint 0 , box.m.x + box.d.x , box.m.y - box.d.y , 0
  setpoint 8 , box.m.x + box.d.x , 0 , box.m.z - box.d.z
  setpoint 9 , 0 , box.m.y + box.d.y , box.m.z - box.d.z
  setpoint 10 , box.m.x - box.d.x , box.m.x + box.d.y , 0
  setpoint 11 , box.m.x - box.d.x , 0 , box.m.z + box.d.z
  setpoint 12, 0 , box.m.y - box.d.y , box.m.z + box.d.z
  
  tri 7 , 6 , 3
  tri 7 , 5 , 6 
  tri 7 , 3 , 5 
  
  quad 6 , 5 , 10 , 11 
  quad 5 , 3 , 8 , 9 
  quad 3 , 6 , 12 , 0 
  
  tri 6 , 12 , 11 
  tri 3 , 8 , 0 
  tri 5 , 9 , 10 
end sub

sub setbox( mx as single , my as single , mz as single , dx as single , dy as single , dz as single )
  box.m.x = mx
  box.m.y = my
  box.m.z = mz
  box.d.x = dx
  box.d.y = dy
  box.d.z = dz
end sub

#endif

[bluatigro]

stupid me :
i forgot flip in mainloop

red rotating cube 'visable'

Code: Select all

''bluatigro 25 jan 2017
''opengl lib test
''rotating cube

#include "_OPEN-GL.bas"

dim as single hoek

do
  glClear GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT

  glLoadIdentity
  glTranslatef 0 , 0 , -5
  glRotatef hoek , 1 , 1 , 0
  
  material.diffuse = red
  setMaterial GL_FRONT_AND_BACK , material
  
  setbox 0,0,0 , 1,1,1
  cube
  
  hoek += 5
  sleep 40
  flip
loop until inkey = chr( 27 )

[bluatigro]

update :
animated avartar example
_open-gl.bas extended

main

Code: Select all

''bluatigro 25 jan 2017
''opengl lib test 2
''animated avartars

#include "_OPEN-GL.bas"

dim as single hoek

do
  glClear GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT

  material.ambient = gray
  material.diffuse = cyan
  setMaterial GL_FRONT_AND_BACK , material
  glLoadIdentity
  glTranslatef -2 , 0 , -10
  glRotatef 30 , 0 , 1 , 0
  animate 0,0,0
  animate human_walk , hoek , 30
  human
  
  material.diffuse = yellow
  setMaterial GL_FRONT_AND_BACK , material
  glLoadIdentity
  glTranslatef 0 , 0 , -10
  glRotatef 30 , 0 , 1 , 0
  animate 0,0,0
  animate i_stand , 0 , 0
  animate i_sting , hoek , 5
  insect

  material.diffuse = magenta
  setMaterial GL_FRONT_AND_BACK , material
  glLoadIdentity
  glTranslatef 2 , 0 , -10
  glRotatef 30 , 0 , 1 , 0
  animate 0,0,0
  animate dog_walk , hoek , 30
  dog

  hoek += 10
  sleep 40
  flip
loop until inkey = chr( 27 )
  

_open-gl.bas

Code: Select all

''bluatigro 25 jan 2017
''opengl lib

#ifndef OPENGL_H
#define OPENGL_H

''VECTOR3D

type t3d
  x as single
  y as single
  z as single
  declare constructor()
  declare constructor ( x as single , y as single, z as single )
  declare sub fill( x as single , y as single , z as single )
  declare sub normalize
end type
constructor t3d()
  this.x = 0
  this.y = 0
  this.z = 0
end constructor 
constructor t3d( x as single , y as single , z as single )
  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 single ) 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 single ) as t3d
  return type( a.x / d , a.y / d , a.z / d )
end operator
sub t3d.fill( x as single , y as single , z as single )
  this.x = x
  this.y = y
  this.z = z
end sub
declare function dot( a as t3d , b as t3d ) as single
function dot( a as t3d , b as t3d ) as single
  return a.x * b.x + a.y * b.y + a.z * b.z
end function
declare function length( q as t3d ) as single
function length( q as t3d ) as single
   return sqr( q.x * q.x + q.y * q.y + q.z * q.z ) + 1e-7
end function  
declare function anlge( a as t3d , b as t3d ) as single
function getangle( a as t3d , b as t3d ) as single
  return acos( dot( a , b ) _
  / ( length( a ) * length( b ) ) )
end function
sub t3d.normalize
  this /= length( this )
end sub

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

const as single PI = csng( atn( 1 ) * 4 )

''3DENGINE


declare sub child( x as single , y as single , z as single , ax as integer , lim as integer )
declare function pend( fase as single , amp as single ) as single
declare sub skelet( no as integer , x as single , y as single , z as single )
dim shared sk( 63 ) as t3d
declare sub opengl_init()

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 single , y as single , z as single , lim as integer , ax as integer )
  glTranslatef x , y , z
  select case ax
    case xyz
      glRotatef sk( lim ).x , 1 , 0 , 0
      glRotatef sk( lim ).y , 0 , 1 , 0
      glRotatef sk( lim ).z , 0 , 0 , 1
    case xzy
      glRotatef sk( lim ).x , 1 , 0 , 0
      glRotatef sk( lim ).z , 0 , 0 , 1
      glRotatef sk( lim ).y , 0 , 1 , 0
    case yxz
      glRotatef sk( lim ).y , 0 , 1 , 0
      glRotatef sk( lim ).x , 1 , 0 , 0
      glRotatef sk( lim ).z , 0 , 0 , 1
    case yzx
      glRotatef sk( lim ).y , 0 , 1 , 0
      glRotatef sk( lim ).z , 0 , 0 , 1
      glRotatef sk( lim ).x , 1 , 0 , 0
    case zxy
      glRotatef sk( lim ).z , 0 , 0 , 1
      glRotatef sk( lim ).x , 1 , 0 , 0
      glRotatef sk( lim ).y , 0 , 1 , 0
    case zyx
      glRotatef sk( lim ).z , 0 , 0 , 1
      glRotatef sk( lim ).y , 0 , 1 , 0
      glRotatef sk( lim ).x , 1 , 0 , 0
    case else
  end select  
end sub

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

sub skelet( no as integer , x as single , y as single , z as single )
  sk( no and 63 ).x = x 
  sk( no and 63 ).y = y
  sk( no and 63 ).z = z
end sub

screen 20, 32, , 2

'' ReSizeGLScene
glViewport 0, 0, 1024 , 768                      '' Reset The Current Viewport
glMatrixMode GL_PROJECTION                     '' Select The Projection Matrix
glLoadIdentity                                 '' Reset The Projection Matrix
gluPerspective 45.0, 1024.0/768.0, 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, 0.5                '' 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 ) = { 0 , 50 , 0 , 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 t_4d
  dim as single x , y , z , w
  declare sub fill( nx as single , ny as single , nz as single , nw as single )
end type
sub t_4d.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 t_4d 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

''MATERIAL

type t_material
  dim as t_4d 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

''PRIMATIVS

dim shared as t3d pnt( 256 )

sub setpoint( no as integer , x as single , y as single , z as single )
  if no < 0 or no > 255 then exit sub
  pnt( no ).x = x
  pnt( no ).y = y
  pnt( no ).z = 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 t3d n = ( pnt( p2 ) - pnt( p1 ) ) _
               \ ( pnt( p3 ) - pnt( p1 ) )
  n.normalize()
  glbegin gl_triangles
    glnormal3f n.x , n.y , n.z
    glvertex3f pnt( p1 ).x , pnt( p1 ).y , pnt( p1 ).z
    glvertex3f pnt( p2 ).x , pnt( p2 ).y , pnt( p2 ).z
    glvertex3f 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 t3d zp = ( pnt( p1 ) + pnt( p2 ) _
  + pnt( p3 ) + pnt( p4 ) ) / 4
  dim as t3d n = ( pnt( p2 ) - zp ) _
               \ ( pnt( p3 ) - zp )
  n.normalize()
  glbegin gl_quads
    glnormal3f n.x , n.y , n.z
    glvertex3f pnt( p1 ).x , pnt( p1 ).y , pnt( p1 ).z
    glvertex3f pnt( p2 ).x , pnt( p2 ).y , pnt( p2 ).z
    glvertex3f pnt( p3 ).x , pnt( p3 ).y , pnt( p3 ).z
    glvertex3f pnt( p4 ).x , pnt( p4 ).y , pnt( p4 ).z
  glend 
end sub

''SHAPES

type Tbox
  m as t3d
  d as t3d
end type
dim shared box as Tbox

declare sub isoca( i as integer )
declare sub sphere( h as integer , r as integer _
, a as single , b as single )
declare sub torus( hsides as integer , rsides as integer )
declare sub cilinder( sides as integer _
, dx as single , dy as single , top as integer , bot as integer ) 
declare sub cube( )
declare sub hcube( )
declare sub setbox( mx as single , my as single _
, mz as single , dx as single , dy as single , dz as single )
declare sub geo( no as integer , p1 as integer _
, p2 as integer , p3 as integer )

sub geo( no as integer , p1 as integer _
, p2 as integer , p3 as integer )
  if no < 1 then 
    tri p1 , p2 , p3 
  else
  dim p12 as integer , p13 as integer , p23 as integer
    p12 = 255 - no * 3
    p13 = 255 - no * 3 - 1
    p23 = 255 - no * 3 - 2
    pnt( p12 ) = ( pnt( p1 ) + pnt( p2 ) ) / 2
    pnt( p13 ) = ( pnt( p1 ) + pnt( p3 ) ) / 2
    pnt( p23 ) = ( pnt( p2 ) + pnt( p3 ) ) / 2
    pnt( p12 ).normalize
    pnt( p13 ).normalize
    pnt( p23 ).normalize
    geo no - 1 , p1 , p12 , p13
    geo no - 1 , p2 , p23 , p12
    geo no - 1 , p3 , p13 , p23
    geo no - 1 , p12 , p23 , p13
  end if
end sub

sub isoca( i as integer )
  if i < 0 then i = 0
  if i > 5 then i = 5
  glPushMatrix
  glTranslatef box.m.x , box.m.y , box.m.z 
  glScalef box.d.x , box.d.y , box.d.z
    
  setpoint  1 ,  0       ,  0 , 1.118034
  setpoint  2 ,  1       ,  0         ,  .5 
  setpoint  3 ,  .309017 ,  .95105654 ,  .5 
  setpoint  4 , -.809017 ,  .58778524 ,  .5 
  setpoint  5 , -.809017 , -.58778524 ,  .5 
  setpoint  6 ,  .309017 , -.95105654 ,  .5 
  setpoint  7 ,  .809017 ,  .58778524 , -.5 
  setpoint  8 , -.309017 ,  .95105654 , -.5 
  setpoint  9 , -1       ,  0         , -.5 
  setpoint 10 , -.309017 , -.95105654 , -.5
  setpoint 11 ,  .809017 , -.58778524 , -.5 
  setpoint 12 ,  0       ,  0         , -1.118034
  dim t as integer
  for t = 1 to 12
    pnt( t ).normalize
  next t
  geo i , 1 ,  2 , 3
  geo i , 1 ,  3 ,  4 
  geo i , 1 ,  4 ,  5 
  geo i , 1 ,  5 ,  6 
  geo i , 1 ,  6 ,  2 
  geo i , 2 ,  7 ,  3
  geo i , 3 ,  7 ,  8 
  geo i , 3 ,  8 ,  4
  geo i , 4 ,  8 ,  9 
  geo i , 4 ,  9 ,  5 
  geo i , 5 ,  9 , 10 
  geo i , 5 , 10 ,  6 
  geo i , 6 , 10 , 11 
  geo i , 6 , 11 ,  2
  geo i , 2 , 11 ,  7 
  geo i , 12 ,  8 ,  7
  geo i , 12 ,  9 ,  8
  geo i , 12 , 10 ,  9 
  geo i , 12 , 11 , 10 
  geo i , 12 ,  7 , 11 
  glPopMatrix
end sub

sub sphere( a as integer , b as integer _
, da as single , db as single )
  dim as single i , j , i2 , j2 
  dim as single x , y , z
  if a < 3 then a = 3 
  if a > 64 then a = 64
  if b < 3 then b = 3 
  if b > 64 then b = 64
  glPushMatrix
  glTranslatef box.m.x , box.m.y , box.m.z
  glScalef box.d.x , box.d.y , box.d.z
  for i = -PI to PI  step PI / a * 2 
    i2 = i + PI / a * 2 
    for j = -PI / 2 to PI / 2 - pi / b * 2 step PI / b * 2 
      j2 = j + PI / b * 2 

      x = sin( i ) * cos( j )
      y = sin( j )
      z = cos( i ) * cos( j )
      setpoint 0 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )

      x = sin( i2 ) * cos( j )
      y = sin( j )
      z = cos( i2 ) * cos( j )
      setpoint 1 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )
      
      x = sin( i2 ) * cos( j2 )
      y = sin( j2 )
      z = cos( i2 ) * cos( j2 )
      setpoint 2 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )
      
      x = sin( i ) * cos( j2 )
      y = sin( j2 )
      z = cos( i ) * cos( j2 )
      setpoint 3 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )
      
      quad 0 , 1 , 2 , 3 
    next j
  next i
  glPopMatrix
end sub

sub torus( a as integer , b as integer )
  dim i as single , j as single , i2 as single , j2 as single
  if a < 3 then a = 3 
  if a > 64 then a = 643
  if b < 3 then b = 3 
  if b > 64 then b = 64 
  dim mx as single , my as single , mz as single , dx as single , dy as single , dz as single 
  mx = box.m.x 
  my = box.m.y 
  mz = box.m.z 
  dx = box.d.x 
  dy = box.d.y 
  dz = box.d.z 
  for i = -PI to PI  step PI / a * 2 
    i2 = i + PI / a * 2 
    for j = -PI to PI step PI / b * 2 
      j2 = j + PI / b * 2 
      setpoint 0 _ 
      , mx + ( dx + dy * cos( i ) ) * cos( j ) _
      , my + ( dx + dy * cos( i ) ) * sin( j ) _
      , mz + sin( i ) * dz  
      setpoint 1 _
      , mx + ( dx + dy * cos( i ) ) * cos( j2 ) _
      , my + ( dx + dy * cos( i ) ) * sin( j2 ) _
      , mz + sin( i ) * dz 
      setpoint 2 _
      , mx + ( dx + dy * cos( i2 ) ) * cos( j2 ) _
      , my + ( dx + dy * cos( i2 ) ) * sin( j2 ) _
      , mz + sin( i2 ) * dz 
      setpoint 3 _ 
      , mx + ( dx + dy * cos( i2 ) ) * cos( j ) _
      , my + ( dx + dy * cos( i2 ) ) * sin( j ) _
      , mz + sin( i2 ) * dz 
      quad 0 , 1 , 2 , 3 
    next j
  next i
end sub

sub cilinder( sides as integer , dx as single , dy as single , top as integer , bot as integer )
  dim f as single
  if sides < 3 then sides = 3
  if sides > 64 then sides = 64
  for f = 0 to sides + 2
    setpoint f , box.m.x + sin( f * pi * 2 / sides ) * box.d.x _
               , box.m.y - box.d.y _
               , box.m.z + cos( f * pi * 2 / sides ) * box.d.z
    setpoint f + sides + 1 , box.m.x + sin( f * pi * 2 / sides ) * dx _
                           , box.m.y + box.d.y _
                           , box.m.z + 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.m.y + box.d.y , 0
    for f = 0 to sides
        setpoint f , box.m.x + sin( f * pi * 2 / sides ) * dx _
               , box.m.y + box.d.y _
               , box.m.z + 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.m.y - box.d.y , 0
    for f = 0 to sides + 2
        setpoint f , box.m.x - sin( f * pi * 2 / sides ) * box.d.x _
               , box.m.y - box.d.y _
               , box.m.z + cos( f * pi * 2 / sides ) * box.d.z  
    next f
    for f = 0 to sides + 2
      tri 255 , f , f + 1 
    next f
  end if
end sub

sub cube()
  setpoint 0 , box.m.x + box.d.x , box.m.y + box.d.y , box.m.z + box.d.z
  setpoint 1 , box.m.x + box.d.x , box.m.y + box.d.y , box.m.z - box.d.z
  setpoint 2 , box.m.x + box.d.x , box.m.y - box.d.y , box.m.z + box.d.z
  setpoint 3 , box.m.x + box.d.x , box.m.y - box.d.y , box.m.z - box.d.z
  setpoint 4 , box.m.x - box.d.x , box.m.y + box.d.y , box.m.z + box.d.z
  setpoint 5 , box.m.x - box.d.x , box.m.y + box.d.y , box.m.z - box.d.z
  setpoint 6 , box.m.x - box.d.x , box.m.y - box.d.y , box.m.z + box.d.z
  setpoint 7 , box.m.x - box.d.x , box.m.y - box.d.y , box.m.z - box.d.z
  quad 0 , 2 , 3 , 1 ''right
  quad 7 , 6 , 4 , 5 ''left
  quad 0 , 4 , 5 , 1 ''up
  quad 7 , 3 , 2 , 6 ''down
  quad 0 , 4 , 6 , 2 ''back
  quad 7 , 5 , 1 , 3 ''front
end sub

sub hcube()
  setpoint 1 , box.m.x + box.d.x , box.m.y + box.d.y , box.m.z - box.d.z
  setpoint 2 , box.m.x + box.d.x , box.m.y - box.d.y , box.m.z + box.d.z
  setpoint 3 , box.m.x + box.d.x , box.m.y - box.d.y , box.m.z - box.d.z
  setpoint 4 , box.m.x - box.d.x , box.m.y + box.d.y , box.m.z + box.d.z
  setpoint 5 , box.m.x - box.d.x , box.m.y + box.d.y , box.m.z - box.d.z
  setpoint 6 , box.m.x - box.d.x , box.m.y - box.d.y , box.m.z + box.d.z
  setpoint 7 , box.m.x - box.d.x , box.m.y - box.d.y , box.m.z - box.d.z
  
  setpoint 0 , box.m.x + box.d.x , box.m.y - box.d.y , 0
  setpoint 8 , box.m.x + box.d.x , 0 , box.m.z - box.d.z
  setpoint 9 , 0 , box.m.y + box.d.y , box.m.z - box.d.z
  setpoint 10 , box.m.x - box.d.x , box.m.x + box.d.y , 0
  setpoint 11 , box.m.x - box.d.x , 0 , box.m.z + box.d.z
  setpoint 12, 0 , box.m.y - box.d.y , box.m.z + box.d.z
  
  tri 7 , 6 , 3
  tri 7 , 5 , 6 
  tri 7 , 3 , 5 
  
  quad 6 , 5 , 10 , 11 
  quad 5 , 3 , 8 , 9 
  quad 3 , 6 , 12 , 0 
  
  tri 6 , 12 , 11 
  tri 3 , 8 , 0 
  tri 5 , 9 , 10 
end sub

sub setbox( mx as single , my as single , mz as single , dx as single , dy as single , dz as single )
  box.m.x = mx
  box.m.y = my
  box.m.z = mz
  box.d.x = dx
  box.d.y = dy
  box.d.z = dz
end sub


const as integer body = 0 
const as integer arm = 1
const as integer elbow = 2 
const as integer wrist = 3
const as integer leg = 4
const as integer knee = 5 
const as integer enkle = 6 
const as integer neck = 7
const as integer eye = 8 
const as integer ileg = 4 
const as integer iknee = 9 
const as integer wing = 14
const as integer tail = 16
const as integer sensor = 17
const as integer thumb = 18
const as integer finger = 19
const as integer lr = 32

const as integer human_walk = 1
const as integer dog_walk = 2
const as integer I_FLY = 3
const as integer I_LEFT_LEGS = 4
const as integer I_LEFT_BOX = 5
const as integer I_RIGHT_LEGS = 6
const as integer I_RIGHT_BOX = 7
const as integer I_STING = 8
const as integer I_STAND = 9

declare sub animate( anim as integer , f as single , a as single )

declare sub human()
declare sub dog()
declare sub insect()

declare sub pilko()
declare sub man()
declare sub minion()

sub animate( anim as integer , f as single , a as single )
  DIM I AS INTEGER
  select case anim
  case human_walk
    skelet arm , pend( f , a ) , 0 , 0
    skelet elbow , -abs( a ) , 0 , 0
    skelet arm + lr , pend( f + 180, a ) , 0 , 0
    skelet elbow + lr , -abs( a ) , 0 , 0
    skelet leg , pend( f + 180 , a ) , 0 , 0
    skelet knee , pend( f + 90 , a ) + a , 0 , 0
    skelet leg + lr , pend( f , a ) , 0 , 0
    skelet knee + lr , pend( f - 90 , a ) + a , 0 , 0
  case dog_walk
    skelet arm , pend( f + 180 , a ) , 0 , 0
    skelet elbow , pend( f + 90 , a ) + a , 0 , 0
    skelet arm + lr , pend( f , a ) , 0 , 0
    skelet elbow + lr , pend( f - 90 , a ) + a , 0 , 0
    skelet leg , pend( f + 180 , a ) , 0 , 0
    skelet knee , pend( f + 90 , a ) + a , 0 , 0
    skelet leg + lr , pend( f , a ) , 0 , 0
    skelet knee + lr , pend( f - 90 , a ) + a , 0 , 0
    skelet tail , -45 , pend( f * 2 , a ) , 0
    skelet neck , 0 , 0 , 0
    skelet neck + lr , 0 , 0 , 0
  Case I_FLY
    For i = 0 To 1
      skelet wing + i, 0 , 0 , Pend(f, a)
      skelet wing+lr + i, 0,0, Pend(f, -a)
    Next
  Case I_LEFT_BOX
    skelet arm, 0, Pend(f, -a) + 45 , 0
    skelet elbow, 0, Pend(f, a * 2) - 60 , 0
  Case I_LEFT_LEGS
    For i = 0 To 4
      skelet ileg + i, 0 , 0, Pend(f + i * 180, a)
      skelet iknee + i, Pend(f + i * 180 + 90, a) , 0 , 0
    Next
  Case I_RIGHT_BOX
    skelet arm+lr, 0, Pend(f, a) - 45,0
    skelet elbow+lr, 0, Pend(f, -a * 2) + 60, 0
  Case I_RIGHT_LEGS
    For i = 0 To 4
      skelet ileg+lr+ i, 0,0, Pend(f + i * 180, a)
      skelet iknee+lr + i, Pend(f + i * 180 + 90, a),0,0
    Next
  Case I_STAND
    skelet arm, 0, 45, 0
    skelet elbow, 0, -60 , 0
    skelet finger, 0, 0, 0
    skelet thumb, 0, 0, 0
    skelet arm+lr, 0, -45, 0
    skelet elbow+lr, 0, 60 , 0
    skelet finger+lr, 0, 0, 0
    skelet thumb+lr, 0, 0, 0
    skelet tail, 10, 0 , 0
    skelet tail+lr, 10, 0 , 0
  Case I_STING
    skelet tail, 10 + Pend(f, a), 0, 0
    skelet tail+lr, 10 - Pend(f, a), 0, 0
  case else
    dim i as integer
    for i = 0 to 63
      skelet i , 0,0,0
    next i
  end select
end sub

sub insect()
  Dim i as integer
glPushmatrix
  glScalef .01 , .01 , .01
  setbox 0, 0, 0, 30, 10.0, 60.0
  Cube
  For i = 0 To 4
    glPushMatrix
      child 35.0, 0.0, i * 25 - 50 , ileg + i, xyz
      setbox 30.0, 0.0, 0.0, 30.0, 5.0, 5.0
      Cube
      glPushMatrix
        child 65.0, -5.0, 0.0 , iknee + i, xyz
        setbox 0.0, -30.0, 0.0, 5.0, 30.0, 5.0
        Cube
      glPopMatrix
    glPopMatrix
    glpushMatrix
      child -35.0, 0.0, i * 25 - 50, ileg + lr + i, xyz
      setbox -30.0, 0.0, 0.0, 30.0, 5.0, 5.0
      Cube 
      glPushMatrix
        child -65.0, -5.0, 0.0 , iknee + lr + 1, xyz
        setbox 0.0, -30.0, 0.0, 5.0, 30.0, 5.0
        Cube
      glPopmatrix
    glPopMatrix
  Next
  glPushMatrix
    child 0 , 0 , -50 , tail , xyz
    For i = 0 To 9
      glPushMatrix
        child 0.0, 0.0, -30.0 , tail, xyz
        setbox 0.0, 0.0, -15.0, 10.0, 10.0, 10.0
        Cube
    Next
    for i = 0 to 8
        glPushMatrix
          child 0 , 0 , -30 , tail+lr , xyz
          cube
    next i
    for i = 0 to 8
        glPopMatrix
      glPopMatrix
    next i
  glPopMatrix
  glPushMatrix
    child 30.0, 0.0, 65.0, arm, xyz
    setbox 0.0, 0.0, 30.0, 5.0, 5.0, 30.0
    Cube
    glPushMatrix
      child 0.0, 0.0, 65.0, elbow, xyz
      Cube
      glPushmatrix
        child 0.0, 0.0, 65.0 , wrist, xyz
        glPushmatrix
          child -10.0, 0.0, 5.0 , thumb, xyz
          Cube
        glPopMatrix
        glPushMatrix
          child 5.0, 0.0, 5.0, finger, xyz
          setbox 0.0, 0.0, 30.0, 5.0, 10.0, 30.0
          Cube
        glPopMatrix
      glPopMatrix
    glPopMatrix
  glPopMatrix
  glPushMatrix
    child -30.0, 0.0, 65.0, arm + lr, xyz
    setbox 0.0, 0.0, 30.0, 5.0, 5.0, 30.0
    Cube
    glPushMatrix
      child 0.0, 0.0, 65.0, elbow +lr, xyz
      Cube
      glPushMatrix
        child 0.0, 0.0, 65.0, wrist+lr, xyz
        glPushMatrix
          child 10.0, 0.0, 5.0, thumb+lr, xyz
          Cube
        glPopMatrix
        glPushMatrix
          child -5.0, 0.0, 5.0, finger+lr, xyz
          setbox 0.0, 0.0, 30.0, 5.0, 10.0, 30.0
          Cube
        glPopMatrix
      glPopMatrix
    glPopMatrix
   glPopMatrix
   For i = 0 To 1
     glPushMatrix
       child 20.0, 20.0, 40.0 - 50.0 * i, wing + i, xyz
       setbox 60.0, 0.0, 8.0, 60.0, 2.0, 16.0
       Cube
     glPopMatrix
     glPushMatrix
       child -20.0, 20.0, 40.0 - 50.0 * i , wing+lr + i,  xyz
       setbox -60.0, 0.0, 8.0, 60.0, 2.0, 16.0
       Cube
     glPopmatrix
   Next
glPopMatrix
end sub

sub human()
  setbox  0 , 0 , 0  ,  .5 , .1 , .1
  cube 
  setbox 0 , .75 , 0 , .1 , .5 , .1
  cube 
  setbox 0 , 1.8 , 0 , .2 , .2 , .2
  cube 
  setbox 0 , 1.4 , 0 , .7 , .1 , .1
  cube 
  glPushMatrix
    child .45 , 0 , 0 , leg , zyx
    setbox 0 , -.6 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , knee , xyz
      cube 
      glPushMatrix
        child 0 , -1.2 , 0 , enkle , xyz
        setbox 0 , 0 , .2 , .1 , .1 , .3
        cube 
      glPopMatrix
    glPopMatrix
  glPopMatrix
  glPushMatrix
    child -.45 , 0 , 0 , leg + lr , zyx
    setbox 0 , -.6 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , knee + lr , xyz
      cube 
      glPushMatrix
        child 0 , -1.2 , 0 , enkle + lr , xyz 
        setbox 0 , 0 , .2 , .1 , .1 , .3
        cube 
      glPopMatrix
    glPopMatrix
  glPopMatrix
  glPushMatrix
    child .65 , 1.3 , 0 , arm , xyz
    setbox 0 , -.5 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , elbow , xyz
      cube 
      glPushMatrix
        child 0 , -1 , 0 , wrist , zyx
        setbox 0 , -.3 , 0 , .05 , .2 , .15
        cube
      glPopMatrix
    glPopMatrix
  glPopMatrix
  glPushMatrix
    child -.65 , 1.3 , 0 , arm + lr , xyz
    setbox 0 , -.5 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , elbow + lr , xyz
      cube 
      glPushMatrix
        child 0 , -1 , 0 , wrist + lr , zyx
        setbox 0 , -.3 , 0 , .05 , .2 , .15
        cube 
      glPopMatrix
    glPopMatrix
  glPopMatrix
end sub

sub dog()
  setbox 0,.2,.5 , .3,.3,.7
  cube
  glpushmatrix
    child 0 , .6 , 1.5 , neck , xyz
    glpushmatrix
      child 0 , 0 , 0 , neck + lr , zyx
      setbox 0,0,0 , .3 , .3 , .3
      cube
      setbox 0,-.2,.3 , .2,.2,.2
      cube
      setbox 0,0,.5 , .1,.1,.1
      cube
      setbox .3,-.15,0 , .05,.3,.2
      cube
      setbox -.3,-.15,0 , .05,.3,.2
      cube
    glpopmatrix
  glpopmatrix
  glpushmatrix
    child 0 , .4 , -.5 , tail , yzx
    setbox 0,.3,0 , .1 , .3 , .1
    cube
  glpopmatrix
  glPushMatrix
    child .3 , 0 , 1 , leg , zyx
    setbox 0 , -.6 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , knee , xyz
      cube 
      glPushMatrix
        child 0 , -1.2 , 0 , enkle , xyz
        setbox 0 , 0 , .2 , .1 , .1 , .3
        cube 
      glPopMatrix
    glPopMatrix
  glPopMatrix
  glPushMatrix
    child -.3 , 0 , 1 , leg + lr, zyx
    setbox 0 , -.6 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , knee + lr, xyz
      cube 
      glPushMatrix
        child 0 , -1.2 , 0 , enkle + lr, xyz
        setbox 0 , 0 , .2 , .1 , .1 , .3
        cube 
      glPopMatrix
    glPopMatrix
  glPopMatrix
  glPushMatrix
    child .3 , 0 , 0 , arm , zyx
    setbox 0 , -.6 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , elbow , xyz
      cube 
      glPushMatrix
        child 0 , -1.2 , 0 , wrist , xyz
        setbox 0 , 0 , .2 , .1 , .1 , .3
        cube 
      glPopMatrix
    glPopMatrix
  glPopMatrix
  glPushMatrix
    child -.3 , 0 , 0 , arm + lr , zyx
    setbox 0 , -.6 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , elbow + lr , xyz
      cube 
      glPushMatrix
        child 0 , -1.2 , 0 , wrist + lr , xyz
        setbox 0 , 0 , .2 , .1 , .1 , .3
        cube 
      glPopMatrix
    glPopMatrix
  glPopMatrix
end sub

#endif

[bluatigro]

try at a flight sim

Code: Select all

''bluatigro 25 jan 2017
''opengl lib test 3
''sky car sim

#include "_OPEN-GL.bas"

dim as single hoek
type t_camara
public :
  dim as single x,y,z,pan
  declare sub move( dx as single _
  , dy as single , dz as single , dpan as single )
end type
sub t_camara.move( dx as single _
  , dy as single , dz as single , dpan as single )
  rotate dx , dz , -pan
  x += dx
  y += dy
  z += dz
  pan += dpan
end sub

dim shared as t_camara cam

type t_skycar
public :
  dim as single x , y , z , pan
  dim as t_4d kl
  dim as integer tel , state
  declare sub draw_it
  declare sub move( dx as single _
  , dy as single , dz as single , dpan as single )
end type
sub t_skycar.move( dx as single _
  , dy as single , dz as single , dpan as single )
  rotate dx , dz , -pan
  x += dx
  y += dy
  z += dz
  pan += dpan
end sub
sub t_skycar.draw_it
material.diffuse = kl
setmaterial GL_FRONT , material
glpushmatrix
  gltranslatef x,y,z
  glrotatef pan , 0,1,0
  glpushmatrix
    setbox 0,0,0 , .5,.5,2
    sphere 24 , 24 , 1 , 1
    setbox 0,.5,0 , .2,.2,.5
    sphere 24 , 24 , 1 , 1
    glpushmatrix
      gltranslatef 1,-.5,1.5
      glrotatef -60 , 1,0,0
      setbox 0,0,0 , .3,.1,.3
      torus 24 , 24
    glpopmatrix
    glpushmatrix
      gltranslatef -1,-.5,1.5
      glrotatef -60 , 1,0,0
      setbox 0,0,0 , .3,.1,.3
      torus 24 , 24
    glpopmatrix
    glpushmatrix
      gltranslatef 1,0,-1.5
      glrotatef -60 , 1,0,0
      setbox 0,0,0 , .3,.1,.3
      torus 24 , 24
    glpopmatrix
    glpushmatrix
      gltranslatef -1,0,-1.5
      glrotatef -60 , 1,0,0
      setbox 0,0,0 , .3,.1,.3
      torus 24 , 24
    glpopmatrix
  glpopmatrix
glpopmatrix
end sub
dim as integer i , j , muisx , muisy , size = 20
dim as single dx , dy , dz , dpan
dim shared as t_skycar skycar( 5 )
dim as t3d skycarspot , camaraspot 
dim as t_4d clr( 5 ) = { red , green , yellow , blue , magenta , cyan }
for i = 0 to ubound( skycar )
  while length( skycarspot - camaraspot ) < 6
    skycar(i).x = range( -size , size )
    skycar(i).y = range( 0 , 10 )
    skycar(i).z = range( -size , size )
    skycarspot.fill skycar(i).x , skycar(i).y , skycar(i).z
  wend
  skycar( i ).kl = clr( i mod 6 )
next i


do
  glClear GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT
''camara
  glLoadIdentity
  glRotatef -cam.pan , 0 , 1 , 0
  glTranslatef -cam.x , -cam.y , -cam.z
''ground
  material.diffuse = green
  setmaterial GL_FRONT_AND_BACK , material
  for i = -size to size
    for j = -size to size
      if (i+j)and 1 then
        setpoint 0 , i , -1 , j+1
        setpoint 1 , i+1 , -1 , j+1
        setpoint 2 , i+1 , -1 , j
        setpoint 3 , i , -1 , j
        quad 0 , 1 , 2 , 3
      end if
    next j
  next i
''skycar stuf
  for i = 0 to ubound( skycar )
  skycar(i).tel -= 1
  if skycar(i).tel < 0 then
    skycar(i).tel = range( 15 , 150 )
    skycar(i).state = range( 0 , 5 )
  end if
  select case skycar(i).state
    case 0
      if skycar(i).y < 10 then skycar(i).move 0,.1,.1,0
    case 1
      if skycar(i).y > 0 then skycar(i).move 0,-.1,.1,0
    case 2
      skycar(i).move 0,0,.2,0
    case 3
      skycar(i).move 0,0,0,1
    case else
      skycar(i).move 0,0,0,-1
  end select
  skycar(i).draw_it
  if skycar(i).x < -size then skycar(i).x = size
  if skycar(i).x > size then skycar(i).x = -size
  if skycar(i).z < -size then skycar(i).z = size
  if skycar(i).z < size then skycar(i).z = -size
''hit camara - skycar ?
skycarspot.fill skycar(i).x , skycar(i).y , skycar(i).z
camaraspot.fill cam.x , cam.y , cam.z
if length( camaraspot - skycarspot ) < 4 then exit do
  next i
''read keyboard and mouse and move camara
  if multikey( sc_up ) then
    cam.move 0 , .1 , 0 , 0
  end if
  if multikey( sc_down ) and cam.y > 0 then
    cam.move 0 , -.1 , 0 , 0
  end if
  if multikey( sc_left ) then
    cam.move -.1 , 0 , 0 , 0
  end if
  if multikey( sc_right ) then
    cam.move .1 , 0 , 0 , 0
  end if
  if not getmouse( muisx , muisy ) then
    if muisx <> -1 and muisy <> -1 then
      if muisx < winx / 3 then
        cam.move 0 , 0 , 0 , 1
      end if
      if muisy < winy / 3 then
        cam.move 0 , 0 , -.1 , 0
      end if
      if muisx > winx * 2 / 3 then
        cam.move 0 , 0 , 0 , -1
      end if
      if muisy > winy * 2 / 3 then
        cam.move 0 , 0 , .1 , 0
      end if
    end if
  end if
  hoek += 5
  sleep 40
  flip
loop until inkey = chr( 27 )
  

Code: Select all

''bluatigro 25 jan 2017
''opengl lib

#ifndef OPENGL_H
#define OPENGL_H

''VECTOR3D

type t3d
  x as single
  y as single
  z as single
  declare constructor()
  declare constructor ( x as single , y as single, z as single )
  declare sub fill( x as single , y as single , z as single )
  declare sub normalize
end type
constructor t3d()
  this.x = 0
  this.y = 0
  this.z = 0
end constructor 
constructor t3d( x as single , y as single , z as single )
  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 single ) 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 single ) as t3d
  return type( a.x / d , a.y / d , a.z / d )
end operator
sub t3d.fill( x as single , y as single , z as single )
  this.x = x
  this.y = y
  this.z = z
end sub
declare function dot( a as t3d , b as t3d ) as single
function dot( a as t3d , b as t3d ) as single
  return a.x * b.x + a.y * b.y + a.z * b.z
end function
declare function length( q as t3d ) as single
function length( q as t3d ) as single
   return sqr( q.x * q.x + q.y * q.y + q.z * q.z ) + 1e-7
end function  
declare function anlge( a as t3d , b as t3d ) as single
function getangle( a as t3d , b as t3d ) as single
  return acos( dot( a , b ) _
  / ( length( a ) * length( b ) ) )
end function
sub t3d.normalize
  this /= length( this )
end sub

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

''MATH

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

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

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

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

sub rotate( byref k as single , byref l as single , deg as single )
  dim as single 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

''3DENGINE

declare sub child( x as single , y as single , z as single , ax as integer , lim as integer )
declare function pend( fase as single , amp as single ) as single
declare sub skelet( no as integer , x as single , y as single , z as single )
dim shared sk( 63 ) as t3d

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 single , y as single , z as single , lim as integer , ax as integer )
  glTranslatef x , y , z
  select case ax
    case xyz
      glRotatef sk( lim ).x , 1 , 0 , 0
      glRotatef sk( lim ).y , 0 , 1 , 0
      glRotatef sk( lim ).z , 0 , 0 , 1
    case xzy
      glRotatef sk( lim ).x , 1 , 0 , 0
      glRotatef sk( lim ).z , 0 , 0 , 1
      glRotatef sk( lim ).y , 0 , 1 , 0
    case yxz
      glRotatef sk( lim ).y , 0 , 1 , 0
      glRotatef sk( lim ).x , 1 , 0 , 0
      glRotatef sk( lim ).z , 0 , 0 , 1
    case yzx
      glRotatef sk( lim ).y , 0 , 1 , 0
      glRotatef sk( lim ).z , 0 , 0 , 1
      glRotatef sk( lim ).x , 1 , 0 , 0
    case zxy
      glRotatef sk( lim ).z , 0 , 0 , 1
      glRotatef sk( lim ).x , 1 , 0 , 0
      glRotatef sk( lim ).y , 0 , 1 , 0
    case zyx
      glRotatef sk( lim ).z , 0 , 0 , 1
      glRotatef sk( lim ).y , 0 , 1 , 0
      glRotatef sk( lim ).x , 1 , 0 , 0
    case else
  end select  
end sub

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

sub skelet( no as integer , x as single , y as single , z as single )
  sk( no and 63 ).x = x 
  sk( no and 63 ).y = y
  sk( no and 63 ).z = z
end sub

screen 20, 32, , 2

#include "fbgfx.bi"
#if __FB_LANG__ = "fb"
  Using FB 
#endif
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, 0.5                '' 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 ) = { 0 , 50 , 0 , 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 t_4d
  dim as single x , y , z , w
  declare sub fill( nx as single , ny as single , nz as single , nw as single )
end type
sub t_4d.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 t_4d 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

''MATERIAL

type t_material
  dim as t_4d 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

''PRIMATIVS

dim shared as t3d pnt( 256 )

sub setpoint( no as integer , x as single , y as single , z as single )
  if no < 0 or no > 255 then exit sub
  pnt( no ).x = x
  pnt( no ).y = y
  pnt( no ).z = 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 t3d n = ( pnt( p2 ) - pnt( p1 ) ) _
               \ ( pnt( p3 ) - pnt( p1 ) )
  n.normalize()
  glbegin gl_triangles
    glnormal3f n.x , n.y , n.z
    glvertex3f pnt( p1 ).x , pnt( p1 ).y , pnt( p1 ).z
    glvertex3f pnt( p2 ).x , pnt( p2 ).y , pnt( p2 ).z
    glvertex3f 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 t3d zp = ( pnt( p1 ) + pnt( p2 ) _
  + pnt( p3 ) + pnt( p4 ) ) / 4
  dim as t3d n = ( pnt( p2 ) - zp ) _
               \ ( pnt( p3 ) - zp )
  n.normalize()
  glbegin gl_quads
    glnormal3f n.x , n.y , n.z
    glvertex3f pnt( p1 ).x , pnt( p1 ).y , pnt( p1 ).z
    glvertex3f pnt( p2 ).x , pnt( p2 ).y , pnt( p2 ).z
    glvertex3f pnt( p3 ).x , pnt( p3 ).y , pnt( p3 ).z
    glvertex3f pnt( p4 ).x , pnt( p4 ).y , pnt( p4 ).z
  glend 
end sub

''SHAPES

type Tbox
  m as t3d
  d as t3d
end type
dim shared box as Tbox

declare sub isoca( i as integer )
declare sub sphere( h as integer , r as integer _
, a as single , b as single )
declare sub torus( hsides as integer , rsides as integer )
declare sub cilinder( sides as integer _
, dx as single , dy as single , top as integer , bot as integer ) 
declare sub cube( )
declare sub hcube( )
declare sub setbox( mx as single , my as single _
, mz as single , dx as single , dy as single , dz as single )
declare sub geo( no as integer , p1 as integer _
, p2 as integer , p3 as integer )

sub geo( no as integer , p1 as integer _
, p2 as integer , p3 as integer )
  if no < 1 then 
    tri p1 , p2 , p3 
  else
  dim p12 as integer , p13 as integer , p23 as integer
    p12 = 255 - no * 3
    p13 = 255 - no * 3 - 1
    p23 = 255 - no * 3 - 2
    pnt( p12 ) = ( pnt( p1 ) + pnt( p2 ) ) / 2
    pnt( p13 ) = ( pnt( p1 ) + pnt( p3 ) ) / 2
    pnt( p23 ) = ( pnt( p2 ) + pnt( p3 ) ) / 2
    pnt( p12 ).normalize
    pnt( p13 ).normalize
    pnt( p23 ).normalize
    geo no - 1 , p1 , p12 , p13
    geo no - 1 , p2 , p23 , p12
    geo no - 1 , p3 , p13 , p23
    geo no - 1 , p12 , p23 , p13
  end if
end sub

sub isoca( i as integer )
  if i < 0 then i = 0
  if i > 5 then i = 5
  glPushMatrix
  glTranslatef box.m.x , box.m.y , box.m.z 
  glScalef box.d.x , box.d.y , box.d.z
    
  setpoint  1 ,  0       ,  0 , 1.118034
  setpoint  2 ,  1       ,  0         ,  .5 
  setpoint  3 ,  .309017 ,  .95105654 ,  .5 
  setpoint  4 , -.809017 ,  .58778524 ,  .5 
  setpoint  5 , -.809017 , -.58778524 ,  .5 
  setpoint  6 ,  .309017 , -.95105654 ,  .5 
  setpoint  7 ,  .809017 ,  .58778524 , -.5 
  setpoint  8 , -.309017 ,  .95105654 , -.5 
  setpoint  9 , -1       ,  0         , -.5 
  setpoint 10 , -.309017 , -.95105654 , -.5
  setpoint 11 ,  .809017 , -.58778524 , -.5 
  setpoint 12 ,  0       ,  0         , -1.118034
  dim t as integer
  for t = 1 to 12
    pnt( t ).normalize
  next t
  geo i , 1 ,  2 , 3
  geo i , 1 ,  3 ,  4 
  geo i , 1 ,  4 ,  5 
  geo i , 1 ,  5 ,  6 
  geo i , 1 ,  6 ,  2 
  geo i , 2 ,  7 ,  3
  geo i , 3 ,  7 ,  8 
  geo i , 3 ,  8 ,  4
  geo i , 4 ,  8 ,  9 
  geo i , 4 ,  9 ,  5 
  geo i , 5 ,  9 , 10 
  geo i , 5 , 10 ,  6 
  geo i , 6 , 10 , 11 
  geo i , 6 , 11 ,  2
  geo i , 2 , 11 ,  7 
  geo i , 12 ,  8 ,  7
  geo i , 12 ,  9 ,  8
  geo i , 12 , 10 ,  9 
  geo i , 12 , 11 , 10 
  geo i , 12 ,  7 , 11 
  glPopMatrix
end sub

sub sphere( a as integer , b as integer _
, da as single , db as single )
  dim as single i , j , i2 , j2 
  dim as single x , y , z
  if a < 3 then a = 3 
  if a > 64 then a = 64
  if b < 3 then b = 3 
  if b > 64 then b = 64
  glPushMatrix
  glTranslatef box.m.x , box.m.y , box.m.z
  glScalef box.d.x , box.d.y , box.d.z
  for i = -PI to PI  step PI / a * 2 
    i2 = i + PI / a * 2 
    for j = -PI / 2 to PI / 2 - pi / b * 2 step PI / b * 2 
      j2 = j + PI / b * 2 

      x = sin( i ) * cos( j )
      y = sin( j )
      z = cos( i ) * cos( j )
      setpoint 0 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )

      x = sin( i2 ) * cos( j )
      y = sin( j )
      z = cos( i2 ) * cos( j )
      setpoint 1 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )
      
      x = sin( i2 ) * cos( j2 )
      y = sin( j2 )
      z = cos( i2 ) * cos( j2 )
      setpoint 2 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )
      
      x = sin( i ) * cos( j2 )
      y = sin( j2 )
      z = cos( i ) * cos( j2 )
      setpoint 3 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )
      
      quad 0 , 1 , 2 , 3 
    next j
  next i
  glPopMatrix
end sub

sub torus( a as integer , b as integer )
  dim i as single , j as single , i2 as single , j2 as single
  if a < 3 then a = 3 
  if a > 64 then a = 643
  if b < 3 then b = 3 
  if b > 64 then b = 64 
  dim mx as single , my as single , mz as single , dx as single , dy as single , dz as single 
  mx = box.m.x 
  my = box.m.y 
  mz = box.m.z 
  dx = box.d.x 
  dy = box.d.y 
  dz = box.d.z 
  for i = -PI to PI  step PI / a * 2 
    i2 = i + PI / a * 2 
    for j = -PI to PI step PI / b * 2 
      j2 = j + PI / b * 2 
      setpoint 0 _ 
      , mx + ( dx + dy * cos( i ) ) * cos( j ) _
      , my + ( dx + dy * cos( i ) ) * sin( j ) _
      , mz + sin( i ) * dz  
      setpoint 1 _
      , mx + ( dx + dy * cos( i ) ) * cos( j2 ) _
      , my + ( dx + dy * cos( i ) ) * sin( j2 ) _
      , mz + sin( i ) * dz 
      setpoint 2 _
      , mx + ( dx + dy * cos( i2 ) ) * cos( j2 ) _
      , my + ( dx + dy * cos( i2 ) ) * sin( j2 ) _
      , mz + sin( i2 ) * dz 
      setpoint 3 _ 
      , mx + ( dx + dy * cos( i2 ) ) * cos( j ) _
      , my + ( dx + dy * cos( i2 ) ) * sin( j ) _
      , mz + sin( i2 ) * dz 
      quad 0 , 1 , 2 , 3 
    next j
  next i
end sub

sub cilinder( sides as integer , dx as single , dy as single , top as integer , bot as integer )
  dim f as single
  if sides < 3 then sides = 3
  if sides > 64 then sides = 64
  for f = 0 to sides + 2
    setpoint f , box.m.x + sin( f * pi * 2 / sides ) * box.d.x _
               , box.m.y - box.d.y _
               , box.m.z + cos( f * pi * 2 / sides ) * box.d.z
    setpoint f + sides + 1 , box.m.x + sin( f * pi * 2 / sides ) * dx _
                           , box.m.y + box.d.y _
                           , box.m.z + 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.m.y + box.d.y , 0
    for f = 0 to sides
        setpoint f , box.m.x + sin( f * pi * 2 / sides ) * dx _
               , box.m.y + box.d.y _
               , box.m.z + 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.m.y - box.d.y , 0
    for f = 0 to sides + 2
        setpoint f , box.m.x - sin( f * pi * 2 / sides ) * box.d.x _
               , box.m.y - box.d.y _
               , box.m.z + cos( f * pi * 2 / sides ) * box.d.z  
    next f
    for f = 0 to sides + 2
      tri 255 , f , f + 1 
    next f
  end if
end sub

sub cube()
  setpoint 0 , box.m.x + box.d.x , box.m.y + box.d.y , box.m.z + box.d.z
  setpoint 1 , box.m.x + box.d.x , box.m.y + box.d.y , box.m.z - box.d.z
  setpoint 2 , box.m.x + box.d.x , box.m.y - box.d.y , box.m.z + box.d.z
  setpoint 3 , box.m.x + box.d.x , box.m.y - box.d.y , box.m.z - box.d.z
  setpoint 4 , box.m.x - box.d.x , box.m.y + box.d.y , box.m.z + box.d.z
  setpoint 5 , box.m.x - box.d.x , box.m.y + box.d.y , box.m.z - box.d.z
  setpoint 6 , box.m.x - box.d.x , box.m.y - box.d.y , box.m.z + box.d.z
  setpoint 7 , box.m.x - box.d.x , box.m.y - box.d.y , box.m.z - box.d.z
  quad 0 , 2 , 3 , 1 ''right
  quad 7 , 6 , 4 , 5 ''left
  quad 0 , 4 , 5 , 1 ''up
  quad 7 , 3 , 2 , 6 ''down
  quad 0 , 4 , 6 , 2 ''back
  quad 7 , 5 , 1 , 3 ''front
end sub

sub hcube()
  setpoint 1 , box.m.x + box.d.x , box.m.y + box.d.y , box.m.z - box.d.z
  setpoint 2 , box.m.x + box.d.x , box.m.y - box.d.y , box.m.z + box.d.z
  setpoint 3 , box.m.x + box.d.x , box.m.y - box.d.y , box.m.z - box.d.z
  setpoint 4 , box.m.x - box.d.x , box.m.y + box.d.y , box.m.z + box.d.z
  setpoint 5 , box.m.x - box.d.x , box.m.y + box.d.y , box.m.z - box.d.z
  setpoint 6 , box.m.x - box.d.x , box.m.y - box.d.y , box.m.z + box.d.z
  setpoint 7 , box.m.x - box.d.x , box.m.y - box.d.y , box.m.z - box.d.z
  
  setpoint 0 , box.m.x + box.d.x , box.m.y - box.d.y , 0
  setpoint 8 , box.m.x + box.d.x , 0 , box.m.z - box.d.z
  setpoint 9 , 0 , box.m.y + box.d.y , box.m.z - box.d.z
  setpoint 10 , box.m.x - box.d.x , box.m.x + box.d.y , 0
  setpoint 11 , box.m.x - box.d.x , 0 , box.m.z + box.d.z
  setpoint 12, 0 , box.m.y - box.d.y , box.m.z + box.d.z
  
  tri 7 , 6 , 3
  tri 7 , 5 , 6 
  tri 7 , 3 , 5 
  
  quad 6 , 5 , 10 , 11 
  quad 5 , 3 , 8 , 9 
  quad 3 , 6 , 12 , 0 
  
  tri 6 , 12 , 11 
  tri 3 , 8 , 0 
  tri 5 , 9 , 10 
end sub

sub setbox( mx as single , my as single , mz as single , dx as single , dy as single , dz as single )
  box.m.x = mx
  box.m.y = my
  box.m.z = mz
  box.d.x = dx
  box.d.y = dy
  box.d.z = dz
end sub


const as integer body = 0 
const as integer arm = 1
const as integer elbow = 2 
const as integer wrist = 3
const as integer leg = 4
const as integer knee = 5 
const as integer enkle = 6 
const as integer neck = 7
const as integer eye = 8 
const as integer ileg = 4 
const as integer iknee = 9 
const as integer wing = 14
const as integer tail = 16
const as integer sensor = 17
const as integer thumb = 18
const as integer finger = 19
const as integer lr = 32

const as integer human_walk = 1
const as integer dog_walk = 2
const as integer I_FLY = 3
const as integer I_LEFT_LEGS = 4
const as integer I_LEFT_BOX = 5
const as integer I_RIGHT_LEGS = 6
const as integer I_RIGHT_BOX = 7
const as integer I_STING = 8
const as integer I_STAND = 9

declare sub animate( anim as integer , f as single , a as single )

declare sub human()
declare sub dog()
declare sub insect()

declare sub pilko()
declare sub man()
declare sub minion()

sub animate( anim as integer , f as single , a as single )
  DIM I AS INTEGER
  select case anim
  case human_walk
    skelet arm , pend( f , a ) , 0 , 0
    skelet elbow , -abs( a ) , 0 , 0
    skelet arm + lr , pend( f + 180, a ) , 0 , 0
    skelet elbow + lr , -abs( a ) , 0 , 0
    skelet leg , pend( f + 180 , a ) , 0 , 0
    skelet knee , pend( f + 90 , a ) + a , 0 , 0
    skelet leg + lr , pend( f , a ) , 0 , 0
    skelet knee + lr , pend( f - 90 , a ) + a , 0 , 0
  case dog_walk
    skelet arm , pend( f + 180 , a ) , 0 , 0
    skelet elbow , pend( f + 90 , a ) + a , 0 , 0
    skelet arm + lr , pend( f , a ) , 0 , 0
    skelet elbow + lr , pend( f - 90 , a ) + a , 0 , 0
    skelet leg , pend( f + 180 , a ) , 0 , 0
    skelet knee , pend( f + 90 , a ) + a , 0 , 0
    skelet leg + lr , pend( f , a ) , 0 , 0
    skelet knee + lr , pend( f - 90 , a ) + a , 0 , 0
    skelet tail , -45 , pend( f * 2 , a ) , 0
    skelet neck , 0 , 0 , 0
    skelet neck + lr , 0 , 0 , 0
  Case I_FLY
    For i = 0 To 1
      skelet wing + i, 0 , 0 , Pend(f, a)
      skelet wing+lr + i, 0,0, Pend(f, -a)
    Next
  Case I_LEFT_BOX
    skelet arm, 0, Pend(f, -a) + 45 , 0
    skelet elbow, 0, Pend(f, a * 2) - 60 , 0
  Case I_LEFT_LEGS
    For i = 0 To 4
      skelet ileg + i, 0 , 0, Pend(f + i * 180, a)
      skelet iknee + i, Pend(f + i * 180 + 90, a) , 0 , 0
    Next
  Case I_RIGHT_BOX
    skelet arm+lr, 0, Pend(f, a) - 45,0
    skelet elbow+lr, 0, Pend(f, -a * 2) + 60, 0
  Case I_RIGHT_LEGS
    For i = 0 To 4
      skelet ileg+lr+ i, 0,0, Pend(f + i * 180, a)
      skelet iknee+lr + i, Pend(f + i * 180 + 90, a),0,0
    Next
  Case I_STAND
    skelet arm, 0, 45, 0
    skelet elbow, 0, -60 , 0
    skelet finger, 0, 0, 0
    skelet thumb, 0, 0, 0
    skelet arm+lr, 0, -45, 0
    skelet elbow+lr, 0, 60 , 0
    skelet finger+lr, 0, 0, 0
    skelet thumb+lr, 0, 0, 0
    skelet tail, 10, 0 , 0
    skelet tail+lr, 10, 0 , 0
  Case I_STING
    skelet tail, 10 + Pend(f, a), 0, 0
    skelet tail+lr, 10 - Pend(f, a), 0, 0
  case else
    dim i as integer
    for i = 0 to 63
      skelet i , 0,0,0
    next i
  end select
end sub

sub insect()
  Dim i as integer
glPushmatrix
  glScalef .01 , .01 , .01
  setbox 0, 0, 0, 30, 10.0, 60.0
  Cube
  For i = 0 To 4
    glPushMatrix
      child 35.0, 0.0, i * 25 - 50 , ileg + i, xyz
      setbox 30.0, 0.0, 0.0, 30.0, 5.0, 5.0
      Cube
      glPushMatrix
        child 65.0, -5.0, 0.0 , iknee + i, xyz
        setbox 0.0, -30.0, 0.0, 5.0, 30.0, 5.0
        Cube
      glPopMatrix
    glPopMatrix
    glpushMatrix
      child -35.0, 0.0, i * 25 - 50, ileg + lr + i, xyz
      setbox -30.0, 0.0, 0.0, 30.0, 5.0, 5.0
      Cube 
      glPushMatrix
        child -65.0, -5.0, 0.0 , iknee + lr + 1, xyz
        setbox 0.0, -30.0, 0.0, 5.0, 30.0, 5.0
        Cube
      glPopmatrix
    glPopMatrix
  Next
  glPushMatrix
    child 0 , 0 , -50 , tail , xyz
    For i = 0 To 9
      glPushMatrix
        child 0.0, 0.0, -30.0 , tail, xyz
        setbox 0.0, 0.0, -15.0, 10.0, 10.0, 10.0
        Cube
    Next
    for i = 0 to 8
        glPushMatrix
          child 0 , 0 , -30 , tail+lr , xyz
          cube
    next i
    for i = 0 to 8
        glPopMatrix
      glPopMatrix
    next i
  glPopMatrix
  glPushMatrix
    child 30.0, 0.0, 65.0, arm, xyz
    setbox 0.0, 0.0, 30.0, 5.0, 5.0, 30.0
    Cube
    glPushMatrix
      child 0.0, 0.0, 65.0, elbow, xyz
      Cube
      glPushmatrix
        child 0.0, 0.0, 65.0 , wrist, xyz
        glPushmatrix
          child -10.0, 0.0, 5.0 , thumb, xyz
          Cube
        glPopMatrix
        glPushMatrix
          child 5.0, 0.0, 5.0, finger, xyz
          setbox 0.0, 0.0, 30.0, 5.0, 10.0, 30.0
          Cube
        glPopMatrix
      glPopMatrix
    glPopMatrix
  glPopMatrix
  glPushMatrix
    child -30.0, 0.0, 65.0, arm + lr, xyz
    setbox 0.0, 0.0, 30.0, 5.0, 5.0, 30.0
    Cube
    glPushMatrix
      child 0.0, 0.0, 65.0, elbow +lr, xyz
      Cube
      glPushMatrix
        child 0.0, 0.0, 65.0, wrist+lr, xyz
        glPushMatrix
          child 10.0, 0.0, 5.0, thumb+lr, xyz
          Cube
        glPopMatrix
        glPushMatrix
          child -5.0, 0.0, 5.0, finger+lr, xyz
          setbox 0.0, 0.0, 30.0, 5.0, 10.0, 30.0
          Cube
        glPopMatrix
      glPopMatrix
    glPopMatrix
   glPopMatrix
   For i = 0 To 1
     glPushMatrix
       child 20.0, 20.0, 40.0 - 50.0 * i, wing + i, xyz
       setbox 60.0, 0.0, 8.0, 60.0, 2.0, 16.0
       Cube
     glPopMatrix
     glPushMatrix
       child -20.0, 20.0, 40.0 - 50.0 * i , wing+lr + i,  xyz
       setbox -60.0, 0.0, 8.0, 60.0, 2.0, 16.0
       Cube
     glPopmatrix
   Next
glPopMatrix
end sub

sub human()
  setbox  0 , 0 , 0  ,  .5 , .1 , .1
  cube 
  setbox 0 , .75 , 0 , .1 , .5 , .1
  cube 
  setbox 0 , 1.8 , 0 , .2 , .2 , .2
  cube 
  setbox 0 , 1.4 , 0 , .7 , .1 , .1
  cube 
  glPushMatrix
    child .45 , 0 , 0 , leg , zyx
    setbox 0 , -.6 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , knee , xyz
      cube 
      glPushMatrix
        child 0 , -1.2 , 0 , enkle , xyz
        setbox 0 , 0 , .2 , .1 , .1 , .3
        cube 
      glPopMatrix
    glPopMatrix
  glPopMatrix
  glPushMatrix
    child -.45 , 0 , 0 , leg + lr , zyx
    setbox 0 , -.6 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , knee + lr , xyz
      cube 
      glPushMatrix
        child 0 , -1.2 , 0 , enkle + lr , xyz 
        setbox 0 , 0 , .2 , .1 , .1 , .3
        cube 
      glPopMatrix
    glPopMatrix
  glPopMatrix
  glPushMatrix
    child .65 , 1.3 , 0 , arm , xyz
    setbox 0 , -.5 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , elbow , xyz
      cube 
      glPushMatrix
        child 0 , -1 , 0 , wrist , zyx
        setbox 0 , -.3 , 0 , .05 , .2 , .15
        cube
      glPopMatrix
    glPopMatrix
  glPopMatrix
  glPushMatrix
    child -.65 , 1.3 , 0 , arm + lr , xyz
    setbox 0 , -.5 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , elbow + lr , xyz
      cube 
      glPushMatrix
        child 0 , -1 , 0 , wrist + lr , zyx
        setbox 0 , -.3 , 0 , .05 , .2 , .15
        cube 
      glPopMatrix
    glPopMatrix
  glPopMatrix
end sub

sub dog()
  setbox 0,.2,.5 , .3,.3,.7
  cube
  glpushmatrix
    child 0 , .6 , 1.5 , neck , xyz
    glpushmatrix
      child 0 , 0 , 0 , neck + lr , zyx
      setbox 0,0,0 , .3 , .3 , .3
      cube
      setbox 0,-.2,.3 , .2,.2,.2
      cube
      setbox 0,0,.5 , .1,.1,.1
      cube
      setbox .3,-.15,0 , .05,.3,.2
      cube
      setbox -.3,-.15,0 , .05,.3,.2
      cube
    glpopmatrix
  glpopmatrix
  glpushmatrix
    child 0 , .4 , -.5 , tail , yzx
    setbox 0,.3,0 , .1 , .3 , .1
    cube
  glpopmatrix
  glPushMatrix
    child .3 , 0 , 1 , leg , zyx
    setbox 0 , -.6 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , knee , xyz
      cube 
      glPushMatrix
        child 0 , -1.2 , 0 , enkle , xyz
        setbox 0 , 0 , .2 , .1 , .1 , .3
        cube 
      glPopMatrix
    glPopMatrix
  glPopMatrix
  glPushMatrix
    child -.3 , 0 , 1 , leg + lr, zyx
    setbox 0 , -.6 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , knee + lr, xyz
      cube 
      glPushMatrix
        child 0 , -1.2 , 0 , enkle + lr, xyz
        setbox 0 , 0 , .2 , .1 , .1 , .3
        cube 
      glPopMatrix
    glPopMatrix
  glPopMatrix
  glPushMatrix
    child .3 , 0 , 0 , arm , zyx
    setbox 0 , -.6 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , elbow , xyz
      cube 
      glPushMatrix
        child 0 , -1.2 , 0 , wrist , xyz
        setbox 0 , 0 , .2 , .1 , .1 , .3
        cube 
      glPopMatrix
    glPopMatrix
  glPopMatrix
  glPushMatrix
    child -.3 , 0 , 0 , arm + lr , zyx
    setbox 0 , -.6 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , elbow + lr , xyz
      cube 
      glPushMatrix
        child 0 , -1.2 , 0 , wrist + lr , xyz
        setbox 0 , 0 , .2 , .1 , .1 , .3
        cube 
      glPopMatrix
    glPopMatrix
  glPopMatrix
end sub

#endif

[integer]

program would not compile.

Code: Select all

#include "_OPEN-GL.bas" 

Where is this program?
Could not find it in the forum search (naturally)
Is this the same as in the examples sub directory called: fbgfx_opengl.bas

[fxm]

program would not compile.

Code: Select all

#include "_OPEN-GL.bas" 

Where is this program?

In the same post, the code just below the caller I suppose!

[grindstone]

In the same post, the code just below the caller I suppose!

You're supposing correct.

[integer]

In the same post, the code just below the caller I suppose!

You're supposing correct.

That is correct!
There seems to be a modified version in each post.

[bluatigro]

@ al :
_open_gl.bas wil only be posted if there is a new vwerion

update :
sub hand added

Code: Select all

''bluatigro 30 jan 2017
''opengl lib test 4
''animated hand

#include "_open-gl.bas"

dim as single hoek
dim as integer i

do
  glClear GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT

  glLoadIdentity
  glTranslatef 0 , 0 , -10
  glrotatef -70 , 1,0,0
  glrotatef pend( hoek,30) , 0,1,0
  glscalef 3,3,3
  skelet thumb , pend(hoek+60,20) -30,0,0
  for i = 0 to 2
    skelet index_finger + i, 0,0,pend(hoek,15)-15
    skelet mid_finger + i , 0,0,pend(hoek-60,15)-15
    skelet ring_finger + i , 0,0,pend(hoek-120,15)-15
  next i
  hand white , 0

  hoek += 10
  sleep 40
  flip
loop until inkey = chr( 27 )

Code: Select all

''bluatigro 30 jan 2017
''_open-gl.bas 

#ifndef OPENGL_H
#define OPENGL_H

''VECTOR3D

type t3d
  x as single
  y as single
  z as single
  declare constructor()
  declare constructor ( x as single , y as single, z as single )
  declare sub fill( x as single , y as single , z as single )
  declare sub normalize
end type
constructor t3d()
  this.x = 0
  this.y = 0
  this.z = 0
end constructor 
constructor t3d( x as single , y as single , z as single )
  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 single ) 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 single ) as t3d
  return type( a.x / d , a.y / d , a.z / d )
end operator
sub t3d.fill( x as single , y as single , z as single )
  this.x = x
  this.y = y
  this.z = z
end sub
declare function dot( a as t3d , b as t3d ) as single
function dot( a as t3d , b as t3d ) as single
  return a.x * b.x + a.y * b.y + a.z * b.z
end function
declare function length( q as t3d ) as single
function length( q as t3d ) as single
   return sqr( q.x * q.x + q.y * q.y + q.z * q.z ) + 1e-7
end function  
declare function anlge( a as t3d , b as t3d ) as single
function getangle( a as t3d , b as t3d ) as single
  return acos( dot( a , b ) _
  / ( length( a ) * length( b ) ) )
end function
sub t3d.normalize
  this /= length( this )
end sub

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

''MATH

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

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

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

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

sub rotate( byref k as single , byref l as single , deg as single )
  dim as single 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

''3DENGINE

declare sub child( x as single , y as single , z as single , ax as integer , lim as integer )
declare function pend( fase as single , amp as single ) as single
declare sub skelet( no as integer , x as single , y as single , z as single )
dim shared sk( 63 ) as t3d

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 single , y as single , z as single , lim as integer , ax as integer )
  glTranslatef x , y , z
  select case ax
    case xyz
      glRotatef sk( lim ).x , 1 , 0 , 0
      glRotatef sk( lim ).y , 0 , 1 , 0
      glRotatef sk( lim ).z , 0 , 0 , 1
    case xzy
      glRotatef sk( lim ).x , 1 , 0 , 0
      glRotatef sk( lim ).z , 0 , 0 , 1
      glRotatef sk( lim ).y , 0 , 1 , 0
    case yxz
      glRotatef sk( lim ).y , 0 , 1 , 0
      glRotatef sk( lim ).x , 1 , 0 , 0
      glRotatef sk( lim ).z , 0 , 0 , 1
    case yzx
      glRotatef sk( lim ).y , 0 , 1 , 0
      glRotatef sk( lim ).z , 0 , 0 , 1
      glRotatef sk( lim ).x , 1 , 0 , 0
    case zxy
      glRotatef sk( lim ).z , 0 , 0 , 1
      glRotatef sk( lim ).x , 1 , 0 , 0
      glRotatef sk( lim ).y , 0 , 1 , 0
    case zyx
      glRotatef sk( lim ).z , 0 , 0 , 1
      glRotatef sk( lim ).y , 0 , 1 , 0
      glRotatef sk( lim ).x , 1 , 0 , 0
    case else
  end select  
end sub

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

sub skelet( no as integer , x as single , y as single , z as single )
  sk( no and 63 ).x = x 
  sk( no and 63 ).y = y
  sk( no and 63 ).z = z
end sub

screen 20, 32, , 2

#include "fbgfx.bi"
#if __FB_LANG__ = "fb"
  Using FB 
#endif
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.5, 0.5                '' Blue 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 ) = { 0 , 50 , 0 , 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 t_4d
  dim as single x , y , z , w
  declare sub fill( nx as single , ny as single , nz as single , nw as single )
end type
sub t_4d.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 t_4d 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 t_4d , f as single , b as t_4d ) as t_4d 
  dim uit as t_4d
  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

function rainbow( f as single ) as t_4d
  dim uit as t_4d
  uit.x = sin( rad( f ) ) / 2 + .5
  uit.y = sin( rad( f - 120 ) ) / 2 + .5
  uit.z = sin( rad( f + 120 ) ) / 2 + .5
  uit.w = 1
  return uit
end function  

''MATERIAL

type t_material
  dim as t_4d 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

''PRIMATIVS

dim shared as t3d pnt( 256 )

sub setpoint( no as integer , x as single , y as single , z as single )
  if no < 0 or no > 255 then exit sub
  pnt( no ).x = x
  pnt( no ).y = y
  pnt( no ).z = 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 t3d n = ( pnt( p2 ) - pnt( p1 ) ) _
               \ ( pnt( p3 ) - pnt( p1 ) )
  n.normalize()
  glbegin gl_triangles
    glnormal3f n.x , n.y , n.z
    glvertex3f pnt( p1 ).x , pnt( p1 ).y , pnt( p1 ).z
    glvertex3f pnt( p2 ).x , pnt( p2 ).y , pnt( p2 ).z
    glvertex3f 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 t3d zp = ( pnt( p1 ) + pnt( p2 ) _
  + pnt( p3 ) + pnt( p4 ) ) / 4
  dim as t3d n = ( pnt( p2 ) - zp ) _
               \ ( pnt( p3 ) - zp )
  n.normalize()
  glbegin gl_quads
    glnormal3f n.x , n.y , n.z
    glvertex3f pnt( p1 ).x , pnt( p1 ).y , pnt( p1 ).z
    glvertex3f pnt( p2 ).x , pnt( p2 ).y , pnt( p2 ).z
    glvertex3f pnt( p3 ).x , pnt( p3 ).y , pnt( p3 ).z
    glvertex3f pnt( p4 ).x , pnt( p4 ).y , pnt( p4 ).z
  glend 
end sub

''SHAPES

type Tbox
  m as t3d
  d as t3d
end type
dim shared box as Tbox

declare sub isoca( i as integer )
declare sub sphere( h as integer , r as integer _
, a as single , b as single )
declare sub hsphere( h as integer , r as integer _
, t as integer , a as single , b as single )
declare sub torus( hsides as integer , rsides as integer )
declare sub cilinder( sides as integer _
, dx as single , dy as single , top as integer , bot as integer ) 
declare sub cube( )
declare sub hcube( )
declare sub setbox( mx as single , my as single _
, mz as single , dx as single , dy as single , dz as single )
declare sub geo( no as integer , p1 as integer _
, p2 as integer , p3 as integer )

sub geo( no as integer , p1 as integer _
, p2 as integer , p3 as integer )
  if no < 1 then 
    tri p1 , p2 , p3 
  else
  dim p12 as integer , p13 as integer , p23 as integer
    p12 = 255 - no * 3
    p13 = 255 - no * 3 - 1
    p23 = 255 - no * 3 - 2
    pnt( p12 ) = ( pnt( p1 ) + pnt( p2 ) ) / 2
    pnt( p13 ) = ( pnt( p1 ) + pnt( p3 ) ) / 2
    pnt( p23 ) = ( pnt( p2 ) + pnt( p3 ) ) / 2
    pnt( p12 ).normalize
    pnt( p13 ).normalize
    pnt( p23 ).normalize
    geo no - 1 , p1 , p12 , p13
    geo no - 1 , p2 , p23 , p12
    geo no - 1 , p3 , p13 , p23
    geo no - 1 , p12 , p23 , p13
  end if
end sub

sub isoca( i as integer )
  if i < 0 then i = 0
  if i > 5 then i = 5
  glPushMatrix
  glTranslatef box.m.x , box.m.y , box.m.z 
  glScalef box.d.x , box.d.y , box.d.z
    
  setpoint  1 ,  0       ,  0 , 1.118034
  setpoint  2 ,  1       ,  0         ,  .5 
  setpoint  3 ,  .309017 ,  .95105654 ,  .5 
  setpoint  4 , -.809017 ,  .58778524 ,  .5 
  setpoint  5 , -.809017 , -.58778524 ,  .5 
  setpoint  6 ,  .309017 , -.95105654 ,  .5 
  setpoint  7 ,  .809017 ,  .58778524 , -.5 
  setpoint  8 , -.309017 ,  .95105654 , -.5 
  setpoint  9 , -1       ,  0         , -.5 
  setpoint 10 , -.309017 , -.95105654 , -.5
  setpoint 11 ,  .809017 , -.58778524 , -.5 
  setpoint 12 ,  0       ,  0         , -1.118034
  dim t as integer
  for t = 1 to 12
    pnt( t ).normalize
  next t
  geo i , 1 ,  2 , 3
  geo i , 1 ,  3 ,  4 
  geo i , 1 ,  4 ,  5 
  geo i , 1 ,  5 ,  6 
  geo i , 1 ,  6 ,  2 
  geo i , 2 ,  7 ,  3
  geo i , 3 ,  7 ,  8 
  geo i , 3 ,  8 ,  4
  geo i , 4 ,  8 ,  9 
  geo i , 4 ,  9 ,  5 
  geo i , 5 ,  9 , 10 
  geo i , 5 , 10 ,  6 
  geo i , 6 , 10 , 11 
  geo i , 6 , 11 ,  2
  geo i , 2 , 11 ,  7 
  geo i , 12 ,  8 ,  7
  geo i , 12 ,  9 ,  8
  geo i , 12 , 10 ,  9 
  geo i , 12 , 11 , 10 
  geo i , 12 ,  7 , 11 
  glPopMatrix
end sub

sub sphere( a as integer , b as integer _
, da as single , db as single )
  dim as single i , j , i2 , j2 
  dim as single x , y , z
  if a < 3 then a = 3 
  if a > 64 then a = 64
  if b < 3 then b = 3 
  if b > 64 then b = 64
  glPushMatrix
  glTranslatef box.m.x , box.m.y , box.m.z
  glScalef box.d.x , box.d.y , box.d.z
  for i = -PI to PI  step PI / a * 2 
    i2 = i + PI / a * 2 
    for j = -PI / 2 to PI / 2 - pi / b * 2 step PI / b * 2 
      j2 = j + PI / b * 2 

      x = sin( i ) * cos( j )
      y = sin( j )
      z = cos( i ) * cos( j )
      setpoint 0 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )

      x = sin( i2 ) * cos( j )
      y = sin( j )
      z = cos( i2 ) * cos( j )
      setpoint 1 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )
      
      x = sin( i2 ) * cos( j2 )
      y = sin( j2 )
      z = cos( i2 ) * cos( j2 )
      setpoint 2 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )
      
      x = sin( i ) * cos( j2 )
      y = sin( j2 )
      z = cos( i ) * cos( j2 )
      setpoint 3 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )
      
      quad 0 , 1 , 2 , 3 
    next j
  next i
  glPopMatrix
end sub

sub hsphere( a as integer , b as integer _
, t as integer , da as single , db as single )
  dim as single i , j , i2 , j2 
  dim as single x , y , z
  if a < 3 then a = 3 
  if a > 64 then a = 64
  if b < 3 then b = 3 
  if b > 64 then b = 64
  glPushMatrix
  glTranslatef box.m.x , box.m.y , box.m.z
  glScalef box.d.x , box.d.y , box.d.z
  for i = -PI to PI  step PI / a * 2 
    i2 = i + PI / a * 2 
    for j = -PI / 2 to t * pi / b / 2 - pi / b * 2 step PI / b * 2 
      j2 = j + PI / b * 2 

      x = sin( i ) * cos( j )
      y = sin( j )
      z = cos( i ) * cos( j )
      setpoint 0 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )

      x = sin( i2 ) * cos( j )
      y = sin( j )
      z = cos( i2 ) * cos( j )
      setpoint 1 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )
      
      x = sin( i2 ) * cos( j2 )
      y = sin( j2 )
      z = cos( i2 ) * cos( j2 )
      setpoint 2 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )
      
      x = sin( i ) * cos( j2 )
      y = sin( j2 )
      z = cos( i ) * cos( j2 )
      setpoint 3 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )
      
      quad 0 , 1 , 2 , 3 
    next j
  next i
  glPopMatrix
end sub

sub torus( a as integer , b as integer )
  dim i as single , j as single , i2 as single , j2 as single
  if a < 3 then a = 3 
  if a > 64 then a = 643
  if b < 3 then b = 3 
  if b > 64 then b = 64 
  dim mx as single , my as single , mz as single , dx as single , dy as single , dz as single 
  mx = box.m.x 
  my = box.m.y 
  mz = box.m.z 
  dx = box.d.x 
  dy = box.d.y 
  dz = box.d.z 
  for i = -PI to PI  step PI / a * 2 
    i2 = i + PI / a * 2 
    for j = -PI to PI step PI / b * 2 
      j2 = j + PI / b * 2 
      setpoint 0 _ 
      , mx + ( dx + dy * cos( i ) ) * cos( j ) _
      , my + ( dx + dy * cos( i ) ) * sin( j ) _
      , mz + sin( i ) * dz  
      setpoint 1 _
      , mx + ( dx + dy * cos( i ) ) * cos( j2 ) _
      , my + ( dx + dy * cos( i ) ) * sin( j2 ) _
      , mz + sin( i ) * dz 
      setpoint 2 _
      , mx + ( dx + dy * cos( i2 ) ) * cos( j2 ) _
      , my + ( dx + dy * cos( i2 ) ) * sin( j2 ) _
      , mz + sin( i2 ) * dz 
      setpoint 3 _ 
      , mx + ( dx + dy * cos( i2 ) ) * cos( j ) _
      , my + ( dx + dy * cos( i2 ) ) * sin( j ) _
      , mz + sin( i2 ) * dz 
      quad 0 , 1 , 2 , 3 
    next j
  next i
end sub

sub cilinder( sides as integer , dx as single , dy as single , top as integer , bot as integer )
  dim f as single
  if sides < 3 then sides = 3
  if sides > 64 then sides = 64
  for f = 0 to sides + 2
    setpoint f , box.m.x + sin( f * pi * 2 / sides ) * box.d.x _
               , box.m.y - box.d.y _
               , box.m.z + cos( f * pi * 2 / sides ) * box.d.z
    setpoint f + sides + 1 , box.m.x + sin( f * pi * 2 / sides ) * dx _
                           , box.m.y + box.d.y _
                           , box.m.z + 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.m.y + box.d.y , 0
    for f = 0 to sides
        setpoint f , box.m.x + sin( f * pi * 2 / sides ) * dx _
               , box.m.y + box.d.y _
               , box.m.z + 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.m.y - box.d.y , 0
    for f = 0 to sides + 2
        setpoint f , box.m.x - sin( f * pi * 2 / sides ) * box.d.x _
               , box.m.y - box.d.y _
               , box.m.z + cos( f * pi * 2 / sides ) * box.d.z  
    next f
    for f = 0 to sides + 2
      tri 255 , f , f + 1 
    next f
  end if
end sub

sub cube()
  setpoint 0 , box.m.x + box.d.x , box.m.y + box.d.y , box.m.z + box.d.z
  setpoint 1 , box.m.x + box.d.x , box.m.y + box.d.y , box.m.z - box.d.z
  setpoint 2 , box.m.x + box.d.x , box.m.y - box.d.y , box.m.z + box.d.z
  setpoint 3 , box.m.x + box.d.x , box.m.y - box.d.y , box.m.z - box.d.z
  setpoint 4 , box.m.x - box.d.x , box.m.y + box.d.y , box.m.z + box.d.z
  setpoint 5 , box.m.x - box.d.x , box.m.y + box.d.y , box.m.z - box.d.z
  setpoint 6 , box.m.x - box.d.x , box.m.y - box.d.y , box.m.z + box.d.z
  setpoint 7 , box.m.x - box.d.x , box.m.y - box.d.y , box.m.z - box.d.z
  quad 0 , 2 , 3 , 1 ''right
  quad 7 , 6 , 4 , 5 ''left
  quad 0 , 4 , 5 , 1 ''up
  quad 7 , 3 , 2 , 6 ''down
  quad 0 , 4 , 6 , 2 ''back
  quad 7 , 5 , 1 , 3 ''front
end sub

sub hcube()
  setpoint 1 , box.m.x + box.d.x , box.m.y + box.d.y , box.m.z - box.d.z
  setpoint 2 , box.m.x + box.d.x , box.m.y - box.d.y , box.m.z + box.d.z
  setpoint 3 , box.m.x + box.d.x , box.m.y - box.d.y , box.m.z - box.d.z
  setpoint 4 , box.m.x - box.d.x , box.m.y + box.d.y , box.m.z + box.d.z
  setpoint 5 , box.m.x - box.d.x , box.m.y + box.d.y , box.m.z - box.d.z
  setpoint 6 , box.m.x - box.d.x , box.m.y - box.d.y , box.m.z + box.d.z
  setpoint 7 , box.m.x - box.d.x , box.m.y - box.d.y , box.m.z - box.d.z
  
  setpoint 0 , box.m.x + box.d.x , box.m.y - box.d.y , 0
  setpoint 8 , box.m.x + box.d.x , 0 , box.m.z - box.d.z
  setpoint 9 , 0 , box.m.y + box.d.y , box.m.z - box.d.z
  setpoint 10 , box.m.x - box.d.x , box.m.x + box.d.y , 0
  setpoint 11 , box.m.x - box.d.x , 0 , box.m.z + box.d.z
  setpoint 12, 0 , box.m.y - box.d.y , box.m.z + box.d.z
  
  tri 7 , 6 , 3
  tri 7 , 5 , 6 
  tri 7 , 3 , 5 
  
  quad 6 , 5 , 10 , 11 
  quad 5 , 3 , 8 , 9 
  quad 3 , 6 , 12 , 0 
  
  tri 6 , 12 , 11 
  tri 3 , 8 , 0 
  tri 5 , 9 , 10 
end sub

sub setbox( mx as single , my as single , mz as single , dx as single , dy as single , dz as single )
  box.m.x = mx
  box.m.y = my
  box.m.z = mz
  box.d.x = dx
  box.d.y = dy
  box.d.z = dz
end sub


const as integer body = 0 
const as integer arm = 1
const as integer elbow = 2 
const as integer wrist = 3
const as integer leg = 4
const as integer knee = 5 
const as integer enkle = 6 
const as integer neck = 7
const as integer eye = 8 
const as integer ileg = 4 
const as integer iknee = 9 
const as integer wing = 14
const as integer tail = 16
const as integer sensor = 17
const as integer thumb = 18
const as integer finger = 19
const as integer index_finger = 21
const as integer mid_finger = 24
const as integer ring_finger = 27
const as integer ear = 30
const as integer wenk = 31
const as integer lr = 32

const as integer human_walk = 1
const as integer dog_walk = 2
const as integer I_FLY = 3
const as integer I_LEFT_LEGS = 4
const as integer I_LEFT_BOX = 5
const as integer I_RIGHT_LEGS = 6
const as integer I_RIGHT_BOX = 7
const as integer I_STING = 8
const as integer I_STAND = 9

sub animate( anim as integer , f as single , a as single )
  DIM I AS INTEGER
  select case anim
  case human_walk
    skelet arm , pend( f , a ) , 0 , 0
    skelet elbow , -abs( a ) , 0 , 0
    skelet arm + lr , pend( f + 180, a ) , 0 , 0
    skelet elbow + lr , -abs( a ) , 0 , 0
    skelet leg , pend( f + 180 , a ) , 0 , 0
    skelet knee , pend( f + 90 , a ) + a , 0 , 0
    skelet leg + lr , pend( f , a ) , 0 , 0
    skelet knee + lr , pend( f - 90 , a ) + a , 0 , 0
  case dog_walk
    skelet arm , pend( f + 180 , a ) , 0 , 0
    skelet elbow , pend( f + 90 , a ) + a , 0 , 0
    skelet arm + lr , pend( f , a ) , 0 , 0
    skelet elbow + lr , pend( f - 90 , a ) + a , 0 , 0
    skelet leg , pend( f + 180 , a ) , 0 , 0
    skelet knee , pend( f + 90 , a ) + a , 0 , 0
    skelet leg + lr , pend( f , a ) , 0 , 0
    skelet knee + lr , pend( f - 90 , a ) + a , 0 , 0
    skelet tail , -45 , pend( f * 2 , a ) , 0
    skelet neck , 0 , 0 , 0
    skelet neck + lr , 0 , 0 , 0
  Case I_FLY
    For i = 0 To 1
      skelet wing + i, 0 , 0 , Pend(f, a)
      skelet wing+lr + i, 0,0, Pend(f, -a)
    Next
  Case I_LEFT_BOX
    skelet arm, 0, Pend(f, -a) + 45 , 0
    skelet elbow, 0, Pend(f, a * 2) - 60 , 0
  Case I_LEFT_LEGS
    For i = 0 To 4
      skelet ileg + i, 0 , 0, Pend(f + i * 180, a)
      skelet iknee + i, Pend(f + i * 180 + 90, a) , 0 , 0
    Next
  Case I_RIGHT_BOX
    skelet arm+lr, 0, Pend(f, a) - 45,0
    skelet elbow+lr, 0, Pend(f, -a * 2) + 60, 0
  Case I_RIGHT_LEGS
    For i = 0 To 4
      skelet ileg+lr+ i, 0,0, Pend(f + i * 180, a)
      skelet iknee+lr + i, Pend(f + i * 180 + 90, a),0,0
    Next
  Case I_STAND
    skelet arm, 0, 45, 0
    skelet elbow, 0, -60 , 0
    skelet finger, 0, 0, 0
    skelet thumb, 0, 0, 0
    skelet arm+lr, 0, -45, 0
    skelet elbow+lr, 0, 60 , 0
    skelet finger+lr, 0, 0, 0
    skelet thumb+lr, 0, 0, 0
    skelet tail, 10, 0 , 0
    skelet tail+lr, 10, 0 , 0
  Case I_STING
    skelet tail, 10 + Pend(f, a), 0, 0
    skelet tail+lr, 10 - Pend(f, a), 0, 0
  case else
    dim i as integer
    for i = 0 to 63
      skelet i , 0,0,0
    next i
  end select
end sub

sub insect()
  Dim i as integer
glPushmatrix
  glScalef .01 , .01 , .01
  setbox 0, 0, 0, 30, 10.0, 60.0
  Cube
  For i = 0 To 4
    glPushMatrix
      child 35.0, 0.0, i * 25 - 50 , ileg + i, xyz
      setbox 30.0, 0.0, 0.0, 30.0, 5.0, 5.0
      Cube
      glPushMatrix
        child 65.0, -5.0, 0.0 , iknee + i, xyz
        setbox 0.0, -30.0, 0.0, 5.0, 30.0, 5.0
        Cube
      glPopMatrix
    glPopMatrix
    glpushMatrix
      child -35.0, 0.0, i * 25 - 50, ileg + lr + i, xyz
      setbox -30.0, 0.0, 0.0, 30.0, 5.0, 5.0
      Cube 
      glPushMatrix
        child -65.0, -5.0, 0.0 , iknee + lr + 1, xyz
        setbox 0.0, -30.0, 0.0, 5.0, 30.0, 5.0
        Cube
      glPopmatrix
    glPopMatrix
  Next
  glPushMatrix
    child 0 , 0 , -50 , tail , xyz
    For i = 0 To 9
      glPushMatrix
        child 0.0, 0.0, -30.0 , tail, xyz
        setbox 0.0, 0.0, -15.0, 10.0, 10.0, 10.0
        Cube
    Next
    for i = 0 to 8
        glPushMatrix
          child 0 , 0 , -30 , tail+lr , xyz
          cube
    next i
    for i = 0 to 8
        glPopMatrix
      glPopMatrix
    next i
  glPopMatrix
  glPushMatrix
    child 30.0, 0.0, 65.0, arm, xyz
    setbox 0.0, 0.0, 30.0, 5.0, 5.0, 30.0
    Cube
    glPushMatrix
      child 0.0, 0.0, 65.0, elbow, xyz
      Cube
      glPushmatrix
        child 0.0, 0.0, 65.0 , wrist, xyz
        glPushmatrix
          child -10.0, 0.0, 5.0 , thumb, xyz
          Cube
        glPopMatrix
        glPushMatrix
          child 5.0, 0.0, 5.0, finger, xyz
          setbox 0.0, 0.0, 30.0, 5.0, 10.0, 30.0
          Cube
        glPopMatrix
      glPopMatrix
    glPopMatrix
  glPopMatrix
  glPushMatrix
    child -30.0, 0.0, 65.0, arm + lr, xyz
    setbox 0.0, 0.0, 30.0, 5.0, 5.0, 30.0
    Cube
    glPushMatrix
      child 0.0, 0.0, 65.0, elbow +lr, xyz
      Cube
      glPushMatrix
        child 0.0, 0.0, 65.0, wrist+lr, xyz
        glPushMatrix
          child 10.0, 0.0, 5.0, thumb+lr, xyz
          Cube
        glPopMatrix
        glPushMatrix
          child -5.0, 0.0, 5.0, finger+lr, xyz
          setbox 0.0, 0.0, 30.0, 5.0, 10.0, 30.0
          Cube
        glPopMatrix
      glPopMatrix
    glPopMatrix
   glPopMatrix
   For i = 0 To 1
     glPushMatrix
       child 20.0, 20.0, 40.0 - 50.0 * i, wing + i, xyz
       setbox 60.0, 0.0, 8.0, 60.0, 2.0, 16.0
       Cube
     glPopMatrix
     glPushMatrix
       child -20.0, 20.0, 40.0 - 50.0 * i , wing+lr + i,  xyz
       setbox -60.0, 0.0, 8.0, 60.0, 2.0, 16.0
       Cube
     glPopmatrix
   Next
glPopMatrix
end sub

sub kootjes( f as integer )
  setbox 0,-.2,0 , .1,.1,.1
  cube
  glpushmatrix
    child 0,-.2,0 , f + 1 , xyz
    cube
    glpushmatrix
      child 0,-.2,0 , f + 2 , xyz
      cube
    glpopmatrix
  glpopmatrix
end sub

sub hand( kl as t_4d , i as integer )
  material.diffuse = kl
  setmaterial gl_front , material
  glpushmatrix
    setbox 0,-.3,0 , .1,.3,.3
    cube
    glpushmatrix
      child 0,-.6,.2 , index_finger + i , xyz
      kootjes index_finger + i
    glpopmatrix
    glpushmatrix
      child 0,-.6,0 , mid_finger + i , xyz
      kootjes mid_finger + i
    glpopmatrix
    glpushmatrix
      child 0,-.6,-.2 , ring_finger + i , xyz
      kootjes ring_finger + i
    glpopmatrix
    glpushmatrix
      child 0,-.2,.4 , thumb + i , xyz
      kootjes thumb + i
    glpopmatrix
  glpopmatrix
end sub

sub human( kl as t_4d )
  material.diffuse = kl
  setmaterial gl_front , material
  setbox  0 , 0 , 0  ,  .5 , .1 , .1
  cube 
  setbox 0 , .75 , 0 , .1 , .5 , .1
  cube 
  setbox 0 , 1.8 , 0 , .2 , .2 , .2
  cube 
  setbox 0 , 1.4 , 0 , .7 , .1 , .1
  cube 
  glPushMatrix
    child .45 , 0 , 0 , leg , zyx
    setbox 0 , -.6 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , knee , xyz
      cube 
      glPushMatrix
        child 0 , -1.2 , 0 , enkle , xyz
        setbox 0 , 0 , .2 , .1 , .1 , .3
        cube 
      glPopMatrix
    glPopMatrix
  glPopMatrix
  glPushMatrix
    child -.45 , 0 , 0 , leg + lr , zyx
    setbox 0 , -.6 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , knee + lr , xyz
      cube 
      glPushMatrix
        child 0 , -1.2 , 0 , enkle + lr , xyz 
        setbox 0 , 0 , .2 , .1 , .1 , .3
        cube 
      glPopMatrix
    glPopMatrix
  glPopMatrix
  glPushMatrix
    child .65 , 1.3 , 0 , arm , xyz
    setbox 0 , -.5 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , elbow , xyz
      cube 
      glPushMatrix
        child 0 , -1 , 0 , wrist , zyx
        glscalef .5,.5,.5
        hand white , 0
      glPopMatrix
    glPopMatrix
  glPopMatrix
  material.diffuse = kl
  setmaterial gl_front , material  
  glPushMatrix
    child -.65 , 1.3 , 0 , arm + lr , xyz
    setbox 0 , -.5 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , elbow + lr , xyz
      cube 
      glPushMatrix
        child 0 , -1 , 0 , wrist + lr , zyx
        glscalef .5,.5,.5
        hand white , lr
      glPopMatrix
    glPopMatrix
  glPopMatrix
end sub

sub dog()
  setbox 0,.2,.5 , .3,.3,.7
  cube
  glpushmatrix
    child 0 , .6 , 1.5 , neck , xyz
    glpushmatrix
      child 0 , 0 , 0 , neck + lr , zyx
      setbox 0,0,0 , .3 , .3 , .3
      cube
      setbox 0,-.2,.3 , .2,.2,.2
      cube
      setbox 0,0,.5 , .1,.1,.1
      cube
      setbox .3,-.15,0 , .05,.3,.2
      cube
      setbox -.3,-.15,0 , .05,.3,.2
      cube
    glpopmatrix
  glpopmatrix
  glpushmatrix
    child 0 , .4 , -.5 , tail , yzx
    setbox 0,.3,0 , .1 , .3 , .1
    cube
  glpopmatrix
  glPushMatrix
    child .3 , 0 , 1 , leg , zyx
    setbox 0 , -.6 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , knee , xyz
      cube 
      glPushMatrix
        child 0 , -1.2 , 0 , enkle , xyz
        setbox 0 , 0 , .2 , .1 , .1 , .3
        cube 
      glPopMatrix
    glPopMatrix
  glPopMatrix
  glPushMatrix
    child -.3 , 0 , 1 , leg + lr, zyx
    setbox 0 , -.6 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , knee + lr, xyz
      cube 
      glPushMatrix
        child 0 , -1.2 , 0 , enkle + lr, xyz
        setbox 0 , 0 , .2 , .1 , .1 , .3
        cube 
      glPopMatrix
    glPopMatrix
  glPopMatrix
  glPushMatrix
    child .3 , 0 , 0 , arm , zyx
    setbox 0 , -.6 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , elbow , xyz
      cube 
      glPushMatrix
        child 0 , -1.2 , 0 , wrist , xyz
        setbox 0 , 0 , .2 , .1 , .1 , .3
        cube 
      glPopMatrix
    glPopMatrix
  glPopMatrix
  glPushMatrix
    child -.3 , 0 , 0 , arm + lr , zyx
    setbox 0 , -.6 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , elbow + lr , xyz
      cube 
      glPushMatrix
        child 0 , -1.2 , 0 , wrist + lr , xyz
        setbox 0 , 0 , .2 , .1 , .1 , .3
        cube 
      glPopMatrix
    glPopMatrix
  glPopMatrix
end sub

#endif

[bluatigro]

i m trying to get text
see subs digit() and text() in _open-gl.bas

main

Code: Select all

''bluatigro 3 feb 2017
''opengl lib test 5
''animated text

#include "_open-gl.bas"

dim as single hoek
dim as integer i

material.diffuse = yellow
setmaterial gl_front , material

do
  glClear GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT

  glLoadIdentity
  glTranslatef 0 , 0 , -10
  glrotatef hoek , 0,1,0
  text "GAME OVER"

  hoek += 10
  sleep 40
  flip
loop until inkey = chr( 27 )
  

_open-gl.bas

Code: Select all

''bluatigro 3 feb 2017
''_open-gl.bas 

#ifndef OPENGL_H
#define OPENGL_H

''VECTOR3D

type t3d
  x as single
  y as single
  z as single
  declare constructor()
  declare constructor ( x as single , y as single, z as single )
  declare sub fill( x as single , y as single , z as single )
  declare sub normalize
end type
constructor t3d()
  this.x = 0
  this.y = 0
  this.z = 0
end constructor 
constructor t3d( x as single , y as single , z as single )
  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 single ) 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 single ) as t3d
  return type( a.x / d , a.y / d , a.z / d )
end operator
sub t3d.fill( x as single , y as single , z as single )
  this.x = x
  this.y = y
  this.z = z
end sub
declare function dot( a as t3d , b as t3d ) as single
function dot( a as t3d , b as t3d ) as single
  return a.x * b.x + a.y * b.y + a.z * b.z
end function
declare function length( q as t3d ) as single
function length( q as t3d ) as single
   return sqr( q.x * q.x + q.y * q.y + q.z * q.z ) + 1e-7
end function  
declare function anlge( a as t3d , b as t3d ) as single
function getangle( a as t3d , b as t3d ) as single
  return acos( dot( a , b ) _
  / ( length( a ) * length( b ) ) )
end function
sub t3d.normalize
  this /= length( this )
end sub

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

''MATH

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

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

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

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

sub rotate( byref k as single , byref l as single , deg as single )
  dim as single 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

''3DENGINE

declare sub child( x as single , y as single , z as single , ax as integer , lim as integer )
declare function pend( fase as single , amp as single ) as single
declare sub skelet( no as integer , x as single , y as single , z as single )
dim shared sk( 63 ) as t3d

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 single , y as single , z as single , lim as integer , ax as integer )
  glTranslatef x , y , z
  select case ax
    case xyz
      glRotatef sk( lim ).x , 1 , 0 , 0
      glRotatef sk( lim ).y , 0 , 1 , 0
      glRotatef sk( lim ).z , 0 , 0 , 1
    case xzy
      glRotatef sk( lim ).x , 1 , 0 , 0
      glRotatef sk( lim ).z , 0 , 0 , 1
      glRotatef sk( lim ).y , 0 , 1 , 0
    case yxz
      glRotatef sk( lim ).y , 0 , 1 , 0
      glRotatef sk( lim ).x , 1 , 0 , 0
      glRotatef sk( lim ).z , 0 , 0 , 1
    case yzx
      glRotatef sk( lim ).y , 0 , 1 , 0
      glRotatef sk( lim ).z , 0 , 0 , 1
      glRotatef sk( lim ).x , 1 , 0 , 0
    case zxy
      glRotatef sk( lim ).z , 0 , 0 , 1
      glRotatef sk( lim ).x , 1 , 0 , 0
      glRotatef sk( lim ).y , 0 , 1 , 0
    case zyx
      glRotatef sk( lim ).z , 0 , 0 , 1
      glRotatef sk( lim ).y , 0 , 1 , 0
      glRotatef sk( lim ).x , 1 , 0 , 0
    case else
  end select  
end sub

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

sub skelet( no as integer , x as single , y as single , z as single )
  sk( no and 63 ).x = x 
  sk( no and 63 ).y = y
  sk( no and 63 ).z = z
end sub

screen 20, 32 

dim shared as ubyte letterpart( 256 , 16 )
dim as integer j , k
dim as ulong kl
color &hffffff , 0
for i as byte = 0 to 255
  cls
  print chr( i )
  for j = 0 to 7
    for k = 0 to 16 
      kl = point( j , k )
      letterpart( i , k ) += ( 2 ^ j ) * iif( kl > 0 , 1 , 0 )
    next k
  next j
next i

declare sub setbox(x as single,y as single,z as single _
,dx as single,dy as single,dz as single )
declare sub cube()

sub digit( b as ubyte )
  dim as integer i , j
  for i = 0 to 16
    for j = 0 to 7
      if letterpart( b , i ) and ( 2 ^ j ) then
        setbox j*.1-.4,i*.1-.8,0 , .08,.08,.08
        cube
      end if
    next j
  next i
end sub

sub text( t as string )
  dim as integer i
  for i = 1 to len( t )
    glpushmatrix
      gltranslatef -len( t ) / 2 + i , 0 , 0
      digit asc( mid( t , i , 1 ) )
    glpopmatrix
  next i
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.5, 0.5                '' Blue 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 ) = { 0 , 50 , 0 , 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 t_4d
  dim as single x , y , z , w
  declare sub fill( nx as single , ny as single , nz as single , nw as single )
end type
sub t_4d.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 t_4d 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 t_4d , f as single , b as t_4d ) as t_4d 
  dim uit as t_4d
  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

function rainbow( f as single ) as t_4d
  dim uit as t_4d
  uit.x = sin( rad( f ) ) / 2 + .5
  uit.y = sin( rad( f - 120 ) ) / 2 + .5
  uit.z = sin( rad( f + 120 ) ) / 2 + .5
  uit.w = 1
  return uit
end function  

''MATERIAL

type t_material
  dim as t_4d 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

''PRIMATIVS

dim shared as t3d pnt( 256 )

sub setpoint( no as integer , x as single , y as single , z as single )
  if no < 0 or no > ubound( pnt ) then exit sub
  pnt( no ).x = x
  pnt( no ).y = y
  pnt( no ).z = 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 t3d n = ( pnt( p2 ) - pnt( p1 ) ) _
               \ ( pnt( p3 ) - pnt( p1 ) )
  n.normalize()
  glbegin gl_triangles
    glnormal3f n.x , n.y , n.z
    glvertex3f pnt( p1 ).x , pnt( p1 ).y , pnt( p1 ).z
    glvertex3f pnt( p2 ).x , pnt( p2 ).y , pnt( p2 ).z
    glvertex3f 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 t3d zp = ( pnt( p1 ) + pnt( p2 ) _
  + pnt( p3 ) + pnt( p4 ) ) / 4
  dim as t3d n = ( pnt( p2 ) - zp ) _
               \ ( pnt( p3 ) - zp )
  n.normalize()
  glbegin gl_quads
    glnormal3f n.x , n.y , n.z
    glvertex3f pnt( p1 ).x , pnt( p1 ).y , pnt( p1 ).z
    glvertex3f pnt( p2 ).x , pnt( p2 ).y , pnt( p2 ).z
    glvertex3f pnt( p3 ).x , pnt( p3 ).y , pnt( p3 ).z
    glvertex3f pnt( p4 ).x , pnt( p4 ).y , pnt( p4 ).z
  glend 
end sub

''SHAPES

type Tbox
  m as t3d
  d as t3d
end type
dim shared box as Tbox

declare sub isoca( i as integer )
declare sub sphere( h as integer , r as integer _
, a as single , b as single )
declare sub hsphere( h as integer , r as integer _
, t as integer , a as single , b as single )
declare sub torus( hsides as integer , rsides as integer )
declare sub cilinder( sides as integer _
, dx as single , dy as single , top as integer , bot as integer ) 
declare sub hcube( )
declare sub geo( no as integer , p1 as integer _
, p2 as integer , p3 as integer )

sub geo( no as integer , p1 as integer _
, p2 as integer , p3 as integer )
  if no < 1 then 
    tri p1 , p2 , p3 
  else
  dim p12 as integer , p13 as integer , p23 as integer
    p12 = 255 - no * 3
    p13 = 255 - no * 3 - 1
    p23 = 255 - no * 3 - 2
    pnt( p12 ) = ( pnt( p1 ) + pnt( p2 ) ) / 2
    pnt( p13 ) = ( pnt( p1 ) + pnt( p3 ) ) / 2
    pnt( p23 ) = ( pnt( p2 ) + pnt( p3 ) ) / 2
    pnt( p12 ).normalize
    pnt( p13 ).normalize
    pnt( p23 ).normalize
    geo no - 1 , p1 , p12 , p13
    geo no - 1 , p2 , p23 , p12
    geo no - 1 , p3 , p13 , p23
    geo no - 1 , p12 , p23 , p13
  end if
end sub

sub isoca( i as integer )
  if i < 0 then i = 0
  if i > 5 then i = 5
  glPushMatrix
  glTranslatef box.m.x , box.m.y , box.m.z 
  glScalef box.d.x , box.d.y , box.d.z
    
  setpoint  1 ,  0       ,  0 , 1.118034
  setpoint  2 ,  1       ,  0         ,  .5 
  setpoint  3 ,  .309017 ,  .95105654 ,  .5 
  setpoint  4 , -.809017 ,  .58778524 ,  .5 
  setpoint  5 , -.809017 , -.58778524 ,  .5 
  setpoint  6 ,  .309017 , -.95105654 ,  .5 
  setpoint  7 ,  .809017 ,  .58778524 , -.5 
  setpoint  8 , -.309017 ,  .95105654 , -.5 
  setpoint  9 , -1       ,  0         , -.5 
  setpoint 10 , -.309017 , -.95105654 , -.5
  setpoint 11 ,  .809017 , -.58778524 , -.5 
  setpoint 12 ,  0       ,  0         , -1.118034
  dim t as integer
  for t = 1 to 12
    pnt( t ).normalize
  next t
  geo i , 1 ,  2 , 3
  geo i , 1 ,  3 ,  4 
  geo i , 1 ,  4 ,  5 
  geo i , 1 ,  5 ,  6 
  geo i , 1 ,  6 ,  2 
  geo i , 2 ,  7 ,  3
  geo i , 3 ,  7 ,  8 
  geo i , 3 ,  8 ,  4
  geo i , 4 ,  8 ,  9 
  geo i , 4 ,  9 ,  5 
  geo i , 5 ,  9 , 10 
  geo i , 5 , 10 ,  6 
  geo i , 6 , 10 , 11 
  geo i , 6 , 11 ,  2
  geo i , 2 , 11 ,  7 
  geo i , 12 ,  8 ,  7
  geo i , 12 ,  9 ,  8
  geo i , 12 , 10 ,  9 
  geo i , 12 , 11 , 10 
  geo i , 12 ,  7 , 11 
  glPopMatrix
end sub

sub sphere( a as integer , b as integer _
, da as single , db as single )
  dim as single i , j , i2 , j2 
  dim as single x , y , z
  if a < 3 then a = 3 
  if a > 64 then a = 64
  if b < 3 then b = 3 
  if b > 64 then b = 64
  glPushMatrix
  glTranslatef box.m.x , box.m.y , box.m.z
  glScalef box.d.x , box.d.y , box.d.z
  for i = -PI to PI  step PI / a * 2 
    i2 = i + PI / a * 2 
    for j = -PI / 2 to PI / 2 - pi / b * 2 step PI / b * 2 
      j2 = j + PI / b * 2 

      x = sin( i ) * cos( j )
      y = sin( j )
      z = cos( i ) * cos( j )
      setpoint 0 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )

      x = sin( i2 ) * cos( j )
      y = sin( j )
      z = cos( i2 ) * cos( j )
      setpoint 1 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )
      
      x = sin( i2 ) * cos( j2 )
      y = sin( j2 )
      z = cos( i2 ) * cos( j2 )
      setpoint 2 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )
      
      x = sin( i ) * cos( j2 )
      y = sin( j2 )
      z = cos( i ) * cos( j2 )
      setpoint 3 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )
      
      quad 0 , 1 , 2 , 3 
    next j
  next i
  glPopMatrix
end sub

sub hsphere( a as integer , b as integer _
, t as integer , da as single , db as single )
  dim as single i , j , i2 , j2 
  dim as single x , y , z
  if a < 3 then a = 3 
  if a > 64 then a = 64
  if b < 3 then b = 3 
  if b > 64 then b = 64
  glPushMatrix
  glTranslatef box.m.x , box.m.y , box.m.z
  glScalef box.d.x , box.d.y , box.d.z
  for i = -PI to PI  step PI / a * 2 
    i2 = i + PI / a * 2 
    for j = -PI / 2 to t * pi / b / 2 - pi / b * 2 step PI / b * 2 
      j2 = j + PI / b * 2 

      x = sin( i ) * cos( j )
      y = sin( j )
      z = cos( i ) * cos( j )
      setpoint 0 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )

      x = sin( i2 ) * cos( j )
      y = sin( j )
      z = cos( i2 ) * cos( j )
      setpoint 1 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )
      
      x = sin( i2 ) * cos( j2 )
      y = sin( j2 )
      z = cos( i2 ) * cos( j2 )
      setpoint 2 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )
      
      x = sin( i ) * cos( j2 )
      y = sin( j2 )
      z = cos( i ) * cos( j2 )
      setpoint 3 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )
      
      quad 0 , 1 , 2 , 3 
    next j
  next i
  glPopMatrix
end sub

sub torus( a as integer , b as integer )
  dim i as single , j as single , i2 as single , j2 as single
  if a < 3 then a = 3 
  if a > 64 then a = 643
  if b < 3 then b = 3 
  if b > 64 then b = 64 
  dim mx as single , my as single , mz as single , dx as single , dy as single , dz as single 
  mx = box.m.x 
  my = box.m.y 
  mz = box.m.z 
  dx = box.d.x 
  dy = box.d.y 
  dz = box.d.z 
  for i = -PI to PI  step PI / a * 2 
    i2 = i + PI / a * 2 
    for j = -PI to PI step PI / b * 2 
      j2 = j + PI / b * 2 
      setpoint 0 _ 
      , mx + ( dx + dy * cos( i ) ) * cos( j ) _
      , my + ( dx + dy * cos( i ) ) * sin( j ) _
      , mz + sin( i ) * dz  
      setpoint 1 _
      , mx + ( dx + dy * cos( i ) ) * cos( j2 ) _
      , my + ( dx + dy * cos( i ) ) * sin( j2 ) _
      , mz + sin( i ) * dz 
      setpoint 2 _
      , mx + ( dx + dy * cos( i2 ) ) * cos( j2 ) _
      , my + ( dx + dy * cos( i2 ) ) * sin( j2 ) _
      , mz + sin( i2 ) * dz 
      setpoint 3 _ 
      , mx + ( dx + dy * cos( i2 ) ) * cos( j ) _
      , my + ( dx + dy * cos( i2 ) ) * sin( j ) _
      , mz + sin( i2 ) * dz 
      quad 0 , 1 , 2 , 3 
    next j
  next i
end sub

sub cilinder( sides as integer , dx as single , dy as single , top as integer , bot as integer )
  dim f as single
  if sides < 3 then sides = 3
  if sides > 64 then sides = 64
  for f = 0 to sides + 2
    setpoint f , box.m.x + sin( f * pi * 2 / sides ) * box.d.x _
               , box.m.y - box.d.y _
               , box.m.z + cos( f * pi * 2 / sides ) * box.d.z
    setpoint f + sides + 1 , box.m.x + sin( f * pi * 2 / sides ) * dx _
                           , box.m.y + box.d.y _
                           , box.m.z + 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.m.y + box.d.y , 0
    for f = 0 to sides
        setpoint f , box.m.x + sin( f * pi * 2 / sides ) * dx _
               , box.m.y + box.d.y _
               , box.m.z + 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.m.y - box.d.y , 0
    for f = 0 to sides + 2
        setpoint f , box.m.x - sin( f * pi * 2 / sides ) * box.d.x _
               , box.m.y - box.d.y _
               , box.m.z + cos( f * pi * 2 / sides ) * box.d.z  
    next f
    for f = 0 to sides + 2
      tri 255 , f , f + 1 
    next f
  end if
end sub

sub cube()
  setpoint 0 , box.m.x + box.d.x , box.m.y + box.d.y , box.m.z + box.d.z
  setpoint 1 , box.m.x + box.d.x , box.m.y + box.d.y , box.m.z - box.d.z
  setpoint 2 , box.m.x + box.d.x , box.m.y - box.d.y , box.m.z + box.d.z
  setpoint 3 , box.m.x + box.d.x , box.m.y - box.d.y , box.m.z - box.d.z
  setpoint 4 , box.m.x - box.d.x , box.m.y + box.d.y , box.m.z + box.d.z
  setpoint 5 , box.m.x - box.d.x , box.m.y + box.d.y , box.m.z - box.d.z
  setpoint 6 , box.m.x - box.d.x , box.m.y - box.d.y , box.m.z + box.d.z
  setpoint 7 , box.m.x - box.d.x , box.m.y - box.d.y , box.m.z - box.d.z
  quad 0 , 2 , 3 , 1 ''right
  quad 7 , 6 , 4 , 5 ''left
  quad 0 , 4 , 5 , 1 ''up
  quad 7 , 3 , 2 , 6 ''down
  quad 0 , 4 , 6 , 2 ''back
  quad 7 , 5 , 1 , 3 ''front
end sub

sub hcube()
  setpoint 1 , box.m.x + box.d.x , box.m.y + box.d.y , box.m.z - box.d.z
  setpoint 2 , box.m.x + box.d.x , box.m.y - box.d.y , box.m.z + box.d.z
  setpoint 3 , box.m.x + box.d.x , box.m.y - box.d.y , box.m.z - box.d.z
  setpoint 4 , box.m.x - box.d.x , box.m.y + box.d.y , box.m.z + box.d.z
  setpoint 5 , box.m.x - box.d.x , box.m.y + box.d.y , box.m.z - box.d.z
  setpoint 6 , box.m.x - box.d.x , box.m.y - box.d.y , box.m.z + box.d.z
  setpoint 7 , box.m.x - box.d.x , box.m.y - box.d.y , box.m.z - box.d.z
  
  setpoint 0 , box.m.x + box.d.x , box.m.y - box.d.y , 0
  setpoint 8 , box.m.x + box.d.x , 0 , box.m.z - box.d.z
  setpoint 9 , 0 , box.m.y + box.d.y , box.m.z - box.d.z
  setpoint 10 , box.m.x - box.d.x , box.m.x + box.d.y , 0
  setpoint 11 , box.m.x - box.d.x , 0 , box.m.z + box.d.z
  setpoint 12, 0 , box.m.y - box.d.y , box.m.z + box.d.z
  
  tri 7 , 6 , 3
  tri 7 , 5 , 6 
  tri 7 , 3 , 5 
  
  quad 6 , 5 , 10 , 11 
  quad 5 , 3 , 8 , 9 
  quad 3 , 6 , 12 , 0 
  
  tri 6 , 12 , 11 
  tri 3 , 8 , 0 
  tri 5 , 9 , 10 
end sub

sub setbox( mx as single , my as single , mz as single , dx as single , dy as single , dz as single )
  box.m.x = mx
  box.m.y = my
  box.m.z = mz
  box.d.x = dx
  box.d.y = dy
  box.d.z = dz
end sub


const as integer body = 0 
const as integer arm = 1
const as integer elbow = 2 
const as integer wrist = 3
const as integer leg = 4
const as integer knee = 5 
const as integer enkle = 6 
const as integer neck = 7
const as integer eye = 8 
const as integer ileg = 4 
const as integer iknee = 9 
const as integer wing = 14
const as integer tail = 16
const as integer sensor = 17
const as integer thumb = 18
const as integer finger = 19
const as integer index_finger = 21
const as integer mid_finger = 24
const as integer ring_finger = 27
const as integer ear = 30
const as integer wenk = 31
const as integer lr = 32

const as integer human_walk = 1
const as integer dog_walk = 2
const as integer I_FLY = 3
const as integer I_LEFT_LEGS = 4
const as integer I_LEFT_BOX = 5
const as integer I_RIGHT_LEGS = 6
const as integer I_RIGHT_BOX = 7
const as integer I_STING = 8
const as integer I_STAND = 9

sub animate( anim as integer , f as single , a as single )
  DIM I AS INTEGER
  select case anim
  case human_walk
    skelet arm , pend( f , a ) , 0 , 0
    skelet elbow , -abs( a ) , 0 , 0
    skelet arm + lr , pend( f + 180, a ) , 0 , 0
    skelet elbow + lr , -abs( a ) , 0 , 0
    skelet leg , pend( f + 180 , a ) , 0 , 0
    skelet knee , pend( f + 90 , a ) + a , 0 , 0
    skelet leg + lr , pend( f , a ) , 0 , 0
    skelet knee + lr , pend( f - 90 , a ) + a , 0 , 0
  case dog_walk
    skelet arm , pend( f + 180 , a ) , 0 , 0
    skelet elbow , pend( f + 90 , a ) + a , 0 , 0
    skelet arm + lr , pend( f , a ) , 0 , 0
    skelet elbow + lr , pend( f - 90 , a ) + a , 0 , 0
    skelet leg , pend( f + 180 , a ) , 0 , 0
    skelet knee , pend( f + 90 , a ) + a , 0 , 0
    skelet leg + lr , pend( f , a ) , 0 , 0
    skelet knee + lr , pend( f - 90 , a ) + a , 0 , 0
    skelet tail , -45 , pend( f * 2 , a ) , 0
    skelet neck , 0 , 0 , 0
    skelet neck + lr , 0 , 0 , 0
  Case I_FLY
    For i = 0 To 1
      skelet wing + i, 0 , 0 , Pend(f, a)
      skelet wing+lr + i, 0,0, Pend(f, -a)
    Next
  Case I_LEFT_BOX
    skelet arm, 0, Pend(f, -a) + 45 , 0
    skelet elbow, 0, Pend(f, a * 2) - 60 , 0
  Case I_LEFT_LEGS
    For i = 0 To 4
      skelet ileg + i, 0 , 0, Pend(f + i * 180, a)
      skelet iknee + i, Pend(f + i * 180 + 90, a) , 0 , 0
    Next
  Case I_RIGHT_BOX
    skelet arm+lr, 0, Pend(f, a) - 45,0
    skelet elbow+lr, 0, Pend(f, -a * 2) + 60, 0
  Case I_RIGHT_LEGS
    For i = 0 To 4
      skelet ileg+lr+ i, 0,0, Pend(f + i * 180, a)
      skelet iknee+lr + i, Pend(f + i * 180 + 90, a),0,0
    Next
  Case I_STAND
    skelet arm, 0, 45, 0
    skelet elbow, 0, -60 , 0
    skelet finger, 0, 0, 0
    skelet thumb, 0, 0, 0
    skelet arm+lr, 0, -45, 0
    skelet elbow+lr, 0, 60 , 0
    skelet finger+lr, 0, 0, 0
    skelet thumb+lr, 0, 0, 0
    skelet tail, 10, 0 , 0
    skelet tail+lr, 10, 0 , 0
  Case I_STING
    skelet tail, 10 + Pend(f, a), 0, 0
    skelet tail+lr, 10 - Pend(f, a), 0, 0
  case else
    dim i as integer
    for i = 0 to 63
      skelet i , 0,0,0
    next i
  end select
end sub

sub insect()
  Dim i as integer
glPushmatrix
  glScalef .01 , .01 , .01
  setbox 0, 0, 0, 30, 10.0, 60.0
  Cube
  For i = 0 To 4
    glPushMatrix
      child 35.0, 0.0, i * 25 - 50 , ileg + i, xyz
      setbox 30.0, 0.0, 0.0, 30.0, 5.0, 5.0
      Cube
      glPushMatrix
        child 65.0, -5.0, 0.0 , iknee + i, xyz
        setbox 0.0, -30.0, 0.0, 5.0, 30.0, 5.0
        Cube
      glPopMatrix
    glPopMatrix
    glpushMatrix
      child -35.0, 0.0, i * 25 - 50, ileg + lr + i, xyz
      setbox -30.0, 0.0, 0.0, 30.0, 5.0, 5.0
      Cube 
      glPushMatrix
        child -65.0, -5.0, 0.0 , iknee + lr + 1, xyz
        setbox 0.0, -30.0, 0.0, 5.0, 30.0, 5.0
        Cube
      glPopmatrix
    glPopMatrix
  Next
  glPushMatrix
    child 0 , 0 , -50 , tail , xyz
    For i = 0 To 9
      glPushMatrix
        child 0.0, 0.0, -30.0 , tail, xyz
        setbox 0.0, 0.0, -15.0, 10.0, 10.0, 10.0
        Cube
    Next
    for i = 0 to 8
        glPushMatrix
          child 0 , 0 , -30 , tail+lr , xyz
          cube
    next i
    for i = 0 to 8
        glPopMatrix
      glPopMatrix
    next i
  glPopMatrix
  glPushMatrix
    child 30.0, 0.0, 65.0, arm, xyz
    setbox 0.0, 0.0, 30.0, 5.0, 5.0, 30.0
    Cube
    glPushMatrix
      child 0.0, 0.0, 65.0, elbow, xyz
      Cube
      glPushmatrix
        child 0.0, 0.0, 65.0 , wrist, xyz
        glPushmatrix
          child -10.0, 0.0, 5.0 , thumb, xyz
          Cube
        glPopMatrix
        glPushMatrix
          child 5.0, 0.0, 5.0, finger, xyz
          setbox 0.0, 0.0, 30.0, 5.0, 10.0, 30.0
          Cube
        glPopMatrix
      glPopMatrix
    glPopMatrix
  glPopMatrix
  glPushMatrix
    child -30.0, 0.0, 65.0, arm + lr, xyz
    setbox 0.0, 0.0, 30.0, 5.0, 5.0, 30.0
    Cube
    glPushMatrix
      child 0.0, 0.0, 65.0, elbow +lr, xyz
      Cube
      glPushMatrix
        child 0.0, 0.0, 65.0, wrist+lr, xyz
        glPushMatrix
          child 10.0, 0.0, 5.0, thumb+lr, xyz
          Cube
        glPopMatrix
        glPushMatrix
          child -5.0, 0.0, 5.0, finger+lr, xyz
          setbox 0.0, 0.0, 30.0, 5.0, 10.0, 30.0
          Cube
        glPopMatrix
      glPopMatrix
    glPopMatrix
   glPopMatrix
   For i = 0 To 1
     glPushMatrix
       child 20.0, 20.0, 40.0 - 50.0 * i, wing + i, xyz
       setbox 60.0, 0.0, 8.0, 60.0, 2.0, 16.0
       Cube
     glPopMatrix
     glPushMatrix
       child -20.0, 20.0, 40.0 - 50.0 * i , wing+lr + i,  xyz
       setbox -60.0, 0.0, 8.0, 60.0, 2.0, 16.0
       Cube
     glPopmatrix
   Next
glPopMatrix
end sub

sub kootjes( f as integer )
  setbox 0,-.2,0 , .1,.1,.1
  cube
  glpushmatrix
    child 0,-.2,0 , f + 1 , xyz
    cube
    glpushmatrix
      child 0,-.2,0 , f + 2 , xyz
      cube
    glpopmatrix
  glpopmatrix
end sub

sub hand( kl as t_4d , i as integer )
  material.diffuse = kl
  setmaterial gl_front , material
  glpushmatrix
    setbox 0,-.3,0 , .1,.3,.3
    cube
    glpushmatrix
      child 0,-.6,.2 , index_finger + i , xyz
      kootjes index_finger + i
    glpopmatrix
    glpushmatrix
      child 0,-.6,0 , mid_finger + i , xyz
      kootjes mid_finger + i
    glpopmatrix
    glpushmatrix
      child 0,-.6,-.2 , ring_finger + i , xyz
      kootjes ring_finger + i
    glpopmatrix
    glpushmatrix
      child 0,-.2,.4 , thumb + i , xyz
      kootjes thumb + i
    glpopmatrix
  glpopmatrix
end sub

sub human( kl as t_4d )
  material.diffuse = kl
  setmaterial gl_front , material
  setbox  0 , 0 , 0  ,  .5 , .1 , .1
  cube 
  setbox 0 , .75 , 0 , .1 , .5 , .1
  cube 
  setbox 0 , 1.8 , 0 , .2 , .2 , .2
  cube 
  setbox 0 , 1.4 , 0 , .7 , .1 , .1
  cube 
  glPushMatrix
    child .45 , 0 , 0 , leg , zyx
    setbox 0 , -.6 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , knee , xyz
      cube 
      glPushMatrix
        child 0 , -1.2 , 0 , enkle , xyz
        setbox 0 , 0 , .2 , .1 , .1 , .3
        cube 
      glPopMatrix
    glPopMatrix
  glPopMatrix
  glPushMatrix
    child -.45 , 0 , 0 , leg + lr , zyx
    setbox 0 , -.6 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , knee + lr , xyz
      cube 
      glPushMatrix
        child 0 , -1.2 , 0 , enkle + lr , xyz 
        setbox 0 , 0 , .2 , .1 , .1 , .3
        cube 
      glPopMatrix
    glPopMatrix
  glPopMatrix
  glPushMatrix
    child .65 , 1.3 , 0 , arm , xyz
    setbox 0 , -.5 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , elbow , xyz
      cube 
      glPushMatrix
        child 0 , -1 , 0 , wrist , zyx
        glscalef .5,.5,.5
        hand white , 0
      glPopMatrix
    glPopMatrix
  glPopMatrix
  material.diffuse = kl
  setmaterial gl_front , material  
  glPushMatrix
    child -.65 , 1.3 , 0 , arm + lr , xyz
    setbox 0 , -.5 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , elbow + lr , xyz
      cube 
      glPushMatrix
        child 0 , -1 , 0 , wrist + lr , zyx
        glscalef .5,.5,.5
        hand white , lr
      glPopMatrix
    glPopMatrix
  glPopMatrix
end sub

sub dog()
  setbox 0,.2,.5 , .3,.3,.7
  cube
  glpushmatrix
    child 0 , .6 , 1.5 , neck , xyz
    glpushmatrix
      child 0 , 0 , 0 , neck + lr , zyx
      setbox 0,0,0 , .3 , .3 , .3
      cube
      setbox 0,-.2,.3 , .2,.2,.2
      cube
      setbox 0,0,.5 , .1,.1,.1
      cube
      setbox .3,-.15,0 , .05,.3,.2
      cube
      setbox -.3,-.15,0 , .05,.3,.2
      cube
    glpopmatrix
  glpopmatrix
  glpushmatrix
    child 0 , .4 , -.5 , tail , yzx
    setbox 0,.3,0 , .1 , .3 , .1
    cube
  glpopmatrix
  glPushMatrix
    child .3 , 0 , 1 , leg , zyx
    setbox 0 , -.6 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , knee , xyz
      cube 
      glPushMatrix
        child 0 , -1.2 , 0 , enkle , xyz
        setbox 0 , 0 , .2 , .1 , .1 , .3
        cube 
      glPopMatrix
    glPopMatrix
  glPopMatrix
  glPushMatrix
    child -.3 , 0 , 1 , leg + lr, zyx
    setbox 0 , -.6 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , knee + lr, xyz
      cube 
      glPushMatrix
        child 0 , -1.2 , 0 , enkle + lr, xyz
        setbox 0 , 0 , .2 , .1 , .1 , .3
        cube 
      glPopMatrix
    glPopMatrix
  glPopMatrix
  glPushMatrix
    child .3 , 0 , 0 , arm , zyx
    setbox 0 , -.6 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , elbow , xyz
      cube 
      glPushMatrix
        child 0 , -1.2 , 0 , wrist , xyz
        setbox 0 , 0 , .2 , .1 , .1 , .3
        cube 
      glPopMatrix
    glPopMatrix
  glPopMatrix
  glPushMatrix
    child -.3 , 0 , 0 , arm + lr , zyx
    setbox 0 , -.6 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , elbow + lr , xyz
      cube 
      glPushMatrix
        child 0 , -1.2 , 0 , wrist + lr , xyz
        setbox 0 , 0 , .2 , .1 , .1 , .3
        cube 
      glPopMatrix
    glPopMatrix
  glPopMatrix
end sub

#endif

[bluatigro]

update :
try at landscaping

Code: Select all

''bluatigro 10 feb 2017
''surface

#include "_open_gl_dbl.bas"

dim as double hoek

dim as single q(2,2,2) = {{{-2,.4,2},{-1,1,2},{2,0,2}} _
                         ,{{-2.4,0,0},{-1.5,1,0},{-2,0,0}} _
                         ,{{-2,-.8,-2},{-1,1,-2},{2,0,-2}}}
                      

do
  glClear GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT
  
  camara.use

  material.diffuse = green
  setmaterial gl_front_and_back , material
  
  glMap2f GL_MAP2_VERTEX_3 , 0 , 10 , 3 , 3 , 0 , 10 , 9 , 3 , @q(0,0,0)
  
  glEnable GL_MAP2_VERTEX_3
  
  glMapGrid2f 10 , 0 , 10 , 10 , 0 , 10
  
  glEvalMesh2 GL_FILL , 0 , 10 , 0 , 10
  
  glEnable GL_AUTO_NORMAL
  
''camara contols
  
  if multikey( sc_up ) then
    camara.move 0 , .1 , 0 , 0
  end if
  if multikey( sc_down ) and camara.y > 0 then
    camara.move 0 , -.1 , 0 , 0
  end if
  if multikey( sc_left ) then
    camara.move -.1 , 0 , 0 , 0
  end if
  if multikey( sc_right ) then
    camara.move .1 , 0 , 0 , 0
  end if
  if not getmouse( mousex , mousey ) then
    if mousex <> -1 and mousey <> -1 then
      if mousex < winx / 3 then
        camara.move 0 , 0 , 0 , 1
      end if
      if mousey < winy / 3 then
        camara.move 0 , 0 , -.1 , 0
      end if
      if mousex > winx * 2 / 3 then
        camara.move 0 , 0 , 0 , -1
      end if
      if mousey > winy * 2 / 3 then
        camara.move 0 , 0 , .1 , 0
      end if
    end if
  end if
  
  sleep 40
  flip
loop until inkey = chr( 27 )

_open_gl_dbl.bas

Code: Select all

''bluatigro 10 feb 2017
''_open_gl_dbl.bas 

#ifndef OPENGL_H
#define OPENGL_H

dim shared as integer mousex , mousey

''VECTOR3D

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
declare function dot( a as t3d , b as t3d ) as double
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
declare function length( q as t3d ) as double
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  
declare function anlge( a as t3d , b as t3d ) as double
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

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

''MATH

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

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
  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 -pan , 0 , 1 , 0
  glTranslated -x , -y , -z
end sub

dim 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 sk( 63 ) as t3d

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( no as integer , x as double , y as double , z as double )
  sk( no and 63 ).x = x 
  sk( no and 63 ).y = y
  sk( no and 63 ).z = z
end sub

screen 20, 32 

dim shared as ubyte letterpart( 256 , 7 , 16 ) 
dim as integer j , k
dim as ulong kl
color &hffffff , 0
for i as byte = 0 to 255
  cls
  print chr( i )
  for j = 0 to 7
    for k = 0 to 16 
      kl = point( j , k )
      letterpart( i , j , k ) = 1 ''* iif( kl > 0 , 1 , 0 )
    next k
  next j
next i

declare sub setbox(x as double,y as double,z as double _
,dx as double,dy as double,dz as double )
declare sub cube()

sub digit( b as integer )
  dim as integer i , j
  for i = 0 to 16
    for j = 0 to 7
      if letterpart( b , j , i ) = 1 then
        setbox j*.1-.4,i*.1-.8,0 , .04,.04,.1
        cube
      end if
    next j
  next i
end sub

sub text( t as string )
  dim as integer i
  for i = 1 to len( t )
    glpushmatrix
      gltranslatef i - len( t ) / 2 - .5 , 0 , 0
      digit asc( mid( t , i , 1 ) )
    glpopmatrix
  next i
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.5, 0.5                '' Blue 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 ) = { 0 , 50 , 0 , 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 t_4d
  dim as single x , y , z , w
  declare sub fill( nx as single , ny as single , nz as single , nw as single )
end type
sub t_4d.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 t_4d 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 t_4d , f as double , b as t_4d ) as t_4d 
  dim uit as t_4d
  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

function rainbow( f as double ) as t_4d
  dim uit as t_4d
  uit.x = sin( rad( f ) ) / 2 + .5
  uit.y = sin( rad( f - 120 ) ) / 2 + .5
  uit.z = sin( rad( f + 120 ) ) / 2 + .5
  uit.w = 1
  return uit
end function  

''MATERIAL

type t_material
  dim as t_4d 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

''PRIMATIVS

dim shared as t3d pnt( 256 )

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 ).x = x
  pnt( no ).y = y
  pnt( no ).z = 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 t3d 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 t3d zp = ( pnt( p1 ) + pnt( p2 ) _
  + pnt( p3 ) + pnt( p4 ) ) / 4
  dim as t3d n = ( pnt( p2 ) - zp ) _
               \ ( pnt( p3 ) - zp )
  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

''SHAPES

type Tbox
  m as t3d
  d as t3d
end type
dim shared box as Tbox

declare sub isoca( i as integer )
declare sub sphere( h as integer , r as integer _
, a as double , b as double )
declare sub hsphere( h as integer , r as integer _
, t as integer , a as double , b as double )
declare sub torus( hsides as integer , rsides as integer )
declare sub cilinder( sides as integer _
, dx as double , dy as double , top as integer , bot as integer ) 
declare sub hcube( )
declare sub geo( no as integer , p1 as integer _
, p2 as integer , p3 as integer )

sub geo( no as integer , p1 as integer _
, p2 as integer , p3 as integer )
  if no < 1 then 
    tri p1 , p2 , p3 
  else
  dim p12 as integer , p13 as integer , p23 as integer
    p12 = 255 - no * 3
    p13 = 255 - no * 3 - 1
    p23 = 255 - no * 3 - 2
    pnt( p12 ) = ( pnt( p1 ) + pnt( p2 ) ) / 2
    pnt( p13 ) = ( pnt( p1 ) + pnt( p3 ) ) / 2
    pnt( p23 ) = ( pnt( p2 ) + pnt( p3 ) ) / 2
    pnt( p12 ).normalize
    pnt( p13 ).normalize
    pnt( p23 ).normalize
    geo no - 1 , p1 , p12 , p13
    geo no - 1 , p2 , p23 , p12
    geo no - 1 , p3 , p13 , p23
    geo no - 1 , p12 , p23 , p13
  end if
end sub

sub isoca( i as integer )
  if i < 0 then i = 0
  if i > 5 then i = 5
  glPushMatrix
  glTranslated box.m.x , box.m.y , box.m.z 
  glScaled box.d.x , box.d.y , box.d.z
    
  setpoint  1 ,  0       ,  0 , 1.118034
  setpoint  2 ,  1       ,  0         ,  .5 
  setpoint  3 ,  .309017 ,  .95105654 ,  .5 
  setpoint  4 , -.809017 ,  .58778524 ,  .5 
  setpoint  5 , -.809017 , -.58778524 ,  .5 
  setpoint  6 ,  .309017 , -.95105654 ,  .5 
  setpoint  7 ,  .809017 ,  .58778524 , -.5 
  setpoint  8 , -.309017 ,  .95105654 , -.5 
  setpoint  9 , -1       ,  0         , -.5 
  setpoint 10 , -.309017 , -.95105654 , -.5
  setpoint 11 ,  .809017 , -.58778524 , -.5 
  setpoint 12 ,  0       ,  0         , -1.118034
  dim t as integer
  for t = 1 to 12
    pnt( t ).normalize
  next t
  geo i , 1 ,  2 , 3
  geo i , 1 ,  3 ,  4 
  geo i , 1 ,  4 ,  5 
  geo i , 1 ,  5 ,  6 
  geo i , 1 ,  6 ,  2 
  geo i , 2 ,  7 ,  3
  geo i , 3 ,  7 ,  8 
  geo i , 3 ,  8 ,  4
  geo i , 4 ,  8 ,  9 
  geo i , 4 ,  9 ,  5 
  geo i , 5 ,  9 , 10 
  geo i , 5 , 10 ,  6 
  geo i , 6 , 10 , 11 
  geo i , 6 , 11 ,  2
  geo i , 2 , 11 ,  7 
  geo i , 12 ,  8 ,  7
  geo i , 12 ,  9 ,  8
  geo i , 12 , 10 ,  9 
  geo i , 12 , 11 , 10 
  geo i , 12 ,  7 , 11 
  glPopMatrix
end sub

sub sphere( a as integer , b as integer _
, da as double , db as double )
  dim as double i , j , i2 , j2 
  dim as double x , y , z
  if a < 3 then a = 3 
  if a > 64 then a = 64
  if b < 3 then b = 3 
  if b > 64 then b = 64
  glPushMatrix
  glTranslated box.m.x , box.m.y , box.m.z
  glScaled box.d.x , box.d.y , box.d.z
  for i = -PI to PI  step PI / a * 2 
    i2 = i + PI / a * 2 
    for j = -PI / 2 to PI / 2 - pi / b * 2 step PI / b * 2 
      j2 = j + PI / b * 2 

      x = sin( i ) * cos( j )
      y = sin( j )
      z = cos( i ) * cos( j )
      setpoint 0 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )

      x = sin( i2 ) * cos( j )
      y = sin( j )
      z = cos( i2 ) * cos( j )
      setpoint 1 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )
      
      x = sin( i2 ) * cos( j2 )
      y = sin( j2 )
      z = cos( i2 ) * cos( j2 )
      setpoint 2 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )
      
      x = sin( i ) * cos( j2 )
      y = sin( j2 )
      z = cos( i ) * cos( j2 )
      setpoint 3 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )
      
      quad 0 , 1 , 2 , 3 
    next j
  next i
  glPopMatrix
end sub

sub hsphere( a as integer , b as integer _
, t as integer , da as double , db as double )
  dim as double i , j , i2 , j2 
  dim as double x , y , z
  if a < 3 then a = 3 
  if a > 64 then a = 64
  if b < 3 then b = 3 
  if b > 64 then b = 64
  glPushMatrix
  glTranslated box.m.x , box.m.y , box.m.z
  glScaled box.d.x , box.d.y , box.d.z
  for i = -PI to PI  step PI / a * 2 
    i2 = i + PI / a * 2 
    for j = -PI / 2 to t * pi / b / 2 - pi / b * 2 step PI / b * 2 
      j2 = j + PI / b * 2 

      x = sin( i ) * cos( j )
      y = sin( j )
      z = cos( i ) * cos( j )
      setpoint 0 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )

      x = sin( i2 ) * cos( j )
      y = sin( j )
      z = cos( i2 ) * cos( j )
      setpoint 1 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )
      
      x = sin( i2 ) * cos( j2 )
      y = sin( j2 )
      z = cos( i2 ) * cos( j2 )
      setpoint 2 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )
      
      x = sin( i ) * cos( j2 )
      y = sin( j2 )
      z = cos( i ) * cos( j2 )
      setpoint 3 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )
      
      quad 0 , 1 , 2 , 3 
    next j
  next i
  glPopMatrix
end sub

sub torus( a as integer , b as integer )
  dim i as double , j as double , i2 as double , j2 as double
  if a < 3 then a = 3 
  if a > 64 then a = 643
  if b < 3 then b = 3 
  if b > 64 then b = 64 
  dim mx as double , my as double , mz as double , dx as double , dy as double , dz as double 
  mx = box.m.x 
  my = box.m.y 
  mz = box.m.z 
  dx = box.d.x 
  dy = box.d.y 
  dz = box.d.z 
  for i = -PI to PI  step PI / a * 2 
    i2 = i + PI / a * 2 
    for j = -PI to PI step PI / b * 2 
      j2 = j + PI / b * 2 
      setpoint 0 _ 
      , mx + ( dx + dy * cos( i ) ) * cos( j ) _
      , my + ( dx + dy * cos( i ) ) * sin( j ) _
      , mz + sin( i ) * dz  
      setpoint 1 _
      , mx + ( dx + dy * cos( i ) ) * cos( j2 ) _
      , my + ( dx + dy * cos( i ) ) * sin( j2 ) _
      , mz + sin( i ) * dz 
      setpoint 2 _
      , mx + ( dx + dy * cos( i2 ) ) * cos( j2 ) _
      , my + ( dx + dy * cos( i2 ) ) * sin( j2 ) _
      , mz + sin( i2 ) * dz 
      setpoint 3 _ 
      , mx + ( dx + dy * cos( i2 ) ) * cos( j ) _
      , my + ( dx + dy * cos( i2 ) ) * sin( j ) _
      , mz + sin( i2 ) * dz 
      quad 0 , 1 , 2 , 3 
    next j
  next i
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.m.x + sin( f * pi * 2 / sides ) * box.d.x _
               , box.m.y - box.d.y _
               , box.m.z + cos( f * pi * 2 / sides ) * box.d.z
    setpoint f + sides + 1 , box.m.x + sin( f * pi * 2 / sides ) * dx _
                           , box.m.y + box.d.y _
                           , box.m.z + 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.m.y + box.d.y , 0
    for f = 0 to sides
        setpoint f , box.m.x + sin( f * pi * 2 / sides ) * dx _
               , box.m.y + box.d.y _
               , box.m.z + 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.m.y - box.d.y , 0
    for f = 0 to sides + 2
        setpoint f , box.m.x - sin( f * pi * 2 / sides ) * box.d.x _
               , box.m.y - box.d.y _
               , box.m.z + cos( f * pi * 2 / sides ) * box.d.z  
    next f
    for f = 0 to sides + 2
      tri 255 , f , f + 1 
    next f
  end if
end sub

sub cube()
  setpoint 0 , box.m.x + box.d.x , box.m.y + box.d.y , box.m.z + box.d.z
  setpoint 1 , box.m.x + box.d.x , box.m.y + box.d.y , box.m.z - box.d.z
  setpoint 2 , box.m.x + box.d.x , box.m.y - box.d.y , box.m.z + box.d.z
  setpoint 3 , box.m.x + box.d.x , box.m.y - box.d.y , box.m.z - box.d.z
  setpoint 4 , box.m.x - box.d.x , box.m.y + box.d.y , box.m.z + box.d.z
  setpoint 5 , box.m.x - box.d.x , box.m.y + box.d.y , box.m.z - box.d.z
  setpoint 6 , box.m.x - box.d.x , box.m.y - box.d.y , box.m.z + box.d.z
  setpoint 7 , box.m.x - box.d.x , box.m.y - box.d.y , box.m.z - box.d.z
  quad 0 , 2 , 3 , 1 ''right
  quad 7 , 6 , 4 , 5 ''left
  quad 0 , 4 , 5 , 1 ''up
  quad 7 , 3 , 2 , 6 ''down
  quad 0 , 4 , 6 , 2 ''back
  quad 7 , 5 , 1 , 3 ''front
end sub

sub hcube()
  setpoint 1 , box.m.x + box.d.x , box.m.y + box.d.y , box.m.z - box.d.z
  setpoint 2 , box.m.x + box.d.x , box.m.y - box.d.y , box.m.z + box.d.z
  setpoint 3 , box.m.x + box.d.x , box.m.y - box.d.y , box.m.z - box.d.z
  setpoint 4 , box.m.x - box.d.x , box.m.y + box.d.y , box.m.z + box.d.z
  setpoint 5 , box.m.x - box.d.x , box.m.y + box.d.y , box.m.z - box.d.z
  setpoint 6 , box.m.x - box.d.x , box.m.y - box.d.y , box.m.z + box.d.z
  setpoint 7 , box.m.x - box.d.x , box.m.y - box.d.y , box.m.z - box.d.z
  
  setpoint 0 , box.m.x + box.d.x , box.m.y - box.d.y , 0
  setpoint 8 , box.m.x + box.d.x , 0 , box.m.z - box.d.z
  setpoint 9 , 0 , box.m.y + box.d.y , box.m.z - box.d.z
  setpoint 10 , box.m.x - box.d.x , box.m.x + box.d.y , 0
  setpoint 11 , box.m.x - box.d.x , 0 , box.m.z + box.d.z
  setpoint 12, 0 , box.m.y - box.d.y , box.m.z + box.d.z
  
  tri 7 , 6 , 3
  tri 7 , 5 , 6 
  tri 7 , 3 , 5 
  
  quad 6 , 5 , 10 , 11 
  quad 5 , 3 , 8 , 9 
  quad 3 , 6 , 12 , 0 
  
  tri 6 , 12 , 11 
  tri 3 , 8 , 0 
  tri 5 , 9 , 10 
end sub

sub setbox( mx as double , my as double , mz as double , dx as double , dy as double , dz as double )
  box.m.x = mx
  box.m.y = my
  box.m.z = mz
  box.d.x = dx
  box.d.y = dy
  box.d.z = dz
end sub


const as integer body = 0 
const as integer arm = 1
const as integer elbow = 2 
const as integer wrist = 3
const as integer leg = 4
const as integer knee = 5 
const as integer enkle = 6 
const as integer neck = 7
const as integer eye = 8 
const as integer ear = 9
const as integer wenk = 10
const as integer thumb = 11
const as integer index_finger = 14
const as integer mid_finger = 17
const as integer ring_finger = 21
const as integer tail = 24

const as integer iarm = 1
const as integer ielbow = 2
const as integer iwrist = 3
const as integer ileg = 4 
const as integer iknee = 9 
const as integer iwing = 14
const as integer itail = 16
const as integer isensor = 17
const as integer ithumb = 18
const as integer ifinger = 19

const as integer lr = 32

const as integer human_walk = 1
const as integer dog_walk = 2
const as integer I_FLY = 3
const as integer I_LEFT_LEGS = 4
const as integer I_LEFT_BOX = 5
const as integer I_RIGHT_LEGS = 6
const as integer I_RIGHT_BOX = 7
const as integer I_STING = 8
const as integer I_STAND = 9

sub animate( anim as integer , f as double , a as double )
  DIM I AS INTEGER
  select case anim
  case human_walk
    skelet arm , pend( f , a ) , 0 , 0
    skelet elbow , -abs( a ) , 0 , 0
    skelet arm + lr , pend( f + 180, a ) , 0 , 0
    skelet elbow + lr , -abs( a ) , 0 , 0
    skelet leg , pend( f + 180 , a ) , 0 , 0
    skelet knee , pend( f + 90 , a ) + a , 0 , 0
    skelet leg + lr , pend( f , a ) , 0 , 0
    skelet knee + lr , pend( f - 90 , a ) + a , 0 , 0
  case dog_walk
    skelet arm , pend( f + 180 , a ) , 0 , 0
    skelet elbow , pend( f + 90 , a ) + a , 0 , 0
    skelet arm + lr , pend( f , a ) , 0 , 0
    skelet elbow + lr , pend( f - 90 , a ) + a , 0 , 0
    skelet leg , pend( f + 180 , a ) , 0 , 0
    skelet knee , pend( f + 90 , a ) + a , 0 , 0
    skelet leg + lr , pend( f , a ) , 0 , 0
    skelet knee + lr , pend( f - 90 , a ) + a , 0 , 0
    skelet tail , -45 , pend( f * 2 , a ) , 0
    skelet neck , 0 , 0 , 0
    skelet neck + lr , 0 , 0 , 0
  Case I_FLY
    For i = 0 To 1
      skelet iwing + i, 0 , 0 , Pend(f, a)
      skelet iwing+lr + i, 0,0, Pend(f, -a)
    Next
  Case I_LEFT_BOX
    skelet iarm, 0, Pend(f, -a) + 45 , 0
    skelet ielbow, 0, Pend(f, a * 2) - 60 , 0
  Case I_LEFT_LEGS
    For i = 0 To 4
      skelet ileg + i, 0 , 0, Pend(f + i * 180, a)
      skelet iknee + i, Pend(f + i * 180 + 90, a) , 0 , 0
    Next
  Case I_RIGHT_BOX
    skelet iarm+lr, 0, Pend(f, a) - 45,0
    skelet ielbow+lr, 0, Pend(f, -a * 2) + 60, 0
  Case I_RIGHT_LEGS
    For i = 0 To 4
      skelet ileg+lr+ i, 0,0, Pend(f + i * 180, a)
      skelet iknee+lr + i, Pend(f + i * 180 + 90, a),0,0
    Next
  Case I_STAND
    skelet iarm, 0, 45, 0
    skelet ielbow, 0, -60 , 0
    skelet ifinger, 0, 0, 0
    skelet ithumb, 0, 0, 0
    skelet iarm+lr, 0, -45, 0
    skelet ielbow+lr, 0, 60 , 0
    skelet ifinger+lr, 0, 0, 0
    skelet ithumb+lr, 0, 0, 0
    skelet itail, 10, 0 , 0
    skelet itail+lr, 10, 0 , 0
  Case I_STING
    skelet itail, 10 + Pend(f, a), 0, 0
    skelet itail+lr, 10 - Pend(f, a), 0, 0
  case else
    dim i as integer
    for i = 0 to 63
      skelet i , 0,0,0
    next i
  end select
end sub

sub insect()
  Dim i as integer
glPushmatrix
  glScaled .01 , .01 , .01
  setbox 0, 0, 0, 30, 10.0, 60.0
  Cube
  For i = 0 To 4
    glPushMatrix
      child 35.0, 0.0, i * 25 - 50 , ileg + i, xyz
      setbox 30.0, 0.0, 0.0, 30.0, 5.0, 5.0
      Cube
      glPushMatrix
        child 65.0, -5.0, 0.0 , iknee + i, xyz
        setbox 0.0, -30.0, 0.0, 5.0, 30.0, 5.0
        Cube
      glPopMatrix
    glPopMatrix
    glpushMatrix
      child -35.0, 0.0, i * 25 - 50, ileg + lr + i, xyz
      setbox -30.0, 0.0, 0.0, 30.0, 5.0, 5.0
      Cube 
      glPushMatrix
        child -65.0, -5.0, 0.0 , iknee + lr + 1, xyz
        setbox 0.0, -30.0, 0.0, 5.0, 30.0, 5.0
        Cube
      glPopmatrix
    glPopMatrix
  Next
  glPushMatrix
    child 0 , 0 , -50 , itail , xyz
    For i = 0 To 9
      glPushMatrix
        child 0.0, 0.0, -30.0 , itail, xyz
        setbox 0.0, 0.0, -15.0, 10.0, 10.0, 10.0
        Cube
    Next
    for i = 0 to 8
        glPushMatrix
          child 0 , 0 , -30 , itail+lr , xyz
          cube
    next i
    for i = 0 to 8
        glPopMatrix
      glPopMatrix
    next i
  glPopMatrix
  glPushMatrix
    child 30.0, 0.0, 65.0, iarm, xyz
    setbox 0.0, 0.0, 30.0, 5.0, 5.0, 30.0
    Cube
    glPushMatrix
      child 0.0, 0.0, 65.0, ielbow, xyz
      Cube
      glPushmatrix
        child 0.0, 0.0, 65.0 , iwrist, xyz
        glPushmatrix
          child -10.0, 0.0, 5.0 , ithumb, xyz
          Cube
        glPopMatrix
        glPushMatrix
          child 5.0, 0.0, 5.0, ifinger, xyz
          setbox 0.0, 0.0, 30.0, 5.0, 10.0, 30.0
          Cube
        glPopMatrix
      glPopMatrix
    glPopMatrix
  glPopMatrix
  glPushMatrix
    child -30.0, 0.0, 65.0, iarm + lr, xyz
    setbox 0.0, 0.0, 30.0, 5.0, 5.0, 30.0
    Cube
    glPushMatrix
      child 0.0, 0.0, 65.0, ielbow +lr, xyz
      Cube
      glPushMatrix
        child 0.0, 0.0, 65.0, iwrist+lr, xyz
        glPushMatrix
          child 10.0, 0.0, 5.0, ithumb+lr, xyz
          Cube
        glPopMatrix
        glPushMatrix
          child -5.0, 0.0, 5.0, ifinger+lr, xyz
          setbox 0.0, 0.0, 30.0, 5.0, 10.0, 30.0
          Cube
        glPopMatrix
      glPopMatrix
    glPopMatrix
   glPopMatrix
   For i = 0 To 1
     glPushMatrix
       child 20.0, 20.0, 40.0 - 50.0 * i, iwing + i, xyz
       setbox 60.0, 0.0, 8.0, 60.0, 2.0, 16.0
       Cube
     glPopMatrix
     glPushMatrix
       child -20.0, 20.0, 40.0 - 50.0 * i , iwing+lr + i,  xyz
       setbox -60.0, 0.0, 8.0, 60.0, 2.0, 16.0
       Cube
     glPopmatrix
   Next
glPopMatrix
end sub

sub kootjes( f as integer )
  setbox 0,-.2,0 , .1,.1,.1
  cube
  glpushmatrix
    child 0,-.2,0 , f + 1 , xyz
    cube
    glpushmatrix
      child 0,-.2,0 , f + 2 , xyz
      cube
    glpopmatrix
  glpopmatrix
end sub

sub hand( kl as t_4d , i as integer )
  material.diffuse = kl
  setmaterial gl_front , material
  glpushmatrix
    setbox 0,-.3,0 , .1,.3,.3
    cube
    glpushmatrix
      child 0,-.6,.2 , index_finger + i , xyz
      kootjes index_finger + i
    glpopmatrix
    glpushmatrix
      child 0,-.6,0 , mid_finger + i , xyz
      kootjes mid_finger + i
    glpopmatrix
    glpushmatrix
      child 0,-.6,-.2 , ring_finger + i , xyz
      kootjes ring_finger + i
    glpopmatrix
    glpushmatrix
      child 0,-.2,.4 , thumb + i , xyz
      kootjes thumb + i
    glpopmatrix
  glpopmatrix
end sub

sub human( kl as t_4d )
  material.diffuse = kl
  setmaterial gl_front , material
  setbox  0 , 0 , 0  ,  .5 , .1 , .1
  cube 
  setbox 0 , .75 , 0 , .1 , .5 , .1
  cube 
  setbox 0 , 1.8 , 0 , .2 , .2 , .2
  cube 
  setbox 0 , 1.4 , 0 , .7 , .1 , .1
  cube 
  glPushMatrix
    child .45 , 0 , 0 , leg , zyx
    setbox 0 , -.6 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , knee , xyz
      cube 
      glPushMatrix
        child 0 , -1.2 , 0 , enkle , xyz
        setbox 0 , 0 , .2 , .1 , .1 , .3
        cube 
      glPopMatrix
    glPopMatrix
  glPopMatrix
  glPushMatrix
    child -.45 , 0 , 0 , leg + lr , zyx
    setbox 0 , -.6 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , knee + lr , xyz
      cube 
      glPushMatrix
        child 0 , -1.2 , 0 , enkle + lr , xyz 
        setbox 0 , 0 , .2 , .1 , .1 , .3
        cube 
      glPopMatrix
    glPopMatrix
  glPopMatrix
  glPushMatrix
    child .65 , 1.3 , 0 , arm , xyz
    setbox 0 , -.5 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , elbow , xyz
      cube 
      glPushMatrix
        child 0 , -1 , 0 , wrist , zyx
        glscalef .5,.5,.5
        hand white , 0
      glPopMatrix
    glPopMatrix
  glPopMatrix
  material.diffuse = kl
  setmaterial gl_front , material  
  glPushMatrix
    child -.65 , 1.3 , 0 , arm + lr , xyz
    setbox 0 , -.5 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , elbow + lr , xyz
      cube 
      glPushMatrix
        child 0 , -1 , 0 , wrist + lr , zyx
        glscalef .5,.5,.5
        hand white , lr
      glPopMatrix
    glPopMatrix
  glPopMatrix
end sub

sub dog()
  setbox 0,.2,.5 , .3,.3,.7
  cube
  glpushmatrix
    child 0 , .6 , 1.5 , neck , xyz
    glpushmatrix
      child 0 , 0 , 0 , neck + lr , zyx
      setbox 0,0,0 , .3 , .3 , .3
      cube
      setbox 0,-.2,.3 , .2,.2,.2
      cube
      setbox 0,0,.5 , .1,.1,.1
      cube
      setbox .3,-.15,0 , .05,.3,.2
      cube
      setbox -.3,-.15,0 , .05,.3,.2
      cube
    glpopmatrix
  glpopmatrix
  glpushmatrix
    child 0 , .4 , -.5 , tail , yzx
    setbox 0,.3,0 , .1 , .3 , .1
    cube
  glpopmatrix
  glPushMatrix
    child .3 , 0 , 1 , leg , zyx
    setbox 0 , -.6 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , knee , xyz
      cube 
      glPushMatrix
        child 0 , -1.2 , 0 , enkle , xyz
        setbox 0 , 0 , .2 , .1 , .1 , .3
        cube 
      glPopMatrix
    glPopMatrix
  glPopMatrix
  glPushMatrix
    child -.3 , 0 , 1 , leg + lr, zyx
    setbox 0 , -.6 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , knee + lr, xyz
      cube 
      glPushMatrix
        child 0 , -1.2 , 0 , enkle + lr, xyz
        setbox 0 , 0 , .2 , .1 , .1 , .3
        cube 
      glPopMatrix
    glPopMatrix
  glPopMatrix
  glPushMatrix
    child .3 , 0 , 0 , arm , zyx
    setbox 0 , -.6 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , elbow , xyz
      cube 
      glPushMatrix
        child 0 , -1.2 , 0 , wrist , xyz
        setbox 0 , 0 , .2 , .1 , .1 , .3
        cube 
      glPopMatrix
    glPopMatrix
  glPopMatrix
  glPushMatrix
    child -.3 , 0 , 0 , arm + lr , zyx
    setbox 0 , -.6 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , elbow + lr , xyz
      cube 
      glPushMatrix
        child 0 , -1.2 , 0 , wrist + lr , xyz
        setbox 0 , 0 , .2 , .1 , .1 , .3
        cube 
      glPopMatrix
    glPopMatrix
  glPopMatrix
end sub

#endif

[bluatigro]

try at plg file reader

my polygon : poly draws but my plg : horse not why ?

WARNING :
you have to change the path if you save your plg.zip's
in a other directory

no change in _open_gl_dbl.bas see last post of that

main

Code: Select all

''bluatigro 10 feb 2017
''surface

#include "_plg.bas"

dim as double hoek

                           
camara.z = 10

setpoint 0 , -1 , -1 , 0
setpoint 1 , -1 ,  1 , 0
setpoint 2 ,  1 , -1 , 0
setpoint 3 ,  1 ,  1 , 0

dim as polygon poly
poly.create "0 4 0 1 3 2"

dim as plg horse
horse.load_plg "plg\chess\HORSE.PLG"
                      
do
  glClear GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT
  
  camara.use
  
  glPushMatrix
    glRotatef hoek , 0,1,0
    glScalef .1,.1,.1
    horse.draw_it white
    
  glPopMatrix
  
''camara contols
  
  if multikey( sc_up ) then
    camara.move 0 , .1 , 0 , 0
  end if
  if multikey( sc_down ) and camara.y > 0 then
    camara.move 0 , -.1 , 0 , 0
  end if
  if multikey( sc_left ) then
    camara.move -.1 , 0 , 0 , 0
  end if
  if multikey( sc_right ) then
    camara.move .1 , 0 , 0 , 0
  end if
  if not getmouse( mousex , mousey ) then
    if mousex <> -1 and mousey <> -1 then
      if mousex < winx / 3 then
        camara.move 0 , 0 , 0 , 1
      end if
      if mousey < winy / 3 then
        camara.move 0 , 0 , -.1 , 0
      end if
      if mousex > winx * 2 / 3 then
        camara.move 0 , 0 , 0 , -1
      end if
      if mousey > winy * 2 / 3 then
        camara.move 0 , 0 , .1 , 0
      end if
    end if
  end if
  
  hoek += 5
  
  sleep 40
  flip
loop until inkey = chr( 27 )

_plg.bas

Code: Select all

''bluatigro 13 feb 2017
''plg.bas
''a plg file belongs to rend386
''for ren386 see :
''http://buter.software/rend386/
''copy the plg zip files to a directory

''VERSION 1 : 13 FEB 2017 : ONLY 3D INFO IS READ

#include "_open_gl_dbl.bas"

dim shared as ulong wordtel
dim shared as string word( 1000 )
sub split( a as string , cut as string )
  wordtel = 0
  while instr( a , cut ) <> 0
    word( wordtel ) = left( a , instr( a , cut ) - 1 )
    a = right( a , len( a ) - instr( a , cut ) )
    wordtel += 1
  wend
  if a <> "" then
    word( wordtel ) = a
    wordtel += 1
  end if
end sub 


type polygon
public :
  dim as integer numPoints
  dim as integer intbuffer( 10 )
  dim as t_material mat
  declare sub create( s as string )
  declare sub draw_it()
end type
sub polygon.create( s as string )
  split s , " "
  numPoints = val( word( 1 ) )
  dim as integer i 
  for i = 0 to numPoints
    intbuffer( i ) = val( word( i + 2 ) )
  next i
end sub 
sub polygon.draw_it()
  dim as integer i
  glBegin GL_POLYGON
    for i = 0 to numPoints
      glVertex3dv @ pnt( intbuffer( i ) ).x
    next i
  glEnd
end sub 

type plg
private :
  dim as integer numPoints , numPolys
  dim as polygon ptr poly
public :
  declare sub load_plg( file as string )
  declare sub draw_it( kl as sng4d )
end type 
sub plg.draw_it( kl as sng4d )
  material.diffuse = kl
  setmaterial GL_FRONT , material
  dim as integer i
  for i = 1 to numPolys
    poly[ i ].draw_it
  next i
end sub 
sub plg.load_plg( file as string )
  if right( file , 4 ) <> ".PLG" then exit sub
  open file for input as #1
    dim as string in
    line input #1 , in
    while left( in , 1 ) = "#"
      line input #1 , in
    wend
    line input #1 , in
    line input #1 , in
    split in , " "
    numPoints = val( word( 1 ) )
    numPolys = val( word( 2 ) )
    dim as integer i
    for i = 0 to numPoints
      line input #1 , in
      split in , " "
      setpoint i , val( word( 0 ) ) _
      , val( word( 1 ) ) , val( word( 2 ) )
    next i
    poly = allocate( numPolys * sizeof( polygon ) )
    for i = 0 to numPolys
      line input #1 , in
      poly[ i ].create in
    next i
  close #1
end sub 

[bluatigro]

reading plg files dit not work
so i rebuild some in FB

error :
the plg rebuilds dont shade wel , why ?

main

Code: Select all

''bluatigro 14 feb 2017
''surface

#include "_chess_stuf.bas"

dim as double hoek

camara.z = 10
                      
do
  glClear GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT
  
  camara.use

  material.diffuse = white
  setmaterial gl_front_and_back , material

  glPushmatrix
    gltranslated 1,0,0
    glrotated hoek , 0,1,0
    horse
  glpopmatrix
  glPushmatrix
    gltranslated -1,0,0
    glrotated hoek , 0,1,0
    pawn
  glpopmatrix
  glPushmatrix
    gltranslated 2,0,0
    glrotated hoek , 0,1,0
    castle
  glpopmatrix
  glPushmatrix
    gltranslated -2,0,0
    glrotated hoek , 0,1,0
    bishop
  glpopmatrix
    glPushmatrix
    gltranslated 3,0,0
    glrotated hoek , 0,1,0
    queen
  glpopmatrix
    glPushmatrix
    gltranslated -3,0,0
    glrotated hoek , 0,1,0
    king
  glpopmatrix



  
''camara contols
  
''  if multikey( sc_up ) then
''    camara.move 0 , .1 , 0 , 0
''  end if
''  if multikey( sc_down ) and camara.y > 0 then
''    camara.move 0 , -.1 , 0 , 0
''  end if
''  if multikey( sc_left ) then
''    camara.move -.1 , 0 , 0 , 0
''  end if
''  if multikey( sc_right ) then
''    camara.move .1 , 0 , 0 , 0
''  end if
''  if not getmouse( mousex , mousey ) then
''    if mousex <> -1 and mousey <> -1 then
''      if mousex < winx / 3 then
''        camara.move 0 , 0 , 0 , 1
''      end if
''      if mousey < winy / 3 then
''        camara.move 0 , 0 , -.1 , 0
''      end if
''      if mousex > winx * 2 / 3 then
''        camara.move 0 , 0 , 0 , -1
''      end if
''      if mousey > winy * 2 / 3 then
''        camara.move 0 , 0 , .1 , 0
''      end if
''    end if
''  end if
  
  hoek += 5
  
  sleep 40
  flip
loop until inkey = chr( 27 )

_chess_stuf.bas

Code: Select all

''bluatigro 14 feb 2017
''_chess_stuf.bas
''some chess stuf
''rebuild from rend386 plg files

#include "_open_gl_dbl.bas"

sub horse
''# Knight chess piece
''# Created by Todd Porter for use in chess.wld
''# March 1993

''HORSE 20 21
  setpoint 0 , 0 , 0 , 0
  setpoint 1 , 250 , 0 , 0
  setpoint 2 , 77 , 0 , 238
  setpoint 3 , 250 , 200 , 0
  setpoint 4 , 77 , 200 , 238
  setpoint 5 , 0 , 300 , 0
  setpoint 6 , -203 , 0 , 147
  setpoint 7 , -203 , 0 , -148
  setpoint 8 , 78 , 0 , -239
  setpoint 9 , 251 , 0 , 0
  setpoint 10 , -203 , 200 , 147
  setpoint 11 , -203 , 200 , -148
  setpoint 12 , 78 , 200 , -239
  setpoint 13 , 251 , 200 , 0
  setpoint 14 , 250 , 900 , -250      
  setpoint 15 , -250 , 900 , -250     
  setpoint 16 , 0 , 1200 , 0          
  setpoint 17 , 0 , 700 , 400         
  setpoint 18 , 50 , 700 , 50        
  setpoint 19 , -50 , 700 , 50  
  glPushMatrix
    glScaled .001 , .001 , .001
    five 1 , 8 , 7 , 6 , 2
    quad 2 , 4 , 3 , 1
    tri 4 , 5 , 3
    quad 6 , 10 , 4 , 2
    quad 7 ,11 ,10 , 6
    quad 8 ,12 ,11 , 7
    quad 9 ,13 ,12 , 8
    tri 10 , 5 , 4
    tri 11 , 5 , 10
    tri 12 , 5 , 11
    tri 13 , 5 , 12
    tri 5 , 14 , 15
    tri 15 , 14 , 16
    tri 14 , 17 , 16
    tri 17 , 15 , 16
    tri 14 , 18 , 17
    tri 15 , 17 , 19
    tri 18 , 19 , 17
    tri 19 , 18 , 5
    tri 5 , 18 , 14
    tri 5 , 15 , 19
  glPopMatrix
end sub

sub castle
''# Castle chess piece
''# Created by Todd Porter for use in chess.wld
''# March 1993

''castle 24 22
setpoint 0,225 ,0 ,-225
setpoint 1,-225 ,0 ,-225
setpoint 2,-225 ,0 ,225
setpoint 3,225 ,0 ,225
setpoint 4,225 ,225 ,-225
setpoint 5,-225 ,225 ,-225
setpoint 6,-225 ,225 ,225
setpoint 7,225 ,225 ,225
setpoint 8,150 ,350 ,-150
setpoint 9,-150 ,350 ,-150
setpoint 10,-150 ,350 ,150
setpoint 11,150 ,350 ,150
setpoint 12,150 ,700 ,-150
setpoint 13,-150 ,700 ,-150
setpoint 14,-150 ,700 ,150
setpoint 15,150 ,700 ,150
setpoint 16,225 ,800 ,-225
setpoint 17,-225 ,800 ,-225
setpoint 18,-225 ,800 ,225
setpoint 19,225 ,800 ,225
setpoint 20,225 ,1050 ,-225
setpoint 21,-225 ,1050 ,-225
setpoint 22,-225 ,1050 ,225
setpoint 23,225 ,1050 ,225
glPushMatrix
  glscaled .001,.001,.001
  quad 0 ,1 ,2 ,3
  quad 0 ,3 ,7 ,4
  quad 1 ,0 ,4 ,5
  quad 1 ,5 ,6 ,2
  quad 2 ,6 ,7 ,3
  quad 4 ,8 ,9 ,5
  quad 4 ,7 ,11 ,8
  quad 5 ,9 ,10 ,6
  quad 10 ,11 ,7 ,6
  quad 9 ,8 ,12 ,13
  quad 8 ,11 ,15 ,12
  quad 9 ,13 ,14 ,10
  quad 10 ,14 ,15 ,11
  quad 15 ,19 ,16 ,12
  quad 12 ,16 ,17 ,13
  quad 13 ,17 ,18 ,14
  quad 14 ,18 ,19 ,15
  quad 20 ,16 ,19 ,23
  quad 20 ,21 ,17 ,16
  quad 17 ,21 ,22 ,18
  quad 18 ,22 ,23 ,19
  quad 20, 23, 22, 21
glPopMatrix
end sub 

sub bishop
''# Bishop Chess piece
''# Created by Todd Porter for use in chess.wld
''# March 1993

''BISHOP 36 31
setpoint 0 ,0 ,0 ,0
setpoint 1,250 ,0 ,0
setpoint 2,77 ,0 ,238
setpoint 3,250 ,100 ,0
setpoint 4,77 ,100 ,238
setpoint 5,100 ,200 ,0
setpoint 6,31 ,200 ,95
setpoint 7,250 ,600 ,0
setpoint 8,77 ,600 ,238
setpoint 9,100 ,900 ,0
setpoint 10,31 ,900 ,95
setpoint 11,200 ,1150 ,0
setpoint 12,62 ,1150 ,190
setpoint 13,0 ,1450 ,0
setpoint 14,-203 ,0 ,147
setpoint 15,-203 ,0 ,-148
setpoint 16,78 ,0 ,-239
setpoint 17,251 ,0 ,0
setpoint 18,-203 ,100 ,147
setpoint 19,-203 ,100 ,-148
setpoint 20,78 ,100 ,-239
setpoint 21,251 ,100 ,0
setpoint 22,-81 ,200 ,59
setpoint 23,-81 ,200 ,-59
setpoint 24,31 ,200 ,-95
setpoint 25,-203 ,600 ,147
setpoint 26,-203 ,600 ,-148
setpoint 27,78 ,600 ,-239
setpoint 28,251 ,600 ,0
setpoint 29,-81 ,900 ,59
setpoint 30,-81 ,900 ,-59
setpoint 31,31 ,900 ,-95
setpoint 32,-162 ,1150 ,118
setpoint 33,-162 ,1150 ,-118
setpoint 34,62 ,1150 ,-191
setpoint 35,201 ,1150 ,0
glPushMatrix
glScaled .001,.001,.001
five 1 ,16 ,15 ,14 ,2
quad 2 ,4 ,3 ,1
quad 4 ,6 ,5 ,3
quad 6 ,8 ,7 ,5
quad 8 ,10 ,9 ,7
quad 10 ,12 ,11 ,9
tri 12 ,13 ,11
quad 14 ,18 ,4 ,2
quad 15 ,19 ,18 ,14
quad 16 ,20 ,19 ,15
quad 17 ,21 ,20 ,16
quad 18 ,22 ,6 ,4
quad 19 ,23 ,22 ,18
quad 20 ,24 ,23 ,19
quad 21 ,5 ,24 ,20
quad 22 ,25 ,8 ,6
quad 23 ,26 ,25 ,22
quad 24 ,27 ,26 ,23
quad 5 ,28 ,27 ,24
quad 25 ,29 ,10 ,8
quad 26 ,30 ,29 ,25
quad 27 ,31 ,30 ,26
quad 28 ,9 ,31 ,27
quad 29 ,32 ,12 ,10
quad 30 ,33 ,32 ,29
quad 31 ,34 ,33 ,30
quad 9 ,35 ,34 ,31
tri 32 ,13 ,12
tri 33 ,13 ,32
tri 34 ,13 ,33
tri 35 ,13 ,34
glPopMatrix
end sub

sub queen
''# Queen chess piece
''# Created by Todd Porter for use in chess.wld
''# March 1993

''QUEEN 30 26
setpoint 0 ,0 ,0 ,0
setpoint 1 ,250 ,0 ,0
setpoint 2 ,77 ,0 ,238
setpoint 3 ,100 ,250 ,0
setpoint 4 ,31 ,250, 95
setpoint 5 ,100 ,1300 ,0
setpoint 6 ,31 ,1300 ,95
setpoint 7 ,250 ,1400 ,0
setpoint 8 ,77 ,1400 ,238
setpoint 9 ,50 ,1500 ,0
setpoint 10 ,15 ,1500 ,48
setpoint 11 ,0 ,1750 ,0
setpoint 12 ,-203 ,0 ,147
setpoint 13 ,-203 ,0 ,-148
setpoint 14 ,78 ,0 ,-239
setpoint 15 ,251 ,0 ,0
setpoint 16 ,-81 ,250 ,59
setpoint 17 ,-81 ,250 ,-59
setpoint 18 ,31 ,250 ,-95
setpoint 19 ,-81 ,1300 ,59
setpoint 20 ,-81 ,1300 ,-59
setpoint 21 ,31 ,1300 ,-95
setpoint 22 ,-203 ,1400 ,147
setpoint 23 ,-203 ,1400 ,-148
setpoint 24 ,78 ,1400 ,-239
setpoint 25 ,251 ,1400 ,0
setpoint 26 ,-41 ,1500 ,29
setpoint 27 ,-40 ,1500 ,-30
setpoint 28 ,16 ,1500 ,-47
setpoint 29 ,50 ,1500 ,1
glpushmatrix
glscaled .001,.001,.001
five 1 ,14 ,13 ,12 ,2
quad 2 ,4 ,3 ,1
quad 4 ,6 ,5 ,3
quad 6 ,8 ,7 ,5
quad 8 ,10 ,9 ,7
tri 10 ,11 ,9
quad 12 ,16 ,4 ,2
quad 13 ,17 ,16 ,12
quad 14 ,18 ,17 ,13
quad 15 ,3 ,18 ,14
quad 16 ,19 ,6 ,4
quad 17 ,20 ,19 ,16
quad 18 ,21 ,20 ,17
quad 3 ,5 ,21 ,18
quad 19 ,22 ,8 ,6
quad 20 ,23 ,22 ,19
quad 21 ,24 ,23 ,20
quad 5 ,25 ,24 ,21
quad 22 ,26 ,10 ,8
quad 23 ,27 ,26 ,22
quad 24 ,28 ,27 ,23
quad 25 ,29 ,28 ,24
tri 26 ,11 ,10
tri 27 ,11 ,26
tri 28 ,11 ,27
tri 29 ,11 ,28
glpopmatrix
end sub 

sub pawn
''# Pawn chess piece
''# Created by Todd Porter for use in chess.wld
''# March 1993

''PAWN 30 26
setpoint 0,0 ,0 ,0
setpoint 1,250 ,0 ,0
setpoint 2,77 ,0 ,238
setpoint 3,250 ,150 ,0
setpoint 4,77 ,150 ,238
setpoint 5,100 ,300 ,0
setpoint 6,31 ,300 ,95
setpoint 7,100 ,550 ,0
setpoint 8,31 ,550 ,95
setpoint 9,200 ,700 ,0
setpoint 10,62 ,700 ,190
setpoint 11,0 ,850 ,0
setpoint 12,-203 ,0 ,147
setpoint 13,-203 ,0 ,-148
setpoint 14,78 ,0 ,-239
setpoint 15,251 ,0 ,0
setpoint 16,-203 ,150 ,147
setpoint 17,-203 ,150 ,-148
setpoint 18,78 ,150 ,-239
setpoint 19,251 ,150 ,0
setpoint 20,-81 ,300 ,59
setpoint 21,-81 ,300 ,-59
setpoint 22,31 ,300 ,-95
setpoint 23,-81 ,550 ,59
setpoint 24,-81 ,550 ,-59
setpoint 25,31 ,550 ,-95
setpoint 26,-162 ,700 ,118
setpoint 27,-162 ,700 ,-118
setpoint 28,62 ,700 ,-191
setpoint 29,201 ,700 ,0
glpushmatrix
glscaled .001,.001,.001
quad 2 ,4 ,3 ,1
quad 4 ,6 ,5 ,3
quad 6 ,8 ,7 ,5
quad 8 ,10 ,9 ,7
tri 10 ,11 ,9
quad 12 ,16 ,4 ,2
quad 13 ,17 ,16 ,12
quad 14 ,18 ,17 ,13
quad 15 ,19 ,18 ,14
quad 16 ,20 ,6 ,4
quad 17 ,21 ,20 ,16
quad 18 ,22 ,21 ,17
quad 19 ,5 ,22 ,18
quad 20 ,23 ,8 ,6
quad 21 ,24 ,23 ,20
quad 22 ,25 ,24 ,21
quad 5 ,7 ,25 ,22
quad 23 ,26 ,10 ,8
quad 24 ,27 ,26 ,23
quad 25 ,28 ,27 ,24
quad 7 ,29 ,28 ,25
tri 26 ,11 ,10
tri 27 ,11 ,26
tri 28 ,11 ,27
tri 29 ,11 ,28
five 1 ,14 ,13 ,12 ,2
glpopmatrix
end sub

sub king
''i made this myself
setbox 0,.5,0 , .3,.1,.1
torus 12 , 12
glpushmatrix
  gltranslated 0,.6,0
  glrotated 45 , 0,0,1
  setbox 0,.3,0 , .1,.1,.1
  cilinder 12 , .1 , .1 , 1 , 1
  setbox 0,.5,0 , .15,.1,.15
  cilinder 12 , 0 , 0 , 0 , 1
glpopmatrix
end sub 

_open_gl_dbl

Code: Select all

''bluatigro 14 feb 2017
''_open_gl_dbl.bas 

#ifndef OPENGL_H
#define OPENGL_H

dim shared as integer mousex , mousey

''DBL3D

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

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

''MATH

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

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
  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 -pan , 0 , 1 , 0
  glTranslated -x , -y , -z
end sub

dim 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 sk( 63 ) as dbl3d

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( no as integer , x as double , y as double , z as double )
  sk( no and 63 ).x = x 
  sk( no and 63 ).y = y
  sk( no and 63 ).z = z
end sub

screen 20, 32 

dim shared as ubyte letterpart( 256 , 7 , 16 ) 
dim as integer j , k
dim as ulong kl
color &hffffff , 0
for i as byte = 0 to 255
  cls
  print chr( i )
  for j = 0 to 7
    for k = 0 to 16 
      kl = point( j , k )
      letterpart( i , j , k ) = 1 ''* iif( kl > 0 , 1 , 0 )
    next k
  next j
next i

declare sub setbox(x as double,y as double,z as double _
,dx as double,dy as double,dz as double )
declare sub cube()

sub digit( b as integer )
  dim as integer i , j
  for i = 0 to 16
    for j = 0 to 7
      if letterpart( b , j , i ) > 0 then
        setbox j*.1-.4,i*.1-.8,0 , .04,.04,.1
        cube
      end if
    next j
  next i
end sub

sub text( t as string )
  dim as integer i
  for i = 1 to len( t )
    glpushmatrix
      gltranslatef i - len( t ) / 2 - .5 , 0 , 0
      digit asc( mid( t , i , 1 ) )
    glpopmatrix
  next i
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.5, 0.5                '' Blue 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 ) = { 0 , 50 , 0 , 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 sub fill( nx as single , ny as single , nz as single , nw as single )
end type
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

function rainbow( f as double ) as sng4d
  dim uit as sng4d
  uit.x = sin( rad( f ) ) / 2 + .5
  uit.y = sin( rad( f - 120 ) ) / 2 + .5
  uit.z = sin( rad( f + 120 ) ) / 2 + .5
  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

''PRIMATIVS

dim shared as dbl3d pnt( 256 )

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

sub five( p1 as integer _
  , p2 as integer , p3 as integer _
  , p4 as integer , p5 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
  if p5 < 0 or p5 > 255 then exit sub
  dim as dbl3d n = ( pnt( p2 ) - pnt( p1 ) ) _
               \ ( pnt( p3 ) - pnt( p1 ) )
  n.normalize()

  glbegin gl_polygon
    glnormal3d n.x , n.y , n.z
    glvertex3dv @ pnt( p1 ).x
    glvertex3dv @ pnt( p2 ).x 
    glvertex3dv @ pnt( p3 ).x 
    glvertex3dv @ pnt( p4 ).x 
    glvertex3dv @ pnt( p5 ).x
  glend 
end sub


sub six( p1 as integer _
  , p2 as integer , p3 as integer _
  , p4 as integer , p5 as integer _
  , p6 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
  if p5 < 0 or p5 > 255 then exit sub
  dim as dbl3d n = ( pnt( p2 ) - pnt( p1 ) ) _
               \ ( pnt( p3 ) - pnt( p1 ) )
  n.normalize()

  glbegin gl_polygon
    glnormal3d n.x , n.y , n.z
    glvertex3dv @ pnt( p1 ).x
    glvertex3dv @ pnt( p2 ).x 
    glvertex3dv @ pnt( p3 ).x 
    glvertex3dv @ pnt( p4 ).x 
    glvertex3dv @ pnt( p5 ).x
    glvertex3dv @ pnt( p6 ).x
  glend 
end sub


''SHAPES

type Tbox
  m as dbl3d
  d as dbl3d
end type
dim shared box as Tbox

declare sub isoca( i as integer )
declare sub sphere( h as integer , r as integer _
, a as double , b as double )
declare sub hsphere( h as integer , r as integer _
, t as integer , a as double , b as double )
declare sub torus( hsides as integer , rsides as integer )
declare sub cilinder( sides as integer _
, dx as double , dy as double , top as integer , bot as integer ) 
declare sub hcube( )
declare sub geo( no as integer , p1 as integer _
, p2 as integer , p3 as integer )

sub geo( no as integer , p1 as integer _
, p2 as integer , p3 as integer )
  if no < 1 then 
    tri p1 , p2 , p3 
  else
  dim p12 as integer , p13 as integer , p23 as integer
    p12 = 255 - no * 3
    p13 = 255 - no * 3 - 1
    p23 = 255 - no * 3 - 2
    pnt( p12 ) = ( pnt( p1 ) + pnt( p2 ) ) / 2
    pnt( p13 ) = ( pnt( p1 ) + pnt( p3 ) ) / 2
    pnt( p23 ) = ( pnt( p2 ) + pnt( p3 ) ) / 2
    pnt( p12 ).normalize
    pnt( p13 ).normalize
    pnt( p23 ).normalize
    geo no - 1 , p1 , p12 , p13
    geo no - 1 , p2 , p23 , p12
    geo no - 1 , p3 , p13 , p23
    geo no - 1 , p12 , p23 , p13
  end if
end sub

sub isoca( i as integer )
  if i < 0 then i = 0
  if i > 5 then i = 5
  glPushMatrix
  glTranslated box.m.x , box.m.y , box.m.z 
  glScaled box.d.x , box.d.y , box.d.z
    
  setpoint  1 ,  0       ,  0 , 1.118034
  setpoint  2 ,  1       ,  0         ,  .5 
  setpoint  3 ,  .309017 ,  .95105654 ,  .5 
  setpoint  4 , -.809017 ,  .58778524 ,  .5 
  setpoint  5 , -.809017 , -.58778524 ,  .5 
  setpoint  6 ,  .309017 , -.95105654 ,  .5 
  setpoint  7 ,  .809017 ,  .58778524 , -.5 
  setpoint  8 , -.309017 ,  .95105654 , -.5 
  setpoint  9 , -1       ,  0         , -.5 
  setpoint 10 , -.309017 , -.95105654 , -.5
  setpoint 11 ,  .809017 , -.58778524 , -.5 
  setpoint 12 ,  0       ,  0         , -1.118034
  dim t as integer
  for t = 1 to 12
    pnt( t ).normalize
  next t
  geo i , 1 ,  2 , 3
  geo i , 1 ,  3 ,  4 
  geo i , 1 ,  4 ,  5 
  geo i , 1 ,  5 ,  6 
  geo i , 1 ,  6 ,  2 
  geo i , 2 ,  7 ,  3
  geo i , 3 ,  7 ,  8 
  geo i , 3 ,  8 ,  4
  geo i , 4 ,  8 ,  9 
  geo i , 4 ,  9 ,  5 
  geo i , 5 ,  9 , 10 
  geo i , 5 , 10 ,  6 
  geo i , 6 , 10 , 11 
  geo i , 6 , 11 ,  2
  geo i , 2 , 11 ,  7 
  geo i , 12 ,  8 ,  7
  geo i , 12 ,  9 ,  8
  geo i , 12 , 10 ,  9 
  geo i , 12 , 11 , 10 
  geo i , 12 ,  7 , 11 
  glPopMatrix
end sub

sub sphere( a as integer , b as integer _
, da as double , db as double )
  dim as double i , j , i2 , j2 
  dim as double x , y , z
  if a < 3 then a = 3 
  if a > 64 then a = 64
  if b < 3 then b = 3 
  if b > 64 then b = 64
  glPushMatrix
  glTranslated box.m.x , box.m.y , box.m.z
  glScaled box.d.x , box.d.y , box.d.z
  for i = -PI to PI  step PI / a * 2 
    i2 = i + PI / a * 2 
    for j = -PI / 2 to PI / 2 - pi / b * 2 step PI / b * 2 
      j2 = j + PI / b * 2 

      x = sin( i ) * cos( j )
      y = sin( j )
      z = cos( i ) * cos( j )
      setpoint 0 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )

      x = sin( i2 ) * cos( j )
      y = sin( j )
      z = cos( i2 ) * cos( j )
      setpoint 1 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )
      
      x = sin( i2 ) * cos( j2 )
      y = sin( j2 )
      z = cos( i2 ) * cos( j2 )
      setpoint 2 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )
      
      x = sin( i ) * cos( j2 )
      y = sin( j2 )
      z = cos( i ) * cos( j2 )
      setpoint 3 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )
      
      quad 0 , 1 , 2 , 3 
    next j
  next i
  glPopMatrix
end sub

sub hsphere( a as integer , b as integer _
, t as integer , da as double , db as double )
  dim as double i , j , i2 , j2 
  dim as double x , y , z
  if a < 3 then a = 3 
  if a > 64 then a = 64
  if b < 3 then b = 3 
  if b > 64 then b = 64
  glPushMatrix
  glTranslated box.m.x , box.m.y , box.m.z
  glScaled box.d.x , box.d.y , box.d.z
  for i = -PI to PI  step PI / a * 2 
    i2 = i + PI / a * 2 
    for j = -PI / 2 to t * pi / b / 2 - pi / b * 2 step PI / b * 2 
      j2 = j + PI / b * 2 

      x = sin( i ) * cos( j )
      y = sin( j )
      z = cos( i ) * cos( j )
      setpoint 0 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )

      x = sin( i2 ) * cos( j )
      y = sin( j )
      z = cos( i2 ) * cos( j )
      setpoint 1 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )
      
      x = sin( i2 ) * cos( j2 )
      y = sin( j2 )
      z = cos( i2 ) * cos( j2 )
      setpoint 2 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )
      
      x = sin( i ) * cos( j2 )
      y = sin( j2 )
      z = cos( i ) * cos( j2 )
      setpoint 3 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )
      
      quad 0 , 1 , 2 , 3 
    next j
  next i
  glPopMatrix
end sub

sub torus( a as integer , b as integer )
  dim i as double , j as double , i2 as double , j2 as double
  if a < 3 then a = 3 
  if a > 64 then a = 643
  if b < 3 then b = 3 
  if b > 64 then b = 64 
  dim mx as double , my as double , mz as double , dx as double , dy as double , dz as double 
  mx = box.m.x 
  my = box.m.y 
  mz = box.m.z 
  dx = box.d.x 
  dy = box.d.y 
  dz = box.d.z 
  for i = -PI to PI  step PI / a * 2 
    i2 = i + PI / a * 2 
    for j = -PI to PI step PI / b * 2 
      j2 = j + PI / b * 2 
      setpoint 0 _ 
      , mx + ( dx + dy * cos( i ) ) * cos( j ) _
      , my + ( dx + dy * cos( i ) ) * sin( j ) _
      , mz + sin( i ) * dz  
      setpoint 1 _
      , mx + ( dx + dy * cos( i ) ) * cos( j2 ) _
      , my + ( dx + dy * cos( i ) ) * sin( j2 ) _
      , mz + sin( i ) * dz 
      setpoint 2 _
      , mx + ( dx + dy * cos( i2 ) ) * cos( j2 ) _
      , my + ( dx + dy * cos( i2 ) ) * sin( j2 ) _
      , mz + sin( i2 ) * dz 
      setpoint 3 _ 
      , mx + ( dx + dy * cos( i2 ) ) * cos( j ) _
      , my + ( dx + dy * cos( i2 ) ) * sin( j ) _
      , mz + sin( i2 ) * dz 
      quad 0 , 1 , 2 , 3 
    next j
  next i
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.m.x + sin( f * pi * 2 / sides ) * box.d.x _
               , box.m.y - box.d.y _
               , box.m.z + cos( f * pi * 2 / sides ) * box.d.z
    setpoint f + sides + 1 , box.m.x + sin( f * pi * 2 / sides ) * dx _
                           , box.m.y + box.d.y _
                           , box.m.z + 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.m.y + box.d.y , 0
    for f = 0 to sides
        setpoint f , box.m.x + sin( f * pi * 2 / sides ) * dx _
               , box.m.y + box.d.y _
               , box.m.z + 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.m.y - box.d.y , 0
    for f = 0 to sides + 2
        setpoint f , box.m.x - sin( f * pi * 2 / sides ) * box.d.x _
               , box.m.y - box.d.y _
               , box.m.z + cos( f * pi * 2 / sides ) * box.d.z  
    next f
    for f = 0 to sides + 2
      tri 255 , f , f + 1 
    next f
  end if
end sub

sub cube()
  setpoint 0 , box.m.x + box.d.x , box.m.y + box.d.y , box.m.z + box.d.z
  setpoint 1 , box.m.x + box.d.x , box.m.y + box.d.y , box.m.z - box.d.z
  setpoint 2 , box.m.x + box.d.x , box.m.y - box.d.y , box.m.z + box.d.z
  setpoint 3 , box.m.x + box.d.x , box.m.y - box.d.y , box.m.z - box.d.z
  setpoint 4 , box.m.x - box.d.x , box.m.y + box.d.y , box.m.z + box.d.z
  setpoint 5 , box.m.x - box.d.x , box.m.y + box.d.y , box.m.z - box.d.z
  setpoint 6 , box.m.x - box.d.x , box.m.y - box.d.y , box.m.z + box.d.z
  setpoint 7 , box.m.x - box.d.x , box.m.y - box.d.y , box.m.z - box.d.z
  quad 0 , 2 , 3 , 1 ''right
  quad 7 , 6 , 4 , 5 ''left
  quad 0 , 4 , 5 , 1 ''up
  quad 7 , 3 , 2 , 6 ''down
  quad 0 , 4 , 6 , 2 ''back
  quad 7 , 5 , 1 , 3 ''front
end sub

sub hcube()
  setpoint 1 , box.m.x + box.d.x , box.m.y + box.d.y , box.m.z - box.d.z
  setpoint 2 , box.m.x + box.d.x , box.m.y - box.d.y , box.m.z + box.d.z
  setpoint 3 , box.m.x + box.d.x , box.m.y - box.d.y , box.m.z - box.d.z
  setpoint 4 , box.m.x - box.d.x , box.m.y + box.d.y , box.m.z + box.d.z
  setpoint 5 , box.m.x - box.d.x , box.m.y + box.d.y , box.m.z - box.d.z
  setpoint 6 , box.m.x - box.d.x , box.m.y - box.d.y , box.m.z + box.d.z
  setpoint 7 , box.m.x - box.d.x , box.m.y - box.d.y , box.m.z - box.d.z
  
  setpoint 0 , box.m.x + box.d.x , box.m.y - box.d.y , 0
  setpoint 8 , box.m.x + box.d.x , 0 , box.m.z - box.d.z
  setpoint 9 , 0 , box.m.y + box.d.y , box.m.z - box.d.z
  setpoint 10 , box.m.x - box.d.x , box.m.x + box.d.y , 0
  setpoint 11 , box.m.x - box.d.x , 0 , box.m.z + box.d.z
  setpoint 12, 0 , box.m.y - box.d.y , box.m.z + box.d.z
  
  tri 7 , 6 , 3
  tri 7 , 5 , 6 
  tri 7 , 3 , 5 
  
  quad 6 , 5 , 10 , 11 
  quad 5 , 3 , 8 , 9 
  quad 3 , 6 , 12 , 0 
  
  tri 6 , 12 , 11 
  tri 3 , 8 , 0 
  tri 5 , 9 , 10 
end sub

sub setbox( mx as double , my as double , mz as double , dx as double , dy as double , dz as double )
  box.m.x = mx
  box.m.y = my
  box.m.z = mz
  box.d.x = dx
  box.d.y = dy
  box.d.z = dz
end sub


const as integer body = 0 
const as integer arm = 1
const as integer elbow = 2 
const as integer wrist = 3
const as integer leg = 4
const as integer knee = 5 
const as integer enkle = 6 
const as integer neck = 7
const as integer eye = 8 
const as integer ear = 9
const as integer wenk = 10
const as integer thumb = 11
const as integer index_finger = 14
const as integer mid_finger = 17
const as integer ring_finger = 21
const as integer tail = 24

const as integer iarm = 1
const as integer ielbow = 2
const as integer iwrist = 3
const as integer ileg = 4 
const as integer iknee = 9 
const as integer iwing = 14
const as integer itail = 16
const as integer isensor = 17
const as integer ithumb = 18
const as integer ifinger = 19

const as integer lr = 32

const as integer human_walk = 1
const as integer dog_walk = 2
const as integer I_FLY = 3
const as integer I_LEFT_LEGS = 4
const as integer I_LEFT_BOX = 5
const as integer I_RIGHT_LEGS = 6
const as integer I_RIGHT_BOX = 7
const as integer I_STING = 8
const as integer I_STAND = 9

sub animate( anim as integer , f as double , a as double )
  DIM I AS INTEGER
  select case anim
  case human_walk
    skelet arm , pend( f , a ) , 0 , 0
    skelet elbow , -abs( a ) , 0 , 0
    skelet arm + lr , pend( f + 180, a ) , 0 , 0
    skelet elbow + lr , -abs( a ) , 0 , 0
    skelet leg , pend( f + 180 , a ) , 0 , 0
    skelet knee , pend( f + 90 , a ) + a , 0 , 0
    skelet leg + lr , pend( f , a ) , 0 , 0
    skelet knee + lr , pend( f - 90 , a ) + a , 0 , 0
  case dog_walk
    skelet arm , pend( f + 180 , a ) , 0 , 0
    skelet elbow , pend( f + 90 , a ) + a , 0 , 0
    skelet arm + lr , pend( f , a ) , 0 , 0
    skelet elbow + lr , pend( f - 90 , a ) + a , 0 , 0
    skelet leg , pend( f + 180 , a ) , 0 , 0
    skelet knee , pend( f + 90 , a ) + a , 0 , 0
    skelet leg + lr , pend( f , a ) , 0 , 0
    skelet knee + lr , pend( f - 90 , a ) + a , 0 , 0
    skelet tail , -45 , pend( f * 2 , a ) , 0
    skelet neck , 0 , 0 , 0
    skelet neck + lr , 0 , 0 , 0
  Case I_FLY
    For i = 0 To 1
      skelet iwing + i, 0 , 0 , Pend(f, a)
      skelet iwing+lr + i, 0,0, Pend(f, -a)
    Next
  Case I_LEFT_BOX
    skelet iarm, 0, Pend(f, -a) + 45 , 0
    skelet ielbow, 0, Pend(f, a * 2) - 60 , 0
  Case I_LEFT_LEGS
    For i = 0 To 4
      skelet ileg + i, 0 , 0, Pend(f + i * 180, a)
      skelet iknee + i, Pend(f + i * 180 + 90, a) , 0 , 0
    Next
  Case I_RIGHT_BOX
    skelet iarm+lr, 0, Pend(f, a) - 45,0
    skelet ielbow+lr, 0, Pend(f, -a * 2) + 60, 0
  Case I_RIGHT_LEGS
    For i = 0 To 4
      skelet ileg+lr+ i, 0,0, Pend(f + i * 180, a)
      skelet iknee+lr + i, Pend(f + i * 180 + 90, a),0,0
    Next
  Case I_STAND
    skelet iarm, 0, 45, 0
    skelet ielbow, 0, -60 , 0
    skelet ifinger, 0, 0, 0
    skelet ithumb, 0, 0, 0
    skelet iarm+lr, 0, -45, 0
    skelet ielbow+lr, 0, 60 , 0
    skelet ifinger+lr, 0, 0, 0
    skelet ithumb+lr, 0, 0, 0
    skelet itail, 10, 0 , 0
    skelet itail+lr, 10, 0 , 0
  Case I_STING
    skelet itail, 10 + Pend(f, a), 0, 0
    skelet itail+lr, 10 - Pend(f, a), 0, 0
  case else
    dim i as integer
    for i = 0 to 63
      skelet i , 0,0,0
    next i
  end select
end sub

sub insect()
  Dim i as integer
glPushmatrix
  glScaled .01 , .01 , .01
  setbox 0, 0, 0, 30, 10.0, 60.0
  Cube
  For i = 0 To 4
    glPushMatrix
      child 35.0, 0.0, i * 25 - 50 , ileg + i, xyz
      setbox 30.0, 0.0, 0.0, 30.0, 5.0, 5.0
      Cube
      glPushMatrix
        child 65.0, -5.0, 0.0 , iknee + i, xyz
        setbox 0.0, -30.0, 0.0, 5.0, 30.0, 5.0
        Cube
      glPopMatrix
    glPopMatrix
    glpushMatrix
      child -35.0, 0.0, i * 25 - 50, ileg + lr + i, xyz
      setbox -30.0, 0.0, 0.0, 30.0, 5.0, 5.0
      Cube 
      glPushMatrix
        child -65.0, -5.0, 0.0 , iknee + lr + 1, xyz
        setbox 0.0, -30.0, 0.0, 5.0, 30.0, 5.0
        Cube
      glPopmatrix
    glPopMatrix
  Next
  glPushMatrix
    child 0 , 0 , -50 , itail , xyz
    For i = 0 To 9
      glPushMatrix
        child 0.0, 0.0, -30.0 , itail, xyz
        setbox 0.0, 0.0, -15.0, 10.0, 10.0, 10.0
        Cube
    Next
    for i = 0 to 8
        glPushMatrix
          child 0 , 0 , -30 , itail+lr , xyz
          cube
    next i
    for i = 0 to 8
        glPopMatrix
      glPopMatrix
    next i
  glPopMatrix
  glPushMatrix
    child 30.0, 0.0, 65.0, iarm, xyz
    setbox 0.0, 0.0, 30.0, 5.0, 5.0, 30.0
    Cube
    glPushMatrix
      child 0.0, 0.0, 65.0, ielbow, xyz
      Cube
      glPushmatrix
        child 0.0, 0.0, 65.0 , iwrist, xyz
        glPushmatrix
          child -10.0, 0.0, 5.0 , ithumb, xyz
          Cube
        glPopMatrix
        glPushMatrix
          child 5.0, 0.0, 5.0, ifinger, xyz
          setbox 0.0, 0.0, 30.0, 5.0, 10.0, 30.0
          Cube
        glPopMatrix
      glPopMatrix
    glPopMatrix
  glPopMatrix
  glPushMatrix
    child -30.0, 0.0, 65.0, iarm + lr, xyz
    setbox 0.0, 0.0, 30.0, 5.0, 5.0, 30.0
    Cube
    glPushMatrix
      child 0.0, 0.0, 65.0, ielbow +lr, xyz
      Cube
      glPushMatrix
        child 0.0, 0.0, 65.0, iwrist+lr, xyz
        glPushMatrix
          child 10.0, 0.0, 5.0, ithumb+lr, xyz
          Cube
        glPopMatrix
        glPushMatrix
          child -5.0, 0.0, 5.0, ifinger+lr, xyz
          setbox 0.0, 0.0, 30.0, 5.0, 10.0, 30.0
          Cube
        glPopMatrix
      glPopMatrix
    glPopMatrix
   glPopMatrix
   For i = 0 To 1
     glPushMatrix
       child 20.0, 20.0, 40.0 - 50.0 * i, iwing + i, xyz
       setbox 60.0, 0.0, 8.0, 60.0, 2.0, 16.0
       Cube
     glPopMatrix
     glPushMatrix
       child -20.0, 20.0, 40.0 - 50.0 * i , iwing+lr + i,  xyz
       setbox -60.0, 0.0, 8.0, 60.0, 2.0, 16.0
       Cube
     glPopmatrix
   Next
glPopMatrix
end sub

sub kootjes( f as integer )
  setbox 0,-.2,0 , .1,.1,.1
  cube
  glpushmatrix
    child 0,-.2,0 , f + 1 , xyz
    cube
    glpushmatrix
      child 0,-.2,0 , f + 2 , xyz
      cube
    glpopmatrix
  glpopmatrix
end sub

sub hand( kl as sng4d , i as integer )
  material.diffuse = kl
  setmaterial gl_front , material
  glpushmatrix
    setbox 0,-.3,0 , .1,.3,.3
    cube
    glpushmatrix
      child 0,-.6,.2 , index_finger + i , xyz
      kootjes index_finger + i
    glpopmatrix
    glpushmatrix
      child 0,-.6,0 , mid_finger + i , xyz
      kootjes mid_finger + i
    glpopmatrix
    glpushmatrix
      child 0,-.6,-.2 , ring_finger + i , xyz
      kootjes ring_finger + i
    glpopmatrix
    glpushmatrix
      child 0,-.2,.4 , thumb + i , xyz
      kootjes thumb + i
    glpopmatrix
  glpopmatrix
end sub

sub human( kl as sng4d )
  material.diffuse = kl
  setmaterial gl_front , material
  setbox  0 , 0 , 0  ,  .5 , .1 , .1
  cube 
  setbox 0 , .75 , 0 , .1 , .5 , .1
  cube 
  setbox 0 , 1.8 , 0 , .2 , .2 , .2
  cube 
  setbox 0 , 1.4 , 0 , .7 , .1 , .1
  cube 
  glPushMatrix
    child .45 , 0 , 0 , leg , zyx
    setbox 0 , -.6 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , knee , xyz
      cube 
      glPushMatrix
        child 0 , -1.2 , 0 , enkle , xyz
        setbox 0 , 0 , .2 , .1 , .1 , .3
        cube 
      glPopMatrix
    glPopMatrix
  glPopMatrix
  glPushMatrix
    child -.45 , 0 , 0 , leg + lr , zyx
    setbox 0 , -.6 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , knee + lr , xyz
      cube 
      glPushMatrix
        child 0 , -1.2 , 0 , enkle + lr , xyz 
        setbox 0 , 0 , .2 , .1 , .1 , .3
        cube 
      glPopMatrix
    glPopMatrix
  glPopMatrix
  glPushMatrix
    child .65 , 1.3 , 0 , arm , xyz
    setbox 0 , -.5 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , elbow , xyz
      cube 
      glPushMatrix
        child 0 , -1 , 0 , wrist , zyx
        glscalef .5,.5,.5
        hand white , 0
      glPopMatrix
    glPopMatrix
  glPopMatrix
  material.diffuse = kl
  setmaterial gl_front , material  
  glPushMatrix
    child -.65 , 1.3 , 0 , arm + lr , xyz
    setbox 0 , -.5 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , elbow + lr , xyz
      cube 
      glPushMatrix
        child 0 , -1 , 0 , wrist + lr , zyx
        glscalef .5,.5,.5
        hand white , lr
      glPopMatrix
    glPopMatrix
  glPopMatrix
end sub

sub dog()
  setbox 0,.2,.5 , .3,.3,.7
  cube
  glpushmatrix
    child 0 , .6 , 1.5 , neck , xyz
    glpushmatrix
      child 0 , 0 , 0 , neck + lr , zyx
      setbox 0,0,0 , .3 , .3 , .3
      cube
      setbox 0,-.2,.3 , .2,.2,.2
      cube
      setbox 0,0,.5 , .1,.1,.1
      cube
      setbox .3,-.15,0 , .05,.3,.2
      cube
      setbox -.3,-.15,0 , .05,.3,.2
      cube
    glpopmatrix
  glpopmatrix
  glpushmatrix
    child 0 , .4 , -.5 , tail , yzx
    setbox 0,.3,0 , .1 , .3 , .1
    cube
  glpopmatrix
  glPushMatrix
    child .3 , 0 , 1 , leg , zyx
    setbox 0 , -.6 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , knee , xyz
      cube 
      glPushMatrix
        child 0 , -1.2 , 0 , enkle , xyz
        setbox 0 , 0 , .2 , .1 , .1 , .3
        cube 
      glPopMatrix
    glPopMatrix
  glPopMatrix
  glPushMatrix
    child -.3 , 0 , 1 , leg + lr, zyx
    setbox 0 , -.6 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , knee + lr, xyz
      cube 
      glPushMatrix
        child 0 , -1.2 , 0 , enkle + lr, xyz
        setbox 0 , 0 , .2 , .1 , .1 , .3
        cube 
      glPopMatrix
    glPopMatrix
  glPopMatrix
  glPushMatrix
    child .3 , 0 , 0 , arm , zyx
    setbox 0 , -.6 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , elbow , xyz
      cube 
      glPushMatrix
        child 0 , -1.2 , 0 , wrist , xyz
        setbox 0 , 0 , .2 , .1 , .1 , .3
        cube 
      glPopMatrix
    glPopMatrix
  glPopMatrix
  glPushMatrix
    child -.3 , 0 , 0 , arm + lr , zyx
    setbox 0 , -.6 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , elbow + lr , xyz
      cube 
      glPushMatrix
        child 0 , -1.2 , 0 , wrist + lr , xyz
        setbox 0 , 0 , .2 , .1 , .1 , .3
        cube 
      glPopMatrix
    glPopMatrix
  glPopMatrix
end sub

#endif

[bluatigro]

bluebaron : simple flight sim

insturctions :
use mouse to steer left and right
try to avoid the other planes

Code: Select all

''bluatigro 23 feb 2017
''blue baron game

#include "_open_gl_dbl.bas"

type t_bluebaron
  dim as double x,y,z,pan,rol
  dim as integer state , tel
  declare sub draw_it( kl as sng4d )
  declare sub move( dx as double _
  , dy as double , dz as double  _
  , dpan as double )
end type

sub t_bluebaron.draw_it( kl as sng4d )
  dim as integer i
  glPushMatrix
    glTranslated x , y , z
    glRotated pan , 0,1,0
    glRotated rol , 0,0,1
    setbox 0,0,0 , .3,.3,1
    kubus kl
    setbox 0,.3,-.9 , 1,.05,.25
    kubus kl
    setbox 0,.4,-.9 , .05,.5,.25
    kubus kl
    setbox 0,-.3,.75 , 1.5,.05,.25
    kubus kl
    setbox 0,.3,.75 , 2,.05,.25
    kubus kl
    setbox 0,.9,.75 , 2,.05,.25
    kubus kl
  glPopMatrix
end sub 

sub t_bluebaron.move( dx as double _
  , dy as double , dz as double _
  , dpan as double )
  rotate dx , dz , -pan
  x += dx
  y += dy
  z += dz
  pan = ( pan + dpan ) mod 360
  rol = -dpan * 10
end sub

dim as t_bluebaron bluebaron( 50 )
dim as sng4d kleur( 6 ) = {red,green,yellow,blue,magenta,cyan}

camara.y = 2
camara.z = 200

dim as dbl3d player , plane
dim as double hoek( 50 ) , rol , hoek2
dim as integer i , state , tel , done = 0
for i = 0 to ubound( bluebaron )
  bluebaron(i).z = range( -150 , 150 )
  bluebaron(i).y = 2
  bluebaron(i).x = range( -150 , 150 )
next i

randomize timer

do
  glClear GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT

''camara
  glLoadIdentity
  glRotated -rol , 0 , 0 , 1
  glRotated -camara.pan , 0 , 1 , 0
  glTranslated -camara.x , -camara.y , -camara.z

  for i = -20 to 20
    for j = -20 to 20
      setpoint 0 , i*10 - 1 , 0 , j*10 - 1
      setpoint 1 , i*10 - 1 , 0 , j*10 + 1
      setpoint 2 , i*10 + 1 , 0 , j*10 - 1
      setpoint 3 , i*10 + 1 , 0 , j*10 + 1
      vierhoek 0 , 1 , 3 , 2 , green
    next j
  next i
  
  for i = 0 to ubound( bluebaron )
    bluebaron(i).draw_it kleur(i mod 6)
  next i
  
  for i = 0 to ubound( bluebaron )
    bluebaron(i).tel -= 1
    if bluebaron(i).tel < 0 then
      bluebaron(i).tel = range( 5 , 30 )
      bluebaron(i).state = int( rnd * 3 )
    end if
    select case bluebaron(i).state
      case 0
        bluebaron(i).move 0 , 0 , .3 , hoek( i )
      case 1
        bluebaron(i).move 0 , 0 , .3 , hoek( i )
        if hoek(i) < 4.5 then 
          hoek(i) += .1
        else
          bluebaron(i).state = 0
''          bluebaron(i).tel = range( 25 , 100 )
        end if
      case 2
        bluebaron(i).move 0 , 0 , .3 , hoek( i )
        if hoek(i) > -4.5 then 
          hoek(i) -= .1
        else
          bluebaron(i).state = 0
''          bluebaron(i).tel = range( 25 , 100 )
        end if
      case else
        bluebaron(i).move 0 , 0 , .3 , hoek( i )
    end select
    
    if bluebaron(i).x < -200 then bluebaron(i).x =  200
    if bluebaron(i).x >  200 then bluebaron(i).x = -200
    if bluebaron(i).z < -200 then bluebaron(i).z =  200
    if bluebaron(i).z >  200 then bluebaron(i).z = -200
    
    player.fill camara.x , camara.y , camara.z
    plane.fill bluebaron(i).x , bluebaron(i).y , bluebaron(i).z
    if length( plane - player ) < 2 then done = 1
        
  next i
    rol = 0
    camara.move 0 , 0 , -.3 , 0
    if not getmouse( mousex , mousey ) then
    if mousex <> -1 and mousey <> -1 then
      if mousex < winx / 2 - 100 then
        hoek2 = ( winx / 2 - mousex ) / winx * 2
        camara.move 0 , 0 , 0 , hoek2
        rol = hoek2 * 45
      end if
      if mousex > winx / 2 + 100 then
        hoek2 = ( winx / 2 - mousex ) / winx * 2
        camara.move 0 , 0 , 0 , hoek2
        rol = 45 * hoek2
      end if
    end if
  end if
  
  if camara.x < -200 then camara.x =  200
  if camara.x >  200 then camara.x = -200
  if camara.z < -200 then camara.z =  200
  if camara.z >  200 then camara.z = -200

  sleep 40
  flip
loop until inkey = chr( 27 ) or done

_open_gl_dbl.bas

Code: Select all

''bluatigro 23 feb 2017
''_open_gl_dbl.bas 

#ifndef OPENGL_H
#define OPENGL_H

dim shared as integer mousex , mousey

''DBL3D

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

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

''MATH

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

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
  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 -pan , 0 , 1 , 0
  glTranslated -x , -y , -z
end sub

dim 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 sk( 63 ) as dbl3d

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( no as integer , x as double , y as double , z as double )
  sk( no and 63 ).x = x 
  sk( no and 63 ).y = y
  sk( no and 63 ).z = z
end sub

screen 20, 32 

dim shared as ubyte letterpart( 256 , 7 , 16 ) 
dim as integer j , k
dim as ulong kl
color &hffffff , 0
for i as byte = 0 to 255
  cls
  print chr( i )
  for j = 0 to 7
    for k = 0 to 16 
      kl = point( j , k )
      letterpart( i , j , k ) = 1 ''* iif( kl > 0 , 1 , 0 )
    next k
  next j
next i

declare sub setbox(x as double,y as double,z as double _
,dx as double,dy as double,dz as double )
declare sub cube()

sub digit( b as integer )
  dim as integer i , j
  for i = 0 to 16
    for j = 0 to 7
      if letterpart( b , j , i ) > 0 then
        setbox j*.1-.4,i*.1-.8,0 , .04,.04,.1
        cube
      end if
    next j
  next i
end sub

sub text( t as string )
  dim as integer i
  for i = 1 to len( t )
    glpushmatrix
      gltranslatef i - len( t ) / 2 - .5 , 0 , 0
      digit asc( mid( t , i , 1 ) )
    glpopmatrix
  next i
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, 200.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.5, 1.0                '' Blue 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 ) = { 0 , 50 , 0 , 1 }
dim as single diffuse( 3 ) = { 1 , 1 , 1 , 1 }
''dim as single ambient( 3 ) = { .2 , .2 , .2 , 1 }
glLightfv( gl_light0 , gl_position, @lightpos(0) )
glLightfv( gl_light0 , gl_diffuse , @diffuse(0) )
''glLightfv( gl_light0 , gl_ambient , @ambient(0) )
glEnable( gl_light0 )

''COLORS

type sng4d
  dim as single x , y , z , w
  declare sub fill( nx as single , ny as single , nz as single , nw as single )
end type
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

function rainbow( f as double ) as sng4d
  dim uit as sng4d
  uit.x = sin( rad( f ) ) / 2 + .5
  uit.y = sin( rad( f - 120 ) ) / 2 + .5
  uit.z = sin( rad( f + 120 ) ) / 2 + .5
  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

''PRIMATIVS

dim shared as dbl3d pnt( 256 )

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

sub five( p1 as integer _
  , p2 as integer , p3 as integer _
  , p4 as integer , p5 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
  if p5 < 0 or p5 > 255 then exit sub
  dim as dbl3d n = ( pnt( p2 ) - pnt( p1 ) ) _
               \ ( pnt( p3 ) - pnt( p1 ) )
  n.normalize()

  glbegin gl_polygon
    glnormal3d n.x , n.y , n.z
    glvertex3dv @ pnt( p1 ).x
    glvertex3dv @ pnt( p2 ).x 
    glvertex3dv @ pnt( p3 ).x 
    glvertex3dv @ pnt( p4 ).x 
    glvertex3dv @ pnt( p5 ).x
  glend 
end sub


sub six( p1 as integer _
  , p2 as integer , p3 as integer _
  , p4 as integer , p5 as integer _
  , p6 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
  if p5 < 0 or p5 > 255 then exit sub
  dim as dbl3d n = ( pnt( p2 ) - pnt( p1 ) ) _
               \ ( pnt( p3 ) - pnt( p1 ) )
  n.normalize()

  glbegin gl_polygon
    glnormal3d n.x , n.y , n.z
    glvertex3dv @ pnt( p1 ).x
    glvertex3dv @ pnt( p2 ).x 
    glvertex3dv @ pnt( p3 ).x 
    glvertex3dv @ pnt( p4 ).x 
    glvertex3dv @ pnt( p5 ).x
    glvertex3dv @ pnt( p6 ).x
  glend 
end sub


''SHAPES

type Tbox
  m as dbl3d
  d as dbl3d
end type
dim shared box as Tbox

declare sub isoca( i as integer )
declare sub sphere( h as integer , r as integer _
, a as double , b as double )
declare sub hsphere( h as integer , r as integer _
, t as integer , a as double , b as double )
declare sub torus( hsides as integer , rsides as integer )
declare sub cilinder( sides as integer _
, dx as double , dy as double , top as integer , bot as integer ) 
declare sub hcube( )
declare sub geo( no as integer , p1 as integer _
, p2 as integer , p3 as integer )

sub geo( no as integer , p1 as integer _
, p2 as integer , p3 as integer )
  if no < 1 then 
    tri p1 , p2 , p3 
  else
  dim p12 as integer , p13 as integer , p23 as integer
    p12 = 255 - no * 3
    p13 = 255 - no * 3 - 1
    p23 = 255 - no * 3 - 2
    pnt( p12 ) = ( pnt( p1 ) + pnt( p2 ) ) / 2
    pnt( p13 ) = ( pnt( p1 ) + pnt( p3 ) ) / 2
    pnt( p23 ) = ( pnt( p2 ) + pnt( p3 ) ) / 2
    pnt( p12 ).normalize
    pnt( p13 ).normalize
    pnt( p23 ).normalize
    geo no - 1 , p1 , p12 , p13
    geo no - 1 , p2 , p23 , p12
    geo no - 1 , p3 , p13 , p23
    geo no - 1 , p12 , p23 , p13
  end if
end sub

sub isoca( i as integer )
  if i < 0 then i = 0
  if i > 5 then i = 5
  glPushMatrix
  glTranslated box.m.x , box.m.y , box.m.z 
  glScaled box.d.x , box.d.y , box.d.z
    
  setpoint  1 ,  0       ,  0 , 1.118034
  setpoint  2 ,  1       ,  0         ,  .5 
  setpoint  3 ,  .309017 ,  .95105654 ,  .5 
  setpoint  4 , -.809017 ,  .58778524 ,  .5 
  setpoint  5 , -.809017 , -.58778524 ,  .5 
  setpoint  6 ,  .309017 , -.95105654 ,  .5 
  setpoint  7 ,  .809017 ,  .58778524 , -.5 
  setpoint  8 , -.309017 ,  .95105654 , -.5 
  setpoint  9 , -1       ,  0         , -.5 
  setpoint 10 , -.309017 , -.95105654 , -.5
  setpoint 11 ,  .809017 , -.58778524 , -.5 
  setpoint 12 ,  0       ,  0         , -1.118034
  dim t as integer
  for t = 1 to 12
    pnt( t ).normalize
  next t
  geo i , 1 ,  2 , 3
  geo i , 1 ,  3 ,  4 
  geo i , 1 ,  4 ,  5 
  geo i , 1 ,  5 ,  6 
  geo i , 1 ,  6 ,  2 
  geo i , 2 ,  7 ,  3
  geo i , 3 ,  7 ,  8 
  geo i , 3 ,  8 ,  4
  geo i , 4 ,  8 ,  9 
  geo i , 4 ,  9 ,  5 
  geo i , 5 ,  9 , 10 
  geo i , 5 , 10 ,  6 
  geo i , 6 , 10 , 11 
  geo i , 6 , 11 ,  2
  geo i , 2 , 11 ,  7 
  geo i , 12 ,  8 ,  7
  geo i , 12 ,  9 ,  8
  geo i , 12 , 10 ,  9 
  geo i , 12 , 11 , 10 
  geo i , 12 ,  7 , 11 
  glPopMatrix
end sub

sub sphere( a as integer , b as integer _
, da as double , db as double )
  dim as double i , j , i2 , j2 
  dim as double x , y , z
  if a < 3 then a = 3 
  if a > 64 then a = 64
  if b < 3 then b = 3 
  if b > 64 then b = 64
  glPushMatrix
  glTranslated box.m.x , box.m.y , box.m.z
  glScaled box.d.x , box.d.y , box.d.z
  for i = -PI to PI  step PI / a * 2 
    i2 = i + PI / a * 2 
    for j = -PI / 2 to PI / 2 - pi / b * 2 step PI / b * 2 
      j2 = j + PI / b * 2 

      x = sin( i ) * cos( j )
      y = sin( j )
      z = cos( i ) * cos( j )
      setpoint 0 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )

      x = sin( i2 ) * cos( j )
      y = sin( j )
      z = cos( i2 ) * cos( j )
      setpoint 1 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )
      
      x = sin( i2 ) * cos( j2 )
      y = sin( j2 )
      z = cos( i2 ) * cos( j2 )
      setpoint 2 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )
      
      x = sin( i ) * cos( j2 )
      y = sin( j2 )
      z = cos( i ) * cos( j2 )
      setpoint 3 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )
      
      quad 0 , 1 , 2 , 3 
    next j
  next i
  glPopMatrix
end sub

sub hsphere( a as integer , b as integer _
, t as integer , da as double , db as double )
  dim as double i , j , i2 , j2 
  dim as double x , y , z
  if a < 3 then a = 3 
  if a > 64 then a = 64
  if b < 3 then b = 3 
  if b > 64 then b = 64
  glPushMatrix
  glTranslated box.m.x , box.m.y , box.m.z
  glScaled box.d.x , box.d.y , box.d.z
  for i = -PI to PI  step PI / a * 2 
    i2 = i + PI / a * 2 
    for j = -PI / 2 to t * pi / b / 2 - pi / b * 2 step PI / b * 2 
      j2 = j + PI / b * 2 

      x = sin( i ) * cos( j )
      y = sin( j )
      z = cos( i ) * cos( j )
      setpoint 0 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )

      x = sin( i2 ) * cos( j )
      y = sin( j )
      z = cos( i2 ) * cos( j )
      setpoint 1 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )
      
      x = sin( i2 ) * cos( j2 )
      y = sin( j2 )
      z = cos( i2 ) * cos( j2 )
      setpoint 2 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )
      
      x = sin( i ) * cos( j2 )
      y = sin( j2 )
      z = cos( i ) * cos( j2 )
      setpoint 3 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )
      
      quad 0 , 1 , 2 , 3 
    next j
  next i
  glPopMatrix
end sub

sub torus( a as integer , b as integer )
  dim i as double , j as double , i2 as double , j2 as double
  if a < 3 then a = 3 
  if a > 64 then a = 643
  if b < 3 then b = 3 
  if b > 64 then b = 64 
  dim mx as double , my as double , mz as double , dx as double , dy as double , dz as double 
  mx = box.m.x 
  my = box.m.y 
  mz = box.m.z 
  dx = box.d.x 
  dy = box.d.y 
  dz = box.d.z 
  for i = -PI to PI  step PI / a * 2 
    i2 = i + PI / a * 2 
    for j = -PI to PI step PI / b * 2 
      j2 = j + PI / b * 2 
      setpoint 0 _ 
      , mx + ( dx + dy * cos( i ) ) * cos( j ) _
      , my + ( dx + dy * cos( i ) ) * sin( j ) _
      , mz + sin( i ) * dz  
      setpoint 1 _
      , mx + ( dx + dy * cos( i ) ) * cos( j2 ) _
      , my + ( dx + dy * cos( i ) ) * sin( j2 ) _
      , mz + sin( i ) * dz 
      setpoint 2 _
      , mx + ( dx + dy * cos( i2 ) ) * cos( j2 ) _
      , my + ( dx + dy * cos( i2 ) ) * sin( j2 ) _
      , mz + sin( i2 ) * dz 
      setpoint 3 _ 
      , mx + ( dx + dy * cos( i2 ) ) * cos( j ) _
      , my + ( dx + dy * cos( i2 ) ) * sin( j ) _
      , mz + sin( i2 ) * dz 
      quad 0 , 1 , 2 , 3 
    next j
  next i
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.m.x + sin( f * pi * 2 / sides ) * box.d.x _
               , box.m.y - box.d.y _
               , box.m.z + cos( f * pi * 2 / sides ) * box.d.z
    setpoint f + sides + 1 , box.m.x + sin( f * pi * 2 / sides ) * dx _
                           , box.m.y + box.d.y _
                           , box.m.z + 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.m.y + box.d.y , 0
    for f = 0 to sides
        setpoint f , box.m.x + sin( f * pi * 2 / sides ) * dx _
               , box.m.y + box.d.y _
               , box.m.z + 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.m.y - box.d.y , 0
    for f = 0 to sides + 2
        setpoint f , box.m.x - sin( f * pi * 2 / sides ) * box.d.x _
               , box.m.y - box.d.y _
               , box.m.z + cos( f * pi * 2 / sides ) * box.d.z  
    next f
    for f = 0 to sides + 2
      tri 255 , f , f + 1 
    next f
  end if
end sub

sub cube()
  setpoint 0 , box.m.x + box.d.x , box.m.y + box.d.y , box.m.z + box.d.z
  setpoint 1 , box.m.x + box.d.x , box.m.y + box.d.y , box.m.z - box.d.z
  setpoint 2 , box.m.x + box.d.x , box.m.y - box.d.y , box.m.z + box.d.z
  setpoint 3 , box.m.x + box.d.x , box.m.y - box.d.y , box.m.z - box.d.z
  setpoint 4 , box.m.x - box.d.x , box.m.y + box.d.y , box.m.z + box.d.z
  setpoint 5 , box.m.x - box.d.x , box.m.y + box.d.y , box.m.z - box.d.z
  setpoint 6 , box.m.x - box.d.x , box.m.y - box.d.y , box.m.z + box.d.z
  setpoint 7 , box.m.x - box.d.x , box.m.y - box.d.y , box.m.z - box.d.z
  quad 0 , 2 , 3 , 1 ''right
  quad 7 , 6 , 4 , 5 ''left
  quad 0 , 4 , 5 , 1 ''up
  quad 7 , 3 , 2 , 6 ''down
  quad 0 , 4 , 6 , 2 ''back
  quad 7 , 5 , 1 , 3 ''front
end sub

sub hcube()
  setpoint 1 , box.m.x + box.d.x , box.m.y + box.d.y , box.m.z - box.d.z
  setpoint 2 , box.m.x + box.d.x , box.m.y - box.d.y , box.m.z + box.d.z
  setpoint 3 , box.m.x + box.d.x , box.m.y - box.d.y , box.m.z - box.d.z
  setpoint 4 , box.m.x - box.d.x , box.m.y + box.d.y , box.m.z + box.d.z
  setpoint 5 , box.m.x - box.d.x , box.m.y + box.d.y , box.m.z - box.d.z
  setpoint 6 , box.m.x - box.d.x , box.m.y - box.d.y , box.m.z + box.d.z
  setpoint 7 , box.m.x - box.d.x , box.m.y - box.d.y , box.m.z - box.d.z
  
  setpoint 0 , box.m.x + box.d.x , box.m.y - box.d.y , 0
  setpoint 8 , box.m.x + box.d.x , 0 , box.m.z - box.d.z
  setpoint 9 , 0 , box.m.y + box.d.y , box.m.z - box.d.z
  setpoint 10 , box.m.x - box.d.x , box.m.x + box.d.y , 0
  setpoint 11 , box.m.x - box.d.x , 0 , box.m.z + box.d.z
  setpoint 12, 0 , box.m.y - box.d.y , box.m.z + box.d.z
  
  tri 7 , 6 , 3
  tri 7 , 5 , 6 
  tri 7 , 3 , 5 
  
  quad 6 , 5 , 10 , 11 
  quad 5 , 3 , 8 , 9 
  quad 3 , 6 , 12 , 0 
  
  tri 6 , 12 , 11 
  tri 3 , 8 , 0 
  tri 5 , 9 , 10 
end sub

sub setbox( mx as double , my as double , mz as double , dx as double , dy as double , dz as double )
  box.m.x = mx
  box.m.y = my
  box.m.z = mz
  box.d.x = dx
  box.d.y = dy
  box.d.z = dz
end sub


const as integer body = 0 
const as integer arm = 1
const as integer elbow = 2 
const as integer wrist = 3
const as integer leg = 4
const as integer knee = 5 
const as integer enkle = 6 
const as integer neck = 7
const as integer eye = 8 
const as integer ear = 9
const as integer wenk = 10
const as integer thumb = 11
const as integer index_finger = 14
const as integer mid_finger = 17
const as integer ring_finger = 21
const as integer tail = 24

const as integer iarm = 1
const as integer ielbow = 2
const as integer iwrist = 3
const as integer ileg = 4 
const as integer iknee = 9 
const as integer iwing = 14
const as integer itail = 16
const as integer isensor = 17
const as integer ithumb = 18
const as integer ifinger = 19

const as integer lr = 32

const as integer human_walk = 1
const as integer dog_walk = 2
const as integer I_FLY = 3
const as integer I_LEFT_LEGS = 4
const as integer I_LEFT_BOX = 5
const as integer I_RIGHT_LEGS = 6
const as integer I_RIGHT_BOX = 7
const as integer I_STING = 8
const as integer I_STAND = 9

sub animate( anim as integer , f as double , a as double )
  DIM I AS INTEGER
  select case anim
  case human_walk
    skelet arm , pend( f , a ) , 0 , 0
    skelet elbow , -abs( a ) , 0 , 0
    skelet arm + lr , pend( f + 180, a ) , 0 , 0
    skelet elbow + lr , -abs( a ) , 0 , 0
    skelet leg , pend( f + 180 , a ) , 0 , 0
    skelet knee , pend( f + 90 , a ) + a , 0 , 0
    skelet leg + lr , pend( f , a ) , 0 , 0
    skelet knee + lr , pend( f - 90 , a ) + a , 0 , 0
  case dog_walk
    skelet arm , pend( f + 180 , a ) , 0 , 0
    skelet elbow , pend( f + 90 , a ) + a , 0 , 0
    skelet arm + lr , pend( f , a ) , 0 , 0
    skelet elbow + lr , pend( f - 90 , a ) + a , 0 , 0
    skelet leg , pend( f + 180 , a ) , 0 , 0
    skelet knee , pend( f + 90 , a ) + a , 0 , 0
    skelet leg + lr , pend( f , a ) , 0 , 0
    skelet knee + lr , pend( f - 90 , a ) + a , 0 , 0
    skelet tail , -45 , pend( f * 2 , a ) , 0
    skelet neck , 0 , 0 , 0
    skelet neck + lr , 0 , 0 , 0
  Case I_FLY
    For i = 0 To 1
      skelet iwing + i, 0 , 0 , Pend(f, a)
      skelet iwing+lr + i, 0,0, Pend(f, -a)
    Next
  Case I_LEFT_BOX
    skelet iarm, 0, Pend(f, -a) + 45 , 0
    skelet ielbow, 0, Pend(f, a * 2) - 60 , 0
  Case I_LEFT_LEGS
    For i = 0 To 4
      skelet ileg + i, 0 , 0, Pend(f + i * 180, a)
      skelet iknee + i, Pend(f + i * 180 + 90, a) , 0 , 0
    Next
  Case I_RIGHT_BOX
    skelet iarm+lr, 0, Pend(f, a) - 45,0
    skelet ielbow+lr, 0, Pend(f, -a * 2) + 60, 0
  Case I_RIGHT_LEGS
    For i = 0 To 4
      skelet ileg+lr+ i, 0,0, Pend(f + i * 180, a)
      skelet iknee+lr + i, Pend(f + i * 180 + 90, a),0,0
    Next
  Case I_STAND
    skelet iarm, 0, 45, 0
    skelet ielbow, 0, -60 , 0
    skelet ifinger, 0, 0, 0
    skelet ithumb, 0, 0, 0
    skelet iarm+lr, 0, -45, 0
    skelet ielbow+lr, 0, 60 , 0
    skelet ifinger+lr, 0, 0, 0
    skelet ithumb+lr, 0, 0, 0
    skelet itail, 10, 0 , 0
    skelet itail+lr, 10, 0 , 0
  Case I_STING
    skelet itail, 10 + Pend(f, a), 0, 0
    skelet itail+lr, 10 - Pend(f, a), 0, 0
  case else
    dim i as integer
    for i = 0 to 63
      skelet i , 0,0,0
    next i
  end select
end sub

sub insect()
  Dim i as integer
glPushmatrix
  glScaled .01 , .01 , .01
  setbox 0, 0, 0, 30, 10.0, 60.0
  Cube
  For i = 0 To 4
    glPushMatrix
      child 35.0, 0.0, i * 25 - 50 , ileg + i, xyz
      setbox 30.0, 0.0, 0.0, 30.0, 5.0, 5.0
      Cube
      glPushMatrix
        child 65.0, -5.0, 0.0 , iknee + i, xyz
        setbox 0.0, -30.0, 0.0, 5.0, 30.0, 5.0
        Cube
      glPopMatrix
    glPopMatrix
    glpushMatrix
      child -35.0, 0.0, i * 25 - 50, ileg + lr + i, xyz
      setbox -30.0, 0.0, 0.0, 30.0, 5.0, 5.0
      Cube 
      glPushMatrix
        child -65.0, -5.0, 0.0 , iknee + lr + 1, xyz
        setbox 0.0, -30.0, 0.0, 5.0, 30.0, 5.0
        Cube
      glPopmatrix
    glPopMatrix
  Next
  glPushMatrix
    child 0 , 0 , -50 , itail , xyz
    For i = 0 To 9
      glPushMatrix
        child 0.0, 0.0, -30.0 , itail, xyz
        setbox 0.0, 0.0, -15.0, 10.0, 10.0, 10.0
        Cube
    Next
    for i = 0 to 8
        glPushMatrix
          child 0 , 0 , -30 , itail+lr , xyz
          cube
    next i
    for i = 0 to 8
        glPopMatrix
      glPopMatrix
    next i
  glPopMatrix
  glPushMatrix
    child 30.0, 0.0, 65.0, iarm, xyz
    setbox 0.0, 0.0, 30.0, 5.0, 5.0, 30.0
    Cube
    glPushMatrix
      child 0.0, 0.0, 65.0, ielbow, xyz
      Cube
      glPushmatrix
        child 0.0, 0.0, 65.0 , iwrist, xyz
        glPushmatrix
          child -10.0, 0.0, 5.0 , ithumb, xyz
          Cube
        glPopMatrix
        glPushMatrix
          child 5.0, 0.0, 5.0, ifinger, xyz
          setbox 0.0, 0.0, 30.0, 5.0, 10.0, 30.0
          Cube
        glPopMatrix
      glPopMatrix
    glPopMatrix
  glPopMatrix
  glPushMatrix
    child -30.0, 0.0, 65.0, iarm + lr, xyz
    setbox 0.0, 0.0, 30.0, 5.0, 5.0, 30.0
    Cube
    glPushMatrix
      child 0.0, 0.0, 65.0, ielbow +lr, xyz
      Cube
      glPushMatrix
        child 0.0, 0.0, 65.0, iwrist+lr, xyz
        glPushMatrix
          child 10.0, 0.0, 5.0, ithumb+lr, xyz
          Cube
        glPopMatrix
        glPushMatrix
          child -5.0, 0.0, 5.0, ifinger+lr, xyz
          setbox 0.0, 0.0, 30.0, 5.0, 10.0, 30.0
          Cube
        glPopMatrix
      glPopMatrix
    glPopMatrix
   glPopMatrix
   For i = 0 To 1
     glPushMatrix
       child 20.0, 20.0, 40.0 - 50.0 * i, iwing + i, xyz
       setbox 60.0, 0.0, 8.0, 60.0, 2.0, 16.0
       Cube
     glPopMatrix
     glPushMatrix
       child -20.0, 20.0, 40.0 - 50.0 * i , iwing+lr + i,  xyz
       setbox -60.0, 0.0, 8.0, 60.0, 2.0, 16.0
       Cube
     glPopmatrix
   Next
glPopMatrix
end sub

sub kootjes( f as integer )
  setbox 0,-.2,0 , .1,.1,.1
  cube
  glpushmatrix
    child 0,-.2,0 , f + 1 , xyz
    cube
    glpushmatrix
      child 0,-.2,0 , f + 2 , xyz
      cube
    glpopmatrix
  glpopmatrix
end sub

sub hand( kl as sng4d , i as integer )
  material.diffuse = kl
''  material.ambient = kl
  setmaterial gl_front , material
  glpushmatrix
    setbox 0,-.3,0 , .1,.3,.3
    cube
    glpushmatrix
      child 0,-.6,.2 , index_finger + i , xyz
      kootjes index_finger + i
    glpopmatrix
    glpushmatrix
      child 0,-.6,0 , mid_finger + i , xyz
      kootjes mid_finger + i
    glpopmatrix
    glpushmatrix
      child 0,-.6,-.2 , ring_finger + i , xyz
      kootjes ring_finger + i
    glpopmatrix
    glpushmatrix
      child 0,-.2,.4 , thumb + i , xyz
      kootjes thumb + i
    glpopmatrix
  glpopmatrix
end sub

sub human( kl as sng4d )
  material.diffuse = kl
''  material.ambient = kl
  setmaterial gl_front , material
  setbox  0 , 0 , 0  ,  .5 , .1 , .1
  cube 
  setbox 0 , .75 , 0 , .1 , .5 , .1
  cube 
  setbox 0 , 1.8 , 0 , .2 , .2 , .2
  cube 
  setbox 0 , 1.4 , 0 , .7 , .1 , .1
  cube 
  glPushMatrix
    child .45 , 0 , 0 , leg , zyx
    setbox 0 , -.6 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , knee , xyz
      cube 
      glPushMatrix
        child 0 , -1.2 , 0 , enkle , xyz
        setbox 0 , 0 , .2 , .1 , .1 , .3
        cube 
      glPopMatrix
    glPopMatrix
  glPopMatrix
  glPushMatrix
    child -.45 , 0 , 0 , leg + lr , zyx
    setbox 0 , -.6 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , knee + lr , xyz
      cube 
      glPushMatrix
        child 0 , -1.2 , 0 , enkle + lr , xyz 
        setbox 0 , 0 , .2 , .1 , .1 , .3
        cube 
      glPopMatrix
    glPopMatrix
  glPopMatrix
  glPushMatrix
    child .65 , 1.3 , 0 , arm , xyz
    setbox 0 , -.5 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , elbow , xyz
      cube 
      glPushMatrix
        child 0 , -1 , 0 , wrist , zyx
        glscalef .5,.5,.5
        hand white , 0
      glPopMatrix
    glPopMatrix
  glPopMatrix
  material.diffuse = kl
''  material.ambient = kl
  setmaterial gl_front , material  
  glPushMatrix
    child -.65 , 1.3 , 0 , arm + lr , xyz
    setbox 0 , -.5 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , elbow + lr , xyz
      cube 
      glPushMatrix
        child 0 , -1 , 0 , wrist + lr , zyx
        glscalef .5,.5,.5
        hand white , lr
      glPopMatrix
    glPopMatrix
  glPopMatrix
end sub

sub dog()
  setbox 0,.2,.5 , .3,.3,.7
  cube
  glpushmatrix
    child 0 , .6 , 1.5 , neck , xyz
    glpushmatrix
      child 0 , 0 , 0 , neck + lr , zyx
      setbox 0,0,0 , .3 , .3 , .3
      cube
      setbox 0,-.2,.3 , .2,.2,.2
      cube
      setbox 0,0,.5 , .1,.1,.1
      cube
      setbox .3,-.15,0 , .05,.3,.2
      cube
      setbox -.3,-.15,0 , .05,.3,.2
      cube
    glpopmatrix
  glpopmatrix
  glpushmatrix
    child 0 , .4 , -.5 , tail , yzx
    setbox 0,.3,0 , .1 , .3 , .1
    cube
  glpopmatrix
  glPushMatrix
    child .3 , 0 , 1 , leg , zyx
    setbox 0 , -.6 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , knee , xyz
      cube 
      glPushMatrix
        child 0 , -1.2 , 0 , enkle , xyz
        setbox 0 , 0 , .2 , .1 , .1 , .3
        cube 
      glPopMatrix
    glPopMatrix
  glPopMatrix
  glPushMatrix
    child -.3 , 0 , 1 , leg + lr, zyx
    setbox 0 , -.6 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , knee + lr, xyz
      cube 
      glPushMatrix
        child 0 , -1.2 , 0 , enkle + lr, xyz
        setbox 0 , 0 , .2 , .1 , .1 , .3
        cube 
      glPopMatrix
    glPopMatrix
  glPopMatrix
  glPushMatrix
    child .3 , 0 , 0 , arm , zyx
    setbox 0 , -.6 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , elbow , xyz
      cube 
      glPushMatrix
        child 0 , -1.2 , 0 , wrist , xyz
        setbox 0 , 0 , .2 , .1 , .1 , .3
        cube 
      glPopMatrix
    glPopMatrix
  glPopMatrix
  glPushMatrix
    child -.3 , 0 , 0 , arm + lr , zyx
    setbox 0 , -.6 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , elbow + lr , xyz
      cube 
      glPushMatrix
        child 0 , -1.2 , 0 , wrist + lr , xyz
        setbox 0 , 0 , .2 , .1 , .1 , .3
        cube 
      glPopMatrix
    glPopMatrix
  glPopMatrix
end sub


sub driehoek( p1 as integer , p2 as integer _
  , p3 as integer , kl as sng4d )
  material.diffuse = kl
''  material.ambient = kl
  setmaterial gl_front_and_back , material
  tri p1 , p2 , p3
end sub

sub vierhoek( p1 as integer , p2 as integer _
  , p3 as integer , p4 as integer , kl as sng4d )
  material.diffuse = kl
''  material.ambient = kl
  setmaterial gl_front , material
  quad p1 , p2 , p3 , p4
end sub 

sub bol( x as single , y as single , z as single _
  , d as single , kl as sng4d )
  material.diffuse = kl
''  material.ambient = kl
  setmaterial gl_front , material
  setbox x,y,z , d,d,d
  sphere 12,12,1,1
end sub 

sub kubus( kl as sng4d )
  material.diffuse = kl
''  material.ambient = kl
  setmaterial gl_front , material
  cube
end sub

sub lino( x1 as double , y1 as double , z1 as double _
  , x2 as double , y2 as double , z2 as double _
  , kl as sng4d )
  glBegin GL_LINES
    glColor4fv @ kl.x
    glVertex3d x1 , y1 , z1
    glVertex3d x2 , y2 , z2
  glEnd
end sub



#endif

[bluatigro]

update :
t_material has now use method

Code: Select all

''bluatigro 24 apr 2017
''open gl demo

#include "_open-gl.bas"

dim as double hoek
dim as integer state , frame

camara.z = 10

do
  glClear GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT

  camara.use
  
  hoek = frame * 360 / 32
  
  glpushmatrix
  glrotated 30 , 0,1,0
  select case state
    case 0
      animate human_walk , hoek , 30
      human rainbow( hoek ) 
    case 1
      animate dog_walk , hoek , 30
      material.diffuse = rainbow( hoek )
      material.ambient = rainbow( hoek )
      material.use gl_front 
      dog
    case 2
      animate 0 , 0 , 0
      animate i_stand , 0 , 0
      animate i_sting , hoek , 7
      material.diffuse = rainbow( hoek )
      material.ambient = rainbow( hoek )
      material.use gl_front 
      insect
    case else
  end select
  glpopmatrix
  
  frame += 1
  if frame > 32 * 5 then
    frame = 0
    state += 1
  end if
  if state > 2 then
    state = 0
  end if
  sleep 40
  flip
loop until inkey = chr( 27 )

Code: Select all

''bluatigro 24 apr 2017
''_open-gl.bas 

#ifndef OPENGL_H
#define OPENGL_H

''VECTOR3D

type t3d
  x as single
  y as single
  z as single
  declare constructor()
  declare constructor ( x as single , y as single, z as single )
  declare sub fill( x as single , y as single , z as single )
  declare sub normalize
end type
constructor t3d()
  this.x = 0
  this.y = 0
  this.z = 0
end constructor 
constructor t3d( x as single , y as single , z as single )
  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 single ) 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 single ) as t3d
  return type( a.x / d , a.y / d , a.z / d )
end operator
sub t3d.fill( x as single , y as single , z as single )
  this.x = x
  this.y = y
  this.z = z
end sub
declare function dot( a as t3d , b as t3d ) as single
function dot( a as t3d , b as t3d ) as single
  return a.x * b.x + a.y * b.y + a.z * b.z
end function
declare function length( q as t3d ) as single
function length( q as t3d ) as single
   return sqr( q.x * q.x + q.y * q.y + q.z * q.z ) + 1e-7
end function  
declare function anlge( a as t3d , b as t3d ) as single
function getangle( a as t3d , b as t3d ) as single
  return acos( dot( a , b ) _
  / ( length( a ) * length( b ) ) )
end function
sub t3d.normalize
  this /= length( this )
end sub

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

''MATH

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

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

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

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

sub rotate( byref k as single , byref l as single , deg as single )
  dim as single 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 single x,y,z,pan
  declare sub move( dx as single _
  , dy as single , dz as single , dpan as single )
  declare sub use()
end type
sub t_camara.move( dx as single _
  , dy as single , dz as single , dpan as single )
  rotate dx , dz , -pan
  x += dx
  y += dy
  z += dz
  pan += dpan
end sub
sub t_camara.use
  glLoadIdentity
  glRotatef -pan , 0 , 1 , 0
  glTranslatef -x , -y , -z
end sub

dim as t_camara camara

''3DENGINE

declare sub child( x as single , y as single , z as single , ax as integer , lim as integer )
declare function pend( fase as single , amp as single ) as single
declare sub skelet( no as integer , x as single , y as single , z as single )
dim shared sk( 63 ) as t3d

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 single , y as single , z as single , lim as integer , ax as integer )
  glTranslatef x , y , z
  select case ax
    case xyz
      glRotatef sk( lim ).x , 1 , 0 , 0
      glRotatef sk( lim ).y , 0 , 1 , 0
      glRotatef sk( lim ).z , 0 , 0 , 1
    case xzy
      glRotatef sk( lim ).x , 1 , 0 , 0
      glRotatef sk( lim ).z , 0 , 0 , 1
      glRotatef sk( lim ).y , 0 , 1 , 0
    case yxz
      glRotatef sk( lim ).y , 0 , 1 , 0
      glRotatef sk( lim ).x , 1 , 0 , 0
      glRotatef sk( lim ).z , 0 , 0 , 1
    case yzx
      glRotatef sk( lim ).y , 0 , 1 , 0
      glRotatef sk( lim ).z , 0 , 0 , 1
      glRotatef sk( lim ).x , 1 , 0 , 0
    case zxy
      glRotatef sk( lim ).z , 0 , 0 , 1
      glRotatef sk( lim ).x , 1 , 0 , 0
      glRotatef sk( lim ).y , 0 , 1 , 0
    case zyx
      glRotatef sk( lim ).z , 0 , 0 , 1
      glRotatef sk( lim ).y , 0 , 1 , 0
      glRotatef sk( lim ).x , 1 , 0 , 0
    case else
  end select  
end sub

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

sub skelet( no as integer , x as single , y as single , z as single )
  sk( no and 63 ).x = x 
  sk( no and 63 ).y = y
  sk( no and 63 ).z = z
end sub

screen 20, 32 

dim shared as ubyte letterpart( 256 , 7 , 16 ) 
dim as integer j , k
dim as ulong kl
color &hffffff , 0
for i as byte = 0 to 255
  cls
  print chr( i )
  for j = 0 to 7
    for k = 0 to 16 
      kl = point( j , k )
      letterpart( i , j , k ) = 1 ''* iif( kl > 0 , 1 , 0 )
    next k
  next j
next i

declare sub setbox(x as single,y as single,z as single _
,dx as single,dy as single,dz as single )
declare sub cube()

sub digit( b as integer )
  dim as integer i , j
  for i = 0 to 16
    for j = 0 to 7
      if letterpart( b , j , i ) = 1 then
        setbox j*.1-.4,i*.1-.8,0 , .04,.04,.1
        cube
      end if
    next j
  next i
end sub

sub text( t as string )
  dim as integer i
  for i = 1 to len( t )
    glpushmatrix
      gltranslatef i - len( t ) / 2 - .5 , 0 , 0
      digit asc( mid( t , i , 1 ) )
    glpopmatrix
  next i
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 ) = { 0 , 50 , 0 , 1 }
dim as single diffuse( 3 ) = { .7 , .7 , .7 , .7 }
dim as single ambient( 3 ) = { .3 , .3 , .3 , .3 }
glLightfv( gl_light0 , gl_position, @lightpos(0) )
glLightfv( gl_light0 , gl_diffuse , @diffuse(0) )
gllightfv( gl_light0 , gl_ambient , @ambient(0) )
glEnable( gl_light0 )

''COLORS

type t_4d
  dim as single x , y , z , w
  declare sub fill( nx as single , ny as single , nz as single , nw as single )
end type
sub t_4d.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 t_4d 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 t_4d , f as single , b as t_4d ) as t_4d 
  dim uit as t_4d
  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

function rainbow( f as single ) as t_4d
  dim uit as t_4d
  uit.x = sin( rad( f ) ) / 2 + .5
  uit.y = sin( rad( f - 120 ) ) / 2 + .5
  uit.z = sin( rad( f + 120 ) ) / 2 + .5
  uit.w = 1
  return uit
end function  

''MATERIAL

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

''PRIMATIVS

dim shared as t3d pnt( 256 )

sub setpoint( no as integer , x as single , y as single , z as single )
  if no < 0 or no > ubound( pnt ) then exit sub
  pnt( no ).x = x
  pnt( no ).y = y
  pnt( no ).z = 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 t3d n = ( pnt( p2 ) - pnt( p1 ) ) _
               \ ( pnt( p3 ) - pnt( p1 ) )
  n.normalize()
  glbegin gl_triangles
    glnormal3f n.x , n.y , n.z
    glvertex3f pnt( p1 ).x , pnt( p1 ).y , pnt( p1 ).z
    glvertex3f pnt( p2 ).x , pnt( p2 ).y , pnt( p2 ).z
    glvertex3f 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 t3d zp = ( pnt( p1 ) + pnt( p2 ) _
  + pnt( p3 ) + pnt( p4 ) ) / 4
  dim as t3d n = ( pnt( p2 ) - zp ) _
               \ ( pnt( p3 ) - zp )
  n.normalize()
  glbegin gl_quads
    glnormal3f n.x , n.y , n.z
    glvertex3f pnt( p1 ).x , pnt( p1 ).y , pnt( p1 ).z
    glvertex3f pnt( p2 ).x , pnt( p2 ).y , pnt( p2 ).z
    glvertex3f pnt( p3 ).x , pnt( p3 ).y , pnt( p3 ).z
    glvertex3f pnt( p4 ).x , pnt( p4 ).y , pnt( p4 ).z
  glend 
end sub

''SHAPES

type Tbox
  m as t3d
  d as t3d
end type
dim shared box as Tbox

declare sub isoca( i as integer )
declare sub sphere( h as integer , r as integer _
, a as single , b as single )
declare sub hsphere( h as integer , r as integer _
, t as integer , a as single , b as single )
declare sub torus( hsides as integer , rsides as integer )
declare sub cilinder( sides as integer _
, dx as single , dy as single , top as integer , bot as integer ) 
declare sub hcube( )
declare sub geo( no as integer , p1 as integer _
, p2 as integer , p3 as integer )

sub geo( no as integer , p1 as integer _
, p2 as integer , p3 as integer )
  if no < 1 then 
    tri p1 , p2 , p3 
  else
  dim p12 as integer , p13 as integer , p23 as integer
    p12 = 255 - no * 3
    p13 = 255 - no * 3 - 1
    p23 = 255 - no * 3 - 2
    pnt( p12 ) = ( pnt( p1 ) + pnt( p2 ) ) / 2
    pnt( p13 ) = ( pnt( p1 ) + pnt( p3 ) ) / 2
    pnt( p23 ) = ( pnt( p2 ) + pnt( p3 ) ) / 2
    pnt( p12 ).normalize
    pnt( p13 ).normalize
    pnt( p23 ).normalize
    geo no - 1 , p1 , p12 , p13
    geo no - 1 , p2 , p23 , p12
    geo no - 1 , p3 , p13 , p23
    geo no - 1 , p12 , p23 , p13
  end if
end sub

sub isoca( i as integer )
  if i < 0 then i = 0
  if i > 5 then i = 5
  glPushMatrix
  glTranslatef box.m.x , box.m.y , box.m.z 
  glScalef box.d.x , box.d.y , box.d.z
    
  setpoint  1 ,  0       ,  0 , 1.118034
  setpoint  2 ,  1       ,  0         ,  .5 
  setpoint  3 ,  .309017 ,  .95105654 ,  .5 
  setpoint  4 , -.809017 ,  .58778524 ,  .5 
  setpoint  5 , -.809017 , -.58778524 ,  .5 
  setpoint  6 ,  .309017 , -.95105654 ,  .5 
  setpoint  7 ,  .809017 ,  .58778524 , -.5 
  setpoint  8 , -.309017 ,  .95105654 , -.5 
  setpoint  9 , -1       ,  0         , -.5 
  setpoint 10 , -.309017 , -.95105654 , -.5
  setpoint 11 ,  .809017 , -.58778524 , -.5 
  setpoint 12 ,  0       ,  0         , -1.118034
  dim t as integer
  for t = 1 to 12
    pnt( t ).normalize
  next t
  geo i , 1 ,  2 , 3
  geo i , 1 ,  3 ,  4 
  geo i , 1 ,  4 ,  5 
  geo i , 1 ,  5 ,  6 
  geo i , 1 ,  6 ,  2 
  geo i , 2 ,  7 ,  3
  geo i , 3 ,  7 ,  8 
  geo i , 3 ,  8 ,  4
  geo i , 4 ,  8 ,  9 
  geo i , 4 ,  9 ,  5 
  geo i , 5 ,  9 , 10 
  geo i , 5 , 10 ,  6 
  geo i , 6 , 10 , 11 
  geo i , 6 , 11 ,  2
  geo i , 2 , 11 ,  7 
  geo i , 12 ,  8 ,  7
  geo i , 12 ,  9 ,  8
  geo i , 12 , 10 ,  9 
  geo i , 12 , 11 , 10 
  geo i , 12 ,  7 , 11 
  glPopMatrix
end sub

sub sphere( a as integer , b as integer _
, da as single , db as single )
  dim as single i , j , i2 , j2 
  dim as single x , y , z
  if a < 3 then a = 3 
  if a > 64 then a = 64
  if b < 3 then b = 3 
  if b > 64 then b = 64
  glPushMatrix
  glTranslatef box.m.x , box.m.y , box.m.z
  glScalef box.d.x , box.d.y , box.d.z
  for i = -PI to PI  step PI / a * 2 
    i2 = i + PI / a * 2 
    for j = -PI / 2 to PI / 2 - pi / b * 2 step PI / b * 2 
      j2 = j + PI / b * 2 

      x = sin( i ) * cos( j )
      y = sin( j )
      z = cos( i ) * cos( j )
      setpoint 0 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )

      x = sin( i2 ) * cos( j )
      y = sin( j )
      z = cos( i2 ) * cos( j )
      setpoint 1 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )
      
      x = sin( i2 ) * cos( j2 )
      y = sin( j2 )
      z = cos( i2 ) * cos( j2 )
      setpoint 2 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )
      
      x = sin( i ) * cos( j2 )
      y = sin( j2 )
      z = cos( i ) * cos( j2 )
      setpoint 3 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )
      
      quad 0 , 1 , 2 , 3 
    next j
  next i
  glPopMatrix
end sub

sub hsphere( a as integer , b as integer _
, t as integer , da as single , db as single )
  dim as single i , j , i2 , j2 
  dim as single x , y , z
  if a < 3 then a = 3 
  if a > 64 then a = 64
  if b < 3 then b = 3 
  if b > 64 then b = 64
  glPushMatrix
  glTranslatef box.m.x , box.m.y , box.m.z
  glScalef box.d.x , box.d.y , box.d.z
  for i = -PI to PI  step PI / a * 2 
    i2 = i + PI / a * 2 
    for j = -PI / 2 to t * pi / b / 2 - pi / b * 2 step PI / b * 2 
      j2 = j + PI / b * 2 

      x = sin( i ) * cos( j )
      y = sin( j )
      z = cos( i ) * cos( j )
      setpoint 0 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )

      x = sin( i2 ) * cos( j )
      y = sin( j )
      z = cos( i2 ) * cos( j )
      setpoint 1 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )
      
      x = sin( i2 ) * cos( j2 )
      y = sin( j2 )
      z = cos( i2 ) * cos( j2 )
      setpoint 2 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )
      
      x = sin( i ) * cos( j2 )
      y = sin( j2 )
      z = cos( i ) * cos( j2 )
      setpoint 3 _
      , abs( x ) ^ da * sgn( x ) _
      , abs( y ) ^ db * sgn( y ) _
      , abs( z ) ^ da * sgn( z )
      
      quad 0 , 1 , 2 , 3 
    next j
  next i
  glPopMatrix
end sub

sub torus( a as integer , b as integer )
  dim i as single , j as single , i2 as single , j2 as single
  if a < 3 then a = 3 
  if a > 64 then a = 643
  if b < 3 then b = 3 
  if b > 64 then b = 64 
  dim mx as single , my as single , mz as single , dx as single , dy as single , dz as single 
  mx = box.m.x 
  my = box.m.y 
  mz = box.m.z 
  dx = box.d.x 
  dy = box.d.y 
  dz = box.d.z 
  for i = -PI to PI  step PI / a * 2 
    i2 = i + PI / a * 2 
    for j = -PI to PI step PI / b * 2 
      j2 = j + PI / b * 2 
      setpoint 0 _ 
      , mx + ( dx + dy * cos( i ) ) * cos( j ) _
      , my + ( dx + dy * cos( i ) ) * sin( j ) _
      , mz + sin( i ) * dz  
      setpoint 1 _
      , mx + ( dx + dy * cos( i ) ) * cos( j2 ) _
      , my + ( dx + dy * cos( i ) ) * sin( j2 ) _
      , mz + sin( i ) * dz 
      setpoint 2 _
      , mx + ( dx + dy * cos( i2 ) ) * cos( j2 ) _
      , my + ( dx + dy * cos( i2 ) ) * sin( j2 ) _
      , mz + sin( i2 ) * dz 
      setpoint 3 _ 
      , mx + ( dx + dy * cos( i2 ) ) * cos( j ) _
      , my + ( dx + dy * cos( i2 ) ) * sin( j ) _
      , mz + sin( i2 ) * dz 
      quad 0 , 1 , 2 , 3 
    next j
  next i
end sub

sub cilinder( sides as integer , dx as single , dy as single , top as integer , bot as integer )
  dim f as single
  if sides < 3 then sides = 3
  if sides > 64 then sides = 64
  for f = 0 to sides + 2
    setpoint f , box.m.x + sin( f * pi * 2 / sides ) * box.d.x _
               , box.m.y - box.d.y _
               , box.m.z + cos( f * pi * 2 / sides ) * box.d.z
    setpoint f + sides + 1 , box.m.x + sin( f * pi * 2 / sides ) * dx _
                           , box.m.y + box.d.y _
                           , box.m.z + 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.m.y + box.d.y , 0
    for f = 0 to sides
        setpoint f , box.m.x + sin( f * pi * 2 / sides ) * dx _
               , box.m.y + box.d.y _
               , box.m.z + 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.m.y - box.d.y , 0
    for f = 0 to sides + 2
        setpoint f , box.m.x - sin( f * pi * 2 / sides ) * box.d.x _
               , box.m.y - box.d.y _
               , box.m.z + cos( f * pi * 2 / sides ) * box.d.z  
    next f
    for f = 0 to sides + 2
      tri 255 , f , f + 1 
    next f
  end if
end sub

sub cube()
  setpoint 0 , box.m.x + box.d.x , box.m.y + box.d.y , box.m.z + box.d.z
  setpoint 1 , box.m.x + box.d.x , box.m.y + box.d.y , box.m.z - box.d.z
  setpoint 2 , box.m.x + box.d.x , box.m.y - box.d.y , box.m.z + box.d.z
  setpoint 3 , box.m.x + box.d.x , box.m.y - box.d.y , box.m.z - box.d.z
  setpoint 4 , box.m.x - box.d.x , box.m.y + box.d.y , box.m.z + box.d.z
  setpoint 5 , box.m.x - box.d.x , box.m.y + box.d.y , box.m.z - box.d.z
  setpoint 6 , box.m.x - box.d.x , box.m.y - box.d.y , box.m.z + box.d.z
  setpoint 7 , box.m.x - box.d.x , box.m.y - box.d.y , box.m.z - box.d.z
  quad 0 , 2 , 3 , 1 ''right
  quad 7 , 6 , 4 , 5 ''left
  quad 0 , 4 , 5 , 1 ''up
  quad 7 , 3 , 2 , 6 ''down
  quad 0 , 4 , 6 , 2 ''back
  quad 7 , 5 , 1 , 3 ''front
end sub

sub hcube()
  setpoint 1 , box.m.x + box.d.x , box.m.y + box.d.y , box.m.z - box.d.z
  setpoint 2 , box.m.x + box.d.x , box.m.y - box.d.y , box.m.z + box.d.z
  setpoint 3 , box.m.x + box.d.x , box.m.y - box.d.y , box.m.z - box.d.z
  setpoint 4 , box.m.x - box.d.x , box.m.y + box.d.y , box.m.z + box.d.z
  setpoint 5 , box.m.x - box.d.x , box.m.y + box.d.y , box.m.z - box.d.z
  setpoint 6 , box.m.x - box.d.x , box.m.y - box.d.y , box.m.z + box.d.z
  setpoint 7 , box.m.x - box.d.x , box.m.y - box.d.y , box.m.z - box.d.z
  
  setpoint 0 , box.m.x + box.d.x , box.m.y - box.d.y , 0
  setpoint 8 , box.m.x + box.d.x , 0 , box.m.z - box.d.z
  setpoint 9 , 0 , box.m.y + box.d.y , box.m.z - box.d.z
  setpoint 10 , box.m.x - box.d.x , box.m.x + box.d.y , 0
  setpoint 11 , box.m.x - box.d.x , 0 , box.m.z + box.d.z
  setpoint 12, 0 , box.m.y - box.d.y , box.m.z + box.d.z
  
  tri 7 , 6 , 3
  tri 7 , 5 , 6 
  tri 7 , 3 , 5 
  
  quad 6 , 5 , 10 , 11 
  quad 5 , 3 , 8 , 9 
  quad 3 , 6 , 12 , 0 
  
  tri 6 , 12 , 11 
  tri 3 , 8 , 0 
  tri 5 , 9 , 10 
end sub

sub setbox( mx as single , my as single , mz as single , dx as single , dy as single , dz as single )
  box.m.x = mx
  box.m.y = my
  box.m.z = mz
  box.d.x = dx
  box.d.y = dy
  box.d.z = dz
end sub


const as integer body = 0 
const as integer arm = 1
const as integer elbow = 2 
const as integer wrist = 3
const as integer leg = 4
const as integer knee = 5 
const as integer enkle = 6 
const as integer neck = 7
const as integer eye = 8 
const as integer ileg = 4 
const as integer iknee = 9 
const as integer wing = 14
const as integer tail = 16
const as integer sensor = 17
const as integer thumb = 18
const as integer finger = 19
const as integer index_finger = 21
const as integer mid_finger = 24
const as integer ring_finger = 27
const as integer ear = 30
const as integer wenk = 31
const as integer lr = 32

const as integer human_walk = 1
const as integer dog_walk = 2
const as integer I_FLY = 3
const as integer I_LEFT_LEGS = 4
const as integer I_LEFT_BOX = 5
const as integer I_RIGHT_LEGS = 6
const as integer I_RIGHT_BOX = 7
const as integer I_STING = 8
const as integer I_STAND = 9

sub animate( anim as integer , f as single , a as single )
  DIM I AS INTEGER
  select case anim
  case human_walk
    skelet arm , pend( f , a ) , 0 , 0
    skelet elbow , -abs( a ) , 0 , 0
    skelet arm + lr , pend( f + 180, a ) , 0 , 0
    skelet elbow + lr , -abs( a ) , 0 , 0
    skelet leg , pend( f + 180 , a ) , 0 , 0
    skelet knee , pend( f + 90 , a ) + a , 0 , 0
    skelet leg + lr , pend( f , a ) , 0 , 0
    skelet knee + lr , pend( f - 90 , a ) + a , 0 , 0
    for i = 0 to 2
      skelet index_finger + i , 0 , 0 , pend( f , 15 ) - 15
      skelet mid_finger + i , 0 , 0 , pend( f - 30 , 15 ) - 15
      skelet ring_finger + i , 0 , 0 , pend( f - 60 , 15 ) - 15
      skelet index_finger + i + lr , 0 , 0 , pend( f , 15 ) + 15
      skelet mid_finger + i + lr , 0 , 0 , pend( f - 30 , 15 ) + 15
      skelet ring_finger + i + lr , 0 , 0 , pend( f - 60 , 15 ) + 15
    next i
  case dog_walk
    skelet arm , pend( f + 180 , a ) , 0 , 0
    skelet elbow , pend( f + 90 , a ) + a , 0 , 0
    skelet arm + lr , pend( f , a ) , 0 , 0
    skelet elbow + lr , pend( f - 90 , a ) + a , 0 , 0
    skelet leg , pend( f + 180 , a ) , 0 , 0
    skelet knee , pend( f + 90 , a ) + a , 0 , 0
    skelet leg + lr , pend( f , a ) , 0 , 0
    skelet knee + lr , pend( f - 90 , a ) + a , 0 , 0
    skelet tail , -45 , pend( f * 2 , a ) , 0
    skelet neck , 0 , 0 , 0
    skelet neck + lr , 0 , 0 , 0
  Case I_FLY
    For i = 0 To 1
      skelet wing + i, 0 , 0 , Pend(f, a)
      skelet wing+lr + i, 0,0, Pend(f, -a)
    Next
  Case I_LEFT_BOX
    skelet arm, 0, Pend(f, -a) + 45 , 0
    skelet elbow, 0, Pend(f, a * 2) - 60 , 0
  Case I_LEFT_LEGS
    For i = 0 To 4
      skelet ileg + i, 0 , 0, Pend(f + i * 180, a)
      skelet iknee + i, Pend(f + i * 180 + 90, a) , 0 , 0
    Next
  Case I_RIGHT_BOX
    skelet arm+lr, 0, Pend(f, a) - 45,0
    skelet elbow+lr, 0, Pend(f, -a * 2) + 60, 0
  Case I_RIGHT_LEGS
    For i = 0 To 4
      skelet ileg+lr+ i, 0,0, Pend(f + i * 180, a)
      skelet iknee+lr + i, Pend(f + i * 180 + 90, a),0,0
    Next
  Case I_STAND
    skelet arm, 0, 45, 0
    skelet elbow, 0, -60 , 0
    skelet finger, 0, 0, 0
    skelet thumb, 0, 0, 0
    skelet arm+lr, 0, -45, 0
    skelet elbow+lr, 0, 60 , 0
    skelet finger+lr, 0, 0, 0
    skelet thumb+lr, 0, 0, 0
    skelet tail, 10, 0 , 0
    skelet tail+lr, 10, 0 , 0
  Case I_STING
    skelet tail, 10 + Pend(f, a), 0, 0
    skelet tail+lr, 10 - Pend(f, a), 0, 0
  case else
    dim i as integer
    for i = 0 to 63
      skelet i , 0,0,0
    next i
  end select
end sub

sub insect()
  Dim i as integer
glPushmatrix
  glScalef .01 , .01 , .01
  setbox 0, 0, 0, 30, 10.0, 60.0
  Cube
  For i = 0 To 4
    glPushMatrix
      child 35.0, 0.0, i * 25 - 50 , ileg + i, xyz
      setbox 30.0, 0.0, 0.0, 30.0, 5.0, 5.0
      Cube
      glPushMatrix
        child 65.0, -5.0, 0.0 , iknee + i, xyz
        setbox 0.0, -30.0, 0.0, 5.0, 30.0, 5.0
        Cube
      glPopMatrix
    glPopMatrix
    glpushMatrix
      child -35.0, 0.0, i * 25 - 50, ileg + lr + i, xyz
      setbox -30.0, 0.0, 0.0, 30.0, 5.0, 5.0
      Cube 
      glPushMatrix
        child -65.0, -5.0, 0.0 , iknee + lr + 1, xyz
        setbox 0.0, -30.0, 0.0, 5.0, 30.0, 5.0
        Cube
      glPopmatrix
    glPopMatrix
  Next
  glPushMatrix
    child 0 , 0 , -50 , tail , xyz
    For i = 0 To 9
      glPushMatrix
        child 0.0, 0.0, -30.0 , tail, xyz
        setbox 0.0, 0.0, -15.0, 10.0, 10.0, 10.0
        Cube
    Next
    for i = 0 to 8
        glPushMatrix
          child 0 , 0 , -30 , tail+lr , xyz
          cube
    next i
    for i = 0 to 8
        glPopMatrix
      glPopMatrix
    next i
  glPopMatrix
  glPushMatrix
    child 30.0, 0.0, 65.0, arm, xyz
    setbox 0.0, 0.0, 30.0, 5.0, 5.0, 30.0
    Cube
    glPushMatrix
      child 0.0, 0.0, 65.0, elbow, xyz
      Cube
      glPushmatrix
        child 0.0, 0.0, 65.0 , wrist, xyz
        glPushmatrix
          child -10.0, 0.0, 5.0 , thumb, xyz
          Cube
        glPopMatrix
        glPushMatrix
          child 5.0, 0.0, 5.0, finger, xyz
          setbox 0.0, 0.0, 30.0, 5.0, 10.0, 30.0
          Cube
        glPopMatrix
      glPopMatrix
    glPopMatrix
  glPopMatrix
  glPushMatrix
    child -30.0, 0.0, 65.0, arm + lr, xyz
    setbox 0.0, 0.0, 30.0, 5.0, 5.0, 30.0
    Cube
    glPushMatrix
      child 0.0, 0.0, 65.0, elbow +lr, xyz
      Cube
      glPushMatrix
        child 0.0, 0.0, 65.0, wrist+lr, xyz
        glPushMatrix
          child 10.0, 0.0, 5.0, thumb+lr, xyz
          Cube
        glPopMatrix
        glPushMatrix
          child -5.0, 0.0, 5.0, finger+lr, xyz
          setbox 0.0, 0.0, 30.0, 5.0, 10.0, 30.0
          Cube
        glPopMatrix
      glPopMatrix
    glPopMatrix
   glPopMatrix
   For i = 0 To 1
     glPushMatrix
       child 20.0, 20.0, 40.0 - 50.0 * i, wing + i, xyz
       setbox 60.0, 0.0, 8.0, 60.0, 2.0, 16.0
       Cube
     glPopMatrix
     glPushMatrix
       child -20.0, 20.0, 40.0 - 50.0 * i , wing+lr + i,  xyz
       setbox -60.0, 0.0, 8.0, 60.0, 2.0, 16.0
       Cube
     glPopmatrix
   Next
glPopMatrix
end sub

sub kootjes( f as integer )
  setbox 0,-.2,0 , .1,.1,.1
  cube
  glpushmatrix
    child 0,-.2,0 , f + 1 , xyz
    cube
    glpushmatrix
      child 0,-.2,0 , f + 2 , xyz
      cube
    glpopmatrix
  glpopmatrix
end sub

sub hand( kl as t_4d , i as integer )
  material.diffuse = kl
  material.ambient = kl
  material.use gl_front 
  glpushmatrix
    setbox 0,-.3,0 , .1,.3,.3
    cube
    glpushmatrix
      child 0,-.6,.2 , index_finger + i , xyz
      kootjes index_finger + i
    glpopmatrix
    glpushmatrix
      child 0,-.6,0 , mid_finger + i , xyz
      kootjes mid_finger + i
    glpopmatrix
    glpushmatrix
      child 0,-.6,-.2 , ring_finger + i , xyz
      kootjes ring_finger + i
    glpopmatrix
    glpushmatrix
      child 0,-.2,.4 , thumb + i , xyz
      kootjes thumb + i
    glpopmatrix
  glpopmatrix
end sub

sub human( kl as t_4d )
  material.diffuse = kl
  material.ambient = kl
  material.use gl_front 
  setbox  0 , 0 , 0  ,  .5 , .1 , .1
  cube 
  setbox 0 , .75 , 0 , .1 , .5 , .1
  cube 
  setbox 0 , 1.8 , 0 , .2 , .2 , .2
  cube 
  setbox 0 , 1.4 , 0 , .7 , .1 , .1
  cube 
  glPushMatrix
    child .45 , 0 , 0 , leg , zyx
    setbox 0 , -.6 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , knee , xyz
      cube 
      glPushMatrix
        child 0 , -1.2 , 0 , enkle , xyz
        setbox 0 , 0 , .2 , .1 , .1 , .3
        cube 
      glPopMatrix
    glPopMatrix
  glPopMatrix
  glPushMatrix
    child -.45 , 0 , 0 , leg + lr , zyx
    setbox 0 , -.6 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , knee + lr , xyz
      cube 
      glPushMatrix
        child 0 , -1.2 , 0 , enkle + lr , xyz 
        setbox 0 , 0 , .2 , .1 , .1 , .3
        cube 
      glPopMatrix
    glPopMatrix
  glPopMatrix
  glPushMatrix
    child .65 , 1.3 , 0 , arm , xyz
    setbox 0 , -.5 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , elbow , xyz
      cube 
      glPushMatrix
        child 0 , -1 , 0 , wrist , zyx
        glscalef .5,.5,.5
        hand white , 0
      glPopMatrix
    glPopMatrix
  glPopMatrix
  material.diffuse = kl
  material.ambient = kl
  material.use gl_front   
  glPushMatrix
    child -.65 , 1.3 , 0 , arm + lr , xyz
    setbox 0 , -.5 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , elbow + lr , xyz
      cube 
      glPushMatrix
        child 0 , -1 , 0 , wrist + lr , zyx
        glscalef .5,.5,.5
        hand white , lr
      glPopMatrix
    glPopMatrix
  glPopMatrix
end sub

sub dog()
  setbox 0,.2,.5 , .3,.3,.7
  cube
  glpushmatrix
    child 0 , .6 , 1.5 , neck , xyz
    glpushmatrix
      child 0 , 0 , 0 , neck + lr , zyx
      setbox 0,0,0 , .3 , .3 , .3
      cube
      setbox 0,-.2,.3 , .2,.2,.2
      cube
      setbox 0,0,.5 , .1,.1,.1
      cube
      setbox .3,-.15,0 , .05,.3,.2
      cube
      setbox -.3,-.15,0 , .05,.3,.2
      cube
    glpopmatrix
  glpopmatrix
  glpushmatrix
    child 0 , .4 , -.5 , tail , yzx
    setbox 0,.3,0 , .1 , .3 , .1
    cube
  glpopmatrix
  glPushMatrix
    child .3 , 0 , 1 , leg , zyx
    setbox 0 , -.6 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , knee , xyz
      cube 
      glPushMatrix
        child 0 , -1.2 , 0 , enkle , xyz
        setbox 0 , 0 , .2 , .1 , .1 , .3
        cube 
      glPopMatrix
    glPopMatrix
  glPopMatrix
  glPushMatrix
    child -.3 , 0 , 1 , leg + lr, zyx
    setbox 0 , -.6 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , knee + lr, xyz
      cube 
      glPushMatrix
        child 0 , -1.2 , 0 , enkle + lr, xyz
        setbox 0 , 0 , .2 , .1 , .1 , .3
        cube 
      glPopMatrix
    glPopMatrix
  glPopMatrix
  glPushMatrix
    child .3 , 0 , 0 , arm , zyx
    setbox 0 , -.6 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , elbow , xyz
      cube 
      glPushMatrix
        child 0 , -1.2 , 0 , wrist , xyz
        setbox 0 , 0 , .2 , .1 , .1 , .3
        cube 
      glPopMatrix
    glPopMatrix
  glPopMatrix
  glPushMatrix
    child -.3 , 0 , 0 , arm + lr , zyx
    setbox 0 , -.6 , 0 , .1 , .4 , .1
    cube 
    glPushMatrix
      child 0 , -1 , 0 , elbow + lr , xyz
      cube 
      glPushMatrix
        child 0 , -1.2 , 0 , wrist + lr , xyz
        setbox 0 , 0 , .2 , .1 , .1 , .3
        cube 
      glPopMatrix
    glPopMatrix
  glPopMatrix
end sub

#endif