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


;;
;; This layout works the same as the regular one but puts the
;; foundations onto the side at the seventh column. It's the most
;; useful layout on a table.
{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))) )
    ;;
    ;; This is a workaround. There is a redrawing shortcoming when we
    ;; change the background color. It might be related to the way
    ;; regions are used, how the clipping is handled and the way Cairo
    ;; is fed with these things by the Virtual Card Library.
    (define/public (clean-window-in-garden sponge garden)
      (let ((table-width (* card-width (send this get-table-width garden)))
            (table-height (* card-height
                             (send this get-table-height garden))))
        (let-values
         [([x-orig y-orig] (send garden card-location sponge))]
         {let next-row ((y-off 0))
;;            (when [> (+ y-off card-height) table-height]
;;                  (set! y-off (- table-height
;;                                 (* 2/3 card-height))))
           (send* garden
                  (move-card sponge 0 y-off)
                  (move-card sponge (- table-width card-width) y-off))
           (if (< (+ y-off card-height) table-height)
               (next-row (+ y-off card-height))
               'shiny-window)}
         (send garden move-card sponge x-orig y-orig)) ))

    ;;
    ;; 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 flower "Cornflower Blue")
    (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)
      (define (paint-callback-exception-handler exn)
        (warning "layout: background paint-callback failure: "
                 exn))
      {lambda (drawing-context x y width height)
        (with-handlers
         {[exn:fail? paint-callback-exception-handler]}
         ;; XXX there is some redrawing shortcoming at the right border
         ;; and at the lower border
         (send drawing-context set-background flower)
         ;;(send drawing-context erase)
         (send drawing-context clear)
         ;;(send drawing-context flush)
         )})
    (define/public (flower-present selected-flower)
      (set! flower selected-flower))
      ;(flush-display))

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

    (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))
    )}