open gl

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

Re: open gl

Post by bluatigro »

update :
now whit joystick OOP

Code: Select all

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

#include "_open_gl_dbl.bas"
#include "_joystick.bas"

dim as double hoek

type t_skycar
public :
  dim as double x , y , z , pan
  dim as sng4d kl
  dim as integer tel , state
  declare sub draw_it
  declare sub move( dx as double _
  , dy as double , dz as double , dpan as double )
end type
sub t_skycar.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_skycar.draw_it
material.diffuse = kl
setmaterial GL_FRONT , material
glpushmatrix
  gltranslated x,y,z
  glrotated pan , 0,1,0
  glpushmatrix
    setbox 0,0,0 , .5,.5,2
    sphere 24 , 24 , 1 , 1
    setbox 0,.5,0 , .2,.2,.5
    sphere 24 , 24 , 1 , 1
    glpushmatrix
      gltranslatef 1,-.5,1.5
      glrotatef -60 , 1,0,0
      setbox 0,0,0 , .3,.1,.3
      torus 24 , 24
    glpopmatrix
    glpushmatrix
      gltranslatef -1,-.5,1.5
      glrotatef -60 , 1,0,0
      setbox 0,0,0 , .3,.1,.3
      torus 24 , 24
    glpopmatrix
    glpushmatrix
      gltranslatef 1,0,-1.5
      glrotatef -60 , 1,0,0
      setbox 0,0,0 , .3,.1,.3
      torus 24 , 24
    glpopmatrix
    glpushmatrix
      gltranslatef -1,0,-1.5
      glrotatef -60 , 1,0,0
      setbox 0,0,0 , .3,.1,.3
      torus 24 , 24
    glpopmatrix
  glpopmatrix
glpopmatrix
end sub
dim as integer i , size = 10
dim as double dx , dy , dz , dpan
dim shared as t_skycar skycar( 5 )
dim as dbl3d skycarspot , camaraspot 
dim as sng4d clr( 5 ) = { red , green , yellow , blue , magenta , cyan }
for i = 0 to ubound( skycar )
  while length( skycarspot - camaraspot ) < 6
    skycar(i).x = range( -size , size )
    skycar(i).y = range( 0 , 10 )
    skycar(i).z = range( -size , size )
    skycarspot.fill skycar(i).x , skycar(i).y , skycar(i).z
  wend
  skycar( i ).kl = clr( i mod 6 )
next i

dim as joystick joy
do
  glClear GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT
''camara
  camara.use
''ground
  material.diffuse = green
  setmaterial GL_FRONT_AND_BACK , material
  for i = -size to size
    for j = -size to size
      if (i+j)and 1 then
        setpoint 0 , i , -1 , j+1
        setpoint 1 , i+1 , -1 , j+1
        setpoint 2 , i+1 , -1 , j
        setpoint 3 , i , -1 , j
        quad 0 , 1 , 2 , 3
      end if
    next j
  next i
''skycar stuf
  for i = 0 to ubound( skycar )
  skycar(i).tel -= 1
  if skycar(i).tel < 0 then
    skycar(i).tel = range( 15 , 150 )
    skycar(i).state = range( 0 , 5 )
  end if
  select case skycar(i).state
    case 0
      if skycar(i).y < 10 then skycar(i).move 0,.1,.1,0
    case 1
      if skycar(i).y > 0 then skycar(i).move 0,-.1,.1,0
    case 2
      skycar(i).move 0,0,.2,0
    case 3
      skycar(i).move 0,0,0,1
    case else
      skycar(i).move 0,0,0,-1
  end select
  skycar(i).draw_it
  if skycar(i).x < -size then skycar(i).x = size
  if skycar(i).x > size then skycar(i).x = -size
  if skycar(i).z < -size then skycar(i).z = size
  if skycar(i).z < size then skycar(i).z = -size
''hit camara - skycar ?
skycarspot.fill skycar(i).x , skycar(i).y , skycar(i).z
camaraspot.fill camara.x , camara.y , camara.z
''if length( camaraspot - skycarspot ) < 4 then exit do
  next i

  joy.read_all
  
  if joy.x( left_nr ) < -0.5 then camara.move -0.1 , 0 , 0 , 0
  if joy.y( left_nr ) < -0.5 then camara.move 0 , 0.1 , 0 , 0
  if joy.x( left_nr ) > 0.5 then camara.move 0.1 , 0 , 0 , 0
  if joy.y( left_nr ) > 0.5 then camara.move 0 , -0.1 , 0 , 0
  if joy.x( right_nr ) < -0.5 then camara.move 0 , 0 , 0 , 1
  if joy.y( right_nr ) < -0.5 then camara.move 0 , 0 , -0.1 , 0
  if joy.x( right_nr ) > 0.5 then camara.move 0 , 0 , 0 , -1
  if joy.y( right_nr ) > 0.5 then camara.move 0 , 0 , 0.1 , 0

  sleep 40
  flip
loop while inkey = ""
whit the joystick i used a logitech one
you problely need to change the const's for other ones

Code: Select all

''bluatigro 10 may 2017
''game lib : joystick object 

type joystick
public :
  dim as single x( 3 ) , y( 3 )
  dim as integer id , buttons , isthere
  declare sub read_all
end type
sub joystick.read_all
  if not getjoystick( id , buttons _
  , x( 0 ) , y( 0 ) , x( 1 ) , y( 1 ) _
  , x( 2 ) , y( 2 ) , x( 3 ) , y( 3 ) ) then
    isthere = 1
  else
    isthere = 0
  end if
end sub 

''logitech const's
''bit's are for button's
''nr's for stick's
const as integer red_bit = 4
const as integer green_bit = 2
const as integer blue_bit = 1
const as integer left_nr = 0
const as integer right_nr = 1
const as integer pad_nr = 3
const as integer lt_bit = 64
const as integer lb_bit = 16
const as integer rt_bit = 128
const as integer rb_bit = 32

sub joysticktest
  dim as joystick joy
  joy.id = 0
  dim as integer i
  do
    joy.read_all
    screenlock
      cls
      print "[ push [esc] to end ]"
      if joy.isthere then
        print "buttons : " ; joy.buttons 
        for i = 0 to 3
          print "x [ " ; i ; " ] = " ; joy.x( i )
          print "y [ " ; i ; " ] = " ; joy.y( i )
        next i
      else
        print
        print "[ NO JOYSTICK DETECTED !! ]"
      end if
    screenunlock
    sleep 100
  loop until inkey = chr( 27 )
end sub 

''joysticktest
bluatigro
Posts: 660
Joined: Apr 25, 2012 10:35
Location: netherlands

Re: open gl

Post by bluatigro »

update :
banana sub added to _open_gl_dbl.bas

test banana

Code: Select all

''bluatigro 13 may 2017
''demo opengl graphics

#include "_open_gl_dbl.bas"

dim as double angle
dim as integer state
camara.z = 5
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,.5,.5
  banana 12 , 12

  angle = ( angle + 3 ) mod 360
  if angle = 0 then 
    state = ( state + 1 ) mod 7 
  end if
  sleep 40
  flip
loop while inkey = ""
add to _open_gl_dbl.bas this code

Code: Select all


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
bluatigro
Posts: 660
Joined: Apr 25, 2012 10:35
Location: netherlands

Re: open gl

Post by bluatigro »

update :
test what you can do whit banana

error :
where do the spaces the ide sees come from ?

dont forget to put the banana sub into _open_gl_dbl.bas

space shooter game

Code: Select all

''bluatigro 5 jun 2017
''opengl lib test 4
''space shooter game

#include "_open_gl_dbl.bas"
#include "_joystick.bas"

type t_emy
public :
  dim as double x , y , z , pan , tilt
  dim as sng4d kl
  dim as integer tel , state
  declare sub draw_it
  declare sub move( dx as double _
  , dy as double , dz as double , dpan as double )
end type
sub t_emy.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_emy.draw_it
  material.diffuse = kl
  setmaterial GL_FRONT , material
  glpushmatrix
    gltranslated x,y,z
    glrotated 90 , 0,0,1
    glrotated 90 , 0,1,0
    glrotated pan ,0,0,1
    glrotated tilt , 1,0,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
  glpopmatrix
end sub
dim as integer i , size = 50
dim as double dx , dy , dz , dpan
dim shared as t_emy emy( 5 )
dim as double hoek( ubound( emy ) )
dim as dbl3d emyspot , camaraspot 
dim as sng4d clr( 5 ) = { red , green , yellow , blue , magenta , cyan }
for i = 0 to ubound( emy )
  while length( emyspot - camaraspot ) < 6
    emy(i).x = range( -size , size )
    emy(i).y = range( 0 , 10 )
    emy(i).z = range( -size , size )
    emyspot.fill emy(i).x , emy(i).y , emy(i).z
  wend
  emy( i ).kl = clr( i mod 6 )
next i

dim as joystick joy
do
  glClear GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT
''camara
  camara.use
''ground
  material.diffuse = green
  setmaterial GL_FRONT_AND_BACK , material
  for i = -size to size step 5
    for j = -size to size step 5
        setpoint 0 , i , -1 , j+1
        setpoint 1 , i+1 , -1 , j+1
        setpoint 2 , i+1 , -1 , j
        setpoint 3 , i , -1 , j
        quad 0 , 1 , 2 , 3
    next j
  next i
''emy stuf
  for i = 0 to ubound( emy )
    emy(i).tel -= 1
    if emy(i).tel < 0 then
      emy(i).tel = range( 15 , 150 )
      emy(i).state = range( 0 , 3 )
    end if
    emy(i).tilt = hoek(i)
    emy(i).move 0,0,.1,0
    select case emy(i).state
      case 0
        emy(i).move 0 , 0 , .1 , hoek( i )
      case 1
        emy(i).move 0 , 0 , .1 , hoek( i )
        if hoek(i) < 45 then 
          hoek(i) += 1
        else
          emy(i).state = 0
''          emy(i).tel = range( 25 , 100 )
        end if
      case 2
        emy(i).move 0 , 0 , .1 , hoek( i )
        if hoek(i) > -4.5 then 
          hoek(i) -= .1
        else
          emy(i).state = 0
''          emy(i).tel = range( 25 , 100 )
        end if
      case else
        emy(i).move 0 , 0 , .1 , hoek( i )
    end select
   
    emy(i).draw_it
    if emy(i).x < -size then 
      emy(i).x = size
    end if
    if emy(i).x > size then 
      emy(i).x = -size
    end if
    if emy(i).z < -size then 
      emy(i).z = size
    end if
    if emy(i).z < size then 
      emy(i).z = -size
    end if
''hit camara - emy ?
emyspot.fill emy(i).x , emy(i).y , emy(i).z
camaraspot.fill camara.x , camara.y , camara.z
''if length( camaraspot - emyspot ) < 4 then exit do
  next i

  joy.read_all
  
  camara.move 0 , 0 , -0.1 , 0
  camara.tilt = 0
  if joy.x( left_nr ) < -0.5 then 
    camara.move -0.1 , 0 , 0 , 0
  end if
  if joy.y( left_nr ) < -0.5 then 
    if camara.y < 10 then
      camara.move 0 , 0.1 , 0 , 0
    end if
  end if
  if joy.x( left_nr ) > 0.5 then 
    camara.move 0.1 , 0 , 0 , 0
  end if
  if joy.y( left_nr ) > 0.5 then 
    if camara.y > 0 then
      camara.move 0 , -0.1 , 0 , 0
    end if
  end if
  if joy.x( right_nr ) < -0.5 then 
    camara.move 0 , 0 , 0 , 1
    camara.tilt = 45
  end if
  if joy.y( right_nr ) < -0.5 then 
    camara.move 0 , 0 , -0.1 , 0
  end if
  if joy.x( right_nr ) > 0.5 then 
    camara.move 0 , 0 , 0 , -1
    camara.tilt = -45
  end if
  if joy.y( right_nr ) > 0.5 then 
    camara.move 0 , 0 , 0.1 , 0
  end if
''keep camara in game  
  if camara.x > size then
    camara.x = -size
  end if
  if camara.x < -size then
    camara.x = size
  end if
  if camara.z > size then
    camara.z = -size
  end if
  if camara.z < -size then
    camara.z = size
  end if

  sleep 40
  flip
loop while inkey = ""
change camara in _open_gl_dbl.bas

Code: Select all

''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
thesanman112
Posts: 538
Joined: Jul 15, 2005 4:13

Re: open gl

Post by thesanman112 »

bluatigro,

where is the original _opengl_dbl file?? maybe you could just edit first post with what you have so far, just edit the code sniblets to reflect the changes you have made, and have ALL the programs needed to run...
bluatigro
Posts: 660
Joined: Apr 25, 2012 10:35
Location: netherlands

Re: open gl

Post by bluatigro »

@ thesanman112 :
at your request :
the new _open_gl_dbl.bas

Code: Select all

''bluatigro 7 jun 2017
''_open_gl_dbl.bas 

#ifndef OPENGL_H
#define OPENGL_H

dim shared as integer mousex , mousey

''DBL3D

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

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

''MATH

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

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

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

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

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

''CAMARA

type t_camara
public :
  dim as double x,y,z,pan,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 

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

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

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

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

#include "fbgfx.bi"
#if __FB_LANG__ = "fb"
  Using FB 
#endif
SCREEN 20 , 32 , , 2
DIM shared AS INTEGER winx , winy
SCREENINFO winx , winy 
''SCREENRES winx , winy , 32 , 2 , FB.GFX_FULLSCREEN

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

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

''COLORS

type sng4d
  dim as single x , y , z , w
  declare sub fill( nx as single , ny as single , nz as single , nw as single )
end type
sub sng4d.fill( nx as single , ny as single , nz as single , nw as single )
  x = nx 
  y = ny 
  z = nz
  w = nw
end sub
dim shared as sng4d black , red , green , yellow _
, blue , magenta , cyan , white _
, orange , gray , pink 
black.fill   0,0,0,1
red.fill     1,0,0,1
green.fill   0,1,0,1
yellow.fill  1,1,0,1
blue.fill    0,0,1,1
magenta.fill 1,0,1,1
cyan.fill    0,1,1,1
white.fill   1,1,1,1

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

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

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

''MATERIAL

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

''PRIMATIVS

dim shared as dbl3d pnt( 256 )

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

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

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

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

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


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

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


''SHAPES

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

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

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

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

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

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

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

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

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

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

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

sub 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 iarm = 1
const as integer ielbow = 2
const as integer iwrist = 3
const as integer ileg = 4 
const as integer iknee = 9 
const as integer iwing = 14
const as integer itail = 16
const as integer isensor = 17
const as integer ithumb = 18
const as integer ifinger = 19

const as integer lr = 32

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

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

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

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

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

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

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

#endif
some mistakes removed from
main

Code: Select all

''bluatigro 7 jun 2017
''opengl lib test 4
''space shooter game

#include "_open_gl_dbl.bas"
#include "_joystick.bas"

type t_emy
public :
  dim as double x , y , z , pan , tilt , rol
  dim as sng4d kl
  dim as integer tel , state
  declare sub draw_it
  declare sub move( dx as double _
  , dy as double , dz as double , dpan as double )
end type
sub t_emy.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
  rol = dpan * 10
end sub
sub t_emy.draw_it
  material.diffuse = kl
  setmaterial GL_FRONT , material
  glpushmatrix
    gltranslated x,y,z
    glrotated 90 , 0,0,1
    glrotated 90 , 0,1,0
    glrotated pan ,0,0,1
    glrotated rol , 1,0,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
  glpopmatrix
end sub
dim as integer i , size = 50
dim as double dx , dy , dz , dpan
dim shared as t_emy emy( 5 )
dim as double hoek( ubound( emy ) )
dim as dbl3d emyspot , camaraspot 
dim as sng4d clr( 5 ) = { red , green , yellow , blue , magenta , cyan }
for i = 0 to ubound( emy )
  while length( emyspot - camaraspot ) < 6
    emy(i).x = range( -size , size )
    emy(i).y = range( 0 , 10 )
    emy(i).z = range( -size , size )
    emyspot.fill emy(i).x , emy(i).y , emy(i).z
  wend
  emy( i ).kl = clr( i mod 6 )
next i

dim as joystick joy
do
  glClear GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT
''camara
  camara.use
''ground
  material.diffuse = green
  setmaterial GL_FRONT_AND_BACK , material
  for i = -size to size step 5
    for j = -size to size step 5
        setpoint 0 , i , -1 , j+1
        setpoint 1 , i+1 , -1 , j+1
        setpoint 2 , i+1 , -1 , j
        setpoint 3 , i , -1 , j
        quad 0 , 1 , 2 , 3
    next j
  next i
''emy stuf
  for i = 0 to ubound( emy )
    emy(i).tel -= 1
    if emy(i).tel < 0 then
      emy(i).tel = range( 15 , 150 )
      emy(i).state = range( 0 , 5 )
    end if
    emy(i).move 0,0,.1,0
    select case emy(i).state
      case 0
        emy(i).move 0 , 0 , .1 , hoek( i )
      case 1
        emy(i).move 0 , 0 , .1 , hoek( i )
        if hoek(i) < 4.5 then 
          hoek(i) += .1
        else
          emy(i).state = 0
''          emy(i).tel = range( 25 , 100 )
        end if
      case 2
        emy(i).move 0 , 0 , .1 , hoek( i )
        if hoek(i) > -4.5 then 
          hoek(i) -= .1
        else
          emy(i).state = 0
''          emy(i).tel = range( 25 , 100 )
        end if
      case 3
        if emy(i).y < 10 then
          emy(i).move 0 , .1 , 0 , hoek(i)
        end if
      case 4
        if emy(i).y > 0 then
          eny(i).move 0 , -.1 , 0 , hoek(i)
        end if
      case else
        emy(i).move 0 , 0 , .1 , hoek( i )
    end select
   
    emy(i).draw_it
    if emy(i).x < -size then 
      emy(i).x = size
    end if
    if emy(i).x > size then 
      emy(i).x = -size
    end if
    if emy(i).z < -size then 
      emy(i).z = size
    end if
    if emy(i).z < size then 
      emy(i).z = -size
    end if
''hit camara - emy ?
    emyspot.fill emy(i).x , emy(i).y , emy(i).z
    camaraspot.fill camara.x , camara.y , camara.z
''if length( camaraspot - emyspot ) < 4 then exit do
  next i

  joy.read_all
  
  camara.move 0 , 0 , -0.1 , 0
  camara.tilt = 0
  if joy.x( left_nr ) < -0.5 then 
    camara.move -0.1 , 0 , 0 , 0
  end if
  if joy.y( left_nr ) < -0.5 then 
    if camara.y < 10 then
      camara.move 0 , 0.1 , 0 , 0
    end if
  end if
  if joy.x( left_nr ) > 0.5 then 
    camara.move 0.1 , 0 , 0 , 0
  end if
  if joy.y( left_nr ) > 0.5 then 
    if camara.y > 0 then
      camara.move 0 , -0.1 , 0 , 0
    end if
  end if
  if joy.x( right_nr ) < -0.5 then 
    camara.move 0 , 0 , 0 , 1
    camara.tilt = 45
  end if
  if joy.y( right_nr ) < -0.5 then 
    camara.move 0 , 0 , -0.1 , 0
  end if
  if joy.x( right_nr ) > 0.5 then 
    camara.move 0 , 0 , 0 , -1
    camara.tilt = -45
  end if
  if joy.y( right_nr ) > 0.5 then 
    camara.move 0 , 0 , 0.1 , 0
  end if
''keep camara in game  
  if camara.x > size then
    camara.x = -size
  end if
  if camara.x < -size then
    camara.x = size
  end if
  if camara.z > size then
    camara.z = -size
  end if
  if camara.z < -size then
    camara.z = size
  end if

  sleep 40
  flip
loop while inkey = ""
where are the spaces come from the compiler sees ?
how do i remove them ?
bluatigro
Posts: 660
Joined: Apr 25, 2012 10:35
Location: netherlands

Re: open gl

Post by bluatigro »

update :
opengl text on screen

Code: Select all

''bluatigro 22 nov 2017
''demo opengl graphics

#include "_avartars.bas"

dim as double angle
dim as integer state
camara.z = 5
camara.y = 0
do
  glclear gl_color_buffer_bit or gl_depth_buffer_bit
  camara.use

  material.diffuse = white
  setmaterial gl_front , material
  glrotated angle ,0,0,1

  text "GAME OVER"

  sleep 40
  flip
loop while inkey = ""


Code: Select all

''bluatigro 22 nov 2017
''_open_gl_dbl.bas 

#ifndef OPENGL_H
#define OPENGL_H

dim shared as integer mousex , mousey

''DBL3D

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

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

''MATH

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

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

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

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

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

''CAMARA

type t_camara
public :
  dim as double x,y,z,pan,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 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.5, 0.5, 0.5, 1.0                '' Black Background
glClearDepth 1.0                               '' Depth Buffer Setup
glEnable GL_DEPTH_TEST                         '' Enables Depth Testing
glDepthFunc GL_LEQUAL                          '' The Type Of Depth Testing To Do
glHint GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST    '' Really Nice Perspective Calculations

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

''COLORS

type sng4d
  dim as single x , y , z , w
  declare sub fill( nx as single , ny as single , nz as single , nw as single )
end type
sub sng4d.fill( nx as single , ny as single , nz as single , nw as single )
  x = nx 
  y = ny 
  z = nz
  w = nw
end sub

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

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

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

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

''MATERIAL

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

''text

dim shared as integer letterpart( 40 , 7 ) 
dim as integer j , k 
const as string letters = "abcdefghijklmnopqrstuvwxyz0123456789"
dim as string q
for i as byte = 1 to len( letters )
  for j = 0 to 7
    read q
    for k = 0 to 7
      if mid( q , k + 1 , 1 ) = "1" then
        letterpart( i , j ) = letterpart( i , j ) or 2 ^ k
      end if
    next k
  next j
next i

''a
data "...1...."
data "..111..."
data ".1...1.."
data "1.....1."
data "1111111."
data "1.....1."
data "1.....1."
data "1.....1."
''b
data "1111...."
data "1...1..."
data "1....1.."
data "1....1.."
data "111111.."
data "1.....1."
data "1.....1."
data "111111.."
''c
data "..111..."
data ".1...1.."
data "1.....1."
data "1......."
data "1......."
data "1.....1."
data ".1...1.."
data "..111..."
''d
data "11111..."
data "1....1.."
data "1.....1."
data "1.....1."
data "1.....1."
data "1.....1."
data "1....1.."
data "11111..."
''e
data "1111111."
data "1.....1."
data "1......."
data "1......."
data "111111.."
data "1......."
data "1.....1."
data "1111111."
''f
data "1111111."
data "1.....1."
data "1......."
data "1......."
data "111111.."
data "1......."
data "1......."
data "1......."
''g
data "..111..."
data ".1...1.."
data "1.....1."
data "1......."
data "1...111."
data "1.....1."
data ".1...1.."
data "..111..."
''h
data "1.....1."
data "1.....1."
data "1.....1."
data "1.....1."
data "1111111."
data "1.....1."
data "1.....1."
data "1.....1."
''i
data "..111..."
data "...1...."
data "...1...."
data "...1...."
data "...1...."
data "...1...."
data "...1...."
data "..111..."
''j
data "..111..."
data "...1...."
data "...1...."
data "...1...."
data "...1...."
data "1..1...."
data "1..1...."
data ".11...."
''k
data "1......."
data "1....1.."
data "1...1..."
data "1..1...."
data "111.."
data "1...1..."
data "1....1.."
data "1.....1."
''l
data "1......."
data "1......."
data "1......."
data "1......."
data "1......."
data "1......."
data "1......."
data "1111111."
''m
data "1.....1."
data "11...11."
data "1.1.1.1."
data "1..1..1."
data "1..1..1."
data "1.....1."
data "1.....1."
data "1.....1."
''n
data "1.....1."
data "11....1."
data "1.1...1."
data "1..1..1."
data "1..1..1."
data "1...1.1."
data "1....11."
data "1.....1."
''o
data "..111..."
data ".1...1.."
data "1.....1."
data "1.....1."
data "1.....1."
data "1.....1."
data ".1...1.."
data "..111..."
''p
data "11111..."
data "1....1.."
data "1.....1."
data "1....1.."
data "11111..."
data "1.....,."
data "1......."
data "1......."
''q
data "..111..."
data ".1...1.."
data "1.....1."
data "1.....1."
data "1..1..1."
data "1...1.1."
data ".1...1.."
data "..111.1."
''r
data "11111..."
data "1....1.."
data "1.....1."
data "1....1.."
data "111111.."
data "1...1..."
data "1....1.."
data "1.....1."
''s
data "..111..."
data ".1...1.."
data "1.....1."
data "1......."
data ".11111.."
data "......1."
data "1.....1."
data ".11111.."
''t
data "1111111."
data "1..1..1."
data "...1...."
data "...1...."
data "...1...."
data "...1...."
data "...1...."
data "..111..."
''u
data "1.....1."
data "1.....1."
data "1.....1."
data "1.....1."
data "1.....1."
data "1.....1."
data "1.....1."
data ".11111.."
''v
data "1.....1."
data "1.....1."
data "1.....1."
data "1.....1."
data "1.....1."
data ".1...1.."
data "..1.1..."
data "...1...."
''w
data "1.....1."
data "1.....1."
data "1.....1."
data "1.....1."
data "1..1..1."
data "1.1.1.1."
data "11...11."
data "1.....1."
''x
data "1.....1."
data ".1...1.."
data "..1.1.."
data "...1...."
data "...1...."
data "..1.1..."
data ".1...1.."
data "1.....1."
''y
data "1.....1."
data ".1...1.."
data "..1.1.."
data "...1...."
data "...1...."
data "..1....."
data ".1......"
data "1......."
''z
data "1111111."
data ".....1.."
data "....1..."
data "...1...."
data "...1...."
data "..1....."
data ".1......"
data "1111111."
''0
data ".11111.."
data "1.....1."
data "1.....1."
data "1.....1."
data "........"
data "1.....1."
data "1.....1."
data ".11111.."
''1
data "........"
data "......1."
data "......1."
data "......1."
data "........"
data "......1."
data "......1."
data "........"
''2
data ".11111.."
data "......1."
data "......1."
data "......1."
data ".11111.."
data "1......."
data "1......."
data ".11111.."
''3
data ".11111.."
data "......1."
data "......1."
data "......1."
data ".11111.."
data "......1."
data "......1."
data ".11111.."
''4
data "........"
data "1.....1."
data "1.....1."
data "1.....1."
data ".11111.."
data "......1."
data "......1."
data "........"
''5
data ".11111.."
data "1......."
data "1......."
data "1......."
data ".11111.."
data "......1."
data "......1."
data ".11111.."
''6
data ".11111.."
data "1......."
data "1......."
data "1......."
data ".11111.."
data "1.....1."
data "1.....1."
data ".11111.."
''7
data ".11111.."
data "......1."
data "......1."
data "......1."
data "........"
data "......1."
data "......1."
data "........"
''8
data ".11111.."
data "1.....1."
data "1.....1."
data "1.....1."
data ".11111.."
data "1.....1."
data "1.....1."
data ".11111.."
''9
data ".11111.."
data "1.....1."
data "1.....1."
data "1.....1."
data ".11111.."
data "......1."
data "......1."
data ".11111.."

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

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

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

''PRIMATIVS

dim shared as dbl3d pnt( 256 )

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

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

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

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

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


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

  glbegin gl_polygon
    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 sphere( h as integer , r as integer _
, a as double , b as double )
declare sub hsphere( h as integer , r as integer _
, t as integer , a as double , b as double )
declare sub torus( hsides as integer , rsides as integer )
declare sub cilinder( sides as integer _
, dx as double , dy as double , top as integer , bot as integer ) 
declare sub hcube( )
declare sub geo( no as integer , p1 as integer _
, p2 as integer , p3 as integer )

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

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

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

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

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

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

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

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

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

sub 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 iarm = 1
const as integer ielbow = 2
const as integer iwrist = 3
const as integer ileg = 4 
const as integer iknee = 9 
const as integer iwing = 14
const as integer itail = 16
const as integer isensor = 17
const as integer ithumb = 18
const as integer ifinger = 19

const as integer lr = 32

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

sub animate( anim as integer , f as double , a as double )
  DIM I AS INTEGER
  select case anim
  case human_walk
    skelet arm , pend( f , a ) , 0 , 0
    skelet elbow , -abs( a ) , 0 , 0
    skelet arm + lr , pend( f + 180, a ) , 0 , 0
    skelet elbow + lr , -abs( a ) , 0 , 0
    skelet leg , pend( f + 180 , a ) , 0 , 0
    skelet knee , pend( f + 90 , a ) + a , 0 , 0
    skelet leg + lr , pend( f , a ) , 0 , 0
    skelet knee + lr , pend( f - 90 , a ) + a , 0 , 0
    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, 30.0, 5.0, 5.0, 30.0
    Cube
    glPushMatrix
      child 0.0, 0.0, 65.0, ielbow, xyz
      Cube
      glPushmatrix
        child 0.0, 0.0, 65.0 , iwrist, xyz
        glPushmatrix
          child -10.0, 0.0, 5.0 , ithumb, xyz
          Cube
        glPopMatrix
        glPushMatrix
          child 5.0, 0.0, 5.0, ifinger, xyz
          setbox 0.0, 0.0, 30.0, 5.0, 10.0, 30.0
          Cube
        glPopMatrix
      glPopMatrix
    glPopMatrix
  glPopMatrix
  glPushMatrix
    child -30.0, 0.0, 65.0, iarm + lr, xyz
    setbox 0.0, 0.0, 30.0, 5.0, 5.0, 30.0
    Cube
    glPushMatrix
      child 0.0, 0.0, 65.0, ielbow +lr, xyz
      Cube
      glPushMatrix
        child 0.0, 0.0, 65.0, iwrist+lr, xyz
        glPushMatrix
          child 10.0, 0.0, 5.0, ithumb+lr, xyz
          Cube
        glPopMatrix
        glPushMatrix
          child -5.0, 0.0, 5.0, ifinger+lr, xyz
          setbox 0.0, 0.0, 30.0, 5.0, 10.0, 30.0
          Cube
        glPopMatrix
      glPopMatrix
    glPopMatrix
   glPopMatrix
   For i = 0 To 1
     glPushMatrix
       child 20.0, 20.0, 40.0 - 50.0 * i, iwing + i, xyz
       setbox 60.0, 0.0, 8.0, 60.0, 2.0, 16.0
       Cube
     glPopMatrix
     glPushMatrix
       child -20.0, 20.0, 40.0 - 50.0 * i , iwing+lr + i,  xyz
       setbox -60.0, 0.0, 8.0, 60.0, 2.0, 16.0
       Cube
     glPopmatrix
   Next
glPopMatrix
end sub

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

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

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

sub dog( 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

#endif
dodicat
Posts: 7983
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: open gl

Post by dodicat »

If I set the camera.z to 10
Then create the colour parameter for the text:
I did:
dim as sng4d g=type(100,10,0,1)
just before the loop.
Then
text "GAME OVER",g

It looks really good.
Thank you.
bluatigro
Posts: 660
Joined: Apr 25, 2012 10:35
Location: netherlands

Re: open gl

Post by bluatigro »

try at terain

instuctions :
use cursor keys for left , right , up and down
use mouse for rotate_pan , forwart and back

WARNING :
don't make noizesize to great

main :

Code: Select all

''bluatigro 13 may 2017
''noise hils

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

dim as double x , y
dim as dbl3d hil( noizesize , noizesize )
for x = 0 to noizesize
  for y = 0 to noizesize
    hil( x , y ).fill x - noizesize/2 , turbulence2d( x , y , noizesize )*20 , y - noizesize/2
  next y
next x

dim as integer state
dim as double angle
dim as dbl3d normal
camara.y = 20
do
  glclear gl_color_buffer_bit or gl_depth_buffer_bit
''  camara.pan = angle
  glloadidentity
  glpushmatrix
    gltranslated 0,.35,-1
    glscaled .1,.1,.1
    text "points" , red
  glpopmatrix
  camara.use
  material.diffuse = green
  setmaterial gl_front , material 
  for x = 0 to noizesize - 1
    for y = 0 to noizesize - 1
      normal = (hil(x,y+1)-hil(x,y))\(hil(x+1,y)-hil(x,y))
      glbegin gl_quads
        glnormal3dv @ normal.x
        glvertex3dv @ hil(x,y).x
        glvertex3dv @ hil(x+1,y).x
        glvertex3dv @ hil(x+1,y+1).x
        glvertex3dv @ hil(x,y+1).x
      glend
    next y
  next x

  if multikey( sc_left ) then camara.move -.3 , 0 , 0 , 0
  if multikey( sc_right ) then camara.move .3 , 0 , 0 , 0
  if multikey( sc_up ) then camara.move 0 , 0.3 , 0 , 0
  if multikey( sc_down ) then camara.move 0 , -.3 , 0 , 0
  if not getmouse( mousex , mousey ) then
    if mousex <> -1 and mousey <> -1 then
      if mousex < winx / 3 then camara.move 0 , 0 , 0 , 1
      if mousex > winx * 2 / 3 then camara.move 0 , 0 , 0 , -1
      if mousey < winy / 3 then camara.move 0 , 0 , -.3 , 0
      if mousey > winy * 2 / 3 then camara.move 0 , 0 , .3 , 0
    end if
  end if
  angle += 2
  sleep 40
  flip
loop until inkey = chr( 27 )
i removed the noise array and repaced it whit a function so it takes les space
noise.bas :

Code: Select all

'' bluatigro 29 nov 2017
'' noise

#ifndef __SIMPLENOISE_BI__
#define __SIMPLENOISE_BI__

const as integer NOIZESIZE = 63

function noise( x as integer , y as integer , z as integer ) as double
  randomize x + 1000 * y + 1e6 * z
  return rnd 
end function

function smoothNoise1d(x as double) as double
  x=abs(x)
  dim as integer iX1=int(x)
  dim as integer iX2=ix1+1
  dim as double tx=x-iX1
  iX1 and= NOIZESIZE
  iX2 and= NOIZESIZE
  dim as double l=noise(iX1,0,0)
  dim as double r=noise(iX2,0,0)
  dim as double v=l + (r-l)*tx
  return v
end function

function smoothNoise2d(x as double, y as double) as double
  x=abs(x)
  y=abs(y)
  dim as integer iX1=int(x)
  dim as integer iY1=int(y)
  dim as integer iX2=ix1+1
  dim as integer iY2=iy1+1
  dim as double tx=x-iX1
  dim as double ty=y-iY1
  
  iX1 and= NOIZESIZE
  iX2 and= NOIZESIZE
  iY1 and= NOIZESIZE
  iY2 and= NOIZESIZE
  
  dim as double lt=noise(iX1,iY1,0)
  dim as double rt=noise(iX2,iY1,0)
  dim as double rb=noise(iX2,iY2,0)
  dim as double lb=noise(iX1,iY2,0)
  
  dim as double sxt=lt + (rt-lt)*tx
  dim as double sxb=lb + (rb-lb)*tx
  
  dim as double v=sxt+(sxb-sxt)*ty
  return v
end function

function smoothNoise3d(x as double, y as double, z as double) as double
  x=abs(x)
  y=abs(y)
  z=abs(z)
  dim as integer iX1=int(x)
  dim as integer iY1=int(y)
  dim as integer iZ1=int(z)
  dim as integer iX2=ix1+1
  dim as integer iY2=iy1+1
  dim as integer iZ2=iz1+1
  dim as double tx=x-iX1
  dim as double ty=y-iY1
  dim as double tz=z-iZ1
  
  iX1 and= NOIZESIZE
  iX2 and= NOIZESIZE
  iY1 and= NOIZESIZE
  iY2 and= NOIZESIZE
  iZ1 and= NOIZESIZE
  iZ2 and= NOIZESIZE
  
  dim as double ltf=noise(iX1,iY1,iZ1)
  dim as double rtf=noise(iX2,iY1,iZ1)
  dim as double rbf=noise(iX2,iY2,iZ1)
  dim as double lbf=noise(iX1,iY2,iZ1)
  dim as double sxtf=ltf + (rtf-ltf)*tx
  dim as double sxbf=lbf + (rbf-lbf)*tx
  
  dim as double ltb=noise(iX1,iY1,iZ2)
  dim as double rtb=noise(iX2,iY1,iZ2)
  dim as double rbb=noise(iX2,iY2,iZ2)
  dim as double lbb=noise(iX1,iY2,iZ2)
  dim as double sxtb = ltb + (rtb-ltb)*tx
  dim as double sxbb = lbb + (rbb-lbb)*tx
  
  dim as double vf = sxtf+(sxbf-sxtf)*ty
  dim as double vb = sxtb+(sxbb-sxtb)*ty
  dim as double v = vf + (vb-vf)*tz
   
  return v
end function

function turbulence1d(x as double, size as double) as double
  dim as double value, initialSize=any
  if size<1 then size=1
  initialSize = size
  while(size >= 1)
    value += smoothNoise1d(x / size) * size
    size /= 2.0
  wend
  value*=0.5
  return value/initialSize
end function

function turbulence2d(x as double, y as double, size as double) as double
  dim as double value, initialSize=any
  if size<1 then size=1
  initialSize = size
  while(size >= 1)
    value += smoothNoise2d(x / size, y / size) * size
    size /= 2.0
  wend
  value*=0.5
  return value/(initialSize-1)
end function

function turbulence3d(x as double, y as double, z as double, size as double) as double
  dim as double value, initialSize=any
  if size<1 then size=1
  initialSize = size
  while(size >= 1)
    value += smoothNoise3d(x / size, y / size, z/size) * size
    size /= 2.0
  wend
  value*=0.5
  return value/(initialSize-1)
end function

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

Re: open gl

Post by bluatigro »

what is wrong whit the folowing code ?

if i use this i get a black screen

it shoot draw a '?' on screen

Code: Select all


sub vraag( lim as integer , i as integer )
  if i < 0 then
    sphere 0 , 0 , 0 , .1 , green
  else
    glpushmatrix
      child 0 , .1 , 0 , lim , xyz
      vraag lim , i - 1
    glpopmatrix
  end if
end sub
sub vraagteken( hoek as double )
  glpushmatrix 
    skelet 0 , 0 , 0 , hoek
    skelet 1 , 0 , 0 , -hoek
    vraag 0 , 5
    vraag 1 , 25
  glpopmatrix
end sub

Imortis
Moderator
Posts: 1924
Joined: Jun 02, 2005 15:10
Location: USA
Contact:

Re: open gl

Post by Imortis »

bluatigro wrote:what is wrong whit the folowing code ?

if i use this i get a black screen

it shoot draw a '?' on screen

Code: Select all


sub vraag( lim as integer , i as integer )
  if i < 0 then
    sphere 0 , 0 , 0 , .1 , green
  else
    glpushmatrix
      child 0 , .1 , 0 , lim , xyz
      vraag lim , i - 1
    glpopmatrix
  end if
end sub
sub vraagteken( hoek as double )
  glpushmatrix 
    skelet 0 , 0 , 0 , hoek
    skelet 1 , 0 , 0 , -hoek
    vraag 0 , 5
    vraag 1 , 25
  glpopmatrix
end sub

My guess would be no Flip? You are not flipping the working buffer onto the screen buffer.
bluatigro
Posts: 660
Joined: Apr 25, 2012 10:35
Location: netherlands

Re: open gl

Post by bluatigro »

update :
i made a sphere to big
changed that

Code: Select all


sub vraagteken( hoek as double ) '' ?
  dim as integer i
  glpushmatrix
  gltranslated 0,-2,0
  sphere 0,-.6,0 , .2 , green
  skelet 0 , 0 , 0 , hoek
  skelet 1 , 0 , 0 , -hoek
  for i = 0 to 5
    glpushmatrix
      child 0,.2,0 , 0 , xyz
      sphere 0,0,0 , .2 , green
  next i
  for i = 0 to 25
      glpushmatrix
        child 0,.2,0 , 1 , xyz 
        sphere 0,0,0 , .2 , green
  next i
  for i = 0 to 25
      glpopmatrix
  next i
  for i = 0 to 5
    glpopmatrix
  next i
  glpopmatrix
end sub

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

Re: open gl

Post by bluatigro »

update :
try at textures

error :
gltexture2[f|d] not defined

Code: Select all

'' bluatigro 12 dec 2017
'' texture test

#include "_open_gl_dbl.bas"

dim as integer texture
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_LINEAR
glTexParameteri GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR
''glGenerateMipmap GL_TEXTURE_2D ''is not recognized

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

dim as double angle

do
  glclear gl_color_buffer_bit or gl_depth_buffer_bit
  camara.use
  glpushmatrix
    glrotatef angle , 0,1,0
    glbegin gl_quads
      gltexture2d 0 , 0
      glvertex3d -1 , -1 , 0
      gltexture2d 0 , 1
      glvertex3d -1 , 1  , 0
      gltexture2d 1 , 1
      glvertex3d 1 , 1 , 0
      gltexture2d 1 , 0
      glvertex3d 1 , -1 , 0
    glend
  glpopmatrix
  angle += 1
  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 »

update :
FIRST TEXTURE !!

error :
my 64x64 texture does not work
i got a ) expected error

Code: Select all

'' bluatigro 12 dec 2017
'' texture test

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

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 , 0 , 0 _
                               , 0 , 1 , 0 _
                               , 1 , 1 , 0 _
                               , 0 , 0 , 1 } 
glTexImage2D GL_TEXTURE_2D, 0, GL_RGB, 2, 2, 0, GL_RGB, GL_FLOAT, @ textdata(0)

'' texture 64x64
''dim as single textdata( 64*64*3 )
''dim as integer a,b,c
''for a = 0 to 63
''  for b = 0 to 63
''    for c = 0 to 2
''      textdata( a*64*64+b*64+c ) = turbulence(a,b,c)
''    next c
''  next b
''next a
''glTexImage2D GL_TEXTURE_2D, 0, GL_RGB, 64, 64, 0, GL_RGB, GL_FLOAT, @ textdata(0)

dim as double angle

camara.z = 5

do
  glclear gl_color_buffer_bit or gl_depth_buffer_bit
  camara.use
  glpushmatrix
    glrotatef angle , 0,1,0
    glbegin gl_quads
      glTexCoord2f 0 , 0
      glvertex3d -1 , -1 , 0
      glTexCoord2f 0 , 2
      glvertex3d -1 , 1  , 0
      glTexCoord2f 2 , 2
      glvertex3d 1 , 1 , 0
      glTexCoord2f 2 , 0
      glvertex3d 1 , -1 , 0
    glend
  glpopmatrix
  angle += 1
  sleep 40
  flip
loop until inkey = chr( 27 )
noise.bas :

Code: Select all

'' bluatigro 29 nov 2017
'' noise

#ifndef __SIMPLENOISE_BI__
#define __SIMPLENOISE_BI__

function noise( x as integer , y as integer , z as integer ) as double
  randomize x + 1000 * y + 1e6 * z
  return rnd 
end function

function smoothNoise(x as double, y as double, z as double) as double
  x=abs(x)
  y=abs(y)
  z=abs(z)
  dim as integer iX1=int(x)
  dim as integer iY1=int(y)
  dim as integer iZ1=int(z)
  dim as integer iX2=ix1+1
  dim as integer iY2=iy1+1
  dim as integer iZ2=iz1+1
  dim as double tx=x-iX1
  dim as double ty=y-iY1
  dim as double tz=z-iZ1
  
  dim as double ltf=noise(iX1,iY1,iZ1)
  dim as double rtf=noise(iX2,iY1,iZ1)
  dim as double rbf=noise(iX2,iY2,iZ1)
  dim as double lbf=noise(iX1,iY2,iZ1)
  dim as double sxtf=ltf + (rtf-ltf)*tx
  dim as double sxbf=lbf + (rbf-lbf)*tx
  
  dim as double ltb=noise(iX1,iY1,iZ2)
  dim as double rtb=noise(iX2,iY1,iZ2)
  dim as double rbb=noise(iX2,iY2,iZ2)
  dim as double lbb=noise(iX1,iY2,iZ2)
  dim as double sxtb = ltb + (rtb-ltb)*tx
  dim as double sxbb = lbb + (rbb-lbb)*tx
  
  dim as double vf = sxtf+(sxbf-sxtf)*ty
  dim as double vb = sxtb+(sxbb-sxtb)*ty
  dim as double v = vf + (vb-vf)*tz
   
  return v
end function

function turbulence(x as double, y as double, z as double, size as double) as double
  dim as double value, initialSize=any
  if size<1 then size=1
  initialSize = size
  while(size >= 1)
    value += smoothNoise(x / size, y / size, z/size) * size
    size /= 2.0
  wend
  value*=0.5
  return value/(initialSize-1)
end function

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

Re: open gl

Post by bluatigro »

update :
try at terain code

error :
i don't get my qqq() hils on screen

my qq() hil works

Code: Select all

''bluatigro 10 feb 2017
''surface

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

dim as double hoek , x , y , i

randomize timer

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

dim as single qqq(64,64,2) , qq(2,2,2)
for x = 0 to 64
  for y = 0 to 64
    qqq(x,y,0) = x 
    qqq(x,y,1) = y
    qqq(x,y,2) = turbulence(x,y,0,64)
  next y
next x
for x = 0 to 2
  for y = 0 to 2
    qq(x,y,0) = x 
    qq(x,y,1) = y 
    qq(x,y,2) = 0 ''turbulence(x,y,0,4)
  next y
next x

                           
                           
camara.z = 10
                      

do
  glClear GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT
  
  camara.use

  material.diffuse = green
  setmaterial gl_front_and_back , material

'' this is the qq() hils
  glMap2f GL_MAP2_VERTEX_3 , 0 , 10 , 3 , 3 , 0 , 10 , 3 , 3 , @qq(0,0,0)
'' how do i do the qqq() hils ?

  glEnable GL_MAP2_VERTEX_3
  
  glMapGrid2f 10 , 0 , 10 , 10 , 0 , 10
  
  glEvalMesh2 GL_FILL , 0 , 10 , 0 , 10
  
  glEnable GL_AUTO_NORMAL
  
''camara contols
  
  if multikey( sc_up ) then
    camara.move 0 , .1 , 0 , 0
  end if
  if multikey( sc_down ) and camara.y > 0 then
    camara.move 0 , -.1 , 0 , 0
  end if
  if multikey( sc_left ) then
    camara.move -.1 , 0 , 0 , 0
  end if
  if multikey( sc_right ) then
    camara.move .1 , 0 , 0 , 0
  end if
  if not getmouse( mousex , mousey ) then
    if mousex <> -1 and mousey <> -1 then
      if mousex < winx / 3 then
        camara.move 0 , 0 , 0 , 1
      end if
      if mousey < winy / 3 then
        camara.move 0 , 0 , -.1 , 0
      end if
      if mousex > winx * 2 / 3 then
        camara.move 0 , 0 , 0 , -1
      end if
      if mousey > winy * 2 / 3 then
        camara.move 0 , 0 , .1 , 0
      end if
    end if
  end if
  
  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 »

try at texture on hils

error :
i only get green lines
i shoot be getting red,green,yellow and blue squares

how do i use a bmp as texture ?
how do i create a bigger landscape whit glmap2f() ? [ see and use qqq() ]

Code: Select all

''bluatigro 24 jan 2017
''surface

#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(64,64,2) , qq(2,2,2)
''for x = 0 to 64
''  for y = 0 to 64
''    qqq(x,y,0) = x 
''    qqq(x,y,1) = y
''    qqq(x,y,2) = turbulence(x,y,0,64)
''  next y
''next x
for x = 0 to 2
  for y = 0 to 2
    qq(x,y,0) = x 
    qq(x,y,1) = turbulence(x,y,z,4)*4-2
    qq(x,y,2) = y
  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 ,   0 ,   0 _
                              ,   0 , 1 ,   0 _
                              , 1 , 1 ,   0 _
                              ,   0 ,   0 , 1 } 
glTexImage2D GL_TEXTURE_2D, 0, GL_RGB, 2, 2, 0, GL_RGB, GL_FLOAT _
, @ textdata(0)

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

  material.diffuse = green
  setmaterial gl_front_and_back , material

'' this is the qq() hils
  glMap2f GL_MAP2_VERTEX_3 , 0 , 10 , 3 , 3 , 0 , 10 , 9 , 3 _
  , @qq(0,0,0)
  glMap2f GL_MAP2_TEXTURE_COORD_2 , 0 , 1 , 2 , 2 , 0 , 1 , 11 , 2 _
  , @textdata(0)
'' how do i do the qqq() hils ?

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