%%HP: T(3)A(D)F(.);
@ PLANETS by Tim Strong
DIR
  PLANETS
    \<< RCLF 'FLG'
STO { { "Merc"
      \<< 1 CONT
      \>> } { "Venu"
      \<< 2 CONT
      \>> } { "Mars"
      \<< 4 CONT
      \>> } { "Jupit"
      \<< 5 CONT
      \>> } { "Satu"
      \<< 6 CONT
      \>> } { "Uran"
      \<< 7 CONT
      \>> } { "Nept"
      \<< 8 CONT
      \>> } { "Plut"
      \<< 9 CONT
      \>> } } TMENU
"Enter date: M DD YYYY
 Select Planet"
PROMPT DUP 'PLDATA'
SWAP GET OBJ\-> DROP
'PLDATA' 3 GET OBJ\->
6 DROPN \-> n Tp \Gel \Gw
ec a ic \GW \Gho Vo Te
\Gele \Gwe ece
      \<< 4 FIX \GDd90
360 365.242191 / *
DUP Tp / NRMANG
'Np' STO Te /
NRMANG 'Ne' STO Np
\Gel + \Gw - 'Mp' STO
Np 360 \pi / \->NUM ec
* Mp SIN * + \Gel +
NRMANG 'l' STO l \Gw
- 'vp' STO a 1 ec
SQ - * 1 ec vp COS
* + / 'r' STO Ne
\Gele + \Gwe - 'Me' STO
Ne 360 \pi / \->NUM ece
* Me SIN * + \Gele +
NRMANG 'L' STO L \Gwe
- 've' STO 1 ece SQ
- 1 ece ve COS * +
/ 'R' STO l \GW - DUP
SIN ic SIN * ASIN
'\165' STO DUP SIN ic
COS * 'y' STO COS
'x' STO
        IF 'n<3'
        THEN x y
R\->C ARG \GW + 'l' STO
r \165 COS * 'r' STO r
L l - SIN * R r L l
- COS * - / ATAN
'Ap' STO 180 L Ap +
+ NRMANG '\Gl' STO r
\165 TAN \Gl l - SIN * *
R l L - SIN * /
ATAN '\Gb' STO
        ELSE R l L
- SIN * r R l L -
COS * - / ATAN l +
NRMANG '\Gl' STO r \165
TAN \Gl l - SIN * * R
l L - SIN * / ATAN
'\Gb' STO
        END \Gl \Gb 6
CONCO SWAP 15 /
        IF DUP 0 <
        THEN 24 +
        END SWAP
\->DMS '\Gd' STO '\Ga'
STO R SQ r SQ + 2 R
* r * l L - COS * -
\v/ '\Gr' STO \Gho \Gr /
'\Gh' STO \Gl l - COS 1
+ 2 / 'F' STO
.138612439306 \Gr *
\->HMS '\Gt' STO 5 r \Gr
* F \v/ / LOG * Vo +
'm' STO "\Ga= " \Ga
\->STR + "
\Gd= " \Gd
\->STR + + "
\Gr= " \Gr
\->STR + + "
\Gt= " \Gt
\->STR + + "     " {
"Mercury" "Venus"
"" "Mars" "Jupiter"
"Saturn" "Uranus"
"Neptune" "Pluto" }
n GET + + "
\Gh= " \Gh
\->STR + + "
F= " F
\->STR + + "
m= " m
\->STR + + CLLCD 1
DISP 3 FREEZE FLG
STOF { m \Gt F \Gh \Gr \Ga
\Gd \Gb \Gl Ap x y \165 R ve
L Np FLG Me r vp l
Mp Ne } PURGE
      \>>
    \>>
  CONCO
    \<<
      IF DEPTH 3 <
      THEN { {
"AaH\Gd"
        \<< 1 CONT
        \>> } {
"H\GdAa"
        \<< 2 CONT
        \>> } {
"\Ga\GdH\Gd"
        \<< 3 CONT
        \>> } {
"H\Gd\Ga\Gd"
        \<< 4 CONT
        \>> } {
"\Ga\Gd\Gl\Gb"
        \<< 5 CONT
        \>> } {
"\Gl\Gb\Ga\Gd"
        \<< 6 CONT
        \>> } {
"\Ga\Gdlb"
        \<< 7 CONT
        \>> } {
"lb\Ga\Gd"
        \<< 8 CONT
        \>> } } TMENU
CLLCD
"Select Conversion:"
PROMPT
      END \-> \Gm v n
      \<< { A B C D }
n 2 / .5 + FLOOR
GET EVAL
        IF n 8 == n
6 == OR
        THEN TRN
        END \Gm COS v
COS * \Gm SIN v COS *
v SIN \->V3 * V\-> ASIN
3 ROLLD R\->C ARG
SWAP 0 MENU
      \>>
    \>>
  DMS\->
    \<< HMS\-> SWAP
HMS\-> SWAP
    \>>
  \->DMS
    \<< \->HMS "DMS"
\->TAG SWAP \->HMS
"DMS" \->TAG SWAP
    \>>
  JULDAY
    \<< \-> m d y
      \<< y 10000 * m
100 * d + +
15821015 \>=
        IF 'm\<=2'
        THEN y 1 -
'y' STO m 12 + 'm'
STO
        END
        IF
        THEN y 100
/ IP DUP 4 / IP
SWAP NEG 2 + +
        ELSE 0
        END 365.25
y *
        IF 'y<0'
        THEN .75 -
        END IP
30.6001 m 1 + * IP
+ + d + 1720994.5 +
      \>>
    \>>
  \GDd90
    \<< JULDAY
2447891.5 -
    \>>
  EPOCH 2000
  A
    \<< \O/ SIN NEG 0 \O/
COS 0 -1 0 \O/ COS 0
\O/ SIN { 3 3 } \->ARRY
    \>>
  B
    \<< LST COS LST
SIN 0 LST SIN LST
COS NEG 0 0 0 1 { 3
3 } \->ARRY
    \>>
  C
    \<< 1 0 0 0 \Ge COS
\Ge SIN 0 \Ge SIN NEG \Ge
COS { 3 3 } \->ARRY
    \>>
  D
[[ -.0669887 -.8727558 -.4835389 ]
 [ .4927285 -.450347 .7445846 ]
 [ -.8676008 -.1883746 .4601998 ]]
  \Ge
    \<< 1 0 EPOCH
JULDAY 2451545 -
36525 / \-> T '(
46.815*T+.0006*T^2-
.00181*T^3)/3600'
NEG 23.439292 +
    \>>
  \O/ 47.0194444444
  CST { PLANETS
CONCO DMS\-> \->DMS
JULDAY \GDd90 EPOCH \O/
\Ge }
  NRMANG
    \<< DUP 360 / IP
360 * -
      IF DUP 0 <
      THEN 360 +
      END
    \>>
  PLDATA { {
.240852 60.750646
77.299833 .205633
.387099 7.00454
48.21274 6.74 -.42
} { .615211
88.455855
131.430236 .006778
.723332 3.394535
76.58982 16.92 -4.4
} { 1.00004
99.403308
102.768413 .016713
1 0 0 0 0 } {
1.880932 240.739474
335.874939 .093396
1.523688 1.849736
49.480308 9.36
-1.52 } { 11.863075
90.638185 14.170747
.048482 5.202561
1.303613 100.353142
196.74 -9.4 } {
29.471362
287.690033
92.861407 .055581
9.554747 2.48898
113.576139 165.6
-8.88 } { 84.039492
271.063148
172.884833 .046321
19.21814 .733059
73.926961 65.8
-7.19 } { 164.79246
282.349556
48.009758 .009003
30.10957 1.770646
131.670599 62.2
-6.87 } { 246.77027
221.4127 224.133
.24624 39.3414
17.142 110.144 8.2
-1 } }
END