Otherware/Otherware_1_SB_Development.iso/mac/hypercar/science/almanac.sit/Almanac.sw/stack_-1.xml

Extensible Markup Language | 1991-04-23 | 12.0 KB | 16 lines

<?xml version="1.0" encoding="utf-8" ?>
<!DOCTYPE stack PUBLIC "-//Apple, Inc.//DTD stack V 2.0//EN" "" >
<stack>
    <name>in.sw</name>
    <id>-1</id>
    <cardCount>16</cardCount>
    <cardID>2966</cardID>
    <listID>7378</listID>
    <cantModify><false /></cantModify>
    <cantDelete><false /></cantDelete>
    <cantAbort><false /></cantAbort>
    <cardSize>
        <width>512</width>
        <height>342</height>
    </cardSize>
    <script>on openStack
global force,intl,total
put false into c1
if the number of this cd Γëá 1 then
push cd
put true into c1
go first cd
end if
createMenu
put 0 into total
set lockscreen to true
set lockmessages to true
push cd
go second cd
if number of cd flds >0 then put 1 into total
pop cd
set lockscreen to false
set lockmessages to false
put 0 into force
hide message box
put the seconds/86400 + 16480.5 + DSTCheck()/24 into jd2
put trunc(jd2+24000000) +1 into jd
get the long date
if first word of cd fld daily is not in it then
beep
put "Polynomials are outdated..."
wait 1 sec
hide message box
end if
-- international stuff
put "Dimanche,Lundi,Mardi,Mercredi,Jeudi,Vendredi,Samedi" into frdays
put empty into intl
if first word of it is in frdays then put "Fr" into intl
get the date
if it contains "." then put "De" into intl
if char 1 of second word of the long date is in "0123456789" and ¬
intl is empty then put "Au" into intl
convert it to dateItems
put item 2 of it into m
put item 3 of it into d
-- end intl determination
put false into val
if intl = "Au" then
if m<=4 or m>10 then put true into val
put trunc(jd-7*trunc(jd/7)) into w
if m=10 and d>=w-1 then put true into val
if m=4 and (d-w)>=25 then put false into val
end if
if intl is empty then
if m>4 and m<=10 then put true into val
put trunc(jd-7*trunc(jd/7)) into w
if m=4 and d>=w-1 then put true into val
if m=10 and (d-w)>=25 then put false into val
end if
set hilite of bkgnd button "DST" of cd origin to val
if val then
put "D" into char 3 of last word of cd fld coords of cd origin
else
put "S" into char 3 of last word of cd fld coords of cd origin
end if
if the short name of this cd is "origin" then
put line 2 of cd fld "Algol" into ecl
repeat
if ecl > jd2 then exit repeat
add 2.8673075 to ecl
end repeat
set numberFormat to "0.0"
put "Next minimum of Algol occurs in" && (ecl-jd2)*24 &&¬
"hours at JD=" into line 1 of cd fld Algol
set numberFormat to "0.###"
put ecl+2400000 after line 1 of cd fld Algol
put ecl into line 2 of cd fld Algol
end if
if c1 then pop cd
end openStack

on closeStack
if "Object" is in the menus then delete menu "Object"
pass closeStack
end closeStack

function nDate Uflag,Jflag,n
-- Uflag =0 for no UT, 1 for UT
-- Jflag =12 for JT, 0 for no JT
-- n = # days after given date
global intl
get the seconds
add 86400*n+3600*(Jflag+Uflag*DSTcheck()) to it
convert it to long date
if intl = "De" then
put char 1 to (offset(".",second word of it)-1) of second word of it ¬
&& third word of it && last word of it into he
else if intl = "Fr" or intl = "Au" then
put second word of it && third word of it && last word of it into he
else
put char 1 to (offset(",",third word of it)-1) of third word of it ¬
&& second word of it && last word of it into he
end if
return he
end nDate

on createMenu
if there is a menu "Object" then exit createMenu
create menu "Object"
put createMenuItems() into menu "Object" with menuMsg createMenuMsgs()
end createMenu

function createMenuItems
return "Sun" & return & "Moon" & return & "Mercury" & return & ¬
"Venus" & return & "Mars" & return & "Jupiter" & return & ¬
"Saturn" & return & "Uranus" & return & "Neptune" & return
end createMenuItems

function createMenuMsgs
return "go cd sun" & return & "go cd moon" & return & "go cd mercury" ¬
& return & "go cd venus" & return & "go cd mars" & return & ¬
"go cd jupiter" & return &  "go cd saturn" & return & "go cd uranus" ¬
& return & "go cd neptune"
end createMenuMsgs

function rnd10 x
return round(x*10)/10
end rnd10

function DSTcheck
get first word of line 4 of cd fld Coords of cd origin
if hilite of bkgnd button "DST" of cd origin
then put it-1 into temp
else put it into temp
return temp
end DSTcheck

function frac x
return x-trunc(x)
end frac

function sgn x
if x<0 then
get -1
else if x=0 then
get 0
else if x>0 then
get 1
end if
return it
end sgn

function sind n
return sin((n mod 360)*pi/180)
end sind

function cosd n
return cos((n mod 360)*pi/180)
end cosd

function tand n
return tan((n mod 360)*pi/180)
end tand

on dayOfYear
-- returns day, dayUT as number of day in year
global dayUT,day,daySecs,intl
put the date into daysecs
if intl is "De" then
put "31.12." into pJan0
else if intl is "Fr" or intl = "Au" then
put "31/12/" into pJan0
else
put "12/31/" into pJan0
end if
get number of chars of the date
put pJan0 & (char it-1 to it of the date)-1 into Jan0
convert daySecs to seconds
convert Jan0 to seconds
put (daySecs-Jan0)/86400 into day
put (daySecs-Jan0+3600*DSTcheck())/86400 into dayUT
end dayOfYear

on cheb a,b,c
global x,xa,xb
put 2*x*a-b+c into temp
put a into xb
put temp into xa
end cheb

on UT
global day,daySecs,x,xa,xb,m
dayOfYear -- gets daySecs
get ((the seconds-daySecs)/3600+DSTcheck())mod 24
put trunc(it) into h
put trunc(60*(it-h)) into m
if m<10 then put "0" before m
if h=0 then put "0" before h
put "Universal Time = "& h &":" & m into line 1 of fld UT
put it into line 2 of fld UT
end UT

on ST
global day,daySecs,x,xa,xb,dayUT
dayOfYear -- gets day
put (dayUT-1)/183-1 into x
put 0 into a
put 0 into b
put 7 into i
repeat until i=0
cheb a,b,word i+1 of cd fld "Sidereal Cheb" of cd origin
put xa into a
put xb into b
subtract 1 from i
end repeat
put xb into b2
cheb a,b,word 1 of cd fld "Sidereal Cheb" of cd origin
get ((xa-b2)/2+((the seconds-daySecs)/3600+DSTcheck())*1.00273791+¬
(line 2 of cd fld "coords" of cd origin)/15+24) mod 24
put trunc(it) into h
put trunc(60*(it-h)) into m
if m<10 then put "0" before m
if h=0 then put "0" before h
put "Sidereal Time = "& h &":" & m into line 1 of fld ST
put it into line 2 of fld ST
end ST

on hm decv,arg
global h,m
put trunc(arg) into h
put trunc(60*(arg-h)) into m
if decv then put abs(m) into m
if m<10 then put "0" before m
end hm

function atanq x,y
get atan(y/x)
if x>0 then add pi to it
return it mod (2*pi)
end atanq

on moonpos
global t,dra,decra,dec,fac
set cursor to busy
put 218.32+481267.883*t+6.29*sind(134.9+477198.85*t)-1.27*¬
sind(259.2-413335.38*t)+.66*sind(235.7+890534.23*t)+.21*sind(¬
269.9+954397.7*t)-.19*sind(357.5+35999.05*t)-.11*sind(186.6+¬
966404.05*t) into lambda
put 5.13*sind(93.3+483202.03*t)+.28*sind(228.2+960400.87*t)¬
-.28*sind(318.3+6003.18*t)-.17*sind(217.6-407332.2*t) into beta
put cosd(beta)*cosd(lambda) into l
set cursor to busy
put .9175*cosd(beta)*sind(lambda)-.3978*sind(beta) into m
put .3978*cosd(beta)*sind(lambda)+.9175*sind(beta) into n
put (180+atanq(l,m)/fac) mod 360 into dra
put dra/15 into decra
put atan(n/sqrt(1-n*n))/fac into dec
end moonpos

on calc num,force
global day,daySecs,x,xa,xb,dayUT,it,h,m,mode,t,dec,decra,dra,fac,cdata
-- calcs ra and dec, force =1 means do it anyway
set cursor to 1001
dayOfYear -- gets day,dayUT
put pi/180 into fac
get line 3 of fld UT
put line 1 of cd fld "Coords" of cd origin into lat
if (it=trunc(dayUT) and the optionkey is up) and force=0 then
put line 5 of fld Pos into dra
put line 6 of fld Pos into dec
put line 3 of fld rise into arg
else
set cursor to 1002
put trunc(dayUT) into line 3 of fld UT
if short name of this cd is "Moon" then
-- Moon calcs from A.A.
put ((last word of line 1 of fld JD)-2451545)/36525 into t
moonpos
-- lines for asteroid calcs
else if number of this cd >10 and number of this cd <13 then
-- get the vars, put into decra and dec
ccalc
put char 24 to 25 of cdata into rh
put char 27 to 30 of cdata into rm
put char 35 to 36 of cdata into dh
put char 38 to 39 of cdata into dm
put "Magnitude = "&last word of cdata into cd fld mag
put rh+rm/60 into decra
put decra*15 into dra
put dh+dm/60 into dec
if char 34 of cdata is "-" then
put -dec into dec
end if
else
put (dayUT+((the seconds-daySecs)/3600+DSTcheck())/24-1)/183-1 ¬
into x
put 0 into a
put 0 into b
put num into i
repeat until i=0
set cursor to busy
cheb a,b,word i+1 of fld "ra cheb"
put xa into a
put xb into b
subtract 1 from i
end repeat
put xb into b2
cheb a,b,word 1 of fld "ra cheb"
put (((xa-b2)/2+48) mod 24) *15 into dra
put dra/15 into decra
put 0 into a
put 0 into b
put num into i
repeat until i=0
set cursor to busy
cheb a,b,word i+1 of fld "dec cheb"
put xa into a
put xb into b
subtract 1 from i
end repeat
put xb into b2
cheb a,b,word 1 of fld "dec cheb"
get (xa-b2)/2
put it into dec
--addition for distance
put 0 into a
put 0 into b
put num into i
repeat until i=0
set cursor to busy
cheb a,b,word i+1 of fld "dist cheb"
put xa into a
put xb into b
subtract 1 from i
end repeat
put xb into b2
cheb a,b,word 1 of fld "dist cheb"
get (xa-b2)/2
put it into line 3 of fld dmag
put trunc(1000*it) into dist
get number of chars of dist
put char 1 to (it-3) of dist & "." & char (it-2) to it of dist ¬
into dist
put "Earth -"&&short name of this cd&&"Distance ="&&dist&&"A.U."¬
into line 1 of fld DMag
end if
if "Sun" is in short name of this cd then
--1.9 now give the user a choice
repeat with ii=20 to 22
if hilite of btn id ii then put ii-19 into argt
end repeat
put item argt of "-.104528,-.207912,-.309017" into val
get (val-sind(lat)*sind(dec))/(cosd(lat)*cosd(dec))
put abs(atan(sqrt(1-it*it)/it)) into ang
if -.20791<sind(lat)*sind(dec) then put pi-ang into ang
put ang/fac/15 into delta
put (dra/15+(line 2 of fld UT)-line 2 of fld 2+24-DSTcheck()) ¬
mod 24 into arg
get arg-delta
put it into line 3 of cd fld twilight
hm false,it
ampm
put "Twilight begins at "& h &":" & m && mode into line 1 of¬
cd fld twilight
get arg+delta
put it into line 4 of cd fld twilight
hm false,it
ampm
put "Twilight ends    at "& h &":" & m && mode into line 2 of ¬
cd fld twilight
end if
put dra into line 5 of fld Pos
hm false,decra
put short name of this cd &" R.A. = "& h &"h " & m &"m"into¬
line 1 of fld Pos
put dec into line 6 of fld Pos
put empty into sign
if dec<0 and dec>-1 then put "-" into sign
if dec>0 then put "+" into sign
hm true,dec
put short name of this cd&" Dec.  = "&sign&h&"° "&m&"'" ¬
into line 2 of fld Pos
get -sind(lat)*sind(dec)/cosd(lat)/cosd(dec)
put atan(sqrt(1-it*it)/it) into ang
put dec>0 into d1
put lat>0 into d2
if d1 is d2 then
add pi to ang
end if
put ang/fac/15 into delta
put dra/15+line 2 of fld UT-line 2 of fld ST+24-DSTcheck() into arg
get (arg-delta) mod 24
put arg into line 3 of fld rise
put it into line 4 of fld rise
hm false,it
ampm
put short name of this cd && "Rises at "& h &":" & m && mode ¬
into line 1 of fld rise
get (arg+delta) mod 24
put it into line 5 of fld rise
hm false,it
ampm
put short name of this cd && "Sets  at "& h &":" & m && mode into ¬
line 2 of fld rise
set cursor to 1001
end if
-- calc alt and az of object
put ((360+15*(line 2 of fld ST)-dra) mod 360) into LHA
put cosd(LHA)*sind(lat)-tand(dec)*cosd(lat) into den
put round(atanq(den,sind(LHA))/fac) into temp
put sind(lat)*sind(dec)+cosd(lat)*cosd(dec)*cosd(LHA) into sina
if abs(sina)<1 then
put round(atan(sina/(sqrt(1-sina*sina)))/fac) into alt
if alt>0 then
put "Az. = "& temp into line 3 of fld Pos
put "Alt. = " & alt into line 4 of fld Pos
else
if temp>180
then put "W" into tem
else put "E" into tem
put "below " & tem & " horizon" into line 3 of fld Pos
put empty into line 4 of fld Pos
end if
else
beep
end if
set cursor to 1
end calc

on ccalc
global cdata
put the seconds into t
add DSTcheck()*3600 to t
convert t to dateitems
put item 2 of t into m
if m<10 then put space before m
put item 3 of t into d
if d<10 then put space before d
put m&"/"&d&".0/ "&item 1 of t into mask
put line 2 of fld planet into