Otherware/Otherware_1_SB_Development.iso/mac/hypercar/fun/astroalm.sit/Almanac/stack.txt

Text File | 1989-10-16 | 10.3 KB | 371 lines

-- stack: in
-- format: 8 (HyperCard 1)
-- flags: 0x1000 (none)
-- protect password hash: 0
-- maximum user level: 5 (scripting)
-- window: Rect(x1=0, y1=0, x2=0, y2=0)
-- screen: Rect(x1=0, y1=0, x2=0, y2=0)
-- card dimensions: w=0 h=0
-- scroll: x=0 y=0
-- background count: 3
-- first background id: 2765
-- card count: 15
-- first card id: 2966
-- list block id: 11014
-- print block id: 9282
-- font table block id: 0
-- style table block id: 0
-- free block count: 0
-- free size: 0 bytes
-- total size: 54688 bytes
-- stack block size: 10240 bytes
-- created by hypercard version: 0x00000000
-- compacted by hypercard version: 0x01228000
-- modified by hypercard version: 0x01228000
-- opened by hypercard version: 0x01228000
-- patterns[0]: 0x0000000000000000
-- patterns[1]: 0x8000000008000000
-- patterns[2]: 0x8800220088002200
-- patterns[3]: 0x8888222288882222
-- patterns[4]: 0x88AA22AA88AA22AA
-- patterns[5]: 0xCCAA33AACCAA33AA
-- patterns[6]: 0xEEAABBAAEEAABBAA
-- patterns[7]: 0xEEBBBBEEEEBBBBEE
-- patterns[8]: 0xFFBBFFEEFFBBFFEE
-- patterns[9]: 0xFFBBFFFFFFBBFFFF
-- patterns[10]: 0x8010022001084004
-- patterns[11]: 0xFFFFFFFFFFFFFFFF
-- patterns[12]: 0x8822882288228822
-- patterns[13]: 0x1122448811224488
-- patterns[14]: 0xC4800C6843023026
-- patterns[15]: 0xB130031BD8C00C8D
-- patterns[16]: 0xAA00AA00AA00AA00
-- patterns[17]: 0x8822552288225522
-- patterns[18]: 0x8855225588552255
-- patterns[19]: 0x77DD77DD77DD77DD
-- patterns[20]: 0x8000000000000000
-- patterns[21]: 0xAA55AA55AA55AA55
-- patterns[22]: 0x038448300C020101
-- patterns[23]: 0x8244394482010101
-- patterns[24]: 0x8814224188412214
-- patterns[25]: 0x8080413E080814E3
-- patterns[26]: 0x22048C7422179810
-- patterns[27]: 0xBE808808EB088880
-- patterns[28]: 0x25C8328964244C92
-- patterns[29]: 0xA29C41BE2AC914EB
-- patterns[30]: 0x40A00000040A0000
-- patterns[31]: 0x8040200002040800
-- patterns[32]: 0xAA00800088008000
-- patterns[33]: 0xFF80808080808080
-- patterns[34]: 0x081C22C180010204
-- patterns[35]: 0xFF808080FF080808
-- patterns[36]: 0xF87422478F172271
-- patterns[37]: 0xBF00BFBFB0B0B0B0
-- patterns[38]: 0xFF7FBE5DA2418000
-- patterns[39]: 0xFAF5FAF5A050A050
-- checksum: 0x0
----- HyperTalk script -----
on openStack
  global force,intl,moon
  if the version < "1.2" then
    Ask "This stack requires HyperCard 1.2.1 or newer" with "Drat!"
    go recent cd
  end if
  put 0 into moon
  if the short name of second cd is "Occult." then put 1 into moon
  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 date
  if it contains "."
  then put true into intl
else put false into intl
convert it to dateItems
if intl then
  repeat with i=1 to number of chars of it
    if char i of it = "." then put "," into char i of it
  end repeat
  put item 1 of it into d
  put item 2 of it into m
else
  put item 2 of it into m
  put item 3 of it into d
end if
put false into val
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
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
push cd
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
end openStack

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 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
  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

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 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*pi/180)
end sind

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

function tand n
return tan(n*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 then
    repeat with i=1 to number of chars of daysecs
      if char i of daysecs = "." then put "/" into char i of daysecs
    end repeat
  end if
  convert daySecs to seconds
  put number of chars of the date into ndate
  put "12/31/" & (char ndate-1 to ndate of the date)-1 into Jan0
  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

on calc num,force
  set cursor to 1001
  -- calcs ra and dec, force =1 means do it anyway
  global day,daySecs,x,xa,xb,dayUT,it,h,m,mode
  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
    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"
    get ((xa-b2)/2+48) mod 24
    put it*15 into dra
    put dra into line 5 of fld Pos
    hm false,it
    put short name of this cd &" R.A. = "& h &"h " & m &"m"into line 1 of fld Pos
    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
    put it into line 6 of fld Pos
    put empty into sign
    if it<0 and it>-1 then put "-" into sign
    if it>0 then put "+" into sign
    hm true,it
    put short name of this cd&" Dec.  = "&sign&h&"┬░ "&m&"'" into line 2 of fld Pos
    if "Sun" is in short name of this cd then
      get (-.20791-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
    get -sind(lat)*sind(dec)/cosd(lat)/cosd(dec)
    put atan(sqrt(1-it*it)/it) into ang
    if dec>0 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

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

on ampm
  global h,mode,intl
  if intl then
    put empty into mode
  else
    put h into h2
    if h>11 then
      subtract 12 from h
      put "PM" into mode
    else
      put "AM" into mode
    end if
    if h=0 then put 12 into h
  end if
end ampm