;;
;; Layout
;;
;; This abstract layout hub class keeps the layout in one spot.
;; This approach rips open the encapsulation of the other classes
;; but in this case it's more important to seperate layout from logic.
;;
;; As a general layout message passing protocol objects requesting
;; layout information send themselves as arguments even if this is
;; right now unecessary in some cases. In most cases though this
;; layout hub needs more information from the object, e.g. the index
;; of a stack to provide the correct layout information.
;;
;; About this layout for Flower Garden:
;;
;; The layout is hardcoded: it will not adapt to a change in the
;; number of stacks. A different number of stacks would be a different
;; game anyway. It should be rather easy to exchange the meaning of
;; row and column in this layout though. But it might even be
;; intertwined: not always following its inner logic.
;;
;; The layout is completely based on the playing card dimensions:
;;  for this it needs one unit card to retrieve the dimensions.
;;
;; There is an upper border and a left border.
;; There are six columns with intercolumn spacing.
;; There are three rows with interrow spacing.
;;  The first row contains the centered four foundations.
;;  The second row contains the six flower beds.
;;  The third row contains the bouquet.

{define layout77%
  (class
      object%
    (init unit-card)
    (super-new)
    (define card-width (send unit-card card-width))
    (define card-height (send unit-card card-height))
    ;; ??? perhaps we should release unit-card here

    (define default-spacing-unit (/ card-width 7)) ; confront with table width

    (define upper-border default-spacing-unit)
    (define left-border default-spacing-unit)
    (define intercolumn-space default-spacing-unit)
    (define interrow-space (* 2 default-spacing-unit))

    (define (column-n-x n)
      "Return the x coordinate of the left border of the n'th column."
      (+ left-border (* (+ card-width intercolumn-space)
                        (sub1 n))) )

    ;;
    ;; Layout of the Table

    ;; One card width for each column plus one for spacing.
    (define/public (get-table-width garden) 7)

    ;; One card height for the foundations, one for the bouquet, one
    ;; for spacing and four card heights for the flower bed.
    (define/public (get-table-height garden) 7)

    ;; Table Background
    (define fixed-window-border 0)
    (define flower "Lavender")
    (define/public (get-background-x-coordinate garden)
      fixed-window-border)
    (define/public (get-background-y-coordinate garden)
      fixed-window-border)
    (define/public (get-background-width garden)
      (- (* card-width (get-table-width garden))
         (* 2 fixed-window-border)))
    (define/public (get-background-height garden)
      (- (* card-height (get-table-height garden))
         (* 2 fixed-window-border)))
    (define/public (get-background-paint-callback garden)
      {lambda (drawing-context x y width height)
        ;; XXX there is some redrawing shortcoming at the right border
        ;; and at the lower border
        (send drawing-context set-background flower)
        (send drawing-context clear)
        })
    (define/public (flower-present selected-flower)
      (set! flower selected-flower))

    ;;
    ;; Layout of the Foundations
    (define foundation-top-line
      upper-border)
    (define/public (get-foundation-x-coordinate foundation)
      (let ((foundation-index (send foundation get-foundation-index)))
        (column-n-x (+ foundation-index 1))))
    (define/public (get-foundation-y-coordinate foundation)
      foundation-top-line)
    (define/public (get-foundation-width foundation)
      card-width)
    (define foundation-height card-height)
    (define/public (get-foundation-height foundation)
      foundation-height)

    ;;
    ;; Layout of the Flower Beds
    (define flower-bed-top-line
      (+ foundation-top-line
         foundation-height
         interrow-space))
    (define/public (get-flower-bed-x-coordinate flower-bed)
      (let ((flower-bed-index (send flower-bed get-flower-bed-index)))
        (column-n-x flower-bed-index)))
    (define/public (get-flower-bed-y-coordinate flower-bed)
      flower-bed-top-line)
    (define flower-bed-width card-width)
    (define/public (get-flower-bed-width flower-bed)
      flower-bed-width)
    ;; Each flower bed needs to accomodate up to 18 cards.
    (define flower-bed-card-y-offset (/ card-height 3))
    (define flower-bed-height (+ (* 1  card-height)
                                 (* 8 flower-bed-card-y-offset)))
    (define/public (get-flower-bed-height flower-bed)
      flower-bed-height)

    ;;
    ;; Layout of the Bouquet
    (define bucket-top-line
      (+ flower-bed-top-line
         flower-bed-height
         (* 3/2 interrow-space)))        ; this extra space makes it look better
    (define/public (get-bucket-x-coordinate bucket)
      (column-n-x 1)) ; bucket's left border is aligned to the first column
    (define/public (get-bucket-y-coordinate bucket)
      bucket-top-line)
    (define/public (get-bucket-width bucket)
      (- (+ (column-n-x 6) flower-bed-width)
         left-border)) ; bucket's right border is aligned to the last column
    (define/public (get-bucket-height bucket)
      [+ (* 3/4 default-spacing-unit) ; there is no sense if not asthetic sense
         (* 3/2 card-height)]) ; give the user some space and fill the table

    ;;
    ;; Card Layout
    (define (stack-layout-cards foundation)
      (let ((cards (reverse (send foundation get-cards)))
            (region (send foundation get-region)))
        (send* (send (send foundation get-garden)
                     get-table)
          (stack-cards (reverse cards)) ; z-axis-stacking
          (move-cards cards
                      (region-x region)
                      (region-y region)))))
    (define foundation-layout-cards stack-layout-cards)

    (define (flower-bed-layout-cards flower-bed)
      (let* ((cards (reverse (send flower-bed get-cards)))
             (region (send flower-bed get-region))
             (number-of-cards (length cards))
             ;(card-height (send (wheels cards) card-height))
             (offset flower-bed-card-y-offset)
             (height (region-h region)))
        (when (> (+ card-height (* number-of-cards offset))
                 height)
          ;                                        ; y = ch + (nc-1)*of
          ;                                        ; y-ch / (nc-1) = of
          (set! offset (/ (- height card-height)
                          (sub1 number-of-cards))))
        (send* (send (send flower-bed get-garden) get-table)
          (stack-cards (reverse cards)) ; z-axis-stacking
          (move-cards cards
                      (region-x region)
                      (region-y region)
                      {lambda (n)
                        (values 0 (* offset n)) } ))))


    (define bucket-card-top-line (+ bucket-top-line
                                    (* 2 default-spacing-unit)))
    (define (bucket-layout-cards bucket)
      (let* ((table (send (send bucket get-garden) get-table))
             (cards (send bucket get-cards)) ; sorting is done by the bucket
             (number-of-cards (send bucket number-of-cards))
             (region (send bucket get-region))
             (width (region-w region))
             [offset (if (> number-of-cards 1)
                         (begin (/ (- width (* 1 card-width))
                                   (sub1 number-of-cards)))
                         ; This is correct when number-of-cards is one.
                         ; This is wrong for number-of-cards less than
                         ; or equal to 0 which should not happen.
                         +inf.0)]
             [maximum-offset (* 3/2 card-width)]
             [centered-x-offset 0])
        ;; When the offset is too close to card-width it looks better
        ;; not to put one card next to the other but to fan them.
        (when [> offset (* 2/3 card-width)]
              (set! offset (* 2/3 card-width))
              (set! centered-x-offset
                    {half [- (region-w region)
                             {+ card-width
                                [* offset (- number-of-cards 1)]}]} ))
        (send* (send (send bucket get-garden) get-table)
          (stack-cards (reverse cards)) ; z-axis-stacking
          (move-cards cards
                      (+ (region-x region) centered-x-offset)
                      (region-y region)
                      {lambda (n)
                        (values (* offset n)
                                (* 2 default-spacing-unit))
                                ;(vector-ref y-coordinates n))
                                } ))
        )) ; closes bucket-layout-cards

    (define/public (layout-cards stack)
      (cond ([is-a? stack foundation%] (foundation-layout-cards stack))
            ([is-a? stack flower-bed%] (flower-bed-layout-cards stack))
            ([is-a? stack bucket%] (bucket-layout-cards stack))
            (else
             (warning "layout%: layout-cards!:"
                      " no registered card layout found for type: "
                      (object-interface stack)
                      ": using fallback: stack-layout-cards!")
             (stack-layout-cards stack))))
    )}