Some renames for this dusty code.
original commit: d8fec78585aac51145b12cf486a38d53375e8c21
This commit is contained in:
Eli Barzilay
parent
49be64a3e3
commit
560ff92c71
|
|
@ -0,0 +1,38 @@
|
|||
(require
|
||||
mzlib/class
|
||||
mzlib/list
|
||||
mred
|
||||
mzlib/etc
|
||||
"../aligned-editor-container.ss"
|
||||
"../aligned-pasteboard.ss"
|
||||
"../snip-lib.ss")
|
||||
|
||||
(define f (new frame% (label "test") (width 200) (height 200)))
|
||||
(define e (new text%))
|
||||
(define c (new editor-canvas% (editor e) (parent f)))
|
||||
|
||||
(define vpb1 (new vertical-pasteboard%))
|
||||
(define aes1 (new aligned-editor-snip% (editor vpb1)))
|
||||
|
||||
(define vpb2 (new vertical-pasteboard%))
|
||||
(define aes2 (new aligned-editor-snip% (editor vpb2)))
|
||||
|
||||
(define t (new text%))
|
||||
(define es (new editor-snip% (editor t)))
|
||||
|
||||
(send vpb1 insert aes2 false)
|
||||
(send vpb2 insert es)
|
||||
(send e insert aes1)
|
||||
(send f show #t)
|
||||
(send f show #f)
|
||||
|
||||
(send t begin-edit-sequence)
|
||||
(send e begin-edit-sequence)
|
||||
(send t insert "1\n")
|
||||
(send t insert "1")
|
||||
(send e end-edit-sequence)
|
||||
(send t end-edit-sequence)
|
||||
|
||||
(>= (send vpb1 get-aligned-min-height)
|
||||
(send vpb2 get-aligned-min-height)
|
||||
(snip-height es))
|
||||
|
|
@ -1,16 +0,0 @@
|
|||
(require
|
||||
"../aligned-pasteboard.ss"
|
||||
"../aligned-editor-container.ss")
|
||||
|
||||
(define (converges? x) #t)
|
||||
|
||||
(converges?
|
||||
(let* ((f (new frame% (label "test")))
|
||||
(e (new text%))
|
||||
(c (new editor-canvas% (editor e) (parent f)))
|
||||
(pb (new vertical-pasteboard%))
|
||||
(actual (new text%))
|
||||
(act-line (new aligned-editor-snip% (editor (new vertical-pasteboard%))))
|
||||
(t (new aligned-editor-snip% (editor pb))))
|
||||
(send e insert t)
|
||||
(send* pb (begin-edit-sequence) (insert act-line #f) (end-edit-sequence))))
|
||||
|
|
@ -1,4 +0,0 @@
|
|||
(require mrlib/aligned-pasteboard)
|
||||
(with-handlers ([exn? (lambda (x) #f)])
|
||||
(send (new pasteboard%) insert (new aligned-editor-snip% (editor (new horizontal-pasteboard%))))
|
||||
#t)
|
||||
|
|
@ -1,251 +0,0 @@
|
|||
|
||||
(require
|
||||
mzlib/etc
|
||||
mzlib/list
|
||||
mzlib/match
|
||||
"../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))))
|
||||
|
|
@ -1,207 +0,0 @@
|
|||
|
||||
(require
|
||||
mzlib/etc
|
||||
mzlib/class
|
||||
"test-macro.ss"
|
||||
mred
|
||||
"../pasteboard-lib.ss"
|
||||
"../aligned-pasteboard.ss"
|
||||
"../aligned-editor-container.ss")
|
||||
|
||||
;; (printf "running tests for pasteboard-lib.ss~n")
|
||||
|
||||
;;pasteboard-root: ((is-a?/c aligned-pasteboard<%>) -> (is-a?/c aligned-pasteboard<%>))
|
||||
;;gets the top most aligned pasteboard in the tree of pasteboards and containers
|
||||
|
||||
(let*
|
||||
([pb1 (instantiate vertical-pasteboard% ())]
|
||||
[pb2 (instantiate horizontal-pasteboard% ())]
|
||||
[pb3 (instantiate vertical-pasteboard% ())]
|
||||
[es2 (instantiate aligned-editor-snip% () (editor pb2))]
|
||||
[es3 (instantiate aligned-editor-snip% () (editor pb3))]
|
||||
|
||||
[frame (instantiate frame% () (label "l") (width 10) (height 10))]
|
||||
[canvas (instantiate aligned-editor-canvas% () (parent frame) (editor pb1))])
|
||||
|
||||
(send pb1 insert es2)
|
||||
(send pb2 insert es3)
|
||||
|
||||
(test
|
||||
equal?
|
||||
(pasteboard-root pb3)
|
||||
pb1)
|
||||
|
||||
(test
|
||||
equal?
|
||||
(pasteboard-root pb2)
|
||||
pb1)
|
||||
|
||||
(test
|
||||
equal?
|
||||
(pasteboard-root pb1)
|
||||
pb1)
|
||||
)
|
||||
|
||||
(let*
|
||||
([pb1 (instantiate vertical-pasteboard% ())]
|
||||
[pb2 (instantiate horizontal-pasteboard% ())]
|
||||
[pb3 (instantiate vertical-pasteboard% ())]
|
||||
[es1 (instantiate aligned-editor-snip% () (editor pb1))]
|
||||
[es3 (instantiate aligned-editor-snip% () (editor pb3))]
|
||||
|
||||
[frame (instantiate frame% () (label "l") (width 10) (height 10))]
|
||||
[canvas (instantiate aligned-editor-canvas% () (parent frame) (editor pb2))])
|
||||
|
||||
(send pb2 insert es1)
|
||||
(send pb2 insert es3)
|
||||
|
||||
(test
|
||||
equal?
|
||||
(pasteboard-root pb3)
|
||||
pb2)
|
||||
|
||||
(test
|
||||
equal?
|
||||
(pasteboard-root pb2)
|
||||
pb2)
|
||||
|
||||
(test
|
||||
equal?
|
||||
(pasteboard-root pb1)
|
||||
pb2)
|
||||
)
|
||||
|
||||
;;pasteboard-parent: ((is-a?/c pasteboard%) . -> . (is-a?/c aligned-editor-container<%>))
|
||||
;;gets the canvas or snip that the pasteboard is displayed in
|
||||
(let*
|
||||
([pb1 (instantiate vertical-pasteboard% ())]
|
||||
[pb2 (instantiate horizontal-pasteboard% ())]
|
||||
[pb3 (instantiate vertical-pasteboard% ())]
|
||||
[es2 (instantiate aligned-editor-snip% () (editor pb2))]
|
||||
[es3 (instantiate aligned-editor-snip% () (editor pb3))]
|
||||
|
||||
[frame (instantiate frame% () (label "l") (width 10) (height 10))]
|
||||
[canvas (instantiate aligned-editor-canvas% () (parent frame) (editor pb1))])
|
||||
|
||||
(send pb1 insert es2)
|
||||
(send pb2 insert es3)
|
||||
|
||||
(test
|
||||
equal?
|
||||
(pasteboard-parent pb1)
|
||||
canvas)
|
||||
|
||||
(test
|
||||
equal?
|
||||
(pasteboard-parent pb2)
|
||||
es2)
|
||||
|
||||
(test
|
||||
equal?
|
||||
(pasteboard-parent pb3)
|
||||
es3)
|
||||
)
|
||||
|
||||
(let*
|
||||
([pb1 (instantiate vertical-pasteboard% ())]
|
||||
[pb2 (instantiate horizontal-pasteboard% ())]
|
||||
[pb3 (instantiate vertical-pasteboard% ())]
|
||||
[es2 (instantiate aligned-editor-snip% () (editor pb2))]
|
||||
[es3 (instantiate aligned-editor-snip% () (editor pb3))]
|
||||
|
||||
[frame (instantiate frame% () (label "l") (width 10) (height 10))]
|
||||
[canvas (instantiate aligned-editor-canvas% () (parent frame) (editor pb1))])
|
||||
|
||||
(send pb1 insert es2)
|
||||
(send pb1 insert es3)
|
||||
|
||||
(test
|
||||
equal?
|
||||
(pasteboard-parent pb1)
|
||||
canvas)
|
||||
|
||||
(test
|
||||
equal?
|
||||
(pasteboard-parent pb2)
|
||||
es2)
|
||||
|
||||
(test
|
||||
equal?
|
||||
(pasteboard-parent pb3)
|
||||
es3)
|
||||
)
|
||||
|
||||
#|
|
||||
;;num-sizeable: ((is-a?/c aligned-pasteboard<%>) . -> . number?)
|
||||
;;the number of snips in the pasteboard that can be resized
|
||||
(let*
|
||||
([pb1 (instantiate vertical-pasteboard% ())]
|
||||
[es1 (instantiate editor-snip% () (editor (instantiate text% ())))]
|
||||
[es2 (instantiate editor-snip% () (editor (instantiate text% ())))]
|
||||
[es3 (instantiate editor-snip% () (editor (instantiate text% ())))]
|
||||
[es4 (instantiate editor-snip% () (editor (instantiate text% ())))]
|
||||
|
||||
[frame (instantiate frame% () (label "l") (width 10) (height 10))]
|
||||
[canvas (instantiate aligned-editor-canvas% () (parent frame) (editor pb1))])
|
||||
(send frame show true)
|
||||
|
||||
(send pb1 insert es1)
|
||||
(send pb1 insert es2)
|
||||
(send pb1 insert es3)
|
||||
(send pb1 insert es4)
|
||||
|
||||
(test
|
||||
=
|
||||
(num-sizeable pb1)
|
||||
0)
|
||||
|
||||
(send pb1 delete es1)
|
||||
|
||||
(test
|
||||
=
|
||||
(num-sizeable pb1)
|
||||
0)
|
||||
|
||||
(send frame show false)
|
||||
)
|
||||
|
||||
(let*
|
||||
([pb1 (instantiate vertical-pasteboard% ())]
|
||||
[es1 (instantiate aligned-editor-snip% () (editor (instantiate vertical-pasteboard% ())))]
|
||||
[es2 (instantiate aligned-editor-snip% () (editor (instantiate vertical-pasteboard% ())))]
|
||||
[es3 (instantiate aligned-editor-snip% () (editor (instantiate vertical-pasteboard% ())))]
|
||||
[es4 (instantiate aligned-editor-snip% () (editor (instantiate vertical-pasteboard% ())))]
|
||||
|
||||
[frame (instantiate frame% () (label "l") (width 10) (height 10))]
|
||||
[canvas (instantiate aligned-editor-canvas% () (parent frame) (editor pb1))])
|
||||
(send frame show true)
|
||||
|
||||
(send pb1 insert es1)
|
||||
(send pb1 insert es2)
|
||||
(send pb1 insert es3)
|
||||
(send pb1 insert es4)
|
||||
|
||||
(test
|
||||
=
|
||||
(num-sizeable pb1)
|
||||
4)
|
||||
|
||||
(send pb1 delete es1)
|
||||
|
||||
(test
|
||||
=
|
||||
(num-sizeable pb1)
|
||||
3)
|
||||
|
||||
(send pb1 erase)
|
||||
|
||||
(test
|
||||
=
|
||||
(num-sizeable pb1)
|
||||
0)
|
||||
|
||||
(send frame show false)
|
||||
)
|
||||
|
||||
(printf "tests done~n")
|
||||
|#
|
||||
|
|
@ -1,208 +0,0 @@
|
|||
|
||||
(require
|
||||
mzlib/etc
|
||||
mzlib/class
|
||||
mred
|
||||
"../snip-lib.ss"
|
||||
"../aligned-pasteboard.ss"
|
||||
"../aligned-editor-container.ss"
|
||||
"test-macro.ss")
|
||||
|
||||
;;(printf "running tests for snip-lib.ss~n")
|
||||
|
||||
;;snip-width: ((is-a?/c aligned-pasteboard<%>) (is-a?/c snip%) . -> . number?)
|
||||
;;the width of a snip in the given pasteboard
|
||||
(let*
|
||||
([pb1 (instantiate vertical-pasteboard% ())]
|
||||
[es1 (instantiate editor-snip% () (editor pb1))]
|
||||
[pb2 (instantiate vertical-pasteboard% ())]
|
||||
|
||||
[frame (instantiate frame% () (label "l") (width 10) (height 10))]
|
||||
[canvas (instantiate aligned-editor-canvas% () (parent frame) (editor pb2))])
|
||||
(send frame show true)
|
||||
|
||||
(send pb2 insert es1)
|
||||
(send es1 resize 20 20)
|
||||
(sleep/yield 1)
|
||||
(test
|
||||
equal?
|
||||
(snip-width #;pb2 es1)
|
||||
20.0)
|
||||
|
||||
(send es1 resize 200 90)
|
||||
(sleep/yield 1)
|
||||
(test
|
||||
equal?
|
||||
(snip-width #;pb2 es1)
|
||||
200.0)
|
||||
|
||||
(send frame show false)
|
||||
)
|
||||
|
||||
;;snip-height: ((is-a?/c aligned-pasteboard<%>) (is-a?/c snip%) . -> . number?)
|
||||
;;the height of a snip in the given pasteboard
|
||||
(let*
|
||||
([pb1 (instantiate vertical-pasteboard% ())]
|
||||
[es1 (instantiate editor-snip% () (editor pb1))]
|
||||
[pb2 (instantiate vertical-pasteboard% ())]
|
||||
|
||||
[frame (instantiate frame% () (label "l") (width 10) (height 10))]
|
||||
[canvas (instantiate aligned-editor-canvas% () (parent frame) (editor pb2))])
|
||||
(send frame show true)
|
||||
|
||||
(send pb2 insert es1)
|
||||
(send es1 resize 20 20)
|
||||
(sleep/yield 1)
|
||||
(test
|
||||
equal?
|
||||
(snip-height #;pb2 es1)
|
||||
20.0)
|
||||
|
||||
(send es1 resize 200 90)
|
||||
(sleep/yield 1)
|
||||
(test
|
||||
equal?
|
||||
(snip-height #;pb2 es1)
|
||||
90.0)
|
||||
|
||||
(send frame show false)
|
||||
)
|
||||
|
||||
;;snip-min-width: ((is-a?/c snip%) . -> . number?)
|
||||
;;the minimum width of the snip
|
||||
|
||||
;;snip-min-height: ((is-a?/c snip%) . -> . number?)
|
||||
;;the minimum height of the snip
|
||||
|
||||
;;snip-parent: ((is-a?/c snip%) . -> . (is-a?/c editor<%>))
|
||||
;;the pasteboard that contains the snip
|
||||
(let*
|
||||
([pb1 (instantiate pasteboard% ())]
|
||||
[es1 (instantiate editor-snip% () (editor pb1))]
|
||||
[pb2 (instantiate pasteboard% ())]
|
||||
|
||||
[frame (instantiate frame% () (label "l") (width 10) (height 10))]
|
||||
[canvas (instantiate editor-canvas% () (parent frame) (editor pb2))])
|
||||
(send frame show true)
|
||||
|
||||
(send pb2 insert es1)
|
||||
|
||||
(test
|
||||
equal?
|
||||
(snip-parent es1)
|
||||
pb2)
|
||||
|
||||
(send frame show false)
|
||||
)
|
||||
|
||||
(let*
|
||||
([pb1 (instantiate horizontal-pasteboard% ())]
|
||||
[pb2 (instantiate horizontal-pasteboard% ())]
|
||||
[pb3 (instantiate horizontal-pasteboard% ())]
|
||||
[pb4 (instantiate horizontal-pasteboard% ())]
|
||||
[pb5 (instantiate horizontal-pasteboard% ())]
|
||||
[es2 (instantiate aligned-editor-snip% () (editor pb2))]
|
||||
[es3 (instantiate aligned-editor-snip% () (editor pb3))]
|
||||
[es4 (instantiate aligned-editor-snip% () (editor pb4))]
|
||||
[es5 (instantiate aligned-editor-snip% () (editor pb5))]
|
||||
|
||||
[frame (instantiate frame% () (label "l") (width 10) (height 10))]
|
||||
[canvas (instantiate aligned-editor-canvas% () (parent frame) (editor pb1))])
|
||||
(send frame show true)
|
||||
(send pb1 insert es2)
|
||||
(send pb2 insert es3)
|
||||
(send pb3 insert es4)
|
||||
(send pb4 insert es5)
|
||||
|
||||
(test
|
||||
equal?
|
||||
(snip-parent es2)
|
||||
pb1)
|
||||
|
||||
(test
|
||||
equal?
|
||||
(snip-parent es3)
|
||||
pb2)
|
||||
|
||||
(test
|
||||
equal?
|
||||
(snip-parent es4)
|
||||
pb3)
|
||||
|
||||
(test
|
||||
equal?
|
||||
(snip-parent es5)
|
||||
pb4)
|
||||
|
||||
(send frame show false)
|
||||
)
|
||||
|
||||
;;fold-snip: (lambda (b?) ((any? b? . -> . b?) b? (is-a?/c snip%) . -> . b?))
|
||||
;;the application of f on all snips from snip to the end in a foldl foldr mannor
|
||||
(let*
|
||||
([pb1 (instantiate vertical-pasteboard% ())]
|
||||
[es1 (instantiate editor-snip% () (editor (instantiate text% ())))]
|
||||
[es2 (instantiate editor-snip% () (editor (instantiate text% ())))]
|
||||
[es3 (instantiate editor-snip% () (editor (instantiate text% ())))]
|
||||
[es4 (instantiate editor-snip% () (editor (instantiate text% ())))]
|
||||
|
||||
[frame (instantiate frame% () (label "l") (width 10) (height 10))]
|
||||
[canvas (instantiate aligned-editor-canvas% () (parent frame) (editor pb1))])
|
||||
(send frame show true)
|
||||
|
||||
(send pb1 insert es1)
|
||||
(send pb1 insert es2)
|
||||
(send pb1 insert es3)
|
||||
(send pb1 insert es4)
|
||||
|
||||
(send es1 resize 100 100)
|
||||
(send es2 resize 100 100)
|
||||
(send es3 resize 100 100)
|
||||
(send es4 resize 100 100)
|
||||
|
||||
(test
|
||||
=
|
||||
(fold-snip
|
||||
(lambda (snip total-height)
|
||||
(+ (snip-height #;pb1 snip)
|
||||
total-height))
|
||||
0
|
||||
es1)
|
||||
400)
|
||||
|
||||
(send frame show false)
|
||||
)
|
||||
|
||||
|
||||
;;for-each-snip: (((is-a?/c snip%) . -> . (void)) (is-a/c? snip%) . -> . (void))
|
||||
;;applies the function to all the snips
|
||||
(let*
|
||||
([pb1 (instantiate vertical-pasteboard% ())]
|
||||
[es1 (instantiate editor-snip% () (editor (instantiate text% ())))]
|
||||
[es2 (instantiate editor-snip% () (editor (instantiate text% ())))]
|
||||
[es3 (instantiate editor-snip% () (editor (instantiate text% ())))]
|
||||
[es4 (instantiate editor-snip% () (editor (instantiate text% ())))]
|
||||
|
||||
[frame (instantiate frame% () (label "l") (width 10) (height 10))]
|
||||
[canvas (instantiate aligned-editor-canvas% () (parent frame) (editor pb1))]
|
||||
[count 0])
|
||||
(send frame show true)
|
||||
|
||||
(send pb1 insert es1)
|
||||
(send pb1 insert es2)
|
||||
(send pb1 insert es3)
|
||||
(send pb1 insert es4)
|
||||
|
||||
(for-each-snip
|
||||
(lambda (snip)
|
||||
(set! count (add1 count)))
|
||||
es1)
|
||||
|
||||
(test
|
||||
=
|
||||
count
|
||||
4)
|
||||
|
||||
(send frame show false)
|
||||
)
|
||||
;;(printf "tests done~n")
|
||||
|
|
@ -1,231 +0,0 @@
|
|||
(require
|
||||
mzlib/class
|
||||
mred
|
||||
mzlib/etc
|
||||
mzlib/list
|
||||
"../aligned-pasteboard.ss"
|
||||
"../aligned-editor-container.ss"
|
||||
"snip-dumper.ss")
|
||||
|
||||
|
||||
|
||||
; ;;
|
||||
; ;
|
||||
; ;
|
||||
; ;;;;; ;; ;; ;;;;;;;;;;;;;; ;;; ; ;;;;; ;;;;
|
||||
; ; ; ;;;; ; ; ; ; ;; ;; ; ; ; ; ;
|
||||
; ;;;;;; ;; ;;;; ; ; ; ; ; ; ;;;;;; ;;;;
|
||||
; ; ;; ; ; ; ; ; ; ; ; ; ;
|
||||
; ;; ; ; ; ; ; ; ; ; ;; ;; ; ;; ; ; ;
|
||||
; ;;;; ;; ;; ;;;;;;; ;; ;;; ;;; ;;;;; ;;;; ;;;;
|
||||
; ;
|
||||
; ;;;
|
||||
|
||||
(printf "running test1.ss~n")
|
||||
|
||||
(define frame
|
||||
(instantiate frame% ()
|
||||
(label "Frame")
|
||||
(width 400)
|
||||
(height 400)))
|
||||
|
||||
(define pasteboard
|
||||
(instantiate horizontal-pasteboard% ()))
|
||||
|
||||
(define canvas
|
||||
(instantiate aligned-editor-canvas% ()
|
||||
(parent frame)
|
||||
(editor pasteboard)))
|
||||
|
||||
(define insider
|
||||
(instantiate vertical-pasteboard% ()))
|
||||
|
||||
(define insider2
|
||||
(instantiate vertical-pasteboard% ()))
|
||||
|
||||
(define insider3
|
||||
(instantiate vertical-pasteboard% ()))
|
||||
|
||||
(define insider4
|
||||
(instantiate vertical-pasteboard% ()))
|
||||
|
||||
(define insider5
|
||||
(instantiate vertical-pasteboard% ()))
|
||||
|
||||
(define insider6
|
||||
(instantiate vertical-pasteboard% ()))
|
||||
|
||||
(define insider7
|
||||
(instantiate vertical-pasteboard% ()))
|
||||
|
||||
(define pb-snip
|
||||
(instantiate aligned-editor-snip% ()
|
||||
(editor insider)))
|
||||
|
||||
(define pb-snip2
|
||||
(instantiate aligned-editor-snip% ()
|
||||
(editor insider2)))
|
||||
|
||||
(define pb-snip3
|
||||
(instantiate aligned-editor-snip% ()
|
||||
(editor insider3)))
|
||||
|
||||
(define pb-snip4
|
||||
(instantiate aligned-editor-snip% ()
|
||||
(editor insider4)))
|
||||
|
||||
(define pb-snip5
|
||||
(instantiate aligned-editor-snip% ()
|
||||
(editor insider5)))
|
||||
|
||||
(define pb-snip6
|
||||
(instantiate aligned-editor-snip% ()
|
||||
(editor insider6)))
|
||||
|
||||
(define pb-snip7
|
||||
(instantiate aligned-editor-snip% ()
|
||||
(editor insider7)))
|
||||
|
||||
(define t-snip
|
||||
(instantiate editor-snip% ()
|
||||
(editor
|
||||
(instantiate text% ()))))
|
||||
|
||||
(define i-snip
|
||||
(instantiate image-snip% ()))
|
||||
|
||||
(define i-snip2
|
||||
(instantiate image-snip% ()))
|
||||
|
||||
(define t-snip2
|
||||
(instantiate editor-snip% ()
|
||||
(editor
|
||||
(instantiate text% ()))))
|
||||
(define t-snip3
|
||||
(instantiate editor-snip% ()
|
||||
(editor
|
||||
(instantiate text% ()))))
|
||||
|
||||
(send pasteboard begin-edit-sequence)
|
||||
(send frame show true)
|
||||
(send pasteboard insert pb-snip)
|
||||
(send pasteboard insert t-snip)
|
||||
(send pasteboard insert i-snip)
|
||||
(send pasteboard insert i-snip2)
|
||||
(send pasteboard insert pb-snip2)
|
||||
(send pasteboard insert t-snip2)
|
||||
(send insider insert t-snip3)
|
||||
(send insider2 insert pb-snip3)
|
||||
(send insider2 insert pb-snip4)
|
||||
(send pasteboard insert pb-snip5)
|
||||
(send pasteboard insert pb-snip6)
|
||||
(send pasteboard insert pb-snip7)
|
||||
(send pasteboard end-edit-sequence)
|
||||
|
||||
|
||||
|
||||
|
||||
; ; ;
|
||||
; ; ;
|
||||
;;;;;;; ;;;;; ;;;; ;;;;; ;;;;
|
||||
; ; ; ; ; ; ; ; ;
|
||||
; ; ;;;;;; ;;;; ; ;;;;
|
||||
; ; ; ; ; ;
|
||||
; ; ;; ; ; ; ; ; ;
|
||||
; ;;;;; ;;;; ;;;; ;;;;; ;;;;
|
||||
|
||||
|
||||
|
||||
|
||||
(dump=?
|
||||
(dump-children pasteboard)
|
||||
(list
|
||||
(make-snip-dump 57.0 368.0 0.0 0.0 empty)
|
||||
(make-snip-dump 114.0 368.0 57.0 0.0 empty)
|
||||
(make-snip-dump 171.0 368.0 114.0 0.0 empty)
|
||||
(make-snip-dump 182.0 24.0 171.0 0.0 empty)
|
||||
(make-snip-dump
|
||||
249.0
|
||||
368.0
|
||||
182.0
|
||||
0.0
|
||||
(list (make-snip-dump 55.0 178.0 0.0 0.0 empty) (make-snip-dump 55.0 356.0 0.0 178.0 empty)))
|
||||
(make-snip-dump 269.0 20.0 249.0 0.0 false)
|
||||
(make-snip-dump 289.0 20.0 269.0 0.0 false)
|
||||
(make-snip-dump 300.0 24.0 289.0 0.0 empty)
|
||||
(make-snip-dump 368.0 368.0 300.0 0.0 (list (make-snip-dump 11.0 24.0 0.0 0.0 empty))))
|
||||
)
|
||||
|
||||
(send frame resize 0 0)
|
||||
(sleep/yield 1)
|
||||
|
||||
(dump=?
|
||||
(dump-children pasteboard)
|
||||
(list
|
||||
(make-snip-dump 10.0 34.0 0.0 0.0 empty)
|
||||
(make-snip-dump 20.0 34.0 10.0 0.0 empty)
|
||||
(make-snip-dump 30.0 34.0 20.0 0.0 empty)
|
||||
(make-snip-dump 41.0 24.0 30.0 0.0 empty)
|
||||
(make-snip-dump
|
||||
61.0
|
||||
34.0
|
||||
41.0
|
||||
0.0
|
||||
(list (make-snip-dump 10.0 11.0 0.0 0.0 empty) (make-snip-dump 10.0 22.0 0.0 11.0 empty)))
|
||||
(make-snip-dump 81.0 20.0 61.0 0.0 false)
|
||||
(make-snip-dump 101.0 20.0 81.0 0.0 false)
|
||||
(make-snip-dump 112.0 24.0 101.0 0.0 empty)
|
||||
(make-snip-dump 133.0 34.0 112.0 0.0 (list (make-snip-dump 11.0 24.0 0.0 0.0 empty))))
|
||||
)
|
||||
|
||||
(send frame resize 800 600)
|
||||
(sleep/yield 1)
|
||||
|
||||
(dump=?
|
||||
(dump-children pasteboard)
|
||||
(list
|
||||
(make-snip-dump 137.0 568.0 0.0 0.0 empty)
|
||||
(make-snip-dump 274.0 568.0 137.0 0.0 empty)
|
||||
(make-snip-dump 411.0 568.0 274.0 0.0 empty)
|
||||
(make-snip-dump 422.0 24.0 411.0 0.0 empty)
|
||||
(make-snip-dump
|
||||
569.0
|
||||
568.0
|
||||
422.0
|
||||
0.0
|
||||
(list (make-snip-dump 135.0 278.0 0.0 0.0 empty) (make-snip-dump 135.0 556.0 0.0 278.0 empty)))
|
||||
(make-snip-dump 589.0 20.0 569.0 0.0 false)
|
||||
(make-snip-dump 609.0 20.0 589.0 0.0 false)
|
||||
(make-snip-dump 620.0 24.0 609.0 0.0 empty)
|
||||
(make-snip-dump 768.0 568.0 620.0 0.0 (list (make-snip-dump 11.0 24.0 0.0 0.0 empty))))
|
||||
)
|
||||
|
||||
(send frame resize 400 400)
|
||||
(send pasteboard delete i-snip)
|
||||
(send pasteboard delete i-snip2)
|
||||
|
||||
(dump=?
|
||||
(dump-children pasteboard)
|
||||
(list
|
||||
(make-snip-dump 65.0 368.0 0.0 0.0 empty)
|
||||
(make-snip-dump 130.0 368.0 65.0 0.0 empty)
|
||||
(make-snip-dump 195.0 368.0 130.0 0.0 empty)
|
||||
(make-snip-dump 206.0 24.0 195.0 0.0 empty)
|
||||
(make-snip-dump
|
||||
281.0
|
||||
368.0
|
||||
206.0
|
||||
0.0
|
||||
(list (make-snip-dump 63.0 178.0 0.0 0.0 empty) (make-snip-dump 63.0 356.0 0.0 178.0 empty)))
|
||||
(make-snip-dump 292.0 24.0 281.0 0.0 empty)
|
||||
(make-snip-dump 368.0 368.0 292.0 0.0 (list (make-snip-dump 11.0 24.0 0.0 0.0 empty))))
|
||||
)
|
||||
|
||||
(send pasteboard erase)
|
||||
(dump=?
|
||||
(dump-children pasteboard)
|
||||
empty
|
||||
)
|
||||
|
||||
(send frame show false)
|
||||
(printf "done~n")
|
||||
|
|
@ -1,189 +0,0 @@
|
|||
(require
|
||||
mzlib/class
|
||||
mred
|
||||
mzlib/etc
|
||||
mzlib/list
|
||||
"../aligned-pasteboard.ss"
|
||||
"../aligned-editor-container.ss"
|
||||
"snip-dumper.ss")
|
||||
|
||||
;
|
||||
;
|
||||
; ;;
|
||||
; ;
|
||||
; ;
|
||||
; ;;;;; ;; ;; ;;;;;;;;;;;;;; ;;; ; ;;;;; ;;;;
|
||||
; ; ; ;;;; ; ; ; ; ;; ;; ; ; ; ; ;
|
||||
; ;;;;;; ;; ;;;; ; ; ; ; ; ; ;;;;;; ;;;;
|
||||
; ; ;; ; ; ; ; ; ; ; ; ; ;
|
||||
; ;; ; ; ; ; ; ; ; ; ;; ;; ; ;; ; ; ;
|
||||
; ;;;; ;; ;; ;;;;;;; ;; ;;; ;;; ;;;;; ;;;; ;;;;
|
||||
; ;
|
||||
; ;;;
|
||||
;
|
||||
|
||||
(printf "running test2.ss~n")
|
||||
|
||||
(define frame
|
||||
(instantiate frame% ()
|
||||
(label "Frame")
|
||||
(width 400)
|
||||
(height 400)))
|
||||
|
||||
(define pasteboard
|
||||
(instantiate horizontal-pasteboard% ()))
|
||||
|
||||
(define canvas
|
||||
(instantiate aligned-editor-canvas% ()
|
||||
(parent frame)
|
||||
(editor pasteboard)))
|
||||
|
||||
(define vp1
|
||||
(instantiate vertical-pasteboard% ()))
|
||||
|
||||
(define ae-snip1
|
||||
(instantiate aligned-editor-snip% ()
|
||||
(editor vp1)))
|
||||
|
||||
(define vp2
|
||||
(instantiate vertical-pasteboard% ()))
|
||||
|
||||
(define ae-snip2
|
||||
(instantiate aligned-editor-snip% ()
|
||||
(editor vp2)))
|
||||
|
||||
(define vp3
|
||||
(instantiate vertical-pasteboard% ()))
|
||||
|
||||
(define ae-snip3
|
||||
(instantiate aligned-editor-snip% ()
|
||||
(editor vp3)))
|
||||
|
||||
(define vp4
|
||||
(instantiate vertical-pasteboard% ()))
|
||||
|
||||
(define ae-snip4
|
||||
(instantiate aligned-editor-snip% ()
|
||||
(editor vp4)))
|
||||
|
||||
(define vp5
|
||||
(instantiate vertical-pasteboard% ()))
|
||||
|
||||
(define ae-snip5
|
||||
(instantiate aligned-editor-snip% ()
|
||||
(editor vp5)))
|
||||
|
||||
(send pasteboard insert ae-snip1)
|
||||
(send pasteboard insert ae-snip2)
|
||||
(send pasteboard insert ae-snip5)
|
||||
(send vp2 insert ae-snip3)
|
||||
(send vp2 insert ae-snip4)
|
||||
(send frame show true)
|
||||
|
||||
;
|
||||
;
|
||||
;
|
||||
; ; ;
|
||||
; ; ;
|
||||
; ;;;;; ;;;;; ;;;; ;;;;; ;;;;
|
||||
; ; ; ; ; ; ; ; ;
|
||||
; ; ;;;;;; ;;;; ; ;;;;
|
||||
; ; ; ; ; ;
|
||||
; ; ;; ; ; ; ; ; ;
|
||||
; ;;;;; ;;;; ;;;; ;;;;; ;;;;
|
||||
;
|
||||
;
|
||||
;
|
||||
|
||||
(sleep/yield 1)
|
||||
(dump=?
|
||||
(dump-children pasteboard)
|
||||
(list
|
||||
(make-snip-dump 120.0 368.0 0.0 0.0 empty)
|
||||
(make-snip-dump
|
||||
249.0
|
||||
368.0
|
||||
120.0
|
||||
0.0
|
||||
(list (make-snip-dump 117.0 178.0 0.0 0.0 empty) (make-snip-dump 117.0 356.0 0.0 178.0 empty)))
|
||||
(make-snip-dump 368.0 368.0 249.0 0.0 empty))
|
||||
)
|
||||
|
||||
(send frame resize 0 0)
|
||||
(sleep/yield 1)
|
||||
(dump=?
|
||||
(dump-children pasteboard)
|
||||
(list
|
||||
(make-snip-dump 10.0 30.0 0.0 0.0 empty)
|
||||
(make-snip-dump
|
||||
30.0
|
||||
30.0
|
||||
10.0
|
||||
0.0
|
||||
(list (make-snip-dump 10.0 10.0 0.0 0.0 empty) (make-snip-dump 10.0 19.0 0.0 9.0 empty)))
|
||||
(make-snip-dump 40.0 30.0 30.0 0.0 empty))
|
||||
)
|
||||
|
||||
(send frame resize 800 600)
|
||||
(sleep/yield 1)
|
||||
(dump=?
|
||||
(dump-children pasteboard)
|
||||
(list
|
||||
(make-snip-dump 253.0 568.0 0.0 0.0 empty)
|
||||
(make-snip-dump
|
||||
516.0
|
||||
568.0
|
||||
253.0
|
||||
0.0
|
||||
(list (make-snip-dump 251.0 278.0 0.0 0.0 empty) (make-snip-dump 251.0 556.0 0.0 278.0 empty)))
|
||||
(make-snip-dump 768.0 568.0 516.0 0.0 empty))
|
||||
)
|
||||
|
||||
(send pasteboard delete ae-snip5)
|
||||
(dump=?
|
||||
(dump-children pasteboard)
|
||||
(list
|
||||
(make-snip-dump
|
||||
389.0
|
||||
568.0
|
||||
0.0
|
||||
0.0
|
||||
(list (make-snip-dump 377.0 278.0 0.0 0.0 empty) (make-snip-dump 377.0 556.0 0.0 278.0 empty)))
|
||||
(make-snip-dump 768.0 568.0 389.0 0.0 empty))
|
||||
)
|
||||
|
||||
(send pasteboard insert ae-snip5)
|
||||
(dump=?
|
||||
(dump-children pasteboard)
|
||||
(list
|
||||
(make-snip-dump 253.0 568.0 0.0 0.0 empty)
|
||||
(make-snip-dump
|
||||
516.0
|
||||
568.0
|
||||
253.0
|
||||
0.0
|
||||
(list (make-snip-dump 251.0 278.0 0.0 0.0 empty) (make-snip-dump 251.0 556.0 0.0 278.0 empty)))
|
||||
(make-snip-dump 768.0 568.0 516.0 0.0 empty))
|
||||
)
|
||||
|
||||
(send pasteboard delete ae-snip5)
|
||||
(send pasteboard delete ae-snip1)
|
||||
(dump=?
|
||||
(dump-children pasteboard)
|
||||
(list
|
||||
(make-snip-dump
|
||||
768.0
|
||||
568.0
|
||||
0.0
|
||||
0.0
|
||||
(list (make-snip-dump 756.0 278.0 0.0 0.0 empty) (make-snip-dump 756.0 556.0 0.0 278.0 empty))))
|
||||
)
|
||||
|
||||
(send pasteboard erase)
|
||||
(dump=?
|
||||
(dump-children pasteboard)
|
||||
empty
|
||||
)
|
||||
|
||||
(send frame show false)
|
||||
(printf "done~n")
|
||||
Loading…
Reference in New Issue
Block a user