fl hex { Denpatokei(Radio Controlled Clock) PropForth 4.6 09/08/2011 22:58:59 } 7a1200 constant 100ms 16e3600 constant 300ms 1e84800 constant 400ms 2dc6c00 constant 600ms 3567e00 constant 700ms 44aa200 constant 900ms 1F8 wconstant ctra 1FA wconstant frqa 1FC wconstant phsa 4 wconstant _signal \ signal-input from time-module 5 wconstant _LED \ checking signal wvariable minute wvariable P_minute wvariable hour wvariable P_hour wvariable date wvariable day wvariable month wvariable year wvariable week wvariable m_data 28 c, 14 c, 0a c, 00 c, 08 c, 04 c, 02 c, 01 c, wvariable h_data 00 c, 00 c, 14 c, 0a c, 00 c, 08 c, 04 c, 02 c, 01 c, wvariable d_data1 00 c, 00 c, c8 c, 64 c, 00 c, 50 c, 28 c, 14 c, 0a c, wvariable d_data2 08 c, 04 c, 02 c, 01 c, wvariable y_data 00 c, 50 c, 32 c, 14 c, 0a c, 08 c, 04 c, 02 c, 01 c, wvariable w_data 04 c, 02 c, 01 c, wvariable total_1 1f w, 3c w, 5b w, 79 w, 98 w, b6 w, d5 w, f4 w, 112 w, 131 w, 14f w, 16e w, wvariable total_2 1f w, 3b w, 5a w, 78 w, 97 w, b5 w, d4 w, f3 w, 111 w, 130 w, 14e w, 16d w, 1 _signal lshift constant _signalm : _LED_l _LED pinlo ; : _LED_h _LED pinhi ; \ waitpeq ( n1 n2 -- ) \ wait until state n1 is equal to ina anded with n2 : waitpeq _execasm2>0 1E0 _cnip ; : 200ms? dup 300ms < swap 100ms > and ; : 500ms? dup 600ms < swap 400ms > and ; : 800ms? dup 900ms < swap 700ms > and ; : delsec 10 u/mod dup if 0 do 3e80 delms loop else drop then dup if 0 do 3e8 delms loop else drop then ; \ >bcd ( n1 -- n2 ) convert hex byte n1 to bcd byte n2 [ifndef >bcd : >bcd A u/mod 4 lshift + ; ] \ ( -- time_count_ticks) : Time 0 _signalm waitpeq \ wait for _signalm to go to low 0 phsa COG! _LED_h _signalm _signalm waitpeq \ wait for _signalm to go to high phsa COG@ dup . _LED_l ; \ ( -- 0|1|2 ) : Time_convert Time dup 800ms? if drop 0 else 500ms? if 1 else 2 thens space dup . cr ; : Frame_top 0 begin Time 200ms? if if 1 else 1 0 then else drop 0 0 then until ; : Get_minute 0 minute W! 0 P_minute W! 1 \ error_flag 8 0 do Time_convert dup P_minute W@ + P_minute W! i 3 = if 0 > if ibound seti drop 0 then \ error else dup 1 = if drop m_data 2+ i + C@ minute W@ + minute W! else 2 = if ibound seti drop 0 \ error thens loop ; : Get_Mark Time 200ms? ; : Get_hour 0 hour W! 0 P_hour W! 1 \ error_flag 9 0 do Time_convert dup P_hour W@ + P_hour W! i 2 < i 4 = or if 0 > if ibound seti drop 0 then \ error else dup 1 = if drop h_data 2+ i + C@ hour W@ + hour W! else 2 = if ibound seti drop 0 \ error thens loop ; : Get_Pass1 0 date W! 1 \ error_flag 9 0 do Time_convert i 2 < i 4 = or if 0 > if ibound seti drop 0 then \ error else dup 1 = if drop d_data1 2+ i + C@ date W@ + date W! else 2 = if ibound seti drop 0 \ error thens loop ; : Get_Pass2 1 \ error_flag 9 0 do Time_convert i 4 < if dup 1 = if drop d_data2 2+ i + C@ date W@ + date W! else 2 = if ibound seti drop 0 then \ error then else i 4 = i 5 = or if 0 > if ibound seti drop 0 then \ error else i 6 = if P_hour W@ <> if drop 0 then \ error else i 7 = if P_minute W@ <> if drop 0 then else i 8 = if 2 = if drop 0 \ error thens loop ; : Get_year 0 year W! 1 \ error_flag 9 0 do Time_convert i 0 > if dup 1 = if drop y_data 2+ i + C@ year W@ + year W! else 2 = if ibound seti drop 0 then \ error then else 2 = if ibound seti drop 0 \ error thens loop ; : Get_week 0 week W! 1 \ error_flag 9 0 do Time_convert i 3 < if dup 1 = if drop w_data 2+ i + C@ week W@ + week W! else 2 = if ibound seti drop 0 then \ error then else 2 = if ibound seti drop 0 \ error thens loop ; \ ( -- ) calculate month and day from date : convert_date 1 0 \ set month and day c 0 do year W@ 7d0 + 4 u/mod drop 0= if total_1 else total_2 then 2+ i 2 u* + W@ dup date W@ >= if drop date W@ swap - ibound seti else nip i b = if 1 year W+! 2drop 0 1 then swap 1+ swap then loop day W! month W! ; : denpatokei \ initialize 30000000 _signal or ctra COG! \ NEG detector 1 frqa COG! _LED pinout \ main-routin decoding time-information begin Frame_top Get_minute if Get_Mark ." P1" cr \ P1 if P_minute W@ 2 u/mod drop P_minute W! \ minute parity Get_hour if Get_Mark ." P2" cr \ P2 if P_hour W@ 2 u/mod drop P_hour W! Get_Pass1 if Get_Mark ." P3" cr \ P3 if Get_Pass2 if Get_Mark ." P4" cr \ P4 if minute W@ dup f = swap 2d = or \ 15minute or 45minute? if year W@ 7d0 swap - year W! ." skip p4-P5" cr 9 delsec 1 else Get_year then if Get_Mark ." P5" cr \ P5 if minute W@ dup f = swap 2d = or \ 15minute or 45minute? if week W@ 7d0 swap - week W! ." skip P5-P0" cr 9 delsec 1 else Get_week then if Get_Mark \ P0 if 0 _signalm waitpeq \ wait for _signalm to go to low ." success" cr minute 1+ dup W@ 3b = \ 59minute? minute W@ >bcd dup . if 0 swap W! hour dup W@ 17 = \ 23oclock? if 0 swap W! 1 date W+! convert_date week dup W@ 0 = \ Sunday? if 1 swap W! else 1 swap W+! then else 1 swap W+! then else 1 swap W+! convert_date then 0 minute W@ >bcd hour W@ >bcd week W@ day W@ >bcd month W@ >bcd year W@ >bcd \ _DS1337_time_w \ display ." Year " year W@ 7d0 + . ." Month " month W@ . ." Day " day W@ . ." Week " week W@ . ." Hour " hour W@ . ." Minute" minute W@ . cr 1 else ." P0 error" cr 0 then else ." P5-P0 error" cr 0 then else ." P5 error" cr 0 then else ." P4-P5 error" cr 0 then else ." P4 error" cr 0 then else ." P3-P4 error" cr 0 then else ." P3 error" cr 0 then else ." P2-P3 error" cr 0 then else ." P2 error" cr 0 then else ." P1-P2 error" cr 0 then else ." P1 error" cr 0 then else ." P0-P1 error" cr 0 then until ; decimal