Posted: 6th Mar 2003 6:36
One of my "let's tinker about" programs, a DBPro program based on a card trick.

+ Code Snippet
sync on : sync rate 40 : hide mouse
randomize timer() : autocam off
color backdrop rgb(0,0,64)

dim n(21) : dim c1(7) : dim c2(7) : dim c3(7)

set text font "ariel" : set text size 52 : set text to bold

` set textures
for num = 1 to 21
  box 0,0,64,64,rgb(220,0,0),rgb(220,220,0),rgb(220,0,220),rgb(0,0,220)
  box 4,4,60,60,rgb(190,0,0),rgb(190,190,0),rgb(190,0,190),rgb(0,0,190)

  n$ = str$(num) : oy = text height(n$) / 2
  ink 0,0
  center text 31,32 - oy,n$ : center text 33,32 - oy,n$
  center text 32,31 - oy,n$ : center text 32,33 - oy,n$
  ink rgb(255,255,255),0 : center text 32,32 - oy,n$
  if num = 6 or num = 9 then box 26,53,38,55

  get image num,0,0,64,64,1
next num

` set objects
make object cube 1,9 : set object 1,1,0,1,1,1,0,1
for obj = 2 to 22 : clone object 1,obj : set object obj,1,0,1,1,1,0,1 : next obj

for obj = 1 to 19 step 3
  z = obj * 4 + 20
  position object obj,35,4.5,z
  position object obj + 1,50,4.5,z
  position object obj + 2,65,4.5,z
next obj

position object 22,50,45,-20

` set camera and lights
position camera 50,45,5 : point camera 50,0,50
set point light 0,50,45,5 : set ambient light 25

SetNumbers()
set text size 18

do
  if stage  n2

    t = n(n1)
    n(n1) = n(n2)
    n(n2) = t
  next i

  for i = 1 to 21 : texture object i,n(i) : next i
endfunction

function ReOrder(b)
  ` re-order textures on cubes depending on user selection

  if b = 1 : a = 2 : c = 3 : endif
  if b = 2 : a = 1 : c = 3 : endif
  if b = 3 : a = 1 : c = 2 : endif

  for i = 1 to 7
    c1(i) = n(a) : c2(i) = n(b) : c3(i) = n(c)
    inc a,3 : inc b,3 : inc c,3
  next i

  a = 1 : b = 8 : c = 15
  for i = 1 to 7
    n(a) = c1(i) : n(b) = c2(i) : n(c) = c3(i)
    inc a,1 : inc b,1 : inc c,1
  next i

  for i = 1 to 21 : texture object i,n(i) : next i
endfunction

function AnimateCubes(v#)
  for obj = 1 to 19 step 3
    oy# = 5.0 + sin(v#) * 3.0

    for i = 0 to 2
      ob = obj + i
      position object ob,object position x(ob),oy#,object position z(ob)
    next i

    v# = wrapvalue(v# + 30.0)
  next obj
endfunction
Posted: 6th Mar 2003 6:38
Unbeleivable!!! It didn't post properly
Let's try again.

+ Code Snippet
sync on : sync rate 40 : hide mouse
randomize timer() : autocam off
color backdrop rgb(0,0,64)

dim n(21) : dim c1(7) : dim c2(7) : dim c3(7)

set text font "ariel" : set text size 52 : set text to bold

` set textures
for num = 1 to 21
  box 0,0,64,64,rgb(220,0,0),rgb(220,220,0),rgb(220,0,220),rgb(0,0,220)
  box 4,4,60,60,rgb(190,0,0),rgb(190,190,0),rgb(190,0,190),rgb(0,0,190)

  n$ = str$(num) : oy = text height(n$) / 2
  ink 0,0
  center text 31,32 - oy,n$ : center text 33,32 - oy,n$
  center text 32,31 - oy,n$ : center text 32,33 - oy,n$
  ink rgb(255,255,255),0 : center text 32,32 - oy,n$
  if num = 6 or num = 9 then box 26,53,38,55

  get image num,0,0,64,64,1
next num

` set objects
make object cube 1,9 : set object 1,1,0,1,1,1,0,1
for obj = 2 to 22 : clone object obj,1 : set object obj,1,0,1,1,1,0,1 : next obj

for obj = 1 to 19 step 3
  z = obj * 4 + 20
  position object obj,35,4.5,z
  position object obj + 1,50,4.5,z
  position object obj + 2,65,4.5,z
next obj

position object 22,50,45,-20

` set camera and lights
position camera 50,45,5 : point camera 50,0,50
set point light 0,50,45,5 : set ambient light 25

SetNumbers()
set text size 18

do
  if stage <= 2
    AnimateCubes(ang#) : ang# = wrapvalue(ang# + 1.0)

    if stage = 0 then center text 320,12,"Think of a numbered cube and then tell me which column it is in."
    if stage = 1 then center text 320,12,"OK which column is it in now?."
    if stage = 2 then center text 320,12,"And finaly, where now?"

    center text 320,28,"Press A, B or C"
    center text 180,450,"A" : center text 320,450,"B" : center text 460,450,"C"

    k$ = inkey$()
    if (k$ = "a") or (k$ = "b") or (k$ = "c")
      repeat : until scancode() = 0
      if k$="a" then ReOrder(1)
      if k$="b" then ReOrder(2)
      if k$="c" then ReOrder(3)
      stage = stage + 1
    endif
  else
    ` display nubered cube user selected
    texture object 22,n(11) : position object 22,50,45,-100
    point camera 50,45,-15

    repeat
      position object 22,50,45,curvevalue(-15,object position z(22),30)
      turn object left 22, 0.5 : roll object right 22, 0.66
      center text 320,12,"This is the numbered cube you thought of!"
      center text 320,28,"Press Return to try again or Escape to exit."
      sync
    until returnkey()

    point camera 50,0,50
    SetNumbers()
    stage = 0
  endif

  sync
loop

` ------------------------------------------------------------------------

function SetNumbers()
  ` randomize textures on cubes

  for i = 1 to 21 : n(i) = i : next i

  for i = 1 to 1000
    n1 = rnd(20)+1
    repeat : n2 = rnd(20)+1 : until n1 <> n2

    t = n(n1)
    n(n1) = n(n2)
    n(n2) = t
  next i

  for i = 1 to 21 : texture object i,n(i) : next i
endfunction

function ReOrder(b)
  ` re-order textures on cubes depending on user selection

  if b = 1 : a = 2 : c = 3 : endif
  if b = 2 : a = 1 : c = 3 : endif
  if b = 3 : a = 1 : c = 2 : endif

  for i = 1 to 7
    c1(i) = n(a) : c2(i) = n(b) : c3(i) = n(c)
    inc a,3 : inc b,3 : inc c,3
  next i

  a = 1 : b = 8 : c = 15
  for i = 1 to 7
    n(a) = c1(i) : n(b) = c2(i) : n(c) = c3(i)
    inc a,1 : inc b,1 : inc c,1
  next i

  for i = 1 to 21 : texture object i,n(i) : next i
endfunction

function AnimateCubes(v#)
  for obj = 1 to 19 step 3
    oy# = 5.0 + sin(v#) * 3.0

    for i = 0 to 2
      ob = obj + i
      position object ob,object position x(ob),oy#,object position z(ob)
    next i

    v# = wrapvalue(v# + 30.0)
  next obj
endfunction



Edit: Have made a slight adjustment to Clone Object on line 26, so it runs with Patch 4.
Posted: 10th Mar 2003 17:38
That's really cool! I particularly like the cloned start up matrix and the "wobble" simple trick though but effective.
Posted: 10th Mar 2003 23:21
...and there was I thinking that this snippet was so dull and boring that I wasn't going to get a response hehe
Posted: 7th Apr 2003 3:25
That was pretty cool, interesting.
Posted: 7th Apr 2003 3:53
Gosh! Two responces in a month! I think I'm going to faint hehe

Seriously though, I have made a small edit in the code above so it will run with DBPro Patch 4 (praise to the edit button!), however if anyone is having problems with Patch 4 and has gone back to Patch 3.1 then you will need to change Clone Object obj,1 on line 26 to Clone Object 1,obj
Posted: 7th Apr 2003 9:18
impresibe