SystemOrganization addCategory: #'OB-Morphic-Core'! SystemOrganization addCategory: #'OB-Morphic-Morphs'! !OBColumn methodsFor: '*ob-morphic' stamp: 'cwp 7/13/2007 20:59'! acceptDroppingMorph: transferMorph event: evt inMorph: listMorph | target | target := self nodeForDropEvent: evt inMorph: listMorph. ^self drop: transferMorph passenger on: target! ! !OBColumn methodsFor: '*ob-morphic' stamp: 'avi 2/20/2004 13:45'! dragEnabled ^ true! ! !OBColumn methodsFor: '*ob-morphic' stamp: 'cwp 7/13/2007 22:39'! dragPassengerFor: item inMorph: listMorph ^ self nodeForItem: item contents asString! ! !OBColumn methodsFor: '*ob-morphic' stamp: 'avi 2/20/2004 14:37'! dragTransferType ^ #OmniBrowser! ! !OBColumn methodsFor: '*ob-morphic' stamp: 'avi 2/20/2004 14:36'! dragTransferTypeForMorph: listMorph ^ self dragTransferType! ! !OBColumn methodsFor: '*ob-morphic' stamp: 'avi 2/20/2004 14:30'! dropEnabled ^ true! ! !OBColumn methodsFor: '*ob-morphic' stamp: 'dr 3/3/2008 16:32'! nodeForDropEvent: evt inMorph: pluggableListMorph | index item label | index := pluggableListMorph rowAtLocation: evt position. index = 0 ifTrue: [^nil]. item := pluggableListMorph listMorph item: index. label := item contents asString withBlanksTrimmed. ^self children detect: [:child | child displayString asString withBlanksTrimmed = label] ifNone: [nil]! ! !OBColumn methodsFor: '*ob-morphic' stamp: 'dr 11/18/2008 20:20'! wantsDroppedMorph: transferMorph event: evt inMorph: listMorph | node passenger | (transferMorph isKindOf: TransferMorph) ifFalse: [^false]. node := self nodeForDropEvent: evt inMorph: listMorph. transferMorph dragTransferType == self dragTransferType ifFalse: [^false]. passenger := transferMorph passenger. ^self canDrop: passenger on: node! ! PluggableTextMorph subclass: #OBPluggableTextMorph instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Morphic-Morphs'! !OBPluggableTextMorph commentStamp: 'cwp 12/7/2004 00:04' prior: 0! This is a trivial subclass of PluggableTextMorph. It overrides initialization methods to use an OBTextMorph rather than a regular TextMorph! !OBPluggableTextMorph methodsFor: 'menu' stamp: 'lr 3/21/2009 20:04'! getMenu: shiftKeyState "Answer the menu for this text view, supplying an empty menu to be filled in. If the menu selector takes an extra argument, pass in the current state of the shift key." | menu aMenu aTitle | getMenuSelector isNil ifTrue: [ ^ nil ]. menu := MenuMorph new defaultTarget: model. aTitle := getMenuTitleSelector ifNotNil: [ model perform: getMenuTitleSelector ]. aMenu := model menu: menu shifted: shiftKeyState selection: self selectionNode. aTitle ifNotNil: [ aMenu addTitle: aTitle ]. ^ aMenu! ! !OBPluggableTextMorph methodsFor: 'event handling' stamp: 'cwp 10/30/2004 23:07'! keyStroke: evt ^ textMorph keyStroke: evt! ! !OBPluggableTextMorph methodsFor: 'as yet unclassified' stamp: 'lr 6/5/2009 22:31'! noteNewOwner: aMorph self containingWindow isNil ifFalse: [ self adoptPaneColor: self containingWindow paneColor ]! ! !OBPluggableTextMorph methodsFor: 'access' stamp: 'cwp 10/14/2006 21:30'! selectionNode ^ OBTextSelection on: self selectionInterval inText: self text. ! ! !OBPluggableTextMorph methodsFor: 'model access' stamp: 'lr 7/3/2009 22:31'! setText: aText scrollBar setValue: 0.0. textMorph ifNil: [ textMorph := OBTextMorph new contents: aText wrappedTo: self innerBounds width - 6. textMorph setEditView: self. scroller addMorph: textMorph ] ifNotNil: [ textMorph newContents: aText ]. self hasUnacceptedEdits: false. self setScrollDeltas! ! TextMorphEditor subclass: #OBTextMorphEditor instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Morphic-Morphs'! !OBTextMorphEditor commentStamp: 'cwp 1/7/2005 23:27' prior: 0! OBTextMorphEditor overrides the TextMorphEditors handling of command keys, passing them along to its model for processing, rather than hard-coding their implementations.! !OBTextMorphEditor methodsFor: 'actions' stamp: 'alain.plantec 6/18/2008 09:10'! browseIt | symbol | self lineSelectAndEmptyCheck: [^ self]. (symbol := self selectedSymbol) isNil ifTrue: [^ self flash]. self send: #browseIt: toModelWith: {symbol} orDo: [super browseIt]! ! !OBTextMorphEditor methodsFor: 'actions' stamp: 'lr 2/12/2009 10:35'! implementorsOfIt "Open a senders browser on the selected selector" | selector | self lineSelectAndEmptyCheck: [ ^ self ]. (selector := self selectedSelector) isNil ifTrue: [ ^ self flash ]. self send: #implementorsOfIt: toModelWith: { selector } orDo: [ super sendersOfIt ]! ! !OBTextMorphEditor methodsFor: 'actions' stamp: 'lr 2/12/2009 10:35'! referencesToIt | selector | self lineSelectAndEmptyCheck: [ ^ self ]. (selector := self selectedSelector) isNil ifTrue: [ ^ self flash ]. self send: #referencesToIt: toModelWith: { selector } orDo: [ super referencesToIt ]! ! !OBTextMorphEditor methodsFor: 'model access' stamp: 'alain.plantec 6/18/2008 09:10'! send: aSelector toModelWith: args orDo: aBlock self terminateAndInitializeAround: [(model respondsTo: aSelector) ifTrue: [(model perform: aSelector withArguments: args) ifFalse: [self flash]] ifFalse: aBlock]! ! !OBTextMorphEditor methodsFor: 'actions' stamp: 'lr 2/12/2009 10:35'! sendersOfIt "Open a senders browser on the selected selector" | selector | self lineSelectAndEmptyCheck: [ ^ self ]. (selector := self selectedSelector) isNil ifTrue: [ ^ self flash ]. self send: #sendersOfIt: toModelWith: { selector } orDo: [ super sendersOfIt ]! ! RectangleMorph subclass: #OBButtonBar instanceVariableNames: 'model' classVariableNames: '' poolDictionaries: '' category: 'OB-Morphic-Morphs'! !OBButtonBar class methodsFor: 'as yet unclassified' stamp: 'cwp 3/11/2007 16:39'! on: aModel ^ self new model: aModel; initGeometry; update: #commands.! ! !OBButtonBar methodsFor: 'updating' stamp: 'dc 9/8/2007 15:02'! addButtonFor: aCommand self addMorphBack: ((self buttonFor: aCommand) position: self position; yourself)! ! !OBButtonBar methodsFor: 'visual' stamp: 'cwp 3/11/2007 20:55'! adoptPaneColor: aColor self submorphs do: [:ea | ea onColor: aColor offColor: aColor whiter]! ! !OBButtonBar methodsFor: 'updating' stamp: 'cwp 8/26/2009 23:21'! buttonFor: aCommand | buttonColor | buttonColor := model color duller. ^ (PluggableButtonMorph on: aCommand getState: #isActive action: (aCommand isActive ifTrue: [ #execute ] ifFalse: [ #yourself ]) label: #buttonLabel) onColor: buttonColor offColor: buttonColor whiter; hResizing: #spaceFill; vResizing: #spaceFill; styleWith: OBPlatform current builder; setBalloonText: aCommand longDescription; yourself! ! !OBButtonBar methodsFor: 'initialize-release' stamp: 'cwp 8/26/2009 23:21'! initGeometry self layoutPolicy: TableLayout new; listDirection: #leftToRight; hResizing: #spaceFill; vResizing: #spaceFill; rubberBandCells: true; styleWith: OBPlatform current builder! ! !OBButtonBar methodsFor: 'accessing' stamp: 'cwp 3/11/2007 15:56'! model ^ model! ! !OBButtonBar methodsFor: 'accessing' stamp: 'lr 3/4/2009 08:17'! model: aModel model isNil ifFalse: [ model removeDependent: self ]. model := aModel. model addDependent: self! ! !OBButtonBar methodsFor: 'visual' stamp: 'lr 3/4/2009 08:17'! noteNewOwner: aMorph | window | window := aMorph containingWindow. window isNil ifFalse: [ self adoptPaneColor: window paneColor ]! ! !OBButtonBar methodsFor: 'building' stamp: 'cwp 7/21/2007 21:35'! styleWith: aBuilder aBuilder styleButtonBar: self! ! !OBButtonBar methodsFor: 'updating' stamp: 'cwp 3/11/2007 15:58'! update: aSymbol aSymbol == #commands ifTrue: [self updateCommands]! ! !OBButtonBar methodsFor: 'updating' stamp: 'cwp 3/11/2007 19:27'! updateCommands self removeAllMorphs. model commands do: [:ea | self addButtonFor: ea]. ! ! RectangleMorph subclass: #OBGroupingMorph instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Morphic-Morphs'! !OBGroupingMorph methodsFor: 'as yet unclassified' stamp: 'cwp 12/9/2007 12:03'! addBorders self borderWidth: 0. self submorphs do: [:morph | morph class = self class ifTrue: [morph addBorders] ifFalse: [morph adoptPaneColor: color. morph borderWidth: 2; borderColor: #inset; color: Color transparent]]! ! !OBGroupingMorph methodsFor: 'as yet unclassified' stamp: 'cwp 12/9/2007 10:50'! addMorph: aMorph frame: relFrame "Stole this from SystemWindow" | frame | frame := LayoutFrame new. frame leftFraction: relFrame left; rightFraction: relFrame right; topFraction: relFrame top; bottomFraction: relFrame bottom. self addMorph: aMorph fullFrame: frame. ! ! !OBGroupingMorph methodsFor: 'as yet unclassified' stamp: 'lr 1/22/2008 20:08'! initialize super initialize. self borderWidth: 0. self color: Color transparent! ! RectangleMorph subclass: #OBPane instanceVariableNames: 'model list button' classVariableNames: '' poolDictionaries: '' category: 'OB-Morphic-Morphs'! !OBPane commentStamp: 'cwp 1/7/2005 23:24' prior: 0! An OBPane is the visual representation of a column in a browser. It contains a morph to display nodes (typically a PluggableListMorph) and (optionally) a morph for communicating with the column's filter. It's main responsibility is to lay out its submorphs as the filter controls are added and removed. iVars: model - the OBColumn that controls the node list displayed in this pane list - the morph which displays the node list, usually a PluggableListMorph button - the morph which controls the column's filter, usually an OBRadioButtonBar.! !OBPane methodsFor: 'updating' stamp: 'cwp 11/2/2004 00:53'! addButton: aButton self hasButton ifTrue: [self removeMorph: button]. button := aButton. button height: self defaultButtonHeight. self addMorph: button; adjustList; adjustButton! ! !OBPane methodsFor: 'updating' stamp: 'cwp 3/14/2007 23:33'! addList: aListMorph list := aListMorph. self addMorph: list. list bounds: self innerBounds. ! ! !OBPane methodsFor: 'updating' stamp: 'lr 2/12/2009 10:36'! adjustButton | inner | self hasButton ifFalse: [ ^ self ]. inner := self innerBounds. button bounds: (inner withTop: inner bottom - button height)! ! !OBPane methodsFor: 'updating' stamp: 'cwp 3/14/2007 23:26'! adjustList self hasButton ifFalse: [self list bounds: self innerBounds] ifTrue: [self list bounds: (self innerBounds withHeight: (self height - self buttonHeight))]! ! !OBPane methodsFor: 'geometry' stamp: 'cwp 2/12/2004 18:32'! bounds: aRectangle super bounds: aRectangle. self adjustList. self adjustButton.! ! !OBPane methodsFor: 'accessing' stamp: 'cwp 3/14/2007 23:28'! button ^ button! ! !OBPane methodsFor: 'constructing' stamp: 'cwp 8/26/2009 23:21'! buttonFor: aSwitch ^ aSwitch buildOn: OBPlatform current builder! ! !OBPane methodsFor: 'constructing' stamp: 'cwp 11/2/2004 00:57'! buttonHeight ^ self hasButton ifTrue: [button height] ifFalse: [self defaultButtonHeight] ! ! !OBPane methodsFor: 'constructing' stamp: 'lr 7/10/2009 11:05'! defaultButtonHeight ^ Preferences standardButtonFont height * 2.5! ! !OBPane methodsFor: 'testing' stamp: 'cwp 2/12/2004 18:35'! hasButton ^ button notNil! ! !OBPane methodsFor: 'initialization' stamp: 'cwp 3/14/2007 23:42'! initGeometry self hResizing: #spaceFill; vResizing: #spaceFill; clipSubmorphs: true; color: Color transparent; cellInset: 0; borderWidth: 0; layoutPolicy: ProportionalLayout new. ! ! !OBPane methodsFor: 'accessing' stamp: 'cwp 3/14/2007 23:42'! list ^ list! ! !OBPane methodsFor: 'initialization' stamp: 'lr 3/4/2009 08:17'! model: anObject "Set my model and make me me a dependent of the given object." model isNil ifFalse: [ model removeDependent: self ]. anObject isNil ifFalse: [ anObject addDependent: self ]. model := anObject! ! !OBPane methodsFor: 'constructing' stamp: 'lr 3/4/2009 09:37'! noteNewOwner: aMorph self containingWindow isNil ifFalse: [ self adoptPaneColor: self containingWindow paneColor ]! ! !OBPane methodsFor: 'updating' stamp: 'lr 2/12/2009 10:36'! removeButton self hasButton ifFalse: [ ^ self ]. self removeMorph: button. button := nil. self adjustList! ! !OBPane methodsFor: 'updating' stamp: 'cwp 5/18/2007 23:09'! update: aSelector aSelector = #switch ifFalse: [^ self]. self hasButton = model wantsButton ifTrue: [^ self]. model wantsButton ifTrue: [self addButton: (self buttonFor: model switch)] ifFalse: [self removeButton]! ! RectangleMorph subclass: #OBPaneScroller instanceVariableNames: 'model sizing panes transform scrollBar' classVariableNames: '' poolDictionaries: '' category: 'OB-Morphic-Morphs'! !OBPaneScroller commentStamp: 'cwp 3/5/2004 12:13' prior: 0! Instances of OBPaneScroller contain the panes which represent columns in a browser. Their primary responsibilities are laying out panes to fit the space available and scrolling them horizontally when there isn't sufficient space. iVars: sizing - The number of panes which should exactly fit the available space. During layout, the width of the panes is determined accordingly. transform - A TransformMorph used for scrolling scrollBar - An OBHorizontalScrollBar used for scrolling! !OBPaneScroller class methodsFor: 'as yet unclassified' stamp: 'cwp 11/17/2004 22:01'! withModel: aModel ^ self new model: aModel! ! !OBPaneScroller methodsFor: 'layout' stamp: 'cwp 2/8/2004 11:10'! adjustPaneHeight "This gets called after the scrollbar has been shown or hidden, to move the bottom of the panes to the right place." transform bounds: self innerBounds. transform submorphsDo: [:m | m bounds: (m bounds withHeight: self paneHeight)] ! ! !OBPaneScroller methodsFor: 'accessing' stamp: 'lr 6/5/2009 22:07'! adoptPaneColor: aColor super adoptPaneColor: aColor. scrollBar adoptPaneColor: aColor! ! !OBPaneScroller methodsFor: 'private' stamp: 'cwp 8/26/2009 23:21'! basicUpdatePanes | builder | builder := OBPlatform current builder. panes := model isNil ifTrue: [ Array new ] ifFalse: [ model columns collect: [ :ea | ea buildOn: builder ] ]. self clearPanes. panes do: [ :ea | self pushPane: ea ]! ! !OBPaneScroller methodsFor: 'private' stamp: 'lr 3/21/2009 20:04'! basicUpdateSizing sizing := model isNil ifTrue: [ 1 ] ifFalse: [ model sizing ]! ! !OBPaneScroller methodsFor: 'layout' stamp: 'cwp 11/21/2004 23:45'! bounds: aRectangle super bounds: aRectangle. self layoutWidgets. self layoutPanes. self setScrollDeltas. ! ! !OBPaneScroller methodsFor: 'panes' stamp: 'cwp 12/6/2003 17:06'! clearPanes transform removeAllMorphs! ! !OBPaneScroller methodsFor: 'layout' stamp: 'cwp 2/26/2004 23:14'! computeMorphWidths | paneWidths widths | paneWidths := self paneWidthsToFit: self totalPaneWidth. widths := OrderedCollection new. paneWidths do: [:w | widths add: w] separatedBy: [widths add: self separatorWidth]. ^ widths asArray ! ! !OBPaneScroller methodsFor: 'layout' stamp: 'cwp 2/8/2004 11:06'! doLayout self layoutWidgets. self layoutPanes. self hideOrShowScrollBar. self setScrollDeltas. self scrollToRight.! ! !OBPaneScroller methodsFor: 'scrolling' stamp: 'cwp 2/8/2004 10:44'! hideOrShowScrollBar self isScrollable ifTrue: [self showScrollBar] ifFalse: [self hideScrollBar]! ! !OBPaneScroller methodsFor: 'scrolling' stamp: 'cwp 2/8/2004 11:10'! hideScrollBar self removeMorph: scrollBar. self adjustPaneHeight.! ! !OBPaneScroller methodsFor: 'initialization' stamp: 'cwp 5/28/2007 01:30'! initialize super initialize. self color: Color white; borderWidth: 0; vResizing: #spaceFill; hResizing: #spaceFill. self initializeTransform; initializeScrollbar.! ! !OBPaneScroller methodsFor: 'initialization' stamp: 'lr 7/4/2009 10:34'! initializeScrollbar scrollBar := ScrollBar new model: self slotName: 'scrollBar'. scrollBar borderWidth: 0; borderColor: #inset; height: self scrollBarHeight. self resizeScrollBar. ! ! !OBPaneScroller methodsFor: 'initialization' stamp: 'cwp 2/8/2004 10:52'! initializeTransform transform := TransformMorph new. transform color: Color transparent; borderWidth: 0; vResizing: #spaceFill; hResizing: #spaceFill; disableTableLayout; bounds: super innerBounds. self addMorphBack: transform. ! ! !OBPaneScroller methodsFor: 'layout' stamp: 'cwp 2/8/2004 10:54'! innerBounds | rect | rect := super innerBounds. ^ self scrollBarIsVisible ifTrue: [rect withHeight: rect height - self scrollBarHeight - 1] ifFalse: [rect]! ! !OBPaneScroller methodsFor: 'scrolling' stamp: 'cwp 2/8/2004 10:42'! isScrollable ^ self leftoverScrollRange > 0! ! !OBPaneScroller methodsFor: 'layout' stamp: 'cwp 2/8/2004 01:22'! layoutPanes | widths rect | widths := self computeMorphWidths. rect := 0@0 extent: (0 @ self paneHeight). transform submorphs with: widths do: [:m :w | rect := rect withWidth: w. m bounds: rect. rect := rect translateBy: (w@0)] ! ! !OBPaneScroller methodsFor: 'layout' stamp: 'cwp 8/25/2003 22:13'! layoutWidgets | inner outer | outer := super innerBounds. inner := self innerBounds. transform bounds: inner. scrollBar bounds: ((inner left @ inner bottom + 1) corner: outer bottomRight)! ! !OBPaneScroller methodsFor: 'scrolling' stamp: 'cwp 8/25/2003 21:04'! leftoverScrollRange ^ (self totalScrollRange - self innerBounds width roundTo: self scrollDeltaWidth) max: 0 ! ! !OBPaneScroller methodsFor: 'accessing' stamp: 'cwp 11/17/2004 22:03'! model ^model! ! !OBPaneScroller methodsFor: 'accessing' stamp: 'lr 3/4/2009 08:17'! model: anObject model isNil ifFalse: [ model removeDependent: self ]. anObject isNil ifFalse: [ anObject addDependent: self ]. model := anObject! ! !OBPaneScroller methodsFor: 'accessing' stamp: 'lr 6/5/2009 22:10'! noteNewOwner: aMorph self containingWindow isNil ifFalse: [ self adoptPaneColor: self containingWindow paneColor ]! ! !OBPaneScroller methodsFor: 'layout' stamp: 'cwp 11/17/2004 23:09'! paneCount ^ self panes size! ! !OBPaneScroller methodsFor: 'layout' stamp: 'cwp 12/6/2003 17:08'! paneHeight ^ transform bounds height! ! !OBPaneScroller methodsFor: 'layout' stamp: 'lr 3/21/2009 20:05'! paneWidthsToFit: limit | padded | padded := Array new: self paneCount. padded atAllPut: (limit / self sizing) floor. 1 to: limit - padded sum do: [:i | padded at: i put: (padded at: i) + 1]. ^ padded ! ! !OBPaneScroller methodsFor: 'accessing' stamp: 'cwp 11/17/2004 23:09'! panes ^ panes ifNil: [self updatePanes. panes]! ! !OBPaneScroller methodsFor: 'panes' stamp: 'cwp 11/23/2004 01:22'! popPanes: count count * 2 timesRepeat: [transform removeMorph: transform lastSubmorph]. panes removeLast: count! ! !OBPaneScroller methodsFor: 'panes' stamp: 'cwp 11/17/2004 22:46'! pushPane: aMorph aMorph borderWidth: 0; hResizing: #rigid; vResizing: #rigid; layoutInset: 0. transform hasSubmorphs ifTrue: [transform addMorphBack: self separator]. transform addMorphBack: aMorph. ! ! !OBPaneScroller methodsFor: 'layout' stamp: 'cwp 2/8/2004 11:03'! resizeScrollBar | inner outer | outer := super innerBounds. inner := outer withHeight: outer height - self scrollBarHeight - 1. scrollBar bounds: ((inner left @ inner bottom + 1) corner: outer bottomRight)! ! !OBPaneScroller methodsFor: 'layout' stamp: 'cwp 8/24/2003 14:29'! scrollBarHeight ^ 12! ! !OBPaneScroller methodsFor: 'scrolling' stamp: 'cwp 2/8/2004 10:56'! scrollBarIsVisible ^ submorphs includes: scrollBar! ! !OBPaneScroller methodsFor: 'input events' stamp: 'cwp 8/20/2009 08:29'! scrollBarMenuButtonPressed: anObject "Ignore the menu button..."! ! !OBPaneScroller methodsFor: 'updating' stamp: 'cwp 11/21/2004 13:51'! scrollBarValue: value transform hasSubmorphs ifFalse: [^ self]. transform offset: (self leftoverScrollRange * value) rounded @ 0.! ! !OBPaneScroller methodsFor: 'scrolling' stamp: 'cwp 8/23/2003 16:21'! scrollDeltaWidth ^ 1! ! !OBPaneScroller methodsFor: 'scrolling' stamp: 'lr 6/6/2009 15:25'! scrollToRight ^ scrollBar animateValue: 1! ! !OBPaneScroller methodsFor: 'panes' stamp: 'cwp 8/26/2009 23:21'! separator ^ BorderedSubpaneDividerMorph vertical color: model defaultBackgroundColor duller; styleWith: OBPlatform current builder; yourself! ! !OBPaneScroller methodsFor: 'defaults' stamp: 'cwp 8/26/2009 23:21'! separatorWidth ^ OBPlatform current builder style39 ifTrue: [ 3 ] ifFalse: [ 4 ]! ! !OBPaneScroller methodsFor: 'scrolling' stamp: 'cwp 8/25/2003 21:14'! setScrollDeltas | range interval value | transform hasSubmorphs ifFalse: [scrollBar interval: 1.0. ^ self]. range := self leftoverScrollRange. range = 0 ifTrue: [^ scrollBar interval: 1.0; setValue: 0]. interval := ((self innerBounds width) / self totalScrollRange) asFloat. value := (transform offset x / range min: 1.0) asFloat. scrollBar interval: interval. scrollBar setValue: value.! ! !OBPaneScroller methodsFor: 'scrolling' stamp: 'cwp 2/8/2004 11:11'! showScrollBar self scrollBarIsVisible ifTrue: [^ self]. self resizeScrollBar. self addMorphFront: scrollBar. self adjustPaneHeight. ! ! !OBPaneScroller methodsFor: 'accessing' stamp: 'cwp 11/22/2004 23:19'! sizing ^ sizing ifNil: [self updateSizing]! ! !OBPaneScroller methodsFor: 'layout' stamp: 'cwp 2/25/2004 20:23'! totalPaneWidth ^ self innerBounds width - ((self sizing - 1) * self separatorWidth)! ! !OBPaneScroller methodsFor: 'scrolling' stamp: 'cwp 8/25/2003 19:27'! totalScrollRange | submorphBounds | submorphBounds := transform localSubmorphBounds ifNil: [^ 0]. ^ submorphBounds width ! ! !OBPaneScroller methodsFor: 'updating' stamp: 'cwp 3/25/2007 00:23'! update: aSymbol aSymbol = #sizing ifTrue: [^ self updateSizing]. aSymbol = #columns ifTrue: [^ self updatePanes].! ! !OBPaneScroller methodsFor: 'updating' stamp: 'lr 3/4/2009 08:18'! updatePanes | count | model ifNil: [ panes := Array new. ^ self ]. count := panes isNil ifFalse: [ panes size ] ifTrue: [ 0 ]. self basicUpdatePanes. self basicUpdateSizing. self layoutPanes. panes size = count ifFalse: [ self hideOrShowScrollBar. self setScrollDeltas ]. panes size > count ifTrue: [ self scrollToRight ]. ^ panes! ! !OBPaneScroller methodsFor: 'updating' stamp: 'cwp 11/23/2004 01:14'! updateSizing | old | old := sizing. self basicUpdateSizing. sizing = old ifFalse: [self layoutPanes]. ^sizing! ! RectangleMorph subclass: #OBRadioButtonBar instanceVariableNames: 'model buttons getListSelector selection getSelectionSelector setSelectionSelector' classVariableNames: '' poolDictionaries: '' category: 'OB-Morphic-Morphs'! !OBRadioButtonBar commentStamp: 'cwp 1/7/2005 23:27' prior: 0! An OBRadioButtonBar is similar to a PluggableListMorph except that it displays a row of buttons rather than a vertical list. Clicking on a button selects it. model - the model for this button bar buttons - a collection of OBButtonModels, which are derived from the model's list selection - the index of the currently selected button getListSelector - the message for getting the list of labels for the buttons getSelectionSelector - the message for getting the index of the currently selected item setSelectionSelector - the message for informing the model that a button has been clicked! !OBRadioButtonBar class methodsFor: 'as yet unclassified' stamp: 'cwp 2/22/2004 16:44'! on: aModel list: listSelector selected: selectionSelector changeSelected: changedSelector ^ self new on: aModel list: listSelector selected: selectionSelector changeSelected: changedSelector! ! !OBRadioButtonBar methodsFor: 'constructing' stamp: 'cwp 5/18/2007 22:12'! adoptPaneColor: aColor color := aColor. self updateSubmorphColor! ! !OBRadioButtonBar methodsFor: 'accessing' stamp: 'dr 10/21/2008 13:19'! getLabels ^model perform: getListSelector ! ! !OBRadioButtonBar methodsFor: 'accessing' stamp: 'dr 3/23/2009 15:30'! getLongDescriptions ^model longDescriptions! ! !OBRadioButtonBar methodsFor: 'updating' stamp: 'cwp 2/24/2004 18:53'! getSelectionIndex ^ model perform: getSelectionSelector! ! !OBRadioButtonBar methodsFor: 'initialize-release' stamp: 'cwp 8/26/2009 23:21'! initGeometry self layoutPolicy: TableLayout new; listDirection: #leftToRight; hResizing: #spaceFill; vResizing: #spaceFill; rubberBandCells: true; styleWith: OBPlatform current builder! ! !OBRadioButtonBar methodsFor: 'callbacks' stamp: 'dr 7/19/2007 15:17'! isEnabled: aButton ^model isEnabled: aButton! ! !OBRadioButtonBar methodsFor: 'callbacks' stamp: 'cwp 2/24/2004 18:54'! isSelected: aButton ^ (buttons at: selection ifAbsent: [^ false]) == aButton! ! !OBRadioButtonBar methodsFor: 'accessing' stamp: 'lr 2/12/2009 10:36'! list buttons ifNil: [ | labels | labels := self getLabels. buttons := Array new: labels size. labels keysAndValuesDo: [ :index :label | buttons at: index put: (OBButtonModel withLabel: label inBar: self) ]. selection := self getSelectionIndex. self ]. ^ buttons collect: [ :b | b label ]! ! !OBRadioButtonBar methodsFor: 'accessing' stamp: 'lr 3/4/2009 08:17'! model: aModel model isNil ifFalse: [ model removeDependent: self ]. model := aModel. model addDependent: self! ! !OBRadioButtonBar methodsFor: 'constructing' stamp: 'lr 3/4/2009 08:17'! noteNewOwner: aMorph | window | window := aMorph containingWindow. window isNil ifFalse: [ self adoptPaneColor: window paneColor ]! ! !OBRadioButtonBar methodsFor: 'initialize-release' stamp: 'cwp 2/25/2004 00:36'! on: aModel list: listSelector selected: selectionGetter changeSelected: selectionSetter self model: aModel. selection := 0. getListSelector := listSelector. getSelectionSelector := selectionGetter. setSelectionSelector := selectionSetter. self initGeometry. self updateList.! ! !OBRadioButtonBar methodsFor: 'callbacks' stamp: 'cwp 2/24/2004 18:47'! push: aButton | index | index := buttons indexOf: aButton. model perform: setSelectionSelector with: index.! ! !OBRadioButtonBar methodsFor: 'constructing' stamp: 'cwp 7/21/2007 21:54'! styleWith: aBuilder aBuilder styleButtonBar: self! ! !OBRadioButtonBar methodsFor: 'updating' stamp: 'cwp 2/25/2004 00:35'! update: aSymbol aSymbol = getListSelector ifTrue: [self updateList. ^ self]. aSymbol = getSelectionSelector ifTrue: [self updateSelection]! ! !OBRadioButtonBar methodsFor: 'updating' stamp: 'dr 3/23/2009 15:41'! updateButtons | labels descriptions | labels := self getLabels. descriptions := self getLongDescriptions. buttons := Array new: labels size. labels withIndexDo: [:label :index | buttons at: index put: (OBButtonModel withLabel: label inBar: self longDescription: (descriptions at: index ifAbsent: [nil]))]. selection := self getSelectionIndex! ! !OBRadioButtonBar methodsFor: 'updating' stamp: 'cwp 11/27/2004 17:58'! updateList self updateButtons; updateMorphs! ! !OBRadioButtonBar methodsFor: 'updating' stamp: 'cwp 8/26/2009 23:28'! updateMorphs | builder | builder := OBPlatform current builder. self removeAllMorphs. buttons do: [ :button | self addMorphBack: (builder build: button) ]. self updateSubmorphColor! ! !OBRadioButtonBar methodsFor: 'updating' stamp: 'cwp 2/24/2004 19:39'! updateSelection | oldSelection | oldSelection := selection. selection := self getSelectionIndex. self withButtonAt: oldSelection do: [:button | button selectionChanged]. self withSelectedButtonDo: [:button | button selectionChanged]! ! !OBRadioButtonBar methodsFor: 'constructing' stamp: 'cwp 5/18/2007 22:17'! updateSubmorphColor self submorphs do: [:ea | ea onColor: color darker offColor: color lighter]! ! !OBRadioButtonBar methodsFor: 'constructing' stamp: 'cwp 5/18/2007 22:12'! updateSubmorphs self submorphs do: [:ea | ea onColor: color darker offColor: color lighter]! ! !OBRadioButtonBar methodsFor: 'updating' stamp: 'cwp 7/9/2007 23:39'! withButtonAt: index do: aBlock ^ aBlock value: (buttons at: index ifAbsent: [^ self]) ! ! !OBRadioButtonBar methodsFor: 'updating' stamp: 'cwp 2/24/2004 19:38'! withSelectedButtonDo: aBlock ^ self withButtonAt: selection do: aBlock! ! OBPlatform subclass: #OBMorphicPlatform instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Morphic-Core'! !OBMorphicPlatform class methodsFor: 'as yet unclassified' stamp: 'cwp 6/1/2007 16:10'! default ^ self new! ! !OBMorphicPlatform class methodsFor: 'as yet unclassified' stamp: 'cwp 8/26/2009 21:54'! initialize OBPlatform current: self new! ! !OBMorphicPlatform methodsFor: 'building' stamp: 'cwp 8/26/2009 22:16'! builder ^ OBMorphBuilder new! ! !OBMorphicPlatform methodsFor: 'preferences' stamp: 'cwp 8/20/2009 08:17'! enableGently: aSymbol Preferences enableGently: aSymbol! ! !OBMorphicPlatform methodsFor: 'interaction' stamp: 'cwp 8/26/2009 23:30'! handleBrowseRequest: request ^ (OBPlatform current build: request browser) openInWorld! ! !OBMorphicPlatform methodsFor: 'interaction' stamp: 'dc 9/18/2007 10:48'! handleChoiceRequest: request ^ UIManager default chooseFrom: request labels values: request values lines: request lines title: (request prompt ifNil: [''])! ! !OBMorphicPlatform methodsFor: 'interaction' stamp: 'lr 3/4/2009 09:38'! handleCloseRequest: request (SystemWindow allInstances detect: [ :ea | ea model = request browser ] ifNone: [ ^ nil ]) delete! ! !OBMorphicPlatform methodsFor: 'interaction' stamp: 'DamienCassou 10/14/2009 09:48'! handleConfirmationRequest: request |choice| choice := UIManager default chooseFrom: {request okChoice. request cancelChoice} values: {true. false} title: request prompt. ^ choice ifNil: [false] ifNotNil: [choice]! ! !OBMorphicPlatform methodsFor: 'interaction' stamp: 'lr 2/12/2009 10:35'! handleDirectoryRequest: request | fileDirectory | fileDirectory := UIManager default chooseDirectory. fileDirectory isNil ifTrue: [ ^ nil ]. ^ fileDirectory pathName! ! !OBMorphicPlatform methodsFor: 'interaction' stamp: 'lr 7/4/2009 16:43'! handleInformRequest: anOBInformRequest UIManager default inform: anOBInformRequest message! ! !OBMorphicPlatform methodsFor: 'interaction' stamp: 'lr 7/4/2009 16:43'! handleMultiLineTextRequest: request ^ UIManager default multiLineRequest: request prompt centerAt: Sensor cursorPoint initialAnswer: request template answerHeight: 200! ! !OBMorphicPlatform methodsFor: 'interaction' stamp: 'lr 10/11/2009 12:18'! handleMultipleChoiceRequest: aRequest | menu | aRequest values isEmpty ifTrue: [ ^ aRequest values ]. menu := MenuMorph new. menu stayUp: true. aRequest prompt isEmptyOrNil ifFalse: [ menu addTitle: aRequest prompt ]. aRequest values do: [ :value | menu addUpdating: #label: target: aRequest selector: #toggleMorphic: argumentList: (Array with: value) ]. menu addLine. menu add: 'ok' target: menu selector: #delete. menu invokeModal. ^ aRequest selection asArray! ! !OBMorphicPlatform methodsFor: 'interaction' stamp: 'DamienCassou 9/20/2009 15:55'! handleTextRequest: request | text | text := UIManager default request:request prompt initialAnswer: request template. ^ (text isNil or: [text isEmpty]) ifTrue: [nil] ifFalse: [text]! ! !OBMorphicPlatform methodsFor: 'interaction' stamp: 'lr 5/14/2008 15:42'! handleWaitRequest: request ^ Cursor wait showWhile: request block! ! !OBMorphicPlatform methodsFor: 'preferences' stamp: 'cwp 7/1/2007 16:46'! menuWithIcons ^ Preferences menuWithIcons! ! !OBMorphicPlatform methodsFor: 'preferences' stamp: 'cwp 7/1/2007 16:41'! optionalButtons ^ Preferences optionalButtons ! ! !OBMorphicPlatform methodsFor: 'preferences' stamp: 'cwp 7/1/2007 17:09'! setPreference: aSymbol toValue: anObject ^ Preferences setPreference: aSymbol toValue: anObject! ! TextMorphForEditView subclass: #OBTextMorph instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Morphic-Morphs'! !OBTextMorph commentStamp: 'cwp 12/7/2004 00:07' prior: 0! This is a trivial subclass of TextMorph. It overrides editor creation to use OBTextMorphEditor rather than a regular TextMorphEditor.! !OBTextMorph methodsFor: 'private' stamp: 'lr 3/4/2009 08:17'! installEditorToReplace: priorEditor "Install an editor for my paragraph. This constitutes 'hasFocus'. If priorEditor is not nil, then initialize the new editor from its state. We may want to rework this so it actually uses the prior editor." | stateArray | priorEditor isNil ifFalse: [ stateArray := priorEditor stateArray ]. editor := OBTextMorphEditor new morph: self. editor changeParagraph: self paragraph. priorEditor isNil ifFalse: [ editor stateArrayPut: stateArray ]. self selectionChanged. ^ editor! ! Object subclass: #OBButtonModel instanceVariableNames: 'bar label longDescription' classVariableNames: '' poolDictionaries: '' category: 'OB-Morphic-Morphs'! !OBButtonModel commentStamp: 'cwp 3/5/2004 12:15' prior: 0! An OBButtonModel serves as a model for PluggableButtonMorphs used OBRadioButtonBar. OBRadioButtonBar cannot be a direct model for its PBMs, since it can contain a variable number of buttons. iVars: bar - the OBRadioButton bar to which this button belongs label - the label of the button! !OBButtonModel class methodsFor: 'as yet unclassified' stamp: 'cwp 8/29/2004 13:31'! offColor ^ Color lightGray twiceLighter! ! !OBButtonModel class methodsFor: 'as yet unclassified' stamp: 'cwp 8/29/2004 13:30'! onColor ^ Color lightGray lighter! ! !OBButtonModel class methodsFor: 'as yet unclassified' stamp: 'cwp 2/24/2004 18:35'! withLabel: aString inBar: aRadioButtonBar ^ self new label: aString; bar: aRadioButtonBar! ! !OBButtonModel class methodsFor: 'as yet unclassified' stamp: 'dr 3/23/2009 15:29'! withLabel: aString inBar: aRadioButtonBar longDescription: aToolTip ^ self new label: aString; bar: aRadioButtonBar; longDescription: aToolTip! ! !OBButtonModel methodsFor: 'accessing' stamp: 'cwp 2/24/2004 18:29'! bar: aRadioButtonBar bar := aRadioButtonBar! ! !OBButtonModel methodsFor: 'building' stamp: 'cwp 7/25/2007 23:55'! buildOn: aBuilder ^aBuilder button: self with: []! ! !OBButtonModel methodsFor: 'testing' stamp: 'cwp 11/27/2004 19:09'! isEnabled ^ bar isEnabled: self! ! !OBButtonModel methodsFor: 'callbacks' stamp: 'cwp 2/24/2004 18:42'! isSelected ^ bar isSelected: self! ! !OBButtonModel methodsFor: 'accessing' stamp: 'cwp 3/2/2004 21:46'! label ^ label! ! !OBButtonModel methodsFor: 'accessing' stamp: 'cwp 2/24/2004 18:29'! label: aString label := aString! ! !OBButtonModel methodsFor: 'callbacks' stamp: 'dr 2/17/2009 15:51'! labelMorph | morph | (Smalltalk classNamed: #UITheme) ifNotNilDo: [:uit | ^uit current buttonLabelForText: label]. morph := (StringMorph contents: label font: TextStyle defaultFont). (label isText and: [label hasColor]) ifFalse: [morph color: (self isEnabled ifTrue: [Color black] ifFalse: [Color gray])]. ^morph! ! !OBButtonModel methodsFor: 'accessing' stamp: 'dr 3/23/2009 16:02'! longDescription ^longDescription! ! !OBButtonModel methodsFor: 'accessing' stamp: 'dr 3/23/2009 15:27'! longDescription: aString longDescription := aString! ! !OBButtonModel methodsFor: 'callbacks' stamp: 'cwp 2/24/2004 19:30'! push bar push: self.! ! !OBButtonModel methodsFor: 'accessing' stamp: 'cwp 11/27/2004 00:50'! selectionChanged self changed: #isSelected. self changed: #labelMorph! ! Object subclass: #OBMorphicIcons instanceVariableNames: '' classVariableNames: 'Icons Instance' poolDictionaries: '' category: 'OB-Morphic-Core'! !OBMorphicIcons commentStamp: 'lr 7/10/2009 11:12' prior: 0! Most of these icons come from http://www.famfamfam.com/lab/icons. They are licensed under the Creative Commons Attribution 3.0 License by Mark James.! !OBMorphicIcons class methodsFor: 'as yet unclassified' stamp: 'lr 3/28/2009 16:15'! default ^ Instance ifNil: [ Instance := self new ]! ! !OBMorphicIcons class methodsFor: 'configuration' stamp: 'dr 9/4/2008 16:16'! iconHeight ^12! ! !OBMorphicIcons class methodsFor: 'as yet unclassified' stamp: 'dr 9/4/2008 16:35'! iconNamed: aSymbol ^ Icons at: aSymbol ifAbsentPut: [self default perform: aSymbol]! ! !OBMorphicIcons class methodsFor: 'configuration' stamp: 'dr 9/4/2008 16:16'! iconWidth ^12! ! !OBMorphicIcons class methodsFor: 'as yet unclassified' stamp: 'lr 3/21/2009 19:49'! initialize Instance := nil. Icons := IdentityDictionary new! ! !OBMorphicIcons methodsFor: 'icons' stamp: 'lr 7/10/2009 11:17'! announcement ^ ((ColorForm extent: 12@12 depth: 8 fromArray: #( 168300858 976894522 976888885 34288443 993737531 993722369 959979575 673982238 103889690 87761712 705236742 120273668 87758851 152641799 789920516 959985427 204284436 488586007 34289723 993723152 926613505 168311098 976632635 473311541 1010580540 1007826230 840318012 1010580540 456396046 1010580540 1010580526 623262780 1010580540 1010580540 1010580540 1010580540) offset: 0@0) colorsFromArray: #(#(0.706 0.788 0.875) #(0.439 0.596 0.761) #(0.545 0.674 0.807) #(0.887 0.934 0.996) #(0.538 0.667 0.804) #(0.423 0.585 0.753) #(0.859 0.918 0.992) #(0.844 0.91 0.992) #(0.577 0.694 0.819) #(0.879 0.93 0.996) #(0.953 0.969 0.98) #(0.663 0.757 0.855) #(0.863 0.922 0.992) #(0.372 0.549 0.733) #(0.71 0.792 0.879) #(0.867 0.926 0.996) #(0.815 0.891 0.992) #(0.361 0.542 0.729) #(0.435 0.592 0.761) #(0.875 0.926 0.996) #(0.827 0.902 0.992) #(0.819 0.894 0.992) #(0.678 0.768 0.863) #(0.49 0.635 0.784) #(0.898 0.941 0.996) #(0.867 0.922 0.996) #(0.482 0.628 0.78) #(0.639 0.741 0.848) #(0.937 0.953 0.973) #(0.815 0.894 0.992) #(0.871 0.926 0.996) #(0.819 0.894 0.988) #(0.941 0.965 0.996) #(0.855 0.914 0.992) #(0.84 0.906 0.992) #(0.91 0.945 0.996) #(0.522 0.655 0.796) #(0.431 0.592 0.757) #(0.745 0.815 0.891) #(0.883 0.934 0.996) #(0.902 0.945 0.996) #(0.458 0.612 0.768) #(0.891 0.937 0.996) #(0.836 0.902 0.992) #(0.894 0.937 0.996) #(0.851 0.914 0.992) #(0.914 0.937 0.965) #(0.831 0.902 0.992) #(0.902 0.941 0.996) #(0.863 0.918 0.992) #(0.365 0.545 0.729) #(0.984 0.988 0.992) #(0.6 0.714 0.831) #(0.906 0.934 0.961) #(0.616 0.721 0.836) #(0.914 0.949 0.996) #(0.992 0.996 0.996) #(0.353 0.534 0.725) #(0.345 0.53 0.721) #(1.0 1.0 1.0)))! ! !OBMorphicIcons methodsFor: 'icons' stamp: 'lr 8/2/2007 10:27'! arrowDown ^ ((ColorForm extent: 12@12 depth: 8 fromArray: #( 185273099 185273099 185273099 185273099 185273099 185273099 185273098 168430090 168495883 185273098 151587081 168495883 185273098 151191561 168495883 185207306 151388169 168430091 185207049 151257353 151587339 185272841 328199 151653131 185273098 150997001 168495883 185273099 168364298 185273099 185273099 185207307 185273099 185273099 185273099 185273099) offset: 0@0) colorsFromArray: #(#(0.573 0.804 0.369) #(0.565 0.768 0.412) #(0.577 0.804 0.372) #(0.561 0.804 0.326) #(0.588 0.831 0.345) #(0.6 0.844 0.353) #(0.565 0.804 0.329) #(0.545 0.772 0.349) #(0.486 0.682 0.353) #(0.388 0.561 0.271) #(1.0 1.0 1.0) #( )))! ! !OBMorphicIcons methodsFor: 'icons' stamp: 'lr 8/2/2007 10:24'! arrowUp ^ ((ColorForm extent: 12@12 depth: 8 fromArray: #( 185273099 185273099 185273099 185273099 185273099 185273099 185273099 185207307 185273099 185273099 168364298 185273099 185273098 150997001 168495883 185272841 328199 151653131 185207049 151257353 151587339 185207306 151388169 168430091 185273098 151191561 168495883 185273098 151587081 168495883 185273098 168430090 168495883 185273099 185273099 185273099) offset: 0@0) colorsFromArray: #(#(0.573 0.804 0.369) #(0.565 0.768 0.412) #(0.577 0.804 0.372) #(0.561 0.804 0.326) #(0.588 0.831 0.345) #(0.6 0.844 0.353) #(0.565 0.804 0.329) #(0.545 0.772 0.349) #(0.486 0.682 0.353) #(0.388 0.561 0.271) #(1.0 1.0 1.0) #( )))! ! !OBMorphicIcons methodsFor: 'icons' stamp: 'lr 8/2/2007 10:34'! arrowUpAndDown ^ ((ColorForm extent: 12@12 depth: 8 fromArray: #( 185273099 185207307 185273099 185273099 167772170 185273099 185273098 262400 168495883 185272832 67699971 658187 185204736 524800 2571 185207306 459776 168430091 185207306 394240 168430091 185204736 524800 2571 185272832 67699971 658187 185273098 262400 168495883 185273099 167772170 185273099 185273099 185207307 185273099) offset: 0@0) colorsFromArray: #(#(0.388 0.561 0.271) #(0.486 0.682 0.353) #(0.565 0.768 0.412) #(0.545 0.772 0.349) #(0.573 0.804 0.369) #(0.577 0.804 0.372) #(0.561 0.804 0.326) #(0.565 0.804 0.329) #(0.588 0.831 0.345) #(0.6 0.844 0.353) #(1.0 1.0 1.0) #( )))! ! !OBMorphicIcons methodsFor: 'icons' stamp: 'lr 3/28/2009 16:04'! blank ^ Form extent: 12 @ 12 depth: 8! ! !OBMorphicIcons methodsFor: 'icons' stamp: 'lr 8/2/2007 19:32'! breakpoint ^ ((ColorForm extent: 12@12 depth: 8 fromArray: #( 437918234 437918234 437918234 437654804 319885069 26 437590295 404100630 100859930 437524241 269290764 100860442 437327375 235736076 67305498 437261581 218893324 67305754 437130258 303174162 84082970 436931081 134678279 196890 437918234 437918234 196890 454761243 454761242 196890 454761243 454761242 196634 454761243 454761242 26) offset: 0@0) colorsFromArray: #(#(0.349 0.212 0.098) #(0.329 0.2 0.094) #(0.376 0.232 0.109) #(0.694 0.462 0.271) #(0.608 0.271 0.204) #(0.545 0.185 0.113) #(0.784 0.322 0.294) #(0.721 0.023 0.023) #(0.788 0.055 0.055) #(0.848 0.106 0.106) #(0.875 0.137 0.137) #(0.914 0.208 0.208) #(0.953 0.298 0.298) #(0.953 0.318 0.318) #(0.953 0.333 0.333) #(0.953 0.349 0.349) #(0.953 0.365 0.365) #(0.953 0.388 0.388) #(0.922 0.427 0.427) #(0.953 0.482 0.482) #(0.949 0.542 0.538) #(0.957 0.592 0.592) #(0.953 0.624 0.62) #(0.984 0.879 0.879) #(0.988 0.898 0.898) #(0.992 0.918 0.918) #(1.0 1.0 1.0) #( )))! ! !OBMorphicIcons methodsFor: 'icons' stamp: 'lr 3/29/2009 14:02'! collection ^ ((ColorForm extent: 12@12 depth: 8 fromArray: #( 168952850 171324982 909522486 255008812 271977989 285543990 706029348 70649368 724044854 254681884 271986469 689508662 135534100 137758237 890965046 909522486 909513472 436212534 909508866 151126326 909522486 909511457 807338806 909522486 909521969 841353526 909522486 909511458 504824630 909522486 909511943 755436854 909522486 909522486 909522486 909522486) offset: 0@0) colorsFromArray: #(#(0.565 0.764 0.538) #(0.992 0.98 0.934) #(0.957 0.879 0.549) #(0.953 0.867 0.514) #(1.0 0.569 0.286) #(0.577 0.772 0.553) #(0.557 0.761 0.53) #(0.957 0.875 0.538) #(1.0 0.949 0.914) #(0.937 0.827 0.369) #(1.0 0.953 0.922) #(0.953 0.871 0.53) #(0.542 0.753 0.518) #(0.992 0.98 0.926) #(0.937 0.965 0.934) #(1.0 0.678 0.466) #(1.0 0.667 0.451) #(0.408 0.678 0.372) #(1.0 0.694 0.494) #(0.93 0.961 0.926) #(1.0 0.682 0.478) #(0.918 0.631 0.447) #(1.0 0.557 0.271) #(0.848 0.757 0.384) #(0.545 0.745 0.506) #(0.561 0.686 0.522) #(0.392 0.671 0.357) #(0.466 0.659 0.423) #(0.887 0.53 0.298) #(0.514 0.71 0.474) #(0.807 0.737 0.458) #(0.887 0.796 0.423) #(0.91 0.628 0.443) #(0.93 0.84 0.466) #(0.894 0.804 0.435) #(0.831 0.553 0.372) #(0.823 0.542 0.357) #(0.643 0.772 0.604) #(0.804 0.733 0.443) #(0.871 0.588 0.408) #(0.498 0.698 0.462) #(0.612 0.733 0.573) #(1.0 0.577 0.306) #(0.639 0.764 0.6) #(0.926 0.569 0.337) #(0.937 0.823 0.353) #(0.937 0.581 0.349) #(0.419 0.686 0.388) #(0.883 0.811 0.53) #(0.894 0.823 0.534) #(0.848 0.776 0.494) #(0.973 0.612 0.38) #(0.941 0.831 0.384) #(0.573 0.694 0.534) #( ) ))! ! !OBMorphicIcons methodsFor: 'icons' stamp: 'lr 3/29/2009 14:10'! exception ^ ((ColorForm extent: 12@12 depth: 8 fromArray: #( 1583238196 1191577949 759500554 1583225870 390089009 36066088 1578711384 857557019 906518110 1581393173 991970905 1549688414 722677332 570761514 1583242846 1327383559 1091971346 5322527 792346372 337270359 1297099812 1011548469 286015067 654532190 1583242842 941838926 1432247902 1583242763 221384798 1583242846 1583224899 1029594718 1583242846 1583231050 1583242846 1583242846) offset: 0@0) colorsFromArray: #(#(0.906 0.764 0.392) #(0.945 0.867 0.6) #(0.918 0.776 0.306) #(0.969 0.922 0.815) #(0.945 0.831 0.443) #(0.953 0.84 0.443) #(0.934 0.823 0.388) #(0.953 0.819 0.286) #(0.98 0.949 0.855) #(0.93 0.815 0.376) #(0.992 0.98 0.941) #(0.894 0.733 0.302) #(0.945 0.792 0.4) #(0.898 0.725 0.286) #(0.949 0.863 0.423) #(0.965 0.91 0.737) #(0.984 0.961 0.906) #(0.914 0.772 0.365) #(0.91 0.768 0.384) #(0.941 0.844 0.415) #(0.953 0.844 0.498) #(0.965 0.871 0.4) #(0.953 0.836 0.474) #(0.945 0.859 0.439) #(0.949 0.867 0.651) #(0.988 0.965 0.867) #(0.949 0.815 0.455) #(0.957 0.855 0.542) #(0.953 0.875 0.514) #(0.957 0.836 0.341) #(0.953 0.867 0.474) #(0.914 0.78 0.474) #(0.945 0.8 0.263) #(0.934 0.811 0.431) #(0.941 0.792 0.216) #(0.93 0.788 0.443) #(0.965 0.914 0.796) #(0.965 0.891 0.51) #(0.898 0.733 0.22) #(0.906 0.764 0.435) #(0.992 0.984 0.953) #(0.898 0.737 0.275) #(0.957 0.894 0.71) #(0.992 0.977 0.914) #(0.926 0.815 0.569) #(0.918 0.788 0.333) #(0.973 0.902 0.561) #(0.918 0.788 0.286) #(0.957 0.891 0.725) #(0.937 0.815 0.396) #(0.902 0.757 0.396) #(0.965 0.867 0.369) #(0.937 0.84 0.384) #(0.934 0.836 0.526) #(0.91 0.764 0.306) #(0.887 0.721 0.333) #(0.914 0.764 0.357) #(0.941 0.855 0.412) #(0.949 0.855 0.462) #(0.949 0.811 0.232) #(0.957 0.891 0.635) #(0.945 0.863 0.659) #(0.941 0.776 0.408) #(0.953 0.855 0.474) #(0.945 0.844 0.427) #(0.941 0.78 0.236) #(0.957 0.891 0.608) #(0.875 0.69 0.216) #(0.969 0.883 0.451) #(0.906 0.761 0.286) #(0.957 0.848 0.498) #(0.934 0.836 0.396) #(0.961 0.84 0.415) #(0.941 0.831 0.408) #(0.977 0.941 0.855) #(0.949 0.875 0.604) #(0.965 0.91 0.655) #(0.922 0.757 0.404) #(0.941 0.851 0.635) #(0.965 0.914 0.698) #(0.879 0.69 0.247) #(0.898 0.741 0.353) #(0.891 0.717 0.302) #(0.973 0.934 0.804) #(0.953 0.831 0.279) #(1.0 0.996 0.992) #(0.941 0.796 0.443) #(0.941 0.804 0.486) #(0.98 0.922 0.573) #(0.914 0.772 0.345) #(0.98 0.945 0.859) #(0.902 0.725 0.322) #(0.969 0.918 0.772) #(0.926 0.8 0.357) #( ) ))! ! !OBMorphicIcons methodsFor: 'icons' stamp: 'lr 8/2/2007 19:32'! flag ^ ((ColorForm extent: 12@12 depth: 8 fromArray: #( 437918234 437918234 437918234 436470535 101584139 387389210 436404481 17105924 303634202 436666638 218827016 35198490 437126412 185075720 1644314 437060363 168298504 1644570 436930320 269422351 370743322 437326099 320082453 387520538 437918234 437918234 387520538 454761243 454761242 387520538 454761243 454761242 387520282 454761243 454761242 387389210) offset: 0@0) colorsFromArray: #(#(0.22 0.396 0.585) #(0.898 0.945 0.996) #(0.228 0.498 0.761) #(0.608 0.796 0.98) #(0.635 0.804 0.98) #(0.655 0.819 0.98) #(0.47 0.729 0.973) #(0.542 0.768 0.977) #(0.251 0.631 0.961) #(0.267 0.639 0.961) #(0.275 0.643 0.961) #(0.286 0.647 0.961) #(0.302 0.659 0.965) #(0.326 0.667 0.965) #(0.353 0.678 0.965) #(0.396 0.714 0.965) #(0.419 0.729 0.969) #(0.239 0.686 0.93) #(0.243 0.624 0.772) #(0.236 0.682 0.851) #(0.228 0.667 0.788) #(0.224 0.616 0.671) #(0.384 0.228 0.082) #(0.349 0.212 0.098) #(0.329 0.2 0.094) #(0.694 0.462 0.271) #(1.0 1.0 1.0) #( )))! ! !OBMorphicIcons methodsFor: 'icons' stamp: 'lr 3/29/2009 14:19'! magnitude ^ ((ColorForm extent: 12@12 depth: 8 fromArray: #( 874447653 738461995 85013556 875824136 573444634 471217204 875826957 607204404 875115572 875836464 489816628 875836468 875836468 50409268 875836468 875836468 268902708 875836468 875836418 101004340 875836468 875836448 167851060 873804852 875825163 204747815 874722356 875763995 321259818 335557684 875042605 102243847 930868 875836468 875836468 875836468) offset: 0@0) colorsFromArray: #(#(0.372 0.372 0.372) #(0.608 0.608 0.608) #(0.961 0.961 0.961) #(0.506 0.506 0.506) #(0.588 0.588 0.588) #(0.415 0.415 0.415) #(0.419 0.419 0.419) #(0.384 0.384 0.384) #(0.745 0.745 0.745) #(0.561 0.561 0.561) #(0.447 0.447 0.447) #(0.435 0.435 0.435) #(0.427 0.427 0.427) #(0.545 0.545 0.545) #(0.522 0.522 0.522) #(0.902 0.902 0.902) #(0.761 0.761 0.761) #(0.53 0.53 0.53) #(0.686 0.686 0.686) #(0.628 0.628 0.628) #(0.181 0.181 0.181) #(0.204 0.204 0.204) #(0.604 0.604 0.604) #(0.455 0.455 0.455) #(0.408 0.408 0.408) #(0.341 0.341 0.341) #(0.659 0.659 0.659) #(0.333 0.333 0.333) #(0.663 0.663 0.663) #(0.624 0.624 0.624) #(0.396 0.396 0.396) #(0.875 0.875 0.875) #(0.542 0.542 0.542) #(0.592 0.592 0.592) #(0.569 0.569 0.569) #(0.236 0.236 0.236) #(0.565 0.565 0.565) #(0.494 0.494 0.494) #(0.62 0.62 0.62) #(0.953 0.953 0.953) #(0.733 0.733 0.733) #(0.502 0.502 0.502) #(0.298 0.298 0.298) #(0.451 0.451 0.451) #(0.585 0.585 0.585) #(0.439 0.439 0.439) #(0.698 0.698 0.698) #(0.714 0.714 0.714) #(0.721 0.721 0.721) #(0.855 0.855 0.855) #(0.474 0.474 0.474) #(0.871 0.871 0.871) #( ) ))! ! !OBMorphicIcons methodsFor: 'icons' stamp: 'lr 3/29/2009 14:13'! morph ^ ((ColorForm extent: 12@12 depth: 8 fromArray: #( 1578631802 292362797 539127618 1895825665 2117994270 1445606482 202325275 1997372285 33573212 859313989 1763509875 1213866361 1064308758 192424752 1645101626 793665883 476466020 85208644 1751792704 621947215 1414349622 527711064 676669009 1346794755 1617375851 1095982919 656635516 1819423020 354700362 1695037706 154613091 420699479 75263577 2139062143 2139062143 2139062143) offset: 0@0) colorsFromArray: #(#(0.557 0.714 0.898) #(0.526 0.686 0.887) #(0.557 0.706 0.887) #(0.494 0.604 0.796) #(0.494 0.6 0.792) #(0.585 0.811 1.0) #(0.879 0.93 0.883) #(0.514 0.671 0.867) #(0.84 0.867 0.902) #(0.581 0.667 0.804) #(0.474 0.577 0.753) #(0.729 0.851 0.674) #(0.51 0.678 0.883) #(0.565 0.71 0.918) #(0.733 0.894 1.0) #(0.538 0.694 0.883) #(0.455 0.741 1.0) #(0.553 0.69 0.871) #(0.969 0.867 0.78) #(0.506 0.635 0.815) #(0.757 0.906 1.0) #(0.851 0.879 0.922) #(0.655 0.844 1.0) #(0.836 0.918 0.992) #(0.604 0.741 0.902) #(0.518 0.631 0.804) #(0.542 0.678 0.855) #(0.549 0.698 0.883) #(0.753 0.875 0.725) #(0.815 0.894 0.823) #(0.51 0.667 0.863) #(0.639 0.733 0.91) #(0.522 0.659 0.84) #(0.686 0.757 0.867) #(0.542 0.671 0.836) #(1.0 0.949 0.612) #(0.848 0.859 0.894) #(0.988 0.949 0.918) #(1.0 0.682 0.514) #(0.984 0.871 0.415) #(1.0 0.796 0.674) #(0.977 0.914 0.867) #(0.518 0.671 0.859) #(0.585 0.776 0.518) #(0.836 0.879 0.922) #(0.534 0.671 0.851) #(0.706 0.757 0.855) #(0.643 0.745 0.879) #(0.819 0.918 1.0) #(0.827 0.871 0.906) #(0.458 0.721 0.404) #(0.62 0.737 0.891) #(0.51 0.631 0.8) #(0.577 0.663 0.848) #(0.506 0.612 0.776) #(0.565 0.671 0.84) #(0.926 0.961 0.992) #(0.581 0.659 0.792) #(0.545 0.639 0.792) #(0.4 0.686 0.353) #(0.811 0.898 0.827) #(0.561 0.706 0.883) #(0.518 0.674 0.871) #(0.659 0.757 0.891) #(0.887 0.945 0.902) #(1.0 0.84 0.717) #(0.717 0.776 0.863) #(0.678 0.745 0.859) #(0.538 0.628 0.776) #(0.898 0.945 0.992) #(1.0 0.918 0.549) #(0.996 0.961 0.757) #(0.863 0.93 0.992) #(0.474 0.628 0.827) #(0.844 0.871 0.914) #(0.62 0.807 0.581) #(0.848 0.867 0.91) #(0.988 0.977 0.898) #(0.804 0.914 1.0) #(0.98 0.977 0.934) #(0.957 0.84 0.365) #(0.961 0.93 0.714) #(0.596 0.678 0.815) #(1.0 0.6 0.314) #(0.953 0.937 0.823) #(1.0 0.538 0.243) #(0.502 0.659 0.855) #(0.498 0.596 0.768) #(0.549 0.792 0.577) #(0.612 0.682 0.807) #(0.914 0.957 0.992) #(0.706 0.863 1.0) #(0.482 0.616 0.8) #(0.498 0.624 0.792) #(0.694 0.757 0.863) #(1.0 0.737 0.569) #(0.631 0.721 0.902) #(0.522 0.772 1.0) #(0.549 0.792 1.0) #(0.553 0.647 0.823) #(0.836 0.926 1.0) #(0.84 0.863 0.891) #(0.423 0.717 0.423) #(0.788 0.898 0.733) #(0.612 0.729 0.887) #(0.918 0.953 0.922) #(0.934 0.965 0.934) #(0.616 0.831 0.628) #(0.53 0.643 0.807) #(0.545 0.686 0.863) #(0.502 0.596 0.753) #(0.616 0.702 0.823) #(0.772 0.898 1.0) #(0.581 0.686 0.844) #(0.851 0.891 0.934) #(0.937 0.965 0.992) #(0.729 0.859 0.686) #(0.671 0.745 0.879) #(0.682 0.749 0.879) #(0.545 0.698 0.898) #(0.388 0.682 0.341) #(0.534 0.639 0.8) #(0.561 0.702 0.883) #(0.553 0.706 0.91) #(0.486 0.588 0.776) #(0.542 0.698 0.887) #(0.522 0.678 0.875) #( ) ))! ! !OBMorphicIcons methodsFor: 'icons' stamp: 'lr 3/29/2009 14:19'! string ^ ((ColorForm extent: 12@12 depth: 8 fromArray: #( 673716502 100672805 623061032 673717016 118757928 587409448 673710082 33825576 354166824 673717518 268698408 19277864 673714447 504037672 638134312 673720360 302655016 606152744 673720360 673588264 555886632 673720360 673456424 572991528 673720360 671621672 656418856 673720360 673654568 538912808 673720360 671948840 84682792 673720360 673128232 320284712) offset: 0@0) colorsFromArray: #(#(0.439 0.721 0.937) #(0.447 0.674 0.93) #(0.573 0.784 0.953) #(0.451 0.682 0.937) #(0.534 0.761 0.949) #(0.435 0.631 0.926) #(0.439 0.729 0.945) #(0.573 0.788 0.953) #(0.443 0.651 0.926) #(0.443 0.663 0.93) #(0.427 0.671 0.93) #(0.494 0.733 0.945) #(0.431 0.631 0.926) #(0.435 0.643 0.926) #(0.498 0.745 0.945) #(0.478 0.694 0.934) #(0.569 0.78 0.953) #(0.941 0.965 0.992) #(0.941 0.961 0.992) #(0.431 0.628 0.926) #(0.538 0.764 0.949) #(0.447 0.682 0.937) #(0.435 0.706 0.937) #(0.431 0.628 0.918) #(0.522 0.768 0.949) #(0.827 0.898 0.977) #(0.455 0.694 0.937) #(0.419 0.71 0.937) #(0.447 0.682 0.93) #(0.455 0.698 0.937) #(0.443 0.71 0.937) #(0.435 0.635 0.926) #(0.435 0.639 0.926) #(0.443 0.659 0.926) #(0.439 0.651 0.926) #(0.451 0.686 0.937) #(0.443 0.659 0.93) #(0.439 0.717 0.937) #(0.443 0.671 0.93) #(0.435 0.647 0.926) #( ) ))! ! !OBMorphicIcons methodsFor: 'icons' stamp: 'lr 3/28/2009 19:01'! testGray ^ ((ColorForm extent: 12@12 depth: 8 fromArray: #( 471604252 471604252 471604252 471604252 471604252 471604252 471604252 471604252 471604252 471604245 67180800 52173852 471604228 302583304 119282716 471604225 436213762 370940956 471604237 319162885 270277660 471604247 117572884 253500444 471604227 101388571 203168796 471604252 471604252 471604252 471604252 471604252 471604252 471604252 471604252 471604252) offset: 0@0) colorsFromArray: #(#(0.761 0.761 0.761) #(0.62 0.62 0.62) #(0.788 0.788 0.788) #(0.949 0.949 0.949) #(0.776 0.776 0.776) #(0.764 0.764 0.764) #(0.733 0.733 0.733) #(0.741 0.741 0.741) #(0.745 0.745 0.745) #(0.871 0.871 0.871) #(0.714 0.714 0.714) #(0.542 0.542 0.542) #(0.934 0.934 0.934) #(0.608 0.608 0.608) #(0.855 0.855 0.855) #(0.694 0.694 0.694) #(0.53 0.53 0.53) #(0.522 0.522 0.522) #(0.772 0.772 0.772) #(0.836 0.836 0.836) #(0.717 0.717 0.717) #(0.953 0.953 0.953) #(0.553 0.553 0.553) #(0.753 0.753 0.753) #(0.729 0.729 0.729) #(0.612 0.612 0.612) #(0.867 0.867 0.867) #(0.69 0.69 0.69) #( ) ))! ! !OBMorphicIcons methodsFor: 'icons' stamp: 'lr 3/28/2009 19:00'! testGreen ^ ((ColorForm extent: 12@12 depth: 8 fromArray: #( 589505315 589505315 589505315 589505315 589505315 589505315 589505315 589505315 589505315 589505302 1248283 337847075 589505280 185011458 488842019 589505281 270075936 404955939 589505298 237047580 170074915 589505303 520428049 505619235 589505284 571803907 102966051 589505315 589505315 589505315 589505315 589505315 589505315 589505315 589505315 589505315) offset: 0@0) colorsFromArray: #(#(0.624 0.863 0.612) #(0.372 0.761 0.353) #(0.585 0.8 0.573) #(0.588 0.721 0.569) #(0.922 0.961 0.918) #(0.639 0.831 0.631) #(0.914 0.937 0.91) #(0.761 0.887 0.757) #(0.538 0.8 0.534) #(0.329 0.6 0.298) #(0.333 0.616 0.306) #(0.608 0.84 0.592) #(0.372 0.753 0.349) #(0.733 0.875 0.729) #(0.71 0.863 0.706) #(0.522 0.792 0.514) #(0.753 0.883 0.753) #(0.565 0.761 0.549) #(0.369 0.741 0.345) #(0.372 0.764 0.353) #(0.922 0.965 0.918) #(0.337 0.631 0.31) #(0.926 0.973 0.922) #(0.616 0.827 0.6) #(0.345 0.651 0.314) #(0.585 0.823 0.585) #(0.608 0.815 0.6) #(0.62 0.84 0.604) #(0.616 0.815 0.604) #(0.608 0.807 0.596) #(0.592 0.729 0.573) #(0.585 0.796 0.569) #(0.643 0.831 0.635) #(0.545 0.8 0.542) #(0.608 0.796 0.592) #( ) ))! ! !OBMorphicIcons methodsFor: 'icons' stamp: 'lr 3/28/2009 18:59'! testOrange ^ ((ColorForm extent: 12@12 depth: 8 fromArray: #( 589505315 589505315 589505315 589505315 589505315 589505315 589505315 589505315 589505315 589505292 1318158 52634403 589505280 353567759 186852131 589505308 35522317 572728099 589505298 136384537 539173667 589505311 151064856 102966051 589505302 454694661 170074915 589505315 589505315 589505315 589505315 589505315 589505315 589505315 589505315 589505315) offset: 0@0) colorsFromArray: #(#(1.0 0.784 0.553) #(1.0 0.8 0.577) #(1.0 0.883 0.737) #(1.0 0.949 0.898) #(1.0 0.871 0.714) #(0.883 0.667 0.498) #(0.891 0.667 0.498) #(1.0 0.753 0.458) #(1.0 0.848 0.674) #(1.0 0.741 0.482) #(0.969 0.926 0.898) #(0.984 0.741 0.498) #(1.0 0.957 0.91) #(1.0 0.8 0.581) #(1.0 0.764 0.522) #(1.0 0.753 0.494) #(1.0 0.737 0.431) #(1.0 0.776 0.53) #(1.0 0.612 0.216) #(1.0 0.883 0.741) #(1.0 0.631 0.243) #(1.0 0.776 0.549) #(0.996 0.949 0.898) #(0.879 0.494 0.164) #(1.0 0.71 0.435) #(1.0 0.772 0.534) #(0.918 0.526 0.164) #(0.969 0.725 0.498) #(1.0 0.635 0.239) #(1.0 0.628 0.228) #(1.0 0.796 0.526) #(1.0 0.757 0.51) #(0.894 0.506 0.164) #(1.0 0.757 0.466) #(0.937 0.538 0.164) #( ) ))! ! !OBMorphicIcons methodsFor: 'icons' stamp: 'lr 3/28/2009 18:59'! testRed ^ ((ColorForm extent: 12@12 depth: 8 fromArray: #( 589505315 589505315 589505315 589505315 589505315 589505315 589505315 589505315 589505315 589505302 269830 287515427 589505280 151065628 488842019 589505282 437981986 220406563 589505288 236066819 186852131 589505290 555032591 86188835 589505311 202835737 270738211 589505315 589505315 589505315 589505315 589505315 589505315 589505315 589505315 589505315) offset: 0@0) colorsFromArray: #(#(1.0 0.51 0.498) #(0.984 0.737 0.725) #(0.98 0.177 0.164) #(0.953 0.534 0.526) #(0.988 0.177 0.164) #(0.815 0.498 0.522) #(0.965 0.502 0.498) #(0.761 0.164 0.185) #(0.949 0.173 0.164) #(0.992 0.506 0.502) #(0.949 0.502 0.498) #(0.78 0.164 0.185) #(0.902 0.498 0.502) #(0.827 0.164 0.177) #(0.973 0.674 0.663) #(0.894 0.47 0.474) #(0.953 0.898 0.906) #(0.988 0.898 0.898) #(0.961 0.466 0.439) #(0.961 0.455 0.431) #(0.98 0.71 0.694) #(0.961 0.577 0.565) #(1.0 0.902 0.898) #(0.804 0.164 0.181) #(0.957 0.423 0.404) #(0.804 0.498 0.522) #(0.984 0.737 0.721) #(0.973 0.526 0.494) #(0.941 0.49 0.49) #(0.922 0.498 0.502) #(0.969 0.177 0.164) #(0.984 0.898 0.898) #(0.953 0.534 0.522) #(0.934 0.486 0.486) #(0.961 0.581 0.569) #( )))! ! !BorderedSubpaneDividerMorph methodsFor: '*ob-morphic' stamp: 'cwp 7/23/2007 02:09'! styleWith: aBuilder self vResizing = #spaceFill ifTrue: [aBuilder styleVerticalDivider: self] ifFalse: [aBuilder styleHorizontalDivider: self]! ! OBBuilder subclass: #OBMorphBuilder instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Morphic-Core'! !OBMorphBuilder class methodsFor: 'instance-creation' stamp: 'lr 6/20/2007 09:36'! open: aModel ^ (self build: aModel) openInWorld! ! !OBMorphBuilder methodsFor: 'building' stamp: 'cwp 8/26/2009 23:21'! button: aButtonModel with: aBlock | morph | morph := PluggableButtonMorph on: aButtonModel getState: #isSelected action: #push label: #labelMorph. morph hResizing: #spaceFill; vResizing: #spaceFill; styleWith: OBPlatform current builder. ^ self current: morph do: aBlock! ! !OBMorphBuilder methodsFor: 'building' stamp: 'lr 7/10/2009 11:05'! fixedButtonBar: aPanel with: aBlock | morph | morph := OBButtonBar on: aPanel. morph height: Preferences standardButtonFont height * 2.5; layoutPolicy: TableLayout new; vResizing: #rigid; hResizing: #spaceFill; listDirection: #leftToRight; rubberBandCells: true; borderWidth: 0. current addMorphBack: morph. self current: morph do: aBlock! ! !OBMorphBuilder methodsFor: 'building' stamp: 'cwp 12/9/2007 11:58'! horizontalGroupWith: aBlock | morph | morph := OBGroupingMorph new. morph layoutPolicy: TableLayout new. morph listDirection: #leftToRight. current addMorph: morph frame: (0 @ 0 extent: 1 @ 1). self current: morph do: aBlock. morph addBorders! ! !OBMorphBuilder methodsFor: 'private' stamp: 'lr 2/12/2009 10:36'! layoutPanels | panes | panes := current submorphs select: [ :ea | ea class == OBGroupingMorph ]. (self shouldUseSpecialLayoutFor: panes) ifTrue: [ panes first layoutFrame bottomFraction: 0.4. panes second layoutFrame topFraction: 0.4 ] ifFalse: [ panes keysAndValuesDo: [ :index :morph | morph layoutFrame topFraction: (index - 1) / panes size; bottomFraction: index / panes size ] ]. panes do: [ :ea | ea on: #mouseEnter send: #paneTransition: to: current. ea on: #mouseLeave send: #paneTransition: to: current ]. self style39 ifTrue: [ current addPaneSplitters ]! ! !OBMorphBuilder methodsFor: 'private' stamp: 'lr 7/4/2009 16:53'! listMorphForColumn: aColumn ^ (OBPluggableListMorph on: aColumn list: #list selected: #selection changeSelected: #selection: menu: #menu: keystroke: #keystroke:from:) getListElementSelector: #listAt:; getListSizeSelector: #listSize; dragEnabled: aColumn dragEnabled; dropEnabled: aColumn dropEnabled; doubleClickSelector: #doubleClick; alwaysShowScrollBars: false; borderWidth: 0; autoDeselect: false; yourself! ! !OBMorphBuilder methodsFor: 'private' stamp: 'dr 10/30/2008 16:22'! mercuryMorphFor: aMercuryPanel ^ (OBPluggableTextMorph on: aMercuryPanel text: #text accept: #accept:notifying: readSelection: #selection menu: #menu:shifted:) font: Preferences standardCodeFont; hideScrollBarsIndefinitely; acceptOnCR: true; height: Preferences standardCodeFont height * 1.2; borderWidth: 0; vResizing: #rigid; hResizing: #spaceFill; yourself.! ! !OBMorphBuilder methodsFor: 'building' stamp: 'lr 3/4/2009 08:17'! pane: aColumn with: aBlock | pane | pane := OBPane new. pane model: aColumn; hResizing: #spaceFill; vResizing: #spaceFill; clipSubmorphs: true; color: Color transparent; cellInset: 0; borderWidth: 0; layoutPolicy: ProportionalLayout new; addList: (self listMorphForColumn: aColumn). current isNil ifFalse: [ current pushPane: pane ]. ^ self current: pane do: aBlock! ! !OBMorphBuilder methodsFor: 'building' stamp: 'lr 3/4/2009 08:17'! radioButtonBar: aSwitch with: aBlock | morph | ^ aSwitch isActive ifTrue: [ morph := OBRadioButtonBar on: aSwitch list: #list selected: #selection changeSelected: #selection:. current isNil ifFalse: [ current addButton: morph ]. morph ]! ! !OBMorphBuilder methodsFor: 'building' stamp: 'lr 3/4/2009 08:17'! scroller: aColumnPanel with: aBlock | morph | morph := (OBPaneScroller withModel: aColumnPanel) name: 'scroller'; vResizing: #spaceFill; hResizing: #spaceFill; yourself. current isNil ifFalse: [ current addMorphBack: morph ]. ^ self current: morph do: aBlock! ! !OBMorphBuilder methodsFor: 'private' stamp: 'lr 2/12/2009 10:35'! shouldUseSpecialLayoutFor: panes ^ panes size = 2 and: [ panes first listDirection = #topToBottom and: [ panes second listDirection = #topToBottom and: [ panes first lastSubmorph class = OBPaneScroller and: [ panes last lastSubmorph class = OBPluggableTextMorph ] ] ] ]! ! !OBMorphBuilder methodsFor: 'style' stamp: 'cwp 7/23/2007 02:04'! style39 ^ Smalltalk hasClassNamed: #AbstractResizerMorph! ! !OBMorphBuilder methodsFor: 'style' stamp: 'cwp 7/21/2007 22:26'! styleButton: aButton self style39 ifFalse: [aButton borderWidth: 2; borderRaised]! ! !OBMorphBuilder methodsFor: 'style' stamp: 'cwp 7/21/2007 22:26'! styleButtonBar: aBar self style39 ifFalse: [aBar borderWidth: 0] ifTrue: [aBar color: Color transparent; borderWidth: 0; layoutInset: 2; cellInset: 2] ! ! !OBMorphBuilder methodsFor: 'style' stamp: 'cwp 7/23/2007 02:08'! styleHorizontalDivider: divider self style39 ifTrue: [divider height: 3] ifFalse: [divider borderWidth: 2; borderInset]! ! !OBMorphBuilder methodsFor: 'style' stamp: 'cwp 7/23/2007 02:08'! styleVerticalDivider: divider self style39 ifTrue: [divider height: 3] ifFalse: [divider borderWidth: 2; borderRaised]! ! !OBMorphBuilder methodsFor: 'private' stamp: 'cwp 8/26/2009 22:03'! textMorphClass ^ OBPluggableTextMorph! ! !OBMorphBuilder methodsFor: 'building' stamp: 'cwp 8/26/2009 14:45'! textarea: aDefinitionPanel with: aBlock "see CodeHolder>>buildMorphicCodePaneWith:" | morph | morph := self textMorphClass on: aDefinitionPanel text: #text accept: #accept:notifying: readSelection: #selection menu: #menu:shifted:. morph font: Preferences standardCodeFont; borderWidth: 0; vResizing: #spaceFill; hResizing: #spaceFill. current isNil ifFalse: [ current addMorphBack: morph ]. ^ self current: morph do: aBlock! ! !OBMorphBuilder methodsFor: 'building' stamp: 'cwp 8/26/2009 23:21'! textfield: aMercuryPanel with: aBlock | morph divider | morph := self mercuryMorphFor: aMercuryPanel. morph color: Color white. current isNil ifFalse: [ current addMorphBack: morph. self current: morph do: aBlock. divider := BorderedSubpaneDividerMorph horizontal color: aMercuryPanel browser defaultBackgroundColor duller; styleWith: OBPlatform current builder. current addMorphBack: divider ]. ^ morph! ! !OBMorphBuilder methodsFor: 'building' stamp: 'cwp 12/9/2007 10:57'! verticalGroupWith: aBlock | morph | morph := OBGroupingMorph new. morph layoutPolicy: TableLayout new. current addMorph: morph frame: (0 @ 0 extent: 1 @ 1). self current: morph do: aBlock! ! !OBMorphBuilder methodsFor: 'building' stamp: 'lr 2/17/2009 17:30'! window: aBrowser with: aBlock | window | window := SystemWindow labelled: aBrowser labelString. window model: aBrowser. ^self current: window do: [aBlock value. self layoutPanels]! ! PluggableListMorph subclass: #OBPluggableListMorph instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Morphic-Morphs'! !OBPluggableListMorph commentStamp: 'dr 7/18/2007 14:27' prior: 0! I am a special kind of PluggableListMorph and provides methods to access icons for list elements. I use OBLazyListMorph as listMorphClass! !OBPluggableListMorph methodsFor: 'model access' stamp: 'cwp 7/24/2007 00:12'! iconAt: index ^ model iconAt: index! ! !OBPluggableListMorph methodsFor: 'list management' stamp: 'lr 4/3/2009 13:26'! listMorphClass ^ OBLazyListMorph! ! !OBPluggableListMorph methodsFor: 'as yet unclassified' stamp: 'lr 5/4/2009 20:25'! mouseUp: event "Override a change in PLM that breaks OmniBrowser. This version of the method is from Squeak 3.7 and was originally stamped: 'ls 6/22/2001 22:49'" | row previousSelectionIndex icon | row := self rowAtLocation: event position. "aMorph ifNotNil: [aMorph highlightForMouseDown: false]." model okToChange ifFalse: [^ self]. (autoDeselect == false and: [row == 0]) ifTrue: [^ self]. "work-around the no-mans-land bug" "No change if model is locked" previousSelectionIndex := self selectionIndex. ((autoDeselect == nil or: [autoDeselect]) and: [row == self selectionIndex]) ifTrue: [self changeModelSelection: 0] ifFalse: [self changeModelSelection: row]. Cursor normal show. "Trigger icon action" (previousSelectionIndex = self selectionIndex and: [ (row := self rowAtLocation: event position) ~= 0 and: [ (icon := self iconAt: row) notNil and: [ (icon := OBMorphicIcons iconNamed: icon) notNil and: [ (event position x - self left < icon width) ] ] ] ]) ifTrue: [ model clickIconAt: row ]! ! !OBNode methodsFor: '*ob-morphic' stamp: 'cwp 3/2/2004 21:28'! acceptDroppedNode: aNode ^ aNode perform: self dropSelector with: self ! ! !OBNode methodsFor: '*ob-morphic' stamp: 'avi 2/20/2004 14:00'! asDraggableMorph ^(StringMorph contents: self name) color: Color white; yourself! ! !OBNode methodsFor: '*ob-morphic' stamp: 'cwp 3/2/2004 21:29'! dropSelector "Override in subclasses" ^ #dropOnNode: ! ! !OBNode methodsFor: '*ob-morphic' stamp: 'cwp 3/2/2004 21:28'! wantsDroppedNode: aNode ^ aNode respondsTo: self dropSelector! ! LazyListMorph subclass: #OBLazyListMorph instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Morphic-Morphs'! !OBLazyListMorph commentStamp: 'dr 7/18/2007 14:28' prior: 0! I am an adapted version of LazyListMorph. I can display icons and colors for my elements.! !OBLazyListMorph methodsFor: 'drawing' stamp: 'lr 4/3/2009 13:24'! colorForRow: row | item | ^(selectedRow notNil and: [ row = selectedRow]) ifTrue: [ Color black ] ifFalse: [ item := self getListItem: row. item isText ifTrue: [item colorAt: 1] ifFalse: [self color] ].! ! !OBLazyListMorph methodsFor: 'drawing' stamp: 'lr 7/3/2009 22:31'! display: item atRow: row on: canvas "display the given item at row row" | drawBounds top icon | drawBounds := self drawBoundsForRow: row. drawBounds := drawBounds intersect: self bounds. (listSource iconAt: row) ifNotNilDo: [ :name | icon := OBMorphicIcons iconNamed: name. top := drawBounds top + ((drawBounds height - icon height) // 2). canvas translucentImage: icon at: drawBounds left @ top. drawBounds := drawBounds left: drawBounds left + icon width + 2 ]. item isText ifTrue: [ canvas drawString: item in: drawBounds font: (font emphasized: (item emphasisAt: 1)) color: (self colorForRow: row) ] ifFalse: [ canvas drawString: item in: drawBounds font: font color: (self colorForRow: row) ]! ! !MenuMorph methodsFor: '*ob-morphic' stamp: 'cwp 6/8/2007 20:45'! add: label target: anObject selector: aSelector enabled: aBoolean icon: aSymbol self add: label target: anObject selector: aSelector. self lastItem isEnabled: aBoolean. Preferences menuWithIcons ifTrue: [self lastItem icon: (self iconNamed: aSymbol)]! ! !MenuMorph methodsFor: '*ob-morphic' stamp: 'cwp 9/30/2007 18:34'! addSubmenu: aString enabled: aBoolean "Append the given submenu with the given label." | item submenu | item := MenuItemMorph new. submenu := MenuMorph new. item contents: aString; isEnabled: aBoolean; subMenu: submenu. self addMorphBack: item. ^ submenu! ! !MenuMorph methodsFor: '*ob-morphic' stamp: 'cwp 6/8/2007 20:41'! iconNamed: aSymbol | sel | aSymbol ifNil: [^ MenuIcons blankIcon]. sel := (MenuIcons respondsTo: aSymbol) ifTrue: [aSymbol] ifFalse: [('small', aSymbol capitalized) asSymbol]. ^ MenuIcons perform: sel! ! !ScrollBar methodsFor: '*ob-morphic' stamp: 'lr 10/19/2009 22:55'! animateValue: newValue | to delta currentTo accel | to := newValue roundTo: scrollDelta. delta := 0.005 min: (to - value) abs. currentTo := to. [ [ (value closeTo: to) or: [ (currentTo closeTo: to) not ] ] whileFalse: [ | time | time := DateAndTime now. delta := (delta * 1.5) min: ((currentTo - value) abs). self setValue: (value < to ifTrue: [ value + delta ] ifFalse: [ value - delta ]). ((10 milliSeconds - (DateAndTime now - time)) max: 0 milliSeconds) asDelay wait ] ] forkAt: Processor highestPriority! ! !PluggableButtonMorph methodsFor: '*ob-morphic' stamp: 'cwp 7/21/2007 21:18'! styleWith: aBuilder aBuilder styleButton: self! ! !OBMultipleChoiceRequest methodsFor: '*ob-morphic' stamp: 'lr 10/11/2009 12:18'! toggleMorphic: anObject "This seems to be somehow required to properly refersh the checkbox." self toggle: anObject. World restoreDisplay! ! OBMorphicPlatform initialize! OBMorphicIcons initialize!