;; Die ersten drei Zeilen dieser Datei wurden von DrScheme eingefügt. Sie enthalten Metadaten
;; über die Sprachebene dieser Datei in einer Form, die DrScheme verarbeiten kann.
#reader(lib "DMdA-assignments-reader.ss" "deinprogramm")((modname kapitel-13b) (read-case-sensitive #f) (teachpacks ()) (deinprogramm-settings #(#f write repeating-decimal #t #t none explicit #f ())))
; Kapitel 13

; Objekte mit self

; Liste von Zeichenketten in der REPL ausdrucken
(: write-list-newline ((list string) -> unspecific))
(define write-list-newline
  (lambda (lis)
    (begin
      (for-each (lambda (s)
                  (write-string s))
                lis)
      (write-newline))))

; Nachrichten sind Zeichenketten
(define message (contract string))
; Prozedur mit unbekanntem Vertrag
(define method (contract %a))

; Person konstruieren
(: make-person (string -> (message -> method)))
(define make-person
  (lambda (name)
    (let ((slaps 0))
      (letrec
          ((self
            (lambda (message)
              (cond ((equal? message "get-name")
                     ;; -> string
                     (lambda ()
                       name))
                    ((equal? message "say")
                     ;; list(string) -> unspecified
                     (lambda (stuff)
                       (write-list-newline stuff)))
                    ((equal? message "slap")
                     ;; -> unspecified
                     (lambda ()
                       (begin
                         (set! slaps (+ 1 slaps))
                         (if (< slaps 3)
                             ((self "say") (list "huh?"))
                             (begin
                               ((self "say") (list "ouch!"))
                               (set! slaps 0))))))))))
        self))))

(define george (make-person "George"))
((george "slap"))
((george "slap"))
((george "slap"))

; Nachricht an Objekt senden und entsprechende Methode aufrufen
; send : object string ... -> ...
(define send
  (lambda (object message . args)
    (apply (object message) args)))

; Sänger(in) konstruieren
; make-singer : string -> (message -> method)
(define make-singer
  (lambda (name)
    (let ((person (make-person name)))
      (letrec
          ((self
            (lambda (message)
              (cond
               ((equal? message "sing")
                ;; Text singen
                ;; list(string) -> unspecified
                (lambda (stuff)
                  (send self "say" (make-pair "tra-la-la " stuff))))
               (else
                (person message))))))
        self))))

(define claudia (make-singer "Claudia"))
(send claudia "say" (list "hello"))
(send claudia "sing" (list "hello"))

; Rock-Star konstruieren
; make-rock-star : string -> (message -> method)
(define make-rock-star
  (lambda (name)
    (let ((singer (make-singer name)))
      (letrec
          ((self
            (lambda (message)
              (cond ((equal? message "say")
                     ;; Text aufsagen
                     ;; list(string) -> unspecified
                     (lambda (stuff)
                       (send singer "say"
                             (append stuff (list ", dude")))))
                    ;; ohrfeigen
                    ;; -> unspecified
                    ((equal? message "slap")
                     (lambda ()
                       (send self "say"
                             (list "pain just makes me stronger"))))
                    (else (singer message))))))
        self))))

(define slash (make-rock-star "Slash"))
(send slash "say" (list "hello"))
(send slash "slap")
(send slash "sing" (list "oh yeah"))