From VisualWorks®, 7.6 of February 1, 2008 on February 1, 2008 at 12:46:47 pm (Dialog confirm: 'You are filing-in a Parcel source file!\\While this is possible it will not have\the same effect as loading the parcel.\None of the Parcel''s prerequisites will\be loaded and none of its load actions\will be performed.\\Are you sure you want to file-in?' withCRs) ifFalse: [self error: 'Parcel file-in abandoned. Choose terminate or close.'] <class> <name>CustomViewExample</name> <environment>Examples</environment> <super>UI.ApplicationModel</super> <private>false</private> none sketches sketchView <imports></imports> <category>Examples-Help</category> <attributes> <package>CustomView-Example</package> </attributes> </class> <comment> Examples.CustomViewExample
This example class demonstrates the integration of a domain model (Sketch) with a custom view (SketchView) and a custom controller (SketchController). The controller is event-driven.
</comment> <class> <name>Sketch</name> <environment>Examples</environment> <super>Core.Object</super> <private>false</private> none name strokes <imports></imports> <category>Examples-Help</category> <attributes> <package>CustomView-Example</package> </attributes> </class> <comment> Examples.Sketch
This example class demonstrates the creation of a domain model.
</comment> <class> <name>SketchView</name> <environment>Examples</environment> <super>UI.View</super> <private>false</private> none <imports></imports> <category>Examples-Help</category> <attributes> <package>CustomView-Example</package> </attributes> </class> <comment> Examples.SketchView
This example class demonstrates the creation of a custom view that uses an event-driven controller.
</comment> <class> <name>SketchController</name> <environment>Examples</environment> <super>UI.ControllerWithMenu</super> <private>false</private> none strokeInProgress keyboardProcessor <imports></imports> <category>Examples-Help</category> <attributes> <package>CustomView-Example</package> </attributes> </class> <comment> Examples.SketchController
This example class demonstrates the creation of a custom event-driven controller. See SketchController1 for the polling version.
</comment> <methods> Examples.CustomViewExample <category>actions</category>
add "Prompt for a sketch name, then add it to the list." | sketchName newSketch list | sketchName := Dialog request: 'Add sketch named...'. sketchName isEmpty ifTrue: [^nil]. newSketch := Sketch new name: sketchName. list := self sketches list. list add: newSketch. self sketches list: list. self sketches selectionIndex: list size.
remove "Remove the currently selected sketch from the list." | list selectedSketch | selectedSketch := self sketches selection. "If no sketch is selected, do nothing." selectedSketch isNil ifTrue: [^self]. list := self sketches list. list remove: selectedSketch. self sketches list: list. self sketches selectionIndex: 0.
</methods> <methods> Examples.CustomViewExample <category>change messages</category>
changedSketch self sketchView model: self sketches selection.
</methods> <methods> Examples.CustomViewExample <category>initialize-release</category>
initialize sketches := SelectionInList with: OrderedCollection new. sketches selectionIndexHolder onChangeSend: #changedSketch to: self. sketchView := SketchView new.
</methods> <methods> Examples.CustomViewExample <category>aspects</category>
sketches ^sketches
sketchView ^sketchView
</methods> <methods> Examples.Sketch <category>comparing</category>
= otherSketch "Answer whether the receiver and otherSketch are the same species, the same size, and have the same name and the same elements." | size | self species == otherSketch species ifFalse: [^false]. self name == otherSketch name ifFalse: [^false]. (size := self size) = otherSketch size ifFalse: [^false]. 1 to: size do: [:index | (self at: index) = (otherSketch at: index) ifFalse: [^false]]. ^true
</methods> <methods> Examples.Sketch <category>adding</category>
add: aPoint "Add aPoint to the current stroke." self strokes last add: aPoint. self changed: #stroke with: self currentLineSegment.
</methods> <methods> Examples.Sketch <category>actions</category>
beginStroke "Start a new stroke subcollection." self strokes addLast: OrderedCollection new.
erase "Erase my contents." self strokes removeAll: self strokes copy. self changed: #erase with: nil.
eraseAll "Erase my contents." self strokes removeAll: self strokes copy. self changed: #erase with: nil.
eraseLine "Erase the last stroke that was drawn." self strokes isEmpty ifFalse: [ self strokes removeLast. self changed: #erase with: nil].
</methods> <methods> Examples.Sketch <category>accessing</category>
currentLineSegment "Answer a line between the last two points drawn. The view responds to a new point by drawing this line." | points start end sz | points := self strokes last. sz := points size. end := points at: sz. "If the current stroke contains only one point, use that point as both start and end." sz > 1 ifTrue: [start := points at: (sz - 1)] ifFalse: [start := end]. ^LineSegment from: start to: end.
name ^name
name: aString name := aString
strokes ^strokes
</methods> <methods> Examples.Sketch <category>displaying</category>
displayString ^self name
</methods> <methods> Examples.Sketch <category>initialize-release</category>
initialize strokes := OrderedCollection new.
</methods> <methods> Examples.Sketch class <category>instance creation</category>
new ^super new initialize.
</methods> <methods> Examples.SketchView <category>controller accessing</category>
defaultControllerClass ^SketchController
</methods> <methods> Examples.SketchView <category>displaying</category>
displayOn: aGraphicsContext self model isNil ifTrue: [^self]. self model strokes do: [ :stroke | aGraphicsContext displayPolyline: stroke].
</methods> <methods> Examples.SketchView <category>model accessing</category>
model: aModel super model: aModel. self invalidate. "Tell the controller where to send menu messages." self controller performer: aModel.
</methods> <methods> Examples.SketchView <category>updating</category>
update: anAspect with: anObject "When a point is added to the model..." anAspect == #stroke ifTrue: [anObject asStroker displayOn: self graphicsContext]. "When the model erases its contents..." anAspect == #erase ifTrue: [self invalidate].
</methods> <methods> Examples.SketchController <category>event driven</category>
desiresFocus ^true
handlerForMouseEvent: event ^((self viewHasCursorWithEvent: event) and: [self model notNil]) ifTrue: [self] ifFalse: [nil]
</methods> <methods> Examples.SketchController <category>events</category>
enterEvent: anEnterEvent "Request keyboard focus." self keyboardProcessor requestActivationFor: self.
exitEvent: anExitEvent "Change the cursor shape back to normal. Also end current stroke in case red button is still being pressed." Cursor normal show. self strokeInProgress: false.
keyPressedEvent: aKeyPressedEvent "Respond to the <Space> key." | char | self model == nil ifTrue: [^nil]. char := aKeyPressedEvent keyValue. (char == Character space) ifTrue: [aKeyPressedEvent hasShift ifTrue: [self model eraseAll] ifFalse: [self model eraseLine]].
mouseMovedEvent: aMouseMovedEvent "Set the cursor when moving in the SketchView. Add a new point for every mouse movement when drawing is in progress." Cursor crossHair show. self strokeInProgress ifTrue: [self model add: (self sensor cursorPointFor: aMouseMovedEvent)]
redButtonPressedEvent: aRedButtonPressedEvent "Start drawing a new line when the <Select> button is pressed. Keep showing the crosshair when pressed." Cursor crossHair show. self model beginStroke. self strokeInProgress: true. self model add: (self sensor cursorPointFor: aRedButtonPressedEvent)
redButtonReleasedEvent: aRedButtonReleasedEvent "Stop drawing when the <Select> button is released." self strokeInProgress: false.
</methods> <methods> Examples.SketchController <category>initialize-release</category>
initialize super initialize. strokeInProgress := false.
initializeMenu | mb | "Build the menu." mb := MenuBuilder new. mb add: 'Erase line <space>' -> #eraseLine. mb add: 'Erase all <Shift-space>' -> #eraseAll. "Install the menu." self menuHolder: mb menu asValue.
release "Upon release, change the cursor shape back to normal." super release. Cursor normal show.
</methods> <methods> Examples.SketchController <category>accessing</category>
keyboardProcessor ^keyboardProcessor
keyboardProcessor: kp keyboardProcessor := kp
strokeInProgress ^strokeInProgress
strokeInProgress: aBoolean strokeInProgress := aBoolean
</methods> <methods> Examples.CustomViewExample class <category>resources</category>
sketchListMenu "UIMenuEditor new openOnClass: self andSelector: #sketchListMenu" <resource: #menu> ^#(#Menu #( #(#MenuItem #label: 'Add' ) #(#MenuItem #label: 'Remove' ) ) #(2 ) #(#add #remove ) ) decodeAsLiteralArray
</methods> <methods> Examples.CustomViewExample class <category>interface specs</category>
windowSpec "UIPainter new openOnClass: self andSelector: #windowSpec" <resource: #canvas> ^#(#{UI.FullSpec} #window: #(#{UI.WindowSpec} #label: 'CustomViewExample' #min: #(#{Core.Point} 378 209 ) #bounds: #(#{Graphics.Rectangle} 512 384 891 593 ) ) #component: #(#{UI.SpecCollection} #collection: #( #(#{UI.GroupBoxSpec} #layout: #(#{Graphics.LayoutFrame} 10 0.333333 10 0 -10 1 -10 1 ) ) #(#{UI.SequenceViewSpec} #layout: #(#{Graphics.LayoutFrame} 10 0 39 0 0 0.332454 -11 1 ) #flags: 15 #model: #sketches #menu: #sketchListMenu ) #(#{UI.ArbitraryComponentSpec} #layout: #(#{Graphics.LayoutFrame} 11 0.333333 11 0 -11 1 -11 1 ) #flags: 0 #component: #sketchView ) #(#{UI.ActionButtonSpec} #layout: #(#{UI.AlignmentOrigin} 5 0.166667 3 0 0.5 0 ) #model: #add #label: 'Add sketch' ) ) ) )
</methods> "Imported Classes:" self error: 'Attempting to file-in parcel imports. Choose terminate or close' <class> <name>Object</name> <environment>Core</environment> <super></super> <private>false</private> none <imports></imports> <category>Kernel-Objects</category> <attributes> <package>Kernel-Objects</package> </attributes> </class> <class> <name>ControllerWithMenu</name> <environment>UI</environment> <super>UI.Controller</super> <private>false</private> none menuHolder performer <imports></imports> <category>Interface-Framework</category> <attributes> <package>Interface-Framework</package> </attributes> </class> <class> <name>View</name> <environment>UI</environment> <super>Graphics.DependentPart</super> <private>false</private> none controller <imports></imports> <category>Interface-Framework</category> <attributes> <package>Interface-Framework</package> </attributes> </class> <class> <name>ApplicationModel</name> <environment>UI</environment> <super>UI.Model</super> <private>false</private> none builder uiSession eventHandlers savedWindowInformation <imports></imports> <category>UIBuilder-Framework</category> <attributes> <package>UIBuilder-Framework</package> </attributes> </class>