ray casting

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

ray casting

Postby bluatigro » May 12, 2014 9:29

this is my first try at ray casting in FB

the difference whit ray tracing :
- ray tracing : a point traveling trou space until hitting somthing : slow
- ray casting : a line in space intersecting something : fast

error :
- i only get the backgound color

i set backgound to gray so i can SOME drawing

Code: Select all

''ray casting 1.0
''bluatigro
''start : 10 may 2014
declare function mix( kla as integer , f as single , klb as single ) as integer
const as single pi = atn( 1 ) * 4

const as integer black   = &h000000
const as integer red     = &hff0000
const as integer green   = &h00ff00
const as integer yellow  = &hffff00
const as integer blue    = &h0000ff
const as integer magenta = &hff00ff
const as integer cyan    = &h00ffff
const as integer white   = &hffffff

const as integer gray    = &h7f7f7f
const as integer pink    = &hff7f7f
const as integer orange  = &hff7f00
const as integer purple  = &h7f007f
dim shared as integer backcolor

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

type tsphere
   m as t3d
   r as single
   clr as integer
   declare sub fill( x as single , y as single , z as single , r as single , clr as integer )
   declare function hit( q as t3d , d as t3d ) as integer
   declare function dist( q as t3d , d as t3d ) as single
   declare function normal( q as t3d ) as t3d
end type
sub tsphere.fill( x as single , y as single , z as single , r as single , clr as integer )
   m.fill x , y , z
   this.r = r
   this.clr = clr
end sub
const as integer false = 0
const as integer true = not false
function tsphere.hit( q as t3d , d as t3d ) as integer
  dim as single b , c , d2
  b = 2 * d.x * ( q.x - this.m.x ) _
    + 2 * d.y * ( q.y - this.m.y ) _
    + 2 * d.z * ( q.z - this.m.z )
  c = ( q.x - this.m.x ) ^ 2 _
    + ( q.y - this.m.y ) ^ 2 _
    + ( q.z - this.m.z ) ^ 2 _
    - this.r ^ 2
  d2 = b *  - 4 * c
  return d2 > 0
end function
function tsphere.dist( q as t3d , d as t3d ) as single
  dim as single b , c
  b = 2 * d.x * ( q.x - this.m.x ) _
    + 2 * d.y * ( q.y - this.m.y ) _
    + 2 * d.z * ( q.z - this.m.z )
  c = ( q.x - this.m.x ) ^ 2 _
    + ( q.y - this.m.y ) ^ 2 _
    + ( q.z - this.m.z ) ^ 2 _
    - this.r ^ 2
  return ( b * -1 - sqr( b * b - 4 * c ) ) / 2
end function
function tsphere.normal( q as t3d ) as t3d
  return ( q - this.m ) / length( q - this.m )
end function

declare function ray( n as t3d , d as t3d ) as integer
declare function range( min as single , max as single ) as single

dim shared sphere( 10 ) as tsphere , light( 2 ) as t3d , i as integer

''fill spheres with random values
for i = 0 to ubound( sphere )
  sphere( i ).fill range( -500 , 500 )  _
                  , range( -350 , 350 ) _
                  , range( 100 , 500 ) _
                  , range( 10 , 300 ) _
                  , rgb( rnd * 255  , rnd  * 255 , rnd * 255 )
next i
declare function shade( kl as integer _
, f as t3d ) as integer
function shade( kl as integer , f as t3d ) as integer
  dim as integer r , g , b
  r = ( kl shr 16 ) and 255
  g = ( kl shr 8 ) and 255
  b = kl and 255
  return rgb( r * f.x , g * f.y , b * f.z )
end function
light( 0 ).fill -500,1000,0
light( 1 ).fill 0 , 1000 , 0
light( 2 ).fill 500,1000,0

dim x as single , y as single , n as t3d , d as t3d
screen 20 , 32
  backcolor = gray
  for x = -500 to 500
    for y = -350 to 350
      n.fill x , y , 0
      d.fill x*1000 , y*1000 , 5e4
      pset( x + 1024 / 2 , 768 / 2 - y ) , ray( n , d )
    next y
    if inkey <> "" then exit for
  next x
  print "ready"
  while inkey = ""
  wend
end
function ray( n as t3d , d as t3d ) as integer
''shoot a ray into the world and look if there is something
''retur color of object or if nothing then darkgray
  dim done as integer , i as integer , uit as integer _
  , tel as integer , led as t3d , bol as t3d
  dim as single l , dist
  uit = backcolor
  done = 0
    for i = 0 to ubound( sphere )
      if sphere( i ).hit( n  , d ) then
        uit = sphere( i ).clr
        tel = i
        done = 1
      end if
    next i
    if not done then
      return backcolor
    else
      l = length( d )
      dist = sphere( tel ).dist( n , d )
      bol = ( d - n ) / l * dist
      led = bol - n
      dim as t3d h
      h.x = angle( led , light( 0 ) )
      h.y = angle( led , light( 1 ) )
      h.z = angle( led , light( 2 ) )
      uit = shade( uit , h / pi  )
    end if
  return uit
end function
function mix( kla as integer , f as single , klb as single ) as integer
''mix 2 colors info 1 new color
''for colortransitions
  dim as integer ra , ga , ba , rb , gb , bb , r , g , b
  ra = ( kla shr 16 ) and 255
  ga = ( kla shr 8 ) and 255
  ba = kla and 255
  rb = ( klb shr 16 ) and 255
  gb = ( klb shr 8 ) and 255
  bb = klb and 255
  r = ra + ( rb - ra ) * f
  g = ga + ( gb - ga ) * f
  b = ba + ( bb - ba ) * f
  return rgb( r , g , b )
end function
function range( min as single , max as single ) as single
''returns a random number between min and max
    return rnd * ( max - min ) + min
end function
rolliebollocks
Posts: 2655
Joined: Aug 28, 2008 10:54
Location: new york

Re: ray casting

Postby rolliebollocks » May 12, 2014 16:18

Code: Select all

''ray casting 1.0
''bluatigro
''start : 10 may 2014
declare function mix( kla as integer , f as single , klb as single ) as integer
const as single pi = atn( 1 ) * 4

const as integer black   = &h000000
const as integer red     = &hff0000
const as integer green   = &h00ff00
const as integer yellow  = &hffff00
const as integer blue    = &h0000ff
const as integer magenta = &hff00ff
const as integer cyan    = &h00ffff
const as integer white   = &hffffff

const as integer gray    = &h7f7f7f
const as integer pink    = &hff7f7f
const as integer orange  = &hff7f00
const as integer purple  = &h7f007f
dim shared as integer backcolor

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

type tsphere
   m as t3d
   r as single
   clr as integer
   declare sub fill( x as single , y as single , z as single , r as single , clr as integer )
   declare function hit( q as t3d , d as t3d ) as integer
   declare function dist( q as t3d , d as t3d ) as single
   declare function normal( q as t3d ) as t3d
end type
sub tsphere.fill( x as single , y as single , z as single , r as single , clr as integer )
   m.fill x , y , z
   this.r = r
   this.clr = clr
end sub
const as integer false = 0
const as integer true = not false
function tsphere.hit( q as t3d , d as t3d ) as integer
  dim as single b , c , d2
  b = 2 * d.x * ( q.x - this.m.x ) _
    + 2 * d.y * ( q.y - this.m.y ) _
    + 2 * d.z * ( q.z - this.m.z )
  c = ( q.x - this.m.x ) ^ 2 _
    + ( q.y - this.m.y ) ^ 2 _
    + ( q.z - this.m.z ) ^ 2 _
    - this.r ^ 2
  d2 = b *  - 4 * c
  return d2 > 0
end function
function tsphere.dist( q as t3d , d as t3d ) as single
  dim as single b , c
  b = 2 * d.x * ( q.x - this.m.x ) _
    + 2 * d.y * ( q.y - this.m.y ) _
    + 2 * d.z * ( q.z - this.m.z )
  c = ( q.x - this.m.x ) ^ 2 _
    + ( q.y - this.m.y ) ^ 2 _
    + ( q.z - this.m.z ) ^ 2 _
    - this.r ^ 2
  return ( b * -1 - sqr( b * b - 4 * c ) ) / 2
end function
function tsphere.normal( q as t3d ) as t3d
  return ( q - this.m ) / length( q - this.m )
end function

declare function ray( n as t3d , d as t3d ) as uinteger
declare function range( min as single , max as single ) as single

dim shared sphere( 10 ) as tsphere , light( 2 ) as t3d , i as integer

''fill spheres with random values
for i = 0 to ubound( sphere )
  sphere( i ).fill range( -500 , 500 )  _
                  , range( -350 , 350 ) _
                  , range( 100 , 500 ) _
                  , range( 10 , 300 ) _
                  , rgb( rnd * 255  , rnd  * 255 , rnd * 255 )
next i
declare function shade( kl as integer _
, f as t3d ) as integer
function shade( kl as integer , f as t3d ) as integer
  dim as integer r , g , b
  r = ( kl shr 16 ) and 255
  g = ( kl shr 8 ) and 255
  b = kl and 255
  return rgb( r * f.x , g * f.y , b * f.z )
end function
light( 0 ).fill -500,1000,0
light( 1 ).fill 0 , 1000 , 0
light( 2 ).fill 500,1000,0

dim x as single , y as single , n as t3d , d as t3d
screen 20 , 32
  backcolor = gray
  for x = -500 to 500
    for y = -350 to 350
      n.fill x , y , 0
      d.fill x*1000 , y*1000 , 5e4
      pset( x + 1024 / 2 , 768 / 2 - y ) , ray( n , d )
    next y
    if inkey <> "" then exit for
  next x
  print "ready"
  while inkey = ""
  wend
end

function ray( n as t3d , d as t3d ) as uinteger
''shoot a ray into the world and look if there is something
''retur color of object or if nothing then darkgray
  dim done as uinteger , i as uinteger , uit as uinteger _
  , tel as uinteger , led as t3d , bol as t3d
  dim as single l , dist
  uit = backcolor
  done = 0
    for i = 0 to ubound( sphere )
       
      if sphere( i ).hit( n  , d ) then
        uit = sphere( i ).clr
        tel = i
        done = 1
      end if
    next i
    if done = 0 then 'not(done) screwed you up
      return backcolor
    else
      l = length( d )
      dist = sphere( tel ).dist( n , d )
      bol = ( d - n ) / l * dist
      led = bol - n
      dim as t3d h
      h.x = angle( led , light( 0 ) )
      h.y = angle( led , light( 1 ) )
      h.z = angle( led , light( 2 ) )
      uit = shade( uit , h / pi  )
    end if
  return uit
end function
function mix( kla as integer , f as single , klb as single ) as integer
''mix 2 colors info 1 new color
''for colortransitions
  dim as integer ra , ga , ba , rb , gb , bb , r , g , b
  ra = ( kla shr 16 ) and 255
  ga = ( kla shr 8 ) and 255
  ba = kla and 255
  rb = ( klb shr 16 ) and 255
  gb = ( klb shr 8 ) and 255
  bb = klb and 255
  r = ra + ( rb - ra ) * f
  g = ga + ( gb - ga ) * f
  b = ba + ( bb - ba ) * f
  return rgb( r , g , b )
end function
function range( min as single , max as single ) as single
''returns a random number between min and max
    return rnd * ( max - min ) + min
end function
 
frisian
Posts: 249
Joined: Oct 08, 2009 17:25

Re: ray casting

Postby frisian » May 13, 2014 21:23

bluatigro

You dusted of your old ray casting program, you have probely mist my last posting in http://www.freebasic.net/forum/posting.php?mode=reply&f=3&t=22506. (at the bottom)

I have incorporated my version of the function ray named ray_new and altered the program a bit, give it a try.
The math is complicated but it works very well and fast. The sphere's look as sphere should look in 2D.

Your program has sometimes some errors in the display when compiled with -s console this is caused by var's declared as single. The precision of single is too low better use double or always compile with -s GCC -o max.

Code: Select all

    ''ray casting 1.0
    ''bluatigro
    ''start : 10 may 2014
   
    declare function mix( kla as integer , f as single , klb as single ) as integer
    const as single pi = atn( 1 ) * 4
   
    const as integer black   = &h000000
    const as integer red     = &hff0000
    const as integer green   = &h00ff00
    const as integer yellow  = &hffff00
    const as integer blue    = &h0000ff
    const as integer magenta = &hff00ff
    const as integer cyan    = &h00ffff
    const as integer white   = &hffffff

    const as integer gray    = &h7f7f7f
    const as integer pink    = &hff7f7f
    const as integer orange  = &hff7f00
    const as integer purple  = &h7f007f
    dim shared as integer backcolor

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

    type tsphere
       m as t3d
       r as single
       clr as integer
       declare sub fill( x as single , y as single , z as single , r as single , clr as integer )
       declare function hit( q as t3d , d as t3d ) as integer
       declare function dist( q as t3d , d as t3d ) as single
       declare function normal( q as t3d ) as t3d
    end type
    sub tsphere.fill( x as single , y as single , z as single , r as single , clr as integer )
       m.fill x , y , z
       this.r = r
       this.clr = clr
    end sub
    const as integer false = 0
    const as integer true = not false
    function tsphere.hit( q as t3d , d as t3d ) as integer
      dim as single b , c , d2
      b = 2 * d.x * ( q.x - this.m.x ) _
        + 2 * d.y * ( q.y - this.m.y ) _
        + 2 * d.z * ( q.z - this.m.z )
      c = ( q.x - this.m.x ) ^ 2 _
        + ( q.y - this.m.y ) ^ 2 _
        + ( q.z - this.m.z ) ^ 2 _
        - this.r ^ 2
      d2 = b *  - 4 * c
      return d2 > 0
    end function
    function tsphere.dist( q as t3d , d as t3d ) as single
      dim as single b , c
      b = 2 * d.x * ( q.x - this.m.x ) _
        + 2 * d.y * ( q.y - this.m.y ) _
        + 2 * d.z * ( q.z - this.m.z )
      c = ( q.x - this.m.x ) ^ 2 _
        + ( q.y - this.m.y ) ^ 2 _
        + ( q.z - this.m.z ) ^ 2 _
        - this.r ^ 2
      return ( b * -1 - sqr( b * b - 4 * c ) ) / 2
    end function
    function tsphere.normal( q as t3d ) as t3d
      return ( q - this.m ) / length( q - this.m )
    end Function
   
'========================================================================

    dim shared sphere( 10 ) as tsphere , light( 2 ) as t3d , i as integer
'========================================================================

    function shade( kl as integer , f as t3d ) as integer
      dim as integer r , g , b
      r = ( kl shr 16 ) and 255
      g = ( kl shr 8 ) and 255
      b = kl and 255
      return rgb( r * f.x , g * f.y , b * f.z )
    end function


    function ray( n as t3d , d as t3d ) as uinteger
    ''shoot a ray into the world and look if there is something
    ''retur color of object or if nothing then darkgray
      dim done as uinteger , i as uinteger , uit as uinteger _
      , tel as uinteger , led as t3d , bol as t3d
      dim as single l , dist
      uit = backcolor
      done = 0
        for i = 0 to ubound( sphere )
           
          if sphere( i ).hit( n  , d ) then
            uit = sphere( i ).clr
            tel = i
            done = 1
          end if
        next i
        if done = 0 then 'not(done) screwed you up
          return backcolor
        else
          l = length( d )
          dist = sphere( tel ).dist( n , d )
          bol = ( d - n ) / l * dist
          led = bol - n
          dim as t3d h
          h.x = angle( led , light( 0 ) )
          h.y = angle( led , light( 1 ) )
          h.z = angle( led , light( 2 ) )
          uit = shade( uit , h / pi  )
        end if
      return uit
    end Function
     
    function mix( kla as integer , f as single , klb as single ) as integer
    ''mix 2 colors info 1 new color
    ''for colortransitions
      dim as integer ra , ga , ba , rb , gb , bb , r , g , b
      ra = ( kla shr 16 ) and 255
      ga = ( kla shr 8 ) and 255
      ba = kla and 255
      rb = ( klb shr 16 ) and 255
      gb = ( klb shr 8 ) and 255
      bb = klb and 255
      r = ra + ( rb - ra ) * f
      g = ga + ( gb - ga ) * f
      b = ba + ( bb - ba ) * f
      return rgb( r , g , b )
    end function
    function range( min as single , max as single ) as single
    ''returns a random number between min and max
        return rnd * ( max - min ) + min
    end Function 
 
'================================new ray routine============   
    Function ray_new(n As t3d, d As t3d ) As Integer

      Const limit = 1000

      Dim As t3d h, m, d1
      Dim As Integer r, i, i_sphere, uit
      Dim As Double b, c ,t , dist = limit
      Dim As Double line_start = n.x*n.x + n.y*n.y + n.z*n.z

      m = d * limit
      d1 = m - n

      Dim As Double a = d1.x*d1.x + d1.y*d1.y + d1.z*d1.z

      For i = 0 To UBound (sphere)

        b = 2*d1.x*(n.x-sphere(i).m.x) _
          + 2*d1.y*(n.y-sphere(i).m.y) _
          + 2*d1.z*(n.z-sphere(i).m.z)

        c = sphere(i).m.x*sphere(i).m.x _
          + sphere(i).m.y*sphere(i).m.y _
          + sphere(i).m.z*sphere(i).m.z + line_start _
          - 2*(  sphere(i).m.x*n.x _
               + sphere(i).m.y*n.y _
               + sphere(i).m.z*n.z )_
          - sphere(i).r*sphere(i).r

        If (b*b) > (4*a*c) Then ' (b^2-4ac) > 0 ray hits sphere
          t = (-b-(Sqr(b*b-a*c*4)))/(a*2)
          If t < dist Then   ' need to find the shortest distance (closer to viewpoint)
            dist = t
            i_sphere = i
          EndIf
        EndIf

      Next
      If dist = limit Then Return backcolor
      n += d1 * dist
      uit = sphere( i_sphere ).clr
      m = sphere( i_sphere ) .normal( n )
      h.x =1 - (angle( m , light( 0 ) ) / pi)
      h.y =1 - (angle( m , light( 1 ) ) / pi)
      h.z =1 - (angle( m , light( 2 ) ) / pi)
      uit = shade( uit , h )
      Return uit
    End Function
'=========================end of new ray routine============   

'================moved MAIN to end for clarity==============         
    ''fill spheres with random values
   
    Do

   
    for i = 0 to ubound( sphere )
      sphere( i ).fill range( -500, 500 ) _
                     , range( -350, 350 ) _
                     , range(  100, 500 ) _
                     , range(   10, 300 ) _
                     , rgb( rnd * 255, rnd  * 255, rnd * 255 )
    next i
   
   
    light( 0 ).fill -500, 1000, 0
    light( 1 ).fill    0, 1000, 0
    light( 2 ).fill  500, 1000, 0
   
    ' dim x as single , y as single , n as t3d , d as t3d
    Dim x as integer , y as integer , n as t3d , d as t3d      ' ### replaced single with integer
    screen 20 , 32
      backcolor = rgb( 128+rnd * 128,128+ rnd  * 128,128 +rnd * 128 ) ' ### random background color
      For y = -384 to 383                                      ' ### fill the hole screen
        For x = -512 to 511 
          n.fill x , y , 0
          ' d.fill x*1000 , y*1000 , 5e4
          ' pset( x + 1024 / 2 , 768 / 2 - y ) , ray( n , d )
          d.fill x * 50, y * 50, 5e4                           ' ### * 50 looks better
          pset( x + 1024 \ 2, 768 \ 2 - y ), ray_new( n , d )  ' ### replace / with \
          next x
        if inkey <> "" then exit for
      next y
      Sleep 3000
     Loop
      'Print "ready"
      'While inkey = ""
      'Wend
    End
bluatigro
Posts: 652
Joined: Apr 25, 2012 10:35
Location: netherlands

Re: ray casting

Postby bluatigro » May 14, 2014 11:55

update :
- now whit double's insted of single;s
- a 'sort' routine for hitted sphere;s on distance

error :
- the sphere's are to big
- no shading viseble

Code: Select all

''ray casting 1.2
''bluatigro
''10 may 2014 :
''    frist try
''14 may 2014 :
''    single repaced whit double
''    and mindistance is rememberd
declare function mix( kla as integer , f as double , klb as double ) as integer
const as double pi = atn( 1 ) * 4

const as integer black   = &h000000
const as integer red     = &hff0000
const as integer green   = &h00ff00
const as integer yellow  = &hffff00
const as integer blue    = &h0000ff
const as integer magenta = &hff00ff
const as integer cyan    = &h00ffff
const as integer white   = &hffffff

const as integer gray    = &h7f7f7f
const as integer pink    = &hff7f7f
const as integer orange  = &hff7f00
const as integer purple  = &h7f007f
dim shared as integer backcolor

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

type tsphere
   m as t3d
   r as double
   reflect as double
   clr as integer
   declare sub fill( x as double , y as double , z as double _
   , r as double , reflect as double , clr as integer )
   declare function hit( q as t3d , d as t3d ) as integer
   declare function dist( q as t3d , d as t3d ) as double
   declare function normal( q as t3d ) as t3d
end type
sub tsphere.fill( x as double , y as double , z as double _
, r as double , reflect as double , clr as integer )
   m.fill x , y , z
   this.r = r
   this.reflect = reflect
   this.clr = clr
end sub
const as integer false = 0
const as integer true = not false
function tsphere.hit( q as t3d , d as t3d ) as integer
  dim as double b , c , d2
  b = 2 * d.x * ( q.x - this.m.x ) _
    + 2 * d.y * ( q.y - this.m.y ) _
    + 2 * d.z * ( q.z - this.m.z )
  c = ( q.x - this.m.x ) ^ 2 _
    + ( q.y - this.m.y ) ^ 2 _
    + ( q.z - this.m.z ) ^ 2 _
    - this.r ^ 2
  d2 = b *  - 4 * c
  return d2 > 0
end function
function tsphere.dist( q as t3d , d as t3d ) as double
  dim as double b , c
  b = 2 * d.x * ( q.x - this.m.x ) _
    + 2 * d.y * ( q.y - this.m.y ) _
    + 2 * d.z * ( q.z - this.m.z )
  c = ( q.x - this.m.x ) ^ 2 _
    + ( q.y - this.m.y ) ^ 2 _
    + ( q.z - this.m.z ) ^ 2 _
    - this.r ^ 2
  return ( b * -1 - sqr( b * b - 4 * c ) ) / 2
end function
function tsphere.normal( q as t3d ) as t3d
  return ( q - this.m ) / length( q - this.m )
end function

declare function ray( n as t3d , d as t3d ) as integer
declare function range( min as double , max as double ) as double

dim shared sphere( 10 ) as tsphere , light( 2 ) as t3d , i as integer

sphere( 0 ).fill  200 ,  200 , 200 , 20 , 0 , red 
sphere( 1 ).fill    0 ,  200 , 200 , 20 , 0 , magenta 
sphere( 2 ).fill -200 ,  200 , 200 , 20 , 0 , blue
sphere( 3 ).fill  200 , -200 , 200 , 20 , 0 , yellow
sphere( 4 ).fill    0 , -200 , 200 , 20 , 0 , green 
sphere( 5 ).fill -200 , -200 , 200 , 20 , 0 , cyan
sphere( 6 ).fill    0 ,    0 , 200 , 20 , .5 , gray 
                 
declare function shade( kl as integer _
, f as t3d ) as integer
function shade( kl as integer , f as t3d ) as integer
  dim as integer r , g , b
  r = ( kl shr 16 ) and 255
  g = ( kl shr 8 ) and 255
  b = kl and 255
  return rgb( r * f.x , g * f.y , b * f.z )
end function
light( 0 ).fill -500,1000,0
light( 1 ).fill 0 , 1000 , 0
light( 2 ).fill 500,1000,0

dim x as double , y as double , n as t3d , d as t3d
screen 20 , 32
  backcolor = black
  for x = -500 to 500
    for y = -350 to 350
      n.fill x , y , 0
      d.fill x*1000 , y*1000 , 5e4
      pset( x + 1024 / 2 , 768 / 2 - y ) , ray( n , d )
    next y
    if inkey <> "" then exit for
  next x
  print "ready"
  while inkey = ""
  wend
end
function ray( n as t3d , d as t3d ) as integer
''shoot a ray into the world and look if there is something
''return color of object or if nothing then darkgray
  dim done as integer , i as integer , uit as integer _
  , uit2 as integer , tel as integer , led as t3d , bol as t3d
  dim as double l , dist , min = 1e10
  uit = backcolor
  done = 0
  ''look for hits whit sphere's
    for i = 0 to ubound( sphere )
      if sphere( i ).hit( n  , d ) then
        dist = sphere( i ).dist( n , d )
        ''remember shortest distance
        if dist < min then
          uit = sphere( i ).clr
          tel = i
          done = 1
          min = dist
        end if
      end if
    next i
    if done = 0 then
      ''no hit whit sphere
      return backcolor
    else
      l = length( d )
      bol = ( d - n ) / l * dist
      led = bol - sphere( tel ).m
      dim as t3d h
      h.x = angle( led , light( 0 ) )
      h.y = angle( led , light( 1 ) )
      h.z = angle( led , light( 2 ) )
      uit = shade( uit , h / pi  )
    end if
  return uit
end function
function mix( kla as integer , f as double , klb as double ) as integer
''mix 2 colors into 1 new color
''for colortransitions
  dim as integer ra , ga , ba , rb , gb , bb , r , g , b
  ra = ( kla shr 16 ) and 255
  ga = ( kla shr 8 ) and 255
  ba = kla and 255
  rb = ( klb shr 16 ) and 255
  gb = ( klb shr 8 ) and 255
  bb = klb and 255
  r = ra + ( rb - ra ) * f
  g = ga + ( gb - ga ) * f
  b = ba + ( bb - ba ) * f
  return rgb( r , g , b )
end function
function range( min as double , max as double ) as double
''returns a random number between min and max
    return rnd * ( max - min ) + min
end function

Return to “General”

Who is online

Users browsing this forum: No registered users and 13 guests