;; Kathi Fisler
;; Powerpoint exercise
;; Stage 4 : macro front-end
;; February 2, 2003

;;;;;;;;;;;;;;; THE INTERFACE LANGUAGE ;;;;;;;;;;;;;;;;;;;;;;;

;; print-string : string -> void
;; prints string and a newline to the screen
(define (print-string str)
  (printf "~a~n" str))

;; print-newline : -> void
;; prints a newline on the screen
(define (print-newline) (printf "~n"))

;; print-unnumbered-strings : list[string] -> void
;; prints a list of strings to the screen, each prefixed with a -
(define (print-unnumbered-strings strlist)
  (for-each (lambda (str) (printf "- ~a~n" str)) strlist))

;; print-numbered-strings : list[string] -> void
;; prints a list of strings to the screen, each prefixed with
;;   a number (in consecutive increasing order)
(define (print-numbered-strings strlist label)
  (cond [(empty? strlist) void]
        [(cons? strlist) 
         (begin
           (printf "~a. ~a~n" label (first strlist))
           (print-numbered-strings (rest strlist) (+ 1 label)))]))

;; await-click : -> void
;; mimics a mouse click by waiting for the user to type a character
(define (await-click) (read))

;;;;;;;;;; INTERFACE HELPERS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; print-slide-title : string -> void
;; displays title of slide on screen
(define (print-slide-title title-str)
  (print-string (string-append "Title: " title-str))
  (print-newline))
  
;; print-slide-body : slide-body -> void
;; displays contents of body on screen
(define (print-slide-body body)
  (cond [(string? body) (print-string body)]
        [(pointlist? body) 
         (cond [(pointlist-numbered? body) 
                (print-numbered-strings (pointlist-points body) 1)]
               [else (print-unnumbered-strings (pointlist-points body))])]))

;; print-slide : slide -> void
;; displays contents of slide on screen
(define (print-slide aslide)
  (begin
    (print-string "------------------------------")    
    (print-slide-title (slide-title aslide))
    (print-slide-body (slide-body aslide))
    (print-string "------------------------------")))

;; end-show : -> void
;; displays end of show message on screen
(define (end-show) (print-string "End of show"))

;;;;;;;;;;;; THE DATA ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; a slide is a (make-slide string slide-body)
(define-struct slide (title body))

;; a slide-body is either
;;  - a string (paragraph), or
;;  - a (make-pointlist list[string] boolean)
(define-struct pointlist (points numbered?))

;; A cmd is 
;; - (make-display (-> slide))
;; - (make-timecond (time->boolean) section section)

(define-struct display (slide))
(define-struct timecond (time-limit within-time over-time))

;; A talk is a list of sections
(define-struct talk (sects))

;; A section is a list of commands
(define-struct section (cmds))

;;;;;;;;;;;;;;; LANGUAGE HELPERS ;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; pointlist-numbered : list[string] -> pointlist
;; create numbered pointlist with given points
(define (pointlist-numbered points)
  (make-pointlist points true))

;; pointlist-bulleted : list[string] -> pointlist
;; create non-numbered pointlist with given points
(define (pointlist-bulleted points)
  (make-pointlist points false))

;; disp-slide : slide -> display
;; gives another name for make-display for readability
(define disp-slide make-display)

;;;;;;;;;;;;;;;; MACROS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; macro to wrap lambda around a slide specification
(define-syntax myslide
  (syntax-rules ()
    [(myslide title body)
     (lambda ()
       (make-slide title body))]))

;; macro to wrap list and section structure around a sequence of commands
(define-syntax mytalk
  (syntax-rules ()
    [(mytalk cmd1 ...)
     (make-talk 
      (list 
       (make-section 
        (list cmd1 ...))))]))

;; macro to move slide specifications into talk
(define-syntax talk-with-slides
  (syntax-rules ()
    [(talk-with-slides ((slide name1 title1 body1) 
              ...)
             cmd1 ...)
     (let ([name1 (myslide title1 body1)] 
           ...)
       (mytalk cmd1 ...))]))

;; macro to simplify specification of timeconds
;; note this has two cases: you can leave the second list off in
;;   the program and the macro will insert the empty section
(define-syntax time-branch
  (syntax-rules ()
    [(time-branch test cmdlist)
     (make-timecond test (make-section cmdlist) (make-section empty))]
    [(time-branch test cmdlist1 cmdlist2)
     (make-timecond test (make-section cmdlist1) (make-section cmdlist2))]))


;;;;;;;;;;;;;;;; INTERPRETER ;;;;;;;;;;;;;;;;;;;;;;;;;;
                                  
(define start-time 0)
(define example-index 0)

;; elapsed-time : -> number
;; returns the elapsed seconds since the recorded start time
(define (elapsed-time) 
  (- (current-seconds) start-time))

;; make-next-example-title : -> string
;; creates string from "Example" and the current example index
;; EFFECTS: increments example-index
(define (make-next-example-title)
  (begin
    (set! example-index (+ 1 example-index))
    (format "Example ~a" example-index)))

;; run-cmd : cmd -> void
;; executes the given command
(define (run-cmd cmd)
  (cond [(display? cmd) 
         (begin (print-slide ((display-slide cmd)))
                (await-click))]
        [(timecond? cmd) 
         (cond [((timecond-time-limit cmd) (elapsed-time))
                (run-section (timecond-within-time cmd))]
               [else (run-section (timecond-over-time cmd))])]))

;; run-cmdlist : list[cmd] -> void
;; executes every command in a list
(define (run-cmdlist cmd-lst)
  (cond [(empty? cmd-lst) void]
        [(cons? cmd-lst)
         (begin 
           (run-cmd (first cmd-lst)))
           (run-cmdlist (rest cmd-lst))]))

;; run-sections : list[section] -> void
;; executes all the commands in the given section list
(define (run-sections sect-lst)
  (cond [(empty? sect-lst) void]
        [(cons? sect-lst)
         (begin 
           (run-section (first sect-lst))
           (run-sections (rest sect-lst)))]))

;; run-section : section -> void
;; executes all the commands in the given section
(define (run-section asect)
  (run-cmdlist (section-cmds asect)))

;; run-talk : talk -> void
;; executes the commands in a talk then displays end-of-show message
(define (run-talk a-talk)
  (begin
    (set! example-index 0)
    (set! start-time (current-seconds))
    (run-sections (talk-sects a-talk))
    (end-show)))

;;;;;;;;;;;;;;;;;;;;;;;; THE TALKS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; talk1 : uses new pointlist helpers
(define talk1
  (let ([make-intro-slide
         (lambda ()
           (make-slide 
            "Hand Evals in DrScheme"
            "Hand evaluation helps you learn how Scheme reduces programs to values"))]
        [make-arith-eg-slide
         (lambda ()
	   (make-slide 
	    (make-next-example-title)
	    (pointlist-bulleted (list "(+ (* 2 3) 6)" "(+ 6 6)" "12"))))]
        [make-func-eg-slide
         (lambda ()
	   (make-slide 
	    (make-next-example-title)
	    (pointlist-bulleted (list "(define (foo x) (+ x 3))" "(* (foo 5) 4)" 
                                      "(* (+ 5 3) 4)" "(* 8 4)" "32"))))]
        [make-summary-slide
         (lambda ()
           (make-slide
            "Summary: How to Hand Eval"
            (pointlist-numbered (list "Find the innermost expression"
                                  "Evaluate one step"
                                  "Repeat until have a value"))))])
    (make-talk
     (list
      (make-section
       (list (make-display make-intro-slide) 
             (make-timecond (lambda (time-in-talk) (> 5 time-in-talk))
                            (make-section (list (make-display make-arith-eg-slide)))
                            (make-section empty))
             (make-display make-func-eg-slide) 
             (make-display make-summary-slide)))))))

;; talk2 : uses pointlist helpers and myslide macro
(define talk2
  (let ([make-intro-slide
         (myslide 
          "Hand Evals in DrScheme"
          "Hand evaluation helps you learn how Scheme reduces programs to values")]
        [make-arith-eg-slide
         (myslide 
          (make-next-example-title)
          (pointlist-bulleted (list "(+ (* 2 3) 6)" "(+ 6 6)" "12")))]
        [make-func-eg-slide
         (myslide 
          (make-next-example-title)
          (pointlist-bulleted (list "(define (foo x) (+ x 3))" "(* (foo 5) 4)" 
                                    "(* (+ 5 3) 4)" "(* 8 4)" "32")))]
        [make-summary-slide
         (myslide
          "Summary: How to Hand Eval"
          (pointlist-numbered (list "Find the innermost expression"
                                    "Evaluate one step"
                                    "Repeat until have a value")))])
    (make-talk
     (list
      (make-section
       (list (make-display make-intro-slide) 
             (make-timecond (lambda (time-in-talk) (> 5 time-in-talk))
                            (make-section (list (make-display make-arith-eg-slide)))
                            (make-section empty))
             (make-display make-func-eg-slide) 
             (make-display make-summary-slide)))))))

;; talk3 : uses pointlist helpers, myslide macro, and mytalk macro
(define talk3
  (let ([make-intro-slide
         (myslide 
          "Hand Evals in DrScheme"
          "Hand evaluation helps you learn how Scheme reduces programs to values")]
        [make-arith-eg-slide
         (myslide 
          (make-next-example-title)
          (pointlist-bulleted (list "(+ (* 2 3) 6)" "(+ 6 6)" "12")))]
        [make-func-eg-slide
         (myslide 
          (make-next-example-title)
          (pointlist-bulleted (list "(define (foo x) (+ x 3))" "(* (foo 5) 4)" 
                                    "(* (+ 5 3) 4)" "(* 8 4)" "32")))]
        [make-summary-slide
         (myslide
          "Summary: How to Hand Eval"
          (pointlist-numbered (list "Find the innermost expression"
                                    "Evaluate one step"
                                    "Repeat until have a value")))])
    (mytalk (make-display make-intro-slide) 
            (make-timecond (lambda (time-in-talk) (> 5 time-in-talk))
                           (make-section (list (make-display make-arith-eg-slide)))
                           (make-section empty))
            (make-display make-func-eg-slide) 
            (make-display make-summary-slide))))

;; talk4 : uses talk-with-slides macro
(define talk4
  (talk-with-slides 
   ((slide intro-slide
           "Hand Evals in DrScheme"
           "Hand evaluation helps you learn how Scheme reduces programs to values")
    (slide arith-eg-slide
           (make-next-example-title)
           (pointlist-bulleted (list "(+ (* 2 3) 6)" "(+ 6 6)" "12")))
    (slide func-eg-slide
           (make-next-example-title)
           (pointlist-bulleted (list "(define (foo x) (+ x 3))" "(* (foo 5) 4)" 
                                     "(* (+ 5 3) 4)" "(* 8 4)" "32")))
    (slide summary-slide
           "Summary: How to Hand Eval"
           (pointlist-numbered (list "Find the innermost expression"
                                     "Evaluate one step"
                                     "Repeat until have a value"))))
   (make-display intro-slide) 
   (make-timecond (lambda (time-in-talk) (> 5 time-in-talk))
                  (make-section (list (make-display arith-eg-slide)))
                  (make-section empty))
   (make-display func-eg-slide) 
   (make-display summary-slide)))

;; talk5 : clean-up command names and the timecond syntax
(define talk5
  (talk-with-slides 
   ((slide intro-slide
           "Hand Evals in DrScheme"
           "Hand evaluation helps you learn how Scheme reduces programs to values")
    (slide arith-eg-slide
           (make-next-example-title)
           (pointlist-bulleted (list "(+ (* 2 3) 6)" "(+ 6 6)" "12")))
    (slide func-eg-slide
           (make-next-example-title)
           (pointlist-bulleted (list "(define (foo x) (+ x 3))" "(* (foo 5) 4)" 
                                     "(* (+ 5 3) 4)" "(* 8 4)" "32")))
    (slide summary-slide
           "Summary: How to Hand Eval"
           (pointlist-numbered (list "Find the innermost expression"
                                     "Evaluate one step"
                                     "Repeat until have a value"))))
   (disp-slide intro-slide) 
   (time-branch (lambda (time-in-talk) (> 5 time-in-talk))
                (list (disp-slide arith-eg-slide)))
   (disp-slide func-eg-slide) 
   (disp-slide summary-slide)))