Don't like ads? PRO users don't see any ads ;-)
Guest

Untitled

By: a guest on Jun 2nd, 2012  |  syntax: None  |  size: 8.65 KB  |  hits: 15  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
  1. ;; *****************************************************
  2. ;; Chat client Skeleton
  3.  
  4. (require 2htdp/image)
  5. (require 2htdp/universe)
  6.  
  7. ;; A (chat) Client is (make-client name lines editor curse-on?)
  8. ;;   where name is a String, lines is a [Listof String],
  9. ;;   and editor is a String. curse-on? is a boolean
  10. ;;   used for making the cursor blink.
  11. ;; A (chat) Client is our local World.
  12. ;;
  13. ;; Interp.
  14. ;; A chat client needs three things:
  15. ;;   - The (nick)name of the chatter
  16. ;;   - A list of previous lines in the chat
  17. ;;     (prefixed by the nick of the sender)
  18. ;;   - The current line being edited
  19. ;;   - The state of the cursor (true or false) - used for making
  20. ;;     the cursor blink
  21.  
  22. (define-struct client (name lines editor curse-on?))
  23.  
  24.  
  25. (define client-1  (make-client "chadwick"
  26.                                (list "chadwick: Hola peeps"
  27.                                      "chadwick: Lame chat party :/")
  28.                                "" false))
  29. (define client-2 (make-client "Joker" '() "Why so seri" true))
  30.  
  31.  
  32. ;; Constants for various specifics of the client GUI
  33. (define CLIENT-HEIGHT 200)
  34. (define CLIENT-WIDTH 400)
  35. (define FONT-SIZE 12)
  36. (define FONT-COLOR "black")
  37. (define LINE-SPACING 5)
  38. (define LINE-INDENT 5)
  39. (define DIVIDING-COLOR "blue")
  40. (define NICK-DIVIDER " :  ")
  41. (define CURSOR-IMG-ON (rectangle 4 (+ 4 (* 2 LINE-SPACING)) "solid" "red"))
  42. (define CURSOR-IMG-OFF (rectangle 3 (+ 4 (* 2 LINE-SPACING)) "solid" "black"))
  43.  
  44. (define CHAT-AREA
  45.   (local [(define SEP-Y (- CLIENT-HEIGHT FONT-SIZE (* 2 LINE-SPACING)))]
  46.     (scene+line (empty-scene CLIENT-WIDTH CLIENT-HEIGHT)
  47.                 0 SEP-Y CLIENT-WIDTH SEP-Y DIVIDING-COLOR)))
  48.  
  49. ;; W/2 : Image -> Number
  50. ;; Calculate the image width divided by 2
  51. (define (W/2 img)
  52.   (if (image? img)
  53.       (/ (image-width img) 2)
  54.       (error "W/2 expect an image, got: " img)))
  55.  
  56. ;; H/2 : Image -> Number
  57. ;; Calculate the image height divided by 2
  58. (define (H/2 img)
  59.   (if (image? img)
  60.       (/ (image-height img) 2)
  61.       (error "W/2 expect an image, got: " img)))
  62.  
  63. ;; chattify : String -> Image
  64. (define (chattify s)
  65.   (if (string? s)
  66.       (text s FONT-SIZE FONT-COLOR)
  67.       (error "chattify expects a string, got: " s)))
  68.  
  69. ;; render-client : Client -> Scene
  70. ;; Render the client editor and stored chat lines
  71. (define (render-client c)
  72.   (if (and (client? c) (string? (client-name c)) (string? (client-editor c))
  73.            (list? (client-lines c)) (andmap string? (client-lines c)))
  74.       (local [(define editor (chattify (string-append (client-name c)
  75.                                                       NICK-DIVIDER
  76.                                                       (client-editor c))))]
  77.         (add-chattings (client-lines c) (- CLIENT-HEIGHT (image-height editor)
  78.                                            (* LINE-SPACING 2))
  79.                        (place-image (if (client-curse-on? c) CURSOR-IMG-ON CURSOR-IMG-OFF)
  80.                                     (+ LINE-INDENT (image-width editor) 4)
  81.                                     (- CLIENT-HEIGHT (H/2 editor))
  82.                                     (place-image editor
  83.                                                  (+ LINE-INDENT (W/2 editor))
  84.                                                  (- CLIENT-HEIGHT (H/2 editor))
  85.                                                  CHAT-AREA))))
  86.       (error "render-client expects a client, got: " c)))
  87.  
  88. ;; add-chattings : [Listof String] Number Scene -> Scene
  89. ;; Add the given strings to the chat scene...
  90. (define (add-chattings los y scn)
  91.   (cond [(not (and (list? los) (andmap string? los)))
  92.          (error "add-chattings: first argument must be a list of strings, was: " los)]
  93.         [(not (number? y))
  94.          (error "add-chattings: second argument must be a number, was: " y)]
  95.         [(not (image? scn))
  96.          (error "add-chattings: third argument must be a scene, was: " scn)]
  97.         [else ; all good
  98.           (cond [(empty? los) scn]
  99.                 [else (local [(define txt (chattify (first los)))]
  100.                         (place-image txt
  101.                                      (+ LINE-INDENT (W/2 txt))
  102.                                      (- y (H/2 txt))
  103.                                      (add-chattings (rest los)
  104.                                                     (- y (image-height txt)
  105.                                                        LINE-SPACING) scn)))])]))
  106.  
  107. ;; strip-last : String -> String
  108. ;; strips the last character (if any) from a string
  109. (define (strip-last s)
  110.   (if (string? s)
  111.       (substring s 0 (max (sub1 (string-length s)) 0))
  112.       (error "strip-last expects a string, got: " s)))
  113.  
  114. (check-expect (strip-last "") "")
  115. (check-expect (strip-last "omg") "om")
  116.  
  117. ;; tick : Client -> Client
  118. ;; Blink the cursor...
  119. (define (tick c)
  120.   (if (and (client? c) (string? (client-name c)) (string? (client-editor c))
  121.            (list? (client-lines c)) (andmap string? (client-lines c)))
  122.       (make-client (client-name c)
  123.                    (client-lines c)
  124.                    (client-editor c)
  125.                    (not (client-curse-on? c)))
  126.       (error "tick expects a client, got: " c)))
  127.  
  128. ;; handle-key : Client KeyEvent -> Client
  129. ;; handles key presses for the chat client
  130. (define (handle-key c ke)
  131.   (cond [(not (and (client? c) (string? (client-name c)) (string? (client-editor c))
  132.                    (list? (client-lines c)) (andmap string? (client-lines c))))
  133.          (error "handle-key: first argument must be a client, was: " c)]
  134.         [(not (key-event? ke))
  135.          (error "handle-key: second argument must be a key-event, was: " c)]
  136.         [else ; all good
  137.           (cond
  138.             ;; ******* MODIFY HERE *********
  139.             ;; ** Local Version... comment out to run Universe...
  140.             #|[(key=? ke "\r")
  141.              (make-client (client-name c)
  142.                           (cons (string-append (client-name c)
  143.                                                NICK-DIVIDER
  144.                                                (client-editor c))
  145.                                 (client-lines c))
  146.                           "" (client-curse-on? c))]|#
  147.             ;; ******* MODIFY HERE *********
  148.             ;; ** Universe Version...
  149.             [(key=? ke "\r")
  150.              (make-package c
  151.                            (string-append (client-name c)
  152.                                           NICK-DIVIDER
  153.                                           (client-editor c)))]
  154.             [(key=? ke "\b")
  155.              (make-client (client-name c) (client-lines c)
  156.                           (strip-last (client-editor c))
  157.                           (client-curse-on? c))]
  158.             [(= (string-length ke) 1)
  159.              (make-client (client-name c) (client-lines c)
  160.                           (string-append (client-editor c) ke)
  161.                           (client-curse-on? c))]
  162.             [else c])]))
  163.  
  164. #;(check-expect (handle-key client-2 "\r")
  165.               (make-client "Joker" (list (string-append "Joker"
  166.                                                         NICK-DIVIDER
  167.                                                         "Why so seri")) "" true))
  168. (check-expect (handle-key client-2 "\b")
  169.               (make-client "Joker" (list) "Why so ser" true))
  170. (check-expect (handle-key client-1 "a")
  171.               (make-client "chadwick"
  172.                            (list "chadwick: Hola peeps"
  173.                                  "chadwick: Lame chat party :/")
  174.                            "a" false))
  175.  
  176. ;; handle-msg : Client Message -> Client
  177. ;; Handle an incoming message (String) by posting it
  178. ;; ******* MODIFY HERE *********
  179. (define (handle-msg c msg)
  180.   (make-client (client-name c)
  181.                (cons msg (client-lines c))
  182.                (client-editor c)
  183.                (client-curse-on? c)))
  184.  
  185. (check-expect (handle-msg client-2 "alice: What's up")
  186.               (make-client "Joker" (list "alice: What's up")
  187.                            "Why so seri" true))
  188. (check-expect (handle-msg client-1 "bob: Hacking")
  189.               (make-client "chadwick"
  190.                            (list "bob: Hacking"
  191.                                  "chadwick: Hola peeps"
  192.                                  "chadwick: Lame chat party :/")
  193.                            "" false))
  194.  
  195. ;; run : String -> Client
  196. ;; Runs the chat client, given a nickname
  197. (define (run nick)
  198.   (if (string? nick)
  199.       (big-bang (make-client nick (list) "" false)
  200.                 (on-draw render-client)
  201.                 (on-key handle-key)
  202.                 (on-tick tick 3/4)
  203.                 (register "dubnium.ccs.neu.edu")
  204.                 (on-receive handle-msg)
  205.                 (name nick))
  206.       (error "run expects a string, got: " nick)))
  207.  
  208. ;; ******* MODIFY HERE *********
  209. (run "br")