;; The first three lines of this file were inserted by DrRacket. They record metadata
;; about the language level of this file in a form that our tools can easily process.
#reader(lib "htdp-beginner-reader.ss" "lang")((modname textbox-demo-after) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f)))
;;; This is an alternate implementation of a `textbox` struct (see `textbox-demo.rkt` for v.1).
;;;
;;; Major differences from v1:
;;;   - a natural, good use of helper-functions
;;;     (including their own tests, but (a) allowing re-use, and (b) making debugging 1000x easier)
;;;   - different representation/fields: rather than text & cursor-location, use left- and right-text.
;;;   - use named-constants, for the image-drawing details.
;;;
;;;   (You may uncomment the 'big-bang' call at very end, to demo.
;;;    But only do that AFTER all test-cases pass!)



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

; A few shorter names for standard string functions, for convenience:
;(define (substr s a b) (substring s a b))
(define (str+ s1 s2) (string-append s1 s2))
(define (strlen s) (string-length s))
; Renaming standard functions is DUBIOUS practice, esp. working on teams/companies.
; If there is a standard-name, you should use it, even if it annoys you.


; str* : nat, string -> string
; return `n` copies of `s`, appended.
;
(define (str* n s)
  (cond [(zero? n) ""]
        [else (str+ s (str* (sub1 n) s))]))

(check-expect (str* 0 "") "")
(check-expect (str* 0 "cat") "")
(check-expect (str* 1 "") "")
(check-expect (str* 1 "cat") "cat")
(check-expect (str* 3 "") "")
(check-expect (str* 3 "cat") "catcatcat")



; clamp : real?, real?, real? -> real?
; Return x, except clamped to the interval [a,b].
;   (That is, the closest number to x which is in [a,b] inclusive.)
; @pre (<= a b)
; Note: Beginning-student does not contain nan.0, but if it did this code
; would be weird in that case.
;
(define (clamp a x b)
  (cond [(<= a x b) x]
        [(not (<= a x)) a]
        [(not (<= x b)) b]
        [else (error 'clamp "violated pre-condition: first arg " a " must be <= " b)]))

(check-expect (clamp 1 3 5) 3)
(check-expect (clamp 1 0 5) 1)
(check-expect (clamp 1 7 5) 5)
(check-expect (clamp 1 1 5) 1)
(check-expect (clamp 1 5 5) 5)
(check-expect (clamp 1 +inf.0 5) 5)
(check-expect (clamp -inf.0 777777777 +inf.0) 777777777)

(define (infinite? x) (= (abs x) +inf.0))
(check-satisfied (clamp -inf.0 +inf.0 +inf.0) infinite?)
(check-satisfied (clamp -inf.0 -inf.0 +inf.0) infinite?)




; substr/safe : string, natnum, natum-or-inf.0 -> string
; Like substring, but if `a` or `b` aren't valid indices of `s`,
; just grab 'til the start/end of `s` instead.
; As a special case, `b` may be +inf.0, to take to the end-of-`s`.
; pre-condition: (and (<= a (string-length s)) (>= b 0))
;    (Note/bug: I should relax this pre-condition, after `let*` introduced.)
;
(define (substr/safe s a b)
  (substring s (clamp 0 a (strlen s)) (clamp 0 b (strlen s))))

(check-expect (substr/safe "hello" 2 4) "ll")
(check-expect (substr/safe "hello" 2 19) "llo")
(check-expect (substr/safe "hello" 2 +inf.0) "llo")

(check-expect (substr/safe "hello" 0 5) "hello")
(check-expect (substr/safe "hello" -2 44) "hello")
(check-expect (substr/safe "hello" -2 1) "h")

(check-expect (substr/safe "hello" 92 95) "")
(check-expect (substr/safe "hello" -7 -3) "")
(check-expect (substr/safe "hello" -5 0) "")

(check-expect (substr/safe "" -5 17) "")


(define (str-last s) (substr/safe s (sub1 (strlen s)) +inf.0))
(define (str-drop-last s) (substr/safe s 0 (sub1 (strlen s))))

(check-expect (str-last "") "")
(check-expect (str-last "a") "a")
(check-expect (str-last "hello") "o")
(check-expect (str-drop-last "") "")
(check-expect (str-drop-last "a") "")
(check-expect (str-drop-last "hello") "hell")


; has-prefix? : string, string -> boolean
; Does `a` start with (the characters of) `b`?
(define (has-prefix? a b)
  (string=? (substr/safe a 0 (strlen b)) b))

(check-expect (has-prefix? "" "") #true)
(check-expect (has-prefix? "cathay" "") #true)
(check-expect (has-prefix? "cathay" "cat") #true)
(check-expect (has-prefix? "cathay" "cathay") #true)

(check-expect (has-prefix? "" "y") #false)
(check-expect (has-prefix? "shorty" "longy mclongstr") #false)

(check-expect (has-prefix? "x" "y") #false)
(check-expect (has-prefix? "cathay" "catz") #false)
(check-expect (has-prefix? "cathay" "dogo") #false)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


; Data def'n:
(define-struct textbox (l r))
; make-textbox : string, string -> textbox
;    interpretation: `l` is the text to the left of the cursor; `r` is the text to the right.

; Recall: racket auto-creates constructor as above, getters, and a predicate:
;    textbox-contents : textbox -> string
;    textbox-cursor   : textbox -> natural
;    textbox? : ANY -> boolean

; examples of data
(make-textbox "" "hello")  ; cursor before entire word
(make-textbox "h" "ello")
(make-textbox "hello" "")
(make-textbox "hel" "lo")

(make-textbox "h" "")
(make-textbox "" "h")

(define EMPTY-TEXTBOX (make-textbox "" ""))

(define (tbox-l a-tbox) (textbox-l a-tbox))
(define (tbox-r a-tbox) (textbox-r a-tbox))
(define (tbox l r) (make-textbox l r))

; template:

; func-for-textbox : textbox -> ???
;
(define (func-for-textbox a-box)
  (... (textbox-l a-box) ... (textbox-r a-box) ...))

;===========

(check-expect (tbox-handle-key (tbox "hello" "") "right")
              (tbox "hello" ""))
(check-expect (tbox-handle-key (tbox "" "hello") "left")
              (tbox "" "hello"))
(check-expect (tbox-handle-key (tbox "" "hello") "\b")
              (tbox "" "hello"))

(check-expect (tbox-handle-key (tbox "hel" "lo") "z")
              (tbox "helz" "lo"))
(check-expect (tbox-handle-key (tbox "hel" "lo") "right")
              (tbox "hell" "o"))
(check-expect (tbox-handle-key (tbox "hel" "lo") "left")
              (tbox "he" "llo"))
(check-expect (tbox-handle-key (tbox "hel" "lo") "\b")
              (tbox "he" "lo"))

(check-expect (tbox-handle-key EMPTY-TEXTBOX "z")
              (tbox "z" ""))
(check-expect (tbox-handle-key EMPTY-TEXTBOX "left")
              EMPTY-TEXTBOX)
(check-expect (tbox-handle-key EMPTY-TEXTBOX "right")
              EMPTY-TEXTBOX)
(check-expect (tbox-handle-key EMPTY-TEXTBOX "\b")
              EMPTY-TEXTBOX)


; tbox-handle-key : textbox?, key-event? -> textbox?
; Update `a-textbox` to incorporate `key`.
;
(define (tbox-handle-key a-tbox key)
  (cond [(key=? key "right") (tbox (str+ (tbox-l a-tbox) (substr/safe (tbox-r a-tbox) 0 1))
                                   (substr/safe (tbox-r a-tbox) 1 +inf.0))]
        [(key=? key "left")  (tbox (str-drop-last (tbox-l a-tbox))
                                   (str+ (str-last (tbox-l a-tbox)) (tbox-r a-tbox)))]
        [(key=? key "\b")    (tbox (str-drop-last (tbox-l a-tbox))
                                   (tbox-r a-tbox))]
        [(key=? key "escape") (tbox "MVC" " FTW!")]
        [(> (strlen key) 1) a-tbox]
        [else                (tbox (str+ (tbox-l a-tbox) key)
                                   (tbox-r a-tbox))]))


(define BOX-H 40)             ; height of the drawn text-box, in px (as per image library).
(define BOX-W 400)            ; minimum width of the text-box, in px.
(define BOX (rectangle BOX-W BOX-H 'outline 'green))

(define FONT-H BOX-H)         ; font-size (height of a typical char), in px.
(define CURSOR-H (* FONT-H 0.8)) ; height of our cursor, in px.
(define CURSOR (rectangle 2 CURSOR-H 'solid 'orange)) ; the cursor-image

(check-expect (draw-tbox (tbox "hel" "lo"))
              (overlay/align "left" "center"
                             (beside (text (substring "hello" 0 3) FONT-H 'blue)
                                     CURSOR
                                     (text "lo" FONT-H 'blue))
                             BOX))


(check-expect (draw-tbox (tbox "" "hello"))
              (overlay/align "left" "center"
                             (beside CURSOR
                                     (text "hello" FONT-H 'blue))
                             BOX))

(check-expect (draw-tbox (tbox "hello" ""))
              (overlay/align "left" "center"
                             (beside (text "hello" FONT-H 'blue)
                                     CURSOR)
                             BOX))


(check-expect (draw-tbox (tbox "" ""))
              (overlay/align "left" "center"
                             CURSOR
                             BOX))


; draw : textbox? -> image?
; Create an image corresponding to the textbox.
;
(define (draw-tbox a-textbox)
  (overlay/align "left" "center"
                 (beside (text (tbox-l a-textbox) FONT-H 'blue)
                         CURSOR
                         (text (tbox-r a-textbox) FONT-H 'blue))
                 BOX))


;-----------------------------------
(require 2htdp/universe)    ; Note: usually we place any `require`s at the top of our file.

; The library function `big-bang` takes:
;    an initial object (here, an empty textbox),
;    a function to update the object on key-event (that is, a callback),
;    and a function to draw the object on request (another callback).
; It then interfaces to the OS's keyboard and draw events,
; updating its notion of the current textbox.
; NOTE that we are doing this functionally: we never re-assign to fields,
; and we CAN have unit-tests for things usually thought of as GUI-inextricable.
; This is Model-View-Controller (done particularly cleanly).
;
#;(big-bang (tbox "" "")
    [on-draw draw-tb]
    [on-key tbox-handle-key])


; Another example of using `big-bang` (unrelated to textboxes):
;
(define (draw-ball n) (overlay (circle n 'solid 'blue) (empty-scene 200 200)))
(define (grow-ball n __) (+ n 20))

#;(big-bang 20
    [on-draw draw-ball]
    [on-key grow-ball]
    [on-tick sub1])



;;;;;;;;;;;;;;;;;;;;; easter-egg textbox ;;;;;;;;;;;;;;;;;;;;;;
;;; A textbox with a "secret code"; if you type in that code then
;;; the textbox is replaced with a hidden message.
;;;
;;; >>>Pedagogical purpose: demo a struct-containing-struct,
;;; and how the template guides us to appropriate helpers.
;;;
;;; An "eegg" is a struct-containing-struct:
;;; a regular textbox, AND the secret-word AND how much of the
;;; secret-word has already been typed in so far.
;;;
(define-struct eegg (code so-far tbox))
; make-eegg : string, string, textbox -> eegg
(make-eegg "raddy" "" (tbox "" ""))
(make-eegg "raddy" "ra" (tbox "ha" "choo"))
(make-eegg "raddy" "rad" (tbox "ha" "choo"))
(make-eegg "raddy" "" (tbox "hax" "choo"))


; A "higher level" constructor, which initializes fields appropriately.
(define (create-eegg code)
  (make-eegg code "" (tbox "" "")))


; Template for eegg:
; NOTE that we have three fields, so our template will just pull out
; those three fields (one of which is a textbox),
; BUT NOT the fields-of-the-contained-textbox;
; that is overreaching the "one task, one function" principle.
; Have another function to handle a textbox; this function only
; handles the easter-egg logic.
;
(define (func-for-eegg an-ee)
  (... (eegg-code an-ee) (eegg-so-far an-ee) (eegg-tbox an-ee)))
; template DOES NOT include (tbox-l (eegg-tbox an-ee)),
; and our functions should likely not include these either.


(check-expect (heek (make-eegg "raddy" "ra" (tbox "ha" "choo")) "d")
              (make-eegg "raddy" "rad" (tbox "ha" "choo")))

(check-expect (heek (make-eegg "raddy" "ra" (tbox "ha" "choo")) "x")
              (make-eegg "raddy" "" (tbox "hax" "choo")))

(check-expect (heek (make-eegg "raddy" "radd" (tbox "ha" "choo")) "y")
              (make-eegg "raddyraddy" "" THE-EASTER-EGG))



(define THE-EASTER-EGG (tbox "whoa, " "woot!"))


; heek : eegg key-event? -> eegg
; "heek" = "handle easter-egg key-event"
;
(define (heek an-ee key)
  (cond [(string=? (eegg-code an-ee)
                   (str+ (eegg-so-far an-ee) key))
         ; The easter egg has been unlocked!
         (make-eegg (str* 2 (eegg-code an-ee)) "" THE-EASTER-EGG)]
        
        [(has-prefix? (eegg-code an-ee)
                      (str+ (eegg-so-far an-ee) key))
         ; Making progress toward easter egg
         (make-eegg (eegg-code an-ee)
                    (str+ (eegg-so-far an-ee) key)
                    (eegg-tbox an-ee))]
        
        [else ; Reset any progress, and delegate to tbox-handle-key
         (make-eegg (eegg-code an-ee)
                    ""
                    (tbox-handle-key (eegg-tbox an-ee) key))]))


#| My first version -- w/o "has-prefix?" or a renamed "str+".
   It's works, but is FAR too ugly (and rather long).

(define (heek an-ee key)
  (cond [(key=? key (substring (eegg-code an-ee)
                               (strlen (eegg-so-far an-ee))
                               (add1 (strlen (eegg-so-far an-ee)))))
         (if (= (strlen (eegg-code an-ee))
                (add1 (strlen (eegg-so-far an-ee))))
             (make-eegg (string-append (eegg-code an-ee) (eegg-code an-ee))
                        ""
                        (tbox "whoa, " "woot!"))
             (make-eegg (eegg-code an-ee)
                        (string-append (eegg-so-far an-ee)
                                       (substring (eegg-code an-ee)
                                                  (strlen (eegg-so-far an-ee))
                                                  (add1 (strlen (eegg-so-far an-ee)))))
                        (eegg-tbox an-ee)))]
        [else (make-eegg (eegg-code an-ee)
                         ""
                         (tbox-handle-key (eegg-tbox an-ee) key))]))
        |#


(define (draw-eegg an-ee)
  (draw-tbox (eegg-tbox an-ee)))

(big-bang (create-eegg "raddy")
  [on-draw draw-eegg]
  [on-key heek])







#|
@author ibarland
@version 2018-Sep-27

@license: CC-BY 4.0 -- you are free to share and adapt this file
for any purpose, provided you include appropriate attribution.
    https://creativecommons.org/licenses/by/4.0/ 
    https://creativecommons.org/licenses/by/4.0/legalcode 
Including a link to the *original* file satisifies "appropriate attribution".
|#