SystemOrganization addCategory: #'OB-Polymorph-Core'! SystemOrganization addCategory: #'OB-Polymorph-Morph'! PluggableListMorph subclass: #OBPluggableListMorph instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Polymorph-Morph'! !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: 'events' stamp: 'lr 11/23/2011 21:45'! 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 ]! ! !OBPluggableListMorph methodsFor: 'updating' stamp: 'lr 10/11/2010 10:17'! updateList | pos index | pos := scrollBar value. self listMorph listChanged. self setScrollDeltas. scrollBar setValue: pos. index := self getCurrentSelectionIndex. self resetPotentialDropRow. self selectionIndex: index! ! !OBMultipleChoiceRequest methodsFor: '*ob-polymorph' 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! ! DialogWindow subclass: #OBCompletionDialog instanceVariableNames: 'textMorph text listMorph listValues listLabels listIndex answer' classVariableNames: '' poolDictionaries: '' category: 'OB-Polymorph-Morph'! !OBCompletionDialog class methodsFor: 'instance creation' stamp: 'lr 9/22/2010 20:21'! on: aRequest ^ self basicNew initializeOn: aRequest! ! !OBCompletionDialog class methodsFor: 'instance creation' stamp: 'lr 9/22/2010 13:31'! openOn: aRequest ^ UITheme builder openModal: (self on: aRequest)! ! !OBCompletionDialog methodsFor: 'accessing' stamp: 'lr 9/23/2010 07:50'! answer "Answer the result of the dialog or nil, if this dialog has been cancelled." ^ answer! ! !OBCompletionDialog methodsFor: 'callbacks' stamp: 'lr 9/22/2010 13:37'! arrowKey: anEvent from: aMorph "Ignore this request."! ! !OBCompletionDialog methodsFor: 'actions' stamp: 'lr 9/22/2010 20:30'! cancel answer := nil. ^ super cancel! ! !OBCompletionDialog methodsFor: 'callbacks' stamp: 'lr 9/22/2010 11:47'! clickIconAt: anInteger "Ignore this request."! ! !OBCompletionDialog methodsFor: 'morphic' stamp: 'lr 9/22/2010 20:09'! defaultFocusMorph ^ textMorph! ! !OBCompletionDialog methodsFor: 'callbacks' stamp: 'lr 9/22/2010 13:22'! doubleClick self ok! ! !OBCompletionDialog methodsFor: 'callbacks' stamp: 'lr 3/6/2011 15:50'! editorKeyStroke: anEvent anEvent keyCharacter = Character arrowDown ifTrue: [ self listIndex: (self listIndex + 1 min: listValues size). ^ true ]. anEvent keyCharacter = Character arrowUp ifTrue: [ self listIndex: (self listIndex - 1 max: 1). ^ true ]. ^ false! ! !OBCompletionDialog methodsFor: 'callbacks' stamp: 'lr 9/22/2010 20:28'! iconAt: anIndex ^ model iconFor: (listValues at: anIndex ifAbsent: [ ^ nil ])! ! !OBCompletionDialog methodsFor: 'initialization' stamp: 'lr 9/22/2010 20:59'! initializeOn: aRequest model := aRequest. listValues := listLabels := #(). listIndex := 0. self initialize. self title: aRequest prompt. self text: aRequest default ! ! !OBCompletionDialog methodsFor: 'testing' stamp: 'lr 9/22/2010 21:32'! isAssisted ^ self model assisted! ! !OBCompletionDialog methodsFor: 'testing' stamp: 'lr 9/22/2010 21:32'! isEnabled ^ self model assisted ifTrue: [ self text isEmptyOrNil not ] ifFalse: [ self listIndex > 0 ]! ! !OBCompletionDialog methodsFor: 'accessing-list' stamp: 'lr 9/22/2010 11:45'! listIndex ^ listIndex! ! !OBCompletionDialog methodsFor: 'accessing-list' stamp: 'lr 9/25/2010 21:15'! listIndex: anInteger listIndex = anInteger ifTrue: [ ^ self ]. listIndex := anInteger. self listSelection ifNotNil: [ :selection | self isAssisted ifTrue: [ text := self model labelFor: self listSelection. self changed: #text ] ]. self changed: #listIndex; changed: #isEnabled! ! !OBCompletionDialog methodsFor: 'accessing-list' stamp: 'lr 9/22/2010 11:43'! listLabels ^ listLabels! ! !OBCompletionDialog methodsFor: 'accessing-list' stamp: 'lr 9/22/2010 11:46'! listSelection ^ listValues at: self listIndex ifAbsent: [ nil ]! ! !OBCompletionDialog methodsFor: 'accessing-list' stamp: 'lr 9/22/2010 11:47'! listSelection: anObject self listIndex: (listValues indexOf: anObject ifAbsent: [ 0 ])! ! !OBCompletionDialog methodsFor: 'accessing-list' stamp: 'lr 9/22/2010 11:44'! listValues ^ listValues! ! !OBCompletionDialog methodsFor: 'accessing-list' stamp: 'lr 9/22/2010 20:06'! listValues: aCollection | previous | previous := self listSelection. listValues := aCollection asArray. listLabels := listValues collect: [ :each | model labelFor: each ]. self changed: #listLabels; listSelection: previous! ! !OBCompletionDialog methodsFor: 'morphic' stamp: 'lr 3/6/2011 15:54'! newContentMorph ^ (self newColumn: (Array with: self newTextMorph with: self newListMorph)) minWidth: 320; minHeight: 200; yourself! ! !OBCompletionDialog methodsFor: 'morphic' stamp: 'lr 9/23/2010 08:01'! newListMorph listMorph := OBPluggableListMorph on: self list: #listLabels selected: #listIndex changeSelected: #listIndex:. listMorph borderStyle: (self theme listNormalBorderStyleFor: listMorph); color: (self theme listNormalFillStyleFor: listMorph); cornerStyle: self preferredCornerStyle; doubleClickSelector: #doubleClick; hResizing: #spaceFill; vResizing: #spaceFill; autoDeselect: false. ^ listMorph! ! !OBCompletionDialog methodsFor: 'morphic' stamp: 'lr 3/6/2011 15:55'! newOKButton ^ super newOKButton getEnabledSelector: #isEnabled; isDefault: true; yourself! ! !OBCompletionDialog methodsFor: 'morphic' stamp: 'lr 3/6/2011 15:53'! newTextMorph textMorph := self newTextEntryFor: self getText: #text setText: #text: help: nil. textMorph acceptOnCR: false; autoAccept: true; selectAll. textMorph textMorph on: #keyStroke send: #editorKeyStroke: to: self. ^ textMorph! ! !OBCompletionDialog methodsFor: 'actions' stamp: 'lr 9/22/2010 20:31'! ok answer := self model assisted ifTrue: [ self text ] ifFalse: [ self listSelection ]. ^ super ok! ! !OBCompletionDialog methodsFor: 'accessing-text' stamp: 'lr 9/22/2010 20:27'! text ^ text! ! !OBCompletionDialog methodsFor: 'accessing-text' stamp: 'lr 9/24/2010 21:44'! text: aString text = aString ifTrue: [ ^ self ]. text := aString. self listValues: (self model valuesFor: text). self isAssisted ifFalse: [ self listIndex: (self listLabels size = 1 ifTrue: [ 1 ] ifFalse: [ self listLabels findFirst: [ :each | each sameAs: text ] ]) ]. self changed: #text; changed: #isEnabled! ! !OBPanel methodsFor: '*ob-polymorph-building' stamp: 'lr 12/3/2011 13:35'! verticalHeightFor: aBuilder ^ aBuilder buttonHeight! ! RectangleMorph subclass: #OBPaneScroller instanceVariableNames: 'model sizing panes transform scrollBar' classVariableNames: '' poolDictionaries: '' category: 'OB-Polymorph-Morph'! OBPaneScroller class instanceVariableNames: 'animationDuration'! !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 instanceVariableNames: 'animationDuration'! !OBPaneScroller class methodsFor: 'settings' stamp: 'lr 3/13/2010 19:54'! animationDuration ^ animationDuration! ! !OBPaneScroller class methodsFor: 'settings' stamp: 'lr 3/13/2010 19:56'! animationDuration: anInteger "The duration of the scroll animation in milliseconds." animationDuration := anInteger! ! !OBPaneScroller class methodsFor: 'initialization' stamp: 'lr 3/13/2010 19:58'! initialize animationDuration := 200! ! !OBPaneScroller class methodsFor: 'instance creation' stamp: 'lr 12/3/2011 12:16'! on: aModel ^ self new model: aModel! ! !OBPaneScroller methodsFor: 'panes' stamp: 'lr 12/4/2011 19:34'! addMorph: aMorph fullFrame: aFrame aMorph adoptPaneColor: self paneColor; hResizing: #rigid; vResizing: #rigid; borderWidth: 0; layoutInset: 0. transform hasSubmorphs ifTrue: [ transform addMorphBack: self separator ]. transform addMorphBack: aMorph. panes addLast: aMorph ! ! !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: 'lr 12/3/2011 17:58'! basicUpdatePanes | builder | self clearPanes. builder := OBInterface default builder. builder inMorph: self inFrame: builder fullFrame do: [ model columns do: [ :each | builder visit: each ] ]! ! !OBPaneScroller methodsFor: 'private' stamp: 'lr 3/21/2009 20:04'! basicUpdateSizing sizing := model isNil ifTrue: [ 1 ] ifFalse: [ model sizing ]! ! !OBPaneScroller methodsFor: 'layout' stamp: 'lr 4/29/2011 23:41'! bounds: aRectangle super bounds: aRectangle. self layoutWidgets. self layoutPanes. self hideOrShowScrollBar. self setScrollDeltas. ! ! !OBPaneScroller methodsFor: 'panes' stamp: 'lr 12/3/2011 17:19'! clearPanes transform removeAllMorphs. panes := OrderedCollection new! ! !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: '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: 'lr 12/3/2011 18:14'! initialize super initialize. self borderWidth: 0; color: Color transparent; vResizing: #spaceFill; hResizing: #spaceFill. self initializeTransform; initializeScrollbar.! ! !OBPaneScroller methodsFor: 'initialization' stamp: 'lr 4/29/2011 23:23'! initializeScrollbar scrollBar := ScrollBar new model: self slotName: 'scrollBar'. scrollBar borderWidth: 1; borderColor: Color black; 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: 'lr 4/29/2011 23:25'! innerBounds | rect | rect := super innerBounds. ^ self scrollBarIsVisible ifTrue: [ rect withHeight: rect height - self scrollBarHeight + 1 ] ifFalse: [ rect ]! ! !OBPaneScroller methodsFor: 'scrolling' stamp: 'lr 4/29/2011 23:34'! 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: 'lr 4/29/2011 23:24'! layoutWidgets | inner outer | outer := super innerBounds. inner := self innerBounds. transform bounds: inner. scrollBar bounds: (inner bottomLeft corner: outer bottomRight)! ! !OBPaneScroller methodsFor: 'scrolling' stamp: 'lr 4/29/2011 23:36'! leftoverScrollRange ^ (self totalScrollRange - self innerBounds width) truncated 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: '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: 'layout' stamp: 'lr 4/29/2011 23:26'! resizeScrollBar | inner outer | outer := super innerBounds. inner := outer withHeight: outer height - self scrollBarHeight + 1. scrollBar bounds: (inner bottomLeft corner: outer bottomRight)! ! !OBPaneScroller methodsFor: 'layout' stamp: 'lr 4/29/2011 23:11'! scrollBarHeight ^ UITheme current settings scrollBarThickness! ! !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: 'input events' stamp: 'lr 5/29/2010 08:11'! 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 3/13/2010 19:59'! scrollToRight scrollBar animateValue: 1.0 duration: self class animationDuration! ! !OBPaneScroller methodsFor: 'panes' stamp: 'lr 12/4/2011 19:33'! separator ^ BorderedSubpaneDividerMorph vertical adoptPaneColor: self paneColor; yourself! ! !OBPaneScroller methodsFor: 'defaults' stamp: 'lr 11/15/2011 07:17'! separatorWidth ^ 3! ! !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: 'lr 11/19/2011 18:18'! update: aSymbol aSymbol = #sizing ifTrue: [^ self updateSizing]. aSymbol = #widgets 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! ! !OBNode methodsFor: '*ob-polymorph' stamp: 'cwp 3/2/2004 21:28'! acceptDroppedNode: aNode ^ aNode perform: self dropSelector with: self ! ! !OBNode methodsFor: '*ob-polymorph' stamp: 'avi 2/20/2004 14:00'! asDraggableMorph ^(StringMorph contents: self name) color: Color white; yourself! ! !OBNode methodsFor: '*ob-polymorph' stamp: 'cwp 3/2/2004 21:29'! dropSelector "Override in subclasses" ^ #dropOnNode: ! ! !OBNode methodsFor: '*ob-polymorph' stamp: 'cwp 3/2/2004 21:28'! wantsDroppedNode: aNode ^ aNode respondsTo: self dropSelector! ! OBVisitor subclass: #OBPolymorphBuilder instanceVariableNames: 'currentMorph currentFrame' classVariableNames: '' poolDictionaries: '' category: 'OB-Polymorph-Core'! !OBPolymorphBuilder methodsFor: 'morphic' stamp: 'lr 12/3/2011 16:37'! append: aMorph "Adds aMorph to the currentMorph with the current frame if possible." currentFrame isNil ifFalse: [ currentMorph addMorph: aMorph fullFrame: currentFrame ] ifTrue: [ aMorph vResizing: #spaceFill; hResizing: #spaceFill. currentMorph addMorphBack: aMorph ]! ! !OBPolymorphBuilder methodsFor: 'themeing' stamp: 'lr 12/3/2011 17:00'! buttonHeight ^ self theme buttonMinHeight! ! !OBPolymorphBuilder methodsFor: 'themeing' stamp: 'lr 12/3/2011 10:02'! fullFrame ^ LayoutFrame new leftFraction: 0 offset: 0; topFraction: 0 offset: 0; rightFraction: 1 offset: 0; bottomFraction: 1 offset: 0; yourself! ! !OBPolymorphBuilder methodsFor: 'morphic' stamp: 'lr 12/3/2011 10:16'! inFrame: aFrame do: aBlock "Set the current frame to aFrame while evaluating aBlock." | previous result | previous := currentFrame. currentFrame := aFrame. result := aBlock value. currentFrame := previous. ^ result! ! !OBPolymorphBuilder methodsFor: 'morphic' stamp: 'lr 12/3/2011 10:17'! inMorph: aMorph do: aBlock "Set the current morph to aMorph while evaluating aBlock." | previous result | previous := currentMorph. currentMorph := aMorph. result := aBlock value. currentMorph := previous. ^ result! ! !OBPolymorphBuilder methodsFor: 'morphic' stamp: 'lr 12/3/2011 10:05'! inMorph: aMorph inFrame: aFrame do: aBlock "Set the current morph to aMorph and the current frame to aFrame while evaluating aBlock." ^ self inMorph: aMorph do: [ self inFrame: aFrame do: aBlock ]! ! !OBPolymorphBuilder methodsFor: 'creational' stamp: 'lr 12/3/2011 09:48'! newPanel ^ PanelMorph new! ! !OBPolymorphBuilder methodsFor: 'creational' stamp: 'lr 11/17/2011 23:38'! newPanelFor: aModel listen: aSelector ^ OBPluggablePanelMorph new model: aModel; listen: aSelector; yourself! ! !OBPolymorphBuilder methodsFor: 'themeing' stamp: 'lr 12/3/2011 17:00'! separatorSize ^ 4! ! !OBPolymorphBuilder methodsFor: 'themeing' stamp: 'lr 11/19/2011 18:36'! theme ^ UITheme current! ! !OBPolymorphBuilder methodsFor: 'visiting' stamp: 'lr 12/3/2011 17:53'! visitAnnotationPanel: aPanel | morph | morph := PluggableTextFieldMorph new on: aPanel text: #text accept: #accept:notifying: readSelection: #selection menu: #menu:shifted:; alwaysAccept: true; acceptOnCR: true; font: self theme textFont; cornerStyle: (self theme textEntryCornerStyleIn: currentMorph); borderStyle: (BorderStyle inset width: 1); color: Color white; selectionColor: self theme selectionColor; hideScrollBarsIndefinitely; enabled: false. morph textMorph autoFit: true; wrapFlag: false; margins: (2@1 corner: 2@1). self append: morph! ! !OBPolymorphBuilder methodsFor: 'visiting' stamp: 'lr 12/3/2011 17:04'! visitBrowser: aBrowser | morph variable fraction offset | morph := OBSystemWindow new model: aBrowser; title: aBrowser labelString; yourself. variable := aBrowser panels count: [ :each | each isVerticallyElastic ]. fraction := offset := 0. self inMorph: morph do: [ aBrowser panels do: [ :each | | frame | frame := LayoutFrame new. frame leftFraction: 0 offset: 0. frame rightFraction: 1 offset: 0. frame topFraction: fraction offset: offset. each isVerticallyElastic ifFalse: [ offset := offset + self buttonHeight + self separatorSize ] ifTrue: [ fraction := fraction + (1 / variable). offset := 0 ]. frame bottomFraction: fraction offset: offset. self inFrame: frame do: [ self visit: each ] ] ]. ^ morph! ! !OBPolymorphBuilder methodsFor: 'visiting' stamp: 'lr 12/3/2011 10:58'! visitButton: aButton self append: ((OBPluggableButtonMorph on: aButton getState: #isPressed action: #execute label: #label) getEnabledSelector: #isEnabled; getColorSelector: #color; yourself)! ! !OBPolymorphBuilder methodsFor: 'visiting' stamp: 'lr 12/3/2011 19:35'! visitButtonBar: aButtonBar | morph | morph := self newPanelFor: aButtonBar listen: #widgets. morph changeTableLayout; layoutInset: 0 @ 1; rubberBandCells: false; listDirection: #leftToRight; children: [ aButtonBar buttons do: [ :each | self inMorph: morph inFrame: nil do: [ self visit: each ] ] ]. self append: morph! ! !OBPolymorphBuilder methodsFor: 'visiting' stamp: 'lr 12/3/2011 12:27'! visitColumn: aColumn | morph | morph := self newPanelFor: aColumn listen: #widgets. morph layoutPolicy: ProportionalLayout new. morph children: [ self inMorph: morph inFrame: self fullFrame do: [ self visit: aColumn list. self visit: aColumn switch ] ]. self append: morph! ! !OBPolymorphBuilder methodsFor: 'visiting' stamp: 'lr 12/3/2011 12:17'! visitColumnPanel: aPanel | fraction fractionStep offset offsetStep | aPanel minPanes = aPanel maxPanes ifFalse: [ ^ self append: (OBPaneScroller on: aPanel) ]. fraction := currentFrame leftFraction. offset := currentFrame leftOffset. fractionStep := currentFrame rightFraction - fraction / aPanel maxPanes. offsetStep := currentFrame rightOffset - offset / aPanel maxPanes. (aPanel columns last: aPanel maxPanes) do: [ :each | | frame | frame := LayoutFrame new. frame topFraction: currentFrame topFraction offset: currentFrame topOffset; bottomFraction: currentFrame bottomFraction offset: currentFrame bottomOffset; leftFraction: fraction offset: offset. fraction := fraction + fractionStep. offset := offset + offsetStep. frame rightFraction: fraction offset: offset. self inFrame: frame do: [ self visit: each ] ]! ! !OBPolymorphBuilder methodsFor: 'visiting' stamp: 'lr 12/3/2011 19:47'! visitDefinitionPanel: aPanel | morph | morph := OBPluggableTextMorph new on: aPanel text: #text accept: #accept:notifying: readSelection: #selection menu: #menu:shifted:selection:; color: Color white; font: StandardFonts codeFont; borderStyle: (BorderStyle inset width: 1); cornerStyle: (self theme textEntryCornerStyleIn: currentMorph); selectionColor: self theme selectionColor; yourself. self append: morph! ! !OBPolymorphBuilder methodsFor: 'visiting' stamp: 'lr 12/3/2011 13:47'! visitFixedButtonPanel: aPanel | morph | morph := self newPanel. self inMorph: morph inFrame: nil do: [ aPanel buttons do: [ :each | self visit: each ] ]. self append: (OverflowRowMorph new baseMorph: morph; yourself) . ! ! !OBPolymorphBuilder methodsFor: 'visiting' stamp: 'lr 12/9/2011 07:29'! visitList: aList | morph | morph := OBPluggableListMorph on: aList list: #list selected: #selection changeSelected: #selection: menu: #menu: keystroke: #keystroke:. morph getListElementSelector: #listAt:; getListSizeSelector: #listSize; doubleClickSelector: #doubleClick; showHScrollBarOnlyWhenNeeded: true; autoDeselect: false; dragEnabled: true; dropEnabled: true; color: Color white; borderWidth: 0. self append: morph! ! !OBPolymorphBuilder methodsFor: 'visiting' stamp: 'lr 12/3/2011 17:52'! visitMercuryPanel: aPanel | morph | morph := PluggableTextFieldMorph new on: aPanel text: #text accept: #accept:notifying: readSelection: #selection menu: #menu:shifted:; alwaysAccept: true; acceptOnCR: true; font: self theme textFont; cornerStyle: (self theme textEntryCornerStyleIn: currentMorph); borderStyle: (BorderStyle inset width: 1); color: Color white; selectionColor: self theme selectionColor; hideScrollBarsIndefinitely. morph textMorph autoFit: true; wrapFlag: false; margins: (2@1 corner: 2@1). self append: morph! ! !OBPolymorphBuilder methodsFor: 'visiting' stamp: 'lr 12/3/2011 19:38'! visitSwitch: aSwitch | offset | aSwitch isActive ifFalse: [ ^ self ]. "First update the list frame to make room for the switch:" offset := 0 - self buttonHeight - self separatorSize. currentFrame bottomOffset: offset. "Now build the buttons in the resulting empty space:" self inFrame: (self fullFrame topFraction: 1 offset: offset) do: [ self visit: aSwitch bar ]! ! !OBBrowser class methodsFor: '*ob-polymorph' stamp: 'lr 9/23/2010 08:09'! taskbarIcon ^ UITheme current smallSystemBrowserIcon! ! OBInterface subclass: #OBPolymorphInterface instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Polymorph-Core'! !OBPolymorphInterface class methodsFor: 'class initialization' stamp: 'lr 11/14/2011 21:03'! initialize OBInterface default: self new! ! !OBPolymorphInterface methodsFor: 'building' stamp: 'lr 11/23/2011 21:41'! builder ^ OBPolymorphBuilder new! ! !OBPolymorphInterface methodsFor: 'interaction' stamp: 'lr 11/17/2011 21:51'! handleBrowseRequest: aRequest (self builder visit: aRequest browser) openInWorld. ^ aRequest browser! ! !OBPolymorphInterface methodsFor: 'interaction' stamp: 'lr 11/16/2011 20:34'! handleChoiceRequest: aRequest ^ UIManager default chooseFrom: aRequest labels values: aRequest values lines: aRequest lines title: (aRequest prompt ifNil: [ String new ])! ! !OBPolymorphInterface methodsFor: 'interaction' stamp: 'lr 11/16/2011 20:42'! handleCloseRequest: aRequest aRequest browser changed: #close! ! !OBPolymorphInterface methodsFor: 'interaction' stamp: 'lr 9/22/2010 20:30'! handleCompletionRequest: aReqest ^ (OBCompletionDialog openOn: aReqest) answer! ! !OBPolymorphInterface methodsFor: 'interaction' stamp: 'lr 11/16/2011 20:34'! handleConfirmationRequest: aRequest | choice | choice := UIManager default confirm: aRequest prompt trueChoice: aRequest okChoice falseChoice: aRequest cancelChoice. ^ choice ifNil: [ false ] ifNotNil: [ choice ]! ! !OBPolymorphInterface methodsFor: 'interaction' stamp: 'lr 11/16/2011 20:35'! handleInformRequest: aRequest ^ UIManager default inform: aRequest message! ! !OBPolymorphInterface methodsFor: 'interaction' stamp: 'lr 11/16/2011 20:35'! handleMultiLineTextRequest: aRequest ^ UIManager default multiLineRequest: aRequest prompt centerAt: Sensor cursorPoint initialAnswer: aRequest template answerHeight: 200! ! !OBPolymorphInterface 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! ! !OBPolymorphInterface methodsFor: 'interaction' stamp: 'lr 11/16/2011 20:35'! handleTextRequest: aRequest | text | text := UIManager default request: aRequest prompt initialAnswer: aRequest template. ^ (text isNil or: [ text isEmpty ]) ifFalse: [ text ]! ! !OBPolymorphInterface methodsFor: 'interaction' stamp: 'lr 5/14/2008 15:42'! handleWaitRequest: request ^ Cursor wait showWhile: request block! ! !OBFixedButtonPanel methodsFor: '*ob-polymorph-building' stamp: 'lr 12/3/2011 13:36'! verticalHeightFor: aBuilder ^ aBuilder buttonHeight + 5! ! !OBSwitch methodsFor: '*ob-polymorph-dragging' stamp: 'lr 5/28/2010 18:08'! acceptDroppingMorph: aTransferMorph event: anEvent inMorph: aButtonMorph ^ column drop: aTransferMorph passenger on: (self nodeForMorph: aButtonMorph)! ! !OBSwitch methodsFor: '*ob-polymorph-dragging' stamp: 'lr 5/28/2010 19:31'! nodeForMorph: aButtonMorph | edge nodes | edge := filter metaNode edges at: (aButtonMorph owner submorphs indexOf: aButtonMorph ifAbsent: [ ^ nil ]) ifAbsent: [ ^ nil ]. nodes := column metaNode filters inject: (edge nodesForParent: column parent) into: [ :result :each | each nodesFrom: result forNode: column parent ]. ^ nodes at: column selection ifAbsent: [ ^ nil ]! ! !OBSwitch methodsFor: '*ob-polymorph-dragging' stamp: 'lr 11/19/2011 18:44'! wantsDroppedMorph: aTransferMorph event: anEvent inMorph: aButtonMorph (aTransferMorph isKindOf: TransferMorph) ifFalse: [ ^ false ]. aTransferMorph dragTransferType = column dragTransferType ifFalse: [ ^ false ]. ^ column canDrop: aTransferMorph passenger on: (self nodeForMorph: aButtonMorph)! ! LazyListMorph subclass: #OBLazyListMorph instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Polymorph-Morph'! !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 12/23/2009 15:22'! 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) ifNotNil: [ :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 string in: drawBounds font: (font emphasized: (item emphasisAt: 1)) color: (item colorAt: 1) ] ifFalse: [ canvas drawString: item in: drawBounds font: font color: (self colorForRow: row) ]! ! TextMorphForEditView subclass: #OBTextMorph instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Polymorph-Morph'! !OBTextMorph methodsFor: 'callbacks' stamp: 'lr 12/4/2011 13:27'! keyStroke: anEvent (anEvent anyModifierKeyPressed and: [ self editView model keystroke: anEvent asKeystroke selection: self editView selectionInterval in: self editView ]) ifFalse: [ super keyStroke: anEvent ]! ! !ScrollBar methodsFor: '*ob-polymorph' stamp: 'lr 7/29/2011 09:16'! animateValue: aNumber duration: anInteger anInteger <= 0 ifTrue: [ self setValue: aNumber ] ifFalse: [ | start startTime | start := value roundTo: scrollDelta. startTime := Time millisecondClockValue. [ | delta | [ (delta := Time millisecondsSince: startTime) < anInteger ] whileTrue: [ self setValue: (aNumber - start) * (delta / anInteger) + start. Processor yield ]. self setValue: aNumber ] fork ]! ! !Text methodsFor: '*ob-polymorph' stamp: 'lr 12/23/2009 15:18'! colorAt: characterIndex | textColor | textColor := (self attributesAt: characterIndex) detect: [ :attribute | attribute isMemberOf: TextColor ] ifNone: [ TextColor black ]. ^ textColor color! ! StandardWindow subclass: #OBSystemWindow instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Polymorph-Morph'! PluggableButtonMorph subclass: #OBPluggableButtonMorph instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Polymorph-Morph'! !OBPluggableButtonMorph methodsFor: 'drag and drop' stamp: 'lr 11/19/2011 18:45'! acceptDroppingMorph: aMorph event: anEvent self halt. ^ owner model acceptDroppingMorph: aMorph event: anEvent inMorph: self! ! !OBPluggableButtonMorph methodsFor: 'drag and drop' stamp: 'lr 11/19/2011 18:45'! dropEnabled ^ true! ! !OBPluggableButtonMorph methodsFor: 'drag and drop' stamp: 'lr 11/19/2011 18:46'! wantsDroppedMorph: aMorph event: anEvent self halt. ^ owner model wantsDroppedMorph: aMorph event: anEvent inMorph: self! ! PanelMorph subclass: #OBPluggablePanelMorph instanceVariableNames: 'model listen children' classVariableNames: '' poolDictionaries: '' category: 'OB-Polymorph-Morph'! !OBPluggablePanelMorph methodsFor: 'accessing' stamp: 'lr 11/17/2011 23:49'! children: aValuable children := aValuable. self refresh! ! !OBPluggablePanelMorph methodsFor: 'accessing' stamp: 'lr 11/17/2011 19:56'! listen: aSelector "If set, listen to change events of aSelector. Otherwise conservatively rebuild the panel whenever an change event is triggered." listen := aSelector! ! !OBPluggablePanelMorph methodsFor: 'accessing' stamp: 'lr 11/17/2011 19:35'! model: aModel model isNil ifFalse: [ model removeDependent: self ]. model := aModel. model isNil ifFalse: [ model addDependent: self ]! ! !OBPluggablePanelMorph methodsFor: 'private' stamp: 'lr 11/17/2011 23:51'! newSubmorphs "Answer the submorphs ready to be added to the receiver." children isNil ifTrue: [ ^ #() ]. ^ children value collect: [ :each | each hResizing: #spaceFill; vResizing: #spaceFill; yourself ]! ! !OBPluggablePanelMorph methodsFor: 'updating' stamp: 'lr 12/3/2011 12:21'! refresh self removeAllMorphs. children cull: self! ! !OBPluggablePanelMorph methodsFor: 'updating' stamp: 'lr 11/17/2011 23:49'! update: aSymbol (aSymbol notNil and: [ listen isNil or: [ listen = aSymbol ] ]) ifTrue: [ self refresh ]! ! PluggableTextMorph subclass: #OBPluggableTextMorph instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Polymorph-Morph'! !OBPluggableTextMorph methodsFor: 'menu' stamp: 'lr 12/3/2011 19:55'! getMenu: shiftKeyState ^ model perform: getMenuSelector with: (UIManager default newMenuIn: self for: model) with: shiftKeyState with: selectionInterval! ! !OBPluggableTextMorph methodsFor: 'private' stamp: 'lr 12/3/2011 19:56'! textMorphClass ^ OBTextMorph! ! !MenuMorph methodsFor: '*ob-polymorph' stamp: 'lr 11/16/2011 19:37'! add: label target: anObject selector: aSelector enabled: aBoolean icon: aSymbol keystroke: aKeystroke self add: label target: anObject selector: aSelector. self lastItem isEnabled: aBoolean. anObject longDescription isNil ifFalse: [ self lastItem setBalloonText: anObject longDescription maxLineLength: 256 ]. OBPlatform current menuWithIcons ifTrue: [ self lastItem icon: (self iconNamed: aSymbol) ]. aKeystroke isNil ifFalse: [ self lastItem keyText: aKeystroke asKeystroke printString ] ! ! !MenuMorph methodsFor: '*ob-polymorph' stamp: 'lr 11/14/2011 23:01'! 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-polymorph' stamp: 'lr 11/14/2011 23:01'! iconNamed: aSymbol ^ OBMorphicIcons iconNamed: (aSymbol isNil ifTrue: [ #blankMenu ] ifFalse: [ aSymbol ]) ! ! !OBList methodsFor: '*ob-polymorph-dragging' stamp: 'lr 11/19/2011 17:41'! acceptDroppingMorph: transferMorph event: dragEvent inMorph: listMorph | target | target := self nodeForDropEvent: dragEvent inMorph: listMorph. ^ column drop: transferMorph passenger on: target! ! !OBList methodsFor: '*ob-polymorph-dragging' stamp: 'lr 11/19/2011 17:42'! dragPassengerFor: item inMorph: listMorph ^ self nodeForItem: item contents asString! ! !OBList methodsFor: '*ob-polymorph-dragging' stamp: 'lr 11/19/2011 17:42'! dragTransferType ^ #OmniBrowser! ! !OBList methodsFor: '*ob-polymorph-dragging' stamp: 'lr 11/19/2011 17:42'! dragTransferTypeForMorph: listMorph ^ self dragTransferType! ! !OBList methodsFor: '*ob-polymorph-dragging' stamp: 'lr 11/19/2011 17:42'! nodeForDropEvent: anEvent inMorph: aPluggableListMorph ^ self children at: (aPluggableListMorph rowAtLocation: anEvent position) ifAbsent: [ nil ]! ! !OBList methodsFor: '*ob-polymorph-dragging' stamp: 'lr 11/19/2011 17:42'! wantsDroppedMorph: transferMorph event: evt inMorph: listMorph | node passenger | (transferMorph isKindOf: TransferMorph) ifFalse: [ ^ false ]. transferMorph dragTransferType = self dragTransferType ifFalse: [ ^ false ]. node := self nodeForDropEvent: evt inMorph: listMorph. passenger := transferMorph passenger. ^ column canDrop: passenger on: node! ! Object subclass: #OBMorphicIcons instanceVariableNames: '' classVariableNames: 'Icons Instance' poolDictionaries: '' category: 'OB-Polymorph-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: 'accessing' stamp: 'lr 5/9/2011 18:48'! default ^ Instance ifNil: [ Instance := self new ]! ! !OBMorphicIcons class methodsFor: 'private' stamp: 'lr 5/9/2011 19:25'! findIcon: aSymbol (self canUnderstand: aSymbol) ifTrue: [ ^ self default perform: aSymbol ]. ^ UITheme current iconNamed: ('small' , aSymbol capitalized) asSymbol ifNone: [ UITheme current iconNamed: aSymbol ]! ! !OBMorphicIcons class methodsFor: 'accessing' stamp: 'lr 5/9/2011 18:47'! iconNamed: aSymbol ^ Icons at: aSymbol ifAbsentPut: [ self findIcon: aSymbol ]! ! !OBMorphicIcons class methodsFor: 'initialization' 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 5/9/2011 18:44'! blankMenu ^ Form extent: 16 @ 1 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) #( ) ))! ! OBPolymorphInterface initialize! OBPaneScroller initialize! OBMorphicIcons initialize!