fixed robbys cvs complaint

original commit: d8b0020014998b40e9d3bf9bdf772445b7951aef

collects/embedded-gui/private/alignment.ss

@@ -42,9 +42,8 @@ neck and it is the most readable solution.
    (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?)))
-   (rect-print ((listof rect?) . -> . void?)))
+           nonnegative? nonnegative? (listof rect?)
+           . -> . (listof rect?))))
   
   ;; align the rectangles within the given space
   (define (align type width height rects)
@@ -121,8 +120,7 @@ neck and it is the most readable solution.
                (loop (rest sizes) (- extra onsize) (sub1 count))
                (values extra/rect (modulo (floor extra) count))))])))
   
-  #;((cons/p nonnegative? nonnegative?) positive? (listof abs-rect?) . -> .
-                                        (listof abs->rect?))
+  #;((cons/p nonnegative? nonnegative?) positive? (listof abs-rect?) . -> . (listof abs->rect?))
   ;; allocate the extra per rectangle to the stretchable rects and move them to their positions
   (define (allocate-evenly/position extra-div extra-mod offsize init-rects)
     (let ([mod (waner extra-mod)])
@@ -149,16 +147,4 @@ neck and it is the most readable solution.
           (begin
             (set! n (sub1 n))
             1))))
-  
-  (define rect-print
-    (match-lambda
-      [() (void)]
-      [(($ rect
-           ($ dim x width stretchable-width?)
-           ($ dim y height stretchable-height?))
-        others ...)
-       (printf "(make-rect (make-dim ~s ~s ~s) (make-dim ~s ~s ~s))~n"
-               x width stretchable-width?
-               y height stretchable-height?)
-       (rect-print others)]))
   )

collects/embedded-gui/private/lines.ss

@@ -0,0 +1,152 @@
+(module lines mzscheme
+  
+  (require
+   (lib "class.ss")
+   (lib "etc.ss")
+   (lib "mred.ss" "mred")
+   "snip-wrapper.ss"
+   "interface.ss")
+  
+  (provide hline% vline%)
+  
+  (define hline%
+    (class snip-wrapper%
+      (super-new
+       (snip (new hline-snip%)))))
+  
+  (define vline%
+    (class snip-wrapper%
+      (super-new
+       (snip (new vline-snip%)))))
+  
+  (define (make-line-snip draw-line stretch-w stretch-h)
+    (letrec ([c (class* snip% (stretchable-snip<%>)
+               
+               (field
+                [width 0]
+                [height 0])
+               
+               ;;;;;;;;;;
+               ;; snip%
+               
+               #;(((is-a?/c dc<%>)
+                   number?
+                   number?)
+                  ((union nonnegative? false?)
+                   (union nonnegative? false?)
+                   (union nonnegative? false?)
+                   (union nonnegative? false?)
+                   (union nonnegative? false?)
+                   (union nonnegative? false?))
+                  . opt-> .
+                  void?)
+               (define/override (get-extent dc x y w h descent space lspace rspace)
+                 (super get-extent dc x y w h descent space lspace rspace)
+                 (when w (set-box! w width))
+                 (when h (set-box! h height)))
+               
+               #;((is-a?/c dc<%>)
+                  number?
+                  number?
+                  number?
+                  number?
+                  number?
+                  number?
+                  number?
+                  number?
+                  (symbols no-caret show-inactive-caret show-caret))
+               (define/override (draw dc x y left top right bottom dx dy draw-caret)
+                 (super draw dc x y left top right bottom dx dy draw-caret)
+                 (draw-line dc x y width height)
+                 (void))
+               
+               ;;;;;;;;;;
+               ;; stretchable-snip<%>
+               
+               #;(positive? positive? . ->  . void?)
+               ;; called by the parent editor to stretch the snip to an specific size
+               (define/public (stretch w h)
+                 (set! width w)
+                 (set! height h))
+               
+               #;(-> positive?)
+               ;; get the minimum width of the snip
+               ;; NOTE: Lines need a margin so they're not overwritten
+               (define/public (get-aligned-min-width) 8)
+               
+               #;(-> positive?)
+               ;; get the minmum height of the snip
+               ;; NOTE: Lines need a margin so they're not overwritten
+               (define/public (get-aligned-min-height) 8)
+               
+               #;(case-> (boolean . -> . void?) (-> boolean?))
+               ;; get or set the stretchablity of the pasteboards width
+               (define/public stretchable-width
+                 (case-lambda
+                   [(v) (error 'stretchable-width "Cannot set stretchable-width of a line-snip%")]
+                   [() stretch-w]))
+               
+               #;(case-> (boolean . -> . void?) (-> boolean?))
+               ;; get or set the stretchablity of the pasteboards height
+               (define/public stretchable-height
+                 (case-lambda
+                   [(v) (error 'stretchable-height "Cannot set stretchable-height of a line-snip%")]
+                   [() stretch-h]))
+               
+               (super-new)
+               (inherit set-snipclass)
+               (set-snipclass sc))]
+          [sc (new
+               (class snip-class%
+                 (define/override (read f)
+                   (new c))
+                 (super-new)))])
+      (send sc set-classname "make-line-snip")
+      (send sc set-version 1)
+      (send (get-the-snip-class-list) add sc)
+      c))
+                
+  
+  (define hline-snip%
+     (make-line-snip
+      (lambda (dc x y width height)
+        (send dc draw-line x (+ y (/ height 2)) (+ x width) (+ y (/ height 2))))
+      true
+      false))
+    
+  (define vline-snip%
+     (make-line-snip
+      (lambda (dc x y width height)
+        (send dc draw-line (+ x (/ width 2)) y (+ x (/ width 2))  (+ y height)))
+      false
+      true))
+  
+  #|
+  (require
+   "verthoriz-alignment.ss"
+   "aligned-pasteboard.ss"
+   "snip-wrapper.ss")
+  
+  (define f (new frame% (label "f") (height 500) (width 500)))
+  (send f show true)
+  (define p (new aligned-pasteboard%))
+  (define c (new editor-canvas% (editor p) (parent f)))
+  (define a1 (new vertical-alignment% (parent p)))
+  (define a2 (new horizontal-alignment% (parent a1)))
+  (new hline% (parent a1))
+  (define a3 (new horizontal-alignment% (parent a1)))
+  
+  (new snip-wrapper%
+       (snip (make-object string-snip% "One"))
+       (parent a2))
+  (new snip-wrapper%
+       (snip (make-object string-snip% "Two"))
+       (parent a2))
+  (new snip-wrapper%
+       (snip (make-object string-snip% "Three"))
+       (parent a3))
+  (new snip-wrapper%
+       (snip (make-object string-snip% "Three"))
+       (parent a3))
+  |#
+  )

collects/embedded-gui/private/tests/alignment-test.ss

@@ -15,7 +15,6 @@
 (define c (new editor-canvas% (editor p) (parent f)))
 (define a1 (new vertical-alignment% (parent p)))
 (define a2 (new horizontal-alignment% (parent a1)))
-;(new hline% (parent a1))
 (define a3 (new horizontal-alignment% (parent a1)))
 
 (new snip-wrapper%

collects/embedded-gui/private/tests/test-alignment.ss

@@ -0,0 +1,276 @@
+(require
+ (lib "etc.ss")
+ (lib "list.ss")
+ (lib "match.ss")
+ "../alignment.ss"
+ "test-macro.ss")
+
+;;los-equal? ((listof rect?) (listof rect?) . -> . boolean?)
+;;tests the equality of the list of structures
+(define (los-equal? a b)
+  (equal?
+   (map rect->list a)
+   (map rect->list b)))
+
+;;rect->list (rect? . -> . vector?)
+;;a vector of the fields in the rect
+(define rect->list
+  (match-lambda
+    [($ rect ($ dim x width stretchable-width?) ($ dim y height stretchable-height?))
+     (list x width stretchable-width? y height stretchable-height?)]))
+
+;;empty pasteboard
+(test
+ los-equal?
+ (align 'vertical 100 100 empty)
+ empty)
+
+;;empty pasteboard
+(test
+ los-equal?
+ (align 'horizontal 100 100 empty)
+ empty)
+
+;;one unstretchable snip
+(test
+ los-equal?
+ (align 'vertical
+        100 100
+        (list (make-rect (make-dim 0 10 false)
+                         (make-dim 0 10 false))))
+ (list (make-rect (make-dim 0 10 false)
+                  (make-dim 0 10 false))))
+
+(test
+ los-equal?
+ (align 'horizontal
+        100 100
+        (list (make-rect (make-dim 0 10 false)
+                         (make-dim 0 10 false))))
+ (list (make-rect (make-dim 0 10 false)
+                  (make-dim 0 10 false))))
+
+;;one stretchable snip
+(test
+ los-equal?
+ (align 'vertical
+        100 100
+        (list (make-rect (make-dim 0 10 true)
+                         (make-dim 0 10 true))))
+ (list (make-rect (make-dim 0 100 true)
+                  (make-dim 0 100 true))))
+
+;;two stretchable snips
+(test
+ los-equal?
+ (align 'vertical
+        10
+        10
+        (list
+         (make-rect (make-dim 0 0 true)
+                    (make-dim 0 0 true))
+         (make-rect (make-dim 0 0 true)
+                    (make-dim 0 0 true))))
+ (list
+  (make-rect (make-dim 0 10 true)
+             (make-dim 0 5 true))
+  (make-rect (make-dim 0 10 true)
+             (make-dim 5 5 true))))
+
+;;three stretchable, one too big
+(test
+ los-equal?
+ (align 'vertical
+        50 100
+        (list (make-rect (make-dim 0 0 true)
+                         (make-dim 0 50 true))
+              (make-rect (make-dim 0 0 true)
+                         (make-dim 0 0 true))
+              (make-rect (make-dim 0 0 true)
+                         (make-dim 0 0 true))))
+ (list (make-rect (make-dim 0 50 true)
+                  (make-dim 0 50 true))
+       (make-rect (make-dim 0 50 true)
+                  (make-dim 50 25 true))
+       (make-rect (make-dim 0 50 true)
+                  (make-dim 75 25 true))))
+
+;;three stetchable, one too big, and an unstetchable
+(test
+ los-equal?
+ (align 'vertical
+        50 100
+        (list (make-rect (make-dim 0 0 true)
+                         (make-dim 0 50 true))
+              (make-rect (make-dim 0 0 true)
+                         (make-dim 0 0 true))
+              (make-rect (make-dim 0 0 true)
+                         (make-dim 0 0 true))
+              (make-rect (make-dim 0 50 false)
+                         (make-dim 0 10 false))))
+ (list (make-rect (make-dim 0 50 true)
+                  (make-dim 0 50 true))
+       (make-rect (make-dim 0 50 true)
+                  (make-dim 50 20 true))
+       (make-rect (make-dim 0 50 true)
+                  (make-dim 70 20 true))
+       (make-rect (make-dim 0 50 false)
+                  (make-dim 90 10 false))))
+
+;;failure from test-suite frame
+;;wrong answer given was (list (make-rect 0 0 335.0 10 #t))
+(test
+ los-equal?
+ (align 'vertical
+        335.0
+        563.0
+        (list
+         (make-rect (make-dim 0 10.0 #t)
+                    (make-dim 0 10.0 #t))))
+ (list (make-rect (make-dim 0 335.0 true)
+                  (make-dim 0 563.0 true))))
+
+;;sort of like the previous failed test but with a nonsizable snip
+(test
+ los-equal?
+ (align 'vertical
+        563.0
+        335.0
+        (list
+         (make-rect (make-dim 0 10.0 #t)
+                    (make-dim 0 10.0 #t))
+         (make-rect (make-dim 0 10.0 false)
+                    (make-dim 0 10.0 false))))
+ (list (make-rect (make-dim 0 563.0 true)
+                  (make-dim 0 325.0 true))
+       (make-rect (make-dim 0 10.0 false)
+                  (make-dim 325.0 10.0 false))))
+
+;;something that requires a little modulo in division
+(test
+ los-equal?
+ (align 'vertical
+        10
+        10
+        (list
+         (make-rect (make-dim 0 0 true)
+                    (make-dim 0 0 true))
+         (make-rect (make-dim 0 0 true)
+                    (make-dim 0 0 true))
+         (make-rect (make-dim 0 0 true)
+                    (make-dim 0 0 true))))
+ (list (make-rect (make-dim 0 10 true)
+                  (make-dim 0 4 true))
+       (make-rect (make-dim 0 10 true)
+                  (make-dim 4 3 true))
+       (make-rect (make-dim 0 10 true)
+                  (make-dim 7 3 true))))
+
+;; 1 snip only stretches in off dimention
+(test
+ los-equal?
+ (align 'vertical
+        100
+        400
+        (list
+         (make-rect (make-dim 0 10 true)
+                    (make-dim 0 30 false))))
+ (list (make-rect (make-dim 0 100 true)
+                  (make-dim 0 30 false))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; The following examples of usage were taken from the test-suite tool and turned into test cases ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(test
+ los-equal?
+ (align 'vertical 563.0 335.0 (list))
+ empty)
+
+(test
+ los-equal?
+ (align 'vertical 563.0 335.0
+        (list (make-rect (make-dim 0 241 #t) (make-dim 0 114 #f))))
+ (list (make-rect (make-dim 0 563.0 #t) (make-dim 0 114 #f))))
+
+(test
+ los-equal?
+ (align 'vertical 551.0 102.0
+        (list (make-rect (make-dim 0 34 #t) (make-dim 0 47 #t))
+              (make-rect (make-dim 0 231 #t) (make-dim 0 57 #t))))
+ (list (make-rect (make-dim 0 551.0 #t) (make-dim 0 47 #t))
+       (make-rect (make-dim 0 551.0 #t) (make-dim 47 57 #t))))
+
+(test
+ los-equal?
+ (align 'vertical 539.0 35.0
+        (list (make-rect (make-dim 0 24 #f) (make-dim 0 13 #f))
+              (make-rect (make-dim 0 11 #f) (make-dim 0 24 #f))))
+ (list (make-rect (make-dim 0 24 #f) (make-dim 0 13 #f))
+       (make-rect (make-dim 0 11 #f) (make-dim 13 24 #f))))
+
+(test
+ los-equal?
+ (align 'horizontal 539.0 45.0
+        (list (make-rect (make-dim 0 65 #t) (make-dim 0 47 #t))
+              (make-rect (make-dim 0 48 #t) (make-dim 0 47 #t))
+              (make-rect (make-dim 0 63 #t) (make-dim 0 47 #t))
+              (make-rect (make-dim 0 45 #f) (make-dim 0 44 #f))))
+ (list
+  (make-rect (make-dim 0 165.0 true) (make-dim 0 45.0 true))
+  (make-rect (make-dim 165.0 165.0 true) (make-dim 0 45.0 true))
+  (make-rect (make-dim 330.0 164.0 true) (make-dim 0 45.0 true))
+  (make-rect (make-dim 494.0 45 false) (make-dim 0 44 false))))
+
+(test
+ los-equal?
+ (align 'vertical 153.0 33.0
+        (list (make-rect (make-dim 0 55 #f) (make-dim 0 13 #f))
+              (make-rect (make-dim 0 11 #f) (make-dim 0 24 #f))))
+ (list
+  (make-rect (make-dim 0 55 false) (make-dim 0 13 false))
+  (make-rect (make-dim 0 11 false) (make-dim 13 24 false))))
+
+(test
+ los-equal?
+ (align 'vertical 153.0 33.0
+        (list (make-rect (make-dim 0 38 #f) (make-dim 0 13 #f))
+              (make-rect (make-dim 0 11 #f) (make-dim 0 24 #f))))
+ (list
+  (make-rect (make-dim 0 38 false) (make-dim 0 13 false))
+  (make-rect (make-dim 0 11 false) (make-dim 13 24 false))))
+
+(test
+ los-equal?
+ (align 'vertical 152.0 33.0
+        (list (make-rect (make-dim 0 26 #f) (make-dim 0 13 #f))
+              (make-rect (make-dim 0 53 #f) (make-dim 0 24 #f))))
+ (list
+  (make-rect (make-dim 0 26 false) (make-dim 0 13 false))
+  (make-rect (make-dim 0 53 false) (make-dim 13 24 false))))
+
+(test
+ los-equal?
+ (align 'vertical 0 0 empty)
+ empty)
+
+(test
+ los-equal?
+ (align 'vertical 4 0 empty)
+ empty)
+
+(test
+ los-equal?
+ (align 'vertical 0 3 empty)
+ empty)
+
+(test
+ los-equal?
+ (align 'horizontal 35 1 empty)
+ empty)
+
+(test
+ los-equal?
+ (align 'horizontal 0 0
+        (list (make-rect (make-dim 0 4 #f) (make-dim 0 5 #f))))
+ (list (make-rect (make-dim 0 4 #f) (make-dim 0 5 #f))))

collects/embedded-gui/private/tests/test-macro.ss

@@ -0,0 +1,18 @@
+(module test-macro mzscheme
+  
+  (require (lib "etc.ss"))
+  
+  (provide test)
+  
+  ;; test: (lambda (a?) ((a? a? . -> . boolean?) a? a? . -> . (void))
+  ;; tests to see if the expression is true and prints and error if it's not
+  (define-syntax test
+    (syntax-rules (identity)
+      ((_ test actual expected)
+       (let ([result
+              (with-handlers
+                  ([exn? identity])
+                actual)])
+         (and (not (exn? result))
+              (test result expected))))))
+  )

collects/embedded-gui/private/verthoriz-alignment.ss

@@ -65,10 +65,11 @@
               [(child ($ a:rect ($ a:dim x w _) ($ a:dim y h _)))
                (send child align (+ x x-offset) (+ y y-offset) w h)]))
           
-          (when (and (is-shown?)
-                     (not (empty? children)); this and
-                     (not (zero? width))    ; this should be handled by align later
-                     (not (zero? height)))  ; this one too
+          (when (is-shown?)
+            #;(and (is-shown?)
+                   (not (empty? children)); this and
+                   (not (zero? width))    ; this should be handled by align later
+                   (not (zero? height)))  ; this one too
             (for-each move/resize
                       children
                       (a:align type width height