[ENH] Dialogs
Michael Rueger
Michael.Rueger.-ND at disney.com
Wed Mar 1 22:59:05 UTC 2000
Change Set: Morphic-Dialogs
Date: 1 March 2000
Author: Michael Rueger
A small framework for building dialog windows.
The dialogs are not modal yet (which they should be).
There is also the potential to extend this package to support platform
specific dialogs via SystemDialog concreteClass.
See also the examples in MorphicDialog.
Change Set: Morphic-Dialogs-mir
Date: 1 March 2000
Author: Michael Rueger
Based on the morphic dialog package this change set replaces most of the user
interface calls (inform:, confirm:) with calls to the morphic dialog package.
--
"To improve is to change, to be perfect is to change often."
Winston Churchill
+------------------------------------------------------------+
| Michael Rueger |
| Phone: ++1 (818) 623 3283 Fax: ++1 (818) 623 3559 |
+---------- Michael.Rueger.-ND at corp.go.com ------------------+
-------------- next part --------------
"Change Set: Morphic-Dialogs
Date: 1 March 2000
Author: Michael Rueger
A small framework for building dialog windows.
The dialogs are not modal yet (which they should be).
There is also the potential to extend this package to support platform specific dialogs via SystemDialog concreteClass.
See also the examples in MorphicDialog.
"!
SimpleButtonMorph subclass: #SimpleDialogButtonMorph
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Morphic-Dialogs'!
!SimpleDialogButtonMorph methodsFor: 'accessing' stamp: 'mir 2/17/2000 13:38'!
label: aString extraSpace: aPoint
| oldLabel m |
(oldLabel _ self findA: StringMorph)
ifNotNil: [oldLabel delete].
m _ StringMorph contents: aString font: TextStyle defaultFont.
self extent: m extent + (borderWidth + 6) + aPoint.
m position: self center - (m extent // 2).
self addMorph: m.
m lock! !
!SimpleDialogButtonMorph methodsFor: 'accessing' stamp: 'mir 2/17/2000 13:46'!
label: aString extraSpace: aPoint minimumExtent: minExtent
| oldLabel m |
(oldLabel _ self findA: StringMorph)
ifNotNil: [oldLabel delete].
m _ StringMorph contents: aString font: TextStyle defaultFont.
self extent: ((m extent + (borderWidth + 6) + aPoint) max: minExtent).
m position: self center - (m extent // 2).
self addMorph: m.
m lock! !
!SimpleDialogButtonMorph methodsFor: 'drawing' stamp: 'mir 2/17/2000 13:37'!
drawOn: aCanvas
borderColor == #raised ifTrue: [
"Use a hack for now"
aCanvas fillRectangle: self bounds fillStyle: self fillStyle.
^ aCanvas frameAndFillRectangle: bounds
fillColor: Color transparent
borderWidth: borderWidth
topLeftColor: Color white
bottomRightColor: Color veryDarkGray].
borderColor == #defaultRaised ifTrue: [
"Use a hack for now"
aCanvas fillRectangle: self bounds fillStyle: self fillStyle.
aCanvas frameRectangle: self bounds color: Color black.
^ aCanvas frameAndFillRectangle: (bounds insetBy: 1 at 1)
fillColor: Color transparent
borderWidth: (borderWidth - 1 max: 1)
topLeftColor: Color white
bottomRightColor: Color veryDarkGray].
super drawOn: aCanvas! !
RectangleMorph subclass: #SystemDialog
instanceVariableNames: 'done '
classVariableNames: 'StandardOptions '
poolDictionaries: ''
category: 'Morphic-Dialogs'!
!SystemDialog methodsFor: 'open/close' stamp: 'mir 2/23/2000 19:44'!
getUserResponse
"Wait for the user to accept or cancel, and answer the result string. Answers the empty string if the user cancels."
"Details: This is invoked synchronously from the caller. In order to keep processing inputs and updating the screen while waiting for the user to respond, this method has its own version of the World's event loop."
| w |
w _ self world.
w ifNil: [^ self response].
done _ false.
[done] whileFalse: [w doOneSubCycle].
self delete.
w doOneSubCycle.
^ self response
! !
!SystemDialog methodsFor: 'open/close' stamp: 'mir 7/20/1999 18:52'!
getUserResponseSync
"Wait for the user to accept or cancel, and answer the result string. Answers the empty string if the user cancels."
"Details: This is invoked synchronously from the caller. In order to keep processing inputs and updating the screen while waiting for the user to respond, this method has its own version of the World's event loop."
| w hand |
" w _ self world.
w ifNil: [^ self response]."
hand _ World primaryHand.
w _ hand world .
w
addMorphFront: self;
startSteppingSubmorphsOf: self.
self changed.
done _ false.
[done] whileFalse: [w doOneSubCycle].
self delete.
^ self response
! !
!SystemDialog methodsFor: 'accessing' stamp: 'mir 7/19/1999 18:24'!
response
self subclassResponsibility! !
!SystemDialog methodsFor: 'accessing' stamp: 'mir 7/20/1999 12:50'!
roundedWindowCorners
^true! !
!SystemDialog methodsFor: 'private construction' stamp: 'mir 2/17/2000 13:50'!
makeButtonRow: morphList
| row |
row _ AlignmentMorph newRow
fillStyle: Color transparent;
borderWidth: 0;
inset: 3;
minCellSize: 60.
row hResizing: #shrinkWrap; vResizing: #spaceFill; centering: #center; extent: 5 at 5.
morphList do: [:morph |
row addMorph: (self wrapButton: morph)].
^ row! !
!SystemDialog methodsFor: 'private construction' stamp: 'mir 7/22/1999 12:06'!
wrapButton: aMorph
"wrap a button or other morph in an alignmentMorph to allow to fill space."
| wrapper |
wrapper _ AlignmentMorph newColumn
fillStyle: Color transparent;
"color: self defaultColor;"
centering: #center;
hResizing: #spaceFill;
vResizing: #spaceFill.
wrapper addMorph: aMorph.
^wrapper
! !
!SystemDialog methodsFor: 'initialization' stamp: 'mir 2/28/2000 16:13'!
initialize
super initialize.
done _ false.
self
fillStyle: Color veryLightGray;
"fillStyle: self defaultFillStyle;"
borderWidth: 2;
borderColor: #raised! !
!SystemDialog methodsFor: 'private accessing' stamp: 'mir 7/20/1999 12:36'!
defaultColor
^Color black! !
!SystemDialog methodsFor: 'private accessing' stamp: 'mir 7/20/1999 12:36'!
defaultFillStyle
^Color veryLightGray! !
!SystemDialog methodsFor: 'private accessing' stamp: 'mir 2/23/2000 19:48'!
standardOption: option
^StandardOptions at: option ifAbsent: [nil]! !
!SystemDialog methodsFor: 'drawing' stamp: 'mir 7/20/1999 12:50'!
fullDrawOn: aCanvas
self roundedWindowCorners
ifTrue: [CornerRounder roundCornersOf: self on: aCanvas
displayBlock: [super fullDrawOn: aCanvas]
borderWidth: 2]
ifFalse: [super fullDrawOn: aCanvas]! !
!SystemDialog methodsFor: 'private' stamp: 'mir 2/28/2000 14:07'!
positionInWorld: aWorld
| vOffset |
vOffset _ self bounds amountToTranslateWithin: aWorld viewBox.
self position: self position + vOffset! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
SystemDialog class
instanceVariableNames: ''!
!SystemDialog class methodsFor: 'accessing' stamp: 'mir 2/23/2000 19:56'!
concreteClass
^World
ifNil: [MVCDialog]
ifNotNil: [MorphicDialog]! !
!SystemDialog class methodsFor: 'class initialization' stamp: 'mir 2/23/2000 19:48'!
initialize
"SystemDialog initialize"
StandardOptions _ Dictionary new.
StandardOptions
at: #ok put: (Array with: 'OK' with: true with: nil);
at: #yes put: (Array with: 'Yes' with: true with: nil);
at: #no put: (Array with: 'No' with: false with: nil);
at: #accept put: (Array with: 'Accept' with: true with: nil);
at: #cancel put: (Array with: 'Cancel' with: nil with: nil);
at: #retry put: (Array with: 'Retry' with: true with: nil);
at: #abort put: (Array with: 'Give Up' with: false with: nil)
! !
SystemDialog subclass: #MVCDialog
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Morphic-Dialogs'!
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
MVCDialog class
instanceVariableNames: ''!
!MVCDialog class methodsFor: 'standard dialogs' stamp: 'mir 2/23/2000 19:57'!
confirm: queryString
"Put up a yes/no menu with caption aString. Answer true if the response is yes, false if no. This is a modal question--the user must respond yes or no."
"nil confirm: 'Are you hungry?'"
^ SelectionMenu confirm: queryString! !
!MVCDialog class methodsFor: 'standard dialogs' stamp: 'mir 2/23/2000 19:57'!
confirm: aString orCancel: cancelBlock
"Put up a yes/no/cancel menu with caption aString.
Answer true if the response is yes, false if no.
If cancel is chosen, evaluate cancelBlock."
| choice |
[true] whileTrue:
[choice _ (PopUpMenu labels:
'yes
no
cancel') startUpWithCaption: aString.
choice = 1 ifTrue: [^ true].
choice = 2 ifTrue: [^ false].
choice = 3 ifTrue: [^ cancelBlock value]]! !
!MVCDialog class methodsFor: 'standard dialogs' stamp: 'mir 2/23/2000 19:57'!
inform: aString
"Display a message for the user to read and then dismiss. 6/9/96 sw"
aString size > 0
ifTrue: [(PopUpMenu labels: ' OK ') startUpWithCaption: aString]! !
!MVCDialog class methodsFor: 'standard dialogs' stamp: 'mir 2/23/2000 20:00'!
retry: messageText onAbort: abortActionBlock
| response |
response _ (PopUpMenu labels: 'Retry\Give Up' withCRs)
startUpWithCaption: messageText.
^response = 2
ifTrue: [
abortActionBlock value.
false]
ifFalse: [true]! !
SystemDialog subclass: #MorphicDialog
instanceVariableNames: 'resultOption '
classVariableNames: ''
poolDictionaries: ''
category: 'Morphic-Dialogs'!
!MorphicDialog methodsFor: 'event handling' stamp: 'mir 7/20/1999 15:47'!
handlesMouseOver: evt
^ true
! !
!MorphicDialog methodsFor: 'event handling' stamp: 'mir 7/20/1999 16:19'!
keyStroke: evt
"Process the given keyboard event."
| k |
k _ evt keyValue.
k = 13 ifTrue: [ "return key"
self defaultSelected].
! !
!MorphicDialog methodsFor: 'event handling' stamp: 'mir 7/20/1999 15:46'!
mouseEnter: evt
evt hand newKeyboardFocus: self.
! !
!MorphicDialog methodsFor: 'private' stamp: 'mir 7/20/1999 18:31'!
defaultBackgroundMorph
| backgroundMorph |
backgroundMorph _ Morph new.
backgroundMorph
color: self defaultColor;
fillStyle: self defaultFillStyle.
^backgroundMorph! !
!MorphicDialog methodsFor: 'private' stamp: 'mir 7/20/1999 16:18'!
defaultSelected
done _ true.
! !
!MorphicDialog methodsFor: 'private' stamp: 'mir 7/22/1999 10:23'!
minimumExtent
^200 at 80! !
!MorphicDialog methodsFor: 'private' stamp: 'mir 7/19/1999 18:40'!
optionSelected: optionValue
resultOption _ optionValue.
done _ true.
! !
!MorphicDialog methodsFor: 'accessing' stamp: 'mir 7/20/1999 16:27'!
defaultResponse: aValue
resultOption _ aValue! !
!MorphicDialog methodsFor: 'accessing' stamp: 'mir 7/19/1999 18:25'!
response
^resultOption! !
!MorphicDialog methodsFor: 'private construction' stamp: 'mir 2/17/2000 13:51'!
constructInnerMorph: optionMorphs descriptionMorph: descriptionMorph
| innerMorph optionMorph buttonRow optionDescriptionMorph |
innerMorph _ AlignmentMorph newColumn.
innerMorph
centering: #center;
fillStyle: Color transparent;
"width: self innerBounds width;"
hResizing: #spaceFill;
vResizing: #spaceFill;
borderWidth: 0;
extent: self minimumExtent.
optionMorph _ AlignmentMorph new.
optionMorph
hResizing: #shrinkWrap;
color: Color transparent;
borderWidth: 0.
buttonRow _ self makeButtonRow: optionMorphs.
optionMorph addMorph: buttonRow.
innerMorph addMorph: optionMorph.
optionDescriptionMorph _ self constructOptionDescriptionMorph: descriptionMorph.
innerMorph addMorph: optionDescriptionMorph.
^innerMorph
! !
!MorphicDialog methodsFor: 'private construction' stamp: 'mir 7/20/1999 16:40'!
constructOption: optionDescriptor
^self
constructSimpleOptionMorph: (optionDescriptor at: 1)
optionValue: (optionDescriptor at: 2)
optionImage: (optionDescriptor at: 3)
default: false
! !
!MorphicDialog methodsFor: 'private construction' stamp: 'mir 2/17/2000 13:52'!
constructOptionDescriptionMorph: optionDescriptionMorph
| container |
container _ AlignmentMorph newRow
centering: #center;
hResizing: #shrinkWrap;
vResizing: #spaceFill;
fillStyle: Color transparent;
"color: Color black;"
borderWidth: 0.
container addMorph: optionDescriptionMorph.
^container.
! !
!MorphicDialog methodsFor: 'private construction' stamp: 'mir 7/20/1999 17:43'!
constructOptionText: optionText
^TextMorph new contents: optionText! !
!MorphicDialog methodsFor: 'private construction' stamp: 'mir 2/17/2000 13:47'!
constructSimpleOptionMorph: optionLabel optionValue: optionValue optionImage: optionImage default: isDefaultOption
| optionMorph |
optionImage isNil
ifTrue: [
optionMorph _ SimpleDialogButtonMorph new.
optionMorph
label: optionLabel extraSpace: 10 at 4 minimumExtent: 45 at 23;
borderWidth: 1;
useSquareCorners;
borderColor: #raised]
ifFalse: [
optionMorph _ ThreePhaseButtonMorph new.
optionMorph
offImage: optionImage;
extent: optionImage extent].
optionMorph
"fillStyle: Color transparent;"
color: self defaultFillStyle;
actionSelector: #optionSelected: ;
target: self;
arguments: (Array with: optionValue).
isDefaultOption
ifTrue: [
optionMorph
borderColor: #defaultRaised].
^optionMorph
! !
!MorphicDialog methodsFor: 'private construction' stamp: 'mir 7/20/1999 16:24'!
constructStandardOption: option default: default
| optionDescriptor |
optionDescriptor _ self standardOption: option.
optionDescriptor ifNil: [^self].
^self
constructSimpleOptionMorph: (optionDescriptor at: 1)
optionValue: (optionDescriptor at: 2)
optionImage: (optionDescriptor at: 3)
default: option == default
! !
!MorphicDialog methodsFor: 'private options' stamp: 'mir 2/28/2000 15:37'!
optionMorphs: optionMorphs descriptionMorph: descriptionMorph backgroundMorph: backgroundMorph
| innerMorph |
innerMorph _ self constructInnerMorph: optionMorphs descriptionMorph: descriptionMorph.
self extent: (innerMorph fullBounds extent + (self borderWidth*2)) truncated.
innerMorph position: self innerBounds topLeft.
backgroundMorph ifNotNil: [
backgroundMorph extent: self innerBounds extent.
backgroundMorph position: self innerBounds topLeft.
self addMorph: backgroundMorph].
self addMorph: innerMorph! !
!MorphicDialog methodsFor: 'private options' stamp: 'mir 7/20/1999 18:14'!
options: options defaultResponse: defaultResponse label: aLabelString optionText: optionText backgroundMorph: backgroundMorph
| optionList optionDescriptionMorph |
self defaultResponse: defaultResponse.
optionList _ options collect: [:option |
self constructOption: option].
optionDescriptionMorph _ self constructOptionText: optionText.
self optionMorphs: optionList descriptionMorph: optionDescriptionMorph backgroundMorph: backgroundMorph
! !
!MorphicDialog methodsFor: 'private options' stamp: 'mir 2/28/2000 13:59'!
standardOptions: options default: default optionText: optionText
| optionList optionDescriptionMorph |
self defaultResponse: ((self standardOption: default) at: 2).
optionList _ options collect: [:option |
self constructStandardOption: option default: default].
optionDescriptionMorph _ self constructOptionText: optionText.
self optionMorphs: optionList descriptionMorph: optionDescriptionMorph backgroundMorph: nil
! !
!MorphicDialog methodsFor: 'initialization' stamp: 'mir 7/19/1999 17:42'!
initialize
super initialize.
! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
MorphicDialog class
instanceVariableNames: ''!
!MorphicDialog class methodsFor: 'standard dialogs' stamp: 'mir 2/23/2000 19:50'!
confirm: messageText
^ self
standardOptions: #(#no #yes )
default: #yes
optionText: messageText ! !
!MorphicDialog class methodsFor: 'standard dialogs' stamp: 'mir 2/23/2000 19:50'!
confirm: messageText orCancel: cancelBlock
| result |
result _ self
standardOptions: #(#cancel #no #yes )
default: #yes
optionText: messageText.
^result
ifNil: [cancelBlock value]
ifNotNil: [result]! !
!MorphicDialog class methodsFor: 'standard dialogs' stamp: 'mir 2/23/2000 19:50'!
fatalError: messageText
^ self
standardOptions: #(#ok )
default: #ok
optionText: messageText ! !
!MorphicDialog class methodsFor: 'standard dialogs' stamp: 'mir 7/21/1999 11:04'!
fatalError: message quit: quitIfTrue! !
!MorphicDialog class methodsFor: 'standard dialogs' stamp: 'mir 2/23/2000 19:50'!
inform: messageText
^ self
standardOptions: #(#ok )
default: #ok
optionText: messageText ! !
!MorphicDialog class methodsFor: 'standard dialogs' stamp: 'mir 2/23/2000 19:50'!
okCancel: messageText
^ self
standardOptions: #(#cancel #ok )
default: #cancel
optionText: messageText ! !
!MorphicDialog class methodsFor: 'standard dialogs' stamp: 'mir 2/23/2000 19:50'!
retryAbort: messageText
^ self
standardOptions: #(#retry #abort )
default: #retry
optionText: messageText ! !
!MorphicDialog class methodsFor: 'private examples' stamp: 'mir 2/17/2000 12:41'!
checkForm
^(Form extent: 40 at 20) fillGray! !
!MorphicDialog class methodsFor: 'private examples' stamp: 'mir 2/17/2000 12:41'!
stopForm
^(Form extent: 40 at 20) fillBlack! !
!MorphicDialog class methodsFor: 'examples' stamp: 'mir 2/17/2000 12:50'!
exampleConfirm
"OptionDialog exampleConfirm"
(self confirm: 'Can you confirm this?')
ifFalse: [Transcript show: 'Not '].
Transcript show: 'Confirmed'; cr
! !
!MorphicDialog class methodsFor: 'examples' stamp: 'mir 2/23/2000 19:55'!
exampleFunny
"OptionDialog exampleFunny"
| optionList |
optionList _ Array
with: (Array with: 'Funny' with: true with: nil)
with: (Array with: 'Not so' with: false with: nil).
(self options: optionList defaultResponse: true optionText: 'Is this funny?' )
ifFalse: [Transcript show: 'Not '].
Transcript show: 'Funny'; cr
! !
!MorphicDialog class methodsFor: 'examples' stamp: 'mir 2/23/2000 19:55'!
exampleFunnyLooking
"OptionDialog exampleFunnyLooking"
| optionList |
optionList _ Array
with: (Array with: 'Not so' with: false with: self stopForm)
with: (Array with: 'Funny' with: true with: self checkForm).
(self options: optionList defaultResponse: true optionText: 'Is this a form example?' )
ifFalse: [Transcript show: 'Not '].
Transcript show: 'Funny'; cr
! !
!MorphicDialog class methodsFor: 'examples' stamp: 'mir 2/17/2000 13:55'!
exampleInform
"OptionDialog exampleInform"
self inform: 'This is not an information.'! !
!MorphicDialog class methodsFor: 'examples' stamp: 'mir 2/17/2000 12:50'!
exampleLongConfirm
"OptionDialog exampleLongConfirm"
(self confirm: 'Can you confirm this very long message text?')
ifFalse: [Transcript show: 'Not '].
Transcript show: 'Confirmed'; cr
! !
!MorphicDialog class methodsFor: 'examples' stamp: 'mir 2/17/2000 13:56'!
exampleOKCancel
"OptionDialog exampleOKCancel"
(self okCancel: 'Cancel this?') ~= true
ifTrue: [Transcript show: 'Not '].
Transcript show: 'Confirmed'; cr
! !
!MorphicDialog class methodsFor: 'instance creation' stamp: 'mir 7/19/1999 16:14'!
new
^super new initialize! !
!MorphicDialog class methodsFor: 'instance creation' stamp: 'mir 2/28/2000 13:57'!
options: optionList defaultResponse: defaultResponse optionText: anOptionText
^self options: optionList defaultResponse: defaultResponse optionText: anOptionText backgroundMorph: nil! !
!MorphicDialog class methodsFor: 'instance creation' stamp: 'mir 2/28/2000 14:09'!
options: optionList defaultResponse: defaultResponse optionText: anOptionText backgroundMorph: backgroundMorph
| optionDialog |
optionDialog _ self new.
optionDialog
options: optionList
defaultResponse: defaultResponse
optionText: anOptionText
backgroundMorph: backgroundMorph.
optionDialog center: (World activeHand
ifNil: [Display boundingBox center]
ifNotNil: [World activeHand position]).
optionDialog positionInWorld: World.
World addMorph: optionDialog.
backgroundMorph startStepping.
^optionDialog getUserResponse! !
!MorphicDialog class methodsFor: 'instance creation' stamp: 'mir 2/28/2000 14:09'!
standardOptions: optionList default: defaultOption optionText: anOptionText
| optionDialog |
optionDialog _ self new.
"optionDialog extent: 300 at 150."
optionDialog
standardOptions: optionList
default: defaultOption
optionText: anOptionText.
optionDialog center: (World activeHand
ifNil: [Display boundingBox center]
ifNotNil: [World activeHand position]).
optionDialog positionInWorld: World.
World currentWorld addMorph: optionDialog.
^optionDialog getUserResponse! !
!MorphicDialog class methodsFor: 'instance creation' stamp: 'mir 2/23/2000 19:54'!
standardOptions: optionList optionText: anOptionText
^self standardOptions: optionList default: nil optionText: anOptionText ! !
SystemDialog initialize!
-------------- next part --------------
"Change Set: Morphic-Dialogs-mir
Date: 1 March 2000
Author: Michael Rueger
Based on the morphic dialog package this change set replaces most of the user interface calls (inform:, confirm:) with calls to the morphic dialog package.
"!
!Object methodsFor: 'user dialogs' stamp: 'mir 2/23/2000 19:46'!
confirm: queryString
"Put up a yes/no menu with caption aString. Answer true if the response is yes, false if no. This is a modal question--the user must respond yes or no."
"nil confirm: 'Are you hungry?'"
^SystemDialog concreteClass confirm: queryString! !
!Object methodsFor: 'user dialogs' stamp: 'mir 2/23/2000 19:57'!
confirm: aString orCancel: cancelBlock
"Put up a yes/no/cancel menu with caption aString.
Answer true if the response is yes, false if no.
If cancel is chosen, evaluate cancelBlock."
^SystemDialog concreteClass confirm: aString orCancel: cancelBlock! !
!Object methodsFor: 'user dialogs' stamp: 'mir 2/23/2000 19:46'!
inform: aString
"Display a message for the user to read and then dismiss. 6/9/96 sw"
aString size > 0
ifTrue: [SystemDialog concreteClass inform: aString]
" ifTrue: [(PopUpMenu labels: ' OK ') startUpWithCaption: aString]"! !
!Object methodsFor: 'user dialogs' stamp: 'mir 2/23/2000 19:44'!
retry: messageText onAbort: aBlock
| result |
result _ self retryAbort: messageText.
^result
ifTrue: [result]
ifFalse: [aBlock value]! !
!Object methodsFor: 'user dialogs' stamp: 'mir 2/23/2000 19:46'!
retryAbort: messageText
^SystemDialog concreteClass retryAbort: messageText! !
More information about the Squeak-dev
mailing list
|