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-intermediate-reader.ss" "lang")((modname |22.3|) (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 #f #t none #f ((lib "draw.ss" "teachpack" "htdp") (lib "arrow.ss" "teachpack" "htdp") (lib "gui.ss" "teachpack" "htdp")))))
4 
5 (define (change-text event)
6   (draw-message main-message (text-contents main-text)))
7 (define (change-choice event)
8   (cond
9     [(= (choice-index main-choice) 0) (draw-message main-choice-message "Please make a selection")]
10     [(= (choice-index main-choice) 1) (draw-message main-choice-message "Let's shop another time")]
11     [(= (choice-index main-choice) 2) (draw-message main-choice-message "There's nothing interesting on TV")]
12     [(= (choice-index main-choice) 3) (draw-message main-choice-message "Sure, we're programming right now!")]
13     [(= (choice-index main-choice) 4) (draw-message main-choice-message "Maybe in 2 hours!")]))
14 (define (close-main-window event)
15   (hide-window main-window))
16 
17 (define main-message (make-message "Hi, nice to meet you too!"))
18 (define query (make-message "What would you like to do today?"))
19 (define main-text (make-text "Hi Aaron!"))
20 (define main-choice-message (make-message ""))
21 (define main-choice (make-choice (list "Make a selection"
22                                        "Go Shopping"
23                                        "Watch TV"
24                                        "Program Scheme"
25                                        "Sleep")))
26 (define main-window
27   (create-window
28    (list (list (make-button "Close Window" close-main-window))
29          (list (make-button "Change Text" change-text)
30                main-text main-message)
31          (list query)
32          (list main-choice
33                (make-button "Go!" change-choice))
34          (list main-choice-message))))
35   
36