;; 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-v2) (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)) ; 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 (string-length s)) (clamp 0 b (string-length 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" 2 4) "ll") (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 (string-length s)) +inf.0)) (define (str-drop-last s) (substr/safe s 0 (sub1 (string-length 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") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; 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 "" "")) ; template: ; func-for-textbox : textbox -> ??? ; (define (func-for-textbox a-box) (... (textbox-l a-box) ... (textbox-r a-box) ...)) ;=========== (check-expect (handle-key (make-textbox "hello" "") "right") (make-textbox "hello" "")) (check-expect (handle-key (make-textbox "" "hello") "left") (make-textbox "" "hello")) (check-expect (handle-key (make-textbox "" "hello") "\b") (make-textbox "" "hello")) (check-expect (handle-key (make-textbox "hel" "lo") "z") (make-textbox "helz" "lo")) (check-expect (handle-key (make-textbox "hel" "lo") "right") (make-textbox "hell" "o")) (check-expect (handle-key (make-textbox "hel" "lo") "left") (make-textbox "he" "llo")) (check-expect (handle-key (make-textbox "hel" "lo") "\b") (make-textbox "he" "lo")) (check-expect (handle-key EMPTY-TEXTBOX "z") (make-textbox "z" "")) (check-expect (handle-key EMPTY-TEXTBOX "left") EMPTY-TEXTBOX) (check-expect (handle-key EMPTY-TEXTBOX "right") EMPTY-TEXTBOX) (check-expect (handle-key EMPTY-TEXTBOX "\b") EMPTY-TEXTBOX) ; handle-key : textbox?, key-event? -> textbox? ; Update `a-textbox` to incorporate `key`. ; (define (handle-key a-tb key) (cond [(key=? key "right") (make-textbox (string-append (textbox-l a-tb) (substr/safe (textbox-r a-tb) 0 1)) (substr/safe (textbox-r a-tb) 1 +inf.0))] [(key=? key "left") (make-textbox (str-drop-last (textbox-l a-tb)) (string-append (str-last (textbox-l a-tb)) (textbox-r a-tb)))] [(key=? key "\b") (make-textbox (str-drop-last (textbox-l a-tb)) (textbox-r a-tb))] [(> (string-length key) 1) a-tb] [else (make-textbox (string-append (textbox-l a-tb) key) (textbox-r a-tb))])) (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 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. (check-expect (draw (make-textbox "hel" "lo")) (overlay/align "left" "center" (beside (text (substring "hello" 0 3) FONT-H 'blue) (rectangle 1 CURSOR-H 'solid 'orange) (text "lo" FONT-H 'blue)) (rectangle BOX-W BOX-H 'outline 'green))) (check-expect (draw (make-textbox "" "hello")) (overlay/align "left" "center" (beside (rectangle 1 CURSOR-H 'solid 'orange) (text "hello" FONT-H 'blue)) (rectangle BOX-W BOX-H 'outline 'green))) (check-expect (draw (make-textbox "hello" "")) (overlay/align "left" "center" (beside (text "hello" FONT-H 'blue) (rectangle 1 CURSOR-H 'solid 'orange)) (rectangle BOX-W BOX-H 'outline 'green))) (check-expect (draw (make-textbox "" "")) (overlay/align "left" "center" (rectangle 1 CURSOR-H 'solid 'orange) (rectangle BOX-W BOX-H 'outline 'green))) ; draw : textbox? -> image? ; Create an image corresponding to the textbox. ; (define (draw a-textbox) (overlay/align "left" "center" (beside (text (textbox-l a-textbox) FONT-H 'blue) (rectangle 1 CURSOR-H 'solid 'orange) (text (textbox-r a-textbox) FONT-H 'blue)) (rectangle BOX-W BOX-H 'outline 'green))) ;----------------------------------- (require 2htdp/universe) ; Note: usually we place any `require`s at the top of our file. (big-bang (make-textbox "" "") [on-draw draw] [on-key handle-key]) #| @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". |#