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

I am going to design an interactive weekly exercise calendar. The program displays the current day and associated exercise, as allows the user to scroll forward/backward in the week by pressing the right/left arrow keys, respectively. When I finished coding, there are some problems in the to-draw and on-key part.

(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]))

Next week function:

(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]))

Previous week function:

(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]))

big-bang:

(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]))


Solution 1:[1]

Just some notes:

  • This part (define WEEKDAY (text (exercise e-day) 36 "blue")) can't be evaluated, because value of e-day isn't known. You can rewrite it as function with argument e-day, or move it directly into draw-day function.
  • Don't repeat string=? in next-weekday and prev-weekday. You can use some data structure and fetch data with assoc.
  • If those check-expect tests are given to you by teacher, you should mark them somehow like this "I have to use this code and can't change it and I have to pass exactly these tests". I didn't find note like this, so I rewrote them to suit my solution.

Rest of the code is similar:

(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]))

Start with (exercise-calendar "Monday") and press left and right key.

Sources

This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.

Source: Stack Overflow

Solution Source
Solution 1 Martin Půda