sections/flowers.rkt
;; #lang racket

;; (require games/cards racket/class
;;          "pretext.rkt")

;;
;; Flowers
;;
;; Now this is the stupid approach to class redefinition (see
;; Guile/GOOPS). We need each card object to have a back link to its
;; stack. While card% does feature a home-region where region is the
;; "view" of the stack the region structure does not provide a list of
;; cards and thus it does not keep track of the sequence of cards. We
;; do this in the model with a list (see stack%). Then the message
;; passing protocol for the region callbacks gives us a list of cards
;; dragged to a region and we can add these cards to the stack of the
;; target. But how do we remove these cards from the stack where the
;; cards came from? BTW The implementation of Spider loops through all
;; stacks. We do that with broadcast.

(define (reset-flowers flowers)
  [when (method-in-interface?
         'snap-back-after-regions? card<%>)
        ;; See Animations in the README file and see also
        ;; "mred/15064" in Racket's bug database. This is
        ;; conditional for compatibility with Rkt < 6.2.1
        (broadcast flowers snap-back-after-regions? #t)]
  (broadcast* flowers
              (face-down)
              (dim #f)
              (user-can-flip #f)
              (snap-back-after-move #t)
              (user-can-move #f))
  flowers)
(define (wiggle-flower-in-garden flower garden)
  (let* ((table (send garden get-table))
         (layout (send garden get-layout))
         (x-offset (send layout get-flower-wiggle-x-offset flower))
         (y-offset (send layout get-flower-wiggle-y-offset flower)))
    (let-values (([x y] (send table card-location flower)))
      (send table move-card flower
            (- x x-offset) (+ y y-offset))
      (send table move-card flower
            (+ x x-offset) (- y y-offset))
      (send table move-card flower x y)) ))
;;
;; Stateful Flowers
;; We don't want to save a deep copy of a view.
;; Instead we do the flag flipping ourselfs.
;; Card positions are part of the table% object state.
(define (flower-save-state flower)
  (list (send flower face-down?)
        (send flower user-can-flip)
        (send flower snap-back-after-move)
        (send flower user-can-move)
        (send flower home-region)))
(define (flower-restore-state flower state)
  (if (first state)
      (send flower face-down)
      (send flower face-up))
  (send flower user-can-flip (second state))
  (send flower snap-back-after-move (third state))
  (send flower user-can-move (fourth state))
  (send flower home-region (fifth state)))

(define (make-flowers flowers)
  (reset-flowers flowers))


;; Utility procedure to be used with sort
(define (card-sort-smaller? first-card second-card)
  "Return true if the first card has a lower rank than the second card."
  (< (send first-card get-value) (send second-card get-value)))

(define (card-sort-by-rank cards)
  (sort cards card-sort-smaller?))