(module simple-layouts mzscheme
  (require (lib "class.ss")
           (lib "mred.ss" "mred")
           (lib "list.ss")
           (lib "plt-match.ss"))
  
  (provide simple-horizontal-panel% simple-grid-panel%)
  
  (define simple-horizontal-panel%
    ;; This is a simple example of a horizontal layout.
    
    ;; It doesn't do what horizontal-panel% does --- in particular,
    ;; it's not paying attention to alignment.  Still, it's a start.
    (class panel%
      (super-new)
      (override container-size place-children)
      
      ;; container-size: (listof (list number number boolean boolean)) 
      ;;                 -> (values number number)
      ;; Returns our container's minimum size, given the size of
      ;; the children.
      (define (container-size info)
        (let ([widths (map first info)]
              [heights (map second info)])
          (values
           (apply + widths)
           (apply max heights))))
      
      
      ;; place-children: (listof (list integer integer boolean boolean))
      ;;                 integer integer ->
      ;;                 (listof (list integer integer integer integer)
      (define (place-children info width height)
        (let loop ([info info]
                   [width-acc 0])
          (match info
            [(list (list width height horiz-stretch? vert-stretch?)
                   rest ...)
             (cons (list width-acc 0 width height)
                   (loop rest (+ width width-acc)))]
            [else empty])))))
  
  
  (define simple-grid-panel%
    (class panel%
      (init [columns-per-row 3])
      (define -columns-per-row columns-per-row)
      (super-new)
      (override container-size place-children)
      
      ;; container-size: (listof (list number number boolean boolean)) 
      ;;                 -> (values number number)
      ;; Returns our container's minimum size, given the size of
      ;; the children.
      (define (container-size info)
        (let-values ([(child-width child-height)
                      (uniform-child-size info)]
                     [(number-of-rows)
                      (ceiling (/ (length info) -columns-per-row))])
          (values
           (* child-width -columns-per-row)
           (* child-height number-of-rows))))
      
      ;; uniform-child-size: 
      ;;     (listof (list number number boolean boolean)) 
      ;;                 -> (values number number)      
      ;; returns the minimum width and height that all the children
      ;; can fit into.
      (define (uniform-child-size info)
        (let ([widths (map first info)]
              [heights (map second info)])
          (values (apply max widths)
                  (apply max heights))))
      
      
      ;; place-children: (listof (list integer integer boolean boolean))
      ;;                 integer integer ->
      ;;                 (listof (list integer integer integer integer)
      (define (place-children info width height)
        (let-values ([(child-width child-height)
                      (uniform-child-size info)])
          (let loop ([info info]
                     [i 0])
            (match info
              [(list (list width height horiz-stretch? vert-stretch?)
                     rest ...)
               (cons (list (* child-width (remainder i -columns-per-row))
                           (* child-height (quotient i -columns-per-row))
                           width 
                           height)
                     (loop rest (add1 i)))]
              [else empty]))))))


  (define (test)
    (define (t1)
      (define f (new frame% [label "test"]))
      (define h (new simple-horizontal-panel% [parent f]))
      (make-object message% "hello" h)
      (make-object message% "world" h)
      (send f show #t))
    
    (define (t2)
      (define f2 (new frame% [label "test2"]))
      (define h2 (new simple-grid-panel% [parent f2]))
      (for-each (lambda (msg)
                  (make-object message% msg h2))
                '("hello" "world" "this" "is" "a" "cool" "test"))
      (send f2 show #t))
    (t1)
    (t2))
  
  (define (phone-numbers)
    (define ((make-button parent) label)
      (new button% 
           [label (format "~a" label)]
           [parent parent]))
    
    (define frame (new frame% [label "test"]))
    (define grid (new simple-grid-panel% [parent frame]))
    (for-each (make-button grid) '(1 2 3
                                   4 5 6
                                   7 8 9
                                   * 0 \#))
    (send frame show #t)))