suzanne.soy/gui
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

made the alignments doubly linked lists so that I can instert into the middle easily

Browse Source 
original commit: cbb071dfb7a4c8fc64ab85d538c26c4b96a3ce1a
This commit is contained in:
Mike MacHenry 2004-10-13 19:53:11 +00:00
parent b6d3c63636
commit a460454511
4 changed files with 64 additions and 62 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
collects/embedded-gui/private/aligned-pasteboard.ss
View File

@ -42,12 +42,13 @@
;; The pasteboard that this alignment is being displayed to
(define/public (get-pasteboard) this)
#;((is-a?/c alignment<%>) . -> . void?)
;; Set the given alignment as a the child
(define/public (add-child child)
(if alignment
(error 'add-child "There may be only one alignment<%> of a pasteboard")
(set! alignment child)))
#;(((is-a?/c alignment<%>)) ((union (is-a?/c alignment<%>) false?)) . opt-> . void?)
;; Add the given alignment as a child before the existing child
(define/public add-child
(opt-lambda (child (after #f))
(if alignment
(error 'add-child "There may be only one alignment<%> of a pasteboard")
(set! alignment child))))
#;((is-a?/c alignment<%>) . -> . void?)
;; Deletes a child from the the alignments

20
collects/embedded-gui/private/interface.ss
View File

@ -4,10 +4,18 @@
(provide stretchable-snip<%>
alignment<%>
alignment-parent<%>)
alignment-parent<%>
dllist<%>)
(define dllist<%>
(interface ()
next
prev
for-each
map-to-list))
(define alignment<%>
(interface ()
(interface (dllist<%>)
#;(-> alignment-parent<%>)
;; The parent of this alignment
@ -53,18 +61,14 @@
;; The pasteboard that this alignment is being displayed to
get-pasteboard
#;((is-a?/c alignment<%>) . -> . void?)
;; Add the given alignment as a child
#;(((is-a?/c alignment<%>)) ((union (is-a?/c alignment<%>) false?)) . opt-> . void?)
;; Add the given alignment as a child before the existing child
add-child
#;((is-a?/c alignment<%>) . -> . void?)
;; Deletes a child from the the alignments
delete-child
#;(-> (listof (is-a?/c alignment<%>)))
;; A list of the children of this alignment parent
get-children
#;(-> boolean?)
;; True if the alignment is being shown (accounting for its parent being shown)
is-shown?

5
collects/embedded-gui/private/snip-wrapper.ss
View File

@ -4,12 +4,13 @@
(lib "etc.ss")
(lib "class.ss")
"interface.ss"
(prefix sl: "snip-lib.ss"))
(prefix sl: "snip-lib.ss")
"dllist.ss")
(provide snip-wrapper%)
(define snip-wrapper%
(class* object% (alignment<%>)
(class* dllist% (alignment<%>)
(init-field snip parent)
(field [pasteboard (send parent get-pasteboard)]
[show? true]

88
collects/embedded-gui/private/verthoriz-alignment.ss
View File

@ -7,27 +7,37 @@
(lib "match.ss")
(prefix a: "alignment.ss")
"interface.ss"
"alignment-helpers.ss")
"alignment-helpers.ss"
"dllist.ss")
(provide
horizontal-alignment%
vertical-alignment%)
;;;;;;;;;;
;; alignment
(define (vert/horiz-alignment type)
(class* object% (alignment<%> alignment-parent<%>)
(class* dllist% (alignment<%> alignment-parent<%>)
(init-field parent [show? true])
(init-field parent [show? true] [after #f])
(init [stretchable-width true]
[stretchable-height true])
(field
[pasteboard (send parent get-pasteboard)]
[children empty]
[min-width 0]
[min-height 0]
[stretchable-width? stretchable-width]
[stretchable-height? stretchable-height])
(field
[head (new head%)]
[tail (new tail%)])
(send head next tail)
(send tail prev head)
;;;;;;;;;;
;; alignment<%>
@ -39,22 +49,21 @@
;; Tells the alignment that its sizes should be calculated
(define/public (set-min-sizes)
(when show?
(for-each
(lambda (child)
(send child set-min-sizes))
children)
(send head for-each
(lambda (child)
(send child set-min-sizes)))
(let-values ([(x-accum y-accum)
(if (symbol=? type 'vertical)
(values vacuous-max +)
(values + vacuous-max))])
(set! min-width
(apply x-accum
(map (lambda (c) (send c get-min-width))
children)))
(send head map-to-list
(lambda (c) (send c get-min-width)))))
(set! min-height
(apply y-accum
(map (lambda (c) (send c get-min-height))
children))))))
(send head map-to-list
(lambda (c) (send c get-min-height))))))))
#;(nonnegative? nonnegative? nonnegative? nonnegative? . -> . void?)
;; Tells the alignment to align its children on the pasteboard in the given rectangle
@ -66,14 +75,10 @@
(send child align (+ x x-offset) (+ y y-offset) w h)]))
(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
(map build-rect children)))))
(send head for-each
move/resize
(a:align type width height
(send head map-to-list build-rect)))))
#;(-> nonnegative?)
;; The minimum width this alignment must be
@ -114,40 +119,31 @@
(when (send parent is-shown?)
(show/hide-children bool)))
;;;;;;;;;;
;; alignment-parent<%>
#;(-> (is-a?/c pasteboard%))
;; The pasteboard that this alignment is being displayed to
(define/public (get-pasteboard) pasteboard)
#;(((is-a?/c alignment<%>)) ((is-a?/c alignment<%>)) . opt-> . void?)
#;(((is-a?/c alignment<%>)) ((union (is-a?/c alignment<%>) false?)) . opt-> . void?)
;; Add the given alignment as a child before the existing child
(define/public (add-child child)
(set! children (append children (list child))))
(define/public add-child
(opt-lambda (child (after #f))
(define (link p item n)
(send p next child)
(send child prev p)
(send n prev child)
(send child next n))
(if after
(link after child (send after next))
(link (send tail prev) child tail))))
#;((is-a?/c alignment<%>) . -> . void?)
;; Deletes a child from the the alignments
(define/public (delete-child child)
(send child show/hide false)
(set! children (filter (lambda (c) (not (eq? child c)))
children)))
#;(-> (listof (is-a?/c alignment<%>)))
;; A list of the children of this alignment parent
(define/public (get-children) children)
#;((is-a?/c alignment<%>) (is-a?/c alignment<%>) . -> . void?)
;; Moves a snip to a position after the other
(define/public (move-after child reference)
(let ([r (remove child children)])
(set! children (insert-after child r reference))))
#;((is-a?/c alignment<%>) (is-a?/c alignment<%>) . -> . void?)
;; Moves a snip to a position before the other
(define/public (move-before child reference)
(let ([r (remove child children)])
(set! children (insert-before child r reference))))
(let ([p (send child prev)]
[n (send child next)])
(send p next n)
(send n prev p)))
#;(-> boolean?)
;; True if the alignment is being shown (accounting for its parent being shown)
@ -161,11 +157,11 @@
;; Shows or hides the children
(define/private (show/hide-children bool)
(send pasteboard lock-alignment true)
(for-each (lambda (c) (send c show/hide bool)) children)
(send head for-each (lambda (c) (send c show/hide bool)))
(send pasteboard lock-alignment false))
(super-new)
(send parent add-child this)))
(send parent add-child this after)))
(define vertical-alignment% (vert/horiz-alignment 'vertical))
(define horizontal-alignment% (vert/horiz-alignment 'horizontal))