...

original commit: bfd85b7e724afe90d4363b863bda7cf228197273

collects/mrlib/private/aligned-pasteboard/alignment.ss

@@ -1,22 +1,24 @@
-;;note:   This code computes the sizees for the rectangles in the space using the on dimention
+#|
-;;      off dimention method of referencing sizes. This means for example instead of saying
+This code computes the sizees for the rectangles in the space using the on dimention
-;;      width we say off dimention for vertical alignment. Inorder to consume and return
+off dimention method of referencing sizes. This means for example instead of saying
-;;      the values in terms of width and height manipulation had to be done. I chose to create
+width we say off dimention for vertical alignment. Inorder to consume and return
-;;      a struct abs-rect (abstract rectangle) and have code map horizontal and vertical rect
+the values in terms of width and height manipulation had to be done. I chose to create
-;;      stucts on to them. This code is a bit long but more readable than the other two options
+a struct abs-rect (abstract rectangle) and have code map horizontal and vertical rect
-;;      I came up with.
+stucts on to them. This code is a bit long but more readable than the other two options
-;;        1) define all functions to be letrec bound functions inside align. align then take
+I came up with.
-;;           accessors for the rect struct. The caller of align swaps the order of ondimention
+  1) define all functions to be letrec bound functions inside align. align then take
-;;           and off dimention accessors for vertical or horizontal code. This method does not
+     accessors for the rect struct. The caller of align swaps the order of ondimention
-;;           allow the use of the readable, sort, consis pattern matching code. As some of the
+     and off dimention accessors for vertical or horizontal code. This method does not
-;;           matching code is easily removed this may be a good option but a large letrec
+     allow the use of the readable, short, consis pattern matching code. As some of the
-;;           is harder to write tests for.
+     matching code is easily removed this may be a good option but a large letrec
-;;        2) define a pattern matcher syntax that will match the struct rect but swap the fields
+     is harder to write tests for.
-;;           based on wich on is the on or off dimention. This would have been shorter but much
+  2) define a pattern matcher syntax that will match the struct rect but swap the fields
-;;           more confusing.
+     based on wich on is the on or off dimention. This would have been shorter but much
-;;     The current implementation requires align to map over the rects and allocate new stucts
+     more confusing.
-;;     for each one on both passing into and returning from stretch-to-fit; This is not a bottle
+The current implementation requires align to map over the rects and allocate new stucts
-;;     neck and it is the most readable solution.
+for each one on both passing into and returning from stretch-to-fit; This is not a bottle
+neck and it is the most readable solution.
+|#
 
 (module alignment mzscheme
   
@@ -29,15 +31,16 @@
   (define-struct rect (x y))
   (define-struct abs-rect (ondim offdim))
   (define-struct dim (pos size stretchable?))
-  ;; make-rect (dim? dim? . -> . rect?)
-  ;; make-abs-rect (dim? dim? . -> . rect?)
-  ;; make-dim (nonnegative? nonnegative? boolean? . -> . dim?)
   
-  (provide
+  (define (nonnegative? n)
-   (struct rect (x y))
+    (and (number? n)
-   (struct dim (pos size stretchable?)))
+         (or (positive? n)
+             (zero? n))))
   
   (provide/contract
+   (struct rect ((x dim?) (y dim?)))
+   (struct abs-rect ((ondim dim?) (offdim dim?)))
+   (struct dim ((pos nonnegative?) (size nonnegative?) (stretchable? boolean?)))
    (align ((symbols 'horizontal 'vertical)
            positive? positive? (listof rect?)
            . -> . (listof rect?)))
@@ -137,7 +140,7 @@
                                   (make-dim 0 offsize offstretch?))
                    (loop rest-rects (+ onpos onsize))))]))))
   
-  ;; waner (nonnegative? . -> . (-> (union 1 0)))
+  ;; waner (natural-number? . -> . (-> (union 1 0)))
   ;; makes a thunk that returns 1 for it's first n applications, zero otherwise
   (define (waner n)
     (lambda ()

collects/test-suite/private/button-snip.ss

@@ -6,6 +6,7 @@
    (lib "etc.ss"))
   
   (provide
+   text-button-snip%
    button-snip%
    toggle-button-snip%)
   
@@ -55,6 +56,35 @@
       (super-new)
       (load-file image)))
   
+  ;; a textual button of the same type
+  (define text-button-snip%
+    (class string-snip%
+      (init label)
+      (init-field callback)
+      (field
+       [got-click? false]
+       [inside? false])
+      
+      (rename [super-on-event on-event])
+      (define/override (on-event dc x y editorx editory event)
+        (case (send event get-event-type)
+          [(left-down)
+           (set! got-click? true)
+           (set! inside? true)]
+          [(left-up)
+           (when (and got-click? inside?)
+             (callback this event))
+           (set! got-click? false)
+           (set! inside? false)]
+          [(enter)
+           (set! inside? true)]
+          [(leave)
+           (set! inside? false)]
+          [else (void)]))
+      
+      (super-make-object label)))
+  
+  ;; a toggle button that displays different images
   (define toggle-button-snip%
     (class button-snip%
       (inherit set-images)