;;
;; Rule Delegates
;;

;(define empty? null?)

(define no-rules%
  {class
   object%
   (init)
   (super-new)

   (define/public (get-name)
     "Master's Garden")

   (define/public (can-place-on-flower-bed? flower flower-bed)
     (warning "no-rules%: can-place-on-flower-bed?: no rules in effect")
     #t)

   (define/public (can-place-on-foundation? flower foundation)
     (warning "no-rules%: can-place-on-foundation?: no rules in effect")
     #t)

   (define/public (can-place-on-bucket? flower bucket)
     (warning "no-rules%: can-place-on-bucket?: flowers: "
              (send bucket number-of-cards)
              " (no rules in effect)")
     #t)

})

(define rules-hard%
  {class
   no-rules%
   (init)
   (super-new)

   (define/override (get-name)
     "Flower Garden")

   (define/override (can-place-on-flower-bed? flower flower-bed)
      (let ((stacked (send flower-bed get-cards)))
        [or (empty? stacked)
            (and (card-one-rank-below? flower (wheels stacked)) )] ))

   (define/override (can-place-on-foundation? flower foundation)
      (let ((stacked (send foundation get-cards)))
        [or (and (empty? stacked)
                 (card-is-ace? flower))
            (and (not (empty? stacked))
                 (card-same-suit? flower (wheels stacked))
                 (card-one-rank-above? flower (wheels stacked)))]))

   (define/override (can-place-on-bucket? flower bucket)
      #f)
})

(define rules-moon%
  {class
   rules-hard%
   (init)
   (super-new)

   (define/override (get-name)
     "Flower Moon Garden")

   (define/override (can-place-on-flower-bed? flower flower-bed)
      (let ((stacked (send flower-bed get-cards)))
        [or (empty? stacked)
            (and (card-one-rank-below? flower (wheels stacked))
                 (card-same-color? flower (wheels stacked)))] ))

   (define/override (can-place-on-bucket? flower bucket)
      [< (send bucket number-of-cards) 16])
})

(define rules-venus%
  {class
   rules-moon%
   (init)
   (super-new)

   (define/override (get-name)
     "Flower Venus Garden")

   (define/override (can-place-on-flower-bed? flower flower-bed)
      (let ((stacked (send flower-bed get-cards)))
        [or (empty? stacked)
            (and (card-one-rank-below? flower (wheels stacked))
                 (card-same-suit? flower (wheels stacked)))] ))
})