'===========================================================================
' Subject: SIDEREAL TIME CLOCK                Date: 01-01-00 (15:23)       
'  Author: David O. Williams                  Code: QB, QBasic, PDS        
'  Origin: david.williams@ablelink.org      Packet: DATETIME.ABC
'===========================================================================
' Sidereal Clock

' David O. Williams. 1999. Public Domain. No Price. No Warranty.
' (But I do think it's correct!)

' Thanks to Jeff Root, Mike Ross and Arnold Gill for suggestions and help.

' E-mail: david.williams@ablelink.org

' If you make any changes, and distribute the changed version, please
' document what you have done here, so you get the credit - or blame!

DECLARE FUNCTION DivMult% (Div&)
DECLARE FUNCTION Sting$ (X%)
DECLARE FUNCTION Secs& (TS$)
DECLARE FUNCTION Dte# (Dat$)
DECLARE SUB Dely (N!)

DEFDBL A-Z
COMMON SHARED Num&

CONST Factor = 1.00273793#    ' sidereal / solar time ratio

EqDate$ = "03-21-1999"        ' these 2 lines are date and (UT) time of
EqTime$ = "01:46:00"          ' most recent available March equinox.

TEqun = -440                  ' equation of time at March equinox

EqTi = Secs&(EqTime$)
Offset = Dte#(EqDate$) + EqTi

Pl$ = "MBMST255L10"
FOR X% = 1 TO 10
   Pl$ = Pl$ + "N50N55N60N65N70N65N60N55"
NEXT
Pl$ = Pl$ + "N50L64N0"

DIM P$(0 TO INT(LEN(Pl$) / 20))
Y% = 1
Np% = 0
DO
  Z% = INSTR(Y% + 25, Pl$, "N")
  IF Z% = 0 THEN Z% = LEN(Pl$) + 1
  P$(Np%) = MID$(Pl$, Y%, Z% - Y%)
  IF Z% > LEN(Pl$) THEN EXIT DO
  Y% = Z%
  Np% = Np% + 1
LOOP

CLS

SetAll:

PRINT "Input your longitude, in degrees west of Greenwich, as"
PRINT "accurately as possible. Use negative numbers if east of Greenwich."

INPUT "Longitude (w)"; Lon
LonCorr = 43200# - EqTi + 240# * Lon - TEqun

PRINT
PRINT "Hit <enter> if no change needed, else type new date and/or time."
ON ERROR GOTO Errtrap

PRINT "Current date  "; DATE$
INPUT "Changed date"; D$
IF LEN(D$) = 10 AND D$ > "01" AND D$ < "13" THEN
   DATE$ = D$
   PRINT "Change made"
ELSE
   PRINT "Date unchanged"
END IF
PRINT
PRINT "Current time  "; TIME$
INPUT "Changed time"; T$
IF LEN(T$) = 8 AND T$ > "00" AND T$ < "24" THEN
   TIME$ = T$
   PRINT "Change made"
ELSE
   PRINT "Time unchanged"
END IF
ON ERROR GOTO 0

PRINT
PRINT "Enter time-zone to which computer clock is set, as difference,"
PRINT "in hours, from GMT/UT. E.g. for EST, enter -5."
INPUT "Time Zone Offset"; Tz
Tz = 3600# * Tz

Konst = LonCorr + Factor * (Offset + Tz)

SetAlarm:

PRINT
PRINT "Hit <enter> if sidereal alarm is not to be set, else enter time."
INPUT "Sidereal alarm time (HH:MM:SS)"; At$
IF LEN(At$) = 8 THEN
  Al& = Secs&(At$)
  PRINT "Alarm Set"
ELSE
  Al& = -1
  PRINT "Alarm not set"
END IF
AlCount% = Np% + 1

PRINT
PRINT "Enable sidereal time beeps? (y/N) ";
DO
   K$ = LCASE$(INKEY$)
LOOP UNTIL K$ = "y" OR K$ = "n" OR K$ = CHR$(13)
IF K$ = CHR$(13) THEN K$ = "n"
PRINT K$
Bp% = (K$ = "y")

CALL Dely(.5)

CLS
PRINT "Upper display is computer clock, showing regular civil time."
PRINT
PRINT "Lower display shows your local sidereal time, i.e. the Right"
PRINT "Ascensions of objects currently on the meridian of your sky."
PRINT
PRINT "Press 'Q' key to terminate displays."

LOCATE 12, 20
PRINT "   Local civil time:";
LOCATE 14, 20
PRINT "Local sidereal time:";

N& = 0
Dt$ = ""
Tm$ = ""
DO
  IF TIME$ <> Tm$ THEN
      Tm$ = TIME$
      LOCATE 12, 42
      PRINT Tm$;
  END IF
  IF DATE$ <> Dt$ THEN
      Dt$ = DATE$
      K = Factor * Dte#(Dt$) - Konst
  END IF
  Num& = INT(Factor * TIMER + K)
  IF Num& <> N& THEN
     N& = Num&
     Junk% = DivMult%(86400)
     IF Num& = Al& THEN
        AlCount% = 0
     END IF
     H% = DivMult%(3600)
     M% = DivMult%(60)
     T$ = Sting$(H%) + ":" + Sting$(M%) + ":" + Sting$(CINT(Num&))
     LOCATE 14, 42
     PRINT T$;
     IF Bp% THEN
      IF PLAY(0) = 0 AND AlCount% > Np% THEN
       PLAY "MBMST255L10"
       IF Num& MOD 10 <> 0 THEN
          PLAY "O3C"
       ELSEIF Num& = 0 THEN
          PLAY "O4C"
       ELSE
          PLAY "O3E"
       END IF
      END IF
     END IF
  END IF
  IF AlCount% <= Np% THEN
    IF PLAY(0) < 10 THEN
      PLAY P$(AlCount%)
      AlCount% = AlCount% + 1
    END IF
  END IF
LOOP UNTIL LCASE$(INKEY$) = "q"

LOCATE 12, 20
PRINT "                                    ";
LOCATE 14, 20
PRINT "'Q' Key pressed. Displays ended."

CALL Dely(1)

CLS
PRINT "1. Reset alarm and/or beeps"
PRINT "2. Reset all variables"
PRINT "3. End program"
PRINT
PRINT "Choose by number (1 - 3) : ";

DO
  K$ = INKEY$
LOOP UNTIL K$ >= "1" AND K$ <= "3"
PRINT K$

SELECT CASE VAL(K$)
 CASE 1
   GOTO SetAlarm
 CASE 2
   PRINT
   GOTO SetAll
END SELECT

PRINT
PRINT "Program terminated"

END

Errtrap:
 BEEP
 PRINT "**** Improperly entered data ****"
 PRINT "No ";
 RESUME NEXT

SUB Dely (N!)
 Tim! = TIMER
 DO
   Ti2! = TIMER - Tim!
   IF Ti2! < 0 THEN Tim! = Tim! - 86400!
 LOOP UNTIL Ti2! > N!
END SUB

FUNCTION DivMult% (Div&)
    Q% = INT(Num& / Div&)
    Num& = Num& - Div& * Q%
    DivMult% = Q%
END FUNCTION

FUNCTION Dte# (Dat$)
  Y% = VAL(RIGHT$(Dat$, 4))
  M% = VAL(LEFT$(Dat$, 2))
  D% = VAL(MID$(Dat$, 4, 2))
  IF M% > 2 THEN
    M% = M% - 3
  ELSE
    M% = M% + 9
    Y% = Y% - 1
  END IF
  X = 86400# * (365& * Y% + Y% \ 4 + CINT(30.6 * M%) + D%)
  Dte# = X
END FUNCTION

FUNCTION Secs& (TS$)
  H% = VAL(LEFT$(TS$, 2))
  M% = VAL(MID$(TS$, 4, 2))
  S% = VAL(RIGHT$(TS$, 2))
  Ti& = 3600& * H% + 60& * M% + S%
  Secs& = Ti&
END FUNCTION

FUNCTION Sting$ (X%)
    S$ = RIGHT$(STR$(X% + 100), 2)
    Sting$ = S$
END FUNCTION