Dark Bit Factory & Gravity

PROGRAMMING => Other languages => Yabasic => Topic started by: Clanky on March 30, 2007

Title: Rotating Cube
Post by: Clanky on March 30, 2007
Wow. Saw the sample in the yabasic library - coded by Shockwave!!!

I changed some of it, made it so you can zoom in/out, make the cube transparent (has some glitches because of style = 1 - style... changes too quick some times), and the cube floats around the screen.
If I could have done that with VB... woooooooow!!!

But owell. I like this demo.

Shockwave: Wow! Nice 3D Cube demo.  :updance:

Code: [Select]
open window 640,512

gosub initialise

repeat
  setdrawbuf dw
  dw = 1 - dw
  setdispbuf dw
  clear window
  if style = 0 gosub stars
gosub rotate
gosub construct
  if style = 1 gosub stars
  rem Make Cube Move
  if wip <= 0 wp = 0
  if wip >= 5 wp = 1
  if wp = 0 wip = wip + 0.05
  if wp = 1 wip = wip - 0.05
  rem Zoom In / Out
  if (size < 24 and peek("port1") = 16) size = size + 0.5
  if (size > 1.5 and peek("port1") = 64) size = size - 0.5
  rem Change Style
  if peek("port1") = 16384 style = 1 - style
until (peek("port1") = 8)
exit

label stars
  for i = 1 to stars
    star_y(i) = star_y(i) + speed(i)
    if star_y(i) >= 512 then
      star_x(i) = ran(640)
      speed(i) = ran(3) + 1
      star_y(i) = 0
    fi
    setrgb 1, 80 * speed(i), 80 * speed(i), 100 * speed(i)
    dot star_x(i), star_y(i)
  next
return

label construct
  for a = 1 to faces
    gosub draw
  next a
return

label draw
rem Draw Faces
vx1 = tx(f1(a)) - tx(f2(a))
vy1 = ty(f1(a)) - ty(f2(a))
vx2 = tx(f3(a)) - tx(f2(a))
vy2 = ty(f3(a)) - ty(f2(a))
n = (vx1 * vy2 - vx2 * vy1) + 50
  if n < 0 then
    n = - (n / 1000)
    setrgb 1, r(a) + n, g(a) + n, b(a) + n
    fill triangle tx(f1(a)), ty(f1(a)) to tx(f2(a)), ty(f2(a)) to tx(f3(a)), ty(f3(a))
    fill triangle tx(f1(a)), ty(f1(a)) to tx(f4(a)), ty(f4(a)) to tx(f3(a)), ty(f3(a))
    if cls(a) = 1 then
      setrgb 1, 150, 150, 150
      line tx(f1(a)), ty(f1(a)), tx(f2(a)), ty(f2(a))
      line tx(f2(a)), ty(f2(a)), tx(f3(a)), ty(f3(a))
      line tx(f3(a)), ty(f3(a)), tx(f4(a)), ty(f4(a))
      line tx(f4(a)), ty(f4(a)), tx(f1(a)), ty(f1(a))
    fi
  fi
return

label rotate
  for a = 1 to points
    x1 = x(a)
    y1 = y(a)
    z1 = z(a)
    rem Rotation and Movement
    xx = x1
    yy = y1 * cs(xr) + z1 * sn(xr) + wip
    zz = z1 * cs(xr) - y1 * sn(xr) + wip
    y1 = yy
    x1 = xx * cs(yr) - zz * sn(yr) + wip
    z1 = xx * sn(yr) + zz * cs(yr) + wip
    zz = z1
    xx = x1 * cs(zr) - y1 * sn(zr) + wip
    yy = x1 * sn(zr) + y1 * cs(zr) + wip
    rem Perspective
    dv = (zz / 40) + 1
    xx = size * (xx / dv) + 320
    yy = size * (yy / dv) + 256
    tx(a) = xx
    ty(a) = yy
    tz(a) = zz
  next a
xr = xr + 3
yr = yr + 2
zr = zr + 5
  if xr > 720 xr = xr - 720
  if yr > 720 yr = yr - 720
  if zr > 720 zr = zr - 720
return

label initialise
rem Get Star Position and Speed
stars = 100
dim star_x(stars), star_y(stars), speed(stars)
  for i = 1 to stars
    setdrawbuf dw
    dw = 1 - dw
    setdispbuf dw
    clear window
    star_x(i) = ran(640):star_y(i) = ran(512)
    speed(i) = ran(3) + 1
    text 10, 20, "STARS: " + str$(i)
    fill rect 100, 247, 100 + (i * 4), 263
    rect 100, 247, 500, 263
  next
rem Cube Initialise
size = 12
dw = 1
points = 8
faces = 6
dim x(points), y(points), z(points), tx(points), ty(points), tz(points)
dim f1(faces), f2(faces), f3(faces), f4(faces), r(faces), g(faces), b(faces), cls(faces)
dim cs(720), sn(720)
  for ang = 0 to 720
    cs(ang) = cos(ang * (pi / 360))
    sn(ang) = sin(ang * (pi / 360))
  next ang
  rem Get Cube Points
  for a = 1 to points
    read x(a), y(a), z(a)
  next a
  rem Get Face Parameters and Connections
  for a = 1 to faces
    read f1(a)
    read f2(a)
    read f3(a)
    read f4(a)
    read r(a), g(a), b(a), cls(a)
  next a
rem Objects X, Y, Z Points
data -10, 10, 10, 10, 10, 10, 10,-10, 10,-10,-10, 10
data -10, 10,-10, 10, 10,-10, 10,-10,-10,-10,-10,-10
rem Connections, Colour and Shaded
data 1, 2, 3, 4, 30, 0, 0, 1
data 5, 8, 7, 6, 30, 0, 0, 1
data 6, 2, 1, 5, 0, 30, 0, 1
data 8, 4, 3, 7, 0, 30, 0, 1
data 2, 6, 7, 3, 0, 0, 30, 1
data 8, 5, 1, 4, 0, 0, 30, 1
return

Title: Re: Rotating Cube
Post by: Shockwave on March 30, 2007
Nice adaption mate :)
Title: Re: Rotating Cube
Post by: rain_storm on March 30, 2007
blindingly fast  ;D