--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/UIGalleryView.st Thu Jun 26 14:50:18 1997 +0200
@@ -0,0 +1,670 @@
+"
+ COPYRIGHT (c) 1997 by Claus Gittinger / eXept Software AG
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+
+
+
+NoteBookView subclass:#UIGalleryView
+ instanceVariableNames:'majorKey minorKeys minorKeysHolder'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Interface-UIPainter'
+!
+
+View subclass:#Canvas
+ instanceVariableNames:'dragMode clientSpecHolder inputView selection specification
+ lastClickPoint menuSelector raiseMenuSelector uiBuilder'
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:UIGalleryView
+!
+
+DropObject subclass:#DropSpec
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:UIGalleryView::Canvas
+!
+
+!UIGalleryView class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1997 by Claus Gittinger / eXept Software AG
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+
+
+!
+
+documentation
+"
+ implements a selection panel, keeping widgets which could be placed
+ into other components by drag & drop or copy @ paste. The objects
+ which are draged/droped must be kind of UISpecification's.
+ The UISelectionPanel used by the UIPainter is implemented in this way.
+
+ [author:]
+ Claus Gittinger
+ Claus Atzkern
+
+ [see also:]
+ UIPainter
+ UISelectionPanel
+"
+
+!
+
+examples
+"
+ opens a gallery
+
+ [exBegin]
+ |top sel|
+
+ top := StandardSystemView new label:'gallery'; extent:500@300.
+ sel := UIGalleryView origin:0.0 @ 0.0 corner:1.0 @ 1.0 in:top.
+
+ sel labels:#( 'Buttons'
+ 'Panels'
+ 'Text'
+ ).
+
+ sel minorKeys:#( #standartButtonToggle
+ #standartPanels
+ #standartText
+ ).
+
+ sel majorKey:UISelectionPanel.
+ top open.
+ [exEnd]
+"
+! !
+
+!UIGalleryView methodsFor:'accessing'!
+
+builder
+ "get the builder used to setup a window from a specification (or nil in case
+ of using a new builder)
+ "
+ ^ canvas builder
+!
+
+builder:aBuilderOrNil
+ "set the builder used to setup a window from a specification (or nil in case
+ of using a new builder)
+ "
+ canvas builder:aBuilderOrNil
+!
+
+canvas:aCanvas
+ ^ self
+
+!
+
+labels:listOfLabels minorKeys:listOfMinorKeys majorKey:aMajorKey
+ "setup for labels, selectors and class provider
+ "
+ self labels:listOfLabels.
+ minorKeys := listOfMinorKeys.
+ majorKey := aMajorKey.
+!
+
+majorKey
+ "get the class providing the window specifications
+ "
+ ^ majorKey
+!
+
+majorKey:aKey
+ "get the class providing the window specifications
+ "
+ (majorKey := aKey) notNil ifTrue:[
+ aKey isBehavior ifFalse:[
+ majorKey := Smalltalk at:aKey asSymbol
+ ]
+ ].
+ self selection:nil
+!
+
+minorKeys
+ "get the list of selector keys
+ "
+ ^ minorKeys
+!
+
+minorKeys:aListOfSelectors
+ "set the list of selectors
+ "
+ minorKeys := aListOfSelectors.
+ tabRaw selection:nil.
+! !
+
+!UIGalleryView methodsFor:'accessing holders'!
+
+clientSpecHolder
+ "get the holder which keeps the current selection or in case of
+ no selection the specification under the cursor
+ "
+ ^ canvas clientSpecHolder
+!
+
+clientSpecHolder:aHolder
+ "set the holder which keeps the current selection or in case of
+ no selection the specification under the cursor
+ "
+ canvas clientSpecHolder:aHolder
+!
+
+menuSelector
+ ^ canvas menuSelector
+!
+
+menuSelector:aSelector
+ ^ canvas menuSelector:aSelector
+!
+
+minorKeysHolder
+ "get the holder keeping the minor keys; the selectors to access
+ specifications from a class associated with the majorKey.
+ "
+ ^ minorKeysHolder
+!
+
+minorKeysHolder:aValueHolder
+ "set the holder keeping the minor keys; the selectors to access
+ specifications from a class associated with the majorKey.
+ "
+ minorKeysHolder notNil ifTrue:[
+ minorKeysHolder removeDependent:self.
+ ].
+
+ (minorKeysHolder := aValueHolder) notNil ifTrue:[
+ minorKeysHolder addDependent:self.
+ ].
+ self minorKeys:(minorKeysHolder value)
+! !
+
+!UIGalleryView methodsFor:'change & update'!
+
+selectionChangedTo:something
+ "selection changed
+ "
+ |specification selector selection application|
+
+ selection := tabRaw listIndexOf:something.
+
+ (selection notNil and:[minorKeys size >= selection]) ifTrue:[
+ selector := minorKeys at:selection.
+
+ (majorKey respondsTo:selector) ifTrue:[
+ specification := majorKey perform:selector
+ ] ifFalse:[
+ (application := self application) notNil ifTrue:[
+ Object messageNotUnderstoodSignal handle:[:ex|
+ (application class respondsTo:selector) ifTrue:[
+ specification := application class perform:selector
+ ]
+ ] do:[
+ specification := application aspectFor:selector
+ ]
+ ]
+ ]
+ ].
+ canvas specification:specification.
+
+!
+
+update
+ self selectionChangedTo:(tabRaw selection).
+!
+
+update:something with:aParameter from:changedObject
+ "one of my models changed its value
+ "
+ changedObject == minorKeysHolder ifTrue:[
+ ^ self minorKeys:( minorKeysHolder value)
+ ].
+ super update:something with:aParameter from:changedObject.
+
+! !
+
+!UIGalleryView methodsFor:'initialization'!
+
+destroy
+ minorKeysHolder notNil ifTrue:[
+ minorKeysHolder removeDependent:self.
+ minorKeysHolder := nil.
+ ].
+ super destroy.
+!
+
+initialize
+ "setup default attributes
+ "
+ canvas := Canvas.
+
+ super initialize.
+ tabRaw action:[:something| self selectionChangedTo:something ].
+
+! !
+
+!UIGalleryView::Canvas methodsFor:'accessing'!
+
+builder
+ "get the builder used to setup a window from a specification (or nil in case
+ of using a new builder)
+ "
+ ^ uiBuilder
+!
+
+builder:something
+ "set the builder used to setup a window from a specification (or nil in case
+ of using a new builder)
+ "
+ uiBuilder := something.
+!
+
+clientSpecHolder
+ "get the holder which keeps the current selection or in case of
+ no selection the specification under the cursor
+ "
+ ^ clientSpecHolder
+!
+
+clientSpecHolder:aHolder
+ "set the holder which keeps the current selection or in case of
+ no selection the specification under the cursor
+ "
+ (clientSpecHolder := aHolder) notNil ifTrue:[
+ clientSpecHolder value:selection
+ ].
+!
+
+menuSelector
+ "return the value of the instance variable 'menuSelector' (automatically generated)"
+
+ ^ menuSelector!
+
+menuSelector:something
+ "set the value of the instance variable 'menuSelector' (automatically generated)"
+
+ menuSelector := something.!
+
+specification
+ "get current specification
+ "
+ ^ specification
+
+
+!
+
+specification:aSpecOrSpecArray
+ "set a new specification
+ "
+ |builder|
+
+ self selection:nil.
+
+ self subViews copy do:[:aSubView|
+ aSubView ~~ inputView ifTrue:[
+ aSubView destroy
+ ]
+ ].
+
+ aSpecOrSpecArray notNil ifTrue:[
+ specification := UISpecification from:aSpecOrSpecArray.
+ builder := uiBuilder ? UIBuilder new.
+ specification buildViewFor:builder in:self.
+
+ subViews do:[:v|
+ (v ~~ inputView and:[(self findSpecFor:v) notNil]) ifTrue:[
+ v borderWidth:1.
+ ]
+ ].
+ self shown ifTrue:[
+ self realizeAllSubViews.
+ inputView raise
+ ]
+ ] ifFalse:[
+ specification := nil
+ ]
+
+
+
+! !
+
+!UIGalleryView::Canvas methodsFor:'building'!
+
+buildSpecFrom:aSpec
+ "build spec out of spec
+ "
+ |spec comp coll|
+
+ (aSpec notNil and:[aSpec canUIDrag]) ifFalse:[
+ ^ nil
+ ].
+
+ spec := aSpec copy.
+
+ (aSpec class supportsSubComponents and:[aSpec component notNil]) ifFalse:[
+ ^ spec
+ ].
+ comp := aSpec component.
+ spec component:nil.
+
+ comp canUIDrag ifFalse:[
+ ^ spec
+ ].
+ coll := OrderedCollection new.
+
+ comp do:[:anEntry||spc|
+ (spc := self buildSpecFrom:anEntry) notNil ifTrue:[
+ coll add:spc
+ ]
+ ].
+ coll isEmpty ifTrue:[
+ ^ spec
+ ].
+ comp := comp copy.
+ comp collection:coll.
+ spec component:comp.
+ ^ spec
+
+
+
+
+! !
+
+!UIGalleryView::Canvas methodsFor:'drag & drop'!
+
+startDrag
+ "start drag of selection
+ "
+ |dragObj spec name|
+
+ spec := self findSpecFor:selection.
+
+ spec notNil ifTrue:[
+ spec := self buildSpecFrom:spec.
+ name := spec className asString.
+ name := name copyFrom:1 to:(name size - ('Spec' size) + 1).
+ name at:1 put:(name at:1) asLowercase.
+ name at:(name size) put:$1.
+ spec name:name.
+
+ self showUnselected.
+ dragObj := DropSpec for:selection specification:spec.
+ self showSelected.
+ DragAndDropManager startDrag:dragObj from:inputView.
+ ]
+
+! !
+
+!UIGalleryView::Canvas methodsFor:'event handling'!
+
+buttonMotion:state x:x y:y
+ "start a drag on selection
+ "
+ |sensor|
+
+ (lastClickPoint notNil and:[selection notNil]) ifTrue:[
+ sensor := self sensor.
+ sensor anyButtonPressed ifTrue:[
+ (lastClickPoint dist:(x@y)) > 10.0 ifTrue:[
+ ^ self startDrag
+ ]
+ ]
+ ]
+
+
+!
+
+buttonPress:button x:x y:y
+ "change selection
+ "
+ |application|
+
+ button == 1 ifTrue:[
+ lastClickPoint := Point x:x y:y.
+ self selection:(self findObjectAtX:x y:y).
+ ] ifFalse:[
+ lastClickPoint := nil.
+
+ (menuSelector notNil and:[(application := self application) notNil]) ifTrue:[
+ Object messageNotUnderstoodSignal handle:[:ex|
+ ] do:[
+ application aspectFor:menuSelector
+ ]
+ ]
+ ]
+
+!
+
+exposeX:x y:y width:w height:h
+ "handle an expose event from device; redraw selection
+ "
+ super exposeX:x y:y width:w height:h.
+
+ (selection notNil and:[self sensor hasExposeEventFor:selection]) ifFalse:[
+ self showSelected.
+ ].
+
+
+! !
+
+!UIGalleryView::Canvas methodsFor:'initialization'!
+
+initialize
+ super initialize.
+
+ inputView := InputView origin:0.0@0.0 extent:1.0@1.0 in:self.
+ inputView eventReceiver:self.
+ inputView enableButtonEvents.
+ inputView enableButtonMotionEvents.
+ inputView enableMotionEvents.
+
+
+! !
+
+!UIGalleryView::Canvas methodsFor:'searching'!
+
+findObjectAtX:x y:y
+ "find the origin/corner of the currentWidget
+ "
+ |point id p e|
+
+ point := Point x:x y:y.
+ id := inputView id.
+
+ subViews do:[:v|
+ v ~~ inputView ifTrue:[
+ p := device translatePoint:point from:id to:(v id).
+ ( p x >= 0 and:[p x <= v width
+ and:[p y >= 0 and:[p y <= v height
+ and:[(self findSpecFor:v) notNil]]]]
+ ) ifTrue:[
+ ^ v
+ ]
+ ]
+ ].
+ ^ nil
+
+
+!
+
+findSpecFor:anObject
+ "returns subspec assigned to instance or nil
+ "
+ |name components spec|
+
+ anObject notNil ifTrue:[
+ name := anObject name.
+
+ specification do:[:aSpec|
+ aSpec name = name ifTrue:[
+ aSpec canUIDrag ifTrue:[^ aSpec]
+ ifFalse:[^ nil]
+ ]
+ ]
+ ].
+ ^ nil
+
+
+! !
+
+!UIGalleryView::Canvas methodsFor:'selection'!
+
+handlesOf:aComponent do:aOneArgBlock
+ "evaluate the block on each handle; the argument to the block
+ is a rectangle
+ "
+ aComponent notNil ifTrue:[
+ aOneArgBlock value:(aComponent origin - (2@2) extent:6@6).
+ aOneArgBlock value:(aComponent corner - (1@1) extent:6@6).
+ aOneArgBlock value:(aComponent topRight - (1@2) extent:6@6).
+ aOneArgBlock value:(aComponent bottomLeft - (2@1) extent:6@6).
+ aOneArgBlock value:(aComponent leftCenter - (2@0) extent:6@6).
+ aOneArgBlock value:(aComponent rightCenter - (1@0) extent:6@6).
+ aOneArgBlock value:(aComponent topCenter - (0@2) extent:6@6).
+ aOneArgBlock value:(aComponent bottomCenter - (0@1) extent:6@6).
+ ]
+
+
+!
+
+selection:anObject
+ "selection changed
+ "
+ |name spec|
+
+ selection ~~ anObject ifTrue:[
+ self showUnselected.
+ spec := self findSpecFor:anObject.
+
+ spec notNil ifTrue:[
+ selection := anObject.
+ self showSelected
+ ] ifFalse:[
+ selection := nil
+ ].
+ clientSpecHolder notNil ifTrue:[
+ clientSpecHolder value:spec
+ ]
+ ]
+
+
+!
+
+showSelected
+ "show selected
+ "
+ self shown ifFalse:[^ self].
+
+ selection notNil ifTrue:[
+ self clippedByChildren:false.
+
+ self handlesOf:selection do:[:aRectangle|
+ self fillRectangle:aRectangle
+ ].
+ self clippedByChildren:true.
+ ].
+
+
+!
+
+showUnselected
+ "show unselected
+ "
+ |r currSel|
+
+ (currSel := selection) isNil ifTrue:[
+ ^ self
+ ].
+ selection := nil.
+ self shown ifFalse:[^ self].
+
+ self clippedByChildren:false.
+
+ self handlesOf:currSel do:[:aRectangle|
+ self clearRectangle:aRectangle
+ ].
+ self clippedByChildren:true.
+ r := currSel bounds.
+
+ subViews do:[:sv|
+ |absOrg absFrame|
+
+ sv ~~ inputView ifTrue:[
+ (sv bounds intersects:r) ifTrue:[
+ sv borderColor:(Color gray:5).
+ sv borderColor:(Color black).
+
+ sv withAllSubViewsDo:[:v|
+ v fill:v viewBackground.
+ v exposeX:0 y:0 width:9999 height:9999.
+ ]
+ ]
+ ]
+ ].
+ selection := currSel.
+
+! !
+
+!UIGalleryView::Canvas::DropSpec class methodsFor:'instance creation'!
+
+for:aView specification:aSpec
+ "create drop object for a view derived from a specification
+ "
+ |point extent root device|
+
+ device := aView device.
+ root := device rootView.
+ extent := aView extent.
+ point := device translatePoint:0@0 from:(aView id) to:(root id).
+
+ DisplayObject := nil.
+
+ (point x > 0 and:[point y > 0]) ifTrue:[
+ point := point + extent.
+ (point x < root width and:[point y < root height]) ifTrue:[
+ aView topView raise.
+ device sync.
+ aView invalidate.
+ aView windowGroup processExposeEvents.
+ DisplayObject := Image fromView:aView grab:false.
+ ]
+ ].
+ DisplayObject isNil ifTrue:[
+ DisplayObject := Form extent:extent depth:1.
+ DisplayObject colorMap:(Array with:Color white with:Color black).
+ DisplayObject fill:(Color colorId:0).
+ DisplayObject paint:(Color colorId:1).
+ DisplayObject displayRectangleX:0 y:0 width:aView extent x height:aView extent y.
+ ].
+ aSpec class == UISubSpecification ifTrue:[
+ aSpec layout:(LayoutOrigin fromPoint:0@0)
+ ].
+ ^ self new theObject:aSpec
+! !
+
+!UIGalleryView class methodsFor:'documentation'!
+
+version
+ ^ '$Header$'
+! !