turtle 2.0

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

turtle 2.0

Postby bluatigro » May 10, 2017 9:21

i got this idea from a book :
computing beaty of nature

instructions :
f : draw l
g : move l
[ : store x,y

] : read x,y
- : rotate - dangle
+ : rotate + dangle
b : draw prog smaler

WARNING :
prog must have matching [ and ]
i dont know what happens if you don't do

Code: Select all

const as double factor = 0.7
const as double dangle = 20
const as double kort = 30
const as double pi = atn( 1 ) * 4

screen 20 , 32

dim shared as double x(10),y(10),tx=512,ty=700,angle=0
dim shared as integer tel

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

sub turtle( l as double , prog as string )
  dim as double dx = 0 , dy = l
  dim as integer i
  if l > kort then
    rotate dx , dy , angle
    for i = 1 to len( prog )
      select case mid( prog , i , 1 )
        case "f"
          line(tx,ty)-step(dx,dy),&hffff
          tx+=dx
          ty+=dy
        case "g"
          tx+=dx
          ty+=dy
        case "["
          x(tel)=tx
          y(tel)=ty
          tel+=1
        case "]"
          tel-=1
          tx=x(tel)
          ty=y(tel)
        case "-"
          angle -= dangle
        case "+"
          angle += dangle
        case "b"
          turtle l * factor , prog
        case else
      end select
    next i
  end if
end sub

turtle 100 , "f[+b-b-b]-[-b+b+b]"

sleep
lrcvs
Posts: 569
Joined: Mar 06, 2008 19:27
Location: Spain

Re: turtle 2.0

Postby lrcvs » May 10, 2017 13:23

See you:

"lindenmayer" systems fractals and plants

and

l-system

https://en.wikipedia.org/wiki/L-system


viewtopic.php?f=8&t=21368


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

Re: turtle 2.0

Postby bluatigro » May 11, 2017 8:30

i quoted the book wrong it is :
the computational beauty of nature
bplus
Posts: 56
Joined: May 01, 2017 15:57

Re: turtle 2.0

Postby bplus » May 11, 2017 15:22

Hi,

I just tried out Blu's program and am...

I was expecting a plant like thing but only a few random lines near bottom of screen. Please don't tell me that's it! (No, do tell if that's it.)

I am beginner with FB, what am I missing?

Also screen 20 is a shade too tall for my laptop, I checked out screen in help and see I am restricted to preset sizes.

That is not my only option because I did several things not needing screen at all (as I recall) but I had to diddle with code changing screens...

If we are just doing a still shot, a screen command is simplest? if we are doing a movie the diddling is necessary?
vdecampo
Posts: 2981
Joined: Aug 07, 2007 23:20
Location: Maryland, USA
Contact:

Re: turtle 2.0

Postby vdecampo » May 11, 2017 15:45

[quote="bplus"Also screen 20 is a shade too tall for my laptop, I checked out screen in help and see I am restricted to preset sizes.[/quote]

Check out the ScreenRes command. You can specify height/width of most any size.

-Vince
Tourist Trap
Posts: 2358
Joined: Jun 02, 2015 16:24

Re: turtle 2.0

Postby Tourist Trap » May 11, 2017 20:06

bplus wrote:If we are just doing a still shot, a screen command is simplest? if we are doing a movie the diddling is necessary?

If you want a screen configurated to allow transparency effect, and to allow multiple pages (for animation) you can use those few lines below. In addition you will have the information on your desktop size used to give a correct size to your application (80% of whatever desktop size is yours):

Code: Select all

#include once   "fbgfx.bi"
dim as integer   scrW => any
dim as integer   scrH => any
scope
   var dskW   => -1
   var dskH   => -1
   screenControl   fb.GET_DESKTOP_SIZE, _
               dskW, _
               dskH
   '
   scrW   = dskW - 2*dskW\32
   scrH   = dskH - 2*dskH\8
   screenRes   scrW, scrH, _                        'sets application screen dimension
            32, _                               'sets application screen color depth
            2, _                               'sets application screen page number
            fb.GFX_SHAPED_WINDOW   + _               'enables application standard transparency
            fb.GFX_ALPHA_PRIMITIVES   + _               'enables application standard alpha
            fb.GFX_NO_FRAME                        'sets application borders to none
end scope
bplus
Posts: 56
Joined: May 01, 2017 15:57

Re: turtle 2.0

Postby bplus » May 11, 2017 20:37

Thanks Tourist Trap! That is exactly the big guns graphics that was throwing me but I look forward to using.

I do not mean to side track from blu's code, I like his stuff, and usually he leaves us a simple fix to figure out at JB.
I look at it as like a Sunday afternoon crosswords puzzle. FB still too new for me to play that game here.

EDIT: Removed link

Oh heck, this is similar to my Draw String project, can't be that different. I wish I had a screen shot.
MrSwiss
Posts: 2597
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: turtle 2.0

Postby MrSwiss » May 12, 2017 13:34

@bplus,

you might like to use the compact (aka: no nonsense) version:

Code: Select all

#Include Once "fbgfx.bi"

Dim As Integer  w, h, x, y, scrW, scrH

ScreenInfo(w, h) ' get desktop size, in pix. (w/h, can be re-used later)
scrW = CInt(w * 0.5)    ' downscale to 50% (of desktop size)
scrH = CInt(h * 0.5)    ' downscale to 50% (as above)
' following info on last param: can be found, in 'fbgfx.bi' -- no secret
ScreenRes(scrW, scrH, 32, 2, 88)    ' 88 = (AlphaPr = 64 + noFrame = 8 + shapedWin = 16)

' example code: draw a orange block, with some transparency ~25%
ScreenSet(1, 0)

w = CInt(scrW * 0.8) : h = CInt(scrH * 0.8)
x = CInt(scrW * 0.1) : y = CInt(scrH * 0.1)
Line (x, y)-Step(w-1, h-1), &hBFFF7F00, BF
Flip

sleep
bplus
Posts: 56
Joined: May 01, 2017 15:57

Re: turtle 2.0

Postby bplus » May 12, 2017 19:11

Thanks MrSwiss,

You are right I like compact, the more thinking the less typing, I hate typing!

I was hoping for only one file involved for this.

I haven't done an "INCLUDE" since mid 90's, I assume the file is in the downloads with FB, if I dig around I can put it in same folder?
Other preliminary's I might need to know, so that I may see your gem up on the screen?
bplus
Posts: 56
Joined: May 01, 2017 15:57

Re: turtle 2.0

Postby bplus » May 12, 2017 20:43

Oh blu was doing this! Only without help of rnd and color (I ran the LB code to get screen shot).

Code: Select all

Common Shared As Integer xmax, ymax, sx, sy, level
Common Shared As Double pi, p10, p30, a, l
xmax = 800 : ymax = 600 : sx = xmax/2 : sy = ymax : level = 1
pi = ACos(-1) : p10 = pi/36 : p30 = pi/12 : a = pi/2 : l = ymax/10
screenres xmax, ymax, 32, 2
WindowTitle "FB tree for bplus"
sub branch(x As Integer, y As integer, ang As double, length As double, lev As Integer)
   Dim As Double x2 = x + cos(ang) * length
     Dim As Double y2 = y - sin(ang) * length
     Color RGB(lev * 20, lev * 12, lev * 6)
     Line (x, y) - (x2, y2)
     if lev > 10 or length < 5 then exit sub
     lev += 1
     branch x2, y2, ang + p10 + p30 * rnd, .8 * length + .2 * Rnd * length, lev
     branch x2, y2, ang - p10 - p30 * Rnd, .8 * length + .2 * Rnd * length, lev
End Sub
branch sx, sy, a, l, level
sleep


No INCLUDE needed. Should I say how long it took me to figure out to put the sub definition before the call? Yikes! ;-))
MrSwiss
Posts: 2597
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: turtle 2.0

Postby MrSwiss » May 12, 2017 22:29

bplus wrote:I assume the file is in the downloads with FB, if I dig around I can put it in same folder?
First part: YES, it's part, of the FBC package (fbgfx.bi).
And, second part: NO, leave it, where it is, you'll find it in: <FBC-DIR>/inc/fbgfx.bi
(Otherwise, the compiler doesn't find it, any longer.)

Apart from that: simply copy the code /compile / run it ... (it's not really that impressive).
Its simply an example, that shows relative sizing (relative to: actual display-size).
bplus
Posts: 56
Joined: May 01, 2017 15:57

Re: turtle 2.0

Postby bplus » May 13, 2017 1:08

Oh, I see what happened with MrSwiss code, my blunder, yes lovely orange block. The INCLUDE line wasn't even needed but SLEEP was missing from my copy/paste. Blu's code (from LB) does run fine in JB, so why not FB yet?
bplus
Posts: 56
Joined: May 01, 2017 15:57

Re: turtle 2.0

Postby bplus » May 13, 2017 2:18

Got it working!

Code: Select all

' turtle 2 blu fixed 2017-05-12
Common Shared As Integer tel, tx, ty
tel = 1 : tx = 400 : ty = 575
Common Shared As Double factor, dangle, kort, pi, angle
factor = 0.705 : dangle = 22.0 : kort = 24 : pi = ACos(-1) : angle = 0
Dim Shared As Integer x(10), y(10)

ScreenRes 800, 600, 32, 2

sub rotate( ByRef k as double , byref l as double , deg as double )
     dim as double s , c , hk , hl
     s = sin( deg * pi / 180 ) : c = cos( deg * pi / 180 )
     hk = k * c - l * s : hl = k * s + l * c
     k = hk : l = hl
end sub

sub turtle( l as double , prog as string )
     dim as double dx, dy
     dx = 0 : dy = -l
     dim as integer i
     if l > kort then
       rotate dx , dy , angle
       for i = 1 to len( prog )
         select case mid( prog , i , 1 )
            Case "f"
                line(tx,ty)-step(dx,dy), RGB(200, 200, 50)
                tx += dx : ty += dy
            Case "g" : tx += dx : ty += dy
            Case "[" : x(tel) = tx : y(tel) = ty : tel+=1
            Case "]" : tel -= 1 : tx = x(tel) : ty=y(tel)
            Case "-" : angle -= dangle
            Case "+" : angle += dangle
            Case "b" : turtle l * factor, prog
         End select
       Next
     end if
end sub

turtle 100 , "f+[+b-b-b]-[-b+b+b]"
sleep
bluatigro
Posts: 543
Joined: Apr 25, 2012 10:35
Location: netherlands

Re: turtle 2.0

Postby bluatigro » May 13, 2017 8:31

update :
3D opengl trees

Code: Select all

''bluatigro 13 may 2017
''3d turtle graphics

#include "_open_gl_dbl.bas"

dim shared as double anglex,angley,anglez,angle,factor,kort

anglex = 45
angley = 90
anglez = 20
factor = 0.7

sub tree( i as integer , prog as string )
  dim q as integer
  if i > 0 then
    for q = 1 to len( prog )
      select case mid( prog , q , 1 )
        case "f"
          setbox 0 , 1 , 0 , .1,.3,.1
          cilinder 6 , .1 , .1 , 0 , 0
          gltranslated 0 , 1 , 0
        case "g"
          gltranslated 0 , 1 , 0
        case "["
          glpushmatrix
        case "]"
          glpopmatrix
        case "X"
          glrotated anglex , 1,0,0
        case "x"
          glrotated -anglex , 1,0,0
        case "Y"
          glrotated angley , 0,1,0
        case "y"
          glrotated -angley , 0,1,0
        case "Z"
          glrotated anglez , 0,0,1
        case "z"
          glrotated -anglez , 0,0,1
        case "b"
          glscaled factor,factor,factor
          tree i - 1 , prog
        case else
      end select
    next q
  end if
end sub

camara.z = 10
do
  glclear gl_color_buffer_bit or gl_depth_buffer_bit
  camara.use
 
  glrotated angle , 0,1,0
  tree 3 , "f[xyb]Xyb"
 
  angle += 5
  sleep 40
  flip
loop while inkey = ""



Code: Select all

''bluatigro 11 feb 2017
''_open_gl_dbl.bas

#ifndef OPENGL_H
#define OPENGL_H

dim shared as integer mousex , mousey

''DBL3D

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

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

''MATH

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

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

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

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

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

''CAMARA

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

dim as t_camara camara

''3DENGINE

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

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

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

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

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

screen 20, 32

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

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

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

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

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

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

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

''COLORS

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

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

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

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

''MATERIAL

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

''PRIMATIVS

dim shared as dbl3d pnt( 256 )

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

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

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

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

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


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

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


''SHAPES

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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


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

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

const as integer lr = 32

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

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

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

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

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

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

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

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

Re: turtle 2.0

Postby bluatigro » May 13, 2017 8:52

update :
solid tree

please report nice prog's for tree's

Code: Select all

''bluatigro 13 may 2017
''3d turtle graphics

#include "_open_gl_dbl.bas"

dim shared as double anglex,angley,anglez,angle,factor,kort

anglex = 45
angley = 90
anglez = 20
factor = 0.7

sub tree( i as integer , prog as string )
  dim q as integer
  if i > 0 then
    for q = 1 to len( prog )
      select case mid( prog , q , 1 )
        case "f"
          setbox 0 , 1 , 0 , .1,1,.1
          cilinder 6 , .1 , .1 , 0 , 0
          gltranslated 0 , 2 , 0
        case "g"
          gltranslated 0 , 2 , 0
        case "["
          glpushmatrix
        case "]"
          glpopmatrix
        case "X"
          glrotated anglex , 1,0,0
        case "x"
          glrotated -anglex , 1,0,0
        case "Y"
          glrotated angley , 0,1,0
        case "y"
          glrotated -angley , 0,1,0
        case "Z"
          glrotated anglez , 0,0,1
        case "z"
          glrotated -anglez , 0,0,1
        case "b"
          glscaled factor,factor,factor
          tree i - 1 , prog
        case else
      end select
    next q
  end if
end sub

camara.z = 10
camara.y = 3
do
  glclear gl_color_buffer_bit or gl_depth_buffer_bit
  camara.use
 
  glrotated angle , 0,1,0
  tree 5 , "f[xyb]Xyb"
 
  angle += 5
  sleep 40
  flip
loop while inkey = ""

Return to “General”

Who is online

Users browsing this forum: albert and 4 guests