1 ;; The first three lines of this file were inserted by DrScheme. They record metadata
2 ;; about the language level of this file in a form that our tools can easily process.
3 #reader(lib "htdp-advanced-reader.ss" "lang")((modname |36.4|) (read-case-sensitive #t) (teachpacks ((lib "draw.ss" "teachpack" "htdp") (lib "arrow.ss" "teachpack" "htdp") (lib "gui.ss" "teachpack" "htdp"))) (htdp-settings #(#t constructor repeating-decimal #t #t none #f ((lib "draw.ss" "teachpack" "htdp") (lib "arrow.ss" "teachpack" "htdp") (lib "gui.ss" "teachpack" "htdp")))))
4 ;;Model
5 
6 ;;State Variable
7 ;;address-book : (listof (list symbol number))
8 ;;Stores a list of list of two items (pairs) of names and numbers representing entries in an address book.
9 (define address-book empty)
10 
11 ;add-to-address-book : symbol number -> void
12 ;Effect: Adds name and phone to the address-book.  Produces no output.
13 
14 (define (add-to-address-book name phone)
15   (set! address-book (cons (list name phone) address-book)))
16 
17 ;remove : symbol -> void
18 ;Effect: Removes name from address-book.  No output returned.
19 (define (remove name)
20   (local ((define (remove-aux aname abook)
21             (cond
22               [(empty? abook) empty]
23               [(symbol=? (first (first abook)) aname) (remove-aux aname (rest abook))]
24               [else (cons (first abook)
25                           (remove-aux aname (rest abook)))])))
26     (set! address-book (remove-aux name address-book))))
27 
28 
29 
30 ;lookup-name : symbol (listof (list symbol number)) -> number or false
31 ;Output: Lookup the phone number for aname in abook.  No effect (memory neither changed nor accessed).
32 
33 (define (lookup-name aname abook)
34   (lookup-abstract aname abook first second))
35 
36 ;lookup-number : number (listof (list symbol number)) -> symbol or false
37 ;Output: Lookup the name for the entry with anumber in abook.  No effect (memory neither changed nor accessed).
38 
39 (define (lookup-number anumber abook)
40   (lookup-abstract anumber abook second first))
41 
42 ;lookup-abstract : X (listof (list symbol number)) ((listof Z) -> Z) ((listof Z) -> Z) -> Y
43 ;Output: Given anx, abook, op1, and op2, returns a number given a symbol or a symbol given a number.  X and Y are different data types.
44 ;No effect.
45 
46 (define (lookup-abstract anx abook op1 op2)
47   (cond
48     [(empty? abook) false]
49     [(equal? (op1 (first abook)) anx) (op2 (first abook))]
50     [else (lookup-abstract anx (rest abook) op1 op2)]))
51 
52 ;;View
53 
54 (define name-text (make-text "Name"))
55 (define number-text (make-text "Number"))
56 (define results-message (make-message "Delta Notch Phone Beta"))
57 
58 
59 ;;Controller
60 
61 ;add-entry-callback : event -> true
62 ;Effect: Adds the contents of name-text and number-text into the beginning of address-book.
63 (define (add-entry-callback event)
64   (void? (add-to-address-book (string->symbol (text-contents name-text)) (string->number (text-contents number-text)))))
65 
66 ;remove-name-callback : event -> true
67 ;Effect: Removes an entry from address-book associated with the text contents of name-text.
68 (define (remove-name-callback event)
69   (void? (remove (string->symbol (text-contents name-text)))))
70 
71 ;search-callback : event -> true
72 (define (search-callback event)
73   (local
74     ((define found-name
75        (lookup-number (string->number (text-contents number-text)) address-book))
76      (define found-number 
77        (lookup-name (string->symbol (text-contents name-text)) address-book)))
78     (cond
79       [(and (equal? (text-contents name-text) "")
80             (symbol? found-name))
81        (draw-message results-message (symbol->string found-name))]
82       [(number? found-number)
83        (draw-message results-message (number->string found-number))]
84       [else (draw-message results-message "Entry not found")])))
85 
86 
87 
88 (create-window (list (list name-text (make-button "Add entry" add-entry-callback))
89                      (list number-text (make-button "Search!" search-callback))
90                      (list results-message (make-button "Remove name" remove-name-callback))))
91 
92 ;Tests
93 (define (init-address-book)
94   (begin (add-to-address-book 'Aaron 525)
95          (add-to-address-book 'Geffen 3225)
96          (add-to-address-book 'Jobs 5251)
97          (add-to-address-book 'Gates 5265)
98          (add-to-address-book 'Dell 5259)
99          (remove 'Aaron)
100          address-book))
101 (init-address-book)