%%HP: T(3)A(D)F(.);
@ SKY by Chris Heilman
DIR
  NOW
    \<< RCLF
# 800CC3F0h STOF
DATE "date" \->TAG
TIME "time" \->TAG
ROT STOF
    \>>
  SKY
    \<< Lat COS 'Lc'
STO Lat SIN 'Ls'
STO RCLF \-> f
      \<<
        IFERR DUP2
Sa \-> d t sa
          \<<
# 800CC3F0h STOF
CLLCD d t TSTR 1
DISP
" The Sky
 \169 1991 by C. Heilman

 Wait 3 minutes."
3 DISP # 95h # 95h
PDIM (94.4,94.4)
PMIN (-94.4,-94.4)
PMAX POLAR { # 4Ah
# 4Ah } # 49h 0 361
ARC PICT NEG { # 9h
# 2Ah } PVIEW 1 168
            FOR n
[ 280305.58 383460.65 333493.57 760122.64 760184.69 563550.61 133517.69 183555.65 550254.64 643520.63 2350318.4 2080287.46 1970479.64 2130448.66 2110487.69 1650690.29 2860816.37 2120844.5 2410569.9 1250602.55 3191137.36 2801163.31 1640994.39 2250958.49 1191346.63 921241.55 1821312.59 2881317.6 1201521.34 1461773.41 1991550.4 2051685.46 2381465.5 -1122013.29 -151904.48 -1612227.48 -942293.46 -1982281.65 -2642474.29 -1982414.46 -2262401.43 -3432526.43 -3712634.36 -3902656.44 -4302643.39 -2612397.49 1262637.41 -1572576.44 -2502605.53 252714.6 -3042715.5 -2982753.47 -3442761.39 -2992857.46 -3682744.51 -2542770.48 -2102875.49 -2702814.52 -2632838.4 -2772867.53 -1483053.51 -1613268.49 -1723165.61 -33315.5 -563229.49 -143354.58 -1583437.53 3372.57 -13389.6 143363.67 8930380.9 7422227.41 7182302.51 8202515.62 6181659.38 5641655.44 5371785.44 5701839.53 5601935.38 5492010.41 4932069.39 6442111.57 5232626.48 5152692.42 6772882.51 6572572.52 6152460.47 5902312.53 6263197.44 7063222.52 7763548.52 5650101.42 5920023.43 6070142.45 6020215.47 6370286.54 2672337.42 2912320.57 2612374.66 2692394.62 3142332.61 740888.25 -820786.21 640813.36 -30830.42 -120841.37 -200852.38 -970870.41 990838.54 700725.52 4600792.21 4500899.39 3720899.46 3320743.47 2910021.41 4130112.9 1523462.45 2813460.44 1520033.48 -871419.4 -3391782.63 -2321997.5 -1621624.51 410456.45 -1800109.41 -300348.4 -1590260.55 -1350595.5 -950532.57 -6102199.2 -4252074.5 -4742205.43 -4312246.47 -4122338.48 -4072304.52 -3410849.46 -3580878.51 -3530894.64 -1671013.05 -2641071.38 -2901047.35 1422587.51 2132476.48 3882792.2 3342825.55 4533104.33 2802927.51 -4703321.37 -4693407.41 -1780832.46 -2240764.52 -4230066.44 -4330221.54 1922139.2 4042255.55 2591856.68 2261887.68 2960283.54 3500324.5 4990511.38 4100471.41 521148.24 -2963444.32 -5270960.13 892977.28 -4731224.38 642361.47 -4001209.43 ]
n GET DUP SIGN SWAP
ABS DUP FP 10 * 2 -
SWAP IP 10000 / ROT
OVER IP 10 / * SWAP
FP 1000 * sa SWAP -
Hx \->P \-> mag r \Gh
              \<< r
90
IF <
THEN PICT r \Gh \->V2
  CASE mag -.5 <
    THEN
GROB 7 7 77553E803E5D7F
    END mag .2 <
    THEN
GROB 7 7 77773E803E7F7F
    END mag .9 <
    THEN
GROB 7 7 77773E003E7F7F
    END mag 1.5 <
    THEN
GROB 5 5 B1110E11BF
    END mag 2.5 <
    THEN
GROB 3 3 50005E
    END mag 3 <
    THEN
GROB 2 2 0000
    END mag 6.5 <
    THEN
GROB 1 1 00
    END mag 7 ==
    THEN
GROB 3 3 502050
    END GROB 1 1 10
  END REPL
END TK
              \>>
            NEXT 9
1
            FOR p
              IF p
3 \=/
              THEN
p d t PLANET E\->C sa
ROT - Hx \->P OVER 90
IF <
THEN \->V2 PICT SWAP
{
GROB 9 11 1010EF00AB006C00AB006C00EE006C00EE00EF001010
GROB 9 11 3810D7106C00AB00AB006C00EE006C00EE00D7103810
0
GROB 10 10 1020EF10E110E3106410AD10AD106E10EF101020
GROB 9 11 1010EF002F00EC006D00AD002800ED00ED00EF001010
GROB 9 11 1010EF006F002E006D006A006B006D006900EF001010
GROB 7 9 F7773677B655D536F7
GROB 7 7 F75555367777F7
GROB 5 7 F1915191D111F1
} p GET REPL
ELSE DROP2
END
              END
TK -1
            STEP d
t MOON ROT ROT E\->C
sa ROT - Hx \->P OVER
90
            IF <
            THEN
\->V2 PICT SWAP ROT
10 * 1 + {
GROB 8 8 7EDBFFE7E7FFDB7E
GROB 8 8 7E99DBE7E7DB997E
GROB 8 8 7E99DBE3E3DB997E
GROB 8 8 7E99D9E3E3D9997E
GROB 8 8 7E98D9E1E1D9987E
GROB 8 8 7E98D8E0E0D8987E
GROB 8 8 7E98D86060D8987E
GROB 8 8 7E9858606058987E
GROB 8 8 7E1858606058187E
GROB 8 8 7E1858202058187E
GROB 8 8 7E1818000018187E
} SWAP GET REPL
            ELSE
DROP2 DROP
            END TK
d t SUN DROP 0 E\->C
sa ROT - Hx \->P OVER
90
            IF <
            THEN
\->V2 PICT SWAP
GROB 8 8 3CDBE76666E7DB3C
REPL
            ELSE
DROP2
            END TK
          \>> { }
PVIEW f STOF
        THEN f STOF
ERRN DOERR
        END
      \>>
    \>>
  SUN
    \<< D
.985647356387 * K
DUP 3.365119 - DUP
SIN 1.1915168726 *
ROT + 279.403303 +
K 4 RND "\Gl." \->TAG
SWAP
    \>>
  MOON
    \<< DUP2 D ROT
ROT SUN ROT DUP
13.176396 *
318.351648 + K DUP2
SWAP .1114041 * -
36.34041 - K ROT
318.510107 SWAP
.0529539 * - K \-> ls
ms l Mm n
      \<< l ls - 2 *
Mm - SIN 1.2739 *
Mm OVER + ms SIN
.1858 * SWAP OVER -
ms SIN .37 * - ROT
OVER SIN 6.2886 * +
ROT - SWAP 2 * SIN
.214 * + l + DUP ls
- 2 * SIN .6583 * +
DUP n ms SIN .16 *
- SWAP OVER - DUP
SIN .995970320973 *
OVER COS A ROT + K
4 RND "\Glm" \->TAG
SWAP SIN
8.96834418471E-2 *
ASIN 4 RND "\Gbm"
\->TAG ROT ls - COS 1
SWAP - 2 / 4 RND
"phase" \->TAG
      \>>
    \>>
  PLANET
    \<< D
.985647356387 * \-> p
d
      \<< 1 7
        FOR i
[[ .240852 60.750646 77.299833 .205633 .387099 7.00454 48.21274 ]
 [ .615211 88.455855 131.430236 .006778 .723332 3.394535 76.58982 ]
 [ 1.00004 99.403308 102.768413 .016713 1 0 0 ]
 [ 1.880932 240.739474 335.874939 .093396 1.523688 1.849736 49.480308 ]
 [ 11.863075 90.638185 14.170747 .048482 5.202561 1.303613 100.353142 ]
 [ 29.471362 287.690033 92.861407 .055581 9.554747 2.48898 113.576139 ]
 [ 84.039492 271.063148 172.884833 .046321 19.21814 .773059 73.926961 ]
 [ 164.79246 282.349556 48.009758 .009003 30.10957 1.770646 131.670599 ]
 [ 246.77027 221.4127 224.133 .24624 39.3414 17.142 110.144 ]]
p i 2 \->LIST GET
        NEXT \-> p1
p2 p3 p4 p5 p6 p7
        \<< d p1 / K
DUP p2 + p3 - SIN
p4 * 114.591559026
* p2 + + K DUP p3 -
COS p4 * 1 + 1 p4
SQ - p5 * SWAP / d
1.00004 / K DUP
3.365105 - SIN
1.915168726 *
99.403308 + + K DUP
102.768413 - COS
.016713 * 1 +
.999720675631 SWAP
/ \-> l r L R
          \<< p6 SIN
l p7 - SIN * ASIN
DUP COS r * p6 COS
l p7 - SIN * l p7 -
COS A p7 + \-> psi r
l
            \<< p
              IF 3
>
              THEN
l L - SIN R * r l L
- COS R * - A l + K
              ELSE
L l - SIN r * R L l
- COS r * - A 180 +
L + K
              END 4
RND "\Gl" p + \->TAG
DUP l - SIN psi TAN
* r * l L - SIN R *
A DUP ABS
              IF 90
>
              THEN
DUP SIGN NEG 180 *
MOD
              END 4
RND "\Gb" p + \->TAG
            \>>
          \>>
        \>>
      \>>
    \>>
  E\->C
    \<< Ex - A2 "\Ga"
\->TAG Ey + ASIN "\Gd"
\->TAG
    \>>
  C\->H
    \<< Sa ROT - Hx
"A" \->TAG SWAP "a"
\->TAG SWAP
    \>>
  H\->C
    \<< Sa ROT ROT Hx
ROT SWAP - "\Ga" \->TAG
SWAP "\Gd" \->TAG
    \>>
  C\->E
    \<< Ex + A2 "\Gl"
\->TAG Ey - ASIN "\Gb"
\->TAG
    \>>
  Long 112.0509
  Lat 33.2958
  Zone 7
  Sa
    \<< Zone HMS+
HMS\-> 1.002737909 *
SWAP DUP IP SWAP FP
100 * DUP IP SWAP
FP 10000 * \-> m d y
      \<<
        IF m 3 <
        THEN -1 'y'
STO+ 12 'm' STO+
        END y 100 /
IP DUP 4 / IP 2 +
SWAP NEG + y 365.25
* IP m 1 + 30.6001
* IP + + d +
730550.5 - 36525 /
DUP SQ .000025862 *
SWAP 2400.051336 *
6.697374558 + + +
15 * Long - K
      \>>
    \>>
  A
    \<< RCLF \-> f
      \<< # 3F0h STOF
SWAP \->V2 # C3F0h
STOF V\-> SWAP DROP f
STOF
      \>>
    \>>
  Lc .835847604597
  Ls .548961548644
  Hx
    \<< \-> y x
      \<< y SIN Ls *
y COS Lc * x COS *
+ ASIN y SIN OVER
SIN Ls * - OVER COS
Lc * / ACOS x SIN
        IF 0 >
        THEN 360
SWAP -
        END
      \>>
    \>>
  Ey
    \<< ROT ROT DUP
SIN .917464059944 *
ROT SIN
.397818675669 * ROT
COS *
    \>>
  Ex
    \<< DUP2 TAN
.397818675669 *
SWAP SIN
.917464059944 *
SWAP
    \>>
  A2
    \<< 3 PICK COS A
K
    \>>
  \->P
    \<< 90 - K 90 ROT
- SWAP
    \>>
  D
    \<< Zone -
1.01199 ROT DDAYS 1
+ SWAP 24 / +
    \>>
  K
    \<< 360 MOD
    \>>
  TK
    \<< 1200 .0005
BEEP
    \>>
  PPAR {
(94.4,94.4)
(-94.4,-94.4) X 0
(0,0) POLAR Y }
END