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 39.1.6) (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 ;;make-address-book : string -> address-book
6 ;;An address-book is an interface
7 ;;1. 'add :: symbol number -> void
8 ;;2. 'remove :: symbol -> void
9 ;;3. 'lookup-name :: symbol -> number or false
10 ;;4. 'lookup-number :: number -> symbol or false
12 (define-struct entry (name number))
14 ;;An entry is a structure
16 ;;where na is a symbol, nu is a number.
18 (define (make-address-book title)
22 ;;address-book : (listof entry)
23 ;;Represents the entries in a physical address book
24 (define address-book empty)
26 ;;add-to-address-book : symbol number -> void
27 ;;Effect: Adds name and phone to the address-book. Produces no output.
28 (define (add-to-address-book name phone)
29 (set! address-book (cons (make-entry name phone) address-book)))
31 ;;remove : symbol -> void
32 ;;Effect: Removes name from address-book. No output returned.
35 (filter (lambda (anentry) (not (equal? name (entry-name anentry))))
38 ;;lookup-name : symbol (listof (list symbol number)) -> number or false
39 ;;Output: Lookup the phone number for aname in abook.
40 ;;No effect (memory neither changed nor accessed).
41 (define (lookup-name aname abook)
42 (lookup-abstract aname abook entry-name entry-number))
44 ;;lookup-number : number (listof (list symbol number)) -> symbol or false
45 ;;Output: Lookup the name for the entry with anumber in abook.
46 ;;No effect (memory neither changed nor accessed).
47 (define (lookup-number anumber abook)
48 (lookup-abstract anumber abook entry-number entry-name))
51 ;;X (listof (list symbol number)) ((listof Z) -> Z) ((listof Z) -> Z) -> Y
52 ;;Output: Given anx, abook, op1, and op2, returns a number
53 ;;given a symbol or a symbol given a number. X and Y are different data types.
56 (define (lookup-abstract anx abook op1 op2)
58 [(empty? abook) false]
59 [(equal? (op1 (first abook)) anx) (op2 (first abook))]
60 [else (lookup-abstract anx (rest abook) op1 op2)]))
62 (define (service-manager msg)
64 [(symbol=? msg 'add) add-to-address-book]
65 [(symbol=? msg 'remove) remove]
66 [(symbol=? msg 'lookup-name)
67 (lambda (aname) (lookup-name aname address-book))]
68 [(symbol=? msg 'lookup-number)
69 (lambda (anumber) (lookup-number anumber address-book))])))
73 ;;gui-for-address-book : (listof strings) -> true
74 ;;Consumes alos. Outputs true.
76 ;;1. Creates a new address book (define a new interface for each string?) for each one.
77 ;;2. Creates a GUI for the address books.
79 (define (gui-for-address-book alos)
82 (build-list (length alos)
83 (lambda (i) (make-address-book (list-ref alos i)))))
84 (define greeting-msg (make-message "Delta Notch - People Finder Pro Deluxe (TM)"))
85 (define book-msg (make-message "Select address book: "))
86 (define book-choice (make-choice alos))
87 (define input-name (make-text "Name: "))
88 (define input-number (make-text "Number: "))
89 (define results-msg (make-message ""))
92 (define (add-callback event)
93 (local ((define address-book-interface
94 (list-ref book-list (choice-index book-choice)))
95 (define aname-sym (string->symbol (text-contents input-name)))
96 (define anumber-num (string->number (text-contents input-number))))
97 (begin ((address-book-interface 'add) aname-sym anumber-num)
98 (draw-message results-msg
99 (string-append "Added: "
100 (symbol->string aname-sym)
102 (number->string anumber-num))))))
103 (define (remove-callback event)
104 (local ((define address-book-interface
105 (list-ref book-list (choice-index book-choice)))
106 (define aname-sym (string->symbol (text-contents input-name)))
107 (define anumber-num (string->number (text-contents input-number))))
108 (begin ((address-book-interface 'remove) aname-sym)
109 (draw-message results-msg
110 (string-append "Removed: "
111 (symbol->string aname-sym)
113 (number->string anumber-num))))))
114 (define (lookup-callback event)
115 (local ((define address-book-interface
116 (list-ref book-list (choice-index book-choice)))
117 (define aname (text-contents input-name))
118 (define anumber (text-contents input-number))
119 (define aname-sym (string->symbol aname))
120 (define anumber-num (string->number anumber))
122 ((address-book-interface 'lookup-number) anumber-num))
123 (define return-number
124 ((address-book-interface 'lookup-name) aname-sym)))
126 [(and (not (equal? aname ""))
127 (number? return-number))
128 (draw-message results-msg (number->string return-number))]
129 [(and (not (equal? anumber ""))
130 (symbol? return-name))
131 (draw-message results-msg (symbol->string return-name))]
132 [(and (not (equal? aname ""))
133 (boolean? return-name))
134 (draw-message results-msg "Name not found")]
135 [(and (not (equal? anumber ""))
136 (boolean? return-number))
137 (draw-message results-msg "Number not found")]
138 [else (draw-message results-msg "Please enter a name or number")])))
139 (define add-button (make-button "Add Entry" add-callback))
140 (define remove-button (make-button "Remove Entry" remove-callback))
141 (define lookup-button (make-button "Lookup" lookup-callback)))
142 (create-window (list (list greeting-msg)
143 (list book-msg book-choice)
144 (list input-name add-button)
145 (list input-number remove-button)
146 (list results-msg lookup-button)))))
150 (gui-for-address-book '("Hsinya's Book" "Aaron's Book" "Anonymous Book"))
