\ 2006-08-16 EW adv2_timeup.fs
Variable Flags
Variable newtimer
Variable lastsec
Variable tick
Variable sec
Variable min
Variable hour
Variable day
Variable month
Variable year
500 Constant cycles.tick \ timerC Zykl./Tick
2   Constant ticks.sec   \ Ticks/Sekunde
ram
create MaxDay 31 c, 28 c, 31 c, 30 c, 31 c,
  30 c, 31 c, 31 c, 30 c, 31 c, 30 c, 31 c,
rom
: tickover? ( -- ) newtimer @ timer @ -  0< ;
: leap_year ( year -- t/f )
  dup    4 mod 0=
  over 100 mod 0<> and
  swap 400 mod 0=  or
;
: length_of_month ( year month -- maxday )
  dup 1-                \ array starts at 0
  MaxDay + c@
  swap 2 = IF           \ if month == 2
    swap leap_year IF   \   if leap_year
      1+                \     month += 1
    ENDIF
  ELSE                  \ else
    swap drop           \   remove year
  ENDIF
;
: timeup ( -- )
  cycles.tick newtimer +!
  0 Flags bset          \ tick over
  1 tick +!
  tick @ ticks.sec >= IF
    0 tick !
    1 Flags bset        \ sec over
    1 sec +!
  ENDIF
  sec @ 60 >= IF
    0 sec !
    2 Flags bset        \ min over
    1 min +!
  ENDIF
  min @ 60 >= IF
    0 min !
    3 Flags bset        \ hour over
    1 hour +!
  ENDIF
  hour @ 24 >= IF
    0 hour !
    4 Flags bset        \ day over
    1 day +!
  ENDIF
  day @ year @ month @ length_of_month > IF
    1 day !             \ offset 1!
    5 Flags bset        \ month over
    1 month +!
  ENDIF
  month @ 12 > IF
    1 month !           \ offset 1!
    6 Flags bset        \ year over
    1 year +!
  ENDIF
;