clock.fs 1.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990
  1. ( Clock JCB 10:54 11/17/10)
  2. variable seconds
  3. variable minutes
  4. variable hours
  5. variable days
  6. variable months
  7. variable years
  8. variable weekday
  9. : show2 ( a -- ) @ s>d <# # # #> type ;
  10. : setdate ( ud -- )
  11. [ -8 3600 * ] literal s>d d+
  12. d# 1 d# 60 m*/mod seconds !
  13. d# 1 d# 60 m*/mod minutes !
  14. d# 1 d# 24 m*/mod hours !
  15. d# 59. d- \ Days since Mar 1 1900
  16. 2dup d# 1 d# 7 m*/mod weekday ! 2drop
  17. d# 365 um/mod ( days years )
  18. dup d# 1900 + years !
  19. d# 4 / 1- - \ subtract leaps ( daynum 0-365 )
  20. dup d# 5 * d# 308 + d# 153 / d# 2 - months !
  21. months @ d# 4 + d# 153 d# 5 */ - d# 122 + days !
  22. home
  23. 'emit @ >r
  24. ['] vga-bigemit 'emit !
  25. s" ThuFriSatSunMonTueWed" drop
  26. weekday @ d# 3 * + d# 3 type cr
  27. s" MarAprMayJunJulAugSepOctNovDecJanFeb" drop
  28. months @ d# 3 * + d# 3 type
  29. space days @ d# 0 .r cr
  30. years @ . cr
  31. true if
  32. hours show2
  33. minutes show2
  34. seconds show2
  35. home
  36. then
  37. r> 'emit !
  38. ;
  39. : setdelay ( ud -- )
  40. 'emit @ >r
  41. ['] vga-emit 'emit !
  42. d# 32 d# 0 vga-at-xy
  43. s" ntp " type <# # # # [char] . hold #s #> type
  44. s" ms " type
  45. r> 'emit !
  46. ;
  47. include ntp.fs
  48. 2variable ntp-alarm
  49. : clock-main
  50. vga-page
  51. d# 1000000. ntp-alarm setalarm
  52. begin
  53. begin
  54. mac-fullness
  55. while
  56. arp-handler
  57. OFFSET_ETH_TYPE packet@ h# 800 =
  58. if
  59. d# 2 OFFSET_IP_DSTIP mac-inoffset mac@n net-my-ip d=
  60. if
  61. icmp-handler
  62. then
  63. loader-handler
  64. ntp-handler
  65. then
  66. depth if .s cr then
  67. mac-consume
  68. repeat
  69. ntp-alarm isalarm if
  70. ntp-request
  71. d# 1000000. ntp-alarm setalarm
  72. then
  73. next?
  74. until
  75. ;