From 82c83e1f83bb32a84b2563468d87331578f29947 Mon Sep 17 00:00:00 2001 From: Mike MacHenry Date: Tue, 16 Dec 2003 22:05:58 +0000 Subject: [PATCH] added stretchable-editor-snips original commit: 19ce29b34ee0fc6c9e4082c462e1cd51133c0be5 --- .../aligned-editor-container.ss | 11 +- .../private/aligned-pasteboard/alignment.ss | 15 ++- .../geometry-managed-pasteboard.ss | 22 +--- .../private/aligned-pasteboard/interface.ss | 4 + .../stretchable-editor-snip.ss | 112 ++++++++++++++++++ .../aligned-pasteboard/tests/example-min.ss | 16 +++ .../aligned-pasteboard/tests/minimal.ss | 13 +- .../tests/more-tests-min-stretchable.ss | 40 +++++++ .../tests/stretchable-editor-snip-test-min.ss | 25 ++++ .../tests/stretchable-editor-snip-test.ss | 30 +++++ .../aligned-pasteboard/tests/test-snip-lib.ss | 3 +- 11 files changed, 253 insertions(+), 38 deletions(-) create mode 100644 collects/mrlib/private/aligned-pasteboard/stretchable-editor-snip.ss create mode 100644 collects/mrlib/private/aligned-pasteboard/tests/example-min.ss create mode 100644 collects/mrlib/private/aligned-pasteboard/tests/more-tests-min-stretchable.ss create mode 100644 collects/mrlib/private/aligned-pasteboard/tests/stretchable-editor-snip-test-min.ss create mode 100644 collects/mrlib/private/aligned-pasteboard/tests/stretchable-editor-snip-test.ss diff --git a/collects/mrlib/private/aligned-pasteboard/aligned-editor-container.ss b/collects/mrlib/private/aligned-pasteboard/aligned-editor-container.ss index 4e939bd4..9eac86bc 100644 --- a/collects/mrlib/private/aligned-pasteboard/aligned-editor-container.ss +++ b/collects/mrlib/private/aligned-pasteboard/aligned-editor-container.ss @@ -11,8 +11,7 @@ (provide aligned-editor-canvas% - aligned-editor-snip% - aligned-snip-mixin) + aligned-editor-snip%) ;; a canvas that can contain an aligned-pasteboard<%> ;; STATUS: When both min-width and min-height change the size of the canvas @@ -114,7 +113,10 @@ ;; called to resize the snip (rename [super-resize resize]) (define/override (resize width height) - (super-resize width height) + (super-resize width height)) + + (define/public (stretch width height) + (resize width height) (let ([left (box 0)] [top (box 0)] [right (box 0)] @@ -192,7 +194,4 @@ (send ed realign w h)))) (super-new))) - - ;not-yet-implemented - (define aligned-snip-mixin (lambda (x) x)) ) diff --git a/collects/mrlib/private/aligned-pasteboard/alignment.ss b/collects/mrlib/private/aligned-pasteboard/alignment.ss index 5c94ba34..fbfa6690 100644 --- a/collects/mrlib/private/aligned-pasteboard/alignment.ss +++ b/collects/mrlib/private/aligned-pasteboard/alignment.ss @@ -40,7 +40,8 @@ (provide/contract (align ((symbols 'horizontal 'vertical) positive? positive? (listof rect?) - . -> . (listof rect?)))) + . -> . (listof rect?))) + (rect-print ((listof rect?) . -> . void?))) ;; align the rectangles within the given space (define (align type width height rects) @@ -145,4 +146,16 @@ (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)])) ) diff --git a/collects/mrlib/private/aligned-pasteboard/geometry-managed-pasteboard.ss b/collects/mrlib/private/aligned-pasteboard/geometry-managed-pasteboard.ss index d06c45f3..c7be6d84 100644 --- a/collects/mrlib/private/aligned-pasteboard/geometry-managed-pasteboard.ss +++ b/collects/mrlib/private/aligned-pasteboard/geometry-managed-pasteboard.ss @@ -7,24 +7,12 @@ (lib "etc.ss") (lib "match.ss") (lib "mred.ss" "mred") + "aligned-editor-container.ss" "interface.ss" "alignment.ss" "snip-lib.ss" "pasteboard-lib.ss") - (define f 0) - (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)])) - (provide/contract (make-aligned-pasteboard ((symbols 'vertical 'horizontal) . -> . class?))) ;; mixin to add geometry management to pasteboard with the give type of alignement @@ -54,7 +42,7 @@ (dynamic-let ([ignore-resizing? true]) (for-each-snip (lambda (s) - (if (is-a? s stretchable-snip<%>) + (if (is-a? s aligned-editor-snip%) (send s set-aligned-min-sizes))) (find-first-snip)) (set!-values (aligned-min-width aligned-min-height) @@ -103,10 +91,8 @@ ($ dim x width stretchable-width?) ($ dim y height stretchable-height?))) (move-to snip x y) - ;; Maybe I don't need to resize it if it's aligned-pasteboard-parent<%> and only if it's - ;; a stretchable snip. - (when (or stretchable-height? stretchable-width? (is-a? snip aligned-pasteboard-parent<%>)) - (resize snip width height))])) + (when (is-a? snip stretchable-snip<%>) + (send snip stretch width height))])) ;;;;;;;;;; ;; Events diff --git a/collects/mrlib/private/aligned-pasteboard/interface.ss b/collects/mrlib/private/aligned-pasteboard/interface.ss index fc6e7ba8..c783ad35 100644 --- a/collects/mrlib/private/aligned-pasteboard/interface.ss +++ b/collects/mrlib/private/aligned-pasteboard/interface.ss @@ -72,6 +72,10 @@ ;; that do not implement stretchable-snip<%> will simply not be stretched. (define stretchable-snip<%> (interface () + ;; (positive? positive? . -> . void?) + ;; called by the parent editor to stretch the snip to an specific size + stretch + ;; get-aligned-min-width (-> positive?) ;; get the minimum width of the snip get-aligned-min-width diff --git a/collects/mrlib/private/aligned-pasteboard/stretchable-editor-snip.ss b/collects/mrlib/private/aligned-pasteboard/stretchable-editor-snip.ss new file mode 100644 index 00000000..1413b647 --- /dev/null +++ b/collects/mrlib/private/aligned-pasteboard/stretchable-editor-snip.ss @@ -0,0 +1,112 @@ +(module stretchable-editor-snip mzscheme + + (provide + stretchable-editor-snip% + stretchable-editor-snip-mixin) + + (require + (lib "class.ss") + (lib "mred.ss" "mred") + (lib "etc.ss") + "snip-lib.ss" + "interface.ss") + + (define (stretchable-editor-snip-mixin super%) + (class* super% (stretchable-snip<%>) + + (init + (stretchable-width true) + (stretchable-height true)) + + (field + (aligned-min-width 0) + (aligned-min-height 0) + (stretchable-width-field stretchable-width) + (stretchable-height-field stretchable-height)) + + (public (stretchable-width-method stretchable-width) + (stretchable-height-method stretchable-height)) + + ;; stretchable-width (case-> (Boolean . -> . (void)) (-> Boolean)) + ;; get or set the stretchablity of the pasteboards width + (define stretchable-width-method + (case-lambda + [(value) (set! stretchable-width-field value)] + [() stretchable-width-field])) + + ;; stretchable-height (case-> (Boolean . -> .(void)) (-> Boolean)) + ;; get or set the stretchablity of the pasteboards height + (define stretchable-height-method + (case-lambda + [(value) (set! stretchable-height-field value)] + [() stretchable-height-field])) + + (define/public (get-aligned-min-width) aligned-min-width) + (define/public (get-aligned-min-height) aligned-min-height) + + (inherit get-margin get-editor get-admin) + (define/override (resize w h) + (set! aligned-min-width w) + (set! aligned-min-height h) + (super-resize w h)) + + (define/public (stretch w h) + (super-resize w h)) + + (rename [super-get-extent get-extent]) + (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 (is-a? (get-editor) text%) + (set-box! w (sub1 (unbox w)))) + (go)) + + (define/override (set-min-width w) + ;; account for margin !!!!!! + (send (get-editor) set-min-width w)) + + (define/override (set-min-height h) + ;; account for margin !!!!!! + (send (get-editor) set-min-height h)) + + (rename [super-set-min-width set-min-width] + [super-set-min-height set-min-height]) + (define/public (super-resize w h) + (let ((top (box 0)) + (bot (box 0)) + (lef (box 0)) + (rit (box 0))) + (get-margin top bot lef rit) + (let ((w (max (- w (unbox lef) (unbox rit)) 0)) + (h (max (- h (unbox top) (unbox bot)) 0)) + (e (get-editor)) + (a (get-admin))) + ;; subtracting 1 from W seems to make it act more like the editor-snip + ;; because the C code has a hack to sub1 to make it look better. I am not + ;; sure if this change here is sound and works for every part of this + ;; class. + (super-set-min-width w) + (super-set-min-height h) + (when a (send a resized this #t))))) + + ;; call this from within get extent and use the values it produces by subtracting the + ;; margin instead of calling the editors get-extent and adding the margin. + (define (go) + (let ([w (box 0)] + [h (box 0)] + (top (box 0)) + (bot (box 0)) + (lef (box 0)) + (rit (box 0))) + (get-margin top bot lef rit) + (send (get-editor) get-extent w h) + (set! aligned-min-width (+ (unbox w) (unbox lef) (unbox rit))) + (set! aligned-min-height (+ (unbox h) (unbox top) (unbox rit))))) + + (super-new) + (inherit get-min-width get-min-height) + (set-min-width (get-min-width)) + (set-min-height (get-min-height)))) + + (define stretchable-editor-snip% + (stretchable-editor-snip-mixin + editor-snip%))) \ No newline at end of file diff --git a/collects/mrlib/private/aligned-pasteboard/tests/example-min.ss b/collects/mrlib/private/aligned-pasteboard/tests/example-min.ss new file mode 100644 index 00000000..84ac771c --- /dev/null +++ b/collects/mrlib/private/aligned-pasteboard/tests/example-min.ss @@ -0,0 +1,16 @@ +(require + (lib "class.ss") + (lib "mred.ss" "mred") + (lib "etc.ss") + "../aligned-pasteboard.ss" + "../aligned-editor-container.ss") + +(define f (new frame% (label "") (width 400) (height 400))) +(define e (new horizontal-pasteboard%)) +(define c (new aligned-editor-canvas% (parent f) (editor e))) +(define vp1 (new vertical-pasteboard%)) +(define ae-snip1 (new aligned-editor-snip% (editor vp1))) +(define t-snip1 (new editor-snip% (editor (new text%)))) +(send e insert ae-snip1 false) +(send vp1 insert t-snip1 false) +(send f show true) \ No newline at end of file diff --git a/collects/mrlib/private/aligned-pasteboard/tests/minimal.ss b/collects/mrlib/private/aligned-pasteboard/tests/minimal.ss index b55e58db..9a5ac83a 100644 --- a/collects/mrlib/private/aligned-pasteboard/tests/minimal.ss +++ b/collects/mrlib/private/aligned-pasteboard/tests/minimal.ss @@ -2,21 +2,12 @@ "../aligned-editor-container.ss" "../aligned-pasteboard.ss") -(define my-string-snip% - (class string-snip% - (init-field label) - (rename [super-size-cache-invalid size-cache-invalid]) - (define/override (size-cache-invalid) - (mytrace size-cache-invalid () - (super-size-cache-invalid))) - (super-make-object label))) - (define f (new frame% (label "test") (width 200) (height 200))) (define e (new vertical-pasteboard%)) (define c (new aligned-editor-canvas% (editor e) (parent f))) (define pb (new vertical-pasteboard%)) (define s (new aligned-editor-snip% (editor pb) (stretchable-height #f) (stretchable-width #f))) -(send pb insert (new my-string-snip% (label "Long snip"))) -(send pb insert (new my-string-snip% (label "Longer snip"))) +(send pb insert (make-object string-snip% "Long snip")) +(send pb insert (make-object string-snip% "Longer snip")) (send e insert s) (send f show #t) diff --git a/collects/mrlib/private/aligned-pasteboard/tests/more-tests-min-stretchable.ss b/collects/mrlib/private/aligned-pasteboard/tests/more-tests-min-stretchable.ss new file mode 100644 index 00000000..49d76997 --- /dev/null +++ b/collects/mrlib/private/aligned-pasteboard/tests/more-tests-min-stretchable.ss @@ -0,0 +1,40 @@ +(require + "../aligned-editor-container.ss" + "../aligned-pasteboard.ss") + +(define editor (new vertical-pasteboard%)) +(define pb (new horizontal-pasteboard%)) +(send* pb + (insert (make-object string-snip% "Call") #f) + (insert (new editor-snip% (editor (new text%))) #f)) +(send editor insert (new aligned-editor-snip% (editor pb))) +(define f (new frame% (label "more-test-jacob") (width 200) (height 200))) +(define e (new vertical-pasteboard%)) +(define c (new aligned-editor-canvas% (editor e) (parent f))) +(define t (new aligned-editor-snip% + (editor editor))) +(send e insert t) +(send f show #t) + +;;;;;;;;;; +;; exploration +(require "../snip-lib.ss") +(define t-e (send t get-editor)) +(send t-e get-aligned-min-width) +(send t get-aligned-min-width) +(define fs (send t-e find-first-snip)) +(define fs (send t-e find-first-snip)) +(define fs-e (send fs get-editor)) +(send fs-e find-first-snip) +(send fs-e get-aligned-min-width) +(send fs get-aligned-min-width) +(define (margin snip) + (let ([left (box 0)] + [top (box 0)] + [right (box 0)] + [bottom (box 0)]) + (send snip get-margin left top right bottom) + (list (cons 'left (unbox left)) + (cons 'right (unbox right)) + (cons 'top (unbox top)) + (cons 'bottom (unbox bottom))))) \ No newline at end of file diff --git a/collects/mrlib/private/aligned-pasteboard/tests/stretchable-editor-snip-test-min.ss b/collects/mrlib/private/aligned-pasteboard/tests/stretchable-editor-snip-test-min.ss new file mode 100644 index 00000000..eb61d4c6 --- /dev/null +++ b/collects/mrlib/private/aligned-pasteboard/tests/stretchable-editor-snip-test-min.ss @@ -0,0 +1,25 @@ +(require + "../aligned-pasteboard.ss" + "../aligned-editor-container.ss" + "../stretchable-editor-snip.ss" + "../snip-lib.ss") + +(define f (new frame% (label "") (width 500) (height 500))) +(define e (new vertical-pasteboard%)) +(define c (new aligned-editor-canvas% (parent f) (editor e))) + +(define pb (new vertical-pasteboard%)) +(define aes (new aligned-editor-snip% + (editor pb) + (stretchable-width #f) + (stretchable-height #f))) +(define t2 (new text%)) +(define ses (new stretchable-editor-snip% + (editor t2) + (min-width 100) + (stretchable-width #t) + (stretchable-height #f))) +(send e insert aes) +(send pb insert ses) + +(send f show #t) \ No newline at end of file diff --git a/collects/mrlib/private/aligned-pasteboard/tests/stretchable-editor-snip-test.ss b/collects/mrlib/private/aligned-pasteboard/tests/stretchable-editor-snip-test.ss new file mode 100644 index 00000000..f6eaad31 --- /dev/null +++ b/collects/mrlib/private/aligned-pasteboard/tests/stretchable-editor-snip-test.ss @@ -0,0 +1,30 @@ +(require + "../aligned-pasteboard.ss" + "../aligned-editor-container.ss" + "../stretchable-editor-snip.ss" + "../snip-lib.ss") + +(define f (new frame% (label "") (width 500) (height 500))) +(define e (new vertical-pasteboard%)) +(define c (new aligned-editor-canvas% (parent f) (editor e))) + +(define pb (new vertical-pasteboard%)) +(define aes (new aligned-editor-snip% + (editor pb) + (stretchable-width #f) + (stretchable-height #f))) +(define t1 (new text%)) +(define es (new editor-snip% (editor t1))) +(define t2 (new text%)) +(define ses (new stretchable-editor-snip% + (editor t2) + (stretchable-width #t) + (stretchable-height #f))) + +(send t1 insert "String") +(send e insert aes) +(send pb insert es) +(send pb insert ses) + +(send f show #t) +(equal? (snip-width es) (snip-width ses)) \ No newline at end of file diff --git a/collects/mrlib/private/aligned-pasteboard/tests/test-snip-lib.ss b/collects/mrlib/private/aligned-pasteboard/tests/test-snip-lib.ss index c319b2ed..0eb51b2c 100644 --- a/collects/mrlib/private/aligned-pasteboard/tests/test-snip-lib.ss +++ b/collects/mrlib/private/aligned-pasteboard/tests/test-snip-lib.ss @@ -1,6 +1,5 @@ (require (lib "etc.ss") - (lib "devel.ss" "mike") (lib "class.ss") (lib "mred.ss" "mred") "../snip-lib.ss" @@ -205,4 +204,4 @@ (send frame show false) ) -(printf "tests done~n") \ No newline at end of file +(printf "tests done~n")