Simple text editor with Dr Racket

1:  (require 2htdp/image)  
2:  (require 2htdp/universe)  
3:    
4:  ;;
5:  ;;  
6:  ;;  
7:  ;;  
8:  ;; The screen looks like:  
9:  ;;   
10:  ;;   abc|def  
11:  ;;  
12:  ;; where | is the cursor.  
13:  ;;  
14:  ;; Typing a character inserts that character before the cursor.  
15:  ;; The backspace key deletes the character before the cursor.  
16:  ;; The left and right arrow keys move the cursor left and right.  
17:    
18:    
19:    
20:  ;; =================================================================================  
21:  ;; Constants:  
22:    
23:  (define WIDTH 200)  
24:  (define HEIGHT 20)  
25:    
26:  (define TEXT-SIZE 18)  
27:  (define TEXT-COLOR "BLACK")  
28:    
29:  (define CURSOR (rectangle 1 20 "solid" "red"))  
30:    
31:  (define MTS (empty-scene WIDTH HEIGHT))  
32:    
33:    
34:    
35:  ;; =================================================================================  
36:  ;; Data Definitions:  
37:    
38:  (define-struct editor (txt cp))  
39:  ;; Editor is (make-editor String Natural)  
40:  ;; interp. the current text (txt) and cursor position (cp) using a 0-based index  
41:    
42:  (define ED1 (make-editor ""    0)) ; empty  
43:  (define ED2 (make-editor "abcdef" 0)) ; cursor at beginning as in |abcdef  
44:  (define ED3 (make-editor "abcdef" 3)) ; cursor in middle of text as in abc|def  
45:  (define ED4 (make-editor "abcdef" 6)) ; cursor at end as in abcdef|  
46:    
47:  #;  
48:  (define (fn-for-editor e)  
49:   (... (editor-txt e)  
50:      (editor-cp e)))  
51:    
52:  ;; =================================================================================  
53:  ;; Functions:  
54:    
55:  ;; Editor -> Editor  
56:  ;; start the world with an initial state e, for example (main (make-editor "" 0))  
57:  (define (main e)  
58:   (big-bang e  
59:        (to-draw  render)         ; Editor -> Image  
60:        (on-key   handle-key)))      ; Editor KeyEvent -> Editor  
61:    
62:    
63:    
64:  ;; Editor -> Image  
65:  ;; place text with cursor at left, middle edge of MTS  
66:  (check-expect (render (make-editor "abcdef" 3))  
67:         (overlay/align "left"  
68:                 "middle"  
69:                 (beside (text "abc" TEXT-SIZE TEXT-COLOR)  
70:                     CURSOR  
71:                     (text "def" TEXT-SIZE TEXT-COLOR))  
72:                 MTS))  
73:    
74:  ;(define (render e) MTS) ;stub  
75:    
76:  (define (render e)  
77:   (overlay/align "left"  
78:           "middle"  
79:           (beside (text (substring (editor-txt e) 0 (editor-cp e)) TEXT-SIZE TEXT-COLOR)  
80:               CURSOR  
81:               (text (substring (editor-txt e) (editor-cp e) (string-length (editor-txt e))) TEXT-SIZE TEXT-COLOR))  
82:           MTS))  
83:    
84:    
85:    
86:  ;; Editor KeyEvent -> Editor  
87:  ;; call appropriate function for each keyboard command  
88:    
89:    
90:  ;(define (handle-key e key) e) ;stub  
91:  (check-expect (curs-left ED1) ED1)  
92:  (check-expect (curs-left ED2) ED2)  
93:  (check-expect (curs-left ED3) (make-editor "abcdef" 2))  
94:  (check-expect (curs-left ED4) (make-editor "abcdef" 5))  
95:    
96:  (define (handle-key e key)  
97:   (cond [(key=? key "left")    (curs-left e)]  
98:      [(key=? key "right")    (curs-right e)]  
99:      [(key=? key "\b")     (take-out e)]      
100:      [(= (string-length key) 1) (write e key)]  
101:      [else (make-editor (editor-txt e) (editor-cp e))]))  
102:    
103:  ; Note:   
104:  ; "left" is the left arrow key, "right" is the right arrow key, and   
105:  ; "\b" is the backspace key.  
106:    
107:    
108:  ;; Editor -> Editor  
109:  ;; consumes editor and returns editor with cursor position decreased by one  
110:  (check-expect (curs-left ED1) ED1)  
111:  (check-expect (curs-left ED2) ED2)  
112:  (check-expect (curs-left ED3) (make-editor "abcdef" 2))  
113:  (check-expect (curs-left ED4) (make-editor "abcdef" 5))  
114:    
115:  (define (curs-left e)  
116:   (if (> (editor-cp e) 0)  
117:     (make-editor (editor-txt e) (- (editor-cp e) 1))  
118:     (make-editor (editor-txt e) (editor-cp e))))  
119:  ;; Editor -> Editor  
120:  ;; consumes editor and returns editor with cursor position increased by one  
121:  (check-expect (curs-right ED1) (make-editor "" 0))  
122:  (check-expect (curs-right ED2) (make-editor "abcdef" 1))  
123:  (check-expect (curs-right ED3) (make-editor "abcdef" 4))  
124:  (check-expect (curs-right ED4) (make-editor "abcdef" 6))  
125:    
126:  (define (curs-right e)  
127:   (if (< (editor-cp e) (string-length (editor-txt e)))  
128:       (make-editor (editor-txt e) (+ (editor-cp e) 1))  
129:       (make-editor (editor-txt e) (editor-cp e))))  
130:    
131:  ;; Editor -> Editor  
132:  ;; deletes one character from the editor, leaving cursor in place of deleted character  
133:  (check-expect (take-out ED1) ED1)  
134:  (check-expect (take-out ED2) ED2)  
135:  (check-expect (take-out ED3) (make-editor "abdef" 2))  
136:  (check-expect (take-out ED4) (make-editor "abcde" 5))  
137:    
138:  (define (take-out e)  
139:   (make-editor (string-append (substring (editor-txt e) 0 (editor-cp (curs-left e)))   
140:                 (substring (editor-txt e) (editor-cp e))) (editor-cp (curs-left e))))  
141:  ;; Editor String -> Editor  
142:  ;; inserts characters corresponding to keys on keyboard into   
143:  ;; the editor and cursor position  
144:  (check-expect (write ED3 "what?") (make-editor "abcwhat?def" 4))  
145:    
146:  (define (write e s)  
147:   (make-editor (string-append (substring (editor-txt e)   
148:                          0 (editor-cp e))   
149:                          s (substring (editor-txt e) (editor-cp e)   
150:                          (string-length (editor-txt e))))   
151:                          (+ (editor-cp e) 1)))  
152:    
153:  (main (make-editor "abcdef" 3))  
154:    
155: