open gl

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

Re: open gl

Post by bluatigro »

Code: Select all

''for x = 0 to 64
''  for y = 0 to 64
''    qqq(x,y,0) = x 
''    qqq(x,y,2) = y
''    qqq(x,y,1) = turbulence(x,y,0,64)
''  next y
''next x
bluatigro
Posts: 660
Joined: Apr 25, 2012 10:35
Location: netherlands

Re: open gl

Post by bluatigro »

update :
bigger landscape try

error :
i see to les hil's
texture gives only green line's

instruction's :
use cursor key's for left,right,up and down
use mouse for left turn , right turn , forwart , backwart

Code: Select all

''bluatigro 24 jan 2017
'' glmap2f surface try

#include "_open_gl_dbl.bas"
#include "noise.bas"

dim as double hoek , x , y , z , i

randomize timer

function dice() as single
  return range( -5 , 5 )
end function

dim as single qqq(63,63,2) 
for x = 0 to 63
  for y = 0 to 63
    qqq(x,y,0) = x - 32
    qqq(x,y,2) = y - 32
    qqq(x,y,1) = turbulence(x,y,0,64)-2
  next y
next x

dim as integer texture
glenable gl_texture_2d
glgentextures 1 , @ texture
glbindtexture gl_texture_2d , texture
glTexParameteri GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT
glTexParameteri GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT
glTexParameteri GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST
glTexParameteri GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST
''glGenerateMipmap GL_TEXTURE_2D

'' the texture (2x2)
dim as single textdata( 11 ) = { 1 ,  1 , 0 _
                               , 0 ,  1 , 0 _
                               , 0 ,  0 , 1 _
                               , 1 ,  0 , 0 } 
glTexImage2D GL_TEXTURE_2D, 0, GL_RGB, 2, 2, 0, GL_RGB, GL_FLOAT _
, @ textdata(0)

camara.z = 100
                      
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 , 1 , 64 , 2 , 0 , 1 , 64*64 , 2 _
  , @qqq(0,0,0)
  glMap2f GL_MAP2_TEXTURE_COORD_2 , 0 , 1 , 3 , 2 , 0 , 1 , 12 , 2 _
  , @textdata(0)

  glEnable GL_MAP2_VERTEX_3
  glEnable GL_MAP2_TEXTURE_COORD_2
  
  glMapGrid2f 64 , 0 , 64 , 64 , 0 , 64
  
  glEvalMesh2 GL_FILL , 0 , 64 , 0 , 64
  
  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
  
  hoek += 5
  
  sleep 40
  flip
loop until inkey = chr( 27 )
bluatigro
Posts: 660
Joined: Apr 25, 2012 10:35
Location: netherlands

Re: open gl

Post by bluatigro »

Chemistry try in FB + openGL

the coordinates are not correct
but you get the point

how do i get a lightdot on my spheres ?

Code: Select all

''bluatigro 16 apr 2018
''demo opengl graphics
''chemistry try

#include "_open_gl_dbl.bas"

dim as double angle
dim as integer state
const as double sqr3 = sqr( 3 ) / 2
sub bol( x as double , y as double , z as double , d as double , kl as sng4d )
  material.diffuse = kl
  setmaterial gl_front , material
  setbox x , y , z , d , d , d
  sphere 24 , 24 , 1 , 1
end sub
sub H( x as double , y as double , z as double )
  bol( x , y , z , 1.5 , white )
end sub
sub C( x as double , y as double , z as double )
  bol( x , y , z , 2 , black )
end sub
sub N( x as double , y as double , z as double )
  bol( x , y , z , 2 , blue )
end sub
sub O( x as double , y as double , z as double ) 
  bol( x , y , z , 2 , red )
end sub
sub F( x as double , y as double , z as double )
  bol( x , y , z , 2 , green )
end sub
sub P( x as double , y as double , z as double )
  bol( x , y , z , 2 , orange )
end sub
sub S( x as double , y as double , z as double )
  bol( x , y , z , 2.5 , yellow )
end sub
sub Cl( x as double , y as double , z as double )
  bol( x , y , z , 2.5 , green / 2 )
end sub
sub O2()
  O( -1 , 0 , 0 )
  O( 1 , 0 , 0 )
end sub
sub CO2()
  C( 0 , 0 , 0 )
  O( -1.5 , 0 , 0 )
  O( 1.5 , 0 , 0 )
end sub
sub N2()
  N( -1 , 0 , 0 )
  N( 1 , 0 , 0 )
end sub
sub O3()
  O( 0 , 0 , 0 )
  O( sqr3 , sqr3 , sqr3 )
  O( -sqr3 , sqr3 , -sqr3 )
end sub
sub NH3()
  n( 0 , 0 , 0 )
  h( sqr3 , sqr3 , sqr3 )
  h( -sqr3 , sqr3 , -sqr3 )
  h( 0 , -1 , 0 )
end sub
sub H20()
  o( 0 , 0 , 0 )
  h( sqr3 , sqr3 , sqr3 )
  h( -sqr3 , sqr3 , -sqr3 )
end sub
sub SO2()
  s( 0 , 0 , 0 )
  o( sqr3 * 1.25 , sqr3 * 1.25 , sqr3 * 1.25 )
  o( -sqr3 * 1.25 , sqr3 * 1.25 , -sqr3 * 1.25 )
end sub
sub SO3()
  s( 0 , 0 , 0 )
  o( sqr3 * 1.25 , sqr3 * 1.25 , sqr3 * 1.25 )
  o( -sqr3 * 1.25 , sqr3 * 1.25 , -sqr3 * 1.25 )
  o( 0 , -1.25 , 0 )
end sub
''  //H2SO4() 
sub NO()
  n( -1 , 0 , 0 )
  o( 1 , 0 , 0 )
end sub
sub NO2()
  n( 0 , 0 , 0 )
  o( sqr3 , sqr3 , sqr3 )
  o( -sqr3 , sqr3 , -sqr3 )
end sub
sub HNO3()
  n( 0 , 0 , 0 )
  o( sqr3 , sqr3 , sqr3 )
  o( -sqr3 , sqr3 , -sqr3 )
  o( 0 , -1 , 0 )
  h( 1 , -1.3 , .5 )
end sub
sub H2O2()
  o( 0 , .5 , 0 )
  h( 1 , .8 , 0 )
  o( 0 , -.5 , 0 )
  h( -1 , -.8 , 0 )
end sub

camara.z = 10
do
  glclear gl_color_buffer_bit or gl_depth_buffer_bit
  camara.use
  glpushmatrix
    glRotated angle , 0 , 1 , 0
    if state = 0 then O2()
    if state = 1 then CO2()
    if state = 2 then N2()
    if state = 3 then O3()
    if state = 4 then NH3()
    if state = 5 then H20()
    if state = 6 then SO2()
    if state = 7 then SO3()
    ''H2SO4() 
    if state = 8 then NO() 
    if state = 9 then NO2()
    if state = 10 then HNO3()
    if state = 11 then H2O2()   


  glpopmatrix
  
  angle = ( angle + 3 ) mod 360
  if angle = 0 then 
    state = ( state + 1 ) mod 12
  end if
  sleep 40
  flip
loop while inkey = ""
bluatigro
Posts: 660
Joined: Apr 25, 2012 10:35
Location: netherlands

Re: open gl

Post by bluatigro »

update :
try at 3D boid's

this is a try at a swarm of boid's
this can be used for :
a swarm of bird's
a flok of sheep
a scool of fish

and you can think of other examples i supose

rem :
this is the first step :
drawing [ done ] and moving [ not jet good ]

error :
the boid is not moving good

Code: Select all

''bluatigro 30 apr 2018
''boid 3d in openGL

#include "_open_gl_dbl.bas"

type tboid
  dim as dbl3d spot , angle , speed
  dim as double hoek
  dim as integer state , tel
  declare sub show()
  declare function getspeed() as dbl3d
  declare sub update()
end type
sub tboid.show()
  material.diffuse = white
  setmaterial GL_FRONT , material
  glPushMatrix
    glTranslated spot.x , spot.y , spot.z
    glRotated angle.y , 0,1,0
    glRotated angle.x , 1,0,0
    glRotated angle.z , 0,0,1
    setpoint 0 , 0 , .2 , 1
    setpoint 1 , -.5 , 0 , 1
    setpoint 2 , .5 , 0 , 1
    setpoint 3 , 0 , 0 , -1
    material.diffuse = yellow
    setmaterial GL_FRONT , material
    tri 0 , 1 , 2
    material.diffuse = blue
    setmaterial GL_FRONT , material
    tri 3 , 1 , 2
    material.diffuse = red
    setmaterial GL_FRONT , material
    tri 3 , 1 , 0
    material.diffuse = green
    setmaterial GL_FRONT , material
    tri 3 , 0 , 2
  glPopMatrix
end sub
function tboid.getspeed() as dbl3d
  dim as dbl3d v = speed
  rotate v.x , v.z , angle.y
  rotate v.y , v.z , angle.x
  return v
end function
sub tboid.update()
  spot += getspeed()
end sub

dim as integer state 
const as integer boid_up = 0
const as integer boid_down = 1
const as integer boid_left = 2
const as integer boid_right = 3
const as integer boid_normal = 5
dim as tboid boid
dim as double angle 
const as double worldsize = 5
camara.z = 40
randomize timer
do
  glClear GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT
  camara.use
  
  boid.show
  
  boid.tel -= 1
  if boid.tel < 0 then
    boid.tel = int( range( 5 , 20 ) )
    boid.state = int( range( 0 , 5 ) )
  end if
  select case boid.state
    case boid_left
      boid.angle.y += boid.hoek
      boid.angle.z = boid.hoek * 30
      if boid.hoek < 1 then
        boid.hoek += .1
      end if
    case boid_right
      boid.angle.y -= boid.hoek
      boid.angle.z = boid.hoek * -30
      if boid.hoek < 1 then
        boid.hoek += .1
      end if
    case boid_up
      if boid.spot.y < worldsize then
      if boid.angle.x < 30 then
        boid.angle.x += 1
      end if
      end if
    case boid_down
      if boid.spot.y > -worldsize then
      if boid.angle.x > -30 then
        boid.angle.x -= 1
      end if
      end if
    case else ''boid_normal
  end select
  boid.speed = dbl3d( 0 , 0 , .1 )
  if boid.spot.x + boid.getspeed().x < -worldsize then
    boid.angle.y += 1
  end if
  if boid.spot.x + boid.getspeed().x > worldsize then
    boid.angle.y += 1
  end if
  if boid.spot.z + boid.getspeed().z < -worldsize then
    boid.angle.y += 1
  end if
  if boid.spot.z + boid.getspeed().z > worldsize then
    boid.angle.y += 1
  end if
  if boid.spot.y + boid.getspeed().y < -worldsize then
    boid.angle.x += 1
  end if
  if boid.spot.y + boid.getspeed().y > worldsize then
    boid.angle.x -= 1
  end if
  boid.update
  
  angle += 1
  sleep 40
  flip
loop while inkey = ""
bluatigro
Posts: 660
Joined: Apr 25, 2012 10:35
Location: netherlands

Re: open gl

Post by bluatigro »

error :
no blue screen
no tekst

Code: Select all

''bluatigro 9 jun 2018
''_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,tilt
  declare sub move( dx as double _
  , dy as double , dz as double , dpan as double )
  declare sub use()
end type
sub t_camara.move( dx as double _
  , dy as double , dz as double , dpan as double )
  rotate dx , dz , -pan
  x += dx
  y += dy
  z += dz
  pan += dpan
end sub
sub t_camara.use
  glLoadIdentity
  glRotated -tilt , 0 , 0 , 1
  glRotated -pan , 0 , 1 , 0
  glTranslated -x , -y , -z
end sub

dim 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 

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

dim shared as integer letterpart( 255 , 20 ) 
dim as integer char , ix , iy

screen 18 , 32


for char = 30 to 255
  cls
  print chr( char )
  for ix = 0 to 16
    for iy = 0 to 20
      if point( ix , iy ) <> -16777216 then
        letterpart( char , iy ) += 2 ^ ix
      end if
    next iy
  next ix
next char
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, 1.0, 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 ) = { -50 , 50 , 50 , 1 }
dim as single diffuse( 3 ) = { 1 , 1 , 1 , 1 }
glLightfv( gl_light0 , gl_position, @lightpos(0) )
glLightfv( gl_light0 , gl_diffuse , @diffuse(0) )
glEnable( gl_light0 )

''COLORS

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

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

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

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

''MATERIAL

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

''text

declare sub setbox(x as double,y as double,z as double _
,dx as double,dy as double,dz as double )
declare sub cube()
declare sub sphere( a as integer , b as integer _
, c as double , d as double )


''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
    glnormal3f 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 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 banana( 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/1.99 to PI/1.99 - pi/b*2 step PI / b * 1.99
      j2 = j + PI / b * 1.99
      setpoint 0 _ 
      , mx + ( dx + dy * cos( i ) * cos( j ) ) _
      * cos( j ) _
      , my + ( dx + dy * cos( i ) * cos( j ) ) _
      * sin( j ) _
      , mz + sin( i ) * dz * cos( j )
      setpoint 1 _
      , mx + ( dx + dy * cos( i ) * cos( j2 ) ) _
      * cos( j2 ) _
      , my + ( dx + dy * cos( i ) * cos( j2 ) ) _
      * sin( j2 ) _
      , mz + sin( i ) * dz * cos( j2 )
      setpoint 2 _
      , mx + ( dx + dy * cos( i2 ) * cos( j2 ) ) _
      * cos( j2 ) _
      , my + ( dx + dy * cos( i2 ) * cos( j2 ) ) _
      * sin( j2 ) _
      , mz + sin( i2 ) * dz * cos( j2 )
      setpoint 3 _ 
      , mx + ( dx + dy * cos( i2 ) * cos( j ) ) _
      * cos( j ) _
      , my + ( dx + dy * cos( i2 ) * cos( j ) ) _
      * sin( j ) _
      , mz + sin( i2 ) * dz * cos( j )
      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 mouth = 25

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
const as integer eyes = 10

sub animate( anim as integer , f as double , a as double )
  DIM I AS INTEGER
  select case anim
  case eyes
skelet eye , pend( f , 20 ) , pend( f + 90 , 20 ) , 0
skelet eye+lr , pend( f + 180 , 20 ) , pend( f - 90 , 20 ) , 0
skelet mouth , pend( f , 20 ) + 20 , 0 , 0

  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
    skelet thumb , -pend( f , 10 ) - 10 , 0 , 0
    skelet thumb +lr , -pend( f , 10 ) - 10 , 0 , 0
    for i = 0 to 2
      skelet index_finger + i , 0 , 0 , -pend( f + 30 , 10 ) - 10
      skelet mid_finger + i , 0 , 0 , -pend( f , 10 ) - 10
      skelet ring_finger + i , 0 , 0 , -pend( f - 30 , 10 ) - 10
      skelet index_finger + lr + i , 0 , 0 , pend( f + 30 , 10 ) + 10
      skelet mid_finger + lr + i , 0 , 0 , pend( f , 10 ) + 10
      skelet ring_finger + lr +  i , 0 , 0 , pend( f - 30 , 10 ) + 10
    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 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( kl as sng4d )
  material.diffuse = kl
  setmaterial gl_front , material
  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, 65.0 , 5 , 35 , 5
    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( kl as sng4d )
  material.diffuse = kl
  setmaterial gl_front , material
  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 digit( b as integer )
  dim as integer i , j
  for i = 0 to 16
    for j = 0 to 20
      if ( letterpart( b , i ) and 2 ^ j ) <> 0 then
        setbox j*+.1-.5,i*-.1+.5,0 , .08,.08,.08
        sphere 4 , 4 , 1 , 1
      end if
    next j
  next i
end sub

sub text( txt as string , kl as sng4d )
  material.diffuse = kl
  setmaterial gl_front , material
  dim as integer i
  for i = 1 to len( txt )
    glpushmatrix
      gltranslatef i - len( t ) / 2 - .5 , 0 , 0
      digit asc( mid( t , i , 1 ) ) 
    glpopmatrix
  next i
end sub

''these 4 lines are here only to test stuf
glclear gl_color_buffer_bit or gl_depth_buffer_bit
text "test" , white
flip
sleep 

#endif
bluatigro
Posts: 660
Joined: Apr 25, 2012 10:35
Location: netherlands

Re: open gl

Post by bluatigro »

update :
part _open_gl_dbl.bas

Code: Select all

sub digit( b as integer )
  dim as integer i , j
  for i = 0 to 16
    for j = 0 to 20
      if ( letterpart( b , i ) and 2 ^ j ) <> 0 then
        setbox j * 1 / 20 - .5 , i * -1 / 20 + .5 , 0 _
        , .08 , .08 , .08
        sphere 4 , 4 , 1 , 1
      end if
    next j
  next i
end sub
bluatigro
Posts: 660
Joined: Apr 25, 2012 10:35
Location: netherlands

Re: open gl

Post by bluatigro »

fount part of the error

error :
white screen whit sandglass

Code: Select all

''bluatigro 9 jun 2018
''test opengl graphics

#include "_open_gl_dbl.bas"

dim as double angle = -90
dim as integer state
camara.z = 15
camara.y = 0
do
  glclear gl_color_buffer_bit or gl_depth_buffer_bit
  camara.use
  
  glrotated angle ,0,1,0

''  setbox 0,0,0 , 1,1,.1
''  banana 6 , 10
''  setbox .7,0,0 , .5,.2,.2
''  sphere 10,10,1,1
''  setbox -.4,0,1.5 , .3,.03,.3
''  glrotated 90 , 0,1,0
''  banana 8 , 6
  glpushmatrix
    gltranslated 0 , 3 , 0
    text date , magenta
  glpopmatrix
  glpushmatrix
    text "GAME OVER" , yellow
  glpopmatrix
  glpushmatrix
    gltranslated 0 , -3 , 0
    text time , cyan
  glpopmatrix
  angle += 1
  if angle = 90 then 
    angle = -90
    state = ( state + 1 ) mod 7 
  end if
  sleep 40
  flip
loop while inkey = ""

Code: Select all

''bluatigro 9 jun 2018
''_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,tilt
  declare sub move( dx as double _
  , dy as double , dz as double , dpan as double )
  declare sub use()
end type
sub t_camara.move( dx as double _
  , dy as double , dz as double , dpan as double )
  rotate dx , dz , -pan
  x += dx
  y += dy
  z += dz
  pan += dpan
end sub
sub t_camara.use
  glLoadIdentity
  glRotated -tilt , 0 , 0 , 1
  glRotated -pan , 0 , 1 , 0
  glTranslated -x , -y , -z
end sub

dim 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

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

dim shared as integer letterpart( 255 , 20 ) 
dim as integer char , ix , iy


for char = 30 to 255
  cls
  print chr( char )
  for ix = 0 to 16
    for iy = 0 to 20
      if point( ix , iy ) <> -16777216 then
        letterpart( char , iy ) += 2 ^ ix
      end if
    next iy
  next ix
next char
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, 1.0, 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 ) = { -50 , 50 , 50 , 1 }
dim as single diffuse( 3 ) = { 1 , 1 , 1 , 1 }
glLightfv( gl_light0 , gl_position, @lightpos(0) )
glLightfv( gl_light0 , gl_diffuse , @diffuse(0) )
glEnable( gl_light0 )

''COLORS

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

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

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

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

''MATERIAL

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

''text

declare sub setbox(x as double,y as double,z as double _
,dx as double,dy as double,dz as double )
declare sub cube()
declare sub sphere( a as integer , b as integer _
, c as double , d as double )


''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
    glnormal3f 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 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 banana( 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/1.99 to PI/1.99 - pi/b*2 step PI / b * 1.99
      j2 = j + PI / b * 1.99
      setpoint 0 _ 
      , mx + ( dx + dy * cos( i ) * cos( j ) ) _
      * cos( j ) _
      , my + ( dx + dy * cos( i ) * cos( j ) ) _
      * sin( j ) _
      , mz + sin( i ) * dz * cos( j )
      setpoint 1 _
      , mx + ( dx + dy * cos( i ) * cos( j2 ) ) _
      * cos( j2 ) _
      , my + ( dx + dy * cos( i ) * cos( j2 ) ) _
      * sin( j2 ) _
      , mz + sin( i ) * dz * cos( j2 )
      setpoint 2 _
      , mx + ( dx + dy * cos( i2 ) * cos( j2 ) ) _
      * cos( j2 ) _
      , my + ( dx + dy * cos( i2 ) * cos( j2 ) ) _
      * sin( j2 ) _
      , mz + sin( i2 ) * dz * cos( j2 )
      setpoint 3 _ 
      , mx + ( dx + dy * cos( i2 ) * cos( j ) ) _
      * cos( j ) _
      , my + ( dx + dy * cos( i2 ) * cos( j ) ) _
      * sin( j ) _
      , mz + sin( i2 ) * dz * cos( j )
      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 mouth = 25

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
const as integer eyes = 10

sub animate( anim as integer , f as double , a as double )
  DIM I AS INTEGER
  select case anim
  case eyes
skelet eye , pend( f , 20 ) , pend( f + 90 , 20 ) , 0
skelet eye+lr , pend( f + 180 , 20 ) , pend( f - 90 , 20 ) , 0
skelet mouth , pend( f , 20 ) + 20 , 0 , 0

  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
    skelet thumb , -pend( f , 10 ) - 10 , 0 , 0
    skelet thumb +lr , -pend( f , 10 ) - 10 , 0 , 0
    for i = 0 to 2
      skelet index_finger + i , 0 , 0 , -pend( f + 30 , 10 ) - 10
      skelet mid_finger + i , 0 , 0 , -pend( f , 10 ) - 10
      skelet ring_finger + i , 0 , 0 , -pend( f - 30 , 10 ) - 10
      skelet index_finger + lr + i , 0 , 0 , pend( f + 30 , 10 ) + 10
      skelet mid_finger + lr + i , 0 , 0 , pend( f , 10 ) + 10
      skelet ring_finger + lr +  i , 0 , 0 , pend( f - 30 , 10 ) + 10
    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 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( kl as sng4d )
  material.diffuse = kl
  setmaterial gl_front , material
  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, 65.0 , 5 , 35 , 5
    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( kl as sng4d )
  material.diffuse = kl
  setmaterial gl_front , material
  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 digit( b as integer )
  dim as integer i , j
  for i = 0 to 16
    for j = 0 to 20
      if ( letterpart( b , i ) and 2 ^ j ) <> 0 then
        setbox j * 1 / 20 - .5 , i * -1 / 20 + .5 , 0 _
        , .08 , .08 , .08
        sphere 4 , 4 , 1 , 1
      end if
    next j
  next i
end sub

sub text( txt as string , kl as sng4d )
  material.diffuse = kl
  setmaterial gl_front , material
  dim as integer i
  for i = 1 to len( txt )
    glpushmatrix
      gltranslatef i - len( txt ) / 2 - .5 , 0 , 0
      digit asc( mid( txt, i , 1 ) ) 
    glpopmatrix
  next i
end sub

sleep 

#endif
bluatigro
Posts: 660
Joined: Apr 25, 2012 10:35
Location: netherlands

Re: open gl

Post by bluatigro »

update :
try at textures in 1.50.0

error :
code cant find gl/gl.bi

so there are no typo's left

main

Code: Select all

'' bluatigro 25 jul 2018
'' test bluaGL

#include "bluaGl-txt.bas"

dim as double angle
dim as integer state = -1

function LoadGLTextures() as integer
  dim Status as integer = 0                    '' Status Indicator
  dim TextureImage(0) as BITMAP_RGBImageRec ptr     '' Create Storage Space For The Texture

  ' Load The Bitmap, Check For Errors, If Bitmap's Not Found Quit
  TextureImage(0) = LoadBMP("data\Crate.bmp")
  if TextureImage(0) then
    Status = 1                                   '' Set The Status To TRUE
    glGenTextures 1, @texture(0)                    '' Create The Texture
    ' Typical Texture Generation Using Data From The Bitmap
    glBindTexture GL_TEXTURE_2D, texture(0)
    glTexImage2D GL_TEXTURE_2D, 0, 3, TextureImage(0)->sizeX, TextureImage(0)->sizeY, 0, GL_RGB, GL_UNSIGNED_BYTE, TextureImage(0)->buffer
    glTexParameteri GL_TEXTURE_2D,GL_TEXTURE_MIN_FILTER,GL_LINEAR
    glTexParameteri GL_TEXTURE_2D,GL_TEXTURE_MAG_FILTER,GL_LINEAR
  end if

  if TextureImage(0) then                           '' If Texture Exists
    if TextureImage(0)->buffer then                 '' If Texture Image Exist
      deallocate(TextureImage(0)->buffer)           '' Free The Texture Image Memory
    end if
    deallocate(TextureImage(0))                     '' Free The Image Structure
  end if

  return Status                                     '' Return The Status
end function

settxtpoint 0 , 0 , 0
setpoint 0 , -.5 , -.5 , 0
settxtpoint 1 , 1 , 0
setpoint 1 , .5 , -.5 , 0
settxtpoint 2 , 1 , 1
setpoint 2 , .5 , .5  , 0
settxtpoint 3 , 0 , 1
setpoint 3 , -.5 , .5 , 0

camara.z = 10
do
  glclear gl_color_buffer_bit or gl_depth_buffer_bit
  camara.use
  
  glrotated 10 , 0,1,0
  
  animate eyes , angle , 0
  if state = -1 then
    glpushmatrix
      glrotatef angle , 0 , 1 , 0
      txtquad 0,0 , 1,1 , 2,2 , 3,3
    glpopmatrix
  if state = 0 then
    animate 0 , 0 , 0
    animate i_stand , 0 , 0
    animate i_sting , angle , 10
    insect rainbow( angle )
    glpushmatrix
      gltranslatef 0,-.7,5
      glscalef .4,.4,.4
      text "bug" , white
    glpopmatrix
  end if
  if state = 1 then
    animate human_walk , angle , 30
    human rainbow( angle )
    glpushmatrix
      gltranslatef 0,-.7,5
      glscalef .4,.4,.4
      text "robot" , white
    glpopmatrix
  end if
  if state = 2 then
    animate human_walk , angle , 10
    glpushmatrix
      glscalef 2 , 2 , 2
      glrotatef -80 , 1 , 0 , 0
      hand white , 0
    glpopmatrix
    glpushmatrix
      gltranslatef 0,-.7,5
      glscalef .4,.4,.4
      text "hand" , white
    glpopmatrix
  end if
  if state = 3 then
    animate dog_walk , angle , 30
    dog rainbow( angle )
    glpushmatrix
      gltranslatef 0,-.7,5
      glscalef .4,.4,.4
      text "dog" , white
    glpopmatrix
  end if
  if state = 4 then
    animate human_walk , angle , 30
    glpushmatrix
      glscalef .5,.5,.5
      knaagdier rainbow( angle ) , muis
    glpopmatrix
    glpushmatrix
      gltranslatef 0,-.7,5
      glscalef .4,.4,.4
      text "mouse" , white
    glpopmatrix
  end if
  if state = 5 then
    animate dog_walk , angle , 30
    pilko orange
    glpushmatrix
      gltranslatef 0,-.7,5
      glscalef .4,.4,.4
      text "pilko" , white
    glpopmatrix
  end if
  if state = 6 then
    animate human_walk , angle , 30
    man yellow , blue
    glpushmatrix
      gltranslatef 0,-.7,5
      glscalef .4,.4,.4
      text "human" , white
    glpopmatrix
  end if
  if state = 7 then
    glpushmatrix
      gltranslated 0 , 2 , 0
      glscalef .5,.5,.5
      text date , white
    glpopmatrix
    glpushmatrix
      glscalef .5,.5,.5
      text "the end" , rainbow( angle )
    glpopmatrix
    glpushmatrix
      gltranslated 0 , -2 , 0
      glscalef .5,.5,.5
      text time , white
    glpopmatrix
  end if
  angle = ( angle + 10 ) mod ( 360 * 4 )
  if angle = 0 then 
    state += 1 
    if state > 7 then state = -1
  end if
  sleep 40
  flip
loop while inkey = ""
screen 0
bluaGL-txt

Code: Select all

''bluatigro 25 jul 2018
''bluaGL.bas 

#ifndef OPENGL_H
#define OPENGL_H

dim shared as integer mousex , mousey

''DBL3D

type dbl3d
public :
  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"
#include once "bmpload.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,tilt
  declare sub move( dx as double _
  , dy as double , dz as double , dpan as double )
  declare sub use()
end type
sub t_camara.move( dx as double _
  , dy as double , dz as double , dpan as double )
  rotate dx , dz , -pan
  x += dx
  y += dy
  z += dz
  pan += dpan
end sub
sub t_camara.use
  glLoadIdentity
  glRotated -tilt , 0 , 0 , 1
  glRotated -pan , 0 , 1 , 0
  glTranslated -x , -y , -z
end sub

dim 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

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

dim shared as integer letterpart( 255 , 20 ) 
dim as integer char , ix , iy


for char = 30 to 255
  cls
  print chr( char )
  for ix = 0 to 16
    for iy = 0 to 20
      if point( ix , iy ) <> -16777216 then
        letterpart( char , iy ) += 2 ^ ix
      end if
    next iy
  next ix
next char

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, 1.0, 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 ) = { -50 , 50 , 50 , 1 }
dim as single diffuse( 3 ) = { 1 , 1 , 1 , 1 }
glLightfv( gl_light0 , gl_position, @lightpos(0) )
glLightfv( gl_light0 , gl_diffuse , @diffuse(0) )
glEnable( gl_light0 )

''COLORS

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

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

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

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

''MATERIAL

type t_material
public :
  dim as sng4d 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 , @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

''text

declare sub setbox(x as double,y as double,z as double _
,dx as double,dy as double,dz as double )
declare sub cube()
declare sub sphere( a as integer , b as integer _
, c as double , d as double )


''PRIMATIVS

dim shared as dbl3d pnt( 256 )

type dbl2d
public :
  dim as double u , v
end type

dim shared as dbl2d txtpnt( 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 settxtpoint( no as integer , x as double , y as double )
    if no < 0 or no > 255 then exit sub
    txtpnt( no ).u = x
    txtpnt( no ).v = y
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 txttri( p1 as integer , t1 as integer _
          , p2 as integer , t2 as integer _
          , p3 as integer , t3 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 t1 < 0 or t1 > 255 then exit sub
  if t2 < 0 or t2 > 255 then exit sub
  if t3 < 0 or t3 > 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
    glTexCoord2fv @ txtpnt( t1 ).u
    glvertex3d pnt( p1 ).x , pnt( p1 ).y , pnt( p1 ).z
    glTexCoord2fv @ txtpnt( t2 ).u
    glvertex3d pnt( p2 ).x , pnt( p2 ).y , pnt( p2 ).z
    glTexCoord2fv @ txtpnt( t3 ).u
    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 txtquad( p1 as integer , t1 as integer _
           , p2 as integer , t2 as integer _
           , p3 as integer , t3 as integer _
           , p4 as integer , t4 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 t1 < 0 or t1 > 255 then exit sub
  if t2 < 0 or t2 > 255 then exit sub
  if t3 < 0 or t3 > 255 then exit sub
  if t4 < 0 or t4 > 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
    glTexCoord2fv @ txtpnt( t1 ).u
    glvertex3d pnt( p1 ).x , pnt( p1 ).y , pnt( p1 ).z
    glTexCoord2fv @ txtpnt( t2 ).u
    glvertex3d pnt( p2 ).x , pnt( p2 ).y , pnt( p2 ).z
    glTexCoord2fv @ txtpnt( t3 ).u
    glvertex3d pnt( p3 ).x , pnt( p3 ).y , pnt( p3 ).z
    glTexCoord2fv @ txtpnt( t4 ).u
    glvertex3dv @ pnt( p4 ).x
  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
    glnormal3f 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 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 banana( 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/1.99 to PI/1.99 - pi/b*2 step PI / b * 1.99
      j2 = j + PI / b * 1.99
      setpoint 0 _ 
      , mx + ( dx + dy * cos( i ) * cos( j ) ) _
      * cos( j ) _
      , my + ( dx + dy * cos( i ) * cos( j ) ) _
      * sin( j ) _
      , mz + sin( i ) * dz * cos( j )
      setpoint 1 _
      , mx + ( dx + dy * cos( i ) * cos( j2 ) ) _
      * cos( j2 ) _
      , my + ( dx + dy * cos( i ) * cos( j2 ) ) _
      * sin( j2 ) _
      , mz + sin( i ) * dz * cos( j2 )
      setpoint 2 _
      , mx + ( dx + dy * cos( i2 ) * cos( j2 ) ) _
      * cos( j2 ) _
      , my + ( dx + dy * cos( i2 ) * cos( j2 ) ) _
      * sin( j2 ) _
      , mz + sin( i2 ) * dz * cos( j2 )
      setpoint 3 _ 
      , mx + ( dx + dy * cos( i2 ) * cos( j ) ) _
      * cos( j ) _
      , my + ( dx + dy * cos( i2 ) * cos( j ) ) _
      * sin( j ) _
      , mz + sin( i2 ) * dz * cos( j )
      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 mouth = 25

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
const as integer eyes = 10

sub animate( anim as integer , f as double , a as double )
  DIM I AS INTEGER
  select case anim
  case eyes
skelet eye , pend( f , 20 ) , pend( f + 90 , 20 ) , 0
skelet eye+lr , pend( f + 180 , 20 ) , pend( f - 90 , 20 ) , 0
skelet mouth , pend( f , 20 ) + 20 , 0 , 0

  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
    skelet thumb , -pend( f , 10 ) - 10 , 0 , 0
    skelet thumb +lr , -pend( f , 10 ) - 10 , 0 , 0
    for i = 0 to 2
      skelet index_finger + i , 0 , 0 , -pend( f + 30 , 10 ) - 10
      skelet mid_finger + i , 0 , 0 , -pend( f , 10 ) - 10
      skelet ring_finger + i , 0 , 0 , -pend( f - 30 , 10 ) - 10
      skelet index_finger + lr + i , 0 , 0 , pend( f + 30 , 10 ) + 10
      skelet mid_finger + lr + i , 0 , 0 , pend( f , 10 ) + 10
      skelet ring_finger + lr +  i , 0 , 0 , pend( f - 30 , 10 ) + 10
    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 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( kl as sng4d )
  material.diffuse = kl
  material.use gl_front 
  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, 65.0 , 5 , 35 , 5
    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.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 sng4d )
  material.diffuse = 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.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( kl as sng4d )
  material.diffuse = kl
  material.use gl_front 
  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 digit( b as integer )
  dim as integer i , j
  for i = 0 to 16
    for j = 0 to 20
      if ( letterpart( b , i ) and 2 ^ j ) <> 0 then
        setbox j * 1 / 20 - .5 , i * -1 / 20 + .5 , 0 _
        , .08 , .08 , .08
        sphere 4 , 4 , 1 , 1
      end if
    next j
  next i
end sub

sub text( txt as string , kl as sng4d )
  material.diffuse = kl
  setmaterial gl_front , material
  dim as integer i
  for i = 1 to len( txt )
    glpushmatrix
      gltranslatef i - len( txt ) / 2 - .5 , 0 , 0
      digit asc( mid( txt, i , 1 ) ) 
    glpopmatrix
  next i
end sub

sleep 

#endif ''bluaGL
bluatigro
Posts: 660
Joined: Apr 25, 2012 10:35
Location: netherlands

Re: open gl

Post by bluatigro »

in my old version i get a white screen whit this
in 1.50.0 i get gl/gl.bi missing error

Code: Select all

'' bluatigro 25 jul 2018
'' test bluaGL

#include "bluaGl-txt.bas"

dim as double angle
dim as integer state = -1
dim shared as glint texture(0)

function LoadGLTextures() as integer
  dim Status as integer = 0                    '' Status Indicator
  dim TextureImage(0) as BITMAP_RGBImageRec ptr     '' Create Storage Space For The Texture

  ' Load The Bitmap, Check For Errors, If Bitmap's Not Found Quit
  TextureImage(0) = LoadBMP("data\Crate.bmp")
  if TextureImage(0) then
    Status = 1                                   '' Set The Status To TRUE
    glGenTextures 1, @texture(0)                    '' Create The Texture
    ' Typical Texture Generation Using Data From The Bitmap
    glBindTexture GL_TEXTURE_2D, texture(0)
    glTexImage2D GL_TEXTURE_2D, 0, 3, TextureImage(0)->sizeX, TextureImage(0)->sizeY, 0, GL_RGB, GL_UNSIGNED_BYTE, TextureImage(0)->buffer
    glTexParameteri GL_TEXTURE_2D,GL_TEXTURE_MIN_FILTER,GL_LINEAR
    glTexParameteri GL_TEXTURE_2D,GL_TEXTURE_MAG_FILTER,GL_LINEAR
  end if

  if TextureImage(0) then                           '' If Texture Exists
    if TextureImage(0)->buffer then                 '' If Texture Image Exist
      deallocate(TextureImage(0)->buffer)           '' Free The Texture Image Memory
    end if
    deallocate(TextureImage(0))                     '' Free The Image Structure
  end if

  return Status                                     '' Return The Status
end function

dim as integer dummy = LoadGLTextures()
settxtpoint 0 , 0 , 0
setpoint 0 , -.5 , -.5 , 0
settxtpoint 1 , 1 , 0
setpoint 1 , .5 , -.5 , 0
settxtpoint 2 , 1 , 1
setpoint 2 , .5 , .5  , 0
settxtpoint 3 , 0 , 1
setpoint 3 , -.5 , .5 , 0

camara.z = 10
do
  glclear gl_color_buffer_bit or gl_depth_buffer_bit
  camara.use
  
  glrotated 10 , 0,1,0
  
  animate eyes , angle , 0
  if state = -1 then
    glpushmatrix
      glrotatef angle , 0 , 1 , 0
      txtquad 0,0 , 1,1 , 2,2 , 3,3
    glpopmatrix
  end if
  if state = 0 then
    animate 0 , 0 , 0
    animate i_stand , 0 , 0
    animate i_sting , angle , 10
    insect rainbow( angle )
    glpushmatrix
      gltranslatef 0,-.7,5
      glscalef .4,.4,.4
      text "bug" , white
    glpopmatrix
  end if
  if state = 1 then
    animate human_walk , angle , 30
    human rainbow( angle )
    glpushmatrix
      gltranslatef 0,-.7,5
      glscalef .4,.4,.4
      text "robot" , white
    glpopmatrix
  end if
  if state = 2 then
    animate human_walk , angle , 10
    glpushmatrix
      glscalef 2 , 2 , 2
      glrotatef -80 , 1 , 0 , 0
      hand white , 0
    glpopmatrix
    glpushmatrix
      gltranslatef 0,-.7,5
      glscalef .4,.4,.4
      text "hand" , white
    glpopmatrix
  end if
  if state = 3 then
    animate dog_walk , angle , 30
    dog rainbow( angle )
    glpushmatrix
      gltranslatef 0,-.7,5
      glscalef .4,.4,.4
      text "dog" , white
    glpopmatrix
  end if
  if state = 4 then
    glpushmatrix
      gltranslated 0 , 2 , 0
      glscalef .5,.5,.5
      text date , white
    glpopmatrix
    glpushmatrix
      glscalef .5,.5,.5
      text "the end" , rainbow( angle )
    glpopmatrix
    glpushmatrix
      gltranslated 0 , -2 , 0
      glscalef .5,.5,.5
      text time , white
    glpopmatrix
  end if
  angle = ( angle + 10 ) mod ( 360 * 4 )
  if angle = 0 then 
    state += 1 
    if state > 4 then state = -1
  end if
  sleep 40
  flip
loop while inkey = ""
screen 0

Code: Select all

''bluatigro 25 jul 2018
''bluaGL.bas 

#ifndef OPENGL_H
#define OPENGL_H

dim shared as integer mousex , mousey

''DBL3D

type dbl3d
public :
  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"
#include once "bmpload.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,tilt
  declare sub move( dx as double _
  , dy as double , dz as double , dpan as double )
  declare sub use()
end type
sub t_camara.move( dx as double _
  , dy as double , dz as double , dpan as double )
  rotate dx , dz , -pan
  x += dx
  y += dy
  z += dz
  pan += dpan
end sub
sub t_camara.use
  glLoadIdentity
  glRotated -tilt , 0 , 0 , 1
  glRotated -pan , 0 , 1 , 0
  glTranslated -x , -y , -z
end sub

dim 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

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

dim shared as integer letterpart( 255 , 20 ) 
dim as integer char , ix , iy


for char = 30 to 255
  cls
  print chr( char )
  for ix = 0 to 16
    for iy = 0 to 20
      if point( ix , iy ) <> -16777216 then
        letterpart( char , iy ) += 2 ^ ix
      end if
    next iy
  next ix
next char

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, 1.0, 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 ) = { -50 , 50 , 50 , 1 }
dim as single diffuse( 3 ) = { 1 , 1 , 1 , 1 }
glLightfv( gl_light0 , gl_position, @lightpos(0) )
glLightfv( gl_light0 , gl_diffuse , @diffuse(0) )
glEnable( gl_light0 )

''COLORS

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

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

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

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

''MATERIAL

type t_material
public :
  dim as sng4d 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

''text

declare sub setbox(x as double,y as double,z as double _
,dx as double,dy as double,dz as double )
declare sub cube()
declare sub sphere( a as integer , b as integer _
, c as double , d as double )


''PRIMATIVS

dim shared as dbl3d pnt( 256 )

type dbl2d
public :
  dim as double u , v
end type

dim shared as dbl2d txtpnt( 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 settxtpoint( no as integer , x as double , y as double )
    if no < 0 or no > 255 then exit sub
    txtpnt( no ).u = x
    txtpnt( no ).v = y
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 txttri( p1 as integer , t1 as integer _
          , p2 as integer , t2 as integer _
          , p3 as integer , t3 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 t1 < 0 or t1 > 255 then exit sub
  if t2 < 0 or t2 > 255 then exit sub
  if t3 < 0 or t3 > 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
    glTexCoord2dv @ txtpnt( t1 ).u
    glvertex3d pnt( p1 ).x , pnt( p1 ).y , pnt( p1 ).z
    glTexCoord2dv @ txtpnt( t2 ).u
    glvertex3d pnt( p2 ).x , pnt( p2 ).y , pnt( p2 ).z
    glTexCoord2dv @ txtpnt( t3 ).u
    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 txtquad( p1 as integer , t1 as integer _
           , p2 as integer , t2 as integer _
           , p3 as integer , t3 as integer _
           , p4 as integer , t4 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 t1 < 0 or t1 > 255 then exit sub
  if t2 < 0 or t2 > 255 then exit sub
  if t3 < 0 or t3 > 255 then exit sub
  if t4 < 0 or t4 > 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
    glTexCoord2dv @ txtpnt( t1 ).u
    glvertex3d pnt( p1 ).x , pnt( p1 ).y , pnt( p1 ).z
    glTexCoord2dv @ txtpnt( t2 ).u
    glvertex3d pnt( p2 ).x , pnt( p2 ).y , pnt( p2 ).z
    glTexCoord2dv @ txtpnt( t3 ).u
    glvertex3d pnt( p3 ).x , pnt( p3 ).y , pnt( p3 ).z
    glTexCoord2dv @ txtpnt( t4 ).u
    glvertex3dv @ pnt( p4 ).x
  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
    glnormal3f 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 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 banana( 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/1.99 to PI/1.99 - pi/b*2 step PI / b * 1.99
      j2 = j + PI / b * 1.99
      setpoint 0 _ 
      , mx + ( dx + dy * cos( i ) * cos( j ) ) _
      * cos( j ) _
      , my + ( dx + dy * cos( i ) * cos( j ) ) _
      * sin( j ) _
      , mz + sin( i ) * dz * cos( j )
      setpoint 1 _
      , mx + ( dx + dy * cos( i ) * cos( j2 ) ) _
      * cos( j2 ) _
      , my + ( dx + dy * cos( i ) * cos( j2 ) ) _
      * sin( j2 ) _
      , mz + sin( i ) * dz * cos( j2 )
      setpoint 2 _
      , mx + ( dx + dy * cos( i2 ) * cos( j2 ) ) _
      * cos( j2 ) _
      , my + ( dx + dy * cos( i2 ) * cos( j2 ) ) _
      * sin( j2 ) _
      , mz + sin( i2 ) * dz * cos( j2 )
      setpoint 3 _ 
      , mx + ( dx + dy * cos( i2 ) * cos( j ) ) _
      * cos( j ) _
      , my + ( dx + dy * cos( i2 ) * cos( j ) ) _
      * sin( j ) _
      , mz + sin( i2 ) * dz * cos( j )
      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 mouth = 25

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
const as integer eyes = 10

sub animate( anim as integer , f as double , a as double )
  DIM I AS INTEGER
  select case anim
  case eyes
skelet eye , pend( f , 20 ) , pend( f + 90 , 20 ) , 0
skelet eye+lr , pend( f + 180 , 20 ) , pend( f - 90 , 20 ) , 0
skelet mouth , pend( f , 20 ) + 20 , 0 , 0

  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
    skelet thumb , -pend( f , 10 ) - 10 , 0 , 0
    skelet thumb +lr , -pend( f , 10 ) - 10 , 0 , 0
    for i = 0 to 2
      skelet index_finger + i , 0 , 0 , -pend( f + 30 , 10 ) - 10
      skelet mid_finger + i , 0 , 0 , -pend( f , 10 ) - 10
      skelet ring_finger + i , 0 , 0 , -pend( f - 30 , 10 ) - 10
      skelet index_finger + lr + i , 0 , 0 , pend( f + 30 , 10 ) + 10
      skelet mid_finger + lr + i , 0 , 0 , pend( f , 10 ) + 10
      skelet ring_finger + lr +  i , 0 , 0 , pend( f - 30 , 10 ) + 10
    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 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( kl as sng4d )
  material.diffuse = kl
  material.use gl_front 
  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, 65.0 , 5 , 35 , 5
    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.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 sng4d )
  material.diffuse = 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.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( kl as sng4d )
  material.diffuse = kl
  material.use gl_front 
  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 digit( b as integer )
  dim as integer i , j
  for i = 0 to 16
    for j = 0 to 20
      if ( letterpart( b , i ) and 2 ^ j ) <> 0 then
        setbox j * 1 / 20 - .5 , i * -1 / 20 + .5 , 0 _
        , .08 , .08 , .08
        sphere 4 , 4 , 1 , 1
      end if
    next j
  next i
end sub

sub text( txt as string , kl as sng4d )
  material.diffuse = kl
  material.use gl_front
  dim as integer i
  for i = 1 to len( txt )
    glpushmatrix
      gltranslatef i - len( txt ) / 2 - .5 , 0 , 0
      digit asc( mid( txt, i , 1 ) ) 
    glpopmatrix
  next i
end sub

sleep 

#endif ''bluaGL
Post Reply