code to implement text boxes

text-boxes.rkt

#lang racket

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

;; a text-box-content is a string or false

;; a text-box is (make-text-box text-box-content pixels pixels)
(define-struct text-box (content x y) #:transparent)

;; a world is (make-world (listof text-box) number)
;; side condition: number can't be >= number of boxes
(define-struct world (tbs has-focus) #:transparent)

(define SCREEN-BACKGROUND 
  (rectangle 200 200 "solid" "light gray"))
(define TEXT-SIZE 40)
(define TEXT-BOX-BACKGROUND 
  (rectangle 50 50 "solid" "white"))

;; draw the text box
;; content boolean -> image
(define (draw-text-box-content w)
  (cond [w
         (overlay
          (text w TEXT-SIZE "black")
          TEXT-BOX-BACKGROUND)]
        [else TEXT-BOX-BACKGROUND]))

;; draw a world
;; world -> image
(define (draw-world world)
  (draw-all-text-boxes
   (world-tbs world)
   SCREEN-BACKGROUND))

;; list-of-text-boxes image -> image
;; draw all of the text boxes on the given image
(define (draw-all-text-boxes lotb back)
  (cond [(empty? lotb) back]
        [else (draw-text-box
               (first lotb)
               (draw-all-text-boxes (rest lotb) back))]))

;; text-box image -> image
;; draw a single text box on an image
(define (draw-text-box tb back)
  (place-image
   (draw-text-box-content (text-box-content tb))
   (text-box-x tb) (text-box-y tb)
   back))


(check-equal?
 (draw-text-box (make-text-box #f 150 80)
                SCREEN-BACKGROUND)
 (place-image
  (rectangle 50 50 "solid" "white")
  150 80
  SCREEN-BACKGROUND))


(check-equal? 
 (draw-all-text-boxes empty SCREEN-BACKGROUND)
 SCREEN-BACKGROUND)

(check-equal?
 (draw-all-text-boxes (list (make-text-box #f 50 50)
                            (make-text-box #f 150 80))
                      SCREEN-BACKGROUND)
 (place-image
  (rectangle 50 50 "solid" "white")
  150 80
  (place-image
   (rectangle 50 50 "solid" "white")
   50 50
   SCREEN-BACKGROUND)))

(check-equal? 
 (draw-all-text-boxes (list (make-text-box "E" 50 80)
                         (make-text-box "Q" 150 80))
                      SCREEN-BACKGROUND)
 (place-image
  (draw-text-box-content "Q")
  150 80
  (place-image
   (overlay
    (text "E" 40 "black")
    (rectangle 50 50 "solid" "white"))
   50 80
   SCREEN-BACKGROUND)))


;; take the key, put the character in the world if necessary
;; w key -> world 
(define (text-box-input-key w k)
  (make-world
   (update-appropriate-text-box (world-tbs w) k (world-has-focus w))
   (world-has-focus w)))

;; list-of-text-boxes key number -> list-of-text-boxes
;; update the text box corresponding to the idx
(define (update-appropriate-text-box lotb k idx)
  (cond [(= 0 idx) (cond [(empty? lotb) (error
                                         'update-appropriate-text-box
                                         "ran out of text boxes!")]
                         [else (cons (update-text-box (first lotb) k)
                                     (rest lotb))])]
        [else (cons (first lotb)
                    (update-appropriate-text-box
                     (rest lotb)
                     k
                     (- idx 1)))]))

;; text-box key -> text-box
;; update the text box with the given key
(define (update-text-box tb k)
  (local
    [(define new-content
       (cond [(key=? k "a") "A"]
             [(key=? k "A") "A"]
             [(key=? k "b") "B"]
             [(key=? k "B") "B"]
             [(key=? k " ") #f]
             [else (text-box-content tb)]))]
    (make-text-box new-content
                   (text-box-x tb)
                   (text-box-y tb))))

;; calling update-appropriate-text-box with empty list is an error!

(check-equal? (update-appropriate-text-box (list (make-text-box "A" 10 12)
                                                 (make-text-box "B" 20 132)
                                                 (make-text-box "C" 30 112342))
                                           "A"
                                           1)
              (list (make-text-box "A" 10 12)
                    (make-text-box "A" 20 132)
                    (make-text-box "C" 30 112342)))

(check-equal? (update-text-box (make-text-box "A" 30 79) "B")
              (make-text-box "B" 30 79))

(check-equal? (update-text-box (make-text-box #f 50 50) "a") 
              (make-text-box "A" 50 50))
(check-equal? (update-text-box (make-text-box #f 50 50) "A")
              (make-text-box "A" 50 50))
(check-equal? (update-text-box (make-text-box #f 50 50) "f")
              (make-text-box #f 50 50))


(big-bang (make-world (list (make-text-box #f 50 50)
                            (make-text-box #f 150 80)
                            (make-text-box #f 30 120)
                            (make-text-box #f 130 110))
                      2)
          [to-draw draw-world]
          [on-key text-box-input-key])