[plt-scheme] Re: Make a grid / table control in GUI

hi Stephen,
This is as far as I got with my original. It has the right look, and
the resizing arrows pop up when you hover between column headings, but
at the time I knew virtually nothing about MrEd, so dropped the idea
as too much work. Maybe I should try this again.

Below that is a working resizeable widget that uses the framework's
dragable panel -- it's almost all there, but those gaps between
columns were unacceptable!

regards,
praimon

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
#lang scheme/gui

(define dir-pane%
  (class horizontal-panel%
    (init-field parent)
    (init cols)
    (define colnums cols)
    (init input)
    (define wrapped-input
      (map (lambda (li)
             (map (lambda (s)
                    (string-append s "\n")) li)) input))
    (init headings)
    (define heads headings)
    (super-new [parent parent])
    (let loop ([n 0])
      (cond
        [(= n colnums) (void)]
        [else
         (let* ([vpan (new vertical-panel% [parent this])]
                  [but (new dir-button% [parent vpan]
                            [label (list-ref heads n)])]
                  [canv (new dir-canvas% [parent vpan])]
                  [txt (new text%)])
           (send canv set-editor txt)
           (send txt insert (apply string-append
                                   (map (lambda (s) (list-ref s n))
                                        wrapped-input)))
           (loop (add1 n)))]))))


(define dir-canvas%
  (class editor-canvas%
    (super-new
      [style '(no-border hide-hscroll hide-vscroll)])))

(define dir-button%
  (class button%
    (super-new
     [vert-margin 0]
     [horiz-margin 0]
     [stretchable-width #t])
    (define/override (on-subwindow-event rec ev)
      (let ([b-width (send rec get-width)])
        (cond [(or (send ev entering?) (send ev moving?))
               (when (not
                      (or (< (send ev get-x) 4)
                          (< (- b-width (send ev get-x)) 5)))
                 (send rec set-cursor (make-object cursor%
'size-e/w)))
               ]
              [else (super on-subwindow-event rec ev)])))))

;;testing
(define f (new frame% [label "dir test"]
               [width 200]
               [height 200]))
(define test (new dir-pane% [cols 3] [parent f]
                  [headings '("field 1" "field 2" "field 3")]
                  [input '(("first" "second" "third")
                           ("fourth" "this is a very very long entry" "sixth")
                           ("seventh" "eighth" "ninth"))]))
(send f show #t)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; below is the dragable panel version

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
#lang scheme/gui
(require framework)

(define dir-pane%
  (class panel:horizontal-dragable% ;dragable!
    (init-field parent)
    (init cols)
    (define colnums cols)
    (init input)
    (define wrapped-input
      (map (lambda (li)
             (map (lambda (s)
                    (string-append s "\n")) li)) input))
    (init headings)
    (define heads headings)
    (super-new [parent parent])
    (let loop ([n 0])
      (cond
        [(= n colnums) (void)]
        [else
         (let* ([vpan (new vertical-panel% [parent this])]
                  [but (new dir-button% [parent vpan]
                            [label (list-ref heads n)])]
                  [canv (new dir-canvas% [parent vpan])]
                  [txt (new text%)])
           (send canv set-editor txt)
           (send txt insert (apply string-append
                                   (map (lambda (s) (list-ref s n))
                                        wrapped-input)))
           (loop (add1 n)))]))))

(define dir-canvas%
  (class editor-canvas%
    (super-new
      [style '(no-border hide-hscroll hide-vscroll)])))

(define dir-button%
  (class button%
    (super-new
     [vert-margin 0]
     [horiz-margin 0]
     [stretchable-width #t])
    ))

;;testing
(define f (new frame% [label "dir test"]
               [width 200]
               [height 200]))
(define test (new dir-pane% [cols 3] [parent f]
                  [headings '("field 1" "field 2" "field 3")]
                  [input '(("first" "second" "third")
                           ("fourth" "this is a very very long entry" "sixth")
                           ("seventh" "eighth" "ninth"))]))
(send f show #t)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


On Wed, Sep 9, 2009 at 2:45 AM, Stephen De Gabrielle
<stephen.degabrielle at acm.org> wrote:

> How far did you get with implementing the resizing
> yourself?