2.5 D sprite maker

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

Moderators: anthonio, Abcott

2.5 D sprite maker

Berichtdoor bluatigro » wo nov 20, 2013 10:05 am

dit is n 2.5 D spritemaker
voor t maken van sprites gemaakt uit bollen

r is n voorbeeld van n avatar gegeven

WAARSCHUWING :
- verander het path in sub savesprite indien nodig
- tekenen van de totale animatie duurt +-30min

Code: Selecteer alles
global mmax
mmax = 20
dim m( ( mmax + 5 ) * 4 * 4 + 16 )
dim skx( 64 ) , sky( 64 ) , skz( 64 )
global rotx , roty , rotz  , trans , temp , number , pi
trans = mmax + 1
rotx = mmax + 2
roty = mmax + 3
rotz = mmax + 4
temp = mmax + 5
pi = atn( 1 ) * 4
global xyz , xzy , yxz , yzx , zxy , zyx
xzy = 1
yxz = 2
yzx = 3
zxy = 4
zyx = 5
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy , sprx , spry
WinX = WindowWidth
WinY = WindowHeight
global height , pi
pi = atn( 1 ) * 4
global black , red , green , yellow
global blue , magenta , cyan , white
global pink , purple , gray , orange
black   = rgb(   0 ,   0 ,   0 )
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 )
white   = rgb( 255 , 255 , 255 )
pink    = rgb( 255 , 127 , 127 )
orange  = rgb( 255 , 127 ,   0 )
gray    = rgb( 127 , 127 , 127 )
purple  = rgb( 127 ,   0 , 127 )
''avatar lim's
global arm , elbow , wrist
arm = 0
elbow = 1
wrist = 2
global leg , knee , enkle
leg = 3
knee = 4
enkle = 5
global neck , head , eye
neck = 6
head = 7
eye = 8
global thumb , index , midle , ring
thumb = 9
index = 12
midle = 15
ring = 18
global tail , body , lr
tail = 21
body = 22
lr = 32

nomainwin
open "spheres" for graphics as #m
  #m "trapclose [quit]"
  for frame = 0 to 31
  call startmatrix
  angle = frame * 360 / 32
  ''example animation : human walk
  call skelet leg , pend( angle , 30 ) , 0 , 0
  call skelet knee , pend( angle - 90 , 30 ) - 30 , 0 , 0
  call skelet arm , pend( angle + 180 , 30 ) , 0 , 0
  call skelet elbow , 30 , 0 , 0
  call skelet leg + lr , pend( angle + 180, 30 ) , 0 , 0
  call skelet knee + lr , pend( angle + 90 , 30 ) - 30 , 0 , 0
  call skelet arm + lr , pend( angle , 30 ) , 0 , 0
  call skelet elbow + lr , 30 , 0 , 0
  call clear 150 , 300
  for height = 0 - spry / 2 to spry /  2
    call link 1 , 0,0,0 , 135,0,0 , xyz , 0
    call man yellow , blue
  next height


  #m "flush"
  call savesprite "man" + nr$( frame , 2 )
  next frame
  notice "ready"
wait
''example of a avatar
Sub Kop qq , kl
    call link 15, 0, 0, 0, 0, 0, 0,xyz, number
        call sphere 0, 0, 0, 30, kl
    If qq = 1 Then
        call sphere 25, 25, 0, 9, kl
        call sphere -25, 25, 0, 9, kl
        call sphere 0, 0, 40, 10, gray
    Else
        call sphere 30, 0, 0, 9, kl
        call sphere -30, 0, 0, 9, kl
        call sphere 0, 0, 40, 12, kl
    End If
        call child 16, 14, 14, 14, eye ,xyz, 15
          call sphere 0, 0, 0, 13, white
          call sphere 0, 0, 10, 7, black
        call child 16, -14, 14, 14, eye + lr,xyz, 15
          call sphere 0, 0, 0, 13, white
          call sphere 0, 0, 10, 7, black

End Sub
sub man trui , broek
    call child 9, 0, 0, 0, body+lr , xyz , number
    call child 10, 0, 0, 0, body , xyz , 9
        call sphere 0, 50, 0, 30, trui
        call sphere 0, 25, 0, 23, broek
        call sphere 0, 0, 0, 15, broek
    call child 11, 0, 70, 0, neck, xyz, 10
    call child 12, 0, 30, 0, neck+lr, xyz, 11
        call Kop 0, red
    call child 11, 20, -10, 0, leg, yzx, 9
        call sphere 0, 0, 0, 16, broek
        call sphere 0, -20, 0, 16, broek
    call child 12, 0, -40, 0, knee, xyz, 11
        call sphere 0, 0, 0, 16, broek
        call sphere 0, -20, 0, 16, broek
    call child 13, 0, -40, 0, enkle, xzy, 12
        call sphere 0, 0, 0, 12, gray
        call sphere 0, 0, 20, 12, gray
    call child 11, -20, -10, 0, leg+lr , yzx, 10
        call sphere 0, 0, 0, 16, broek
        call sphere 0, -20, 0, 16, broek
    call child 12, 0, -40, 0, knee+lr, xyz, 11
        call sphere 0, 0, 0, 16, broek
        call sphere 0, -20, 0,16, broek
    call child 13, 0, -40, 0,enkle+lr, xzy, 12
        call sphere 0, 0, 0, 12, gray
        call sphere 0, 0, 20, 12, gray
    call child 11, 40, 60, 0, arm, xzy, 10
        call sphere 0, 0, 0, 16, trui
        call sphere 6, -20, 0, 12, trui
    call child 12, 6, -40, 0, elbow, xyz, 11
        call sphere 0, 0, 0, 12, trui
        call sphere 0, -20, 0, 12, trui
        call sphere 0, -42, 0, 8, red
    call child 11, -40, 60, 0, arm+lr, xzy, 10
        call sphere 0, 0, 0, 16, trui
        call sphere -6, -20, 0, 12, trui
    call child 12, -6, -40, 0, elbow+lr, xyz, 11
        call sphere 0, 0, 0, 12, trui
        call sphere 0, -20, 0, 12, trui
        call sphere 0, -42, 0, 8, red
end sub

''  3d engine

function pend( fase , amp )
  pend = sin( rad( fase ) ) * amp
end function

sub skelet lim , x , y , z
''for animating avatar lim's
  skx( lim ) = x
  sky( lim ) = y
  skz( lim ) = z
end sub

sub child no , x , y , z , lim , ax , p
''for creating lim's of a avatar
  if lim < 0 or lim > 64 then exit sub
  call link no , x , y , z _
  , sky( lim ) , skx( lim ) , skz( lim ) , ax , p
end sub

sub link no , x , y , z , xz , yz , xy , ax , p
''set draw matrix : wil efect future drawing

''no : number new matrix
''x,y,z : translation
''xz,yz,xy : rotation in degrees
''ax : sequence of axes
''p : number old matrix

  if no < 1 or no > mmax then exit sub
  if p < 0 or p > mmax then exit sub
  if p = no then exit sub
''copy matrix 0 into matrix's
  call copy 0 , rotx
  call copy 0 , roty
  call copy 0 , rotz
  call copy 0 , trans
''create rotation matrix's
  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 ) )
''create translation matrix
  m( in( trans , 3 , 0 ) ) = x
  m( in( trans , 3 , 1 ) ) = y
  m( in( trans , 3 , 2 ) ) = z
''select axes sequence [ 1 of 6 ] and act on i
  select case ax
    case xyz
      call multiply rotx , roty , temp
      call multiply temp , rotz , no
      call multiply no , trans , temp
      call multiply temp , p , no
    case xzy
      call multiply rotx , rotz , temp
      call multiply temp , roty , no
      call multiply no , trans , temp
      call multiply temp , p , no
    case yxz
      call multiply roty , rotx , temp
      call multiply temp , rotz , no
      call multiply no , trans , temp
      call multiply temp , p , no
    case yzx
      call multiply roty , rotz , temp
      call multiply temp , rotx , no
      call multiply no , trans , temp
      call multiply temp , p , no
    case zxy
      call multiply rotz , rotx , temp
      call multiply temp , roty , no
      call multiply no , trans , temp
      call multiply temp , p , no
    case zyx
      call multiply rotz , roty , temp
      call multiply temp , rotx , no
      call multiply no , trans , temp
      call multiply temp , p , no
    case else
      call multiply rotx , roty , temp
      call multiply temp , rotz , no
      call multiply no , trans , temp
      call multiply temp , p , no
  end select
  number = no
end sub

sub free no , x , y , z , angle , xas , yas , zas , p
''set new matrix : wil afect future drawing

''no : number new matrix
''x,y,z : translation
''angle : rotation in degrees
''xas,yas,zas : vector of rotaion ax
''p : number old matrix

  if no < 1 or no > mmax then exit sub
  if p < 0 or p > mmax then exit sub
  if p = no then exit sub
  call copy 0 , rotx
  call copy 0 , trans
  l = sqr( xas ^ 2 + yas ^ 2 + zas ^ 2 )
  if l = 0 then exit sub
  xas = xas / l
  yas = yas / l
  zas = zas / l
  s = sin( rad( angle ) )
  c = cos( rad( angle ) )
  t = 1 - cos( rad( angle ) )
  m( in( rotx , 0 , 0 ) ) = t * xas ^ 2 + c
  m( in( rotx , 0 , 1 ) ) = t * xas * yas - s * zas
  m( in( rotx , 0 , 2 ) ) = t * xas * zas - s * yas
  m( in( trans , 3 , 0 ) ) = x
  m( in( rotx , 1 , 0 ) ) = t * xas * yas + s * zas
  m( in( rotx , 1 , 1 ) ) = t * yas ^ 2 + c
  m( in( rotx , 1 , 2 ) ) = t * yas * zas - s * xas
  m( in( trans , 3 , 1 ) ) = y
  m( in( rotx , 2 , 0 ) ) = t * xas * zas - s * yas
  m( in( rotx , 2 , 1 ) ) = t * yas * zas + s * xas
  m( in( rotx , 2 , 2 ) ) = t * zas ^ 2 + c
  m( in( trans , 3 , 2 ) ) = z
  call multiply rotx , translate , temp
  call multiply temp , p , no
  number = no
end sub

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

sub spot byref x , byref y , byref z
'''lokal coordinates to world coordinates
''x,y,z = matrix( number ) * x,y,z
  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
  y = hy
  z = hz
end sub

sub multiply a , b , c
''matrix( c ) = matrix( a ) * matrix( b )
  for i = 0 to 3
    for j = 0 to 3
      m( in( c , i , j ) ) = 0
      for k = 0 to 3
        m( in( c , i , j ) ) = m( in( c , i , j ) ) _
        + m( in( a , i , k ) ) * m( in( b , k , j ) )
      next k
    next j
  next i
end sub

sub startmatrix
''set startmatrix to unity
  for x = 0 to 3
    for y = 0 to 3
      m( in( 0,x,y ) ) = 0
    next y
    m( in( 0,x,x ) ) = 1
  next x
end sub

function in( no , x , y )
''LB4 has no 3d array's
''so i simulate them
  in = x + y * 4 + no * 16
end function

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

'' graphics

sub savesprite spr$
  #m "getbmp sprite 0 0 " ; sprx ; " " ; spry * 2
  bmpsave "sprite" , DefaultDir$ + "\BMP\" ; spr$ ; ".bmp"
end sub

function nr$( no , m )
  nr$ = right$( "00000000" ; no , m )
end function

sub clear x , y
  #m "cls"
  #m "color white"
  #m "backcolor white"
  #m "goto 0 0"
  #m "down"
  #m "boxfilled " ; x ; " " ; y
  #m "up"
  #m "goto 0 " ; y
  #m "down"
  #m "color black"
  #m "backcolor black"
  #m "boxfilled " ; x ; " " ; 2 * y
  #m "up"
  sprx = x
  spry = y
end sub

sub sphere x , y , z , d , kl
  call spot x , y , z
  if abs( height - y ) < d then
    dd = sqr( d ^ 2 - ( height - y ) ^ 2 ) * 2
    kl = mix( kl , 1 - ( height - y ) / d / 2 + 0.5 , 0 )
    r = int( kl and 255 )
    g = int( kl / 256 ) and 255
    b = int( kl / 256 / 256 ) and 255
    print #m , "backcolor " ; r ;" "; g ;" "; b
    print #m , "color " ; r ; " " ; g ; " " ; b
    print #m , "goto "; sprx / 2 + x ;" " _
    ; spry / 2 - height - z / 4 + spry
    print #m , "down"
    print #m , "ellipsefilled "; dd ;" "; dd / 4
    print #m , "up"
    print #m , "backcolor black"
    print #m , "color black"
    print #m , "goto " ; sprx / 2 + x ; " " _
    ; spry / 2 - height - z / 4
    print #m , "down"
    print #m , "ellipsefilled " ; dd ; " " ; dd / 4
    print #m , "up"
  end if
end sub

sub egg x1 , y1 , z1 , d1 , k1 , x2 , y2 , z2 , d2 , k2 , dm
  diff = sqr( ( x1 - x2 ) ^ 2 _
            + ( y1 - y2 ) ^ 2 _
            + ( z1 - z2 ) ^ 2 )
  dx = ( x2 - x1 ) / diff
  dy = ( y2 - y1 ) / diff
  dz = ( z2 - z1 ) / diff
  dd = ( d2 - d1 ) / diff
  if dm = 0 then dm = ( d1 + d2 ) / 2
  for i = 0 to diff
    kl = mix( k1 , 1 - i / diff , k2 )
    call sphere x1 + dx * i _
    , y1 + dy * i _
    , z1 + dz * i _
    , d1 + dd * i _
    + sin( i / diff * pi ) _
    * ( dm - ( d1 + d2 ) / 2 ) _
    , kl
  next i
end sub

function rgb( r , g , b )
  rgb = ( r and 255 ) _
  + ( g and 255 ) * 256 _
  + ( b and 255 ) * 256 * 256
end function

function mix( kl1 , f , kl2 )
  r1 = int( kl1 and 255 )
  g1 = int( kl1 / 256 ) and 255
  b1 = int( kl1 / 256 / 256 ) and 255
  r2 = int( kl2 and 255 )
  g2 = int( kl2 / 256 ) and 255
  b2 = int( kl2 / 256 / 256 ) and 255
  dr = r2 - r1
  dg = g2 - g1
  db = b2 - b1
  dr = dr * f
  dg = dg * f
  db = db * f
  r = r1 + dr
  g = g1 + dg
  b = b1 + db
  mix = rgb( r , g , b )
end function

[quit]
  close #m
end
bluatigro
 
Berichten: 306
Geregistreerd: za sep 27, 2008 6:01 pm

Re: 2.5 D sprite maker

Berichtdoor bluatigro » wo nov 20, 2013 10:09 am

en zo gebruik je ze :
Code: Selecteer alles
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
nomainwin
for i = 0 to 31
  loadbmp "p" ; nr$( i ) _
  , DefaultDir$ + "\BMP\man" + nr$( i ) + ".bmp"
  anim$ = anim$ + "p"; nr$( i ) + " "
next i
open "3d rock" for graphics as #m
  #m "trapclose [quit]"
  #m "fill black"
  #m "getbmp bmp 0 0 10 10"
  #m "background bmp"
  #m "addsprite spr " ; anim$
  #m "spritexy spr 100 100"
  #m "cyclesprite spr 1"
  timer 40 , [tmr]
wait
function nr$( x )
  nr$ = right$( "00" ; x , 2 )
end function
[tmr]
  #m "drawsprites"
wait
[quit]
  for i = 0 to 31
    unloadbmp "p";nr$(i)
  next i
  close #m
end

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

Re: 2.5 D sprite maker

Berichtdoor bluatigro » ma nov 25, 2013 1:40 pm

update :
- nieuwe egg sub

r is iets mis met mijn kleurcode

Code: Selecteer alles
global mmax
mmax = 20
dim m( ( mmax + 5 ) * 4 * 4 + 16 )
dim skx( 64 ) , sky( 64 ) , skz( 64 )
global rotx , roty , rotz  , trans , temp , number , pi
trans = mmax + 1
rotx = mmax + 2
roty = mmax + 3
rotz = mmax + 4
temp = mmax + 5
pi = atn( 1 ) * 4
global xyz , xzy , yxz , yzx , zxy , zyx
xzy = 1
yxz = 2
yzx = 3
zxy = 4
zyx = 5
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy , sprx , spry
WinX = WindowWidth
WinY = WindowHeight
global height , pi
pi = atn( 1 ) * 4
global black , red , green , yellow
global blue , magenta , cyan , white
global pink , purple , gray , orange
black   = rgb(   0 ,   0 ,   0 )
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 )
white   = rgb( 255 , 255 , 255 )
pink    = rgb( 255 , 127 , 127 )
orange  = rgb( 255 , 127 ,   0 )
gray    = rgb( 127 , 127 , 127 )
purple  = rgb( 127 ,   0 , 127 )
''avatar lim's
global arm , elbow , wrist
arm = 0
elbow = 1
wrist = 2
global leg , knee , enkle
leg = 3
knee = 4
enkle = 5
global neck , head , eye
neck = 6
head = 7
eye = 8
global thumb , index , midle , ring
thumb = 9
index = 12
midle = 15
ring = 18
global tail , body , lr
tail = 21
body = 22
lr = 32

nomainwin
open "spheres" for graphics as #m
  #m "trapclose [quit]"
  for frame = 0 to 0
  call startmatrix
  angle = frame * 360 / 32
  ''example animation : human walk
  call skelet leg , pend( angle , 30 ) , 0 , 0
  call skelet knee , pend( angle - 90 , 30 ) - 30 , 0 , 0
  call skelet arm , pend( angle + 180 , 30 ) , 0 , 0
  call skelet elbow , 30 , 0 , 0
  call skelet leg + lr , pend( angle + 180, 30 ) , 0 , 0
  call skelet knee + lr , pend( angle + 90 , 30 ) - 30 , 0 , 0
  call skelet arm + lr , pend( angle , 30 ) , 0 , 0
  call skelet elbow + lr , 30 , 0 , 0
  call clear 200 , 200
  for height = 0 - spry / 2 to spry /  2
    call egg -50,0,0 , 45 , red , 50,0,0 , 45 , blue , 30 , 5
  next height


  #m "flush"

  next frame
  notice "ready"
wait

Sub Kop qq , kl
    call link 15, 0, 0, 0, 0, 0, 0,xyz, number
        call sphere 0, 0, 0, 30, kl
    If qq = 1 Then
        call sphere 25, 25, 0, 9, kl
        call sphere -25, 25, 0, 9, kl
        call sphere 0, 0, 40, 10, gray
    Else
        call sphere 30, 0, 0, 9, kl
        call sphere -30, 0, 0, 9, kl
        call sphere 0, 0, 40, 12, kl
    End If
        call child 16, 14, 14, 14, eye ,xyz, 15
          call sphere 0, 0, 0, 13, white
          call sphere 0, 0, 10, 7, black
        call child 16, -14, 14, 14, eye + lr,xyz, 15
          call sphere 0, 0, 0, 13, white
          call sphere 0, 0, 10, 7, black

End Sub
sub man trui , broek
    call child 9, 0, 0, 0, body+lr , xyz , number
    call child 10, 0, 0, 0, body , xyz , 9
        call sphere 0, 50, 0, 30, trui
        call sphere 0, 25, 0, 23, broek
        call sphere 0, 0, 0, 15, broek
    call child 11, 0, 70, 0, neck, xyz, 10
    call child 12, 0, 30, 0, neck+lr, xyz, 11
        call Kop 0, red
    call child 11, 20, -10, 0, leg, yzx, 9
        call sphere 0, 0, 0, 16, broek
        call sphere 0, -20, 0, 16, broek
    call child 12, 0, -40, 0, knee, xyz, 11
        call sphere 0, 0, 0, 16, broek
        call sphere 0, -20, 0, 16, broek
    call child 13, 0, -40, 0, enkle, xzy, 12
        call sphere 0, 0, 0, 12, gray
        call sphere 0, 0, 20, 12, gray
    call child 11, -20, -10, 0, leg+lr , yzx, 10
        call sphere 0, 0, 0, 16, broek
        call sphere 0, -20, 0, 16, broek
    call child 12, 0, -40, 0, knee+lr, xyz, 11
        call sphere 0, 0, 0, 16, broek
        call sphere 0, -20, 0,16, broek
    call child 13, 0, -40, 0,enkle+lr, xzy, 12
        call sphere 0, 0, 0, 12, gray
        call sphere 0, 0, 20, 12, gray
    call child 11, 40, 60, 0, arm, xzy, 10
        call sphere 0, 0, 0, 16, trui
        call sphere 6, -20, 0, 12, trui
    call child 12, 6, -40, 0, elbow, xyz, 11
        call sphere 0, 0, 0, 12, trui
        call sphere 0, -20, 0, 12, trui
        call sphere 0, -42, 0, 8, red
    call child 11, -40, 60, 0, arm+lr, xzy, 10
        call sphere 0, 0, 0, 16, trui
        call sphere -6, -20, 0, 12, trui
    call child 12, -6, -40, 0, elbow+lr, xyz, 11
        call sphere 0, 0, 0, 12, trui
        call sphere 0, -20, 0, 12, trui
        call sphere 0, -42, 0, 8, red
end sub

''  3d engine

function pend( fase , amp )
  pend = sin( rad( fase ) ) * amp
end function

sub skelet lim , x , y , z
''for animating avatar lim's
  skx( lim ) = x
  sky( lim ) = y
  skz( lim ) = z
end sub

sub child no , x , y , z , lim , ax , p
''for creating lim's of a avatar
  if lim < 0 or lim > 64 then exit sub
  call link no , x , y , z _
  , sky( lim ) , skx( lim ) , skz( lim ) , ax , p
end sub

sub link no , x , y , z , xz , yz , xy , ax , p
''set draw matrix : wil efect future drawing

''no : number new matrix
''x,y,z : translation
''xz,yz,xy : rotation in degrees
''ax : sequence of axes
''p : number old matrix

  if no < 1 or no > mmax then exit sub
  if p < 0 or p > mmax then exit sub
  if p = no then exit sub
''copy matrix 0 into matrix's
  call copy 0 , rotx
  call copy 0 , roty
  call copy 0 , rotz
  call copy 0 , trans
''create rotation matrix's
  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 ) )
''create translation matrix
  m( in( trans , 3 , 0 ) ) = x
  m( in( trans , 3 , 1 ) ) = y
  m( in( trans , 3 , 2 ) ) = z
''select axes sequence [ 1 of 6 ] and act on i
  select case ax
    case xyz
      call multiply rotx , roty , temp
      call multiply temp , rotz , no
      call multiply no , trans , temp
      call multiply temp , p , no
    case xzy
      call multiply rotx , rotz , temp
      call multiply temp , roty , no
      call multiply no , trans , temp
      call multiply temp , p , no
    case yxz
      call multiply roty , rotx , temp
      call multiply temp , rotz , no
      call multiply no , trans , temp
      call multiply temp , p , no
    case yzx
      call multiply roty , rotz , temp
      call multiply temp , rotx , no
      call multiply no , trans , temp
      call multiply temp , p , no
    case zxy
      call multiply rotz , rotx , temp
      call multiply temp , roty , no
      call multiply no , trans , temp
      call multiply temp , p , no
    case zyx
      call multiply rotz , roty , temp
      call multiply temp , rotx , no
      call multiply no , trans , temp
      call multiply temp , p , no
    case else
      call multiply rotx , roty , temp
      call multiply temp , rotz , no
      call multiply no , trans , temp
      call multiply temp , p , no
  end select
  number = no
end sub

sub free no , x , y , z , angle , xas , yas , zas , p
''set new matrix : wil afect future drawing

''no : number new matrix
''x,y,z : translation
''angle : rotation in degrees
''xas,yas,zas : vector of rotaion ax
''p : number old matrix

  if no < 1 or no > mmax then exit sub
  if p < 0 or p > mmax then exit sub
  if p = no then exit sub
  call copy 0 , rotx
  call copy 0 , trans
  l = sqr( xas ^ 2 + yas ^ 2 + zas ^ 2 )
  if l = 0 then exit sub
  xas = xas / l
  yas = yas / l
  zas = zas / l
  s = sin( rad( angle ) )
  c = cos( rad( angle ) )
  t = 1 - cos( rad( angle ) )
  m( in( rotx , 0 , 0 ) ) = t * xas ^ 2 + c
  m( in( rotx , 0 , 1 ) ) = t * xas * yas - s * zas
  m( in( rotx , 0 , 2 ) ) = t * xas * zas - s * yas
  m( in( trans , 3 , 0 ) ) = x
  m( in( rotx , 1 , 0 ) ) = t * xas * yas + s * zas
  m( in( rotx , 1 , 1 ) ) = t * yas ^ 2 + c
  m( in( rotx , 1 , 2 ) ) = t * yas * zas - s * xas
  m( in( trans , 3 , 1 ) ) = y
  m( in( rotx , 2 , 0 ) ) = t * xas * zas - s * yas
  m( in( rotx , 2 , 1 ) ) = t * yas * zas + s * xas
  m( in( rotx , 2 , 2 ) ) = t * zas ^ 2 + c
  m( in( trans , 3 , 2 ) ) = z
  call multiply rotx , translate , temp
  call multiply temp , p , no
  number = no
end sub

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

sub spot byref x , byref y , byref z
'''lokal coordinates to world coordinates
''x,y,z = matrix( number ) * x,y,z
  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
  y = hy
  z = hz
end sub

sub multiply a , b , c
''matrix( c ) = matrix( a ) * matrix( b )
  for i = 0 to 3
    for j = 0 to 3
      m( in( c , i , j ) ) = 0
      for k = 0 to 3
        m( in( c , i , j ) ) = m( in( c , i , j ) ) _
        + m( in( a , i , k ) ) * m( in( b , k , j ) )
      next k
    next j
  next i
end sub

sub startmatrix
''set startmatrix to unity
  for x = 0 to 3
    for y = 0 to 3
      m( in( 0,x,y ) ) = 0
    next y
    m( in( 0,x,x ) ) = 1
  next x
end sub

function in( no , x , y )
''LB4 has no 3d array's
''so i simulate them
  in = x + y * 4 + no * 16
end function

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

'' graphics

sub savesprite spr$
  #m "getbmp sprite 0 0 " ; sprx ; " " ; spry * 2
  bmpsave "sprite" , DefaultDir$ + "\BMP\" ; spr$ ; ".bmp"
end sub

function nr$( no , m )
  nr$ = right$( "00000000" ; no , m )
end function

sub clear x , y
  #m "cls"
  #m "color white"
  #m "backcolor white"
  #m "goto 0 0"
  #m "down"
  #m "boxfilled " ; x ; " " ; y
  #m "up"
  #m "goto 0 " ; y
  #m "down"
  #m "color black"
  #m "backcolor black"
  #m "boxfilled " ; x ; " " ; 2 * y
  #m "up"
  sprx = x
  spry = y
end sub

sub sphere x , y , z , d , kl
  call spot x , y , z
  if abs( height - y ) < d then
    dd = sqr( d ^ 2 - ( height - y ) ^ 2 ) * 2
    kl = mix( kl , 1 - ( height - y ) / d / 2 + 0.5 , 0 )
    r = int( kl and 255 )
    g = int( kl / 256 ) and 255
    b = int( kl / 256 / 256 ) and 255
    print #m , "backcolor " ; r ;" "; g ;" "; b
    print #m , "color " ; r ; " " ; g ; " " ; b
    print #m , "goto "; sprx / 2 + x ;" " _
    ; spry / 2 - height - z / 4 + spry
    print #m , "down"
    print #m , "ellipsefilled "; dd ;" "; dd / 4
    print #m , "up"
    print #m , "backcolor black"
    print #m , "color black"
    print #m , "goto " ; sprx / 2 + x ; " " _
    ; spry / 2 - height - z / 4
    print #m , "down"
    print #m , "ellipsefilled " ; dd ; " " ; dd / 4
    print #m , "up"
  end if
end sub

sub egg x1 , y1 , z1 , d1 , k1 , x2 , y2 , z2 , d2 , k2 , dm , n
  diff = sqr( ( x1 - x2 ) ^ 2 _
            + ( y1 - y2 ) ^ 2 _
            + ( z1 - z2 ) ^ 2 )
  dx = ( x2 - x1 ) / diff
  dy = ( y2 - y1 ) / diff
  dz = ( z2 - z1 ) / diff
  dd = ( d2 - d1 ) / diff
  if dm = 0 then dm = ( d1 + d2 ) / 2
  if n = 0 or n > diff then n = diff
  for i = 0 to diff step diff / n
    kl = mix( k1 , i / diff , k2 )
    call sphere x1 + dx * i _
    , y1 + dy * i _
    , z1 + dz * i _
    , d1 + dd * i _
    + sin( i / diff * pi ) _
    * ( dm - ( d1 + d2 ) / 2 ) _
    , kl
  next i
end sub

function rgb( r , g , b )
''create a colorobject
  r = r and 255
  g = g and 255
  b = b and 255
  rgb = r + g * 256 + b * 256 ^ 2
end function

function rainbow( deg )
''get a colorobject out of a rainbow
  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

function mix( kl1 , f , kl2 )
  r1 = int( kl1 and 255 )
  g1 = int( kl1 / 256 ) and 255
  b1 = int( kl1 / 256 / 256 ) and 255
  r2 = int( kl2 and 255 )
  g2 = int( kl2 / 256 ) and 255
  b2 = int( kl2 / 256 / 256 ) and 255
  dr = r2 - r1
  dg = g2 - g1
  db = b2 - b1
  dr = dr * f
  dg = dg * f
  db = db * f
  r = r1 + dr
  g = g1 + dg
  b = b1 + db
  mix = rgb( r , g , b )
end function

[quit]
  close #m
end

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