lbgfx 3D

Algemene discussies en vragen omtrent Liberty BASIC programma's. Stuur zoveel mogelijk delen van listings (snippets) in als je hulp wilt.

Moderators: anthonio, Abcott

lbgfx 3D

Berichtdoor bluatigro » vr feb 26, 2016 12:41 pm

demo of 6 roterende kubusachtigen

Code: Selecteer alles
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy , gfx
global key$ , mouse.x , mouse.y
dim m( 26 * 4 * 4 ) , cam( 6 )
for i = 0 to 3
  m( in( 0 , i , i ) ) = 1
next i
global rotx , roty , rotz , trans , temp , pi
global xyz , xzy , yxz , yzx , zxy , zyx , number
global b.x , b.y , b.z , b.dx , b.dy , b.dz
rotx = 21
roty = 22
rotz = 23
trans = 24
temp = 25
pi = atn( 1 ) * 4
xyz = 0
xzy = 1
yxz = 2
yzx = 3
zxy = 4
zyx = 5
global tritel , trimax , angle
trimax = 100
dim t( trimax , 15 ) , ry( trimax )
dim pnt( 256 , 2)
for i = 0 to trimax
  ry( i ) = i
next i
winx = WindowWidth
winy = WindowHeight
pi = atn( 1 ) * 4
global red , green , yellow
global blue , magenta , cyan
red = rgb( 255 , 0 , 0 )
green = rgb( 0 , 255 , 0 )
yellow = rgb( 255 , 255 , 0 )
blue = rgb( 0 , 0 , 255 )
magenta = rgb( 255 , 0 , 255 )
cyan = rgb( 0 , 255 , 255 )
graphicbox #m.lbgfx, 0,0,0,0
nomainwin
open "LBGfx 3D" for window as #m
call FixWindowSize hwnd(#m),winx,winy
#m.lbgfx "when mouseMove [move]"
#m.lbgfx "when characterInput [key]"
#m "trapclose [quit]"
#m.lbgfx "setfocus"
open DefaultDir$+"\LBGfx.dll" for dll as #lbgfx
gfx=CreateLBGfx(0,0,winx,winy _
,hwnd(#m),hwnd(#m.lbgfx))
  timer 40 , [timer]
wait
[timer]
  scan   'edit by Gordon
  tritel = 0
  call lbgfx "backcolor black"
  call lbgfx "cls"

  call link 1 , -300,200,0 , angle,angle,angle , xyz , 0
  call setbox 0,0,0 , 100,100,100
  call colorcube
  call link 1 , -300,-200,0 , angle,angle,angle , xzy , 0
  call setbox 0,0,0 , 100,100,50
  call colorcube
  call link 1 , 0,200,0 , angle,angle,angle , yxz , 0
  call setbox 0,0,0 , 100,50,100
  call colorcube
  call link 1 , 0,-200,0 , angle,angle,angle , yzx , 0
  call setbox 0,0,0 , 50,100,100
  call colorcube
  call link 1 , 300,200,0 , angle,angle,angle , zxy , 0
  call setbox 0,0,0 , 100,50,50
  call colorcube
  call link 1 , 300,-200,0 , angle,angle,angle , zyx , 0
  call setbox 0,0,0 , 100,100,100
  call colorcube

  call drawall
  angle = angle + 5
wait
[key]
  key$ = right$( Inkey$ , 1 )
  if key$ <> chr$( 27 ) then wait
[quit]
  call DestroyLBGfx
  close #lbgfx
  close #m             'ain debugged by Gordon
end
[move]
  mouse.x = MouseX
  mouse.y = MouseY
wait

''color stuf

function rgb( r , g , b )
  r = int( r ) and 255
  g = int( g ) and 255
  b = int( b ) and 255
  rgb = r + g * 256 + b * 256 ^ 2
end function

sub setcolor kl
  r = kl and 255
  g = int( kl / 256 ) and 255
  b = int( kl / 256 ^ 2 ) and 255
  call lbgfx "color ";r;" ";g;" ";b
  call lbgfx "backcolor ";r;" ";g;" ";b
end sub

''shapes

sub setbox x , y , z , dx , dy , dz
  b.x = x
  b.y = y
  b.z = z
  b.dx = dx
  b.dy = dy
  b.dz = dz
end sub

sub colorcube
  call setpoint 0 , b.x-b.dx , b.y-b.dy , b.z-b.dz
  call setpoint 1 , b.x-b.dx , b.y-b.dy , b.z+b.dz
  call setpoint 2 , b.x-b.dx , b.y+b.dy , b.z-b.dz
  call setpoint 3 , b.x-b.dx , b.y+b.dy , b.z+b.dz
  call setpoint 4 , b.x+b.dx , b.y-b.dy , b.z-b.dz
  call setpoint 5 , b.x+b.dx , b.y-b.dy , b.z+b.dz
  call setpoint 6 , b.x+b.dx , b.y+b.dy , b.z-b.dz
  call setpoint 7 , b.x+b.dx , b.y+b.dy , b.z+b.dz
  call quad 0 , 1 , 3 , 2 , red
  call quad 7 , 6 , 4 , 5 , cyan
  call quad 0 , 1 , 5 , 4 , green
  call quad 7 , 6 , 2 , 3 , magenta
  call quad 0 , 2 , 6 , 4 , blue
  call quad 7 , 5 , 1 , 3 , yellow
end sub

''triangle stuf

sub setpoint no , x , y , z
''set point in the swarm
  call spot x , y , z
  pnt( no , 0 ) = x
  pnt( no , 1 ) = y
  pnt( no , 2 ) = z
end sub

sub tri p1 , p2 , p3 , kl
''create a triangle from points in the swarm
  if tritel > trimax then exit sub
  t( tritel , 0 ) = pnt( p1 , 0 )
  t( tritel , 1 ) = pnt( p1 , 1 )
  t( tritel , 2 ) = pnt( p1 , 2 )
  t( tritel , 3 ) = pnt( p2 , 0 )
  t( tritel , 4 ) = pnt( p2 , 1 )
  t( tritel , 5 ) = pnt( p2 , 2 )
  t( tritel , 6 ) = pnt( p3 , 0 )
  t( tritel , 7 ) = pnt( p3 , 1 )
  t( tritel , 8 ) = pnt( p3 , 2 )
  t( tritel , 9 ) = kl
  x = (pnt(p1,0)+pnt(p2,0)+pnt(p3,0))/3
  y = (pnt(p1,1)+pnt(p2,1)+pnt(p3,1))/3
  z = (pnt(p1,2)+pnt(p2,2)+pnt(p3,2))/3
  t( tritel , 10 ) = x
  t( tritel , 11 ) = y
  t( tritel , 12 ) = z
  tritel = tritel + 1
end sub

sub quad p1 , p2 , p3 , p4 , kl
''create a quadangle from points in the swarm
  call tri p1 , p2 , p3 , kl
  call tri p1 , p3 , p4 , kl
end sub

sub tri.draw no
''draw a triangle
  x1 = t( no , 0 )
  y1 = t( no , 1 ) 
  z1 = t( no , 2 )
  x2 = t( no , 3 )
  y2 = t( no , 4 )
  z2 = t( no , 5 )
  x3 = t( no , 6 )
  y3 = t( no , 7 )
  z3 = t( no , 8 )
  kl = t( no , 9 )
  call setcolor kl
  a1 = winx / 2 + x1 / ( z1 + 2000 ) * 2000
  b1 = winy / 2 - y1 / ( z1 + 2000 ) * 2000
  a2 = winx / 2 + x2 / ( z2 + 2000 ) * 2000
  b2 = winy / 2 - y2 / ( z2 + 2000 ) * 2000 
  a3 = winx / 2 + x3 / ( z3 + 2000 ) * 2000
  b3 = winy / 2 - y3 / ( z3 + 2000 ) * 2000
  call lbgfx "polyfilled ";a1;" ";b1 _
                      ;" ";a2;" ";b2 _
                      ;" ";a3;" ";b3
end sub

sub drawall
  for h = 1 to tritel
    for l = 0 to h - 1
      if t(ry(l),12)<t(ry(h),12) then
        help = ry( h )
        ry(h)=ry(l)
        ry(l) = help
      end if
    next l
  next h
  for i = 0 to tritel
    call tri.draw ry(i)
  next i
  call lbgfx "flip"
end sub

''blua 3D engine

function range( l , h )
''calculate random number between l and h
  range = rnd( 0 ) * ( h - l ) + l
end function

sub camera x , y , z , pan , tilt , rol
''set camera coordians and angles
  cam( 0 ) = x
  cam( 1 ) = y
  cam( 2 ) = z
  cam( 3 ) = pan
  cam( 4 ) = tilt
  cam( 5 ) = rol
end sub

sub movecamera x , y , z , pan , tilt , rol
''move camera relativly
  call rotate x , y , 0 - cam( 5 )
  call rotate y , z , 0 - cam( 4 )
  call rotate x , z , 0 - cam( 3 ) 
  cam( 0 ) = cam( 0 ) + x
  cam( 1 ) = cam( 1 ) + y
  cam( 2 ) = cam( 2 ) + z
  cam( 3 ) = ( cam( 3 ) + pan ) mod 360
  cam( 4 ) = ( cam( 4 ) + tilt ) mod 360
  cam( 5 ) = ( cam( 5 ) + rol ) mod 360
end sub


sub link no , x , y , z , xz , yz , xy , ax , p
''calculate new matrix no
''folowing drawing wil use this matrix
  if no < 1 or no > 20 then exit sub
  if p < 0 or p > 20 then exit sub
  if no = p then exit sub

  call copy 0 , rotx
  call copy 0 , roty
  call copy 0 , rotz
  call copy 0 , trans

  m( in( rotx , 1 , 1 ) ) = cos( rad( yz ) )
  m( in( rotx , 1 , 2 ) ) = 0-sin( rad( yz ) )
  m( in( rotx , 2 , 1 ) ) = sin( rad( yz ) )
  m( in( rotx , 2 , 2 ) ) = cos( rad( yz ) )

  m( in( roty , 0 , 0 ) ) = cos( rad( xz ) )
  m( in( roty , 0 , 2 ) ) = 0-sin( rad( xz ) )
  m( in( roty , 2 , 0 ) ) = sin( rad( xz ) )
  m( in( roty , 2 , 2 ) ) = cos( rad( xz ) )

  m( in( rotz , 0 , 0 ) ) = cos( rad( xy ) )
  m( in( rotz , 0 , 1 ) ) = 0-sin( rad( xy ) )
  m( in( rotz , 1 , 0 ) ) = sin( rad( xy ) )
  m( in( rotz , 1 , 1 ) ) = cos( rad( xy ) )

  m( in( trans , 3 , 0 ) ) = x
  m( in( trans , 3 , 1 ) ) = y
  m( in( trans , 3 , 2 ) ) = z

  select case ax
    case xyz
      call keer rotx , roty , rotz , no
    case xzy
      call keer rotx , rotz , roty , no
    case yxz
      call keer roty , rotx , rotz , no
    case yzx
      call keer roty , rotz , rotx , no
    case zxy
      call keer rotz , rotx , roty , no
    case zyx
      call keer rotz , roty , rotx , no
    case else
      call keer rotx , roty , rorz , no
  end select

  number = no
end sub

sub keer a , b , c , no
''calculate axel matrix
  call maal a , b , temp
  call maal temp , c , no
  call maal no , trans , temp
  call maal temp , p , no
end sub

function in( no , x , y )
''to 3d array index
  in = no * 16 + x * 4 + y
end function

sub copy a , uit
''copy a matrix into uit matrix
  for i = 0 to 3
    for j = 0 to 3
      m( in( uit , i , j ) ) = m( in( a , i , j ) )
    next j
  next i
end sub

sub maal a , b , uit
''mutltiply 2 matrixes
  for i = 0 to 3
    for j = 0 to 3
      m( in( uit , i , j ) ) = 0
      for k = 0 to 3
        m( in( uit , i , j ) ) = m( in( uit , i , j ) ) _
        + m( in( a , i , k ) ) * m( in( b , k , j ) )
      next k
    next j
  next i
end sub

sub spot byref x , byref y , byref z
''from lokal coordians to world coordians
  no = number
  hx = m( in( no , 0 , 0 ) ) * x _
     + m( in( no , 1 , 0 ) ) * y _
     + m( in( no , 2 , 0 ) ) * z _
     + m( in( no , 3 , 0 ) )
  hy = m( in( no , 0 , 1 ) ) * x _
     + m( in( no , 1 , 1 ) ) * y _
     + m( in( no , 2 , 1 ) ) * z _
     + m( in( no , 3 , 1 ) )
  hz = m( in( no , 0 , 2 ) ) * x _
     + m( in( no , 1 , 2 ) ) * y _
     + m( in( no , 2 , 2 ) ) * z _
     + m( in( no , 3 , 2 ) )
  x = hx - cam( 0 )
  y = hy - cam( 1 )
  z = hz - cam( 2 )
  call rotate x , y , 0 - cam( 5 )
  call rotate y , z , 0 - cam( 4 )
  call rotate x , z , 0 - cam( 3 )
end sub

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

function rad( x )
''from degrees to radians
  rad = x * pi / 180
end function

''whit thanks to dan teel

sub lbgfx text$
  calldll #lbgfx,"graphicCommand" _
  ,gfx as ulong _
  ,text$ as ptr _
  ,ret as void
end sub

function CreateLBGfx(x,y,w,h,hParent,hMessageHandler)'Returns 0 if fail, hWnd if pass
  style=_WS_VISIBLE+_WS_CHILD+_WS_CLIPCHILDREN
  calldll #kernel32,"GetModuleHandleA",0 as ulong,instance as ulong
  calldll #user32,"CreateWindowExA",_
  0 as long,_
  "LBGfx32" as ptr,_
  0 as ulong,_
  style as ulong,_
  x as long,_
  y as long,_
  w as long,_
  h as long,_
  hParent as ulong,_
  0 as ulong,_
  instance as ulong,_
  hMessageHandler as ulong,_
  CreateLBGfx as ulong
end function

sub DestroyLBGfx
  calldll #user32, "DestroyWindow",_
  gfx as ulong, _
  ret as long
end sub

sub FixWindowSize hwnd,width,height
  struct fixrect _
    ,left as long _
    ,top as long _
    ,right as long _
    ,bottom as long
  calldll #user32,"GetClientRect" _
  ,hwnd as ulong _
  ,fixrect as struct _
  ,ret as void
  width=width-fixrect.right.struct+width
  height=height-fixrect.bottom.struct+height
  calldll #user32,"GetWindowRect" _
  ,hwnd as ulong _
  ,fixrect as struct _
  ,ret as void
  x=fixrect.left.struct
  y=fixrect.top.struct
  calldll #user32,"MoveWindow" _
  ,hwnd as ulong _
  ,x as long _
  ,y as long _
  ,width as long _
  ,height as long _
  ,1 as long _
  ,ret as void
end sub
bluatigro
 
Berichten: 306
Geregistreerd: za sep 27, 2008 6:01 pm

Re: lbgfx 3D

Berichtdoor bluatigro » vr feb 26, 2016 1:33 pm

update :
- licht ?
- zelf kleuren kiezen
error :
- de normal of 1 van de driehoeken = 0
Code: Selecteer alles
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy , gfx
global key$ , mouse.x , mouse.y
dim m( 26 * 4 * 4 ) , cam( 6 )
for i = 0 to 3
  m( in( 0 , i , i ) ) = 1
next i
global rotx , roty , rotz , trans , temp , pi
global xyz , xzy , yxz , yzx , zxy , zyx , number
global b.x , b.y , b.z , b.dx , b.dy , b.dz
rotx = 21
roty = 22
rotz = 23
trans = 24
temp = 25
pi = atn( 1 ) * 4
xyz = 0
xzy = 1
yxz = 2
yzx = 3
zxy = 4
zyx = 5
global tritel , trimax , angle
trimax = 100
dim t( trimax , 15 ) , ry( trimax )
dim pnt( 256 , 2)
for i = 0 to trimax
  ry( i ) = i
next i
winx = WindowWidth
winy = WindowHeight
pi = atn( 1 ) * 4
global red , green , yellow
global blue , magenta , cyan
red = rgb( 255 , 0 , 0 )
green = rgb( 0 , 255 , 0 )
yellow = rgb( 255 , 255 , 0 )
blue = rgb( 0 , 0 , 255 )
magenta = rgb( 255 , 0 , 255 )
cyan = rgb( 0 , 255 , 255 )
graphicbox #m.lbgfx, 0,0,0,0
nomainwin
open "LBGfx 3D" for window as #m
call FixWindowSize hwnd(#m),winx,winy
#m.lbgfx "when mouseMove [move]"
#m.lbgfx "when characterInput [key]"
#m "trapclose [quit]"
#m.lbgfx "setfocus"
open DefaultDir$+"\LBGfx.dll" for dll as #lbgfx
gfx=CreateLBGfx(0,0,winx,winy _
,hwnd(#m),hwnd(#m.lbgfx))
  timer 40 , [timer]
wait
[timer]
  scan
  tritel = 0
  call lbgfx "backcolor black"
  call lbgfx "cls"

  call link 1 , -300,200,0 , angle,angle,angle , xyz , 0
  call setbox 0,0,0 , 100,100,100
  call cube red , red , red , red , red , blue
  call link 1 , -300,-200,0 , angle,angle,angle , xzy , 0
  call setbox 0,0,0 , 100,100,50
  call colorcube
  call link 1 , 0,200,0 , angle,angle,angle , yxz , 0
  call setbox 0,0,0 , 100,50,100
  call colorcube
  call link 1 , 0,-200,0 , angle,angle,angle , yzx , 0
  call setbox 0,0,0 , 50,100,100
  call colorcube
  call link 1 , 300,200,0 , angle,angle,angle , zxy , 0
  call setbox 0,0,0 , 100,50,50
  call colorcube
  call link 1 , 300,-200,0 , angle,angle,angle , zyx , 0
  call setbox 0,0,0 , 100,100,100
  call colorcube

  call drawall
  angle = angle + 5
wait
[key]
  key$ = right$( Inkey$ , 1 )
  if key$ <> chr$( 27 ) then wait
[quit]
  call DestroyLBGfx
  close #lbgfx
  close #m      'ain debugged by Gordon
end
[move]
  mouse.x = MouseX
  mouse.y = MouseY
wait

''color stuf

function rgb( r , g , b )
  r = int( r ) and 255
  g = int( g ) and 255
  b = int( b ) and 255
  rgb = r + g * 256 + b * 256 ^ 2
end function

sub setcolor kl
  r = kl and 255
  g = int( kl / 256 ) and 255
  b = int( kl / 256 ^ 2 ) and 255
  call lbgfx "color ";r;" ";g;" ";b
  call lbgfx "backcolor ";r;" ";g;" ";b
end sub

function  mix( kla , f , klb )
  r1 = kla and 255
  g1 = int( kla / 256 ) and 255
  b1 = int( kla / 256 ^ 2 ) and 255
  r2 = klb and 255
  g2 = int( klb / 256 ) and 255
  b2 = int( klb / 256 ^ 2 ) and 255
  r = r1 + ( r2 - r1 ) * f
  g = g1 + ( g2 - g1 ) * f
  b = b1 + ( b2 - b1 ) * f
  mix = rgb( r , g , b )
end function

''shapes

sub setbox x , y , z , dx , dy , dz
  b.x = x
  b.y = y
  b.z = z
  b.dx = dx
  b.dy = dy
  b.dz = dz
end sub

sub colorcube
  call cube red , green , blue , cyan , magenta , yellow
end sub

sub cube l , b , f , r , t , bk
  call setpoint 0 , b.x-b.dx , b.y-b.dy , b.z-b.dz
  call setpoint 1 , b.x-b.dx , b.y-b.dy , b.z+b.dz
  call setpoint 2 , b.x-b.dx , b.y+b.dy , b.z-b.dz
  call setpoint 3 , b.x-b.dx , b.y+b.dy , b.z+b.dz
  call setpoint 4 , b.x+b.dx , b.y-b.dy , b.z-b.dz
  call setpoint 5 , b.x+b.dx , b.y-b.dy , b.z+b.dz
  call setpoint 6 , b.x+b.dx , b.y+b.dy , b.z-b.dz
  call setpoint 7 , b.x+b.dx , b.y+b.dy , b.z+b.dz
  call quad 0 , 1 , 3 , 2 , l
  call quad 7 , 6 , 4 , 5 , r
  call quad 0 , 1 , 5 , 4 , b
  call quad 7 , 6 , 2 , 3 , t
  call quad 0 , 2 , 6 , 4 , f
  call quad 7 , 5 , 1 , 3 , bk
end sub

''triangle stuf

sub setpoint no , x , y , z
''set point in the swarm
  call spot x , y , z
  pnt( no , 0 ) = x
  pnt( no , 1 ) = y
  pnt( no , 2 ) = z
end sub

sub tri p1 , p2 , p3 , kl
''create a triangle from points in the swarm
  if tritel > trimax then exit sub
  t( tritel , 0 ) = pnt( p1 , 0 )
  t( tritel , 1 ) = pnt( p1 , 1 )
  t( tritel , 2 ) = pnt( p1 , 2 )
  t( tritel , 3 ) = pnt( p2 , 0 )
  t( tritel , 4 ) = pnt( p2 , 1 )
  t( tritel , 5 ) = pnt( p2 , 2 )
  t( tritel , 6 ) = pnt( p3 , 0 )
  t( tritel , 7 ) = pnt( p3 , 1 )
  t( tritel , 8 ) = pnt( p3 , 2 )
  t( tritel , 9 ) = kl
  x = (pnt(p1,0)+pnt(p2,0)+pnt(p3,0))/3
  y = (pnt(p1,1)+pnt(p2,1)+pnt(p3,1))/3
  z = (pnt(p1,2)+pnt(p2,2)+pnt(p3,2))/3
  t( tritel , 10 ) = x
  t( tritel , 11 ) = y
  t( tritel , 12 ) = z
''calculate normal of triangle
  x1 = pnt(p2,0)-pnt(p1,0)
  y1 = pnt(p2,1)-pnt(p1,1)
  z1 = pnt(p2,2)-pnt(p1,2)
  x2 = pnt(p3,0)-pnt(p1,0)
  y2 = pnt(p3,1)-pnt(p1,1)
  z2 = pnt(p3,2)-pnt(p1,2)
  x = y1 * z2 - y2 * z1
  y = z1 * x2 - z2 * x1
  z = x1 * y2 - x2 * y1
  t( tritel , 13 ) = x
  t( tritel , 14 ) = y
  t( tritel , 15 ) = z
  tritel = tritel + 1
end sub

sub quad p1 , p2 , p3 , p4 , kl
''create a quadangle from points in the swarm
  call tri p1 , p2 , p3 , kl
  call tri p1 , p3 , p4 , kl
end sub

sub tri.draw no
''draw a triangle
  x1 = t( no , 0 )
  y1 = t( no , 1 ) 
  z1 = t( no , 2 )
  x2 = t( no , 3 )
  y2 = t( no , 4 )
  z2 = t( no , 5 )
  x3 = t( no , 6 )
  y3 = t( no , 7 )
  z3 = t( no , 8 )
  kl = t( no , 9 )
  x = t( no , 13 )
  y = t( no , 14 )
  z = t( no , 15 )
''remed for x/0 error
''  a = getangle( x,y,z , 0,1,0 )
''  kl = mix( kl , cos( a ) / 2 + .5 , 0 )
  call setcolor kl
  a1 = winx / 2 + x1 / ( z1 + 2000 ) * 2000
  b1 = winy / 2 - y1 / ( z1 + 2000 ) * 2000
  a2 = winx / 2 + x2 / ( z2 + 2000 ) * 2000
  b2 = winy / 2 - y2 / ( z2 + 2000 ) * 2000 
  a3 = winx / 2 + x3 / ( z3 + 2000 ) * 2000
  b3 = winy / 2 - y3 / ( z3 + 2000 ) * 2000
  call lbgfx "polyfilled ";a1;" ";b1 _
                      ;" ";a2;" ";b2 _
                      ;" ";a3;" ";b3
end sub

sub drawall
  for h = 1 to tritel - 1
    for l = 0 to h - 1
      if t(ry(l),12)<t(ry(h),12) then
        help = ry( h )
        ry(h)=ry(l)
        ry(l) = help
      end if
    next l
  next h
  for i = 0 to tritel
    call tri.draw ry(i)
  next i
  call lbgfx "flip"
end sub
 
function length( a , b , c )
  length = sqr(a^2+b^2+c^2)
end function

function dot( a,b,c , d,e,f )
  dot = a*d+b*e+c*f
end function

function getangle( a,b,c , d,e,f )
  la = length( a,b,c )
  lb = length( d,e,f )
  d = dot( a,b,c , d,e,f )
  getangle = acs( d / ( la * lb ) )
end function

''blua 3D engine

function range( l , h )
''calculate random number between l and h
  range = rnd( 0 ) * ( h - l ) + l
end function

sub camera x , y , z , pan , tilt , rol
''set camera coordians and angles
  cam( 0 ) = x
  cam( 1 ) = y
  cam( 2 ) = z
  cam( 3 ) = pan
  cam( 4 ) = tilt
  cam( 5 ) = rol
end sub

sub movecamera x , y , z , pan , tilt , rol
''move camera relativly
  call rotate x , y , 0 - cam( 5 )
  call rotate y , z , 0 - cam( 4 )
  call rotate x , z , 0 - cam( 3 ) 
  cam( 0 ) = cam( 0 ) + x
  cam( 1 ) = cam( 1 ) + y
  cam( 2 ) = cam( 2 ) + z
  cam( 3 ) = ( cam( 3 ) + pan ) mod 360
  cam( 4 ) = ( cam( 4 ) + tilt ) mod 360
  cam( 5 ) = ( cam( 5 ) + rol ) mod 360
end sub


sub link no , x , y , z , xz , yz , xy , ax , p
''calculate new matrix no
''folowing drawing wil use this matrix
  if no < 1 or no > 20 then exit sub
  if p < 0 or p > 20 then exit sub
  if no = p then exit sub

  call copy 0 , rotx
  call copy 0 , roty
  call copy 0 , rotz
  call copy 0 , trans

  m( in( rotx , 1 , 1 ) ) = cos( rad( yz ) )
  m( in( rotx , 1 , 2 ) ) = 0-sin( rad( yz ) )
  m( in( rotx , 2 , 1 ) ) = sin( rad( yz ) )
  m( in( rotx , 2 , 2 ) ) = cos( rad( yz ) )

  m( in( roty , 0 , 0 ) ) = cos( rad( xz ) )
  m( in( roty , 0 , 2 ) ) = 0-sin( rad( xz ) )
  m( in( roty , 2 , 0 ) ) = sin( rad( xz ) )
  m( in( roty , 2 , 2 ) ) = cos( rad( xz ) )

  m( in( rotz , 0 , 0 ) ) = cos( rad( xy ) )
  m( in( rotz , 0 , 1 ) ) = 0-sin( rad( xy ) )
  m( in( rotz , 1 , 0 ) ) = sin( rad( xy ) )
  m( in( rotz , 1 , 1 ) ) = cos( rad( xy ) )

  m( in( trans , 3 , 0 ) ) = x
  m( in( trans , 3 , 1 ) ) = y
  m( in( trans , 3 , 2 ) ) = z

  select case ax
    case xyz
      call keer rotx , roty , rotz , no
    case xzy
      call keer rotx , rotz , roty , no
    case yxz
      call keer roty , rotx , rotz , no
    case yzx
      call keer roty , rotz , rotx , no
    case zxy
      call keer rotz , rotx , roty , no
    case zyx
      call keer rotz , roty , rotx , no
    case else
      call keer rotx , roty , rorz , no
  end select

  number = no
end sub

sub keer a , b , c , no
''calculate axel matrix
  call maal a , b , temp
  call maal temp , c , no
  call maal no , trans , temp
  call maal temp , p , no
end sub

function in( no , x , y )
''to 3d array index
  in = no * 16 + x * 4 + y
end function

sub copy a , uit
''copy a matrix into uit matrix
  for i = 0 to 3
    for j = 0 to 3
      m( in( uit , i , j ) ) = m( in( a , i , j ) )
    next j
  next i
end sub

sub maal a , b , uit
''mutltiply 2 matrixes
  for i = 0 to 3
    for j = 0 to 3
      m( in( uit , i , j ) ) = 0
      for k = 0 to 3
        m( in( uit , i , j ) ) = m( in( uit , i , j ) ) _
        + m( in( a , i , k ) ) * m( in( b , k , j ) )
      next k
    next j
  next i
end sub

sub spot byref x , byref y , byref z
''from lokal coordians to world coordians
  no = number
  hx = m( in( no , 0 , 0 ) ) * x _
     + m( in( no , 1 , 0 ) ) * y _
     + m( in( no , 2 , 0 ) ) * z _
     + m( in( no , 3 , 0 ) )
  hy = m( in( no , 0 , 1 ) ) * x _
     + m( in( no , 1 , 1 ) ) * y _
     + m( in( no , 2 , 1 ) ) * z _
     + m( in( no , 3 , 1 ) )
  hz = m( in( no , 0 , 2 ) ) * x _
     + m( in( no , 1 , 2 ) ) * y _
     + m( in( no , 2 , 2 ) ) * z _
     + m( in( no , 3 , 2 ) )
  x = hx - cam( 0 )
  y = hy - cam( 1 )
  z = hz - cam( 2 )
  call rotate x , y , 0 - cam( 5 )
  call rotate y , z , 0 - cam( 4 )
  call rotate x , z , 0 - cam( 3 )
end sub

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

function rad( x )
''from degrees to radians
  rad = x * pi / 180
end function

''whit thanks to dan teel

sub lbgfx text$
  calldll #lbgfx,"graphicCommand" _
  ,gfx as ulong _
  ,text$ as ptr _
  ,ret as void
end sub

function CreateLBGfx(x,y,w,h,hParent,hMessageHandler)'Returns 0 if fail, hWnd if pass
  style=_WS_VISIBLE+_WS_CHILD+_WS_CLIPCHILDREN
  calldll #kernel32,"GetModuleHandleA",0 as ulong,instance as ulong
  calldll #user32,"CreateWindowExA",_
  0 as long,_
  "LBGfx32" as ptr,_
  0 as ulong,_
  style as ulong,_
  x as long,_
  y as long,_
  w as long,_
  h as long,_
  hParent as ulong,_
  0 as ulong,_
  instance as ulong,_
  hMessageHandler as ulong,_
  CreateLBGfx as ulong
end function

sub DestroyLBGfx
  calldll #user32, "DestroyWindow",_
  gfx as ulong, _
  ret as long
end sub

sub FixWindowSize hwnd,width,height
  struct fixrect _
    ,left as long _
    ,top as long _
    ,right as long _
    ,bottom as long
  calldll #user32,"GetClientRect" _
  ,hwnd as ulong _
  ,fixrect as struct _
  ,ret as void
  width=width-fixrect.right.struct+width
  height=height-fixrect.bottom.struct+height
  calldll #user32,"GetWindowRect" _
  ,hwnd as ulong _
  ,fixrect as struct _
  ,ret as void
  x=fixrect.left.struct
  y=fixrect.top.struct
  calldll #user32,"MoveWindow" _
  ,hwnd as ulong _
  ,x as long _
  ,y as long _
  ,width as long _
  ,height as long _
  ,1 as long _
  ,ret as void
end sub
bluatigro
 
Berichten: 306
Geregistreerd: za sep 27, 2008 6:01 pm

Re: lbgfx 3D

Berichtdoor bluatigro » za feb 27, 2016 9:48 am

update :
- gekopelde kubuse
- linked cubes
Code: Selecteer alles
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy , gfx
global key$ , mouse.x , mouse.y
dim m( 26 * 4 * 4 ) , cam( 6 )
for i = 0 to 3
  m( in( 0 , i , i ) ) = 1
next i
global rotx , roty , rotz , trans , temp , pi
global xyz , xzy , yxz , yzx , zxy , zyx , number
global b.x , b.y , b.z , b.dx , b.dy , b.dz
rotx = 21
roty = 22
rotz = 23
trans = 24
temp = 25
pi = atn( 1 ) * 4
xyz = 0
xzy = 1
yxz = 2
yzx = 3
zxy = 4
zyx = 5
global tritel , trimax , angle
trimax = 100
dim t( trimax , 15 ) , ry( trimax )
dim pnt( 256 , 2)
for i = 0 to trimax
  ry( i ) = i
next i
winx = WindowWidth
winy = WindowHeight
pi = atn( 1 ) * 4
global red , green , yellow
global blue , magenta , cyan
red = rgb( 255 , 0 , 0 )
green = rgb( 0 , 255 , 0 )
yellow = rgb( 255 , 255 , 0 )
blue = rgb( 0 , 0 , 255 )
magenta = rgb( 255 , 0 , 255 )
cyan = rgb( 0 , 255 , 255 )
graphicbox #m.lbgfx, 0,0,0,0
nomainwin
open "LBGfx 3D" for window as #m
call FixWindowSize hwnd(#m),winx,winy
#m.lbgfx "when mouseMove [move]"
#m.lbgfx "when characterInput [key]"
#m "trapclose [quit]"
#m.lbgfx "setfocus"
open DefaultDir$+"\LBGfx.dll" for dll as #lbgfx
gfx=CreateLBGfx(0,0,winx,winy _
,hwnd(#m),hwnd(#m.lbgfx))
  timer 40 , [timer]
wait
[timer]
  scan
  tritel = 0
  call lbgfx "backcolor black"
  call lbgfx "cls"

  call link 1 , 0,0,0 , 0,0,angle , xyz , 0
  call setbox 0,0,0 , 50,50,50
  call colorcube
  call link 2 , 0,150,0 , 0,angle,0 , xzy , 1
  call setbox 0,0,0 , 50,50,50
  call colorcube
  call link 3 , 150,0,0 , angle,0,0 , yxz , 2
  call setbox 0,0,0 , 50,50,50
  call colorcube
  call link 4 , 0,0,-150 , 0,0,angle , yzx , 3
  call setbox 0,0,0 , 50,50,50
  call colorcube

  call drawall
  angle = angle + 5
wait
[key]
  key$ = right$( Inkey$ , 1 )
  if key$ <> chr$( 27 ) then wait
[quit]
  call DestroyLBGfx
  close #lbgfx
  close #m      'ain debugged by Gordon
end
[move]
  mouse.x = MouseX
  mouse.y = MouseY
wait

''color stuf

function rgb( r , g , b )
  r = int( r ) and 255
  g = int( g ) and 255
  b = int( b ) and 255
  rgb = r + g * 256 + b * 256 ^ 2
end function

sub setcolor kl
  r = kl and 255
  g = int( kl / 256 ) and 255
  b = int( kl / 256 ^ 2 ) and 255
  call lbgfx "color ";r;" ";g;" ";b
  call lbgfx "backcolor ";r;" ";g;" ";b
end sub

function  mix( kla , f , klb )
  r1 = kla and 255
  g1 = int( kla / 256 ) and 255
  b1 = int( kla / 256 ^ 2 ) and 255
  r2 = klb and 255
  g2 = int( klb / 256 ) and 255
  b2 = int( klb / 256 ^ 2 ) and 255
  r = r1 + ( r2 - r1 ) * f
  g = g1 + ( g2 - g1 ) * f
  b = b1 + ( b2 - b1 ) * f
  mix = rgb( r , g , b )
end function

''shapes

sub setbox x , y , z , dx , dy , dz
  b.x = x
  b.y = y
  b.z = z
  b.dx = dx
  b.dy = dy
  b.dz = dz
end sub

sub colorcube
  call cube red , green , blue , cyan , magenta , yellow
end sub

sub cube l , b , f , r , t , bk
  call setpoint 0 , b.x-b.dx , b.y-b.dy , b.z-b.dz
  call setpoint 1 , b.x-b.dx , b.y-b.dy , b.z+b.dz
  call setpoint 2 , b.x-b.dx , b.y+b.dy , b.z-b.dz
  call setpoint 3 , b.x-b.dx , b.y+b.dy , b.z+b.dz
  call setpoint 4 , b.x+b.dx , b.y-b.dy , b.z-b.dz
  call setpoint 5 , b.x+b.dx , b.y-b.dy , b.z+b.dz
  call setpoint 6 , b.x+b.dx , b.y+b.dy , b.z-b.dz
  call setpoint 7 , b.x+b.dx , b.y+b.dy , b.z+b.dz
  call quad 0 , 1 , 3 , 2 , l
  call quad 7 , 6 , 4 , 5 , r
  call quad 0 , 1 , 5 , 4 , b
  call quad 7 , 6 , 2 , 3 , t
  call quad 0 , 2 , 6 , 4 , f
  call quad 7 , 5 , 1 , 3 , bk
end sub

''triangle stuf

sub setpoint no , x , y , z
''set point in the swarm
  call spot x , y , z
  pnt( no , 0 ) = x
  pnt( no , 1 ) = y
  pnt( no , 2 ) = z
end sub

sub tri p1 , p2 , p3 , kl
''create a triangle from points in the swarm
  if tritel > trimax then exit sub
  t( tritel , 0 ) = pnt( p1 , 0 )
  t( tritel , 1 ) = pnt( p1 , 1 )
  t( tritel , 2 ) = pnt( p1 , 2 )
  t( tritel , 3 ) = pnt( p2 , 0 )
  t( tritel , 4 ) = pnt( p2 , 1 )
  t( tritel , 5 ) = pnt( p2 , 2 )
  t( tritel , 6 ) = pnt( p3 , 0 )
  t( tritel , 7 ) = pnt( p3 , 1 )
  t( tritel , 8 ) = pnt( p3 , 2 )
  t( tritel , 9 ) = kl
  x = (pnt(p1,0)+pnt(p2,0)+pnt(p3,0))/3
  y = (pnt(p1,1)+pnt(p2,1)+pnt(p3,1))/3
  z = (pnt(p1,2)+pnt(p2,2)+pnt(p3,2))/3
  t( tritel , 10 ) = x
  t( tritel , 11 ) = y
  t( tritel , 12 ) = z
''calculate normal of triangle
  x1 = pnt(p2,0)-pnt(p1,0)
  y1 = pnt(p2,1)-pnt(p1,1)
  z1 = pnt(p2,2)-pnt(p1,2)
  x2 = pnt(p3,0)-pnt(p1,0)
  y2 = pnt(p3,1)-pnt(p1,1)
  z2 = pnt(p3,2)-pnt(p1,2)
  x = y1 * z2 - y2 * z1
  y = z1 * x2 - z2 * x1
  z = x1 * y2 - x2 * y1
  t( tritel , 13 ) = x
  t( tritel , 14 ) = y
  t( tritel , 15 ) = z
  tritel = tritel + 1
end sub

sub quad p1 , p2 , p3 , p4 , kl
''create a quadangle from points in the swarm
  call tri p1 , p2 , p3 , kl
  call tri p1 , p3 , p4 , kl
end sub

sub tri.draw no
''draw a triangle
  x1 = t( no , 0 )
  y1 = t( no , 1 )
  z1 = t( no , 2 )
  x2 = t( no , 3 )
  y2 = t( no , 4 )
  z2 = t( no , 5 )
  x3 = t( no , 6 )
  y3 = t( no , 7 )
  z3 = t( no , 8 )
  kl = t( no , 9 )
  x = t( no , 13 )
  y = t( no , 14 )
  z = t( no , 15 )
''remed for x/0 error
''  a = getangle( x,y,z , 0,1,0 )
''  kl = mix( kl , cos( a ) / 2 + .5 , 0 )
  call setcolor kl
  a1 = winx / 2 + x1 / ( z1 + 2000 ) * 2000
  b1 = winy / 2 - y1 / ( z1 + 2000 ) * 2000
  a2 = winx / 2 + x2 / ( z2 + 2000 ) * 2000
  b2 = winy / 2 - y2 / ( z2 + 2000 ) * 2000
  a3 = winx / 2 + x3 / ( z3 + 2000 ) * 2000
  b3 = winy / 2 - y3 / ( z3 + 2000 ) * 2000
  call lbgfx "polyfilled ";a1;" ";b1 _
                      ;" ";a2;" ";b2 _
                      ;" ";a3;" ";b3
end sub

sub drawall
  for h = 1 to tritel - 1
    for l = 0 to h - 1
      if t(ry(l),12)<t(ry(h),12) then
        help = ry( h )
        ry(h)=ry(l)
        ry(l) = help
      end if
    next l
  next h
  for i = 0 to tritel
    call tri.draw ry(i)
  next i
  call lbgfx "flip"
end sub

function length( a , b , c )
  length = sqr(a^2+b^2+c^2)
end function

function dot( a,b,c , d,e,f )
  dot = a*d+b*e+c*f
end function

function getangle( a,b,c , d,e,f )
  la = length( a,b,c )
  lb = length( d,e,f )
  d = dot( a,b,c , d,e,f )
  getangle = acs( d / ( la * lb ) )
end function

''blua 3D engine

function range( l , h )
''calculate random number between l and h
  range = rnd( 0 ) * ( h - l ) + l
end function

sub camera x , y , z , pan , tilt , rol
''set camera coordians and angles
  cam( 0 ) = x
  cam( 1 ) = y
  cam( 2 ) = z
  cam( 3 ) = pan
  cam( 4 ) = tilt
  cam( 5 ) = rol
end sub

sub movecamera x , y , z , pan , tilt , rol
''move camera relativly
  call rotate x , y , 0 - cam( 5 )
  call rotate y , z , 0 - cam( 4 )
  call rotate x , z , 0 - cam( 3 )
  cam( 0 ) = cam( 0 ) + x
  cam( 1 ) = cam( 1 ) + y
  cam( 2 ) = cam( 2 ) + z
  cam( 3 ) = ( cam( 3 ) + pan ) mod 360
  cam( 4 ) = ( cam( 4 ) + tilt ) mod 360
  cam( 5 ) = ( cam( 5 ) + rol ) mod 360
end sub


sub link no , x , y , z , xz , yz , xy , ax , p
''calculate new matrix no
''folowing drawing wil use this matrix
  if no < 1 or no > 20 then exit sub
  if p < 0 or p > 20 then exit sub
  if no = p then exit sub

  call copy 0 , rotx
  call copy 0 , roty
  call copy 0 , rotz
  call copy 0 , trans

  m( in( rotx , 1 , 1 ) ) = cos( rad( yz ) )
  m( in( rotx , 1 , 2 ) ) = 0-sin( rad( yz ) )
  m( in( rotx , 2 , 1 ) ) = sin( rad( yz ) )
  m( in( rotx , 2 , 2 ) ) = cos( rad( yz ) )

  m( in( roty , 0 , 0 ) ) = cos( rad( xz ) )
  m( in( roty , 0 , 2 ) ) = 0-sin( rad( xz ) )
  m( in( roty , 2 , 0 ) ) = sin( rad( xz ) )
  m( in( roty , 2 , 2 ) ) = cos( rad( xz ) )

  m( in( rotz , 0 , 0 ) ) = cos( rad( xy ) )
  m( in( rotz , 0 , 1 ) ) = 0-sin( rad( xy ) )
  m( in( rotz , 1 , 0 ) ) = sin( rad( xy ) )
  m( in( rotz , 1 , 1 ) ) = cos( rad( xy ) )

  m( in( trans , 3 , 0 ) ) = x
  m( in( trans , 3 , 1 ) ) = y
  m( in( trans , 3 , 2 ) ) = z

  select case ax
    case xyz
      call keer rotx , roty , rotz , no , p
    case xzy
      call keer rotx , rotz , roty , no , p
    case yxz
      call keer roty , rotx , rotz , no , p
    case yzx
      call keer roty , rotz , rotx , no , p
    case zxy
      call keer rotz , rotx , roty , no , p
    case zyx
      call keer rotz , roty , rotx , no , p
    case else
      call keer rotx , roty , rorz , no , p
  end select

  number = no
end sub

sub keer a , b , c , no , p
''calculate axel matrix
  call maal a , b , temp
  call maal temp , c , no
  call maal no , trans , temp
  call maal temp , p , no
end sub

function in( no , x , y )
''to 3d array index
  in = no * 16 + x * 4 + y
end function

sub copy a , uit
''copy a matrix into uit matrix
  for i = 0 to 3
    for j = 0 to 3
      m( in( uit , i , j ) ) = m( in( a , i , j ) )
    next j
  next i
end sub

sub maal a , b , uit
''mutltiply 2 matrixes
  for i = 0 to 3
    for j = 0 to 3
      m( in( uit , i , j ) ) = 0
      for k = 0 to 3
        m( in( uit , i , j ) ) = m( in( uit , i , j ) ) _
        + m( in( a , i , k ) ) * m( in( b , k , j ) )
      next k
    next j
  next i
end sub

sub spot byref x , byref y , byref z
''from lokal coordians to world coordians
  no = number
  hx = m( in( no , 0 , 0 ) ) * x _
     + m( in( no , 1 , 0 ) ) * y _
     + m( in( no , 2 , 0 ) ) * z _
     + m( in( no , 3 , 0 ) )
  hy = m( in( no , 0 , 1 ) ) * x _
     + m( in( no , 1 , 1 ) ) * y _
     + m( in( no , 2 , 1 ) ) * z _
     + m( in( no , 3 , 1 ) )
  hz = m( in( no , 0 , 2 ) ) * x _
     + m( in( no , 1 , 2 ) ) * y _
     + m( in( no , 2 , 2 ) ) * z _
     + m( in( no , 3 , 2 ) )
  x = hx - cam( 0 )
  y = hy - cam( 1 )
  z = hz - cam( 2 )
  call rotate x , y , 0 - cam( 5 )
  call rotate y , z , 0 - cam( 4 )
  call rotate x , z , 0 - cam( 3 )
end sub

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

function rad( x )
''from degrees to radians
  rad = x * pi / 180
end function

''whit thanks to dan teel

sub lbgfx text$
  calldll #lbgfx,"graphicCommand" _
  ,gfx as ulong _
  ,text$ as ptr _
  ,ret as void
end sub

function CreateLBGfx(x,y,w,h,hParent,hMessageHandler)'Returns 0 if fail, hWnd if pass
  style=_WS_VISIBLE+_WS_CHILD+_WS_CLIPCHILDREN
  calldll #kernel32,"GetModuleHandleA",0 as ulong,instance as ulong
  calldll #user32,"CreateWindowExA",_
  0 as long,_
  "LBGfx32" as ptr,_
  0 as ulong,_
  style as ulong,_
  x as long,_
  y as long,_
  w as long,_
  h as long,_
  hParent as ulong,_
  0 as ulong,_
  instance as ulong,_
  hMessageHandler as ulong,_
  CreateLBGfx as ulong
end function

sub DestroyLBGfx
  calldll #user32, "DestroyWindow",_
  gfx as ulong, _
  ret as long
end sub

sub FixWindowSize hwnd,width,height
  struct fixrect _
    ,left as long _
    ,top as long _
    ,right as long _
    ,bottom as long
  calldll #user32,"GetClientRect" _
  ,hwnd as ulong _
  ,fixrect as struct _
  ,ret as void
  width=width-fixrect.right.struct+width
  height=height-fixrect.bottom.struct+height
  calldll #user32,"GetWindowRect" _
  ,hwnd as ulong _
  ,fixrect as struct _
  ,ret as void
  x=fixrect.left.struct
  y=fixrect.top.struct
  calldll #user32,"MoveWindow" _
  ,hwnd as ulong _
  ,x as long _
  ,y as long _
  ,width as long _
  ,height as long _
  ,1 as long _
  ,ret as void
end sub
bluatigro
 
Berichten: 306
Geregistreerd: za sep 27, 2008 6:01 pm

Re: lbgfx 3D

Berichtdoor bluatigro » za feb 27, 2016 11:02 am

update :
- avartar !!
- ik denk dat ik tegen de grenzen van lbgfx aanloop
- i m getting to the limits of lbgfx
Code: Selecteer alles
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy , gfx
global key$ , mouse.x , mouse.y
dim m( 26 * 4 * 4 ) , cam( 6 ) , sk( 64 , 2 )
for i = 0 to 3
  m( in( 0 , i , i ) ) = 1
next i
global rotx , roty , rotz , trans , temp , pi , minz
global xyz , xzy , yxz , yzx , zxy , zyx , number
global b.x , b.y , b.z , b.dx , b.dy , b.dz
rotx = 21
roty = 22
rotz = 23
trans = 24
temp = 25
pi = atn( 1 ) * 4
xyz = 0
xzy = 1
yxz = 2
yzx = 3
zxy = 4
zyx = 5
minz = -1900
global tritel , trimax , angle
trimax = 100
dim t( trimax , 15 ) , ry( trimax )
dim pnt( 256 , 2)
for i = 0 to trimax
  ry( i ) = i
next i
winx = WindowWidth
winy = WindowHeight
pi = atn( 1 ) * 4
global red , green , yellow
global blue , magenta , cyan
red = rgb( 255 , 0 , 0 )
green = rgb( 0 , 255 , 0 )
yellow = rgb( 255 , 255 , 0 )
blue = rgb( 0 , 0 , 255 )
magenta = rgb( 255 , 0 , 255 )
cyan = rgb( 0 , 255 , 255 )
graphicbox #m.lbgfx, 0,0,0,0
nomainwin
open "LBGfx 3D" for window as #m
call FixWindowSize hwnd(#m),winx,winy
#m.lbgfx "when mouseMove [move]"
#m.lbgfx "when characterInput [key]"
#m "trapclose [quit]"
#m.lbgfx "setfocus"
open DefaultDir$+"\LBGfx.dll" for dll as #lbgfx
gfx=CreateLBGfx(0,0,winx,winy _
,hwnd(#m),hwnd(#m.lbgfx))
  timer 40 , [timer]
wait
[timer]
  scan
  tritel = 0
  call lbgfx "backcolor black"
  call lbgfx "cls"

  call skelet 0 , pend( angle , 30 ) , 0 , 0
  call skelet 1 , pend( angle - 90 , 30 ) + 30 , 0 , 0
  call skelet 2 , pend( angle + 180 , 30 ) , 0 , 0
  call skelet 3 , pend( angle + 90 , 30 ) + 30 , 0 , 0

  call link 1 , 0,0,0 , 30,0,0 , xyz , 0
  call setbox 0,0,0 , 50,50,10
  call colorcube
  call child 2 , 30,-90,0 , 0 , xyz , 1
  call setbox 0,-25,0 , 10,40,10
  call colorcube
  call child 3 , 0,-90,0 , 1 , xyz , 2
  call setbox 0,-25,0 , 10,40,10
  call colorcube
  call child 2 , -30,-90,0 , 2 , xyz , 1
  call setbox 0,-25,0 , 10,40,10
  call colorcube
  call child 3 , 0,-90,0 , 3 , xyz , 2
  call setbox 0,-25,0 , 10,40,10
  call colorcube

  call drawall
  angle = angle + 5
wait
[key]
  key$ = right$( Inkey$ , 1 )
  if key$ <> chr$( 27 ) then wait
[quit]
  call DestroyLBGfx
  close #lbgfx
  close #m      'ain debugged by Gordon
end
[move]
  mouse.x = MouseX
  mouse.y = MouseY
wait

''color stuf

function rgb( r , g , b )
  r = int( r ) and 255
  g = int( g ) and 255
  b = int( b ) and 255
  rgb = r + g * 256 + b * 256 ^ 2
end function

sub setcolor kl
  r = kl and 255
  g = int( kl / 256 ) and 255
  b = int( kl / 256 ^ 2 ) and 255
  call lbgfx "color ";r;" ";g;" ";b
  call lbgfx "backcolor ";r;" ";g;" ";b
end sub

function  mix( kla , f , klb )
  r1 = kla and 255
  g1 = int( kla / 256 ) and 255
  b1 = int( kla / 256 ^ 2 ) and 255
  r2 = klb and 255
  g2 = int( klb / 256 ) and 255
  b2 = int( klb / 256 ^ 2 ) and 255
  r = r1 + ( r2 - r1 ) * f
  g = g1 + ( g2 - g1 ) * f
  b = b1 + ( b2 - b1 ) * f
  mix = rgb( r , g , b )
end function

''shapes

sub setbox x , y , z , dx , dy , dz
''set bounding box
  b.x = x
  b.y = y
  b.z = z
  b.dx = dx
  b.dy = dy
  b.dz = dz
end sub

sub colorcube
  call cube red , green , blue , cyan , magenta , yellow
end sub

sub cube l , b , f , r , t , bk
''create cube whit 6 colors and size from boundingbox
  call setpoint 0 , b.x-b.dx , b.y-b.dy , b.z-b.dz
  call setpoint 1 , b.x-b.dx , b.y-b.dy , b.z+b.dz
  call setpoint 2 , b.x-b.dx , b.y+b.dy , b.z-b.dz
  call setpoint 3 , b.x-b.dx , b.y+b.dy , b.z+b.dz
  call setpoint 4 , b.x+b.dx , b.y-b.dy , b.z-b.dz
  call setpoint 5 , b.x+b.dx , b.y-b.dy , b.z+b.dz
  call setpoint 6 , b.x+b.dx , b.y+b.dy , b.z-b.dz
  call setpoint 7 , b.x+b.dx , b.y+b.dy , b.z+b.dz
  call quad 0 , 1 , 3 , 2 , l
  call quad 7 , 6 , 4 , 5 , r
  call quad 0 , 1 , 5 , 4 , b
  call quad 7 , 6 , 2 , 3 , t
  call quad 0 , 2 , 6 , 4 , f
  call quad 7 , 5 , 1 , 3 , bk
end sub

''triangle stuf

sub setpoint no , x , y , z
''set point in the swarm
  call spot x , y , z
  pnt( no , 0 ) = x
  pnt( no , 1 ) = y
  pnt( no , 2 ) = z
end sub

sub tri p1 , p2 , p3 , kl
''create a triangle from points in the swarm
  if tritel > trimax then exit sub
  t( tritel , 0 ) = pnt( p1 , 0 )
  t( tritel , 1 ) = pnt( p1 , 1 )
  t( tritel , 2 ) = pnt( p1 , 2 )
  t( tritel , 3 ) = pnt( p2 , 0 )
  t( tritel , 4 ) = pnt( p2 , 1 )
  t( tritel , 5 ) = pnt( p2 , 2 )
  t( tritel , 6 ) = pnt( p3 , 0 )
  t( tritel , 7 ) = pnt( p3 , 1 )
  t( tritel , 8 ) = pnt( p3 , 2 )
  t( tritel , 9 ) = kl
  x = (pnt(p1,0)+pnt(p2,0)+pnt(p3,0))/3
  y = (pnt(p1,1)+pnt(p2,1)+pnt(p3,1))/3
  z = (pnt(p1,2)+pnt(p2,2)+pnt(p3,2))/3
  t( tritel , 10 ) = x
  t( tritel , 11 ) = y
  t( tritel , 12 ) = z
''calculate normal of triangle
  x1 = pnt(p2,0)-pnt(p1,0)
  y1 = pnt(p2,1)-pnt(p1,1)
  z1 = pnt(p2,2)-pnt(p1,2)
  x2 = pnt(p3,0)-pnt(p1,0)
  y2 = pnt(p3,1)-pnt(p1,1)
  z2 = pnt(p3,2)-pnt(p1,2)
  x = y1 * z2 - y2 * z1
  y = z1 * x2 - z2 * x1
  z = x1 * y2 - x2 * y1
  t( tritel , 13 ) = x
  t( tritel , 14 ) = y
  t( tritel , 15 ) = z
  tritel = tritel + 1
end sub

sub quad p1 , p2 , p3 , p4 , kl
''create a quadangle from points in the swarm
  call tri p1 , p2 , p3 , kl
  call tri p1 , p3 , p4 , kl
end sub

sub tri.draw no
''draw a triangle
  x1 = t( no , 0 )
  y1 = t( no , 1 )
  z1 = t( no , 2 )
  x2 = t( no , 3 )
  y2 = t( no , 4 )
  z2 = t( no , 5 )
  x3 = t( no , 6 )
  y3 = t( no , 7 )
  z3 = t( no , 8 )
  kl = t( no , 9 )
  x = t( no , 13 )
  y = t( no , 14 )
  z = t( no , 15 )
  if z1 < minz then exit sub
  if z2 < minz then exit sub
  if z3 < minz then exit sub
''remed for x/0 error
''  a = getangle( x,y,z , 0,1,0 )
''  kl = mix( kl , cos( a ) / 2 + .5 , 0 )
  call setcolor kl
  a1 = winx / 2 + x1 / ( z1 + 2000 ) * 2000
  b1 = winy / 2 - y1 / ( z1 + 2000 ) * 2000
  a2 = winx / 2 + x2 / ( z2 + 2000 ) * 2000
  b2 = winy / 2 - y2 / ( z2 + 2000 ) * 2000
  a3 = winx / 2 + x3 / ( z3 + 2000 ) * 2000
  b3 = winy / 2 - y3 / ( z3 + 2000 ) * 2000
  call lbgfx "polyfilled ";a1;" ";b1 _
                      ;" ";a2;" ";b2 _
                      ;" ";a3;" ";b3
end sub

sub drawall
  for h = 1 to tritel - 1
    for l = 0 to h - 1
      if t(ry(l),12)<t(ry(h),12) then
        help = ry( h )
        ry(h)=ry(l)
        ry(l) = help
      end if
    next l
  next h
  for i = 0 to tritel
    call tri.draw ry(i)
  next i
  call lbgfx "flip"
end sub

function length( a , b , c )
  length = sqr(a^2+b^2+c^2)
end function

function dot( a,b,c , d,e,f )
  dot = a*d+b*e+c*f
end function

function getangle( a,b,c , d,e,f )
  la = length( a,b,c )
  lb = length( d,e,f )
  d = dot( a,b,c , d,e,f )
  getangle = acs( d / ( la * lb ) )
end function

''blua 3D engine

function range( l , h )
''calculate random number between l and h
  range = rnd( 0 ) * ( h - l ) + l
end function

sub camera x , y , z , pan , tilt , rol
''set camera coordians and angles
  cam( 0 ) = x
  cam( 1 ) = y
  cam( 2 ) = z
  cam( 3 ) = pan
  cam( 4 ) = tilt
  cam( 5 ) = rol
end sub

sub movecamera x , y , z , pan , tilt , rol
''move camera relativly
  call rotate x , y , 0 - cam( 5 )
  call rotate y , z , 0 - cam( 4 )
  call rotate x , z , 0 - cam( 3 )
  cam( 0 ) = cam( 0 ) + x
  cam( 1 ) = cam( 1 ) + y
  cam( 2 ) = cam( 2 ) + z
  cam( 3 ) = ( cam( 3 ) + pan ) mod 360
  cam( 4 ) = ( cam( 4 ) + tilt ) mod 360
  cam( 5 ) = ( cam( 5 ) + rol ) mod 360
end sub

function pend( fase , amp )
''for natural movment
  pend = sin( rad( fase ) ) * amp
end function

sub skelet lim , x , y , z
''set angles of a lim of a avatar
  if lim < 0 or lim > 64 then exit sub
  sk( lim , 0 ) = x
  sk( lim , 1 ) = y
  sk( lim , 2 ) = z
end sub

sub child no , x , y , z , lim , ax , p
''calculate a new lim matrix
  if lim < 0 or lim > 64 then exit sub
  call link no , x , y , z _
  , sk( lim , 1 ) , sk( lim , 0 ) , sk( lim , 2 ) , ax , p
end sub

sub link no , x , y , z , xz , yz , xy , ax , p
''calculate new matrix no
''folowing drawing wil use this matrix
  if no < 1 or no > 20 then exit sub
  if p < 0 or p > 20 then exit sub
  if no = p then exit sub

  call copy 0 , rotx
  call copy 0 , roty
  call copy 0 , rotz
  call copy 0 , trans

  m( in( rotx , 1 , 1 ) ) = cos( rad( yz ) )
  m( in( rotx , 1 , 2 ) ) = 0-sin( rad( yz ) )
  m( in( rotx , 2 , 1 ) ) = sin( rad( yz ) )
  m( in( rotx , 2 , 2 ) ) = cos( rad( yz ) )

  m( in( roty , 0 , 0 ) ) = cos( rad( xz ) )
  m( in( roty , 0 , 2 ) ) = 0-sin( rad( xz ) )
  m( in( roty , 2 , 0 ) ) = sin( rad( xz ) )
  m( in( roty , 2 , 2 ) ) = cos( rad( xz ) )

  m( in( rotz , 0 , 0 ) ) = cos( rad( xy ) )
  m( in( rotz , 0 , 1 ) ) = 0-sin( rad( xy ) )
  m( in( rotz , 1 , 0 ) ) = sin( rad( xy ) )
  m( in( rotz , 1 , 1 ) ) = cos( rad( xy ) )

  m( in( trans , 3 , 0 ) ) = x
  m( in( trans , 3 , 1 ) ) = y
  m( in( trans , 3 , 2 ) ) = z

  select case ax
    case xyz
      call keer rotx , roty , rotz , no , p
    case xzy
      call keer rotx , rotz , roty , no , p
    case yxz
      call keer roty , rotx , rotz , no , p
    case yzx
      call keer roty , rotz , rotx , no , p
    case zxy
      call keer rotz , rotx , roty , no , p
    case zyx
      call keer rotz , roty , rotx , no , p
    case else
      call keer rotx , roty , rorz , no , p
  end select

  number = no
end sub

sub keer a , b , c , no , p
''calculate axel matrix
  call maal a , b , temp
  call maal temp , c , no
  call maal no , trans , temp
  call maal temp , p , no
end sub

function in( no , x , y )
''to 3d array index
  in = no * 16 + x * 4 + y
end function

sub copy a , uit
''copy a matrix into uit matrix
  for i = 0 to 3
    for j = 0 to 3
      m( in( uit , i , j ) ) = m( in( a , i , j ) )
    next j
  next i
end sub

sub maal a , b , uit
''mutltiply 2 matrixes
  for i = 0 to 3
    for j = 0 to 3
      m( in( uit , i , j ) ) = 0
      for k = 0 to 3
        m( in( uit , i , j ) ) = m( in( uit , i , j ) ) _
        + m( in( a , i , k ) ) * m( in( b , k , j ) )
      next k
    next j
  next i
end sub

sub spot byref x , byref y , byref z
''from lokal coordians to world coordians
  no = number
  hx = m( in( no , 0 , 0 ) ) * x _
     + m( in( no , 1 , 0 ) ) * y _
     + m( in( no , 2 , 0 ) ) * z _
     + m( in( no , 3 , 0 ) )
  hy = m( in( no , 0 , 1 ) ) * x _
     + m( in( no , 1 , 1 ) ) * y _
     + m( in( no , 2 , 1 ) ) * z _
     + m( in( no , 3 , 1 ) )
  hz = m( in( no , 0 , 2 ) ) * x _
     + m( in( no , 1 , 2 ) ) * y _
     + m( in( no , 2 , 2 ) ) * z _
     + m( in( no , 3 , 2 ) )
  x = hx - cam( 0 )
  y = hy - cam( 1 )
  z = hz - cam( 2 )
  call rotate x , y , 0 - cam( 5 )
  call rotate y , z , 0 - cam( 4 )
  call rotate x , z , 0 - cam( 3 )
end sub

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

function rad( x )
''from degrees to radians
  rad = x * pi / 180
end function

''whit thanks to dan teel

sub lbgfx text$
  calldll #lbgfx,"graphicCommand" _
  ,gfx as ulong _
  ,text$ as ptr _
  ,ret as void
end sub

function CreateLBGfx(x,y,w,h,hParent,hMessageHandler)'Returns 0 if fail, hWnd if pass
  style=_WS_VISIBLE+_WS_CHILD+_WS_CLIPCHILDREN
  calldll #kernel32,"GetModuleHandleA",0 as ulong,instance as ulong
  calldll #user32,"CreateWindowExA",_
  0 as long,_
  "LBGfx32" as ptr,_
  0 as ulong,_
  style as ulong,_
  x as long,_
  y as long,_
  w as long,_
  h as long,_
  hParent as ulong,_
  0 as ulong,_
  instance as ulong,_
  hMessageHandler as ulong,_
  CreateLBGfx as ulong
end function

sub DestroyLBGfx
  calldll #user32, "DestroyWindow",_
  gfx as ulong, _
  ret as long
end sub

sub FixWindowSize hwnd,width,height
  struct fixrect _
    ,left as long _
    ,top as long _
    ,right as long _
    ,bottom as long
  calldll #user32,"GetClientRect" _
  ,hwnd as ulong _
  ,fixrect as struct _
  ,ret as void
  width=width-fixrect.right.struct+width
  height=height-fixrect.bottom.struct+height
  calldll #user32,"GetWindowRect" _
  ,hwnd as ulong _
  ,fixrect as struct _
  ,ret as void
  x=fixrect.left.struct
  y=fixrect.top.struct
  calldll #user32,"MoveWindow" _
  ,hwnd as ulong _
  ,x as long _
  ,y as long _
  ,width as long _
  ,height as long _
  ,1 as long _
  ,ret as void
end sub
bluatigro
 
Berichten: 306
Geregistreerd: za sep 27, 2008 6:01 pm

Re: lbgfx 3D

Berichtdoor bluatigro » zo feb 28, 2016 12:06 pm

wire world try
lijn wereld experiment

error :
- i see only black
- leeg zwart scherm
Code: Selecteer alles
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy , gfx
global key$ , mouse.x , mouse.y
dim m( 26 * 4 * 4 ) , cam( 6 ) , sk( 64 , 2 )
for i = 0 to 3
  m( in( 0 , i , i ) ) = 1
next i
global rotx , roty , rotz , trans , temp , pi , minz
global xyz , xzy , yxz , yzx , zxy , zyx , number
rotx = 21
roty = 22
rotz = 23
trans = 24
temp = 25
pi = atn( 1 ) * 4
xyz = 0
xzy = 1
yxz = 2
yzx = 3
zxy = 4
zyx = 5
minz = -1900
global angle
winx = WindowWidth
winy = WindowHeight
pi = atn( 1 ) * 4
global red , green , yellow
global blue , magenta , cyan
red = rgb( 255 , 0 , 0 )
green = rgb( 0 , 255 , 0 )
yellow = rgb( 255 , 255 , 0 )
blue = rgb( 0 , 0 , 255 )
magenta = rgb( 255 , 0 , 255 )
cyan = rgb( 0 , 255 , 255 )
graphicbox #m.lbgfx, 0,0,0,0
nomainwin
open "LBGfx 3D" for window as #m
call FixWindowSize hwnd(#m),winx,winy
#m.lbgfx "when mouseMove [move]"
#m.lbgfx "when characterInput [key]"
#m "trapclose [quit]"
#m.lbgfx "setfocus"
open DefaultDir$+"\LBGfx.dll" for dll as #lbgfx
gfx=CreateLBGfx(0,0,winx,winy _
,hwnd(#m),hwnd(#m.lbgfx))
  timer 40 , [timer]
wait
[timer]
  scan
  call lbgfx "backcolor black"
  call lbgfx "cls"

  call skelet 0 , pend( angle , 30 ) , 0 , 0
  call skelet 1 , pend( angle - 90 , 30 ) + 30 , 0 , 0
  call skelet 2 , pend( angle + 180 , 30 ) , 0 , 0
  call skelet 3 , pend( angle + 90 , 30 ) + 30 , 0 , 0

  call link 1 , 0,0,0 , 30,0,0 , xyz , 0
  call cube 0,0,0 , 50,50,10 , green , 5
  call child 2 , 30,-90,0 , 0 , xyz , 1
  call cube 0,-25,0 , 10,40,10 , green , 5
  call child 3 , 0,-90,0 , 1 , xyz , 2
  call cube 0,-25,0 , 10,40,10 , green , 5
  call child 2 , -30,-90,0 , 2 , xyz , 1
  call cube 0,-25,0 , 10,40,10 , green , 5
  call child 3 , 0,-90,0 , 3 , xyz , 2
  call cube 0,-25,0 , 10,40,10 , green , 5

  angle = angle + 5
wait
[key]
  key$ = right$( Inkey$ , 1 )
  if key$ <> chr$( 27 ) then wait
[quit]
  call DestroyLBGfx
  close #lbgfx
  close #m      'ain debugged by Gordon
end
[move]
  mouse.x = MouseX
  mouse.y = MouseY
wait

''color stuf

function rgb( r , g , b )
  r = int( r ) and 255
  g = int( g ) and 255
  b = int( b ) and 255
  rgb = r + g * 256 + b * 256 ^ 2
end function

sub setcolor kl
  r = kl and 255
  g = int( kl / 256 ) and 255
  b = int( kl / 256 ^ 2 ) and 255
  call lbgfx "color ";r;" ";g;" ";b
end sub

function  mix( kla , f , klb )
  r1 = kla and 255
  g1 = int( kla / 256 ) and 255
  b1 = int( kla / 256 ^ 2 ) and 255
  r2 = klb and 255
  g2 = int( klb / 256 ) and 255
  b2 = int( klb / 256 ^ 2 ) and 255
  r = r1 + ( r2 - r1 ) * f
  g = g1 + ( g2 - g1 ) * f
  b = b1 + ( b2 - b1 ) * f
  mix = rgb( r , g , b )
end function

''graphics


sub cube mx,my,mz , dx,dy,dz , kl , size

  call lijn mx+dx,my+dy,mz+dz , mx-dx,my+dy,mz+dz , kl , size
  call lijn mx+dx,my+dy,mz-dz , mx-dx,my+dy,mz-dz , kl , size
  call lijn mx+dx,my-dy,mz+dz , mx-dx,my-dy,mz+dz , kl , size
  call lijn mx+dx,my-dy,mz-dz , mx-dx,my-dy,mz-dz , kl , size

  call lijn mx+dx,my+dy,mz+dz , mx+dx,my-dy,mz+dz , kl , size
  call lijn mx+dx,my+dy,mz-dz , mx+dx,my-dy,mz-dz , kl , size
  call lijn mx-dx,my+dy,mz+dz , mx-dx,my-dy,mz+dz , kl , size
  call lijn mx-dx,my+dy,mz-dz , mx-dx,my-dy,mz-dz , kl , size

  call lijn mx+dx,my+dy,mz+dz , mx+dx,my+dy,mz-dz , kl , size
  call lijn mx+dx,my-dy,mz+dz , mx+dx,my-dy,mz-dz , kl , size
  call lijn mx-dx,my+dy,mz+dz , mx-dx,my+dy,mz-dz , kl , size
  call lijn mx-dx,my-dy,mz+dz , mx-dx,my-dy,mz-dz , kl , size

end sub

sub lijn x1,y1,z1 , x2,y2,z2 , kl , size
  call spot x1,y1,z1
  call spot x2,y2,z2
  if z1 < -900 then exit sub
  if z2 < -900 then exit sub
  ax = winx/2 + x1 / ( z1 + 1000 ) * 1000
  ay = winy/2 - y1 / ( z1 + 1000 ) * 1000
  bx = winx/2 + x2 / ( z2 + 1000 ) * 1000
  by = winy/2 - y2 / ( z2 + 1000 ) * 1000
  call setcolor kl
  call lbgfx "size " ; size
  call lbgfx "line " ; ax ; "  " ; ay ; " " ; bx ; " " ; by
end sub
''blua 3D engine

function range( l , h )
''calculate random number between l and h
  range = rnd( 0 ) * ( h - l ) + l
end function

sub camera x , y , z , pan , tilt , rol
''set camera coordians and angles
  cam( 0 ) = x
  cam( 1 ) = y
  cam( 2 ) = z
  cam( 3 ) = pan
  cam( 4 ) = tilt
  cam( 5 ) = rol
end sub

sub movecamera x , y , z , pan , tilt , rol
''move camera relativly
  call rotate x , y , 0 - cam( 5 )
  call rotate y , z , 0 - cam( 4 )
  call rotate x , z , 0 - cam( 3 )
  cam( 0 ) = cam( 0 ) + x
  cam( 1 ) = cam( 1 ) + y
  cam( 2 ) = cam( 2 ) + z
  cam( 3 ) = ( cam( 3 ) + pan ) mod 360
  cam( 4 ) = ( cam( 4 ) + tilt ) mod 360
  cam( 5 ) = ( cam( 5 ) + rol ) mod 360
end sub

function pend( fase , amp )
''for natural movment
  pend = sin( rad( fase ) ) * amp
end function

sub skelet lim , x , y , z
''set angles of a lim of a avatar
  if lim < 0 or lim > 64 then exit sub
  sk( lim , 0 ) = x
  sk( lim , 1 ) = y
  sk( lim , 2 ) = z
end sub

sub child no , x , y , z , lim , ax , p
''calculate a new lim matrix
  if lim < 0 or lim > 64 then exit sub
  call link no , x , y , z _
  , sk( lim , 1 ) , sk( lim , 0 ) , sk( lim , 2 ) , ax , p
end sub

sub link no , x , y , z , xz , yz , xy , ax , p
''calculate new matrix no
''folowing drawing wil use this matrix
  if no < 1 or no > 20 then exit sub
  if p < 0 or p > 20 then exit sub
  if no = p then exit sub

  call copy 0 , rotx
  call copy 0 , roty
  call copy 0 , rotz
  call copy 0 , trans

  m( in( rotx , 1 , 1 ) ) = cos( rad( yz ) )
  m( in( rotx , 1 , 2 ) ) = 0-sin( rad( yz ) )
  m( in( rotx , 2 , 1 ) ) = sin( rad( yz ) )
  m( in( rotx , 2 , 2 ) ) = cos( rad( yz ) )

  m( in( roty , 0 , 0 ) ) = cos( rad( xz ) )
  m( in( roty , 0 , 2 ) ) = 0-sin( rad( xz ) )
  m( in( roty , 2 , 0 ) ) = sin( rad( xz ) )
  m( in( roty , 2 , 2 ) ) = cos( rad( xz ) )

  m( in( rotz , 0 , 0 ) ) = cos( rad( xy ) )
  m( in( rotz , 0 , 1 ) ) = 0-sin( rad( xy ) )
  m( in( rotz , 1 , 0 ) ) = sin( rad( xy ) )
  m( in( rotz , 1 , 1 ) ) = cos( rad( xy ) )

  m( in( trans , 3 , 0 ) ) = x
  m( in( trans , 3 , 1 ) ) = y
  m( in( trans , 3 , 2 ) ) = z

  select case ax
    case xyz
      call keer rotx , roty , rotz , no , p
    case xzy
      call keer rotx , rotz , roty , no , p
    case yxz
      call keer roty , rotx , rotz , no , p
    case yzx
      call keer roty , rotz , rotx , no , p
    case zxy
      call keer rotz , rotx , roty , no , p
    case zyx
      call keer rotz , roty , rotx , no , p
    case else
      call keer rotx , roty , rorz , no , p
  end select

  number = no
end sub

sub keer a , b , c , no , p
''calculate axel matrix
  call maal a , b , temp
  call maal temp , c , no
  call maal no , trans , temp
  call maal temp , p , no
end sub

function in( no , x , y )
''to 3d array index
  in = no * 16 + x * 4 + y
end function

sub copy a , uit
''copy a matrix into uit matrix
  for i = 0 to 3
    for j = 0 to 3
      m( in( uit , i , j ) ) = m( in( a , i , j ) )
    next j
  next i
end sub

sub maal a , b , uit
''mutltiply 2 matrixes
  for i = 0 to 3
    for j = 0 to 3
      m( in( uit , i , j ) ) = 0
      for k = 0 to 3
        m( in( uit , i , j ) ) = m( in( uit , i , j ) ) _
        + m( in( a , i , k ) ) * m( in( b , k , j ) )
      next k
    next j
  next i
end sub

sub spot byref x , byref y , byref z
''from lokal coordians to world coordians
  no = number
  hx = m( in( no , 0 , 0 ) ) * x _
     + m( in( no , 1 , 0 ) ) * y _
     + m( in( no , 2 , 0 ) ) * z _
     + m( in( no , 3 , 0 ) )
  hy = m( in( no , 0 , 1 ) ) * x _
     + m( in( no , 1 , 1 ) ) * y _
     + m( in( no , 2 , 1 ) ) * z _
     + m( in( no , 3 , 1 ) )
  hz = m( in( no , 0 , 2 ) ) * x _
     + m( in( no , 1 , 2 ) ) * y _
     + m( in( no , 2 , 2 ) ) * z _
     + m( in( no , 3 , 2 ) )
  x = hx - cam( 0 )
  y = hy - cam( 1 )
  z = hz - cam( 2 )
  call rotate x , y , 0 - cam( 5 )
  call rotate y , z , 0 - cam( 4 )
  call rotate x , z , 0 - cam( 3 )
end sub

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

function rad( x )
''from degrees to radians
  rad = x * pi / 180
end function

''whit thanks to dan teel

sub lbgfx text$
  calldll #lbgfx,"graphicCommand" _
  ,gfx as ulong _
  ,text$ as ptr _
  ,ret as void
end sub

function CreateLBGfx(x,y,w,h,hParent,hMessageHandler)'Returns 0 if fail, hWnd if pass
  style=_WS_VISIBLE+_WS_CHILD+_WS_CLIPCHILDREN
  calldll #kernel32,"GetModuleHandleA",0 as ulong,instance as ulong
  calldll #user32,"CreateWindowExA",_
  0 as long,_
  "LBGfx32" as ptr,_
  0 as ulong,_
  style as ulong,_
  x as long,_
  y as long,_
  w as long,_
  h as long,_
  hParent as ulong,_
  0 as ulong,_
  instance as ulong,_
  hMessageHandler as ulong,_
  CreateLBGfx as ulong
end function

sub DestroyLBGfx
  calldll #user32, "DestroyWindow",_
  gfx as ulong, _
  ret as long
end sub

sub FixWindowSize hwnd,width,height
  struct fixrect _
    ,left as long _
    ,top as long _
    ,right as long _
    ,bottom as long
  calldll #user32,"GetClientRect" _
  ,hwnd as ulong _
  ,fixrect as struct _
  ,ret as void
  width=width-fixrect.right.struct+width
  height=height-fixrect.bottom.struct+height
  calldll #user32,"GetWindowRect" _
  ,hwnd as ulong _
  ,fixrect as struct _
  ,ret as void
  x=fixrect.left.struct
  y=fixrect.top.struct
  calldll #user32,"MoveWindow" _
  ,hwnd as ulong _
  ,x as long _
  ,y as long _
  ,width as long _
  ,height as long _
  ,1 as long _
  ,ret as void
end sub
bluatigro
 
Berichten: 306
Geregistreerd: za sep 27, 2008 6:01 pm

Re: lbgfx 3D

Berichtdoor bluatigro » ma feb 29, 2016 11:39 am

update :
- geanimeerde avartar
- animated avartar

Code: Selecteer alles
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy , gfx
global key$ , mouse.x , mouse.y
dim m( 26 * 4 * 4 ) , cam( 6 ) , sk( 64 , 2 )
for i = 0 to 3
  m( in( 0 , i , i ) ) = 1
next i
global rotx , roty , rotz , trans , temp , pi , minz
global xyz , xzy , yxz , yzx , zxy , zyx , number
rotx = 21
roty = 22
rotz = 23
trans = 24
temp = 25
pi = atn( 1 ) * 4
xyz = 0
xzy = 1
yxz = 2
yzx = 3
zxy = 4
zyx = 5
minz = -1900
global angle
winx = WindowWidth
winy = WindowHeight
pi = atn( 1 ) * 4
global red , green , yellow
global blue , magenta , cyan
red = rgb( 255 , 0 , 0 )
green = rgb( 0 , 255 , 0 )
yellow = rgb( 255 , 255 , 0 )
blue = rgb( 0 , 0 , 255 )
magenta = rgb( 255 , 0 , 255 )
cyan = rgb( 0 , 255 , 255 )
global arm , elbow , wrist , leg , knee , enkle , neck , lr
arm = 0
elbow = 1
wrist = 2
leg = 3
knee = 4
enkle = 5
neck = 6
lr = 32
graphicbox #m.lbgfx, 0,0,0,0
nomainwin
open "LBGfx 3D" for window as #m
call FixWindowSize hwnd(#m),winx,winy
#m.lbgfx "when mouseMove [move]"
#m.lbgfx "when characterInput [key]"
#m "trapclose [quit]"
#m.lbgfx "setfocus"
open DefaultDir$+"\LBGfx.dll" for dll as #lbgfx
gfx=CreateLBGfx(0,0,winx,winy _
,hwnd(#m),hwnd(#m.lbgfx))
  timer 40 , [timer]
wait
[timer]
  scan
  call lbgfx "backcolor black"
  call lbgfx "cls"

  call link 1 , 0,0,0 , 30,0,0 , xyz , 0
  call robot.walk angle , 30
  call robot.draw green , 3

  call lbgfx "flip"
  angle = angle + 10
wait
[key]
  key$ = right$( Inkey$ , 1 )
  if key$ <> chr$( 27 ) then wait
[quit]
  call DestroyLBGfx
  close #lbgfx
  close #m      'ain debugged by Gordon
end
[move]
  mouse.x = MouseX
  mouse.y = MouseY
wait

''color stuf

function rgb( r , g , b )
  r = int( r ) and 255
  g = int( g ) and 255
  b = int( b ) and 255
  rgb = r + g * 256 + b * 256 ^ 2
end function

sub setcolor kl
  r = kl and 255
  g = int( kl / 256 ) and 255
  b = int( kl / 256 ^ 2 ) and 255
  call lbgfx "color ";r;" ";g;" ";b
end sub

function  mix( kla , f , klb )
  r1 = kla and 255
  g1 = int( kla / 256 ) and 255
  b1 = int( kla / 256 ^ 2 ) and 255
  r2 = klb and 255
  g2 = int( klb / 256 ) and 255
  b2 = int( klb / 256 ^ 2 ) and 255
  r = r1 + ( r2 - r1 ) * f
  g = g1 + ( g2 - g1 ) * f
  b = b1 + ( b2 - b1 ) * f
  mix = rgb( r , g , b )
end function

''graphics

sub robot.walk a , amp
''example animation
  call skelet leg , pend( a , amp ) , 0 , 0
  call skelet knee , pend( a - 90 , amp ) + amp , 0 , 0
  call skelet leg+lr , pend( a + 180 , amp ) , 0 , 0
  call skelet knee+lr , pend( a + 90 , amp ) + amp , 0 , 0
  call skelet arm , pend( a + 180 , amp ) , 0 , 0
  call skelet elbow , 0-abs( amp ) , 0 , 0
  call skelet arm+lr , pend( a , amp ) , 0 , 0
  call skelet elbow+lr , 0-abs( amp ) , 0 , 0
end sub

sub robot.draw kl , size
''example avartar
  call cube 0,0,0 , 50,50,10 , kl , size
  call child 2 , 30,-90,0 , leg , yzx , 1
  call cube 0,-25,0 , 10,40,10 , kl , size
  call child 3 , 0,-90,0 , knee , xyz , 2
  call cube 0,-25,0 , 10,40,10 , kl , size
  call child 4 , 0,-90,0 , enkle , xzy , 3
  call cube 0,-5,-10 , 10,10,20 , kl , size
  call child 2 , -30,-90,0 , leg+lr , xyz , 1
  call cube 0,-25,0 , 10,40,10 , kl , size
  call child 3 , 0,-90,0 , knee+lr , xyz , 2
  call cube 0,-25,0 , 10,40,10 , kl , size
  call child 4 , 0,-90,0 , enkle+lr , xzy , 3
  call cube 0,-5,-10 , 10,10,20 , kl , size
  call child 2 , 0,90,0 , neck , xyz , 1
  call child 3 , 0,10,0 , neck+lr , zyx , 2
  call cube 0,0,0 , 20,20,20 , kl , size
  call child 2 , 90,40,0 , arm , xzy , 1
  call cube 0,-25,0 , 10,40,10 , kl , size
  call child 3 , 0,-90,0 , elbow , xyz , 2
  call cube 0,-25,0 , 10,40,10 , kl , size
  call child 4 , 0,-90,0 , wrist , yzx , 3
  call cube 0,-10,0 , 5,20,20 , kl , size
  call child 2 , -90,40,0 , arm+lr , xzy , 1
  call cube 0,-25,0 , 10,40,10 , kl , size
  call child 3 , 0,-90,0 , elbow+lr , xyz , 2
  call cube 0,-25,0 , 10,40,10 , kl , size
  call child 4 , 0,-90,0 , wrist+lr , yzx , 3
  call cube 0,-10,0 , 5,20,20 , kl , size
end sub

sub cube mx,my,mz , dx,dy,dz , kl , size

  call lijn mx+dx,my+dy,mz+dz , mx-dx,my+dy,mz+dz , kl , size
  call lijn mx+dx,my+dy,mz-dz , mx-dx,my+dy,mz-dz , kl , size
  call lijn mx+dx,my-dy,mz+dz , mx-dx,my-dy,mz+dz , kl , size
  call lijn mx+dx,my-dy,mz-dz , mx-dx,my-dy,mz-dz , kl , size

  call lijn mx+dx,my+dy,mz+dz , mx+dx,my-dy,mz+dz , kl , size
  call lijn mx+dx,my+dy,mz-dz , mx+dx,my-dy,mz-dz , kl , size
  call lijn mx-dx,my+dy,mz+dz , mx-dx,my-dy,mz+dz , kl , size
  call lijn mx-dx,my+dy,mz-dz , mx-dx,my-dy,mz-dz , kl , size

  call lijn mx+dx,my+dy,mz+dz , mx+dx,my+dy,mz-dz , kl , size
  call lijn mx+dx,my-dy,mz+dz , mx+dx,my-dy,mz-dz , kl , size
  call lijn mx-dx,my+dy,mz+dz , mx-dx,my+dy,mz-dz , kl , size
  call lijn mx-dx,my-dy,mz+dz , mx-dx,my-dy,mz-dz , kl , size

end sub

sub lijn x1,y1,z1 , x2,y2,z2 , kl , size
  call spot x1,y1,z1
  call spot x2,y2,z2
  if z1 < -900 then exit sub
  if z2 < -900 then exit sub
  ax = winx/2 + x1 / ( z1 + 1000 ) * 1000
  ay = winy/2 - y1 / ( z1 + 1000 ) * 1000
  bx = winx/2 + x2 / ( z2 + 1000 ) * 1000
  by = winy/2 - y2 / ( z2 + 1000 ) * 1000
  call setcolor kl
  call lbgfx "size " ; size
  call lbgfx "line " ; ax ; "  " ; ay ; " " ; bx ; " " ; by
end sub

''blua 3D engine

function range( l , h )
''calculate random number between l and h
  range = rnd( 0 ) * ( h - l ) + l
end function

sub camera x , y , z , pan , tilt , rol
''set camera coordians and angles
  cam( 0 ) = x
  cam( 1 ) = y
  cam( 2 ) = z
  cam( 3 ) = pan
  cam( 4 ) = tilt
  cam( 5 ) = rol
end sub

sub movecamera x , y , z , pan , tilt , rol
''move camera relativly
  call rotate x , y , 0 - cam( 5 )
  call rotate y , z , 0 - cam( 4 )
  call rotate x , z , 0 - cam( 3 )
  cam( 0 ) = cam( 0 ) + x
  cam( 1 ) = cam( 1 ) + y
  cam( 2 ) = cam( 2 ) + z
  cam( 3 ) = ( cam( 3 ) + pan ) mod 360
  cam( 4 ) = ( cam( 4 ) + tilt ) mod 360
  cam( 5 ) = ( cam( 5 ) + rol ) mod 360
end sub

function pend( fase , amp )
''for natural movment
  pend = sin( rad( fase ) ) * amp
end function

sub skelet lim , x , y , z
''set angles of a lim of a avatar
  if lim < 0 or lim > 64 then exit sub
  sk( lim , 0 ) = x
  sk( lim , 1 ) = y
  sk( lim , 2 ) = z
end sub

sub child no , x , y , z , lim , ax , p
''calculate a new lim matrix
  if lim < 0 or lim > 64 then exit sub
  call link no , x , y , z _
  , sk( lim , 1 ) , sk( lim , 0 ) , sk( lim , 2 ) , ax , p
end sub

sub link no , x , y , z , xz , yz , xy , ax , p
''calculate new matrix no
''folowing drawing wil use this matrix
  if no < 1 or no > 20 then exit sub
  if p < 0 or p > 20 then exit sub
  if no = p then exit sub

  call copy 0 , rotx
  call copy 0 , roty
  call copy 0 , rotz
  call copy 0 , trans

  m( in( rotx , 1 , 1 ) ) = cos( rad( yz ) )
  m( in( rotx , 1 , 2 ) ) = 0-sin( rad( yz ) )
  m( in( rotx , 2 , 1 ) ) = sin( rad( yz ) )
  m( in( rotx , 2 , 2 ) ) = cos( rad( yz ) )

  m( in( roty , 0 , 0 ) ) = cos( rad( xz ) )
  m( in( roty , 0 , 2 ) ) = 0-sin( rad( xz ) )
  m( in( roty , 2 , 0 ) ) = sin( rad( xz ) )
  m( in( roty , 2 , 2 ) ) = cos( rad( xz ) )

  m( in( rotz , 0 , 0 ) ) = cos( rad( xy ) )
  m( in( rotz , 0 , 1 ) ) = 0-sin( rad( xy ) )
  m( in( rotz , 1 , 0 ) ) = sin( rad( xy ) )
  m( in( rotz , 1 , 1 ) ) = cos( rad( xy ) )

  m( in( trans , 3 , 0 ) ) = x
  m( in( trans , 3 , 1 ) ) = y
  m( in( trans , 3 , 2 ) ) = z

  select case ax
    case xyz
      call keer rotx , roty , rotz , no , p
    case xzy
      call keer rotx , rotz , roty , no , p
    case yxz
      call keer roty , rotx , rotz , no , p
    case yzx
      call keer roty , rotz , rotx , no , p
    case zxy
      call keer rotz , rotx , roty , no , p
    case zyx
      call keer rotz , roty , rotx , no , p
    case else
      call keer rotx , roty , rorz , no , p
  end select

  number = no
end sub

sub keer a , b , c , no , p
''calculate axel matrix
  call maal a , b , temp
  call maal temp , c , no
  call maal no , trans , temp
  call maal temp , p , no
end sub

function in( no , x , y )
''to 3d array index
  in = no * 16 + x * 4 + y
end function

sub copy a , uit
''copy a matrix into uit matrix
  for i = 0 to 3
    for j = 0 to 3
      m( in( uit , i , j ) ) = m( in( a , i , j ) )
    next j
  next i
end sub

sub maal a , b , uit
''mutltiply 2 matrixes
  for i = 0 to 3
    for j = 0 to 3
      m( in( uit , i , j ) ) = 0
      for k = 0 to 3
        m( in( uit , i , j ) ) = m( in( uit , i , j ) ) _
        + m( in( a , i , k ) ) * m( in( b , k , j ) )
      next k
    next j
  next i
end sub

sub spot byref x , byref y , byref z
''from lokal coordians to world coordians
  no = number
  hx = m( in( no , 0 , 0 ) ) * x _
     + m( in( no , 1 , 0 ) ) * y _
     + m( in( no , 2 , 0 ) ) * z _
     + m( in( no , 3 , 0 ) )
  hy = m( in( no , 0 , 1 ) ) * x _
     + m( in( no , 1 , 1 ) ) * y _
     + m( in( no , 2 , 1 ) ) * z _
     + m( in( no , 3 , 1 ) )
  hz = m( in( no , 0 , 2 ) ) * x _
     + m( in( no , 1 , 2 ) ) * y _
     + m( in( no , 2 , 2 ) ) * z _
     + m( in( no , 3 , 2 ) )
  x = hx - cam( 0 )
  y = hy - cam( 1 )
  z = hz - cam( 2 )
  call rotate x , y , 0 - cam( 5 )
  call rotate y , z , 0 - cam( 4 )
  call rotate x , z , 0 - cam( 3 )
end sub

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

function rad( x )
''from degrees to radians
  rad = x * pi / 180
end function

''whit thanks to dan teel

sub lbgfx text$
  calldll #lbgfx,"graphicCommand" _
  ,gfx as ulong _
  ,text$ as ptr _
  ,ret as void
end sub

function CreateLBGfx(x,y,w,h,hParent,hMessageHandler)'Returns 0 if fail, hWnd if pass
  style=_WS_VISIBLE+_WS_CHILD+_WS_CLIPCHILDREN
  calldll #kernel32,"GetModuleHandleA",0 as ulong,instance as ulong
  calldll #user32,"CreateWindowExA",_
  0 as long,_
  "LBGfx32" as ptr,_
  0 as ulong,_
  style as ulong,_
  x as long,_
  y as long,_
  w as long,_
  h as long,_
  hParent as ulong,_
  0 as ulong,_
  instance as ulong,_
  hMessageHandler as ulong,_
  CreateLBGfx as ulong
end function

sub DestroyLBGfx
  calldll #user32, "DestroyWindow",_
  gfx as ulong, _
  ret as long
end sub

sub FixWindowSize hwnd,width,height
  struct fixrect _
    ,left as long _
    ,top as long _
    ,right as long _
    ,bottom as long
  calldll #user32,"GetClientRect" _
  ,hwnd as ulong _
  ,fixrect as struct _
  ,ret as void
  width=width-fixrect.right.struct+width
  height=height-fixrect.bottom.struct+height
  calldll #user32,"GetWindowRect" _
  ,hwnd as ulong _
  ,fixrect as struct _
  ,ret as void
  x=fixrect.left.struct
  y=fixrect.top.struct
  calldll #user32,"MoveWindow" _
  ,hwnd as ulong _
  ,x as long _
  ,y as long _
  ,width as long _
  ,height as long _
  ,1 as long _
  ,ret as void
end sub

bluatigro
 
Berichten: 306
Geregistreerd: za sep 27, 2008 6:01 pm

Re: lbgfx 3D

Berichtdoor bluatigro » ma feb 29, 2016 1:01 pm

update :
- human added
- sphere added
Code: Selecteer alles
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy , gfx
global key$ , mouse.x , mouse.y
dim m( 26 * 4 * 4 ) , cam( 6 ) , sk( 64 , 2 )
for i = 0 to 3
  m( in( 0 , i , i ) ) = 1
next i
global rotx , roty , rotz , trans , temp , pi , minz
global xyz , xzy , yxz , yzx , zxy , zyx , number
rotx = 21
roty = 22
rotz = 23
trans = 24
temp = 25
pi = atn( 1 ) * 4
xyz = 0
xzy = 1
yxz = 2
yzx = 3
zxy = 4
zyx = 5
minz = -1900
global angle
winx = WindowWidth
winy = WindowHeight
pi = atn( 1 ) * 4
global red , green , yellow
global blue , magenta , cyan
red = rgb( 255 , 0 , 0 )
green = rgb( 0 , 255 , 0 )
yellow = rgb( 255 , 255 , 0 )
blue = rgb( 0 , 0 , 255 )
magenta = rgb( 255 , 0 , 255 )
cyan = rgb( 0 , 255 , 255 )
global arm , elbow , wrist , leg , knee , enkle , neck , lr
arm = 0
elbow = 1
wrist = 2
leg = 3
knee = 4
enkle = 5
neck = 6
lr = 32
graphicbox #m.lbgfx, 0,0,0,0
nomainwin
open "LBGfx 3D" for window as #m
call FixWindowSize hwnd(#m),winx,winy
#m.lbgfx "when mouseMove [move]"
#m.lbgfx "when characterInput [key]"
#m "trapclose [quit]"
#m.lbgfx "setfocus"
open DefaultDir$+"\LBGfx.dll" for dll as #lbgfx
gfx=CreateLBGfx(0,0,winx,winy _
,hwnd(#m),hwnd(#m.lbgfx))
  timer 40 , [timer]
wait
[timer]
  scan
  call lbgfx "backcolor black"
  call lbgfx "cls"

  call link 1 , -300,0,0 , 45,0,0 , xyz , 0
  call animation.walk angle , 30
  call robot.draw red , 3

  call link 1 , 0,0,0 , 0,0,0 , xyz , 0
  call animation.walk angle , 45
  call human.draw green , 1

  call link 1 , 300,0,0 , -30,0,0 , xyz , 0
  call animation.walk angle , 10
  call human.draw blue , 5

  call lbgfx "flip"
  angle = angle + 10
wait
[key]
  key$ = right$( Inkey$ , 1 )
  if key$ <> chr$( 27 ) then wait
[quit]
  call DestroyLBGfx
  close #lbgfx
  close #m      'ain debugged by Gordon
end
[move]
  mouse.x = MouseX
  mouse.y = MouseY
wait

''color stuf

function rgb( r , g , b )
  r = int( r ) and 255
  g = int( g ) and 255
  b = int( b ) and 255
  rgb = r + g * 256 + b * 256 ^ 2
end function

sub setcolor kl
  r = kl and 255
  g = int( kl / 256 ) and 255
  b = int( kl / 256 ^ 2 ) and 255
  call lbgfx "color ";r;" ";g;" ";b
end sub

function  mix( kla , f , klb )
  r1 = kla and 255
  g1 = int( kla / 256 ) and 255
  b1 = int( kla / 256 ^ 2 ) and 255
  r2 = klb and 255
  g2 = int( klb / 256 ) and 255
  b2 = int( klb / 256 ^ 2 ) and 255
  r = r1 + ( r2 - r1 ) * f
  g = g1 + ( g2 - g1 ) * f
  b = b1 + ( b2 - b1 ) * f
  mix = rgb( r , g , b )
end function

''graphics

sub animation.walk a , amp
''example animation
  call skelet leg , pend( a , amp ) , 0 , 0
  call skelet knee , pend( a - 90 , amp ) + amp , 0 , 0
  call skelet leg+lr , pend( a + 180 , amp ) , 0 , 0
  call skelet knee+lr , pend( a + 90 , amp ) + amp , 0 , 0
  call skelet arm , pend( a + 180 , amp ) , 0 , 0
  call skelet elbow , 0-abs( amp ) , 0 , 0
  call skelet arm+lr , pend( a , amp ) , 0 , 0
  call skelet elbow+lr , 0-abs( amp ) , 0 , 0
end sub

sub human.draw kl , size
''example avatar whit minimal drawing
  call lijn 0,0,0 , 0,80,0 , kl , size
  call lijn -30,80,0 , 30,80,0 , kl , size
  call lijn -20,0,0 , 20,0,0 , kl , size
  call child 2 , 30,80,0 , arm , xzy , 1
  call lijn 0,0,0 , 0,-40,0 , kl , size
  call child 3 , 0,-40,0 , elbow , xyz , 2
  call lijn 0,0,0 , 0,-40,0 , kl , size
  call child 4 , 0,-40,0 , wrist , yzx , 3
  call sphere 0,-10,0 , 10 , kl , size
  call child 2 , -30,80,0 , arm+lr , xzy , 1
  call lijn 0,0,0 , 0,-40,0 , kl , size
  call child 3 , 0,-40,0 , elbow+lr , xyz , 2
  call lijn 0,0,0 , 0,-40,0 , kl , size
  call child 4 , 0,-40,0 , wrist+lr , yzx , 3
  call sphere 0,-10,0 , 10 , kl , size
  call child 2 , 0,90,0 , neck , xyz , 1
  call child 3 , 0,20,0 , neck+lr , zyx , 2
  call sphere 0,0,0 , 20 , kl , size
  call child 2 , 20,0,0 , leg , zyx , 1
  call lijn 0,0,0 , 0,-40,0 , kl , size
  call child 3 , 0,-40,0 , knee , xyz , 2
  call lijn 0,0,0 , 0,-40,0 , kl , size
  call child 4 , 0,-40,0 , enkle , xyz , 3
  call lijn 0,0,0 , 0,0,-20 , kl , size
  call child 2 , -20,0,0 , leg+lr , zyx , 1
  call lijn 0,0,0 , 0,-40,0 , kl , size
  call child 3 , 0,-40,0 , knee+lr , xyz , 2
  call lijn 0,0,0 , 0,-40,0 , kl , size
  call child 4 , 0,-40,0 , enkle+lr , xyz , 3
  call lijn 0,0,0 , 0,0,-20 , kl , size
end sub

sub robot.draw kl , size
''example avartar
  call cube 0,0,0 , 50,50,10 , kl , size
  call child 2 , 30,-90,0 , leg , yzx , 1
  call cube 0,-25,0 , 10,40,10 , kl , size
  call child 3 , 0,-90,0 , knee , xyz , 2
  call cube 0,-25,0 , 10,40,10 , kl , size
  call child 4 , 0,-90,0 , enkle , xzy , 3
  call cube 0,-5,-10 , 10,10,20 , kl , size
  call child 2 , -30,-90,0 , leg+lr , xyz , 1
  call cube 0,-25,0 , 10,40,10 , kl , size
  call child 3 , 0,-90,0 , knee+lr , xyz , 2
  call cube 0,-25,0 , 10,40,10 , kl , size
  call child 4 , 0,-90,0 , enkle+lr , xzy , 3
  call cube 0,-5,-10 , 10,10,20 , kl , size
  call child 2 , 0,90,0 , neck , xyz , 1
  call child 3 , 0,10,0 , neck+lr , zyx , 2
  call cube 0,0,0 , 20,20,20 , kl , size
  call child 2 , 90,40,0 , arm , xzy , 1
  call cube 0,-25,0 , 10,40,10 , kl , size
  call child 3 , 0,-90,0 , elbow , xyz , 2
  call cube 0,-25,0 , 10,40,10 , kl , size
  call child 4 , 0,-90,0 , wrist , yzx , 3
  call cube 0,-10,0 , 5,20,20 , kl , size
  call child 2 , -90,40,0 , arm+lr , xzy , 1
  call cube 0,-25,0 , 10,40,10 , kl , size
  call child 3 , 0,-90,0 , elbow+lr , xyz , 2
  call cube 0,-25,0 , 10,40,10 , kl , size
  call child 4 , 0,-90,0 , wrist+lr , yzx , 3
  call cube 0,-10,0 , 5,20,20 , kl , size
end sub

sub cube mx,my,mz , dx,dy,dz , kl , size

  call lijn mx+dx,my+dy,mz+dz , mx-dx,my+dy,mz+dz , kl , size
  call lijn mx+dx,my+dy,mz-dz , mx-dx,my+dy,mz-dz , kl , size
  call lijn mx+dx,my-dy,mz+dz , mx-dx,my-dy,mz+dz , kl , size
  call lijn mx+dx,my-dy,mz-dz , mx-dx,my-dy,mz-dz , kl , size

  call lijn mx+dx,my+dy,mz+dz , mx+dx,my-dy,mz+dz , kl , size
  call lijn mx+dx,my+dy,mz-dz , mx+dx,my-dy,mz-dz , kl , size
  call lijn mx-dx,my+dy,mz+dz , mx-dx,my-dy,mz+dz , kl , size
  call lijn mx-dx,my+dy,mz-dz , mx-dx,my-dy,mz-dz , kl , size

  call lijn mx+dx,my+dy,mz+dz , mx+dx,my+dy,mz-dz , kl , size
  call lijn mx+dx,my-dy,mz+dz , mx+dx,my-dy,mz-dz , kl , size
  call lijn mx-dx,my+dy,mz+dz , mx-dx,my+dy,mz-dz , kl , size
  call lijn mx-dx,my-dy,mz+dz , mx-dx,my-dy,mz-dz , kl , size

end sub

sub lijn x1,y1,z1 , x2,y2,z2 , kl , size
  call spot x1,y1,z1
  call spot x2,y2,z2
  if z1 < -900 then exit sub
  if z2 < -900 then exit sub
  ax = winx/2 + x1 / ( z1 + 1000 ) * 1000
  ay = winy/2 - y1 / ( z1 + 1000 ) * 1000
  bx = winx/2 + x2 / ( z2 + 1000 ) * 1000
  by = winy/2 - y2 / ( z2 + 1000 ) * 1000
  call setcolor kl
  call lbgfx "size " ; size
  call lbgfx "line " ; ax ; "  " ; ay ; " " ; bx ; " " ; by
end sub

sub sphere x , y , z , d , kl , size
  call spot x , y , z
  if z < -900 then exit sub
  a = winx/2 + x / ( z + 1000 ) * 1000
  b = winy/2 - y / ( z + 1000 ) * 1000
  d = d / ( z + 1000 ) * 1000
  call setcolor kl
  call lbgfx "size " ; size
  call lbgfx "circle ";a;" ";b;" ";d
end sub

''blua 3D engine

function range( l , h )
''calculate random number between l and h
  range = rnd( 0 ) * ( h - l ) + l
end function

sub camera x , y , z , pan , tilt , rol
''set camera coordians and angles
  cam( 0 ) = x
  cam( 1 ) = y
  cam( 2 ) = z
  cam( 3 ) = pan
  cam( 4 ) = tilt
  cam( 5 ) = rol
end sub

sub movecamera x , y , z , pan , tilt , rol
''move camera relativly
  call rotate x , y , 0 - cam( 5 )
  call rotate y , z , 0 - cam( 4 )
  call rotate x , z , 0 - cam( 3 )
  cam( 0 ) = cam( 0 ) + x
  cam( 1 ) = cam( 1 ) + y
  cam( 2 ) = cam( 2 ) + z
  cam( 3 ) = ( cam( 3 ) + pan ) mod 360
  cam( 4 ) = ( cam( 4 ) + tilt ) mod 360
  cam( 5 ) = ( cam( 5 ) + rol ) mod 360
end sub

function pend( fase , amp )
''for natural movment
  pend = sin( rad( fase ) ) * amp
end function

sub skelet lim , x , y , z
''set angles of a lim of a avatar
  if lim < 0 or lim > 64 then exit sub
  sk( lim , 0 ) = x
  sk( lim , 1 ) = y
  sk( lim , 2 ) = z
end sub

sub child no , x , y , z , lim , ax , p
''calculate a new lim matrix
  if lim < 0 or lim > 64 then exit sub
  call link no , x , y , z _
  , sk( lim , 1 ) , sk( lim , 0 ) , sk( lim , 2 ) , ax , p
end sub

sub link no , x , y , z , xz , yz , xy , ax , p
''calculate new matrix no
''folowing drawing wil use this matrix
  if no < 1 or no > 20 then exit sub
  if p < 0 or p > 20 then exit sub
  if no = p then exit sub

  call copy 0 , rotx
  call copy 0 , roty
  call copy 0 , rotz
  call copy 0 , trans

  m( in( rotx , 1 , 1 ) ) = cos( rad( yz ) )
  m( in( rotx , 1 , 2 ) ) = 0-sin( rad( yz ) )
  m( in( rotx , 2 , 1 ) ) = sin( rad( yz ) )
  m( in( rotx , 2 , 2 ) ) = cos( rad( yz ) )

  m( in( roty , 0 , 0 ) ) = cos( rad( xz ) )
  m( in( roty , 0 , 2 ) ) = 0-sin( rad( xz ) )
  m( in( roty , 2 , 0 ) ) = sin( rad( xz ) )
  m( in( roty , 2 , 2 ) ) = cos( rad( xz ) )

  m( in( rotz , 0 , 0 ) ) = cos( rad( xy ) )
  m( in( rotz , 0 , 1 ) ) = 0-sin( rad( xy ) )
  m( in( rotz , 1 , 0 ) ) = sin( rad( xy ) )
  m( in( rotz , 1 , 1 ) ) = cos( rad( xy ) )

  m( in( trans , 3 , 0 ) ) = x
  m( in( trans , 3 , 1 ) ) = y
  m( in( trans , 3 , 2 ) ) = z

  select case ax
    case xyz
      call keer rotx , roty , rotz , no , p
    case xzy
      call keer rotx , rotz , roty , no , p
    case yxz
      call keer roty , rotx , rotz , no , p
    case yzx
      call keer roty , rotz , rotx , no , p
    case zxy
      call keer rotz , rotx , roty , no , p
    case zyx
      call keer rotz , roty , rotx , no , p
    case else
      call keer rotx , roty , rorz , no , p
  end select

  number = no
end sub

sub keer a , b , c , no , p
''calculate axel matrix
  call maal a , b , temp
  call maal temp , c , no
  call maal no , trans , temp
  call maal temp , p , no
end sub

function in( no , x , y )
''to 3d array index
  in = no * 16 + x * 4 + y
end function

sub copy a , uit
''copy a matrix into uit matrix
  for i = 0 to 3
    for j = 0 to 3
      m( in( uit , i , j ) ) = m( in( a , i , j ) )
    next j
  next i
end sub

sub maal a , b , uit
''mutltiply 2 matrixes
  for i = 0 to 3
    for j = 0 to 3
      m( in( uit , i , j ) ) = 0
      for k = 0 to 3
        m( in( uit , i , j ) ) = m( in( uit , i , j ) ) _
        + m( in( a , i , k ) ) * m( in( b , k , j ) )
      next k
    next j
  next i
end sub

sub spot byref x , byref y , byref z
''from lokal coordians to world coordians
  no = number
  hx = m( in( no , 0 , 0 ) ) * x _
     + m( in( no , 1 , 0 ) ) * y _
     + m( in( no , 2 , 0 ) ) * z _
     + m( in( no , 3 , 0 ) )
  hy = m( in( no , 0 , 1 ) ) * x _
     + m( in( no , 1 , 1 ) ) * y _
     + m( in( no , 2 , 1 ) ) * z _
     + m( in( no , 3 , 1 ) )
  hz = m( in( no , 0 , 2 ) ) * x _
     + m( in( no , 1 , 2 ) ) * y _
     + m( in( no , 2 , 2 ) ) * z _
     + m( in( no , 3 , 2 ) )
  x = hx - cam( 0 )
  y = hy - cam( 1 )
  z = hz - cam( 2 )
  call rotate x , y , 0 - cam( 5 )
  call rotate y , z , 0 - cam( 4 )
  call rotate x , z , 0 - cam( 3 )
end sub

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

function rad( x )
''from degrees to radians
  rad = x * pi / 180
end function

''whit thanks to dan teel

sub lbgfx text$
  calldll #lbgfx,"graphicCommand" _
  ,gfx as ulong _
  ,text$ as ptr _
  ,ret as void
end sub

function CreateLBGfx(x,y,w,h,hParent,hMessageHandler)'Returns 0 if fail, hWnd if pass
  style=_WS_VISIBLE+_WS_CHILD+_WS_CLIPCHILDREN
  calldll #kernel32,"GetModuleHandleA",0 as ulong,instance as ulong
  calldll #user32,"CreateWindowExA",_
  0 as long,_
  "LBGfx32" as ptr,_
  0 as ulong,_
  style as ulong,_
  x as long,_
  y as long,_
  w as long,_
  h as long,_
  hParent as ulong,_
  0 as ulong,_
  instance as ulong,_
  hMessageHandler as ulong,_
  CreateLBGfx as ulong
end function

sub DestroyLBGfx
  calldll #user32, "DestroyWindow",_
  gfx as ulong, _
  ret as long
end sub

sub FixWindowSize hwnd,width,height
  struct fixrect _
    ,left as long _
    ,top as long _
    ,right as long _
    ,bottom as long
  calldll #user32,"GetClientRect" _
  ,hwnd as ulong _
  ,fixrect as struct _
  ,ret as void
  width=width-fixrect.right.struct+width
  height=height-fixrect.bottom.struct+height
  calldll #user32,"GetWindowRect" _
  ,hwnd as ulong _
  ,fixrect as struct _
  ,ret as void
  x=fixrect.left.struct
  y=fixrect.top.struct
  calldll #user32,"MoveWindow" _
  ,hwnd as ulong _
  ,x as long _
  ,y as long _
  ,width as long _
  ,height as long _
  ,1 as long _
  ,ret as void
end sub

bluatigro
 
Berichten: 306
Geregistreerd: za sep 27, 2008 6:01 pm

Re: lbgfx 3D

Berichtdoor bluatigro » za maart 26, 2016 3:24 pm

update :
- nu met schaduw
- now whit shadow

Code: Selecteer alles
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy , gfx
global key$ , mouse.x , mouse.y
dim m( 26 * 4 * 4 ) , cam( 6 ) , sk( 64 , 2 )
for i = 0 to 3
  m( in( 0 , i , i ) ) = 1
next i
global rotx , roty , rotz , trans , temp , pi , minz
global xyz , xzy , yxz , yzx , zxy , zyx , number
global b.x , b.y , b.z , b.dx , b.dy , b.dz
rotx = 21
roty = 22
rotz = 23
trans = 24
temp = 25
pi = atn( 1 ) * 4
xyz = 0
xzy = 1
yxz = 2
yzx = 3
zxy = 4
zyx = 5
minz = -1900
global tritel , trimax , angle
trimax = 100
dim t( trimax , 15 ) , ry( trimax )
dim pnt( 256 , 2)
for i = 0 to trimax
  ry( i ) = i
next i
winx = WindowWidth
winy = WindowHeight
pi = atn( 1 ) * 4
global red , green , yellow
global blue , magenta , cyan
red = rgb( 255 , 0 , 0 )
green = rgb( 0 , 255 , 0 )
yellow = rgb( 255 , 255 , 0 )
blue = rgb( 0 , 0 , 255 )
magenta = rgb( 255 , 0 , 255 )
cyan = rgb( 0 , 255 , 255 )
graphicbox #m.lbgfx, 0,0,0,0
nomainwin
open "LBGfx 3D" for window as #m
call FixWindowSize hwnd(#m),winx,winy
#m.lbgfx "when mouseMove [move]"
#m.lbgfx "when characterInput [key]"
#m "trapclose [quit]"
#m.lbgfx "setfocus"
open DefaultDir$+"\LBGfx.dll" for dll as #lbgfx
gfx=CreateLBGfx(0,0,winx,winy _
,hwnd(#m),hwnd(#m.lbgfx))
  timer 40 , [timer]
wait
[timer]
  scan
  tritel = 0
  call lbgfx "backcolor black"
  call lbgfx "cls"

''  call skelet 0 , pend( angle , 30 ) , 0 , 0
''  call skelet 1 , pend( angle - 90 , 30 ) + 30 , 0 , 0
''  call skelet 2 , pend( angle + 180 , 30 ) , 0 , 0
''  call skelet 3 , pend( angle + 90 , 30 ) + 30 , 0 , 0

  call link 1 , 0,0,0 , angle,0,0 , xyz , 0
  call setbox 0,0,0 , 50,50,50
  call cube cyan,cyan,cyan,cyan,cyan,cyan
''  call child 2 , 30,-90,0 , 0 , xyz , 1
''  call setbox 0,-25,0 , 10,40,10
''  call colorcube
''  call child 3 , 0,-90,0 , 1 , xyz , 2
''  call setbox 0,-25,0 , 10,40,10
''  call colorcube
''  call child 2 , -30,-90,0 , 2 , xyz , 1
''  call setbox 0,-25,0 , 10,40,10
''  call colorcube
''  call child 3 , 0,-90,0 , 3 , xyz , 2
''  call setbox 0,-25,0 , 10,40,10
''  call colorcube

  call drawall
  angle = angle + 5
wait
[key]
  key$ = right$( Inkey$ , 1 )
  if key$ <> chr$( 27 ) then wait
[quit]
  call DestroyLBGfx
  close #lbgfx
  close #m      'ain debugged by Gordon
end
[move]
  mouse.x = MouseX
  mouse.y = MouseY
wait

''color stuf

function rgb( r , g , b )
  r = int( r ) and 255
  g = int( g ) and 255
  b = int( b ) and 255
  rgb = r + g * 256 + b * 256 ^ 2
end function

sub setcolor kl
  r = kl and 255
  g = int( kl / 256 ) and 255
  b = int( kl / 256 ^ 2 ) and 255
  call lbgfx "color ";r;" ";g;" ";b
  call lbgfx "backcolor ";r;" ";g;" ";b
end sub

function  mix( kla , f , klb )
  r1 = kla and 255
  g1 = int( kla / 256 ) and 255
  b1 = int( kla / 256 ^ 2 ) and 255
  r2 = klb and 255
  g2 = int( klb / 256 ) and 255
  b2 = int( klb / 256 ^ 2 ) and 255
  r = r1 + ( r2 - r1 ) * f
  g = g1 + ( g2 - g1 ) * f
  b = b1 + ( b2 - b1 ) * f
  mix = rgb( r , g , b )
end function

''shapes

sub setbox x , y , z , dx , dy , dz
''set bounding box
  b.x = x
  b.y = y
  b.z = z
  b.dx = dx
  b.dy = dy
  b.dz = dz
end sub

sub colorcube
  call cube red , green , blue , cyan , magenta , yellow
end sub

sub cube l , b , f , r , t , bk
''create cube whit 6 colors and size from boundingbox
  call setpoint 0 , b.x-b.dx , b.y-b.dy , b.z-b.dz
  call setpoint 1 , b.x-b.dx , b.y-b.dy , b.z+b.dz
  call setpoint 2 , b.x-b.dx , b.y+b.dy , b.z-b.dz
  call setpoint 3 , b.x-b.dx , b.y+b.dy , b.z+b.dz
  call setpoint 4 , b.x+b.dx , b.y-b.dy , b.z-b.dz
  call setpoint 5 , b.x+b.dx , b.y-b.dy , b.z+b.dz
  call setpoint 6 , b.x+b.dx , b.y+b.dy , b.z-b.dz
  call setpoint 7 , b.x+b.dx , b.y+b.dy , b.z+b.dz
  call quad 0 , 1 , 3 , 2 , l
  call quad 7 , 6 , 4 , 5 , r
  call quad 0 , 1 , 5 , 4 , b
  call quad 7 , 6 , 2 , 3 , t
  call quad 0 , 2 , 6 , 4 , f
  call quad 7 , 5 , 1 , 3 , bk
end sub

''triangle stuf

sub setpoint no , x , y , z
''set point in the swarm
  call spot x , y , z
  pnt( no , 0 ) = x
  pnt( no , 1 ) = y
  pnt( no , 2 ) = z
end sub

sub tri p1 , p2 , p3 , kl
''create a triangle from points in the swarm
  if tritel > trimax then exit sub
  t( tritel , 0 ) = pnt( p1 , 0 )
  t( tritel , 1 ) = pnt( p1 , 1 )
  t( tritel , 2 ) = pnt( p1 , 2 )
  t( tritel , 3 ) = pnt( p2 , 0 )
  t( tritel , 4 ) = pnt( p2 , 1 )
  t( tritel , 5 ) = pnt( p2 , 2 )
  t( tritel , 6 ) = pnt( p3 , 0 )
  t( tritel , 7 ) = pnt( p3 , 1 )
  t( tritel , 8 ) = pnt( p3 , 2 )
  t( tritel , 9 ) = kl
  x = (pnt(p1,0)+pnt(p2,0)+pnt(p3,0))/3
  y = (pnt(p1,1)+pnt(p2,1)+pnt(p3,1))/3
  z = (pnt(p1,2)+pnt(p2,2)+pnt(p3,2))/3
  t( tritel , 10 ) = x
  t( tritel , 11 ) = y
  t( tritel , 12 ) = z
''calculate normal of triangle
  x1 = pnt(p2,0)-pnt(p1,0)
  y1 = pnt(p2,1)-pnt(p1,1)
  z1 = pnt(p2,2)-pnt(p1,2)
  x2 = pnt(p3,0)-pnt(p1,0)
  y2 = pnt(p3,1)-pnt(p1,1)
  z2 = pnt(p3,2)-pnt(p1,2)
  x = y1 * z2 - y2 * z1
  y = z1 * x2 - z2 * x1
  z = x1 * y2 - x2 * y1
  t( tritel , 13 ) = x
  t( tritel , 14 ) = y
  t( tritel , 15 ) = z
  tritel = tritel + 1
end sub

sub quad p1 , p2 , p3 , p4 , kl
''create a quadangle from points in the swarm
  call tri p1 , p2 , p3 , kl
  call tri p1 , p3 , p4 , kl
end sub

sub tri.draw no
''draw a triangle
  x1 = t( no , 0 )
  y1 = t( no , 1 )
  z1 = t( no , 2 )
  x2 = t( no , 3 )
  y2 = t( no , 4 )
  z2 = t( no , 5 )
  x3 = t( no , 6 )
  y3 = t( no , 7 )
  z3 = t( no , 8 )
  kl = t( no , 9 )
  x = t( no , 13 )
  y = t( no , 14 )
  z = t( no , 15 )
  if z1 < minz then exit sub
  if z2 < minz then exit sub
  if z3 < minz then exit sub
  if length( x , y , z ) > 0 then
    a = getangle( x,y,z , 0,1,0 )
    kl = mix( kl , cos( a ) / 2 + .5 , 0 )
  end if
  call setcolor kl
  a1 = winx / 2 + x1 / ( z1 + 2000 ) * 2000
  b1 = winy / 2 - y1 / ( z1 + 2000 ) * 2000
  a2 = winx / 2 + x2 / ( z2 + 2000 ) * 2000
  b2 = winy / 2 - y2 / ( z2 + 2000 ) * 2000
  a3 = winx / 2 + x3 / ( z3 + 2000 ) * 2000
  b3 = winy / 2 - y3 / ( z3 + 2000 ) * 2000
  call lbgfx "polyfilled ";a1;" ";b1 _
                      ;" ";a2;" ";b2 _
                      ;" ";a3;" ";b3
end sub

sub drawall
  for h = 1 to tritel - 1
    for l = 0 to h - 1
      if t(ry(l),12)<t(ry(h),12) then
        help = ry( h )
        ry(h)=ry(l)
        ry(l) = help
      end if
    next l
  next h
  for i = 0 to tritel
    call tri.draw ry(i)
  next i
  call lbgfx "flip"
end sub

function length( a , b , c )
  length = sqr(a^2+b^2+c^2)
end function

function dot( a,b,c , d,e,f )
  dot = a*d+b*e+c*f
end function

function getangle( a,b,c , d,e,f )
  la = length( a,b,c )
  lb = length( d,e,f )
  d = dot( a,b,c , d,e,f )
  getangle = acs( d / ( la * lb ) )
end function

''blua 3D engine

function range( l , h )
''calculate random number between l and h
  range = rnd( 0 ) * ( h - l ) + l
end function

sub camera x , y , z , pan , tilt , rol
''set camera coordians and angles
  cam( 0 ) = x
  cam( 1 ) = y
  cam( 2 ) = z
  cam( 3 ) = pan
  cam( 4 ) = tilt
  cam( 5 ) = rol
end sub

sub movecamera x , y , z , pan , tilt , rol
''move camera relativly
  call rotate x , y , 0 - cam( 5 )
  call rotate y , z , 0 - cam( 4 )
  call rotate x , z , 0 - cam( 3 )
  cam( 0 ) = cam( 0 ) + x
  cam( 1 ) = cam( 1 ) + y
  cam( 2 ) = cam( 2 ) + z
  cam( 3 ) = ( cam( 3 ) + pan ) mod 360
  cam( 4 ) = ( cam( 4 ) + tilt ) mod 360
  cam( 5 ) = ( cam( 5 ) + rol ) mod 360
end sub

function pend( fase , amp )
''for natural movment
  pend = sin( rad( fase ) ) * amp
end function

sub skelet lim , x , y , z
''set angles of a lim of a avatar
  if lim < 0 or lim > 64 then exit sub
  sk( lim , 0 ) = x
  sk( lim , 1 ) = y
  sk( lim , 2 ) = z
end sub

sub child no , x , y , z , lim , ax , p
''calculate a new lim matrix
  if lim < 0 or lim > 64 then exit sub
  call link no , x , y , z _
  , sk( lim , 1 ) , sk( lim , 0 ) , sk( lim , 2 ) , ax , p
end sub

sub link no , x , y , z , xz , yz , xy , ax , p
''calculate new matrix no
''folowing drawing wil use this matrix
  if no < 1 or no > 20 then exit sub
  if p < 0 or p > 20 then exit sub
  if no = p then exit sub

  call copy 0 , rotx
  call copy 0 , roty
  call copy 0 , rotz
  call copy 0 , trans

  m( in( rotx , 1 , 1 ) ) = cos( rad( yz ) )
  m( in( rotx , 1 , 2 ) ) = 0-sin( rad( yz ) )
  m( in( rotx , 2 , 1 ) ) = sin( rad( yz ) )
  m( in( rotx , 2 , 2 ) ) = cos( rad( yz ) )

  m( in( roty , 0 , 0 ) ) = cos( rad( xz ) )
  m( in( roty , 0 , 2 ) ) = 0-sin( rad( xz ) )
  m( in( roty , 2 , 0 ) ) = sin( rad( xz ) )
  m( in( roty , 2 , 2 ) ) = cos( rad( xz ) )

  m( in( rotz , 0 , 0 ) ) = cos( rad( xy ) )
  m( in( rotz , 0 , 1 ) ) = 0-sin( rad( xy ) )
  m( in( rotz , 1 , 0 ) ) = sin( rad( xy ) )
  m( in( rotz , 1 , 1 ) ) = cos( rad( xy ) )

  m( in( trans , 3 , 0 ) ) = x
  m( in( trans , 3 , 1 ) ) = y
  m( in( trans , 3 , 2 ) ) = z

  select case ax
    case xyz
      call keer rotx , roty , rotz , no , p
    case xzy
      call keer rotx , rotz , roty , no , p
    case yxz
      call keer roty , rotx , rotz , no , p
    case yzx
      call keer roty , rotz , rotx , no , p
    case zxy
      call keer rotz , rotx , roty , no , p
    case zyx
      call keer rotz , roty , rotx , no , p
    case else
      call keer rotx , roty , rorz , no , p
  end select

  number = no
end sub

sub keer a , b , c , no , p
''calculate axel matrix
  call maal a , b , temp
  call maal temp , c , no
  call maal no , trans , temp
  call maal temp , p , no
end sub

function in( no , x , y )
''to 3d array index
  in = no * 16 + x * 4 + y
end function

sub copy a , uit
''copy a matrix into uit matrix
  for i = 0 to 3
    for j = 0 to 3
      m( in( uit , i , j ) ) = m( in( a , i , j ) )
    next j
  next i
end sub

sub maal a , b , uit
''mutltiply 2 matrixes
  for i = 0 to 3
    for j = 0 to 3
      m( in( uit , i , j ) ) = 0
      for k = 0 to 3
        m( in( uit , i , j ) ) = m( in( uit , i , j ) ) _
        + m( in( a , i , k ) ) * m( in( b , k , j ) )
      next k
    next j
  next i
end sub

sub spot byref x , byref y , byref z
''from lokal coordians to world coordians
  no = number
  hx = m( in( no , 0 , 0 ) ) * x _
     + m( in( no , 1 , 0 ) ) * y _
     + m( in( no , 2 , 0 ) ) * z _
     + m( in( no , 3 , 0 ) )
  hy = m( in( no , 0 , 1 ) ) * x _
     + m( in( no , 1 , 1 ) ) * y _
     + m( in( no , 2 , 1 ) ) * z _
     + m( in( no , 3 , 1 ) )
  hz = m( in( no , 0 , 2 ) ) * x _
     + m( in( no , 1 , 2 ) ) * y _
     + m( in( no , 2 , 2 ) ) * z _
     + m( in( no , 3 , 2 ) )
  x = hx - cam( 0 )
  y = hy - cam( 1 )
  z = hz - cam( 2 )
  call rotate x , y , 0 - cam( 5 )
  call rotate y , z , 0 - cam( 4 )
  call rotate x , z , 0 - cam( 3 )
end sub

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

function rad( x )
''from degrees to radians
  rad = x * pi / 180
end function

''whit thanks to dan teel

sub lbgfx text$
  calldll #lbgfx,"graphicCommand" _
  ,gfx as ulong _
  ,text$ as ptr _
  ,ret as void
end sub

function CreateLBGfx(x,y,w,h,hParent,hMessageHandler)'Returns 0 if fail, hWnd if pass
  style=_WS_VISIBLE+_WS_CHILD+_WS_CLIPCHILDREN
  calldll #kernel32,"GetModuleHandleA",0 as ulong,instance as ulong
  calldll #user32,"CreateWindowExA",_
  0 as long,_
  "LBGfx32" as ptr,_
  0 as ulong,_
  style as ulong,_
  x as long,_
  y as long,_
  w as long,_
  h as long,_
  hParent as ulong,_
  0 as ulong,_
  instance as ulong,_
  hMessageHandler as ulong,_
  CreateLBGfx as ulong
end function

sub DestroyLBGfx
  calldll #user32, "DestroyWindow",_
  gfx as ulong, _
  ret as long
end sub

sub FixWindowSize hwnd,width,height
  struct fixrect _
    ,left as long _
    ,top as long _
    ,right as long _
    ,bottom as long
  calldll #user32,"GetClientRect" _
  ,hwnd as ulong _
  ,fixrect as struct _
  ,ret as void
  width=width-fixrect.right.struct+width
  height=height-fixrect.bottom.struct+height
  calldll #user32,"GetWindowRect" _
  ,hwnd as ulong _
  ,fixrect as struct _
  ,ret as void
  x=fixrect.left.struct
  y=fixrect.top.struct
  calldll #user32,"MoveWindow" _
  ,hwnd as ulong _
  ,x as long _
  ,y as long _
  ,width as long _
  ,height as long _
  ,1 as long _
  ,ret as void
end sub

bluatigro
 
Berichten: 306
Geregistreerd: za sep 27, 2008 6:01 pm

Re: lbgfx 3D

Berichtdoor Gordon » ma apr 11, 2016 6:13 pm

Hallo,

De versie met schaduw crasht bij mij.

Er lijkt iets met de kleuren functie aan de hand te zijn?


Gordon
Avatar gebruiker
Gordon
Site Admin
 
Berichten: 684
Geregistreerd: zo mei 22, 2005 12:50 am

Re: lbgfx 3D

Berichtdoor bluatigro » ma mei 23, 2016 9:24 am

poging tot space game
ik heb de shaduw maar uitgezet
ivm chrashing

info :
cursor keys : links rechts omhoog omlaag
muis : draailinks draairechts vooruit achteruit

Code: Selecteer alles
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy , gfx , pi
global key$ , mouse.x , mouse.y
winx = WindowWidth
winy = WindowHeight
pi = atn( 1 ) * 4
global red , green , yellow
global blue , magenta , cyan
red = rgb( 255 , 0 , 0 )
green = rgb( 0 , 255 , 0 )
yellow = rgb( 255 , 255 , 0 )
blue = rgb( 0 , 0 , 255 )
magenta = rgb( 255 , 0 , 255 )
cyan = rgb( 0 , 255 , 255 )
dim cam( 6 ) , pen( 6 )
dim pnt( 255 , 2 ) , t( 200 , 13 ) , ry( 200 ) , b(6)
global k.max , t.max , t.tel , angle
k.max = 10
t.max = 200
for i = 0 to t.max
  ry(i) = i
next i
dim k.x(k.max) , k.y(k.max) , k.z(k.max)
dim k.p(k.max) , k.t(k.max) , k.r(k.max)
dim k.st(k.max) , k.tel(k.max)
for i = 0 to k.max
  k.x(i) = range(-500,500)
  k.y(i) = range(-300,300)
  k.z(i) = range(-500,500)
  k.p(i) = range(0,360)
  k.st(i) = range(0,2)
  k.tel(i) = range(10,50)
next i
graphicbox #m.lbgfx, 0,0,0,0
nomainwin
open "lbgfx : star trek | war 3D" for window as #m
call FixWindowSize hwnd(#m),winx,winy
#m.lbgfx "when mouseMove [move]"
#m.lbgfx "when characterInput [key]"
#m "trapclose [quit]"
#m.lbgfx "setfocus"
open DefaultDir$+"\LBGfx.dll" for dll as #lbgfx
gfx=CreateLBGfx(0,0,winx,winy _
,hwnd(#m),hwnd(#m.lbgfx))
  timer 40 , [timer]
wait
[timer]
  call lbgfx "backcolor black"
  call lbgfx "cls"
  t.tel = 0
  for i = 0 to k.max
    call pen k.x(i),k.y(i),k.z(i) , k.p(i),0,0
    call ship
    dx = 0
    dz = 5
    call rotate dx , dz , k.p(i)
    k.x(i) = k.x(i)+dx
    k.z(i) = k.z(i)+dz
    if k.x(i) < -500 then k.x(i) = 500
    if k.x(i) > 500 then k.x(i) = -500
    if k.z(i) < -500 then k.z(i) = 500
    if k.z(i) > 500 then k.z(i) = -500
  next i

  select case key$
    case chr$( _VK_UP )
      call movecam 0,5,0 , 0,0,0
    case chr$( _VK_DOWN )
      call movecam 0,-5,0 , 0,0,0
    case chr$( _VK_LEFT )
      call movecam -5,0,0 , 0,0,0
    case chr$( _VK_RIGHT )
      call movecam 5,0,0 , 0,0,0
    case else
  end select
  if mouse.x < winx / 3 then
    call movecam 0,0,0 , 2,0,0
  end if
  if mouse.x > winx * 2 / 3 then
    call movecam 0,0,0 , -2,0,0
  end if
  if mouse.y < winy / 3 then
    call movecam 0,0,5 , 0,0,0
  end if
  if mouse.y > winy * 2 / 3 then
    call movecam 0,0,-5 , 0,0,0
  end if
 
  call drawall
  call lbgfx "flip"
wait
[key]
  key$ = right$( Inkey$ , 1 )
  if key$ <> chr$( 27 ) then wait
[quit]
  call DestroyLBGfx
  close #lbgfx
  close #main
end
[move]
  mouse.x = MouseX
  mouse.y = MouseY
wait

''graphics

sub point no , x , y , z
  call spot x , y , z
  pnt( no , 0 ) = x
  pnt( no , 1 ) = y
  pnt( no , 2 ) = z
end sub

sub tri p1 , p2 , p3 , kl
  if t.tel > t.max then exit sub
  t( t.tel , 0 ) = pnt( p1 , 0 )
  t( t.tel , 1 ) = pnt( p1 , 1 )
  t( t.tel , 2 ) = pnt( p1 , 2 )
  t( t.tel , 3 ) = pnt( p2 , 0 )
  t( t.tel , 4 ) = pnt( p2 , 1 )
  t( t.tel , 5 ) = pnt( p2 , 2 )
  t( t.tel , 6 ) = pnt( p3 , 0 )
  t( t.tel , 7 ) = pnt( p3 , 1 )
  t( t.tel , 8 ) = pnt( p3 , 2 )
  t( t.tel , 9 ) = kl
  x=(pnt(p1,0)+pnt(p2,0)+pnt(p3,0))/3
  y=(pnt(p1,1)+pnt(p2,1)+pnt(p3,1))/3
  z=(pnt(p1,2)+pnt(p2,2)+pnt(p3,2))/3
  t( t.tel , 10 ) = x
  t( t.tel , 11 ) = y
  t( t.tel , 12 ) = z
  t.tel = t.tel + 1
end sub

sub quad p1 , p2 , p3 , p4 , kl
  call tri p1 , p2 , p3 , kl
  call tri p1 , p3 , p4 , kl
end sub

sub tridraw no
  x1 = t( no , 0 )
  y1 = t( no , 1 )
  z1 = t( no , 2 )
  x2 = t( no , 3 )
  y2 = t( no , 4 )
  z2 = t( no , 5 )
  x3 = t( no , 6 )
  y3 = t( no , 7 )
  z3 = t( no , 8 )
  kl = t( no , 9 )
  if z1 < -900 then exit sub
  if z2 < -900 then exit sub
  if z3 < -900 then exit sub
  a1 = winx / 2 + x1 / ( z1 + 1000 ) * 1000
  b1 = winy / 2 - y1 / ( z1 + 1000 ) * 1000
  a2 = winx / 2 + x2 / ( z2 + 1000 ) * 1000
  b2 = winy / 2 - y2 / ( z2 + 1000 ) * 1000
  a3 = winx / 2 + x3 / ( z3 + 1000 ) * 1000
  b3 = winy / 2 - y3 / ( z3 + 1000 ) * 1000 
  call setcolor kl
  call lbgfx "polyfilled ";a1;" ";b1;" ";a2;" ";b2;" ";a3;" ";b3
end sub

sub drawall
  for i = 1 to t.tel - 1
    for j = 0 to i - 1
      if t(ry(i),12) > t(ry(j),12) then
        h = ry(i)
        ry(i)=ry(j)
        ry(j)=h
      end if
    next j
  next i
  for i = 0 to t.tel - 1
    call tridraw ry(i)
  next i
end sub

sub box x,y,z , dx,dy,dz
  b(0) = x
  b(1) = y
  b(2) = z
  b(3) = dx
  b(4) = dy
  b(5) = dz
end sub

sub kubus l,bt,f,r,t,bk
  call point 0,b(0)+b(3),b(1)+b(4),b(2)+b(5)
  call point 1,b(0)+b(3),b(1)+b(4),b(2)-b(5)
  call point 2,b(0)+b(3),b(1)-b(4),b(2)+b(5)
  call point 3,b(0)+b(3),b(1)-b(4),b(2)-b(5)
  call point 4,b(0)-b(3),b(1)+b(4),b(2)+b(5)
  call point 5,b(0)-b(3),b(1)+b(4),b(2)-b(5)
  call point 6,b(0)-b(3),b(1)-b(4),b(2)+b(5)
  call point 7,b(0)-b(3),b(1)-b(4),b(2)-b(5)

  call quad 0,1,3,2,r
  call quad 7,6,4,5,l
  call quad 0,1,5,4,t
  call quad 7,6,2,3,bt
  call quad 0,2,6,4,bk
  call quad 7,5,1,3,f
end sub

sub ship
  call point 0 , 0,0,100
  call point 1 , 0,30,-86
  call point 2 , 50,0,-86
  call point 3 , -50,0,-86
  call tri 1,2,3,yellow
  call tri 0,2,3,blue
  call tri 0,1,2,green
  call tri 0,1,3,red
end sub

sub klkubus
  call kubus red,green,blue,magenta,cyan,yellow
end sub

''camara stuf

sub pen x , y , z , p , t , r
  pen( 0 ) = x
  pen( 1 ) = y
  pen( 2 ) = z
  pen( 3 ) = p
  pen( 4 ) = t
  pen( 5 ) = r
end sub

sub camara x , y , z , p , t , r , zoom
  cam( 0 ) = x
  cam( 1 ) = y
  cam( 2 ) = z
  cam( 3 ) = p
  cam( 4 ) = t
  cam( 5 ) = r
  cam( 6 ) = zoom
end sub

sub movecam x , y , z , p , t , r
  call rotate x , z , cam( 3 )
  cam( 0 ) = cam( 0 ) + x
  cam( 1 ) = cam( 1 ) + y
  cam( 2 ) = cam( 2 ) + z
  cam( 3 ) = ( cam( 3 ) + p ) mod 360
  cam( 4 ) = ( cam( 4 ) + t ) mod 360
  cam( 5 ) = ( cam( 5 ) + r ) mod 360
end sub

sub spot byref x , byref y , byref z
  call rotate x , z , pen( 3 )
  call rotate y , z , pen( 4 )
  call rotate x , y , pen( 5 )
  x = x - cam( 0 ) + pen( 0 )
  y = y - cam( 1 ) + pen( 1 )
  z = z - cam( 2 ) + pen( 2 )
  call rotate x , y , 0 - cam( 5 )
  call rotate y , z , 0 - cam( 4 )
  call rotate x , z , 0 - cam( 3 )
end sub

''math

function rad( deg )
  rad = deg * pi / 180
end function

function range( l , h )
  range = rnd(0) * ( h - l ) + l
end function

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

''color stuf

function rgb( r , g , b )
  r = int( r ) and 255
  g = int( g ) and 255
  b = int( b ) and 255
  rgb = r + g * 256 + b * 256 ^ 2
end function

sub setcolor kl
  r = kl and 255
  g = int( kl / 256 ) and 255
  b = int( kl / 256 ^ 2 ) and 255
  call lbgfx "color ";r;" ";g;" ";b
  call lbgfx "backcolor ";r;" ";g;" ";b
end sub

function  mix( kla , f , klb )
  r1 = kla and 255
  g1 = int( kla / 256 ) and 255
  b1 = int( kla / 256 ^ 2 ) and 255
  r2 = klb and 255
  g2 = int( klb / 256 ) and 255
  b2 = int( klb / 256 ^ 2 ) and 255
  r = r1 + ( r2 - r1 ) * f
  g = g1 + ( g2 - g1 ) * f
  b = b1 + ( b2 - b1 ) * f
  mix = rgb( r , g , b )
end function

function rainbow( deg )
  r = sin( rad( deg ) ) * 127 + 128
  g = sin( rad( deg - 120 ) ) * 127 + 128
  b = sin( rad( deg + 120 ) ) * 127 + 128
  rainbow = rgb( r , g , b )
end function

''dan teel stuf

sub lbgfx text$
  calldll #lbgfx,"graphicCommand" _
  ,gfx as ulong _
  ,text$ as ptr _
  ,ret as void
end sub

function CreateLBGfx(x,y,w,h,hParent,hMessageHandler)'Returns 0 if fail, hWnd if pass
  style=_WS_VISIBLE+_WS_CHILD+_WS_CLIPCHILDREN
  calldll #kernel32,"GetModuleHandleA",0 as ulong,instance as ulong
  calldll #user32,"CreateWindowExA",_
  0 as long,_
  "LBGfx32" as ptr,_
  0 as ulong,_
  style as ulong,_
  x as long,_
  y as long,_
  w as long,_
  h as long,_
  hParent as ulong,_
  0 as ulong,_
  instance as ulong,_
  hMessageHandler as ulong,_
  CreateLBGfx as ulong
end function

sub DestroyLBGfx
  calldll #user32, "DestroyWindow",_
  gfx as ulong, _
  ret as long
end sub

sub FixWindowSize hwnd,width,height
  struct fixrect _
    ,left as long _
    ,top as long _
    ,right as long _
    ,bottom as long
  calldll #user32,"GetClientRect" _
  ,hwnd as ulong _
  ,fixrect as struct _
  ,ret as void
  width=width-fixrect.right.struct+width
  height=height-fixrect.bottom.struct+height
  calldll #user32,"GetWindowRect" _
  ,hwnd as ulong _
  ,fixrect as struct _
  ,ret as void
  x=fixrect.left.struct
  y=fixrect.top.struct
  calldll #user32,"MoveWindow" _
  ,hwnd as ulong _
  ,x as long _
  ,y as long _
  ,width as long _
  ,height as long _
  ,1 as long _
  ,ret as void
end sub
bluatigro
 
Berichten: 306
Geregistreerd: za sep 27, 2008 6:01 pm


Keer terug naar Liberty BASIC Code

Wie is er online

Gebruikers op dit forum: Geen geregistreerde gebruikers. en 1 gast

cron