-----------------------------------

DanShadow

Thu Jan 08, 2004 8:42 pm


[source] 3D (kind of) rotation source

-----------------------------------

I thought someone might find use for this...by using all the numbers on the number pad, you can rotate a cube in all directions. Also, you can move the 'z' axis with the arrow keys.

var pntx, pnty : array 1 .. 8 of int
pntx (1) := 200
pntx (2) := 150
pntx (3) := 200
pntx (4) := 150
pntx (5) := 230
pntx (6) := 180
pntx (7) := 230
pntx (8) := 180
pnty (1) := 200
pnty (2) := 200
pnty (3) := 150
pnty (4) := 150
pnty (5) := 230
pnty (6) := 230
pnty (7) := 180
pnty (8) := 180
var key : string (1) := ""
proc drawCube
    Draw.Box (pntx (1), pnty (1), pntx (4), pnty (4), 255)
    Draw.Box (pntx (5), pnty (5), pntx (8), pnty (8), 255)
    Draw.Line (pntx (1), pnty (1), pntx (5), pnty (5), 255)
    Draw.Line (pntx (3), pnty (3), pntx (7), pnty (7), 255)
    Draw.Line (pntx (2), pnty (2), pntx (6), pnty (6), 255)
    Draw.Line (pntx (4), pnty (4), pntx (8), pnty (8), 255)
end drawCube
loop
    setscreen ("offscreenonly")
    View.Update
    Draw.FillBox (0, 0, maxx, maxy, 0)
    key := ""
    if hasch then
        getch (key)
    end if
    drawCube
    if key = "5" then
        pntx (1) := 200
        pntx (2) := 150
        pntx (3) := 200
        pntx (4) := 150
        pntx (5) := 230
        pntx (6) := 180
        pntx (7) := 230
        pntx (8) := 180
        pnty (1) := 200
        pnty (2) := 200
        pnty (3) := 150
        pnty (4) := 150
        pnty (5) := 230
        pnty (6) := 230
        pnty (7) := 180
        pnty (8) := 180
    elsif key = "6" then
        for i : 1 .. 4
            pntx (i) := pntx (i) + 2
        end for
        for i : 5 .. 8
            pntx (i) := pntx (i) - 2
        end for
    elsif key = "4" then
        for i : 1 .. 4
            pntx (i) := pntx (i) - 2
        end for
        for i : 5 .. 8
            pntx (i) := pntx (i) + 2
        end for
    elsif key = "8" then
        for i : 1 .. 4
            pnty (i) := pnty (i) + 2
        end for
        for i : 5 .. 8
            pnty (i) := pnty (i) - 2
        end for
    elsif key = "2" then
        for i : 1 .. 4
            pnty (i) := pnty (i) - 2
        end for
        for i : 5 .. 8
            pnty (i) := pnty (i) + 2
        end for
    elsif key = "7" then
        for i : 1 .. 4
            pntx (i) := pntx (i) - 2
            pnty (i) := pnty (i) + 2
        end for
        for i : 5 .. 8
            pntx (i) := pntx (i) + 2
            pnty (i) := pnty (i) - 2
        end for
    elsif key = "9" then
        for i : 1 .. 4
            pntx (i) := pntx (i) + 2
            pnty (i) := pnty (i) + 2
        end for
        for i : 5 .. 8
            pntx (i) := pntx (i) - 2
            pnty (i) := pnty (i) - 2
        end for
    elsif key = "1" then
        for i : 1 .. 4
            pntx (i) := pntx (i) - 2
            pnty (i) := pnty (i) - 2
        end for
        for i : 5 .. 8
            pntx (i) := pntx (i) + 2
            pnty (i) := pnty (i) + 2
        end for
    elsif key = "3" then
        for i : 1 .. 4
            pntx (i) := pntx (i) + 2
            pnty (i) := pnty (i) - 2
        end for
        for i : 5 .. 8
            pntx (i) := pntx (i) - 2
            pnty (i) := pnty (i) + 2
        end for
    elsif key = (KEY_UP_ARROW) then
        for i : 1 .. 8
            pnty (i) := pnty (i) + 2
        end for
    elsif key = (KEY_DOWN_ARROW) then
        for i : 1 .. 8
            pnty (i) := pnty (i) - 2
        end for
    elsif key = (KEY_RIGHT_ARROW) then
        for i : 1 .. 8
            pntx (i) := pntx (i) + 2
        end for
    elsif key = (KEY_LEFT_ARROW) then
        for i : 1 .. 8
            pntx (i) := pntx (i) - 2
        end for
    end if
    locate (1, 1)
    put "Controls:"
    put ""
    put "7   8   9"
    put "4   5   6"
    put "1   2   3"
    put "And Arrow Keys"
end loop



-----------------------------------

roer

Thu Jan 08, 2004 11:21 pm



-----------------------------------

Nice  :P Bugs a plenty but they can be sorted out, box grows to outrageous preportions lol
Have some bits!!!!  :P


-----------------------------------

Boarder16

Thu Jan 08, 2004 11:24 pm



-----------------------------------

dan sahdow you never cease to amaze me lol, sweet program... nice work with the rotating...  i'd give u bits but i wanna add a name color soon.. :lol:


-----------------------------------

DanShadow

Fri Jan 09, 2004 9:40 am



-----------------------------------

hehe, thanks all.  :D


-----------------------------------

Maverick

Fri Jan 09, 2004 12:57 pm



-----------------------------------

great job.
For your good program you have received:
http://server5.uploadit.org/files2/070104-choclate%20chip%20cookie.bmp


-----------------------------------

DanShadow

Fri Jan 09, 2004 2:34 pm



-----------------------------------

hehe...tx

"Where do I claim  my fabulous prize?!"