如何使用 big-bang 制作交互式日历?

How to make a interactive calendar by using big-bang?

我打算设计一个交互式的每周锻炼日历。该程序显示当前日期和相关锻炼,允许用户分别通过按 right/left 箭头键滚动 forward/backward 周。当我完成编码时,to-draw和on-key部分出现了一些问题。

(require 2htdp/image)
(require 2htdp/universe)
(define SUNDAY "Sunday Climbing")
(define MONDAY "Monday Cardio")
(define TUESDAY "Tuesday Upper body+Core")
(define WEDNESDAY "Wednesday Cardio")
(define THURSDAY "Thursday Lower Body + Core")
(define FRIDAY "Friday Cardio")
(define SATURDAY "Saturday Rest")
(check-expect (exercise SUNDAY) "Sunday Climbing")
(check-expect (exercise MONDAY) "Monday Cardio")
(define (exercise e-day)
   (cond
     [(string=? e-day SUNDAY) SUNDAY]
     [(string=? e-day MONDAY) MONDAY]
     [(string=? e-day TUESDAY) TUESDAY]
     [(string=? e-day WEDNESDAY) WEDNESDAY]
     [(string=? e-day THURSDAY) THURSDAY]
     [(string=? e-day FRIDAY) FRIDAY]
     [(string=? e-day SATURDAY) SATURDAY]))

下周函数:

(check-expect (next-weekday SUNDAY) MONDAY)
(check-expect (next-weekday MONDAY) TUESDAY)
(define (next-weekday d)
   (cond
     [(string=? d SUNDAY) MONDAY]
     [(string=? d MONDAY) TUESDAY]
     [(string=? d TUESDAY) WEDNESDAY]
     [(string=? d WEDNESDAY) THURSDAY]
     [(string=? d THURSDAY) FRIDAY]
     [(string=? d FRIDAY) SATURDAY]
     [(string=? d SATURDAY) SUNDAY]))

上周函数:

(check-expect (prev-weekday SUNDAY) SATURDAY)
(check-expect (prev-weekday MONDAY) SUNDAY)
(define (prev-weekday d)
   (cond
     [(string=? d SUNDAY) SATURDAY]
     [(string=? d MONDAY) SUNDAY]
     [(string=? d TUESDAY) MONDAY]
     [(string=? d WEDNESDAY) TUESDAY]
     [(string=? d THURSDAY) WEDNESDAY]
     [(string=? d FRIDAY) THURSDAY]
     [(string=? d SATURDAY) FRIDAY]))

大爆炸:

(define (exercise-calendar initial-d)
      (big-bang initial-d
        [to-draw draw-day]
        [on-key move-day]))
    (define BACKGROUND (square 200 "solid" "white"))
    (define WEEKDAY(text (exercise e-day) 36 "blue"))
    (check-expect
     (draw-day day)
     (place-image
      WEEKDAY
      50 50
      BACKGROUND))
    (define
     (draw-day day)
     (place-image
      WEEKDAY
      50 50
      BACKGROUND))
    (define (move-day p ke)
      (cond
        [(key=? ke "left") (prev-weekday p)]
        [(key=? ke "right") (next-weekday p)]
        [else p]))

一些注意事项:

  • 这部分 (define WEEKDAY (text (exercise e-day) 36 "blue")) 无法评估,因为 e-day 的值未知。您可以将其重写为带有参数 e-day 的函数,或者直接将其移动到 draw-day 函数中。
  • 不要在 next-weekdayprev-weekday 中重复 string=?。您可以使用一些数据结构并通过 assoc.
  • 获取数据
  • 如果那些 check-expect 测试是老师给你的,你应该像这样标记它们 “我必须使用这个代码并且不能改变它,我必须通过正是这些测试。我没有找到这样的注释,所以我重写了它们以适合我的解决方案。

其余代码类似:

(require 2htdp/image)
(require 2htdp/universe)

(define (exercise day)
  (second (assoc day (list (list "Sunday" "Sunday Climbing")
                           (list "Monday" "Monday Cardio")
                           (list "Tuesday" "Tuesday Upper body+Core")
                           (list "Wednesday" "Wednesday Cardio")
                           (list "Thursday" "Thursday Lower Body + Core")
                           (list "Friday" "Friday Cardio")
                           (list "Saturday" "Saturday Rest")))))

(define (next-weekday day)
  (second (assoc day (list (list "Sunday" "Monday")
                           (list "Monday" "Tuesday")
                           (list "Tuesday" "Wednesday")
                           (list "Wednesday" "Thursday")
                           (list "Thursday" "Friday")
                           (list "Friday" "Saturday")
                           (list "Saturday" "Sunday")))))

(define (prev-weekday day)
  (second (assoc day (list (list "Sunday" "Saturday")
                           (list "Monday" "Sunday")
                           (list "Tuesday" "Monday")
                           (list "Wednesday" "Tuesday")
                           (list "Thursday" "Wednesday")
                           (list "Friday" "Thursday")
                           (list "Saturday" "Friday")))))

(check-expect (exercise "Sunday") "Sunday Climbing")
(check-expect (exercise "Monday") "Monday Cardio")

(check-expect (next-weekday "Sunday") "Monday")
(check-expect (next-weekday "Monday") "Tuesday")

(check-expect (prev-weekday "Sunday") "Saturday")
(check-expect (prev-weekday "Monday") "Sunday")

(define bg (square 500 "solid" "white"))

(define (draw-day day)
  (place-image (text (exercise day) 18 "blue") 250 50 bg))

(define (move-day day key)
  (cond
    [(key=? key "left") (prev-weekday day)]
    [(key=? key "right") (next-weekday day)]
    [else day]))

(define (exercise-calendar day)
  (big-bang day
    [to-draw draw-day]
    [on-key move-day]))

(exercise-calendar "Monday") 开始,然后按 leftright 键。