;; The first three lines of this file were inserted by DrScheme. They record metadata
;; about the language level of this file in a form that our tools can easily process.
#reader(lib "htdp-intermediate-reader.ss" "lang")((modname 3-3) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ())))
(require 2htdp/universe)

;; -----------------------------------------------------------------------------
;; graphical constants 
(define OPEN (text "(" 11 "black"))
(define CLOSE (text ")" 11 "black"))
(define PLS (text "+" 11 "black"))
(define MUL (text "*" 11 "black"))
(define SPC (text " " 11 "black"))
(define IN+ (rectangle 5 1 "solid" "white"))

(define-struct pls (x in?))
(define-struct mul (x in?))
;; Expr is one of:
;; -- Number
;; -- (make-pls (cons Expr 1LON) Boolean)
;; -- (make-mul (cons Expr 1LON) Boolean)
;; 1LON is one of: 
;; -- (cons Expr empty)
;; -- (cons Expr 1LON)

;; Expr -> Image 
;; render the expression as a stacked image, 
;; with 5 pixels of indentation per nested expression

(check-expect (render (make-pls (list 1 3 2) true))
              (image-stack (text "(+ 1" 11 "black")
                           (image-stack 
                            (image-append IN+ (text "3" 11 "black"))
                            (image-append IN+ (text "2)" 11 "black")))))
(check-expect (render (make-mul (list 1 3 2) true))
              (image-stack (text "(* 1" 11 "black")
                           (image-stack 
                            (image-append IN+ (text "3" 11 "black"))
                            (image-append IN+ (text "2)" 11 "black")))))

(define (render e)
  (local (;; Expr -> Image 
          ;; render expressions 
          (define (r-Expr e)
            (cond
              [(number? e) (text (number->string e) 11 "black")]
              [(pls? e) ;; do NOT abstract over recursive calls!
               (stk PLS (r-Expr (first (pls-x e))) (r-1Lon (rest (pls-x e))))]
              [(mul? e)
               (stk MUL (r-Expr (first (mul-x e))) (r-1Lon (rest (mul-x e))))]))
          ;; 1LON -> Image
          ;; render non-empty lists of numbers
          (define (r-1Lon l)
            (cond
              [(empty? (rest l)) (image-append IN+ (r-Expr (first l)))]
              [else (image-stack (image-append IN+ (r-Expr (first l)))
                                 (r-1Lon (rest l)))]))
	  ;; Image Image Image -> Image 
          ;; add parens, spaces, and stack up
          (define (stk op fst rst)
            (image-stack 
             (image-append OPEN (image-append op (image-append SPC fst)))
             (image-bottom rst CLOSE))))
    (r-Expr e)))

;; -----------------------------------------------------------------------------
;; Image Image -> Image 
;; stack images vertically along left-most line 

(check-expect (image-stack (nw:rectangle 20 10 'solid 'red)
                           (nw:rectangle 20 20 'solid 'red))
              (nw:rectangle 20 30 'solid 'red))

(define (image-stack i j)
  (overlay/xy (put-pinhole i 0 0) 0 (image-height i) j))

;; -----------------------------------------------------------------------------
;; Image Image -> Image 
;; append images horizontally along top-most line 

(check-expect (image-append (nw:rectangle 20 10 'solid 'red) 
                            (nw:rectangle 40 10 'solid 'red))
              (nw:rectangle 60 10 'solid 'red))

(define (image-append i j)
  (overlay/xy (put-pinhole i 0 0) (image-width i) 0 (put-pinhole j 0 0)))

;; -----------------------------------------------------------------------------
;; Image Image -> Image 
;; append images horizontally along top-most line 

(check-expect (image-bottom (nw:rectangle 10 20 'solid 'red) 
                            (nw:rectangle 10  5 'solid 'red))
              (overlay/xy (nw:rectangle 10 20 'solid 'red)
                          10 15
                          (nw:rectangle 10  5 'solid 'red)))

(define (image-bottom i j)
  (overlay/xy (put-pinhole i 0 0) 
              (image-width i) (abs (- (image-height i) (image-height j)))
              (put-pinhole j 0 0)))