;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Sierp Types

;; A Sierp is a self-similar struture that is either 
;; -- SierpBase 
;; -- list-of-Sierp

;; The base-case Sierpinski structure that has
;; has 3 posns in clockwise order from the top:
;; top, lower right, lower left
(define-struct SierpBase (top lr ll))

;; A list-of-Sierp is a list and is either
;; -- empty
;; -- (cons Sierp list-of-Sierp)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Functions for creating Sierpinski gaskets.

;; Makes an equilateral triangle with a base of width.
;; This is a base case Sierpinski gasket
(define (make-FullSizeSierp width)
  (local 
      [(define width_2 (/ width 2))
       (define root3 (sqrt 3))]
  (make-SierpBase (make-posn width_2 0) 
                  (make-posn 0 (* width_2 root3)) 
                  (make-posn width (* width_2 root3)))))

;; getMidPt: posn posn --> posn
;; Returns the mid-point between two posns.
(define (getMidPt p1 p2)
  (make-posn (/ (+ (posn-x p1) (posn-x p2)) 2) 
             (/ (+ (posn-y p1) (posn-y p2)) 2)))

;; make-nextSierp:  SierpBase --> list-of-Sierp
;; Takes a SierpBase and returns a list-of-Sierp filled with 3 SierpBases
;; where the SierpBases are formed from the vertices of the input
;; SierpBase and the mid-points of its sides.
;; The 3 SierpBases are in clockwise order from the top of the input SierpBase.
(define (make-nextSierp sierpBase)
  (local
      [(define midTopLr (getMidPt (SierpBase-top sierpBase)
                                  (SierpBase-lr sierpBase)))
       (define midLrLl  (getMidPt (SierpBase-lr sierpBase)
                                  (SierpBase-ll sierpBase)))
       (define midLlTop (getMidPt (SierpBase-ll sierpBase)
                                  (SierpBase-top sierpBase)))]
    (list (make-SierpBase (SierpBase-top sierpBase) midTopLr midLlTop)
          (make-SierpBase midTopLr (SierpBase-lr sierpBase) midLrLl)     
          (make-SierpBase midLlTop midLrLl (SierpBase-ll sierpBase)))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Sierp Visitor Framework

;; A visitor to a Sierp
;;    fBase:   SierpBase any1 --> any2
;;    fInduct: list-of-Sierp any1 --> any2
(define-struct SierpVisitor (fBase fInduct))

;; sierpExecute:  Sierp SierpVisitor any1 --> any2
;; Accepts the SierpVisitor on the Fractal,
;; calling the appropriate case of the visitor.
(define (sierpExecute sierp sVisitor param)
  (cond
    [(SierpBase? sierp) ((SierpVisitor-fBase sVisitor) sierp param)]
    [(list? sierp)      ((SierpVisitor-fInduct sVisitor) sierp param)]))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; NatNum Visitor Framework
;; Not used in this file, but provided as an example.

;; Visitor to a natural number
;; fBase:   NatNum any1 --> any2
;; fInduct: NatNum any1 --> any2
(define-struct NVisitor (fZero fNZ))

;; Accepts a visitor to a natural number.
(define (nExecute n nVisitor param)
  (cond
    [(zero? n)     ((NVisitor-fZero nVisitor) n param)]
    [(positive? n) ((NVisitor-fNZ nVisitor) n param)]))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Sierpinski drawing

;; draw-sierpBase:  SierpBase --> boolean
;; Draws a SierpBase on the output canvas.
(define (draw-sierpBase sierpBase)
  (and (draw-solid-line (SierpBase-top sierpBase) 
                        (SierpBase-lr sierpBase))
       (draw-solid-line (SierpBase-lr sierpBase)
                        (SierpBase-ll sierpBase))
       (draw-solid-line (SierpBase-ll sierpBase) 
                        (SierpBase-top sierpBase))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Sierpinski growing and drawing
;; Growing and drawing are separated for this example.
;; Uses Sierp visitors.

;; Visitor to draw a Sierpinski gasket.
(define drawSierpVisitor
  (make-SierpVisitor
   
   ;; Draws the host base case Sierpinski gasket.
   ;; SierpBase any --> boolean
   (lambda (baseHost param)
     (draw-sierpBase baseHost))
   
   ;; Draws the host inductive case Sierpinski gasket.
   ;; list-of-Sierp any --> boolean
   (lambda (inductHost param)
     (map (lambda (s)
            (sierpExecute s drawSierpVisitor param))
          inductHost))))

;; Visitor to grow a Sierpinski gasket.
(define growSierpVisitor
   (make-SierpVisitor
    
    ;; Grows the host base case Sierpinski gasket.
    ;; SierpBase any --> Sierp
    (lambda (baseHost param)
      (make-nextSierp baseHost))
    
    ;; Grows the host inductive case Sierpinski gasket.
    ;; list-of-Sierp any --> Sierp
    (lambda (inductHost param)
      (map (lambda (s)
             (sierpExecute s nextSierpVisitor param))
           inductHost))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
"Sierp test cases:"
(define width 500)

(define s1 (make-FullSizeSierp width))
(define s2 (sierpExecute s1 growSierpVisitor null))
(define s3 (sierpExecute s2 growSierpVisitor null))
(define s4 (sierpExecute s3 growSierpVisitor null))


(start width width)

;;(draw-sierpBase s1)

;;(map draw-sierpBase s2)

;;(sierpExecute s1 drawSierpVisitor null) 
;;(sierpExecute s2 drawSierpVisitor null) 


;;(sierpExecute s1 growSierpVisitor null)
;;(sierpExecute s2 growSierpVisitor null)

(sierpExecute s4 drawSierpVisitor null)