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

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

;; The base-case Sierpinski structure is a FractalBase
;; 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)



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

;; 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)]))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Sierp Factory Framework

;; A factory to make a Sierp, which has a 
;; base case function and an inductive case function.
;; The base case takes a full width and returns a base case fractal
;;    fBase:    width --> Sierp
;; The inductive function takes a SierpBase and returns a list of SierpBases
;;    finduct:  SierpBase --> list-of-Sierp
(define-struct SierpFactory (fBase fInduct))


;; Sierp Factory -- an example

;; 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 in 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)))))

;; A Sierpinski gasket fractal factory
(define sFac (make-SierpFactory make-FullSizeSierp make-nextSierp))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; NatNum Visitor Framework

;; 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 growing-and-drawing
;; Growing and drawing are combined for this example, partly
;; for brevity, partly since the main reason to grow a gasket
;; is to draw it.
;; Uses NatNum visitor, Sierp factory.

;; 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))))

;; make-drawNSierp: SierpFactory --> NVisitor
;; Given a factory for how to make a Sierpinski gasket,
;; returns a visitor which will, given n, draw a n-level gasket.
(define (make-DrawNSierp sierpFac)
  (local 
      [(define nDrawSierp
         (make-NVisitor
          
          ;; Draw the given base case Sierpinski gasket.
          ;; NatNum Sierp --> bool
          (lambda (n sierp)
            (draw-sierpBase sierp))
          
          ;; Draw the given inductive case Sierpinski gasket.
          ;; NatNum Sierp --> bool
          (lambda (n sierp)
            (andmap (lambda (s)
                      (nExecute (sub1 n) nDrawSierp s)) 
                    ((SierpFactory-fInduct sierpFac) sierp)))))]
    
    nDrawSierp))

;; draw-Sierpinski: SierpFactory NatNum Num --> boolean
;; Given a factory for how to make a Sierpinski gasket,
;; creates, draws, and throws away a gasket.
;; The gaskets has the given number of levels and the given width.
(define (draw-Sierpinski sierpFac levels width)
  (nExecute levels
            (make-DrawNSierp sierpFac)
            ((SierpFactory-fBase sierpFac) width)))


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

(define s1 (make-FullSizeSierp width))
(define s1_next (make-nextSierp s1))


(start width width)
;;(draw-sierp s1)
;;(map draw-sierp s1_next)

;;(draw-gasket s1 sFac 5)


;;(nExecute 5 (make-DrawNSierp sFac) s1)

(define result (draw-Sierpinski sFac 6 width))