filght sim : SKY CAR

Vragen en suggesties over het programmeren van spelletjes, sprites en dergelijke in Liberty BASIC

Moderator: anthonio

filght sim : SKY CAR

Berichtdoor bluatigro » wo aug 05, 2015 2:10 pm

ERROR :
- code laat geen graphics zien
Code: Selecteer alles
''bluatigro 4 aug 2015
''sky car line
dim m( 26 * 4 * 4 ) , 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 ,
dim kompa$( 7 )
for i = 0 to 7
  read a$
  kompa$( i ) = a$
next i
data "NW N NE"
data "N NE E"
data "NE E SE"
data "E SE S"
data "SE S SW"
data "S SW W"
data "SW W NW"
data "W NW N"
rotx = 21
roty = 22
rotz = 23
trans = 24
temp = 25
pi = atn( 1 ) * 4

minz = -50
xyz = 0
xzy = 1
yxz = 2
yzx = 3
zxy = 4
zyx = 5
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy , key$ , muisx , muisy
winx = WindowWidth
winy = WindowHeight
nomainwin
notice chr$( 13 ) _
+ "Welkome by Sky car ." + chr$( 13 ) _
+ "A flight sim by bluatigro ." + chr$( 13 ) _
+ "instructions :" + chr$( 13 ) _
+ "Cursorkeys :" + chr$( 13 ) _
+ "- left right up down ." + chr$( 13 ) _
+ "Mouse :" + chr$( 13 ) _
+ "- leftturn rightturn forewarts backwarts ."
open "Sky car" for graphics as #m
  #m "trapclose [quit]"
  #m "font Courier_new 50 bold"
  #m "backcolor black"
  #m "when mouseMove [move]"
  #m "when characterInput [key]"
  call camera 0 , winy / 2 , 0 , 0 , 0 , 0 , 1
  timer 40 , [timer]
wait
[timer]
  #m "fill black"
  call link 1 , 0,0,0 , 0,0,0 , xyz , 0
  for i = -3 to 3
    for j = -3 to 3
      call bol i * 500 , 0 , j * 500 , 20 , "green" , 3
    next j
  next i
  a$ = kompa$( ( cam( 3 ) mod 360 ) * 8 / 360 )
  #m "goto " ; winx / 2 - len( a$ ) / 2 * 50 ; " " ; winy - 50
  #m "down"
  #m "\" ; a$
  #m "up"
  if muisx < winx / 3 then
    call movecamera 0,0,0,1
  end if
  if muisx > winx * 2 / 3 then
    call movecamera 0,0,0,-1
  end if 
  if muisy < winy / 3 then
    call movecamera 0,0,5,0
  end if 
  if muisy > winy * 2 / 3 then
    call movecamera 0,0,-5,0
  end if
  select case key$
    case chr$( _VK_UP )
      call movecamera 0 , 5 , 0 , 0
    case chr$( _VK_DOWN )
      if cam( 1 ) > winy / 2 then
        call movecamera 0 , -5 , 0 , 0
      end if
    case chr$( _VK_LEFT )
      call movecamera -5 , 0 , 0 , 0
    case chr$( _VK_RIGHT )
      call movecamera 5 , 0 , 0 , 0
    case chr$( _VK_ESCAPE )
      close #m
      end
    case else
  end select
wait
[move]
  muisx = MouseX
  muisy = MouseY
wait
[key]
  key$ = right$( Inkey$ , 1 )
wait
[quit]
  close #m
end

''3d engine

sub camera x , y , z , pan , tilt , rol , zoom
  cam( 0 ) = x
  cam( 1 ) = y
  cam( 2 ) = z
  cam( 3 ) = pan
  cam( 4 ) = tilt
  cam( 5 ) = rol
  cam( 6 ) = zoom
end sub

sub movecamera x , y , z , pan
  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 ) + pan ) mod 360 
end sub

function pend( fase , amp )
''for natural movement of lim
  pend = sin( rad( fase ) ) * amp
end function

sub skelet lim , x , y , z
''set the angles of a lim
  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
''link a lim on a avatar root or lim
  if lim < 0 or lim > 64 then exit sub
  call link no , x , y , z _
  , sk( lim , 1 ) , sk( lim , 0 ) , sk( lim , 2 ) , p
end sub

sub link no , x , y , z , xz , yz , xy , ax , p
''link a new matrix to a old one
  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 new rotation + translation 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 )
''for 3D array
  in = no * 16 + x * 4 + y
end function

sub copy a , uit
''copy matrix a => uit
  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
''matrix a * matrix b = matrix uit
  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 to world coordinates
  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

function rad( deg )
  rad = deg * pi / 180
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

''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 bol x,y,z , d , kl$ , size
  call spot x , y , z
  if z < minz then exit sub
  a = winx/2 + x / ( z + 1000 ) * 1000
  b = winy/2 - y / ( z + 1000 ) * 1000
  d = d / ( z + 1000 ) *  1000
  #m "goto " ; a ; " " ; b
  #m "color " ; kl$
  #m "backcolor " ; kl$
  #m "size " ; size
  #m "down"
  #m "circle " ; d
  #m "up"
end sub

sub lijn x1,y1,z1 , x2,y2,z2 , kl$ , size
  call spot x1,y1,z1
  call spot x2,y2,z2
  if z1 < minz then exit sub
  if z2 < minz 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
  #m "color " ; kl$
  #m "size " ; size
  #m "down"
  #m "line " ; ax ; "  " ; ay ; " " ; bx ; " " ; by
  #m "up"
end sub
bluatigro
 
Berichten: 306
Geregistreerd: za sep 27, 2008 6:01 pm

Re: filght sim : SKY CAR

Berichtdoor bluatigro » vr aug 07, 2015 10:54 am

update :
- graphics werken nu
error :
- de geREMde code doet niet wat er van verwacht word
Code: Selecteer alles
''bluatigro 4 aug 2015
''sky car line
dim m( 26 * 4 * 4 ) , 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
dim kompa$( 7 )
for i = 0 to 7
  read a$
  kompa$( i ) = a$
next i
data "NW N NE"
data "N NE E"
data "NE E SE"
data "E SE S"
data "SE S SW"
data "S SW W"
data "SW W NW"
data "W NW N"
rotx = 21
roty = 22
rotz = 23
trans = 24
temp = 25
pi = atn( 1 ) * 4

minz = -50
xyz = 0
xzy = 1
yxz = 2
yzx = 3
zxy = 4
zyx = 5
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy , key$ , muisx , muisy
winx = WindowWidth
winy = WindowHeight
nomainwin
notice chr$( 13 ) _
+ "Welkome by Sky car ." + chr$( 13 ) _
+ "A flight sim by bluatigro ." + chr$( 13 ) _
+ "instructions :" + chr$( 13 ) _
+ "Cursorkeys :" + chr$( 13 ) _
+ "- left right up down ." + chr$( 13 ) _
+ "Mouse :" + chr$( 13 ) _
+ "- leftturn rightturn forewarts backwarts ."
open "Sky car" for graphics as #m
  #m "trapclose [quit]"
  #m "font Courier_new 50 bold"
  #m "backcolor black"
  #m "when mouseMove [move]"
  #m "when characterInput [key]"
  call camera 0 , winy / 2 , 0 , 0 , 0 , 0 , 1
  timer 40 , [timer]
wait
[timer]
  #m "fill black"
  call link 1 , 0,0,0 , 0,0,0 , xyz , 0
  for i = -3 to 3
    for j = -3 to 3
      call bol i * 500 , 0 , j * 500 _
      , 20 , rainbow$( cam( 3 ) ) , 3
    next j
  next i
''  a$ = kompa$( ( ( cam( 3 ) mod 360 ) * -8 / 360 + 0.5 ) mod 8 )
''  #m "backcolor black"
''  #m "goto " ; winx / 2 - len( a$ ) / 2 * 50 ; " " ; winy - 150
''  #m "down"
''  #m "\" ; a$
''  #m "up"
  if muisx < winx / 3 then
    call movecamera 0,0,0,1
  end if
  if muisx > winx * 2 / 3 then
    call movecamera 0,0,0,-1
  end if 
  if muisy < winy / 3 then
    call movecamera 0,0,5,0
  end if 
  if muisy > winy * 2 / 3 then
    call movecamera 0,0,-5,0
  end if
  select case key$
    case chr$( _VK_UP )
      call movecamera 0 , 5 , 0 , 0
    case chr$( _VK_DOWN )
      if cam( 1 ) > winy / 2 then
        call movecamera 0 , -5 , 0 , 0
      end if
    case chr$( _VK_LEFT )
      call movecamera -5 , 0 , 0 , 0
    case chr$( _VK_RIGHT )
      call movecamera 5 , 0 , 0 , 0
    case chr$( _VK_ESCAPE )
      close #m
      end
    case else
  end select
  key$ = ""
wait
[move]
  muisx = MouseX
  muisy = MouseY
wait
[key]
  key$ = right$( Inkey$ , 1 )
wait
[quit]
  close #m
end

''3d engine

sub camera x , y , z , pan , tilt , rol , zoom
  cam( 0 ) = x
  cam( 1 ) = y
  cam( 2 ) = z
  cam( 3 ) = pan
  cam( 4 ) = tilt
  cam( 5 ) = rol
  cam( 6 ) = zoom
end sub

sub movecamera x , y , z , pan
  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 ) + pan ) mod 360 
end sub

function pend( fase , amp )
''for natural movement of lim
  pend = sin( rad( fase ) ) * amp
end function

sub skelet lim , x , y , z
''set the angles of a lim
  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
''link a lim on a avatar root or lim
  if lim < 0 or lim > 64 then exit sub
  call link no , x , y , z _
  , sk( lim , 1 ) , sk( lim , 0 ) , sk( lim , 2 ) , p
end sub

sub link no , x , y , z , xz , yz , xy , ax , p
''link a new matrix to a old one
  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 new rotation + translation 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 )
''for 3D array
  in = no * 16 + x * 4 + y
end function

sub copy a , uit
''copy matrix a => uit
  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
''matrix a * matrix b = matrix uit
  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 to world coordinates
  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

function rad( deg )
  rad = deg * pi / 180
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

''graphics

function rgb$( r , g , b )
  r = r and 255
  g = g and 255
  b = b and 255
  rgb$ = str$( r ) + " " ; g ; " " ; b
end function

function rainbow$( deg )
  rainbow$ = rgb$( sin( rad( deg ) ) * 127 + 128 _
           , sin( rad( deg - 120 ) ) * 127 + 128 _
           , sin( rad( deg + 120 ) ) * 127 + 128 )
end function
 

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 bol x,y,z , d , kl$ , size
  call spot x , y , z
  if z < minz then exit sub
  a = winx/2 + x / ( z + 1000 ) * 1000
  b = winy/2 - y / ( z + 1000 ) * 1000
  d = d / ( z + 1000 ) *  1000
  #m "goto " ; a ; " " ; b
  #m "color " ; kl$
  #m "backcolor " ; kl$
  #m "size " ; size
  #m "down"
  #m "circle " ; d
  #m "up"
end sub

sub lijn x1,y1,z1 , x2,y2,z2 , kl$ , size
  call spot x1,y1,z1
  call spot x2,y2,z2
  if z1 < minz then exit sub
  if z2 < minz 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
  #m "color " ; kl$
  #m "size " ; size
  #m "down"
  #m "line " ; ax ; "  " ; ay ; " " ; bx ; " " ; by
  #m "up"
end sub
bluatigro
 
Berichten: 306
Geregistreerd: za sep 27, 2008 6:01 pm


Keer terug naar Games

Wie is er online

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

cron