 ILABEL E:\ASSEMBLE\SOURCE\TOS\TOS.L

; This program sets GEMDOS clock after receiving time from Naval
; Observatory in Washington D.C.  The D.C. Observatory spits out the
; julian date and that must be converted to the _wonderful_ system the
; ST uses to store the time and date (yea, right!) with the following
; formula (please don't ask me how this formula works, I downloaded it
; from the Observatory):

; L=Julian date + 2468570
; N=4 * L/146097
; L = L - (146097 * N + 3) / 4
; Y = 4000 * (L + 1) / 1461001
; L = L - (1461 * Y / 4) + 31
; M = 80 * L / 2447
; DAY = L - (2447 * M / 80)          DAY = DAY OF MONTH
; L = M / 11
; MONTH = M + 2 - (12 * L)         MONTH = CURRENT MONTH
; YEAR = 100 * (N - 49) + Y + L     YEAR = CURRENT YEAR

; PLEASE DO NOT TRY TO FIGURE THIS FORMULA OUT AT HOME.  YOU MAY INJURE
; YOURSELF

 TEXT
                 dc.w    $a00a          ;hide mouse
                 bsr     clearrs232     ;clear serial port of garbage
                 bsr     getdat         ;load the DAT file
                 bsr     dial           ;output string to serial
                 bsr     getinput       ;get input from Observatory
                 bsr     asc2dec        ;convert text into decimal format
                 bsr     jd2greg        ;convert julian date to gregorian
                 bsr     setclock       ;convert greg to GEMDOS time and set
                 bsr     curandreal     ;print current and actual time
                 printline finished
quit:
                 supexec hangup
                 conin_we               ;wait for keypress (without echo)
                 term                   ; MILLER TIME!

;***************************** CLEARRS232 *****************************
clearrs232:
                 printline intro
                 rsconf  #-1,#-1,#-1,#-1,#0,#7   ;set port to 1200 baud
clear:
                 auxistat               ;check for junk characters
                 tst     d0             ;any there?
                 beq     rsdone         ;NO!
                 auxin                  ;get and trash unwanted char
                 bra     clear          ;do until no more characters
rsdone:
                 rts                    ;fin¡

;******************************* GETDAT ******************************
getdat:
                 open    #0,fname       ;open file
                 tst.l   d0             ;error?   (file not found)
                 bmi     createfile     ;yes, create

                 move.w  d0,handle      ;save handle

                 read    timez,#1,handle         ;read timezone data
                 read    initstring,#80,handle   ;read initialization
                 move.l  d0,length               ;save length
                 close   handle                  ;close file
                 rts
;******************************* CREATEFILE **************************
createfile:
                 printline  filenotfound     ;print error message
                 create  #0,fname            ;create file
                 move.w  d0,handle           ;save handle

                 conin_we                    ;get timezone input
                 sub.b   #$31,d0             ;convert to decimal-1
                 move.b  d0,timez            ;save timezone input
                 write   timez,#1,handle     ;write to file

                 printline initst            ;print init message

                 move.l  #initstring,a3      ;address of buffer
                 clr.l   d3                  ;clear garbage
inputloop:
                 conin                  ;get keyboard input
                 cmp.b   #26,d0         ;ctrl Z??
                 beq     loopdone       ;if yes, we're done inputting
                 cmp.b   #$8,d0         ;backspace?
                 beq     bs             ;if yes, handle backspace
                 cmp.b   #$d,d0         ;RETURN?
                 beq     ret            ;yes, handle it
                 move.b  d0,(a3)+       ;save input in buffer
                 add.l   #1,d3          ;keep track of length of input
                 bra     inputloop      ;keep inputting

ret:
                 move.b  #$d,(a3)+
                 move.b  #$a,(a3)+
                 add.l   #2,d3
                 conout  #$a
                 bra     inputloop

bs:
                 conout  #32            ;erase letter
                 conout  #8             ;move back
                 sub.l   #1,d3          ;subtract from length of input
                 tst.l   d3             ;did we hit backspace too much?
                 bmi     toofar         ;yes, start from ZERO
                 move.b  #0,-(a3)       ;we're ok, so delete last input
                 bra     inputloop      ;keeping inputting
toofar:
                 clr.l   d3             ;0 length
                 bra     inputloop      ;keep inputting

loopdone:
                 write   initstring,d3,handle     ;save init file
                 move.l  d3,length                ;save length
                 close   handle                   ;close file
                 printline intro
                 rts                              ;done

;******************************* DIAL ********************************
dial:
                 printline dialing                  ;dialing message
                 write   initstring,length,#2       ;output to modem
                 write   phnum,#9,#2               ;output ph #
                 rts

;***************************** GETINPUT *******************************
getinput:
                 move.l  #0,d3          ;wait 0 seconds
                 supexec tloop0         ;current time will be returned in d4
                 move.l  curtime,starttime   ;save beginning time...
gi2:
                 auxistat               ;is a character waiting?
                 tst.l   d0             ;if d0=0, no char waiting...
                 beq     timer          ;no char, check time
                 auxin                  ;get character from serial
                 cmp.b   #"*",d0        ;is it header character
                 beq     receive        ;yes, get time...
timer:
                 constat                ;keypress?
                 tst.l   d0             ;if d0=-1, char waiting
                 bmi     interrupt      ;see if it's a space
tcont:
                 move.l  #0,d3          ;wait 0 again...
                 supexec tloop0         ;get current time
                 move.l  starttime,d4   ;get starting time
                 sub.l   d4,curtime     ;get time difference
                 cmp.l   #6000,curtime  ;less than 10 seconds
                 blt     gi2            ;ok, less than 10 seconds

                 printline timeout      ;TIMEOUT ERROR
                 bra     quit           ;term prg

interrupt:
                 conin_we               ;get keypress
                 cmp.b   #32,d0         ;spacebar
                 bne     tcont          ;no
                 printline abort        ;user aborted (IDIOT!)
                 printline fin2
                 bra     quit

receive:
                 printline receiving    ;yes, tell em we're receiving
                 auxin                  ;get CR, and trash it
                 auxin                  ;get LF, and trash it too

                 move.l  #inputbuf,a3   ;address of buffer

stringin:
                 auxin                  ;get character from serial
                 cmp.b   #"*",d0        ;are we done?
                 beq     stringdone     ;yes
                 sub.b   #$30,d0        ;convert to decimal
                 move.b  d0,(a3)+       ;save it in buffer
                 bra     stringin       ;keep going
stringdone:
                 rts                    ;ta da!

;******************************** HANGUP *****************************
hangup:
                 move.l  #400,d3        ; at least 1 second wait
                 supexec tloop0         ; wait
                 write   esccode,#3,#2  ; Send Escape Code
                 move.l  #400,d3        ; at least 1 second pause
                 supexec tloop0         ; pause
                 write   mreset,#5,#2   ; "ATH"

                 rts                    ;alacazam!

;****************************** ASC2DEC *****************************
asc2dec:
                 printline setting      ;print message
                 move.l  #inputbuf,a3   ;address of input
                 clr.l   d0             ;clear garbage
                 move.b  (a3)+,d0       ;get first character
                 mulu    #10000,d0      ;10000's place
                 add.l   d0,julian      ;add to julian date
                 clr.l   d0             ;clear junk
                 move.b  (a3)+,d0       ;get second char
                 mulu    #1000,d0       ;1000's place
                 add.l   d0,julian      ;add to julian date
                 clr.l   d0             ;you know by now...
                 move.b  (a3)+,d0       ;get third
                 mulu    #100,d0        ;100's place
                 add.l   d0,julian      ;add to julian date
                 clr.l   d0             ;and so on...
                 move.b  (a3)+,d0       ;get fourth
                 mulu    #10,d0         ;10's place
                 add.l   d0,julian      ;add to julian date
                 clr.l   d0             ; etc. etc.
                 move.b  (a3)+,d0       ;finally
                 add.l   d0,julian      ;1's place, add to julian

                 move.b  (a3)+,d0       ;junk next space

chkspc:
                 cmp.b   #$f0,(a3)+     ;check for space? (space-$30)
                 bne     chkspc         ;no

                 clr.l   d0
                 move.b  (a3)+,d0       ;get first digit for hours
                 mulu    #10,d0         ;10's place
                 add.l   d0,hour        ;add to hour
                 move.b  (a3)+,d0       ;one's place
                 add.l   d0,hour        ;add to hour
                 move.b  (a3)+,d0       ;first digit of minutes
                 mulu    #10,d0         ;10s place
                 add.l   d0,minute      ;save it
                 move.b  (a3)+,d0       ;ones place
                 add.l   d0,minute      ;save it
                 move.b  (a3)+,d0       ;first digit of seconds
                 mulu    #10,d0         ;10's place
                 add.b   (a3)+,d0       ;add one's place
                 lsr.l   #1,d0          ;GEMDOS like seconds/2
                 move.l  d0,second      ;save it

                 clr.l   d0             ;just in case...
                 clr.l   d1             ;and this too...
                 move.b  timez,d0       ;get timezone data
                 move.l  #timedif,a0    ;address of timezone change
                 move.b  0(a0,d0.w),d1  ;get correct change in timezone
                 sub.l   d1,hour        ;correct for timezone
                 tst.l   hour           ;are we into previous day?
                 bge     noch           ;NO
                 sub.l   #1,julian      ;yes, subtract a day
                 add.l   #24,hour       ;but make hour positive
noch:
                 rts                    ;whew!

;******************************* JD2GREG *****************************
jd2greg:
;----------------------------- CALCULATE N ----------------------------
                 clr.l   d0
                 clr.l   d1
                 move.l  julian,l       ;save julian
                 add.l   #2468570,l     ;L= Julian + 2468570
                 move.w  l+2,d0         ;low word of L into d0
                 move.w  l,d1           ;high word of L into d1
                 mulu    #4,d0          ;product #1
                 mulu    #4,d1          ;product #2
                 swap    d1             ;shift to upper word
                 add.l   d1,d0          ;d0 = L * 4
                 move.l  #146097,d3     ;divide d0 by #146097, answer in d2

                 bsr     divide         ;go do long division

                 move.l  d2,n           ;N is final answer

;---------------------------- CALCULATE Y ------------------------------
                 move.l  #2,d1          ;high word in value $23ab1
                 move.l  #$3ab1,d0      ;low word in value $23ab1

                 mulu    d2,d0          ;product #1
                 mulu    d2,d1          ;product #2
                 swap    d1             ;shift to upper word
                 add.l   d1,d0          ;d0 = N * 146097 ($23ab1)
                 add.l   #3,d0          ;add 3

                 asr.l   #2,d0          ;quickie divide by 4
                 sub.l   d0,l

                 move.l  l,d0           ;L ...
                 add.l   #1,d0          ; Plus 1
                 mulu    #4000,d0       ; Times 4000
                 move.l  #1461001,d3    ;divided by 1461001
                 bsr     divide         ;long division
                 move.l  d2,year        ;SAVE Y in year

;---------------------------- CALCULATE M & DAY -----------------------
                 mulu    #1461,d2       ;mutiply Y by 1461
                 move.l  d2,d0          ;d0 is dividend
                 
                 
                 asr.l   #2,d0      ;quickie divide by 4
                 add.l   #31,l
                 sub.l   d0,l
                 
                 move.l  l,d0           ;L...
                 mulu    #80,d0         ;times 80
                 divu    #2447,d0       ;divided by 2447
                 and.l   #$ffff,d0      ;mask off remainder
                 move.l  d0,month       ;equals M (save in month)

                 mulu    #2447,d0       ;times 2447
                 divu    #80,d0         ;divided by 80
                 and.l   #$ffff,d0      ;mask off remainder
                 move.l  l,day          ; day = L - d0
                 sub.l   d0,day         ;ACTUAL DAY

;-------------------------- CALCULATE MONTH -------------------------
                 move.l  month,d0       ;month in d0...
                 divu    #11,d0         ;divide by 11 (why???)
                 and.l   #$ffff,d0      ;no remainder
                 move.l  d0,l           ;save it
                 add.l   #2,month       ;2 + month
                 mulu    #12,d0         ; L times 12
                 sub.l   d0,month       ;difference = ACTUAL MONTH

;------------------------- CALUCULATE YEAR ------------------------
                 move.l  n,d0           ;N...
                 sub.l   #49,d0         ;minus 49...
                 mulu    #100,d0        ;times 100
                 add.l   year,d0        ;plus Y
                 add.l   l,d0           ;plus L
                 move.l  d0,year        ;equals ACTUAL YEAR
                 

                 rts                    ;yippie taye oh kiy aie

;****************************** SETCLOCK ******************************
setclock:
                 gettime                ;get current time and date
                 move.l  d0,curtime     ;save it for later use...
                 move.l  year,d5        ;get year
                 sub.l   #1980,d5       ;convert to system format (year-1980)
                 move.l  d5,year        ;save for later use!
                 asl.l   #4,d5          ;give 4 places for month
                 add.l   month,d5       ;add in month
                 asl.l   #5,d5          ;make room for day
                 add.l   day,d5         ;add in day
                 set_date d5            ;set the GEMDOS date

                 move.l  hour,d5        ;add in hour
                 asl.l   #6,d5          ;make room for minute
                 add.l   minute,d5      ;add in minute
                 asl.l   #5,d5          ;make room for seconds
                 add.l   second,d5      ;add in seconds

                 set_time d5            ;set the system time.
                 rts                    ;easy, ain't it?

;********************* PRINT CURRENT AND REAL TIME *****************
curandreal:
                 printline adate        ;print 'actual date'
                 bsr     pdate          ;print date
                 printline atime        ;print 'actual time
                 bsr     ptime          ;print time

                 printline cdate        ;print 'current date'

                 move.l  curtime,d0          ;get time and date
                 move.l  d0,second           ;save time
                 and.l   #%11111,second      ;seconds only
                 asr.l   #5,d0               ;shift for minutes
                 move.l  d0,minute           ;save time
                 and.l   #%111111,minute     ;min only
                 asr.l   #6,d0               ;shift for hours
                 move.l  d0,hour             ;hours
                 and.l   #%11111,hour        ;hours only
                 asr.l   #5,d0               ;shift for day
                 move.l  d0,day              ;save it
                 and.l   #%11111,day         ;day only
                 asr.l   #5,d0               ;shift for month
                 move.l  d0,month            ;save it
                 and.l   #%11111,month       ;month only
                 asr.l   #4,d0               ;shift for year (minus 1980)
                 move.l  d0,year             ;save year

                 bsr     pdate               ;print current date
                 printline ctime             ;print 'current time'
                 bsr     ptime               ;print time
                 rts

pdate:
                 move.l  month,d3       ;print month
                 bsr     pnum           ;print number... (d3)
                 conout  #'/'           ;output /
                 move.l  day,d3         ;print day
                 bsr     pnum           ;print number
                 conout  #'/'           ;output /
                 move.l  year,d3        ;output year
                 add.l   #80,d3         ;plus 80...
                 bsr     pnum           ;print number
                 rts

ptime:
                 move.l  hour,d3        ;print hour
                 bsr     pnum
                 conout  #':'           ;output :
                 move.l  minute,d3      ;print minute
                 bsr     pnum
                 conout  #':'           ;output :
                 move.l  second,d3      ;print second
                 asl     #1,d3          ;times 2
                 bsr     pnum
                 rts

pnum:
                 divu    #10,d3         ;uw contain 1's pl, lw=10's
                 add.w   #$30,d3        ;d3 contains ascii 10's place
                 conout  d3             ;output 10's place
                 swap    d3             ;1's place in low word
                 add.w   #$30,d3        ;d3 contains ascii 1's placer
                 conout  d3
                 rts




;******************************** DIVIDE ***************************
divide:
                 clr.l   d2             ;counter for 32-bit division
dloop:
                 sub.l   d3,d0          ;long division
                 bmi     divdone        ;did we subtract too much?  yes
                 addq.l  #1,d2          ;no, count 1
                 bra     dloop          ;keep subtracting
divdone:
                 rts

;******************************* TLOOP0 ******************************
tloop0:
                 move.l  $4ba,d4        ; Get value in 200hz counter
                 move.l  d4,curtime     ; save current time
tloop1:
                 cmp.l   $4ba,d4        ; Has the clock ticked yet?
                 beq     tloop1         ; If not, loop until it does

                 dbeq    d3,tloop0      ; Decrement ticks, loop til zero
                 rts


;****************************** THE DATA ****************************
 DATA
julian           dc.l    0
phnum            dc.b    "6530351",$d,$a,0
                 align
esccode          dc.b    "+++",0
                 align
mreset           dc.b    "ATH",$d,$a,0
                 align
fname            dc.b    "CALLTIME.DAT",0
                 align
dialing          dc.b    $d,$a,$a,"Dialing Naval Observatory...",$d,$a,$0
                 align
receiving        dc.b    "Receiving time and date...",$d,$a,$0
                 align
setting          dc.b    "Setting system clock...",$d,$a,$a,$0
                 align
finished         dc.b    $d,$a,$a,"Done!  System clock now accurate to 1 second...",$a
fin2             dc.b    $d,"Thank you for using Bob's CallTime  V. 3.0",$a
                 dc.b    $d,"If you find this program useful, please consider",$a
                 dc.b    $d,"making a donation of $10 U.S. currency.",$d,$a,$a,$a
                 dc.b    "Bob Areddy",$d,$a,"2607 Clawson Avenue",$d,$a
                 dc.b    "Royal Oak, Mi  48073",$d,$a,$a,$a
                 dc.b    $0
                 align
filenotfound:    dc.b    "Data file not found...",$d,$a,$a,$a
                 dc.b    "                          Please Select Time Zone",$d,$a,$a
                 dc.b    "                Standard Time              Daylight Savings Time",$d,$a
                 dc.b    "                 1)  Pacific                   2)  Pacific",$d,$a
                 dc.b    "                 3)  Mountain                  4)  Mountain",$d,$a
                 dc.b    "                 5)  Central                   6)  Central",$d,$a
                 dc.b    "                 7)  Eastern                   8)  Eastern",$d,$a
                 dc.b    "                                   9)  Zulu",$d,$a,$a,$a,$0
                 align
initst           dc.b    $d,$a,$a,"Please enter initialization string... (press control-z when done)",$d,$a,$a
                 align
timedif          dc.b    8,7,7,6,6,5,5,4,0
timeout          dc.b    "Timeout error... unable to receive data.",$d,$a,$a
                 dc.b    "Press any key to exit...",$1b,$66,$0
intro            dc.b    $1b,$45,$1b,"e                        Bob's Calltime   v. 3.1",$d,$a
                 dc.b    "                       Copyright (c)  1990,1994",$d,$a,$a,$0
abort            dc.b    $d,"User interrupted program....",$d,$a,$a,$0
cdate            dc.b    $d,$a,"            GEMDOS date  ",0
ctime            dc.b    "                  GEMDOS time  ",0
adate            dc.b    $d,$a," Naval Observatory date  ",0
atime            dc.b    "       Naval Observatory time  ",0


 BSS
 ALIGN
handle           ds.w    1
initstring       ds.b    128,0
l                ds.l    1
n                ds.l    1
year             ds.l    1
month            ds.l    1
day              ds.l    1
hour             ds.l    1
minute           ds.l    1
second           ds.l    1
dummy1           ds.l    1
dummy2           ds.l    1
length           ds.l    1
inputbuf         ds.b    64,0
timez            ds.b    1
                 align
starttime        ds.l    1
curtime          ds.l    1
                 end

