[comp.sys.handhelds] Rotate 3d objects on HP48

cmeyer@milton.u.washington.edu (Colin Meyer) (11/09/90)

Rotate 3d V1 for HP48's.

Here is my nifty program for rotating three dimensional shapes.
It even does perspectives, but no hidden line removal. Maybe on V2.

It is based on Three-Dimensional Graphics in Turbo Pascal, Computer 
Language, Sept. 1990.

The Programs/Variables:

 SROTATE: start rotation.
 SANIMATE: save grobs on stack (in FRAMES), start animation.
 ANIMATE: start animation of previously saved grobs.
 FRAMES: a list of grobs to animate.
 OCTO: shape - an octohedron
 CONE: shape - actually a six sided pyramid
 CUBE: shape - cube!
 
(Don't worry about the rest of the programs, they're just my strange
 attempt at modular programming!)

Shapes are specified by a list of two lists, a list of vertices (3d 
vectors) and a list of lines between vertices:

{ { [x1 y1 z1]
    [x2 y2 z2]
    ...
    [xn yn zn] }
  { v1 v2
    v3 v4
    ...
    vn vn+1 } }

Each pair of vertices in the line list specifies one line. For instance, 
{ 1 2 } would be a list with only one line, between vertex 1 and vertex 2.
{ 1 2 2 3} would be a list with two lines, the first between vertices 1
and 2, and the second between vertices 2 and 3.

To Use:

1: shape (list of lists, as described about)

[SROTATE]

The Initial View is how the object is initially oriented.
The object will be rotated on the third axis (the one not chosen for one 
of the initial rotations).
X axis = 1, Y axis = 2, Z = 3.

Distance views from: is in user units (try about the same as the width
of the screen).

Rotation options: are as follows:

:Start\<): - the angle to start the rotation at.
:End\<): - the angle to end the rotation at.
:inc: - the increment of the angle between views.

(to do a complete circle, start at 0 degrees, end at 351 and do an 
 increment of 9 - I've found 9 degrees is a small enough jump for smooth
 animation.)

Rotate on new or 
original axes?

-this refers to the initial view. Before that view is the original axes, 
 during that view is the new axes. Confused? Just try both ways & you'll
 understand.

Save as grobs for 
later animation?

-self explanatory.
 If you do choose to save grobs, You'll have to choose how big a grob to 
 save. The program will draw the first frame, and prompt you for corners
 of the grob to save. Move the cursor to each corner, and press [ENTER]
 at each. Make sure to make the grob a bit bigger than the picture, 
 because as it rotates, it may go out of close boundaries. After marking
 corners, you must push [ATTN], then [ORANGE] [CONT].

The program will then go ahead and draw all the frames, saving them as 
grobs on the stack if you chose so. 

When you end up with a bunch of grobs on the stack, Press [SANIMATE] to
save them in the variable FRAMES and then animate them.

Whenever you already have grobs saved in FRAMES, just press [ANIMATE].     

To start, try a cube, and these options:

1: (the cube)

[SROTATE]

:Axis1:1
:\<)1:30 [ENTER]

:Axis2:2
:\<)2:30 [ENTER] 

Distance viewed from:

7 [ENTER]

Rotation options:
:Start\<):0
:End\<):351
:inc:9 [ENTER]

Rotate on new or 
original axes?

[ORIG]

Save as grobs for 
later animation?

[NO]

(sit back and enjoy).


-----CUT HERE-----
%%HP: T(3)A(D)F(.);
DIR
  SROTATE
    \<< 1 2 CF CF
"Initial View:" DUP
{ ":Axis1:
:\<)1:" {
1 8 } } INPUT SWAP
{ ":Axis2:
:\<)2:" {
1 8 } } INPUT SWAP
OBJ\-> DTAG SWAP DTAG
DUP 3 ROLLD R3D ROT
OBJ\-> DTAG SWAP DTAG
DUP 3 ROLLD R3D
SWAP 4 ROLL + 3
ROLLD * SWAP NEG 6
+
"Distance viewed from:"
"" INPUT OBJ\->
"Rotation options:"
{
":Start\<):
:End\<):
:inc:"
{ 1 9 } } INPUT
OBJ\-> DTAG ROT DTAG
ROT DTAG ROT 4 ROLL
5 ROLL 6 ROLL 7
ROLL OBJ\-> DROP
CLLCD
"Rotate on new or 
original axes?"
3 DISP { "NEW" ""
"" "" "" "ORIG" }
TMENU 0
      DO DROP -1
WAIT
      UNTIL { 16.1
11.1 } SWAP POS DUP
DUP
        IF NOT
        THEN 880 .1
BEEP
        END
      END 0 MENU 1
-
      IF
      THEN 1 SF
      END CLLCD
"Save as grobs for 
later animation?"
3 DISP YN
      IF
      THEN 2 SF
      END ROTATE 1 2
CF CF
    \>>
  ANIMATE
    \<< { # 0h # 0h }
PVIEW
      DO FRAMES OBJ\->
1 SWAP
        START PICT
{ # 14h # Ah } ROT
REPL
        NEXT
      UNTIL 0
      END
    \>>
  SANIMATE
    \<< DEPTH \->LIST
'FRAMES' STO ANIMATE
    \>>
  OCTO { {
[ 0 1 1 ]
[ 0 1 -1 ]
[ 0 -1 -1 ]
[ 0 -1 1 ]
[ -1 0 0 ]
[ 1 0 0 ]
} { 1 2 2 3 3 4 4 1
5 1 5 2 5 3 5 4 6 1
6 2 6 3 6 4 } }
  CONE { {
[ 0 1 0 ]
[ -.809 -1 .588 ]
[ -.809 -1 -.588 ]
[ .309 -1 -.951 ]
[ 1 -1 0 ]
[ .309 -1 .951 ]
} { 1 2 1 3 1 4 1 5
1 6 2 6 2 3 3 4 4 5
5 6 } }
  CUBE { {
[ -1 1 1 ]
[ 1 1 1 ]
[ -1 -1 1 ]
[ 1 -1 1 ]
[ -1 1 -1 ]
[ 1 1 -1 ]
[ -1 -1 -1 ]
[ 1 -1 -1 ]
} { 1 2 2 4 4 3 3 1
5 6 6 8 8 7 7 5 1 5
2 6 4 8 3 7 } }
  FRAMES 0
  ROTATE
    \<< \-> inc dst ax
r pnts lines
      \<<
        IF 2 FS?
        THEN ERASE
OVER ax R3D r
          IF 1 FS?
          THEN SWAP
          END *
pnts SWAP dst NOBJ
lines SKETCH PICT {
# 3h # 0h }
GROB 121 6 79EE60CE62DD81CD18B9B18B3039A3001B42A02AA6545045048AA209288AA0007F4E602A6EDD804D14B9A109209BA3001D42A02AAA54114504AAA20920A29000794EA0CEA2D5D0C508BAB10938929B0000000000000000000000000000000000
REPL GRAPH HALT
        ELSE 0 0
        END \-> p1 p2
        \<< ERASE {
# 0h # 0h } PVIEW
          FOR j j
ax R3D r
            IF 1
FS?
            THEN
SWAP
            END *
pnts SWAP dst NOBJ
lines ERASE SKETCH
            IF 2
FS?
            THEN
PICT p1 p2 SUB
            END inc
          STEP
        \>>
      \>>
    \>>
  R3D
    \<<
[[ 0 0 0 ]
 [ 0 0 0 ]
 [ 0 0 0 ]]
OVER DUP 2 \->LIST 1
PUT R\|v 3 MOD 1 +
DUP 3 MOD 1 + ROT
SIN LASTARG COS \->
m1 m2 s c
      \<< R\|^ m2 m2 2
\->LIST c PUT m1 m1 2
\->LIST c PUT m2 m1 2
\->LIST s NEG PUT m1
m2 2 \->LIST s PUT
      \>>
    \>>
  NOBJ
    \<< \-> r d
      \<< { } R\|v OBJ\->
1 SWAP
        START r d
NVERT R\->C R\|^ + R\|v
        NEXT R\|^
      \>>
    \>>
  SKETCH
    \<< SWAP 'PNTS'
STO OBJ\-> 2 / 1 SWAP
      START PNTS
SWAP GET SWAP PNTS
SWAP GET LINE
      NEXT 'PNTS'
PURGE
    \>>
  NVERT
    \<< R\|v SWAP * V\->
R\|^ DUP ROT + / DUP
ROT * R\|v * R\|^
    \>>
  PPAR {
(-4.09375,-2)
(4.09375,2) X 0
(0,0) FUNCTION Y }
  YN
\<< { "YES"
GROB 21 8 000000000000000000000000000000000000000000000000
GROB 21 8 000000000000000000000000000000000000000000000000
GROB 21 8 000000000000000000000000000000000000000000000000
GROB 21 8 000000000000000000000000000000000000000000000000
"NO" } TMENU 0
  DO DROP -1 WAIT
  UNTIL { 16.1 11.1
} SWAP POS DUP DUP
    IF NOT
    THEN 880 .1
BEEP
    END
  END 0 MENU 1 -
\>>
  R\|v
\<< DEPTH ROLLD
\>>
  R\|^
\<< DEPTH ROLL
\>>
END
-----END CUT-----