Sorry your browser is not supported!

Rem Project: newton's cradle
Rem Created: 20.12.2005 21:18:25

Rem ***** Main Source File *****

sync on : sync rate 60 : backdrop off : autocam off

hnd = make memory(4)

load dll "winmm.dll", 1
call dll 1, "midiOutOpen", hnd, -1, 0, 0, 0

hmo = *hnd

make object box 99, 600, 1, 350
make object box 100, 500, 1, 250
perform csg difference 99, 100
delete object 100

make object plain 100, 500, 250
pitch object up 100, 90
set reflection shading on 100

make object sphere 101, 1500, 32, 32
color object 101, rgb(250, 200, 0)
set object cull 101, 0

MakeBalls()
MakeRack(6)
SyncCams(6, 7)

create bitmap 1, 600, 350

lock pixels
for x = 0 to bitmap width()
   for y = 0 to bitmap height()
      c = rnd(100)
      dot x , y, rgb(c + 100, c + 50, 0)
   next y
next x
unlock pixels
get image 99, 0, 0, bitmap width(), bitmap height(), 1

lock pixels
for x = 0 to bitmap width()
   for y = 0 to bitmap height()
      r = (GrayScale(x - 1, y) - GrayScale(x + 1, y) + 255) / 2
      g = (GrayScale(x, y - 1) - GrayScale(x, y + 1) + 255) / 2
      dot x, y, rgb(r, g, 255)
   next y
next x
unlock pixels
get image 100, 0, 0, bitmap width(), bitmap height(), 1

delete bitmap 1

texture object 99, 99
set bump mapping on 99, 100

repeat

   set camera to follow 0, 0, 0, a#, 500, 250 + sin(a#) * 50, 1, 0
   point camera 0, 0, 0

   a# = a# + 0.7

   set cursor 0, 0
   print screen fps()

   inc o : if o > 5 then o = 1
   SyncCams(o, 1)

   if t < timer()
      call dll 1, "midiOutShortMsg", hmo, 0x000073c0
      call dll 1, "midiOutShortMsg", hmo, 0x007f4690
      t = timer() + 1000
   endif

until mouseclick()

delete memory hnd
delete dll 1
end

function GrayScale(x, y)

   if x < 0 then x = 0
   if y < 0 then y = 0
   if x > bitmap width() then x = bitmap width()
   if y > bitmap height() then y = bitmap height()
   c = point(x, y)
   c = rgbr(c) * 0.30 + rgbg(c) * 0.59 + rgbb(c) * 0.11

endfunction c


function MakeRack(o)

   make object cylinder o, 10
   make mesh from object 1, o
   delete object o
   make object sphere o, 10
   make mesh from object 2, o
   delete object o

   restore rackdata

   make object cylinder o, 10
   for l = 0 to 7
      read x, z
      if l then add limb o, l, 1
      scale limb o, l, 100, 2500, 100
      offset limb o, l, x, 125, z
      inc l
      add limb o, l, 2
      offset limb o, l, x, 250, z
   next l
   for l = 8 to 9
      read z
      add limb o, l, 1
      scale limb o, l, 100, 4600, 100
      rotate limb o, l, 0, 0, 90
      offset limb o, l, 0, 250, z
   next l

   delete mesh 1
   delete mesh 2

   rackdata:
   data 230, 100, 230, -100, -230, 100, -230, -100, 100, -100

endfunction

function MakeBalls()

   x = -150
   for o = 1 to 5
      make object sphere o, 75, 32, 32
      position object o, x, 75, 0
      make object triangle o + 10, x, 250, -100, x, 100, 0.5, x, 100, -0.5
      make object triangle o + 20, x, 250,  100, x, 100, 0.5, x, 100, -0.5
      inc x, 75
   next o

endfunction

function SyncCams(o, i)

   dec i

   restore camdata

   for c = 1 to 6

      make camera c

      read x, y, z
      rotate camera c, x, y, z
      position camera c, object position x(o), object position y(o), object position z(o)

      set camera aspect c, 1.0
      set camera fov c, 90
      set camera to image c, i + c, 128, 128

   next c

   sync

   for c = 1 to 6 : delete camera c : next c

   set cube mapping on o, i + 1, i + 2, i + 3, i + 4, i + 5, i + 6

   camdata:
   data 0, 90, 0, 0, 270, 0, 270, 0, 0, 90, 0, 0, 0, 0, 0, 0, 180, 0

endfunction

for x = 0 to bitmap width()-1
for y = 0 to bitmap height()-1

for x = 0 to bitmap width()-1
for y = 0 to bitmap height()-1

if x > (bitmap width()-1) then x = bitmap width()-1
if y > (bitmap height()-1) then y = bitmap height()-1

set window title "Newtons cradle"