;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Broad Layout
;;;
;;;

;;
;; About this layout for Flower Garden:
;;
;; This layout works the same as the regular one but puts the
;; foundations onto the side at the first column. It's the most
;; useful layout on a table.
;;
;; There is an upper border and a left border.
;; There are seven columns with intercolumn spacing.
;; The first column (column 0) contains the foundations.
;; There are two rows with interrow spacing.
;;  The first row contains the six flower beds.
;;  The second row contains the bouquet.

{define layout96l%
  (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 8)) ; confront with table width

    (define upper-border default-spacing-unit)
    (define left-border default-spacing-unit)
    (define intercolumn-space (- (/ (* 3/2 card-width) 5)
                                 (* 1 default-spacing-unit)))
    (define interrow-space (* 2 default-spacing-unit))

    ;; Column zero is for the foundations
    (define foundation-column-width (* 3/2 card-width))
    (define (column-n-x n)
      "Return the x coordinate of the left border of the n'th column."
      (+ left-border (+ (* 1/2 card-width)
                        (* (+ card-width intercolumn-space)
                           n))) )

    ;;
    ;; Layout of the Table

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

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

    ;; Table Background
    (define fixed-window-border 0)
    (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)))

    ;;
    ;; Stack Labels & Style
    (define show-all-stack-regions #f)
    (define/public (get-foundation-title foundation)
      "Foundation")
    (define/public (get-flower-bed-title flower-bed)
      (and show-all-stack-regions "Flower Bed"))
    (define/public (get-bucket-title bucket-title)
      (and show-all-stack-regions "Bouquet"))

    ;;
    ;; Layout of the Foundations
    (define foundation-top-line
      (+ upper-border
         (* 1/2 card-height)))
    (define/public (get-foundation-x-coordinate foundation)
        (+ left-border
           (* 1/4 card-width)))
    (define/public (get-foundation-y-coordinate foundation)
      (let ((foundation-index (send foundation get-foundation-index)))
        (+ foundation-top-line (* (sub1 foundation-index)
                                  (+ card-height
                                     default-spacing-unit)))))
    (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
      upper-border)
    (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)
         foundation-column-width
         interrow-space)) ; 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

    ;;
    ;; Initial Deal Deck Position
    (define/public (get-initial-deal-x-coordinate garden)
      (column-n-x 1))
    (define/public (get-initial-deal-y-coordinate garden)
      (- bucket-top-line card-height))

    ;;
    ;; 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
;;
;; Grouping bucket layout. But groups are not just modulo ...
;;
;;     (define (bucket-layout-cards bucket)
;;       (define (current-group card-index)
;;         (+ 1 (quotient (sub1 card-index)
;;                        4)))
;;       (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))
;;              (bucket-width (region-w region))
;;              [offset (* 1/3 card-width)]
;;              [grouping-offset-addition offset]
;;              [maximum-offset (* 3/2 card-width)]
;;              [centered-x-offset 0]
;;              [number-of-groups (current-group number-of-cards)])

;;         (define (offset-sum number-of-cards)
;;           (if (< number-of-cards 2)
;;               0
;;               (+ (* offset (sub1 number-of-cards))
;;                  (* grouping-offset-addition
;;                     number-of-groups))))
;;         (debug "layout: bucket-layout: number-of-groups: "
;;                number-of-groups)
        
;;         (when (> (+ card-width (offset-sum number-of-cards))
;;                  bucket-width)
;;               (debug "layout: bucket-layout: need to adapt")
;;               (set! offset
;;                     (/ (- bucket-width card-width)
;;                        (+ (- number-of-cards 1)
;;                           number-of-groups)))
;;               (set! grouping-offset-addition offset)
;;               )
;;         (debug "layout: bucket-layout-cards:"
;;                " offset: " (exact->inexact offset)
;;                " grouping-offset-addition: "
;;                (exact->inexact grouping-offset-addition))

;;         (set! centered-x-offset
;;               {half [- bucket-width
;;                        (offset-sum number-of-cards)]} )

;;         (send* (send (send bucket get-garden) get-table)
;;           ;; regular card faces
;;              (stack-cards (reverse cards)) ; z-axis-stacking
;;           ;; oxygen
;;              ;(stack-cards cards) ; z-axis-stacking
;;           (move-cards cards
;;                       (+ (region-x region) centered-x-offset)
;;                       (region-y region)
;;                       {lambda (n)
;;                         (let ((x (+ (* offset n)
;;                                     (* grouping-offset-addition
;;                                        (sub1 (current-group (add1 n)) )) )))
;;                           (debug "layout: move-cards: (callback):"
;;                                  " n: " n
;;                                  " x: " x)
;;                         (values x
;;                                 (* (+ 2
;;                                       (half (modulo
;;                                              (current-group (add1 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))))

    (define/public (get-flower-wiggle-x-offset flower)
      (* 1/6 card-width))
      ;0)
    (define/public (get-flower-wiggle-y-offset flower)
      0)
      ;(* 1/8 card-height))
    )}