fl { Dog Life Clock II PropForth 5.5 2021/04/13 9:50:15 \ ------------------------------------------------------ VFD[M202MD12B] RTS CTS GND --- GND GND --- GND ----------- Propeler | Vcc|---3V3 RxD ---| T1out T1in|---P0(Rx) ----------- ADM3202(level-conversion) +24V --- +24V +24V --- +24V -------rtc module--------------------------------------- DS3231&eeprom ----------- P28 ------|SCL Vcc |----------------3V3 P29 ------|SDA | + - | VBAT|----battery---- GND | h68 GND|----GND ----------- ------------ P28 ------|SCL Vcc |-----3V3 P29 ------|SDA WP |-----GND |h57 A0/A1/A2|NC ------------ -------short-pin--------------------------------------- 3V3 | 10kohm | P2 -----------| |--- X Shortt-pin is removed when dog is dead. |--- And only name,birthday,deadday and livingdays on LCD at power-on. GND } : DLCII ; \ =========================================================================== \ Constants \ =========================================================================== \ -----rtc&eeprom----- hD0 wconstant DS3231 \ Slave addres h68 for DS3231 hAE wconstant eeprom \ Slave addres h57 for 24C32 \ serial for PropForth<-->VFD 1 wconstant Rx 0 wconstant Tx d2400 constant baudrate \ 9600/4 2 wconstant pin variable dateStr -4 allot h32 c, h30 c, h00 c, h00 c, h20 c, \ year h00 c, h00 c, h00 c, h20 c, h00 c, h00 c, h20 c, h00 c, h00 c, h00 c, h20 c, \ month day weekday h00 c, h00 c, h3A c, h00 c, h00 c, h3A c, h00 c, h00 c, h20 c, \ hour minute second dateStr d24 + constant dateStrEnd variable infoStr -4 allot hC5 c, hC2 c, h20 c, \ natsu h46 c, h65 c, h6D c, h61 c, h6C c, h65 c, h20 c, \ Female h42 c, h69 c, h72 c, h74 c, h68 c, h64 c, h61 c, h79 c, h3A c, \ Birthday: h32 c, h30 c, h32 c, h30 c, h20 c, \ 2020 h4F c, h43 c, h54 c, h20 c, h31 c, h33 c, h20 c, \ Oct 13 h20 c, h20 c, h20 c, h20 c, h64 c, h61 c, h79 c, h73 c, h20 c, \ ****days h41 c, h47 c, h45 c, h3A c, \ AGE: h20 c, h20 c, h20 c, h20 c, h20 c, h20 c, h20 c, h20 c, \ **months or **years h20 c, h20 c, h20 c, h20 c, h20 c, h20 c, h20 c, h20 c, \ **years**months h20 c, h20 c, h20 c, h20 c, variable str0 -4 allot 4 c, h41 c, h47 c, h45 c, h3A c, \ AGE: variable str1 -4 allot 3 c, h64 c, h61 c, h79 c, \ day variable str2 -4 allot 5 c, h6D c, h6F c, h6E c, h74 c, h68 c, \ month variable str3 -4 allot 4 c, h79 c, h65 c, h61 c, h72 c, \ year wvariable BirthDay -2 allot d2020 w, d10 w, d13 w, wvariable month -2 allot d31 c, d28 c, d31 c, d30 c, d31 c, d30 c, d31 c, d31 c, d30 c, d31 c, d30 c, d31 c, \ =========================================================================== \ Variables \ =========================================================================== wvariable inchar wvariable livingDay wvariable age wvariable tmp wvariable tmp1 wvariable result wvariable strPos wvariable currentDate wvariable currentInfo wvariable delay1 wvariable delay2 wvariable romAddr wvariable num \ =========================================================================== \ DS3231 \ =========================================================================== : err_msg ." I2C error" ; \ If error, print message \ ( n1 -- ) n1:t/f : err? if err_msg cr then ; \ Start i2c-commnication \ This also can use SMBus device. \ ( -- ) lockdict create _eestart forthentry $C_a_lxasm w, h122 h113 1- tuck - h9 lshift or here W@ alignl h10 lshift or l, z1[ixnW l, z1[ixnX l, z2WyP[U l, z20iPak l, z3ryPW0 l, z1bixnW l, z2WyP[V l, z20iPak l, z3ryPW0 l, z1bixnX l, z1SV01X l, zl0 l, zCW l, zW0000 l, zG0000 l, freedict \ Re-defined RepeatedStart \ ( -- ) : Sr _eestart ; \ Stop i2c-commnication \ ( -- ) : _eestop _scli \ Release scl _sdai \ Release sda ; \ _eewrite ( c1 -- t/f ) write c1 to the eeprom, true if there was an error \ Received acknowledge from i2c-device during scl is high \ scl/sda use pull-up resistor at hi \ clock:400kHz lockdict create _eewrite forthentry $C_a_lxasm w, h12C h113 1- tuck - h9 lshift or here W@ alignl h10 lshift or l, z2WyPW8 l, z1YVPQ0 l, z1rixnd l, z1Sy\C] l, z1[ixne l, z1Sy\C] l, z1bixne l, zfyPO1 l, z3[yP[K l, z1[ixnd l, z1Sy\C] l, z1[ixne l, z1Sy\C] l, z1YF\Nl l, z1viPR6 l, z1bixne l, z1Sy\C] l, z1bixnd l, z1SV01X l, z2WyPc7 l, z20iPik l, z3ryPb0 l, z1SV000 l, zW0000 l, zG0000 l, freedict \ _eeread ( t/f -- c1 ) flag should be true is this is the last read \ scl/sda use pull-up resistor at hi \ clock:400kHz lockdict create _eeread forthentry $C_a_lxasm w, h12D h113 1- tuck - h9 lshift or here W@ alignl h10 lshift or l, z2WiPZB l, z2WyPO0 l, z1[ixne l, z2WyPj8 l, z1Sy\Ka l, z1[ixnf l, z1Sy\Ka l, z1XF\Vl l, znyPO1 l, z1bixnf l, z3[yPnN l, z26VPW0 l, z1rixne l, z1Sy\Ka l, z1[ixnf l, z1Sy\Ka l, z1bixnf l, z1bixne l, z1Sy\Ka l, z1SV01X l, z2WyPc9 l, z20iPik l, z3ryPb0 l, z1SV000 l, zW0000 l, zG0000 l, freedict \ Write series data to register in i2c_device \ ( n1..nn n2 n3 n4 -- ) n1..nn:data n2:number n3:register n4:slave_address : i2c_wr_multi \ Start I2C _eestart \ Write slave address[wr], then receive Acknowledge-bit(ACK:Lo NACK:Hi) _eewrite \ ( n1..nn n2 n3 t/f ) \ Write register swap _eewrite or \ ( n1..nn n2 t/f ) swap \ ( n1..nn t/f n2 ) \ Read n2 byte dup 1 > if \ ( n1..nn t/f n2 ) 0 do \ ( n1..nn t/f ) swap _eewrite or \ ( n1.. nn t/f ) loop else \ ( n1 t/f n2 ) drop swap _eewrite or \ ( t/f ) then \ Stop I2C _eestop err? \ ( -- ) ; \ Read data from register in i2c_device \ ( n1 n2 -- n3 ) n1:register n2:slave_address n3:data : i2c_rd \ Start I2C _eestart \ Write slave address[wr], then receive Acknowledge-bit(ACK:Lo NACK:Hi) tuck _eewrite \ ( n2 n1 t/f ) \ Write register swap _eewrite or \ ( n2 t/f ) swap \ ( t/f n2 ) \ Start read_process Sr \ Write slave address[rd], then receive Acknowledge-bit(ACK:Lo NACK:Hi) 1 or _eewrite or \ ( t/f ) \ Read 1byte ,then set sda to Hi(NACK:master->slave) -1 _eeread \ Stop I2C _eestop swap \ (n3 t/f ) err? \ ( n3 ) ; \ bcd> ( n1 -- n2 ) convert bcd byte n1 to hex byte n2 : bcd> dup hF and swap hF0 and 1 rshift dup 2 rshift + + ; \ >bcd ( n1 -- n2 ) convert hex byte n1 to bcd byte n2 : >bcd d10 u/mod 4 lshift + ; \ Get current time \ Read/Convert current time from DS3231 \ ( -- n1 n2 n3 n4 n5 n6 n7 ) \ n1 - second (00 - 59) \ n2 - minute (00 - 59) \ n3 - hour (00 - 23) \ n4 - day of week (Mon:1 Tue:2 Wed:3 Thur:4 Fri:5 Sat:6 San:7) \ n5 - date (01 - 31) \ n6 - month (01 - 12) \ n7 - year (00 - 99) : rdTime 7 0 do 0 i + DS3231 i2c_rd bcd> loop ; \ Set current-time to DS3231 (24Hour mode) \ Set second to 0 \ ( n1 n2 n3 n4 n5 n6 -- ) \ n1 - year (2000 - 2099) \ n2 - month (01 - 12) \ n3 - date (01 - 31) \ n4 - day-of-week (Mon:1 Tue:2 Wed:3 Thur:4 Fri:5 Sat:6 San:7) \ n5 - hour (00 - 23) \ n6 - minute (00 - 59) : setTime >bcd >r \ minute >bcd >r \ hour >r \ day-of-week >bcd >r \ day >bcd >r \ month d2000 - >bcd \ year r> r> r> r> r> 0 7 0 DS3231 i2c_wr_multi ; \ Save weekday to Time string \ ( n1 n2 -- ) n1:1 to 7 n2:weekday-position inside string buffer : weekdayConv swap 1- c" MONTUEWEDTHUFRISATSUN" 1+ \ ( n2 n1 cstr+1 ) swap 3 * + \ ( n2 cstr+n1*3 ) 3 0 do dup i + C@ 2 ST@ i + C! loop 2drop ; \ Save month-number to Time string \ ( n1 n2 -- ) n1:1 to 12 n2:month-position inside string buffer : monthConv swap 1- c" JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC" 1+ \ ( n2 n1 cstr+1 ) swap 3 * + \ ( n2 cstr+n1*3 ) 3 0 do dup i + C@ 2 ST@ i + C! loop 2drop ; \ Convert date to 2char ascii with zero suppression \ ( n1 n2 -- ) n1:0-31 n2:string address : dateConv swap d10 u/mod \ ( n2 reminder quotient ) dup 0= if drop h30 or over C! h20 swap 1+ C! else h30 or 2 ST@ C! \ ( n2 reminder ) h30 or swap 1+ C! \ ( -- ) then ; \ Convert 2digit to 2char ascii \ ( n1 n2 -- ) n1:00-59 n2:string address : 2digitConv swap d10 u/mod \ ( n2 reminder quotient ) h30 or 2 ST@ C! \ ( n2 reminder ) h30 or swap 1+ C! \ ( -- ) ; \ Save current time from DS3231 to dateStr[Time] \ ( -- ) : saveTime rdTime dateStr 2+ dup >r 2digitConv \ Year r> 3 + dup >r monthConv \ month r> 4 + dup >r dateConv \ date r> 3 + dup >r weekdayConv \ day of week r> 4 + dup >r 2digitConv \ hour r> 3 + dup >r 2digitConv \ minute r> 3 + 2digitConv \ second ; \ =========================================================================== \ eeprom \ =========================================================================== \ Wite eeprom address \ ( n1 n2 -- ) n1:eeprom address n2:t/f n3:Lo-address n4:Hi-address : addrWr swap \ ( t/f n1 ) dup 8 rshift \ ( t/f Lo-address Hi-address ) \ Write address _eewrite swap _eewrite or or \ ( t/f ) ; \ Write data to address in eeprom(24C32) \ ( n1 n2 n3 -- ) n1:data n2:eeprom address n3:slave_address : wrEEPROM \ Start I2C _eestart \ Write slave address[wr], then receive Acknowledge-bit(ACK:Lo NACK:Hi) _eewrite \ ( n1 n2 t/f ) \ Write eeprom address addrWr \ Write data swap _eewrite or \ ( t/f ) \ Stop I2C _eestop err? \ ( -- ) ; \ Byte Read from address in eeprom(24C32) \ ( n1 n2 -- n3 ) n1:eeprom address n2:SlaveAddress n3:byte data : rdEEPROM dup t0 W! \ Save SlaveAddress \ Start I2C _eestart \ Write slave address[wr], then receive Acknowledge-bit(ACK:Lo NACK:Hi) _eewrite \ ( n1 t/f ) \ Write eeprom address addrWr \ Start read_process Sr t0 W@ \ Copy SlaveAddress ( t/f n2 ) 1 or _eewrite or \ ( t/f ) \ Read 1byte ,then set sda to Hi(NACK:master->slave) -1 _eeread \ Stop I2C _eestop swap \ ( n3 t/f ) err? \ ( n3 ) ; \ =========================================================================== \ VFD \ =========================================================================== \ Start up serial-communication \ This need to execute when staring serial-communication at first \ ( -- ) : initSerial c" Tx Rx baudrate serial" 4 cogx \ Start serial on cog4 d100 delms inchar 4 cogio 2+ W! \ Set output of cog4 inchar h100 inchar W! \ Clear inchar 1 4 sersetflags ; \ Stop Serial communication \ This need to execute when finishing serial-communication at last \ ( -- ) : stopSerial 0 4 cogio 2+ W! 4 cogreset ; \ Transmit data[1byte] \ ( n1 -- ) n1:transmitting byte : Transmit begin 4 cogio W@ h100 and until \ Wait until input for serial-cog is under ready-state 4 cogio W! \ Write data to cog4's input ; \ Receive data and save them in free area \ ( n1 -- n2 ) n1:repeat number n2:last addres+1 of free area : Receive here W@ swap 0 do begin inchar W@ h100 and 0= until \ Wait until output for serial-cog is under ready-state inchar W@ over C! \ Save output-data of cog4 to free area h100 inchar W! \ Clear inchar1 1+ \ Increment free space address loop ; \ =========================================================================== \ Main \ =========================================================================== \ Check leap \ ( n1 -- n2 ) n1:year n2:1[leap] 0[normal] : leap? 4 u/mod drop 0= if 1 else 0 then ; \ Get current year \ ( -- n1 ) n1:current year : currentYear 6 DS3231 i2c_rd bcd> d2000 + ; \ Get current month \ ( -- n1 ) n1:current month : currentMonth 5 DS3231 i2c_rd bcd> ; \ Get current day \ ( -- n1 ) n1:current day : currentDay 4 DS3231 i2c_rd bcd> ; \ Get BirthDay year \ ( -- n1 ) n1:BirthDay year : BirthDayYear BirthDay W@ ; \ Get BirthDay month \ ( -- n1 ) n1:BirthDay month : BirthDayMonth BirthDay 2+ W@ ; \ Get BirthDay day \ ( -- n1 ) n1:BirthDay day : BirthDayDay BirthDay 4+ W@ ; \ If \ ( n1 -- n2 ) n1:calculated value n2:add 1 if leap year : calcFeb currentMonth 2 = if currentYear leap? if 1+ thens ; \ Add 1 if leap year \ ( n1 -- n2 ) n1:days n2:+1 if leap year : chkLeap = if currentYear leap? if 1+ thens ; \ Get days of BirthDayMonth \ ( n1 -- n2 ) n1:initial[0] n2:days of BirthDayMonth : getDaysBirthDayMonth BirthDayMonth 1- month + C@ \ Get all days of BirthDayMonth \ Add 1 if leap year BirthDayMonth 2 chkLeap BirthDayDay - \ Get days of BirthDayMonth + ; \ Calculate days until current day \ (currentYear same as Birthday year) \ ( n1 -- n2 ) n1:initial[0] n2:days until current day : calcMonthDaysType1 getDaysBirthDayMonth \ Add days from BirthDayMonth+1 to currntDay currentMonth BirthDayMonth do lasti? if currentDay + \ Add last month days else i month + C@ + \ Add days of next month i 1 chkLeap \ Check Feb(i=1:FEb because of month[0..11]) then loop ; \ Calculate days of BirthDayYear(from BirthDayMonth to December/31 \ (currentYear NOT same as Birthday year) \ ( n1 -- n2 ) n1:initial[0] n2:days until Dec 31 : calcMonthDaysType2 getDaysBirthDayMonth \ Add days from BirthDayMonth+1 to Dec 31 d12 BirthDayMonth do i month + C@ + \ Add days of next month i 1 chkLeap \ Check Feb(i=1:FEb because of month[0..11]) loop ; \ Calculate livingDay \ ( -- ) : calcLivingDay 0 age W! 0 \ initial value \ Compare year BirthDayYear currentYear = if \ In case of currentYear same as Birthday year BirthDayMonth currentMonth = \ Compare month if currentDay BirthDayDay - + \ Add difference of day else calcMonthDaysType1 then else \ In case of currentYear NOT same as BirthDayYear \ Calculate days of BirthDayYear(from BirthDayMonth to December/31) calcMonthDaysType2 currentYear BirthDayYear - 1 > if BirthDayYear 1+ currentYear BirthDayYear - 1- bounds do i leap? if d366 else d365 then + 1 age W+! loop then \ Calculate days during currentYear[from Jan 1 to currentDay] currentMonth 1 <> if currentMonth 1- 0 do \ from Jan 1 to currentMonth-1 i month + C@ + \ Add days of each month[from Jan 1 to currentMonth-1] i 1+ 2 chkLeap \ Check Feb(i=1:FEb because of month[0..11]) loop then currentDay + \ Add days of last month then livingDay W! ; \ Convert 1digit to ascii(ignore zero of top) \ ( n1 -- n2 n3 ) n1:number n2:number(not n1) n3:asciii code : convAscii dup tmp W@ >= \ Check if n1 is bigger than tmp if tmp W@ u/mod h30 + \ Convert number to ascii 1 result W! else result W@ tmp W@ 1 = or if h30 else 0 then \ Set zero then tmp W@ d10 / tmp W! \ Divide tmp by 10 ; \ Add 1 to strtPos \ ( -- ) : strPos+1 1 strPos W+! ; \ Check Month&Day about currentYear and BirthDayYear \ ( -- n1 ) n1:true if both are same : chkMonthDay currentMonth BirthDayMonth = currentDay BirthDayDay >= and currentMonth BirthDayMonth > or ; \ Save 2digit/1digit to Age's item of infoStr \ ( n1 -- ) n1:number : 2digitCopy 0 result W! d10 tmp W! 2 0 do convAscii dup 0<> if strPos W@ C! \ Copy number to infoStr strPos+1 else drop then loop drop ; \ Copy string inside Age's item of infoStr \ ( n1 -- ) n1;string address : strCopy dup 1+ swap C@ \ Get string-length bounds do \ Copy string i C@ strPos W@ C! strPos+1 loop ; \ Add 's' to follwing "day" \ ( -- ) : add's' h73 strPos W@ C! strPos+1 h20 strPos W@ C! strPos+1 ; \ Add 's' to follwing "day" and no space \ ( -- ) : add's'noSP h73 strPos W@ C! strPos+1 ; \ Save livingDay in infoStr \ ( n1 -- ) n1:number : save_livingDay infoStr d31 + strPos W! 0 result W! d1000 tmp W! 4 0 do convAscii dup 0<> if strPos W@ C! \ Copy 1digit to infoStr strPos+1 else drop then loop drop str1 strCopy \ Copy 'day' livingDay W@ 1 > if add's' \ Copy 's' and space' else h20 strPos W@ C! \ Copy space strPos+1 then ; \ Judge if adding 's' following string \ ( n1 -- ) n1:add 's' if true : strTerminate if add's' \ Copy 's' and space' else h20 strPos W@ C! \ Copy space strPos+1 then ; \ Calculate dog \ ( -- ) : calcAge \ Copy string[Age:] to item:Age inside infoStr str0 strCopy currentYear BirthDayYear = if \ currentYear is same year as BirthDayYear \ Get month currentMonth BirthDayMonth - currentDay BirthDayDay < if 1- then else \ currentYear is different year as BirthDayYear \ Get months in BirthDayYear d12 BirthDayMonth - \ Get months in currentYear currentMonth currentDay BirthDayDay < if 1- then \ sum + then d12 u/mod age W+! \ ( months ) Update years dup tmp1 W! \ Save month age W@ + 0= \ Check if both month and year are zero if \ less than 1month (1day-30days) livingDay W@ 2digitCopy str1 strCopy \ Copy 'day' livingDay W@ 1 > if add's' \ Copy 's' and space' else h20 strPos W@ C! \ Copy space strPos+1 then else \ year and month age W@ 0> if \ year age W@ 2digitCopy str3 strCopy tmp1 W@ 0= if age W@ 1 > strTerminate else age W@ 1 > if add's'noSP then \ year and month tmp1 W@ 2digitCopy str2 strCopy tmp1 W@ 1 > strTerminate then else \ only month tmp1 W@ dup 2digitCopy str2 strCopy 1 > strTerminate then then ; \ Read address'0' in eeprom( 0n rtc module) \ ( -- ) : dogInfoStrLen 0 eeprom rdEEPROM ; \ Scan dateStr/infoStr on VFD \ ( --) : scanVFD dateStr currentDate W! infoStr currentInfo W! begin \ 25characters on 1st row delay1 W@ d1200 u/mod drop 0= if h10 Transmit 0 Transmit \ Set write-in position[left end of 1st row ] d20 0 do currentDate W@ i + dup dateStrEnd > if d25 - then \ Back to top of dateStr C@ Transmit \ Transmit character loop currentDate W@ 1+ dup dateStrEnd > if drop dateStr saveTime then currentDate W! then 1 delay1 W+! delay2 W@ d1000 u/mod drop 0= if h10 Transmit h14 Transmit \ Set write-in position[left end of 1st row 2 d20 0 do currentInfo W@ i + dup strPos W@ 1- > if strPos W@ infoStr - - then \ Back to top of infoStr C@ Transmit loop currentInfo W@ 1+ dup strPos W@ = if 1 DS3231 i2c_rd bcd> 2 DS3231 i2c_rd bcd> or 0= \ minute=hour=0 dogInfoStrLen hFF = and \ Don't update when dog was dead if \ Update livingDays & age at 0hour0minute calcLivingDay livingDay W@ save_livingDay calcAge then drop infoStr then currentInfo W! then 1 delay2 W+! 0 until ; \ Check whether pin is hi(short-pin is off) or lo \ ( -- n1 ) n1:true if hi : pinStatus? pin >m ina COG@ and ; \ Check short-pin \ ( -- n1 ) n1:true(pin-off) false(pin-on) : chkPin pinStatus? dup if drop d100 delms pinStatus? then ; \ Write 1byte to eeprom and after writing increasing address \ ( n1 -- ) n1:1byte : byteEEPROM romAddr W@ eeprom wrEEPROM 1 romAddr W+! 2 delms ; \ write string to EEPROM \ ( -- ) : writeStrEEPROM 1 romAddr W! \ short-pin is off when dog is dead \ Save string to eeprom infoStr \ Copy name d10 0 do dup i + C@ byteEEPROM loop d19 + \ address of Birthday's string d11 0 do \ Copy birthday dup i + C@ byteEEPROM loop d12 + \ address of livingday's string h2D byteEEPROM \ - dateStr \ Deathday d12 0 do \ Copy deathday dup i + C@ byteEEPROM loop drop 0 num W! 2 swap \ ( 2 address ) begin \ Copy livingday and Age dup C@ dup byteEEPROM h20 = if 1 num W+! then 1+ over num W@ = if 1 else 0 then until 2drop \ Write string-length in eeprom-top romAddr W@ 0 eeprom wrEEPROM ; \ Procedure after dog was dead \ ( -- ) : noDog infoStr dogInfoStrLen 1- dup infoStr + strPos W! 0 do i 1+ eeprom rdEEPROM over i + C! loop drop \ Scan VFD scanVFD ; \ Upper side is clock and Lower side is dog's information[name Birthday livingdays years]. \ Both side are shifted to left. \ When short-pin(connected to P2) is off, Lower side is dead dog's information[name Birthday Deadday livingdays years] \ Upper side(clock) also continue to display \ ( -- ) : DogLifeClockII initSerial saveTime \ Check data in address'0' inside eeprom dogInfoStrLen hFF <> if noDog then calcLivingDay livingDay W@ save_livingDay calcAge c" scanVFD" 0 cogx begin chkPin if writeStrEEPROM reboot then 0 until { fkey? swap drop until stopSerial 0 cogreset } ; \ Boot after Power-on : onreset5 onreset DogLifeClockII ; { \ View string inside eeprom[24C32] inside rtc module \ ( -- ) : viewROM 0 eeprom rdEEPROM dup . cr 0 do i eeprom rdEEPROM emit loop ; \ Fill string in eeprom[24C32] by hFF \ ( -- ) : eepromFill 0 romAddr W! 0 eeprom rdEEPROM 0 do hFF byteEEPROM 2 delms loop ; }