Marcel Taeumel uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-mt.1211.mcz ==================== Summary ==================== Name: Morphic-mt.1211 Author: mt Time: 31 July 2016, 11:09:16.28949 am UUID: ea98f52e-1be2-e946-947b-465339d1c150 Ancestors: Morphic-mt.1210 *** Widget Refactorings and UI Themes (Part 5 of 11) *** Some fixes and refactorings for dialogs including added support for UI theming. =============== Diff against Morphic-mt.1210 =============== Item was added: + Morph subclass: #DialogWindow + instanceVariableNames: 'titleMorph messageMorph paneMorph buttonRow result selectedButton cancelButton timeout preferredPosition keyMap exclusive' + classVariableNames: 'GradientDialog RoundedDialogCorners UseWiggleAnimation' + poolDictionaries: '' + category: 'Morphic-Windows'! + + !DialogWindow commentStamp: '<historical>' prior: 0! + A DialogBoxMorph is Morph used in simple yes/no/confirm dialogs. Strongly modal.! Item was added: + ----- Method: DialogWindow class>>gradientDialog (in category 'preferences') ----- + gradientDialog + + <preference: 'gradientDialog' + category: 'dialogs' + description: 'If true, dialogs will have a gradient look.' + type: #Boolean> + ^ GradientDialog ifNil: [true] + ! Item was added: + ----- Method: DialogWindow class>>gradientDialog: (in category 'preferences') ----- + gradientDialog: aBoolean + + aBoolean = GradientDialog ifTrue: [^ self]. + GradientDialog := aBoolean. + self refreshAllDialogs.! Item was added: + ----- Method: DialogWindow class>>refreshAllDialogs (in category 'preferences') ----- + refreshAllDialogs + + self allSubInstances do: [:instance | instance setDefaultParameters; setTitleParameters].! Item was added: + ----- Method: DialogWindow class>>roundedDialogCorners (in category 'preferences') ----- + roundedDialogCorners + <preference: 'Rounded Dialog Corners' + categoryList: #(windows dialogs) + description: 'Governs whether dialog windows should have rounded corners' + type: #Boolean> + ^ RoundedDialogCorners ifNil: [ true ]! Item was added: + ----- Method: DialogWindow class>>roundedDialogCorners: (in category 'preferences') ----- + roundedDialogCorners: aBoolean + + RoundedDialogCorners = aBoolean ifTrue: [^ self]. + RoundedDialogCorners := aBoolean. + self refreshAllDialogs.! Item was added: + ----- Method: DialogWindow class>>themeProperties (in category 'preferences') ----- + themeProperties + + ^ super themeProperties, { + { #borderColor. 'Colors'. 'Color of the dialogs''s border.' }. + { #borderWidth. 'Borders'. 'Width of the dialogs''s border.' }. + { #borderStyle. 'Borders'. 'Whether to use a plain border, inset, or outset.' }. + { #color. 'Colors'. 'Background color of the dialog.' }. + { #font. 'Fonts'. 'Font for dialog messages.' }. + { #textColor. 'Colors'. 'Color for dialog messages.' }. + + { #titleBorderColor. 'Colors'. 'Color of the dialogs title border.' }. + { #titleBorderWidth. 'Geometry'. 'Width of the dialog title border.' }. + { #titleBorderStyle. 'Borders'. 'Whether to use a plain border, inset, or outset for the title.' }. + { #titleColor. 'Colors'. 'Background color of the dialogs'' title.' }. + { #titleFont. 'Fonts'. 'Font for dialog title.' }. + { #titleTextColor. 'Colors'. 'Color for the dialog title label.' }. + + { #okColor. 'Colors'. 'Color for the OK button.' }. + { #cancelColor. 'Colors'. 'Color for the Cancel button.' }. + { #buttonColor. 'Colors'. 'Color for a normal button.' }. + { #selectionModifier. 'Colors'. 'How to convert the color of a selected button?' }. + }! Item was added: + ----- Method: DialogWindow class>>useWiggleAnimation (in category 'preferences') ----- + useWiggleAnimation + + <preference: 'Use Wiggle Animation in Modal Dialogs' + categoryList: #(Morphic windows dialogs) + description: 'In order to indicate that a modal dialog is waiting for a user''s input, wiggle instead of flash.' + type: #Boolean> + ^ UseWiggleAnimation ifNil: [true]! Item was added: + ----- Method: DialogWindow class>>useWiggleAnimation: (in category 'preferences') ----- + useWiggleAnimation: aBoolean + + UseWiggleAnimation := aBoolean.! Item was added: + ----- Method: DialogWindow>>addPaneMorph: (in category 'constructing') ----- + addPaneMorph: aMorph + + self paneMorph addMorphBack: aMorph.! Item was added: + ----- Method: DialogWindow>>applyUserInterfaceTheme (in category 'updating') ----- + applyUserInterfaceTheme + + super applyUserInterfaceTheme. + + self + setDefaultParameters; + setTitleParameters; + setMessageParameters. + + "Update all buttons." + selectedButton in: [:sb | + self buttons do: [:ea | + ea setProperty: #normalColor toValue: self defaultButtonColor. + self deselectButton: ea]. + sb ifNotNil: [self selectButton: sb]].! Item was added: + ----- Method: DialogWindow>>buttonRowMorph (in category 'accessing - ui') ----- + buttonRowMorph + ^ buttonRow! Item was added: + ----- Method: DialogWindow>>buttons (in category 'accessing - ui') ----- + buttons + + ^buttonRow submorphs! Item was added: + ----- Method: DialogWindow>>cancelButton (in category 'accessing - ui') ----- + cancelButton + ^ cancelButton! Item was added: + ----- Method: DialogWindow>>cancelDialog (in category 'running') ----- + cancelDialog + + self cancelButton + ifNil: [self closeDialog: nil] + ifNotNil: [:btn | btn performAction]. ! Item was added: + ----- Method: DialogWindow>>closeDialog (in category 'running') ----- + closeDialog + + self selectedButton + ifNil: [self closeDialog: nil] + ifNotNil: [:btn | btn performAction]. ! Item was added: + ----- Method: DialogWindow>>closeDialog: (in category 'running') ----- + closeDialog: returnValue + result := returnValue. + self delete.! Item was added: + ----- Method: DialogWindow>>createAcceptButton (in category 'constructing') ----- + createAcceptButton + + ^ self + createButton: 'Accept' translated + value: true + color: (self userInterfaceTheme okColor ifNil: [Color r: 0.49 g: 0.749 b: 0.49])! Item was added: + ----- Method: DialogWindow>>createBody (in category 'initialization') ----- + createBody + + | body | + body := Morph new + changeTableLayout; + hResizing: #shrinkWrap; + vResizing: #shrinkWrap; + listDirection: #topToBottom; + cellPositioning: #leftCenter; + layoutInset: (10@5 corner: 10@10); + cellInset: 5; + color: Color transparent; + yourself. + body addAllMorphs: {self createMessage: ''. self createPane. self createButtonRow}. + self addMorphBack: body.! Item was added: + ----- Method: DialogWindow>>createButton: (in category 'constructing') ----- + createButton: buttonLabel + + ^ self + createButton: buttonLabel + value: self buttonRow submorphs size + 1 + color: self defaultButtonColor! Item was added: + ----- Method: DialogWindow>>createButton:value: (in category 'constructing') ----- + createButton: buttonLabel value: buttonValue + + ^ self + createButton: buttonLabel + value: buttonValue + color: self defaultButtonColor! Item was added: + ----- Method: DialogWindow>>createButton:value:color: (in category 'constructing') ----- + createButton: buttonLabel value: buttonValue color: buttonColor + + | button | + button := PluggableButtonMorphPlus new + label: buttonLabel ; + action: [ self closeDialog: buttonValue ] ; + setProperty: #normalColor toValue: buttonColor ; + setProperty: #normalLabel toValue: buttonLabel ; + hResizing: #rigid; + vResizing: #rigid; + yourself. + + self deselectButton: button. + buttonRow addMorphBack: button. + self updateButtonExtent. + + ^ button! Item was added: + ----- Method: DialogWindow>>createButtonRow (in category 'initialization') ----- + createButtonRow + + ^ buttonRow := Morph new + color: Color transparent; + changeTableLayout; + vResizing: #shrinkWrap; + hResizing: #spaceFill; + listDirection: #leftToRight; + listCentering: #center; + cellInset: 5; + yourself! Item was added: + ----- Method: DialogWindow>>createCancelButton (in category 'constructing') ----- + createCancelButton + + ^ cancelButton := self + createButton: 'Cancel' translated + value: false + color: (self userInterfaceTheme cancelColor ifNil: [Color r: 1 g: 0.6 b: 0.588])! Item was added: + ----- Method: DialogWindow>>createCancelButton:value: (in category 'constructing') ----- + createCancelButton: label value: result + + ^ cancelButton := self + createButton: label + value: result! Item was added: + ----- Method: DialogWindow>>createMessage: (in category 'initialization') ----- + createMessage: aString + + messageMorph := aString asText asMorph lock. + self setMessageParameters. + ^ messageMorph! Item was added: + ----- Method: DialogWindow>>createPane (in category 'initialization') ----- + createPane + + ^ paneMorph := BorderedMorph new + changeProportionalLayout; + hResizing: #rigid; + vResizing: #rigid; + layoutInset: 0; + color: Color transparent; + borderWidth: 0; + yourself.! Item was added: + ----- Method: DialogWindow>>createTitle: (in category 'initialization') ----- + createTitle: aString + "Mimick behavior of MenuMorph title creation." + + | box closeButton menuButton | + box := Morph new + name: #title; + changeTableLayout; + listDirection: #leftToRight; + listCentering: #justified; + yourself. + + titleMorph := aString asText asMorph lock. + + closeButton := SystemWindowButton new + color: Color transparent; + target: self; + extent: 12@12; + actionSelector: #cancelDialog; + balloonText: 'Cancel this dialog' translated; + borderWidth: 0; + labelGraphic: SystemWindow closeBoxImage; + extent: SystemWindow closeBoxImage extent; + yourself. + + menuButton := SystemWindowButton new + color: Color transparent; + target: self; + actionSelector: #offerDialogMenu; + balloonText: 'Dialog menu' translated; + borderWidth: 0; + labelGraphic: SystemWindow menuBoxImage; + extent: SystemWindow menuBoxImage extent; + yourself. + + box addAllMorphs: {closeButton. titleMorph. menuButton}. + + self addMorphBack: box. + self setTitleParameters. + ! Item was added: + ----- Method: DialogWindow>>defaultButtonColor (in category 'accessing') ----- + defaultButtonColor + + ^ self userInterfaceTheme buttonColor ifNil: [(Color r: 0.658 g: 0.678 b: 0.78) twiceLighter]! Item was added: + ----- Method: DialogWindow>>deselectButton: (in category 'selection') ----- + deselectButton: aButton + + aButton ifNil: [^ self]. + aButton offColor: (aButton valueOfProperty: #normalColor). + aButton == selectedButton ifTrue: [selectedButton := nil].! Item was added: + ----- Method: DialogWindow>>drawOverlayOn: (in category 'drawing') ----- + drawOverlayOn: aCanvas + + | title inset | + super drawOverlayOn: aCanvas. + + title := self submorphs first. + + self wantsRoundedCorners ifTrue: [ + inset := (self class roundedDialogCorners and: [self class gradientDialog]) + "This check compensates a bug in balloon." + ifTrue: [0@0 corner: 0@ -1] ifFalse: [self borderWidth @ 0]. + + "Overdraw lower part of title bar to hide bottom corners." + aCanvas + fillRectangle:( (title bottomLeft - (0 @ self submorphs first cornerRadius) corner: title bottomRight) insetBy: inset) + color: self color]. + + "Draw a line between the title and the contents." + self borderWidth > 0 ifTrue: [ + "Redraw the border all around. Needed because rounded borders do not align very well." + self wantsRoundedCorners + ifTrue: [ aCanvas frameRoundRect: self bounds radius: self cornerRadius width: self borderStyle width color: self borderStyle color] + ifFalse: [aCanvas frameRectangle: self bounds width: self borderStyle width color: self borderStyle color]].! Item was added: + ----- Method: DialogWindow>>ensureSelectedButton (in category 'selection') ----- + ensureSelectedButton + + self selectedButton ifNil: [self selectButton: self buttons first].! Item was added: + ----- Method: DialogWindow>>exclusive (in category 'accessing') ----- + exclusive + + ^ exclusive! Item was added: + ----- Method: DialogWindow>>exclusive: (in category 'accessing') ----- + exclusive: aBoolean + + exclusive := aBoolean. + + exclusive + ifTrue: [self activeHand newMouseFocus: self] + ifFalse: [self activeHand releaseMouseFocus: self].! Item was added: + ----- Method: DialogWindow>>exploreInvocation (in category 'running') ----- + exploreInvocation + + | result context | + self exclusive: false. "We want to explore." + + result := OrderedCollection new. + context := thisContext. + + [context method selector = #getUserResponse] + whileFalse: [context := context sender]. + + [context sender] whileNotNil: [ + result add: context method. + context := context sender]. + result add: context method. + + result explore.! Item was added: + ----- Method: DialogWindow>>flash (in category 'running') ----- + flash + "Flash me" + Beeper beepPrimitive. + + self class useWiggleAnimation ifTrue: [ + #(-2 4 -6 8 -4) do: [:i | + self left: self left + i. + self refreshWorld. + ] separatedBy: [(Delay forMilliseconds: 50) wait] + ] ifFalse: [ + 1 to: 2 do:[:i| + self color: Color black. + self world doOneCycleNow. + (Delay forMilliseconds: 50) wait. + self color: Color white. + self world doOneCycleNow. + (Delay forMilliseconds: 50) wait] ]! Item was added: + ----- Method: DialogWindow>>getUserResponse (in category 'running') ----- + getUserResponse + + | hand world | + (ProvideAnswerNotification signal: self title asString) ifNotNil: [:answer| ^ answer]. + + self message ifEmpty: [messageMorph delete]. "Do not waste space." + self paneMorph submorphs ifEmpty: [self paneMorph delete]. "Do not waste space." + + hand := self currentHand. + world := self currentWorld. + + self fullBounds. + self center: preferredPosition. + self bounds: (self bounds translatedToBeWithin: world bounds). + self openInWorld: world. + + hand keyboardFocus in: [:priorKeyboardFocus | + hand mouseFocus in: [:priorMouseFocus | + self exclusive ifTrue: [hand newMouseFocus: self]. + hand newKeyboardFocus: self. + + [self isInWorld] whileTrue:[world doOneSubCycle]. + + hand newKeyboardFocus: priorKeyboardFocus. + self exclusive ifTrue: [ + hand newMouseFocus: priorMouseFocus]]]. + + ^ result! Item was added: + ----- Method: DialogWindow>>getUserResponseAfter: (in category 'running') ----- + getUserResponseAfter: seconds + + timeout := seconds + 1. + + self ensureSelectedButton. + self step. + self updateButtonExtent. + + ^ self getUserResponse! Item was added: + ----- Method: DialogWindow>>getUserResponseAtHand (in category 'running') ----- + getUserResponseAtHand + + ^ self getUserResponseAtHand: ActiveHand! Item was added: + ----- Method: DialogWindow>>getUserResponseAtHand: (in category 'running') ----- + getUserResponseAtHand: aHand + + self message ifEmpty: [messageMorph delete]. "Do not waste space." + self paneMorph submorphs ifEmpty: [self paneMorph delete]. "Do not waste space." + + self moveSelectedButtonToHand: aHand. + ^ self getUserResponse! Item was added: + ----- Method: DialogWindow>>handleMouseUp: (in category 'events') ----- + handleMouseUp: event + + super handleMouseUp: event. + self exclusive ifTrue: [event hand newMouseFocus: self].! Item was added: + ----- Method: DialogWindow>>handlesKeyboard: (in category 'events') ----- + handlesKeyboard: evt + + ^true! Item was added: + ----- Method: DialogWindow>>handlesMouseDown: (in category 'events') ----- + handlesMouseDown: evt + + ^ true! Item was added: + ----- Method: DialogWindow>>initialExtent (in category 'initialization') ----- + initialExtent + + ^ 200@150! Item was added: + ----- Method: DialogWindow>>initialize (in category 'initialization') ----- + initialize + + super initialize. + + self + changeTableLayout; + listDirection: #topToBottom; + hResizing: #shrinkWrap; + vResizing: #shrinkWrap; + setProperty: #indicateKeyboardFocus toValue: #never. + + self createTitle: 'Dialog'. + self createBody. + + self setDefaultParameters. + + keyMap := Dictionary new. + exclusive := true. + preferredPosition := ActiveWorld center.! Item was added: + ----- Method: DialogWindow>>justDroppedInto:event: (in category 'dropping/grabbing') ----- + justDroppedInto: aMorph event: event + + "Restore drop shadow if necessary." + self hasDropShadow: Preferences menuAppearance3d. + + self exclusive ifTrue: [ + "aggressively preserve focus" + event hand newMouseFocus: self].! Item was added: + ----- Method: DialogWindow>>keyStroke: (in category 'events') ----- + keyStroke: evt + | char | + self stopAutoTrigger. + char := evt keyCharacter. + + char = Character escape ifTrue: [ ^ self cancelDialog ]. + (char = Character cr or: [char = Character enter]) ifTrue: [ ^ self closeDialog ]. + + ((char = Character arrowLeft or: [char = Character arrowUp]) + or: [ evt shiftPressed and: [ char = Character tab ] ]) + ifTrue: [ ^ self selectPreviousButton ]. + ((char = Character arrowRight or: [char = Character arrowDown]) + or: [ char = Character tab ]) + ifTrue: [ ^ self selectNextButton ]. + + keyMap + at: char asLowercase + ifPresent: [ : foundButton | foundButton performAction ] + ifAbsent: [ "do nothing" ].! Item was added: + ----- Method: DialogWindow>>message (in category 'accessing') ----- + message + ^messageMorph contents! Item was added: + ----- Method: DialogWindow>>message: (in category 'accessing') ----- + message: aStringOrText + + messageMorph contents: aStringOrText. + self setMessageParameters.! Item was added: + ----- Method: DialogWindow>>messageMorph (in category 'accessing - ui') ----- + messageMorph + ^ messageMorph! Item was added: + ----- Method: DialogWindow>>mouseDown: (in category 'events') ----- + mouseDown: event + + self stopAutoTrigger. + + "Always bring me to the front since I am modal" + self comeToFront. + + (self containsPoint: event position) + ifFalse:[^ self flash]. + + event hand + waitForClicksOrDrag: self + event: event + selectors: { nil. nil. nil. #startDrag: } + threshold: HandMorph dragThreshold.! Item was added: + ----- Method: DialogWindow>>mouseUp: (in category 'events') ----- + mouseUp: event + self stopAutoTrigger. + ! Item was added: + ----- Method: DialogWindow>>moveSelectedButtonToHand: (in category 'position') ----- + moveSelectedButtonToHand: aHand + "Just let the user confirm the selected button without having to reposition the mouse." + + self ensureSelectedButton. + self moveTo: self fullBounds center + (aHand position - self selectedButton center).! Item was added: + ----- Method: DialogWindow>>moveTo: (in category 'position') ----- + moveTo: position + + preferredPosition := position.! Item was added: + ----- Method: DialogWindow>>moveToHand (in category 'position') ----- + moveToHand + + self moveToHand: self activeHand.! Item was added: + ----- Method: DialogWindow>>moveToHand: (in category 'position') ----- + moveToHand: aHand + + self moveTo: aHand position.! Item was added: + ----- Method: DialogWindow>>offerDialogMenu (in category 'running') ----- + offerDialogMenu + + | menu | + menu := MenuMorph new defaultTarget: self. + menu + add: (exclusive == true ifTrue: ['<yes>'] ifFalse: ['<no>']), 'be modally exclusive' translated + action: #toggleExclusive; + addLine; + add: 'explore dialog invocation' translated + action: #exploreInvocation. + + menu popUpEvent: self currentEvent in: self world. + + [menu isInWorld] whileTrue: [self world doOneSubCycle]. + self exclusive ifTrue: [self activeHand newMouseFocus: self].! Item was added: + ----- Method: DialogWindow>>paneMorph (in category 'accessing - ui') ----- + paneMorph + ^ paneMorph! Item was added: + ----- Method: DialogWindow>>processFocusEvent:using: (in category 'events') ----- + processFocusEvent: evt using: dispatcher + + ^ dispatcher dispatchFocusEventFully: evt with: self! Item was added: + ----- Method: DialogWindow>>registerKeyboardShortcutFor: (in category 'constructing') ----- + registerKeyboardShortcutFor: button + "Take the first alpha-numeric character that is not already used as a shortcut, and use it as a shortcut." + + (button valueOfProperty: #normalLabel) asString in: [:normalLabel | normalLabel do: [:char | + char isAlphaNumeric ifTrue: [ keyMap + at: char asLowercase + ifPresent: [] + ifAbsent: [ + button label: ('{1} ({2})' format: {normalLabel. char}). + ^ keyMap at: char asLowercase put: button ] ] ] ]! Item was added: + ----- Method: DialogWindow>>registerKeyboardShortcuts (in category 'constructing') ----- + registerKeyboardShortcuts + + self buttons do: [:ea | self registerKeyboardShortcutFor: ea].! Item was added: + ----- Method: DialogWindow>>selectButton: (in category 'selection') ----- + selectButton: aButton + + | buttonColor | + buttonColor := ((self userInterfaceTheme selectionModifier ifNil: [ [:c | c muchLighter] ]) value: (aButton valueOfProperty: #normalColor)). + self deselectButton: selectedButton. + aButton offColor: buttonColor. + selectedButton := aButton.! Item was added: + ----- Method: DialogWindow>>selectNextButton (in category 'selection') ----- + selectNextButton + + self selectedButton ifNil: [^ self]. + self selectedButtonIndex: self selectedButtonIndex \\ self buttons size + 1.! Item was added: + ----- Method: DialogWindow>>selectPreviousButton (in category 'selection') ----- + selectPreviousButton + + self selectedButton ifNil: [^ self]. + self selectedButtonIndex: self selectedButtonIndex - 2 \\ self buttons size + 1.! Item was added: + ----- Method: DialogWindow>>selectedButton (in category 'accessing') ----- + selectedButton + ^ selectedButton! Item was added: + ----- Method: DialogWindow>>selectedButton: (in category 'accessing') ----- + selectedButton: aButton + + aButton + ifNil: [self deselectButton: self selectedButton] + ifNotNil: [self selectButton: aButton].! Item was added: + ----- Method: DialogWindow>>selectedButtonIndex (in category 'accessing') ----- + selectedButtonIndex + + ^ self selectedButton + ifNil: [0] + ifNotNil: [:btn | self buttons indexOf: btn]! Item was added: + ----- Method: DialogWindow>>selectedButtonIndex: (in category 'accessing') ----- + selectedButtonIndex: anInteger + + anInteger = 0 ifTrue: [^ self selectedButton: nil]. + self selectedButton: (self buttons at: anInteger).! Item was added: + ----- Method: DialogWindow>>setDefaultParameters (in category 'initialization') ----- + setDefaultParameters + "change the receiver's appareance parameters" + + self + color: (self userInterfaceTheme color ifNil: [Color white]); + borderStyle: (self userInterfaceTheme borderStyle ifNil: [BorderStyle default]); + borderColor: (self userInterfaceTheme borderColor ifNil: [Color gray]); + borderWidth: (self userInterfaceTheme borderWidth ifNil: [1]); + layoutInset: ((self class roundedDialogCorners and: [self class gradientDialog]) + "This check compensates a bug in balloon." + ifTrue: [0] ifFalse: [self borderWidth negated asPoint]). + + Preferences menuAppearance3d ifTrue: [self addDropShadow].! Item was added: + ----- Method: DialogWindow>>setMessageParameters (in category 'initialization') ----- + setMessageParameters + + messageMorph ifNotNil: [ + | fontToUse colorToUse | + fontToUse := self userInterfaceTheme font ifNil: [TextStyle defaultFont]. + colorToUse := self userInterfaceTheme textColor ifNil: [Color black]. + + messageMorph contents + addAttribute: (TextFontReference toFont: fontToUse); + addAttribute: (TextColor color: colorToUse). + messageMorph releaseParagraph; changed].! Item was added: + ----- Method: DialogWindow>>setTitleParameters (in category 'initialization') ----- + setTitleParameters + + (self submorphNamed: #title) ifNotNil: [:title | + title + fillStyle: (self class gradientDialog + ifFalse: [SolidFillStyle color: (self userInterfaceTheme titleColor ifNil: [Color r: 0.658 g: 0.678 b: 0.78])] + ifTrue: [self titleGradientFor: title from: (self userInterfaceTheme titleColor ifNil: [Color r: 0.658 g: 0.678 b: 0.78])]); + borderStyle: (self userInterfaceTheme titleBorderStyle ifNil: [BorderStyle default]); + borderColor: (self userInterfaceTheme titleBorderColor ifNil: [Color r: 0.6 g: 0.7 b: 1]); + borderWidth: (self userInterfaceTheme titleBorderWidth ifNil: [0]); + cornerStyle: (self wantsRoundedCorners ifTrue: [#rounded] ifFalse: [#square]); + vResizing: #shrinkWrap; + hResizing: #spaceFill; + wrapCentering: #center; + cellPositioning: #center; + cellInset: 0; + layoutInset: (5@3 corner: 5@ (2+(self wantsRoundedCorners ifFalse: [0] ifTrue: [self cornerRadius])))]. + + titleMorph ifNotNil: [ + | fontToUse colorToUse | + fontToUse := self userInterfaceTheme titleFont ifNil: [TextStyle defaultFont]. + colorToUse := self userInterfaceTheme titleTextColor ifNil: [Color black]. + + titleMorph contents + addAttribute: (TextFontReference toFont: fontToUse); + addAttribute: (TextColor color: colorToUse). + titleMorph releaseParagraph; changed].! Item was added: + ----- Method: DialogWindow>>startDrag: (in category 'dropping/grabbing') ----- + startDrag: event + + self hasDropShadow: false. + event hand grabMorph: self.! Item was added: + ----- Method: DialogWindow>>step (in category 'stepping and presenter') ----- + step + timeout ifNil: [^self]. + timeout = 0 + ifTrue: [ + self stopStepping. + selectedButton performAction] + ifFalse: [ + selectedButton label: ('{1} ({2})' format: { + selectedButton valueOfProperty: #normalLabel. + timeout}). + timeout := timeout - 1]! Item was added: + ----- Method: DialogWindow>>stepTime (in category 'stepping and presenter') ----- + stepTime + ^1000! Item was added: + ----- Method: DialogWindow>>stopAutoTrigger (in category 'stepping and presenter') ----- + stopAutoTrigger + timeout ifNil: [^self]. + timeout := nil. + self stopStepping. + selectedButton label: (selectedButton valueOfProperty: #normalLabel). ! Item was added: + ----- Method: DialogWindow>>title (in category 'accessing') ----- + title + ^titleMorph contents! Item was added: + ----- Method: DialogWindow>>title: (in category 'accessing') ----- + title: aString + + titleMorph contents: aString asText. + self setTitleParameters.! Item was added: + ----- Method: DialogWindow>>titleGradientFor:from: (in category 'initialization') ----- + titleGradientFor: morph from: aColor + + | cc gradient | + cc := aColor. + gradient := GradientFillStyle ramp: { + 0.0 -> Color white. + 0.15 ->(cc mixed: 0.5 with: Color white). + 0.7 -> cc. + }. + gradient origin: morph topLeft. + gradient direction: 0 @ (TextStyle defaultFont height + 10). + ^ gradient! Item was added: + ----- Method: DialogWindow>>toggleExclusive (in category 'running') ----- + toggleExclusive + + self exclusive: self exclusive not.! Item was added: + ----- Method: DialogWindow>>update: (in category 'updating') ----- + update: aspect + + aspect == #buttons + ifTrue: [self updateButtonExtent]. + + ^ super update: aspect! Item was added: + ----- Method: DialogWindow>>updateButtonExtent (in category 'updating') ----- + updateButtonExtent + + self updateButtonExtent: 20@10.! Item was added: + ----- Method: DialogWindow>>updateButtonExtent: (in category 'updating') ----- + updateButtonExtent: margin + + "Update all button extents." + (buttonRow submorphs collect: [:ea | ea minimumExtent]) max + margin in: [:preferredExtent | + buttonRow submorphsDo: [:ea | ea extent: preferredExtent]]. + + "See if horizontal button layout would be more appropriate." + self flag: #magicNumber. "mt: Remove number with computation, maybe choose button font and 20 characters" + (buttonRow submorphs collect: [:ea | ea fullBounds width]) sum > 400 + ifTrue: [buttonRow + hResizing: #shrinkWrap; + listDirection: #topToBottom; + layoutInset: (buttonRow owner fullBounds width - (buttonRow owner layoutInset left*2) - buttonRow submorphs first fullBounds width // 2@0)] + ifFalse: [buttonRow + hResizing: #spaceFill; + listDirection: #leftToRight; + layoutInset: 0].! Item was added: + ----- Method: DialogWindow>>wantsRoundedCorners (in category 'rounding') ----- + wantsRoundedCorners + + ^ self class roundedDialogCorners or: [super wantsRoundedCorners]! Item was added: + ----- Method: DialogWindow>>wantsToBeDroppedInto: (in category 'dropping/grabbing') ----- + wantsToBeDroppedInto: aMorph + "Return true if it's okay to drop the receiver into aMorph" + ^aMorph isWorldMorph "only into worlds"! Item was changed: + DialogWindow subclass: #FillInTheBlankMorph - RectangleMorph subclass: #FillInTheBlankMorph instanceVariableNames: 'response done textPane responseUponCancel' + classVariableNames: '' - classVariableNames: 'RoundedDialogCorners' poolDictionaries: '' category: 'Morphic-Windows'! Item was changed: ----- Method: FillInTheBlankMorph class>>request:initialAnswer:centerAt:inWorld:onCancelReturn:acceptOnCR:answerExtent: (in category 'instance creation') ----- request: queryString initialAnswer: defaultAnswer centerAt: aPoint inWorld: aWorld onCancelReturn: returnOnCancel acceptOnCR: acceptBoolean answerExtent: answerExtent "Create an instance of me whose question is queryString with the given initial answer. Invoke it centered at the given point, and answer the string the user accepts. If the user cancels, answer returnOnCancel." "FillInTheBlankMorph request: 'Type something, then type CR.' initialAnswer: 'yo ho ho!!' centerAt: Display center" | aFillInTheBlankMorph | aFillInTheBlankMorph := self new setQuery: queryString initialAnswer: defaultAnswer answerExtent: answerExtent acceptOnCR: acceptBoolean. + + aFillInTheBlankMorph createAcceptButton + action: [aFillInTheBlankMorph textPane accept]. + aFillInTheBlankMorph createCancelButton + action: [aFillInTheBlankMorph closeDialog: returnOnCancel]. + + aFillInTheBlankMorph moveTo: aPoint. - aFillInTheBlankMorph responseUponCancel: returnOnCancel. - aWorld addMorph: aFillInTheBlankMorph centeredNear: aPoint. ^ aFillInTheBlankMorph getUserResponse ! Item was changed: ----- Method: FillInTheBlankMorph class>>requestPassword:initialAnswer:centerAt:inWorld:onCancelReturn:acceptOnCR: (in category 'instance creation') ----- requestPassword: queryString initialAnswer: defaultAnswer centerAt: aPoint inWorld: aWorld onCancelReturn: returnOnCancel acceptOnCR: acceptBoolean "Create an instance of me whose question is queryString with the given initial answer. Invoke it centered at the given point, and answer the string the user accepts. If the user cancels, answer returnOnCancel." "FillInTheBlankMorph request: 'Type something, then type CR.' initialAnswer: 'yo ho ho!!' centerAt: Display center" | aFillInTheBlankMorph | aFillInTheBlankMorph := self new setPasswordQuery: queryString initialAnswer: defaultAnswer answerHeight: 50 acceptOnCR: acceptBoolean. + + aFillInTheBlankMorph createAcceptButton + action: [aFillInTheBlankMorph textPane accept]. + aFillInTheBlankMorph createCancelButton + action: [aFillInTheBlankMorph closeDialog: returnOnCancel]. + + aFillInTheBlankMorph moveTo: aPoint. + ^ aFillInTheBlankMorph getUserResponse! - aFillInTheBlankMorph responseUponCancel: returnOnCancel. - aWorld addMorph: aFillInTheBlankMorph centeredNear: aPoint. - ^ aFillInTheBlankMorph getUserResponse - ! Item was removed: - ----- Method: FillInTheBlankMorph class>>roundedDialogCorners (in category 'preferences') ----- - roundedDialogCorners - <preference: 'Rounded Dialog Corners' - category: 'windows' - description: 'Governs whether dialog windows should have rounded corners' - type: #Boolean> - ^ RoundedDialogCorners ifNil: [ true ]! Item was removed: - ----- Method: FillInTheBlankMorph class>>roundedDialogCorners: (in category 'preferences') ----- - roundedDialogCorners: aBoolean - - RoundedDialogCorners := aBoolean. - self allInstances do: [:instance | - aBoolean - ifTrue: [instance useRoundedCorners] - ifFalse: [instance useSquareCorners]].! Item was removed: - ----- Method: FillInTheBlankMorph>>accept (in category 'menu') ----- - accept - "Sent by the accept button." - - textPane accept. - ! Item was removed: - ----- Method: FillInTheBlankMorph>>cancel (in category 'menu') ----- - cancel - "Sent by the cancel button." - - response := responseUponCancel. - done := true. - ! Item was removed: - ----- Method: FillInTheBlankMorph>>convertToCurrentVersion:refStream: (in category 'object fileIn') ----- - convertToCurrentVersion: varDict refStream: smartRefStrm - - varDict at: 'responseUponCancel' ifAbsent: [responseUponCancel := '']. - ^super convertToCurrentVersion: varDict refStream: smartRefStrm. - - ! Item was removed: - ----- Method: FillInTheBlankMorph>>createAcceptButton (in category 'initialization') ----- - createAcceptButton - "create the [accept] button" - | result frame | - result := SimpleButtonMorph new target: self; - color: ColorTheme current okColor. - result - borderColor: (Preferences menuAppearance3d - ifTrue: [#raised] - ifFalse: [result color twiceDarker]). - result label: 'Accept(s)' translated; - actionSelector: #accept. - result setNameTo: 'accept'. - frame := LayoutFrame new. - frame rightFraction: 0.5; - rightOffset: -10; - bottomFraction: 1.0; - bottomOffset: -2. - result layoutFrame: frame. - self addMorph: result. - self - updateColor: result - color: result color - intensity: 2. - ^ result! Item was removed: - ----- Method: FillInTheBlankMorph>>createCancelButton (in category 'initialization') ----- - createCancelButton - "create the [cancel] button" - | result frame | - result := SimpleButtonMorph new target: self; - color: ColorTheme current cancelColor. - result - borderColor: (Preferences menuAppearance3d - ifTrue: [#raised] - ifFalse: [result color twiceDarker]). - result label: 'Cancel(l)' translated; - actionSelector: #cancel. - result setNameTo: 'cancel'. - frame := LayoutFrame new. - frame leftFraction: 0.5; - leftOffset: 10; - bottomFraction: 1.0; - bottomOffset: -2. - result layoutFrame: frame. - self addMorph: result. - self - updateColor: result - color: result color - intensity: 2. - ^ result! Item was removed: - ----- Method: FillInTheBlankMorph>>createQueryTextMorph: (in category 'initialization') ----- - createQueryTextMorph: queryString - "create the queryTextMorph" - | result frame | - result := TextMorph new contents: queryString. - result setNameTo: 'query' translated. - result lock. - frame := LayoutFrame new. - frame topFraction: 0.0; - topOffset: 2. - frame leftFraction: 0.5; - leftOffset: (result width // 2) negated. - result layoutFrame: frame. - self addMorph: result. - ^ result! Item was added: + ----- Method: FillInTheBlankMorph>>createTextPaneAcceptOnCR: (in category 'initialization') ----- + createTextPaneAcceptOnCR: acceptBoolean + + textPane := PluggableTextMorph + on: self + text: #response + accept: #response: + readSelection: #selectionInterval + menu: #codePaneMenu:shifted:. + textPane + showScrollBarsOnlyWhenNeeded; + wantsFrameAdornments: false; + hasUnacceptedEdits: true; + acceptOnCR: acceptBoolean; + setNameTo: 'textPane'; + layoutFrame: (LayoutFrame fractions: (0@0 corner: 1@1)); + hResizing: #spaceFill; + vResizing: #spaceFill. + + ^ textPane! Item was removed: - ----- Method: FillInTheBlankMorph>>createTextPaneExtent:acceptBoolean:topOffset:buttonAreaHeight: (in category 'initialization') ----- - createTextPaneExtent: answerExtent acceptBoolean: acceptBoolean topOffset: topOffset buttonAreaHeight: buttonAreaHeight - "create the textPane" - | result frame | - result := PluggableTextMorph - on: self - text: #response - accept: #response: - readSelection: #selectionInterval - menu: #codePaneMenu:shifted:. - result - extent: answerExtent; - showScrollBarsOnlyWhenNeeded; - hResizing: #spaceFill; - vResizing: #spaceFill; - borderWidth: 1; - hasUnacceptedEdits: true; - acceptOnCR: acceptBoolean; - setNameTo: 'textPane'. - frame := LayoutFrame new - leftFraction: 0.0; - rightFraction: 1.0; - topFraction: 0.0; - topOffset: topOffset; - bottomFraction: 1.0; - bottomOffset: buttonAreaHeight negated; - yourself. - result layoutFrame: frame. - self addMorph: result. - ^ result! Item was removed: - ----- Method: FillInTheBlankMorph>>defaultColor (in category 'initialization') ----- - defaultColor - "answer the default color/fill style for the receiver" - ^ Color white! Item was removed: - ----- Method: FillInTheBlankMorph>>delete (in category 'initialization') ----- - delete - - self breakDependents. - super delete.! Item was removed: - ----- Method: FillInTheBlankMorph>>extent: (in category 'geometry') ----- - extent: aPoint - "change the receiver's extent" - - super extent: aPoint . - self setDefaultParameters. - self updateColor! Item was added: + ----- Method: FillInTheBlankMorph>>filterEvent:for: (in category 'events') ----- + filterEvent: event for: morph + + (event isKeystroke and: [event keyCharacter = Character escape]) + ifTrue: [event ignore. self cancelDialog]. + + ^ event! Item was removed: - ----- Method: FillInTheBlankMorph>>getUserResponse (in category 'invoking') ----- - 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: [^ response]. - - (ProvideAnswerNotification signal: - (self submorphOfClass: TextMorph) userString) ifNotNil: - [:answer | - self delete. - w doOneCycle. - ^ response := (answer == #default) ifTrue: [response] ifFalse: [answer]]. - - done := false. - w activeHand newKeyboardFocus: textPane. - [done] whileFalse: [w doOneCycle]. - self delete. - w doOneCycle. - ^ response - ! Item was removed: - ----- Method: FillInTheBlankMorph>>handlesMouseDown: (in category 'event handling') ----- - handlesMouseDown: evt - ^true! Item was changed: ----- Method: FillInTheBlankMorph>>initialize (in category 'initialization') ----- initialize super initialize. + self addKeyboardCaptureFilter: self.! - self setDefaultParameters. - self extent: 400 @ 150. - responseUponCancel := ''. - self class roundedDialogCorners ifTrue: [self useRoundedCorners]. - ! Item was removed: - ----- Method: FillInTheBlankMorph>>morphicLayerNumber (in category 'invoking') ----- - morphicLayerNumber - - ^10.6! Item was removed: - ----- Method: FillInTheBlankMorph>>mouseDown: (in category 'event handling') ----- - mouseDown: evt - (self containsPoint: evt position) ifFalse:[^ Beeper beep]. "sent in response to outside modal click" - evt hand grabMorph: self. "allow repositioning"! Item was changed: ----- Method: FillInTheBlankMorph>>response (in category 'accessing') ----- response + ^ result - ^ response ! Item was changed: ----- Method: FillInTheBlankMorph>>response: (in category 'accessing') ----- response: aText "Sent when text pane accepts." + result := aText asString. + self delete. - response := aText asString. - done := true. - ^ true ! Item was removed: - ----- Method: FillInTheBlankMorph>>responseUponCancel: (in category 'initialization') ----- - responseUponCancel: anObject - responseUponCancel := anObject - ! Item was changed: ----- Method: FillInTheBlankMorph>>selectionInterval (in category 'accessing') ----- selectionInterval + ^ 1 to: result size - ^ 1 to: response size ! Item was changed: ----- Method: FillInTheBlankMorph>>setDefaultParameters (in category 'initialization') ----- setDefaultParameters - "change the receiver's appareance parameters" + super setDefaultParameters. + textPane ifNotNil: [:tp | tp borderColor: self borderColor].! - | colorFromMenu worldColor menuColor | - - colorFromMenu := Preferences menuColorFromWorld - and: [Display depth > 4 - and: [(worldColor := self currentWorld color) isColor]]. - - menuColor := colorFromMenu - ifTrue: [worldColor luminance > 0.7 - ifTrue: [worldColor mixed: 0.85 with: Color black] - ifFalse: [worldColor mixed: 0.4 with: Color white]] - ifFalse: [MenuMorph menuColor]. - - self color: menuColor. - self borderWidth: MenuMorph menuBorderWidth. - - Preferences menuAppearance3d ifTrue: [ - self borderStyle: BorderStyle thinGray. - self hasDropShadow: true. - - self useSoftDropShadow - ifFalse: [ - self - shadowColor: (TranslucentColor r: 0.0 g: 0.0 b: 0.0 alpha: 0.666); - shadowOffset: 1 @ 1] - ifTrue: [ - self - shadowColor: (TranslucentColor r: 0.0 g: 0.0 b: 0.0 alpha: 0.01); - shadowOffset: (10@8 corner: 10@12) ] - ] - ifFalse: [ - | menuBorderColor | - menuBorderColor := colorFromMenu - ifTrue: [worldColor muchDarker] - ifFalse: [MenuMorph menuBorderColor]. - self borderColor: menuBorderColor. - ]. - - - self layoutInset: 3. - ! Item was changed: ----- Method: FillInTheBlankMorph>>setPasswordQuery:initialAnswer:answerHeight:acceptOnCR: (in category 'initialization') ----- setPasswordQuery: queryString initialAnswer: initialAnswer answerHeight: answerHeight acceptOnCR: acceptBoolean + - | pane | self setQuery: queryString initialAnswer: initialAnswer answerHeight: answerHeight acceptOnCR: acceptBoolean. + textPane font: (StrikeFont passwordFontSize: 12).! - pane := self submorphNamed: 'textPane'. - pane font: (StrikeFont passwordFontSize: 12).! Item was changed: ----- Method: FillInTheBlankMorph>>setQuery:initialAnswer:answerExtent:acceptOnCR: (in category 'initialization') ----- setQuery: queryString initialAnswer: initialAnswer answerExtent: answerExtent acceptOnCR: acceptBoolean + + | text | + + result := initialAnswer. - | query topOffset accept cancel buttonAreaHeight | - response := initialAnswer. done := false. + + self paneMorph removeAllMorphs. + + self title: 'Input Requested'. + self message: queryString. - self removeAllMorphs. - self layoutPolicy: ProportionalLayout new. - query := self createQueryTextMorph: queryString. - topOffset := query height + 4. - accept := self createAcceptButton. - cancel := self createCancelButton. - buttonAreaHeight := (accept height max: cancel height) - + 7. - textPane := self - createTextPaneExtent: answerExtent - acceptBoolean: acceptBoolean - topOffset: topOffset - buttonAreaHeight: buttonAreaHeight. + text := self createTextPaneAcceptOnCR: acceptBoolean. + self paneMorph addMorphBack: text. + + self paneMorph extent: ((initialAnswer asText asMorph extent + (20@10) max: answerExtent) min: 500@500). + self setDefaultParameters.! - self extent: (((answerExtent max: query extent) - max: (initialAnswer asText asMorph extent)) min: 500@500) + (20@30) + (0 @ (topOffset + buttonAreaHeight))! Item was added: + ----- Method: FillInTheBlankMorph>>textPane (in category 'accessing') ----- + textPane + ^ textPane! Item was removed: - ----- Method: FillInTheBlankMorph>>undoGrabCommand (in category 'grabbing/dropping') ----- - undoGrabCommand - ^nil! Item was removed: - ----- Method: FillInTheBlankMorph>>updateColor (in category 'initialization') ----- - updateColor - "update the recevier's fillStyle" - | textPaneBorderColor | - self - updateColor: self - color: self color - intensity: 1. - textPane isNil - ifTrue: [^ self]. - textPaneBorderColor := self borderColor == #raised - ifTrue: [#inset] - ifFalse: [self borderColor]. - textPane borderColor: textPaneBorderColor! Item was removed: - ----- Method: FillInTheBlankMorph>>updateColor:color:intensity: (in category 'initialization') ----- - updateColor: aMorph color: aColor intensity: anInteger - "update the apareance of aMorph" - | fill | - MenuMorph gradientMenu - ifFalse: [^ self]. - - fill := GradientFillStyle ramp: {0.0 -> Color white. 1 -> aColor}. - fill radial: false; - origin: aMorph topLeft; - direction: 0 @ aMorph height. - aMorph fillStyle: fill! Item was changed: Morph subclass: #NewBalloonMorph instanceVariableNames: 'balloonOwner textMorph maximumWidth orientation hasTail' + classVariableNames: 'UseNewBalloonMorph' - classVariableNames: 'DefaultBalloonTextColor UseNewBalloonMorph' poolDictionaries: '' category: 'Morphic-Widgets'! !NewBalloonMorph commentStamp: 'mt 3/31/2015 10:15' prior: 0! A balloon is a bubble with an optional tail. It contains rich text, which describes something about its balloon-owner.! Item was removed: - ----- Method: NewBalloonMorph class>>defaultBalloonTextColor (in category 'preferences') ----- - defaultBalloonTextColor - - <preference: 'Default balloon text color' - categoryList: #(Morphic colors) - description: 'Specifies the default text color if no color information is provided via text attributes such as for plain strings. Otherwise the color information from the text attributes is used.' - type: #Color> - ^ DefaultBalloonTextColor ifNil: [Color black]! Item was removed: - ----- Method: NewBalloonMorph class>>defaultBalloonTextColor: (in category 'preferences') ----- - defaultBalloonTextColor: color - - DefaultBalloonTextColor := color.! Item was changed: ----- Method: NewBalloonMorph class>>string:for:corner: (in category 'instance creation') ----- string: message for: morph corner: symbol ^ self new - color: morph balloonColor; balloonOwner: morph; setText: message; orientation: symbol; yourself! Item was added: + ----- Method: NewBalloonMorph class>>themeProperties (in category 'preferences') ----- + themeProperties + + ^ super themeProperties, { + { #borderColor. 'Colors'. 'Color of the balloon''s border.' }. + { #borderWidth. 'Borders'. 'Width of the balloon''s border.' }. + { #color. 'Colors', 'Color for the balloon background.' }. + { #font. 'Fonts'. 'Font for balloon text if not overridden by text attributes.' }. + { #textColor. 'Colors'. 'Color for the balloon text if not overridden by text attributes.' }. + }! Item was added: + ----- Method: NewBalloonMorph>>applyUserInterfaceTheme (in category 'updating') ----- + applyUserInterfaceTheme + + super applyUserInterfaceTheme. + self setDefaultParameters.! Item was removed: - ----- Method: NewBalloonMorph>>defaultBorderColor (in category 'initialization') ----- - defaultBorderColor - - ^ self defaultColor muchDarker"Color black"! Item was removed: - ----- Method: NewBalloonMorph>>defaultBorderWidth (in category 'initialization') ----- - defaultBorderWidth - - ^ MenuMorph menuBorderWidth! Item was removed: - ----- Method: NewBalloonMorph>>defaultColor (in category 'initialization') ----- - defaultColor - - ^ BalloonMorph balloonColor! Item was changed: ----- Method: NewBalloonMorph>>drawOn: (in category 'drawing') ----- drawOn: aCanvas + self fillStyle isColor + ifFalse: [self fillStyle isGradientFill + ifTrue: [self fillStyle direction: 0 @ self height]]. "Bubble." self wantsRoundedCorners ifTrue: [aCanvas frameAndFillRoundRect: self bubbleBounds radius: self cornerRadius fillStyle: self fillStyle borderWidth: self borderStyle width borderColor: self borderStyle color] ifFalse: [aCanvas fillRectangle: self bubbleBounds fillStyle: self fillStyle borderStyle: self borderStyle]. "Tail." self hasTail ifTrue: [ self verticesForTail in: [:points | | pixelOffset | pixelOffset := points first y < points second y ifFalse: [points first x < points second x ifTrue: [self borderStyle width negated @ self borderStyle width] "bottomLeft" ifFalse: [self borderStyle width @ self borderStyle width]] "bottomRight" ifTrue: [points first x < points second x ifTrue: [self borderStyle width negated @ self borderStyle width negated] "topLeft" ifFalse: [self borderStyle width @ self borderStyle width negated]]. "topRight" aCanvas drawPolygon: points fillStyle: self fillStyle. aCanvas line: points first to: points second + pixelOffset width: self borderStyle width color: self borderStyle color. aCanvas line: points first to: points third + pixelOffset width: self borderStyle width color: self borderStyle color]]! Item was changed: ----- Method: NewBalloonMorph>>initialize (in category 'initialization') ----- initialize super initialize. + self setDefaultParameters. + - self - borderWidth: self defaultBorderWidth; - borderColor: self defaultBorderColor; - color: self defaultColor; - hasDropShadow: (Preferences menuAppearance3d and: [self defaultColor isTranslucent not]); - shadowOffset: 1@1; - shadowColor: (self color muchDarker muchDarker alpha: 0.333); - orientation: #bottomLeft. - - MenuMorph roundedMenuCorners - ifTrue: [self cornerStyle: #rounded]. - textMorph := TextMorph new wrapFlag: false; lock; yourself. self addMorph: textMorph.! Item was added: + ----- Method: NewBalloonMorph>>setDefaultParameters (in category 'initialization') ----- + setDefaultParameters + + self + borderWidth: (self userInterfaceTheme borderWidth ifNil: [1]); + borderColor: (self userInterfaceTheme borderColor ifNil: [Color r: 0.46 g: 0.46 b: 0.353]); + color: (self userInterfaceTheme color ifNil: [Color r: 0.92 g: 0.92 b: 0.706]); + hasDropShadow: (Preferences menuAppearance3d and: [self color isTranslucent not]); + shadowOffset: 1@1; + shadowColor: (self color muchDarker muchDarker alpha: 0.333); + orientation: #bottomLeft. + + MenuMorph roundedMenuCorners + ifTrue: [self cornerStyle: #rounded]. + + "Gradients?" + MenuMorph gradientMenu ifTrue: [ + | cc fill | + cc := self color. + fill := GradientFillStyle ramp: { + 0.0 -> Color white. + 0.15 -> (cc mixed: 0.5 with: Color white). + 0.5 -> cc. + 0.8 -> cc twiceDarker}. + fill + origin: self topLeft; + direction: 0@self height. + self fillStyle: fill].! Item was changed: ----- Method: NewBalloonMorph>>setText: (in category 'initialization') ----- setText: stringOrText | text | text := stringOrText asText. text unembellished ifTrue: [ + text addAttribute: (TextColor color: (self userInterfaceTheme textColor ifNil: [Color black]))]. - text addAttribute: (TextColor color: self class defaultBalloonTextColor)]. + text addAttribute: (TextFontReference toFont: (self userInterfaceTheme font ifNil: [TextStyle defaultFont])). - text addAttribute: (TextFontReference toFont: (self balloonOwner ifNil: [BalloonMorph]) balloonFont). self textMorph wrapFlag: false. self textMorph newContents: text. self textMorph fullBounds. (self maximumWidth > 0 and: [self textMorph width > self maximumWidth]) ifTrue: [ self textMorph wrapFlag: true; width: self maximumWidth]. self updateLayout.! Item was changed: + Morph subclass: #SystemProgressBarMorph + instanceVariableNames: 'barSize barColor' - RectangleMorph subclass: #SystemProgressBarMorph - instanceVariableNames: 'barSize' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Widgets'! !SystemProgressBarMorph commentStamp: 'laza 4/9/2004 11:47' prior: 0! Instances of this morph get used by SystemProgressMoprh to quickly display a progress bar.! Item was added: + ----- Method: SystemProgressBarMorph class>>themeProperties (in category 'preferences') ----- + themeProperties + + ^ super themeProperties, { + { #borderColor. 'Colors'. 'Color of the progress bar''s border.' }. + { #borderWidth. 'Borders'. 'Width of the progress bar''s border.' }. + { #borderStyle. 'Borders'. 'Whether to use a plain border, inset, or outset.' }. + { #color. 'Colors'. 'Background color of the progress bar.' }. + { #barColor. 'Colors'. 'Color of the progress bar''s bar.' }. + }! Item was added: + ----- Method: SystemProgressBarMorph>>applyUserInterfaceTheme (in category 'updating') ----- + applyUserInterfaceTheme + + super applyUserInterfaceTheme. + + self setDefaultParameters.! Item was changed: ----- Method: SystemProgressBarMorph>>drawOn: (in category 'drawing') ----- drawOn: aCanvas | area | super drawOn: aCanvas. barSize > 0 ifTrue: [ area := self innerBounds. + area := area origin extent: (barSize min: area extent x)@area extent y. + aCanvas fillRectangle: area color: barColor - area := area origin extent: barSize-2@area extent y. - aCanvas fillRectangle: area color: LazyListMorph listSelectionColor ]. ! Item was changed: ----- Method: SystemProgressBarMorph>>initialize (in category 'initialization') ----- initialize super initialize. + self setDefaultParameters. - self - borderWidth: 0; - color: MenuMorph menuColor muchLighter. - barSize := 0. ! Item was added: + ----- Method: SystemProgressBarMorph>>setDefaultParameters (in category 'initialization') ----- + setDefaultParameters + "change the receiver's appareance parameters" + + self + color: (self userInterfaceTheme color ifNil: [Color r: 0.977 g: 0.977 b: 0.977]); + borderStyle: (self userInterfaceTheme borderStyle ifNil: [BorderStyle default]); + borderColor: (self userInterfaceTheme borderColor ifNil: [Color transparent]); + borderWidth: (self userInterfaceTheme borderWidth ifNil: [0]). + + barColor := self userInterfaceTheme barColor ifNil: [Color r: 0.72 g: 0.72 b: 0.9].! Item was changed: + Morph subclass: #SystemProgressMorph + instanceVariableNames: 'activeSlots bars labels font lock requestedPosition textColor' - RectangleMorph subclass: #SystemProgressMorph - instanceVariableNames: 'activeSlots bars labels font lock requestedPosition' classVariableNames: 'BarHeight BarWidth Inset UniqueInstance' poolDictionaries: '' category: 'Morphic-Widgets'! !SystemProgressMorph commentStamp: '<historical>' prior: 0! An single instance of this morph class is used to display progress while the system is busy, eg. while it receives code updates or does a fileIn. To give the user progress information you don't deal directly with SystemProgressMorph. You keep on using the well established way of progress notification, that has been a long time in the system, is widely used and does not depend on the existence of SystemProgressMorph. For more information on this look at the example in this class or look at the comment of the method displayProgressAt:from:to:during: in class String. SystemProgressMorph is not meant to be used as a component inside other morphs. You can switch back to the old style of progress display by disabling the morphicProgressStyle setting in the morphic section of the preferences.! Item was added: + ----- Method: SystemProgressMorph class>>applyUserInterfaceTheme (in category 'preferences') ----- + applyUserInterfaceTheme + + self reset.! Item was added: + ----- Method: SystemProgressMorph class>>themeProperties (in category 'preferences') ----- + themeProperties + + ^ super themeProperties, { + { #borderColor. 'Colors'. 'Color of the progress'' border.' }. + { #borderWidth. 'Borders'. 'Width of the progress'' border.' }. + { #borderStyle. 'Borders'. 'Whether to use a plain border, inset, or outset.' }. + { #color. 'Colors'. 'Background color of the progress.' }. + + { #font. 'Fonts'. 'Font for bar labels.' }. + { #textColor. 'Colors'. 'Color for bar labels.' }. + }! Item was added: + ----- Method: SystemProgressMorph>>applyUserInterfaceTheme (in category 'updating') ----- + applyUserInterfaceTheme + + super applyUserInterfaceTheme. + + self setDefaultParameters.! Item was changed: ----- Method: SystemProgressMorph>>font: (in category 'accessing') ----- font: anObject + font := anObject. + self labels select: [:ea | ea notNil] thenDo: [:ea | ea font: font].! - font := anObject! Item was changed: ----- Method: SystemProgressMorph>>initialize (in category 'initialization') ----- initialize super initialize. activeSlots := 0. bars := Array new: 10. labels := Array new: 10. - font := Preferences standardMenuFont. lock := Semaphore forMutualExclusion. self setDefaultParameters; setProperty: #morphicLayerNumber toValue: self morphicLayerNumber; layoutPolicy: TableLayout new; listDirection: #topToBottom; cellPositioning: #leftCenter; cellInset: 5; listCentering: #center; hResizing: #shrinkWrap; vResizing: #shrinkWrap; layoutInset: Inset; minWidth: 150! Item was changed: ----- Method: SystemProgressMorph>>nextSlotFor: (in category 'private') ----- nextSlotFor: shortDescription lock critical: [ | label bar slots | slots := self labels size. self activeSlots = slots ifTrue: [^0]. self activeSlots: self activeSlots + 1. 1 to: slots do: [:index | label := (self labels at: index). label ifNil: [ bar := self bars at: index put: (SystemProgressBarMorph new extent: BarWidth@BarHeight). + label := self labels at: index put: ((StringMorph contents: shortDescription font: self font) color: self textColor). - label := self labels at: index put: (StringMorph contents: shortDescription font: self font). self addMorphBack: label; addMorphBack: bar. ^index]. label owner ifNil: [ bar := self bars at: index. label := self labels at: index. self addMorphBack: (label contents: shortDescription); addMorphBack: (bar barSize: 0). ^index]]] ! Item was changed: ----- Method: SystemProgressMorph>>setDefaultParameters (in category 'initialization') ----- setDefaultParameters "change the receiver's appareance parameters" + self + color: (self userInterfaceTheme color ifNil: [Color r: 0.9 g: 0.9 b: 0.9]); + borderStyle: (self userInterfaceTheme borderStyle ifNil: [BorderStyle default]); + borderColor: (self userInterfaceTheme borderColor ifNil: [Color gray]); + borderWidth: (self userInterfaceTheme borderWidth ifNil: [1]). - | colorFromMenu worldColor menuColor | + Preferences menuAppearance3d ifTrue: [self addDropShadow]. - colorFromMenu := Preferences menuColorFromWorld - and: [Display depth > 4 - and: [(worldColor := self currentWorld color) isColor]]. + self + font: (self userInterfaceTheme font ifNil: [TextStyle defaultFont]); + textColor: (self userInterfaceTheme textColor ifNil: [Color black]). - menuColor := colorFromMenu - ifTrue: [worldColor luminance > 0.7 - ifTrue: [worldColor mixed: 0.85 with: Color black] - ifFalse: [worldColor mixed: 0.4 with: Color white]] - ifFalse: [MenuMorph menuColor]. - self color: menuColor. - - MenuMorph roundedMenuCorners - ifTrue: [self useRoundedCorners]. - self borderWidth: MenuMorph menuBorderWidth. - - Preferences menuAppearance3d ifTrue: [ - self borderStyle: BorderStyle thinGray. - self hasDropShadow: true. - - self useSoftDropShadow - ifFalse: [ - self - shadowColor: (TranslucentColor r: 0.0 g: 0.0 b: 0.0 alpha: 0.666); - shadowOffset: 1 @ 1] - ifTrue: [ - self - shadowColor: (TranslucentColor r: 0.0 g: 0.0 b: 0.0 alpha: 0.01); - shadowOffset: (10@8 corner: 10@12) ] - ] - ifFalse: [ - | menuBorderColor | - menuBorderColor := colorFromMenu - ifTrue: [worldColor muchDarker] - ifFalse: [MenuMorph menuBorderColor]. - self borderColor: menuBorderColor. - ]. - self updateColor: self color: self color intensity: 1.! Item was added: + ----- Method: SystemProgressMorph>>textColor (in category 'accessing') ----- + textColor + + ^ textColor ifNil: [Color black]! Item was added: + ----- Method: SystemProgressMorph>>textColor: (in category 'accessing') ----- + textColor: aColor + + textColor := aColor. + self labels select: [:ea | ea notNil] thenDo: [:ea | ea color: textColor].! Item was changed: ----- Method: SystemProgressMorph>>updateColor:color:intensity: (in category 'initialization') ----- updateColor: aMorph color: aColor intensity: anInteger "update the apareance of aMorph" + | fill cc | - | fill | MenuMorph gradientMenu ifFalse: [^ self]. + + cc := aColor adjustSaturation: -0.08 brightness: 0.4. + fill := GradientFillStyle ramp: { + 0.0 -> cc. + 0.25 -> (aColor mixed: 0.5 with: cc). + 1.0 -> aColor}. + - fill := GradientFillStyle ramp: {0.0 -> Color white. 1 ->aColor}. fill radial: false; origin: aMorph topLeft; direction: 0 @ aMorph height. aMorph fillStyle: fill! Item was added: + ----- Method: SystemProgressMorph>>wantsRoundedCorners (in category 'rounding') ----- + wantsRoundedCorners + + ^ MenuMorph roundedMenuCorners or: [super wantsRoundedCorners]! Item was changed: + DialogWindow subclass: #UserDialogBoxMorph + instanceVariableNames: '' - AlignmentMorph subclass: #UserDialogBoxMorph - instanceVariableNames: 'titleMorph labelMorph buttonRow value selectedButton cancelButton timeout savedLabel keyMap' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Windows'! !UserDialogBoxMorph commentStamp: 'ar 12/11/2009 22:33' prior: 0! A DialogBoxMorph is Morph used in simple yes/no/confirm dialogs. Strongly modal.! Item was changed: ----- Method: UserDialogBoxMorph class>>confirm: (in category 'utilities') ----- confirm: aString "UserDialogBoxMorph confirm: 'Do you like chocolate?'" + ^self confirm: aString title: 'Please Confirm'! - ^self confirm: aString title: 'Please confirm:'! Item was changed: ----- Method: UserDialogBoxMorph class>>confirm:orCancel:at: (in category 'utilities') ----- confirm: aString orCancel: cancelBlock at: aPointOrNil ^self confirm: aString orCancel: cancelBlock + title: 'Please Confirm' - title: 'Please confirm:' at: aPointOrNil! Item was changed: ----- Method: UserDialogBoxMorph class>>confirm:orCancel:title:at: (in category 'utilities') ----- confirm: aString orCancel: cancelBlock title: titleString at: aPointOrNil + (self new - ^(self new title: titleString; + message: aString; + createButton: 'Yes' translated value: true; + createButton: 'No' translated value: false; + createButton: 'Cancel' translated value: nil; + selectedButtonIndex: 1; "YES" + yourself) in: [:dialog | + ^ (aPointOrNil + ifNil: [dialog getUserResponseAtHand] + ifNotNil: [ + dialog moveTo: aPointOrNil. + dialog getUserResponse]) + ifNil: [ cancelBlock value ]]! - label: aString; - addSelectedButton: 'Yes' translated value: true; - addButton: 'No' translated value: false; - addCancelButton: 'Cancel' translated value: nil; - runModalIn: ActiveWorld forHand: ActiveHand at: aPointOrNil) - ifNil: [ cancelBlock value ]! Item was changed: ----- Method: UserDialogBoxMorph class>>confirm:title:at: (in category 'utilities') ----- confirm: aString title: titleString at: aPointOrNil "UserDialogBoxMorph confirm: 'Make your choice carefully' withCRs title: 'Do you like chocolate?'" ^self new title: titleString; + message: aString; + createButton: 'Yes' translated value: true; + createCancelButton: 'No' translated value: false; + selectedButtonIndex: 1; "YES" + getUserResponseAtHand! - label: aString; - addSelectedButton: 'Yes' translated value: true; - addCancelButton: 'No' translated value: false; - runModalIn: ActiveWorld forHand: ActiveHand at: aPointOrNil! Item was changed: ----- Method: UserDialogBoxMorph class>>confirm:title:trueChoice:falseChoice:at: (in category 'utilities') ----- confirm: aString title: titleString trueChoice: trueChoice falseChoice: falseChoice at: aPointOrNil "UserDialogBoxMorph confirm: 'Make your choice carefully' withCRs title: 'Do you like chocolate?' trueChoice: 'Oh yessir!!' falseChoice: 'Not so much...'" ^self new title: titleString; + message: aString; + createButton: trueChoice translated value: true; + createCancelButton: falseChoice translated value: false; + selectedButtonIndex: 1; + moveTo: (aPointOrNil ifNil: [ActiveWorld center]); + getUserResponse! - label: aString; - addSelectedButton: trueChoice translated value: true; - addCancelButton: falseChoice translated value: false; - runModalIn: ActiveWorld forHand: ActiveHand at: aPointOrNil! Item was changed: ----- Method: UserDialogBoxMorph class>>confirm:title:trueChoice:falseChoice:default:triggerAfter:at: (in category 'utilities') ----- confirm: aString title: titleString trueChoice: trueChoice falseChoice: falseChoice default: default triggerAfter: seconds at: aPointOrNil "UserDialogBoxMorph confirm: 'I like hot java' title: 'What do you say?' trueChoice: 'You bet!!' falseChoice: 'Nope' default: false triggerAfter: 12 at: 121@212" ^self new title: titleString; + message: aString; + createButton: trueChoice translated value: true; + createCancelButton: falseChoice translated value: false; + selectedButtonIndex: (default ifTrue: [1] ifFalse: [2]); + moveTo: (aPointOrNil ifNil: [ActiveWorld center]); + getUserResponseAfter: seconds! - label: aString; - addButton: trueChoice translated value: true selected: default performActionOnEscape: false; - addButton: falseChoice translated value: false selected: default not performActionOnEscape: true; - triggerAfter: seconds; - runModalIn: ActiveWorld forHand: ActiveHand at: aPointOrNil! Item was changed: ----- Method: UserDialogBoxMorph class>>inform: (in category 'utilities') ----- inform: aString "UserDialogBoxMorph inform: 'Squeak is great!!'" + ^self inform: aString title: 'Note' translated! - ^self inform: aString title: 'Note:'! Item was changed: ----- Method: UserDialogBoxMorph class>>inform:title:at: (in category 'utilities') ----- inform: aString title: titleString at: aPointOrNil "UserDialogBoxMorph inform: 'Squeak is great!!' title: 'Will you look at this:'" ^self new title: titleString; + message: aString; + createButton: 'OK' translated value: nil; + getUserResponseAtHand! - label: aString; - addSelectedCancelButton: 'OK' translated value: nil; - runModalIn: ActiveWorld forHand: ActiveHand at: aPointOrNil! Item was removed: - ----- Method: UserDialogBoxMorph>>addButton:value: (in category 'constructing') ----- - addButton: buttonLabel value: buttonValue - - self - addButton: buttonLabel - value: buttonValue - selected: false - performActionOnEscape: false! Item was removed: - ----- Method: UserDialogBoxMorph>>addButton:value:selected:performActionOnEscape: (in category 'constructing') ----- - addButton: buttonLabel value: buttonValue selected: isSelected performActionOnEscape: performActionOnEscape - "Adds a button with the given label and value. - The value is returned if the user presses the button." - | button | - button := PluggableButtonMorphPlus new - label: buttonLabel ; - action: [ self closeDialog: buttonValue ] ; - onColor: self buttonColor twiceLighter - offColor: self buttonColor twiceLighter. - button hResizing: #spaceFill; vResizing: #spaceFill. - isSelected ifTrue: [ self selectButton: button ]. - performActionOnEscape ifTrue: [ self performActionOnEscapeOf: button ]. - self registerKeyFor: button. - buttonRow addMorphBack: button! Item was removed: - ----- Method: UserDialogBoxMorph>>addCancelButton:value: (in category 'constructing') ----- - addCancelButton: buttonLabel value: buttonValue - - self - addButton: buttonLabel - value: buttonValue - selected: false - performActionOnEscape: true! Item was removed: - ----- Method: UserDialogBoxMorph>>addSelectedButton:value: (in category 'constructing') ----- - addSelectedButton: buttonLabel value: buttonValue - - self - addButton: buttonLabel - value: buttonValue - selected: true - performActionOnEscape: false! Item was removed: - ----- Method: UserDialogBoxMorph>>addSelectedCancelButton:value: (in category 'constructing') ----- - addSelectedCancelButton: buttonLabel value: buttonValue - - self - addButton: buttonLabel - value: buttonValue - selected: true - performActionOnEscape: true! Item was removed: - ----- Method: UserDialogBoxMorph>>buttonColor (in category 'initialization') ----- - buttonColor - ^Color r: 0.658 g: 0.678 b: 0.78! Item was removed: - ----- Method: UserDialogBoxMorph>>buttons (in category 'events') ----- - buttons - - ^buttonRow submorphs select: [ :each | - each isKindOf: PluggableButtonMorphPlus ].! Item was removed: - ----- Method: UserDialogBoxMorph>>checkAgainstKeymap: (in category 'events') ----- - checkAgainstKeymap: aCharacter - keyMap - at: aCharacter asLowercase - ifPresent: [ : foundButton | foundButton performAction ] - ifAbsent: [ "do nothing" ]! Item was removed: - ----- Method: UserDialogBoxMorph>>closeDialog: (in category 'running') ----- - closeDialog: returnValue - value := returnValue. - self delete.! Item was removed: - ----- Method: UserDialogBoxMorph>>deselectSelectedButton (in category 'events') ----- - deselectSelectedButton - - selectedButton ifNil: [ ^self ]. - selectedButton - onColor: self buttonColor twiceLighter - offColor: self buttonColor twiceLighter. - selectedButton := nil! Item was removed: - ----- Method: UserDialogBoxMorph>>drawSubmorphsOn: (in category 'drawing') ----- - drawSubmorphsOn: aCanvas - - super drawSubmorphsOn: aCanvas. - - self wantsRoundedCorners ifTrue: [ - "Overdraw lower part of title bar to hide bottom corners." - aCanvas - fillRectangle: (self submorphs first "titleRow" bottomLeft - (-1 @ self submorphs first cornerRadius) - corner: self submorphs first "titleRow" bottomRight - (1@0)) - color: self color].! Item was removed: - ----- Method: UserDialogBoxMorph>>flash (in category 'events') ----- - flash - "Flash me" - 1 to: 2 do:[:i| - self color: Color black. - self world doOneCycleNow. - (Delay forMilliseconds: 50) wait. - self color: Color white. - self world doOneCycleNow. - (Delay forMilliseconds: 50) wait. - ].! Item was removed: - ----- Method: UserDialogBoxMorph>>handlesKeyboard: (in category 'events') ----- - handlesKeyboard: evt - - ^true! Item was removed: - ----- Method: UserDialogBoxMorph>>initialize (in category 'initialization') ----- - initialize - - | titleRow cc | - super initialize. - self color: Color white. - self listDirection: #topToBottom; wrapCentering: #center; - hResizing: #shrinkWrap; vResizing: #shrinkWrap. - self layoutInset: -1 @ -1; cellInset: 5@5. - self borderStyle: BorderStyle thinGray. - self setProperty: #indicateKeyboardFocus: toValue: #never. - - FillInTheBlankMorph roundedDialogCorners - ifTrue: [self useRoundedCorners]. - - self hasDropShadow: Preferences menuAppearance3d. - self useSoftDropShadow - ifFalse: [ - self - shadowColor: (TranslucentColor r: 0.0 g: 0.0 b: 0.0 alpha: 0.666); - shadowOffset: 1 @ 1] - ifTrue: [ - self - shadowColor: (TranslucentColor r: 0.0 g: 0.0 b: 0.0 alpha: 0.01); - shadowOffset: (10@8 corner: 10@12)]. - - cc := Color gray: 0.8. - titleRow := AlignmentMorph newRow. - titleRow hResizing: #spaceFill; vResizing: #shrinkWrap. - - self cornerStyle == #rounded - ifTrue: [titleRow useRoundedCorners]. - - titleRow borderStyle: BorderStyle thinGray. - titleRow layoutInset: (5@5 corner: (2@ (5 + (titleRow cornerStyle == #rounded ifTrue: [titleRow cornerRadius] ifFalse: [0])))). - titleRow color: cc. - titleRow fillStyle: self titleGradient. - - titleMorph := StringMorph new. - titleMorph emphasis: 1. - titleRow addMorph: titleMorph. - labelMorph := TextMorph new. - labelMorph margins: (Preferences standardButtonFont widthOf: $x) * 2 @ 0. - labelMorph lock. - buttonRow := AlignmentMorph newRow - vResizing: #rigid; - height: (Preferences standardButtonFont height + 20); - hResizing: #spaceFill; - layoutInset: - (((Preferences standardButtonFont widthOf: $x) * 2 @ 0) - corner: ((Preferences standardButtonFont widthOf: $x) * 2 @ 10)); - cellInset: (Preferences standardButtonFont widthOf: $x) * 2. - buttonRow color: Color transparent. - self - addMorphBack: titleRow ; - addMorphBack: labelMorph ; - addMorphBack: buttonRow. - keyMap := Dictionary new! Item was removed: - ----- Method: UserDialogBoxMorph>>justDroppedInto:event: (in category 'events') ----- - justDroppedInto: aMorph event: event - - "Restore drop shadow if necessary." - self hasDropShadow: Preferences menuAppearance3d. - - "aggressively preserve focus" - event hand newMouseFocus: self.! Item was removed: - ----- Method: UserDialogBoxMorph>>keyStroke: (in category 'events') ----- - keyStroke: evt - | evtCharacter | - self stopAutoTrigger. - evtCharacter := evt keyCharacter. - evtCharacter = Character escape ifTrue: [ - ^cancelButton ifNotNil: [ cancelButton performAction ] ]. - evtCharacter = Character cr ifTrue: [ - ^selectedButton ifNotNil: [ selectedButton performAction ] ]. - (evtCharacter = Character arrowLeft or: [ - evt shiftPressed and: [ evtCharacter = Character tab ] ]) ifTrue: [ - ^self selectPreviousButton ]. - (evtCharacter = Character arrowRight or: [ - evtCharacter = Character tab ]) ifTrue: [ - ^self selectNextButton ]. - self checkAgainstKeymap: evtCharacter! Item was changed: + ----- Method: UserDialogBoxMorph>>label (in category 'accessing') ----- - ----- Method: UserDialogBoxMorph>>label (in category 'constructing') ----- label + ^ self message! - "The dialog's label (String)" - ^labelMorph contents - ! Item was changed: + ----- Method: UserDialogBoxMorph>>label: (in category 'accessing') ----- - ----- Method: UserDialogBoxMorph>>label: (in category 'constructing') ----- label: aString + self message: aString.! - "The dialog's label (String)" - labelMorph contents: aString. - ! Item was removed: - ----- Method: UserDialogBoxMorph>>mouseDown: (in category 'events') ----- - mouseDown: event - self stopAutoTrigger. - "Always bring me to the front since I am modal" - self comeToFront. - (self containsPoint: event position) ifFalse:[ - Beeper beepPrimitive. - ^self flash]. - - self hasDropShadow: false. - event hand grabMorph: self.! Item was removed: - ----- Method: UserDialogBoxMorph>>mouseUp: (in category 'events') ----- - mouseUp: event - self stopAutoTrigger. - "aggressively preserve focus" - event hand newMouseFocus: self.! Item was removed: - ----- Method: UserDialogBoxMorph>>performActionOnEscapeOf: (in category 'constructing') ----- - performActionOnEscapeOf: aButton - - cancelButton := aButton! Item was removed: - ----- Method: UserDialogBoxMorph>>processFocusEvent:using: (in category 'events') ----- - processFocusEvent: evt using: dispatcher - - ^ dispatcher dispatchFocusEventFully: evt with: self! Item was removed: - ----- Method: UserDialogBoxMorph>>registerKeyFor: (in category 'constructing') ----- - registerKeyFor: button - button label do: - [ : eachChar | eachChar isAlphaNumeric ifTrue: - [ keyMap - at: eachChar asLowercase - ifPresent: [ : found | "It's already taken, don't use it." ] - ifAbsent: - [ ^ keyMap - at: eachChar asLowercase - put: button ] ] ]! Item was removed: - ----- Method: UserDialogBoxMorph>>runModalIn:forHand:at: (in category 'running') ----- - runModalIn: aWorld forHand: aHand at: aPointOrNil - "Ensure that we have a reasonable minimum size" - | oldFocus pos offset | - (ProvideAnswerNotification signal: self label asString) ifNotNil:[:answer| ^answer]. - self openInWorld: aWorld. - pos := aPointOrNil ifNil: [ - "If called after a longer UI operation, be sure to use the current mouse cursor. Hand position is not up-to-date. Do one world cycle does not help if there are currently no mouse events. So, we *have to be* this extreme." - Sensor cursorPoint]. - offset := aPointOrNil - ifNil: [selectedButton fullBounds origin - (selectedButton fullBounds extent // 2 * (-1@1))] - ifNotNil: [self fullBounds extent // 2]. - self setConstrainedPosition: pos - offset hangOut: false. - oldFocus := aHand keyboardFocus. - aHand newMouseFocus: self. - aHand newKeyboardFocus: self. - savedLabel := selectedButton label. - [self isInWorld] whileTrue:[aWorld doOneSubCycle]. - oldFocus ifNotNil:[aHand newKeyboardFocus: oldFocus]. - ^value! Item was removed: - ----- Method: UserDialogBoxMorph>>selectButton: (in category 'events') ----- - selectButton: aButton - - self deselectSelectedButton. - aButton - onColor: Color orange muchLighter - offColor: Color orange muchLighter. - selectedButton := aButton! Item was removed: - ----- Method: UserDialogBoxMorph>>selectNextButton (in category 'events') ----- - selectNextButton - - | buttons | - buttons := self buttons. - self selectButton: (buttons atWrap: (buttons indexOf: selectedButton) + 1)! Item was removed: - ----- Method: UserDialogBoxMorph>>selectPreviousButton (in category 'events') ----- - selectPreviousButton - - | buttons | - buttons := self buttons. - self selectButton: (buttons atWrap: (buttons indexOf: selectedButton) - 1)! Item was removed: - ----- Method: UserDialogBoxMorph>>step (in category 'stepping and presenter') ----- - step - timeout ifNil: [^self]. - timeout = 0 - ifTrue: [ - self stopStepping. - selectedButton performAction] - ifFalse: [ - selectedButton label: savedLabel, '(', timeout printString, ')'. - timeout := timeout - 1]! Item was removed: - ----- Method: UserDialogBoxMorph>>stepTime (in category 'stepping and presenter') ----- - stepTime - ^1000! Item was removed: - ----- Method: UserDialogBoxMorph>>stopAutoTrigger (in category 'stepping and presenter') ----- - stopAutoTrigger - timeout ifNil: [^self]. - timeout := nil. - self stopStepping. - selectedButton label: savedLabel ! Item was removed: - ----- Method: UserDialogBoxMorph>>title (in category 'constructing') ----- - title - ^titleMorph contents! Item was removed: - ----- Method: UserDialogBoxMorph>>title: (in category 'constructing') ----- - title: aString - titleMorph contents: aString! Item was removed: - ----- Method: UserDialogBoxMorph>>titleGradient (in category 'initialization') ----- - titleGradient - - | cc gradient | - SystemWindow gradientWindow - ifFalse: [^ SolidFillStyle color: self buttonColor]. - - cc := self buttonColor. - gradient := GradientFillStyle ramp: { - 0.0 -> Color white. - 0.33 ->(cc mixed: 0.5 with: Color white). - 1.0 -> cc. - }. - gradient origin: 0@0. - gradient direction: 0 @ (TextStyle defaultFont height + 10). - ^gradient! Item was removed: - ----- Method: UserDialogBoxMorph>>triggerAfter: (in category 'constructing') ----- - triggerAfter: seconds - timeout := seconds! Item was removed: - ----- Method: UserDialogBoxMorph>>wantsToBeDroppedInto: (in category 'events') ----- - wantsToBeDroppedInto: aMorph - "Return true if it's okay to drop the receiver into aMorph" - ^aMorph isWorldMorph "only into worlds"! Item was changed: + (PackageInfo named: 'Morphic') postscript: 'SystemProgressMorph reset.'! - (PackageInfo named: 'Morphic') postscript: 'MenuIcons initializeIcons. - TheWorldMainDockingBar updateInstances.'! |
Free forum by Nabble | Edit this page |