%%HP: T(3)A(D)F(.);
@ Rotate3D
@ by Colin Meyer
@ Based on Three-Dimensional Graphics in Turbo Pascal, Computer Language,
@   September 1990.
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