'From Squeak3.3alpha of 30 January 2002 [latest update: #4798] on 23 March 2002 at 1:45:46 am'! "Change Set: ColorScrollBars-dew Date: 23 March 2002 Author: Doug Way - Changes the alternativeScrollbarLook so that the inboard scrollbar has the flat, non-rounded look of the original scrollbar, but it matches the window color. (The flop-out scrollbar is still rounded, since the rounded look looks better with the rounded arrows, and the sharper highlighting makes more sense when only one scrollbar appears on the screen at one time.) - Removes border around this new inboard scrollbar, which looks cleaner, and also saves space. - Improves the Color>>lighter/darker family to work consistently for lighter and darker shades of color. Basically, #lighter and #darker will now adjust by the same amount, no matter what shade you start from (similar to what #dansDarker attempted). This makes the #raised/inset bevelling of buttons/etc look a lot better. Also tweaks a few users of these methods in the system to adjust for the change. Mostly everything looks fine as is. (The new methods are actually about 10% slower than the old ones on micro benchmarks, but this doesn't seem to be enough to be noticeable in macro benchmarks or in normal use.) - Fixes keyboard focus highlighting so that the rectangle isn't hidden behind inboard scrollbars. (cleaned up ScrollPane>>innerBounds) - Permanently hides scrollbars in a few short panes, since they're not needed, and look ugly when inboard. These panes include the top pane of a hierarchy/filecontents browser, the pattern pane of the filelist, and the top pane of the methodfinder. - Makes the scrollbars fit correctly within the panes, without overlapping borders (when inboard). - Increases lightening and darkening of window titlebars when active/inactive, so the difference is more noticeable. - Moves alternativeWindowLook preference to windows category (instead of browsing), since it is window-related. - Fixes alternativeScrollbarLook scrollbar so that the thumb doesn't darken after you drag it the first time. - Includes a small fix since the March 14 version, so that translucent/transparent colors are handled correctly. "! !Browser methodsFor: 'initialize-release' stamp: 'dew 3/8/2002 00:05'! buildMorphicSwitches | instanceSwitch divider1 divider2 commentSwitch classSwitch row aColor | instanceSwitch _ PluggableButtonMorph on: self getState: #instanceMessagesIndicated action: #indicateInstanceMessages. instanceSwitch label: 'instance'; askBeforeChanging: true; borderWidth: 0. commentSwitch _ PluggableButtonMorph on: self getState: #classCommentIndicated action: #plusButtonHit. commentSwitch label: '?' asText allBold; askBeforeChanging: true; setBalloonText: 'class comment'; borderWidth: 0. classSwitch _ PluggableButtonMorph on: self getState: #classMessagesIndicated action: #indicateClassMessages. classSwitch label: 'class'; askBeforeChanging: true; borderWidth: 0. divider1 := BorderedSubpaneDividerMorph vertical. divider2 := BorderedSubpaneDividerMorph vertical. Preferences alternativeWindowLook ifTrue:[ divider1 extent: 4@4; borderWidth: 2; borderRaised; color: Color transparent. divider2 extent: 4@4; borderWidth: 2; borderRaised; color: Color transparent. ]. row _ AlignmentMorph newRow hResizing: #spaceFill; vResizing: #spaceFill; layoutInset: 0; borderWidth: 0; addMorphBack: instanceSwitch; addMorphBack: divider1; addMorphBack: commentSwitch; addMorphBack: divider2; addMorphBack: classSwitch. aColor _ Color colorFrom: self defaultBackgroundColor. row color: aColor duller. "ensure matching button divider color. (see #paneColor)" Preferences alternativeWindowLook ifTrue:[aColor _ aColor muchLighter]. {instanceSwitch. commentSwitch. classSwitch} do: [:m | m color: aColor; onColor: aColor twiceDarker offColor: aColor; hResizing: #spaceFill; vResizing: #spaceFill. ]. ^ row ! ! !Browser methodsFor: 'initialize-release' stamp: 'dew 1/7/2002 02:07'! openAsMorphSysCatEditing: editString "Create a pluggable version of all the views for a Browser, including views and controllers." | window hSepFrac switchHeight mySingletonList nextOffsets | window _ (SystemWindow labelled: 'later') model: self. hSepFrac _ 0.30. switchHeight _ 25. mySingletonList _ PluggableListMorph on: self list: #systemCategorySingleton selected: #indexIsOne changeSelected: #indexIsOne: menu: #systemCatSingletonMenu: keystroke: #systemCatSingletonKey:from:. mySingletonList enableDragNDrop: Preferences browseWithDragNDrop. mySingletonList hideScrollBarIndefinitely. window addMorph: mySingletonList fullFrame: ( LayoutFrame fractions: (0@0 corner: 1@0) offsets: (0@0 corner: 0@switchHeight) ). self addClassAndSwitchesTo: window at: (0@0 corner: 0.3333@hSepFrac) plus: switchHeight. nextOffsets _ 0@switchHeight corner: 0@0. window addMorph: self buildMorphicMessageCatList fullFrame: ( LayoutFrame fractions: (0.3333@0 corner: 0.6666@hSepFrac) offsets: nextOffsets ). window addMorph: self buildMorphicMessageList fullFrame: ( LayoutFrame fractions: (0.6666@0 corner: 1@hSepFrac) offsets: nextOffsets ). self addLowerPanesTo: window at: (0@hSepFrac corner: 1@1) with: editString. window setUpdatablePanesFrom: #( classList messageCategoryList messageList). ^ window! ! !Color methodsFor: 'transformations' stamp: 'dew 3/19/2002 23:50'! adjustBrightness: brightness "Adjust the relative brightness of this color. (lowest value is 0.005 so that hue information is not lost)" ^ Color h: self hue s: self saturation v: (self brightness + brightness min: 1.0 max: 0.005) alpha: self alpha! ! !Color methodsFor: 'transformations' stamp: 'dew 3/19/2002 23:51'! adjustSaturation: saturation brightness: brightness "Adjust the relative saturation and brightness of this color. (lowest value is 0.005 so that hue information is not lost)" ^ Color h: self hue s: (self saturation + saturation min: 1.0 max: 0.005) v: (self brightness + brightness min: 1.0 max: 0.005) alpha: self alpha! ! !Color methodsFor: 'transformations' stamp: 'dew 3/23/2002 01:38'! blacker ^ self alphaMixed: 0.8333 with: Color black ! ! !Color methodsFor: 'transformations' stamp: 'dew 3/19/2002 23:54'! dansDarker "Return a darker shade of the same color. An attempt to do better than the current darker method. (now obsolete, since darker has been changed to do this. -dew)" ^ Color h: self hue s: self saturation v: (self brightness - 0.16 max: 0.0)! ! !Color methodsFor: 'transformations' stamp: 'dew 3/4/2002 01:40'! darker "Answer a darker shade of this color." ^ self adjustBrightness: -0.08! ! !Color methodsFor: 'transformations' stamp: 'dew 3/8/2002 00:13'! duller ^ self adjustSaturation: -0.03 brightness: -0.2! ! !Color methodsFor: 'transformations' stamp: 'dew 1/23/2002 20:19'! lighter "Answer a lighter shade of this color." ^ self adjustSaturation: -0.03 brightness: 0.08! ! !Color methodsFor: 'transformations' stamp: 'dew 1/19/2002 01:29'! muchDarker ^ self alphaMixed: 0.5 with: Color black ! ! !Color methodsFor: 'transformations' stamp: 'dew 3/4/2002 01:42'! paler "Answer a paler shade of this color." ^ self adjustSaturation: -0.09 brightness: 0.09 ! ! !Color methodsFor: 'transformations' stamp: 'dew 3/4/2002 01:43'! slightlyDarker ^ self adjustBrightness: -0.03 ! ! !Color methodsFor: 'transformations' stamp: 'dew 3/4/2002 01:43'! slightlyLighter ^ self adjustSaturation: -0.01 brightness: 0.03! ! !Color methodsFor: 'transformations' stamp: 'dew 1/19/2002 01:25'! slightlyWhiter ^ self alphaMixed: 0.85 with: Color white ! ! !Color methodsFor: 'transformations' stamp: 'dew 3/4/2002 01:44'! twiceDarker "Answer a significantly darker shade of this color." ^ self adjustBrightness: -0.15! ! !Color methodsFor: 'transformations' stamp: 'dew 3/4/2002 01:45'! twiceLighter "Answer a significantly lighter shade of this color." ^ self adjustSaturation: -0.06 brightness: 0.15! ! !Color methodsFor: 'transformations' stamp: 'dew 3/23/2002 01:38'! whiter ^ self alphaMixed: 0.8333 with: Color white ! ! !Color class methodsFor: 'instance creation' stamp: 'dew 3/19/2002 23:49'! h: h s: s v: v alpha: alpha ^ (self h: h s: s v: v) alpha: alpha! ! !FileContentsBrowser methodsFor: 'creation' stamp: 'dew 1/7/2002 02:18'! openAsMorph "Create a pluggable version of all the views for a Browser, including views and controllers." | window aListExtent next mySingletonList | window _ (SystemWindow labelled: 'later') model: self. self packages size = 1 ifTrue: [ aListExtent _ 0.333333 @ 0.34. self systemCategoryListIndex: 1. mySingletonList _ PluggableListMorph on: self list: #systemCategorySingleton selected: #indexIsOne changeSelected: #indexIsOne: menu: #packageListMenu: keystroke: #packageListKey:from:. mySingletonList hideScrollBarIndefinitely. window addMorph: mySingletonList frame: (0@0 extent: 1.0@0.06). next := 0@0.06] ifFalse: [ aListExtent _ 0.25 @ 0.4. window addMorph: (PluggableListMorph on: self list: #systemCategoryList selected: #systemCategoryListIndex changeSelected: #systemCategoryListIndex: menu: #packageListMenu: keystroke: #packageListKey:from:) frame: (0@0 extent: aListExtent). next := aListExtent x @ 0]. self addClassAndSwitchesTo: window at: (next extent: aListExtent) plus: 0. next := next + (aListExtent x @ 0). window addMorph: (PluggableListMorph on: self list: #messageCategoryList selected: #messageCategoryListIndex changeSelected: #messageCategoryListIndex: menu: #messageCategoryMenu:) frame: (next extent: aListExtent). next := next + (aListExtent x @ 0). window addMorph: (PluggableListMorph on: self list: #messageList selected: #messageListIndex changeSelected: #messageListIndex: menu: #messageListMenu: keystroke: #messageListKey:from:) frame: (next extent: aListExtent). self addLowerPanesTo: window at: (0@0.4 corner: 1@1) with: nil. ^ window ! ! !FileList class methodsFor: 'instance creation' stamp: 'dew 1/7/2002 01:42'! addVolumesAndPatternPanesTo: window at: upperFraction plus: offset forFileList: aFileList | row patternHeight volumeListMorph patternMorph divider dividerDelta | row _ AlignmentMorph newColumn hResizing: #spaceFill; vResizing: #spaceFill; layoutInset: 0; borderWidth: 0; layoutPolicy: ProportionalLayout new. patternHeight _ 25. volumeListMorph _ (PluggableListMorph on: aFileList list: #volumeList selected: #volumeListIndex changeSelected: #volumeListIndex: menu: #volumeMenu:) autoDeselect: false. patternMorph _ PluggableTextMorph on: aFileList text: #pattern accept: #pattern:. patternMorph acceptOnCR: true. patternMorph hideScrollBarIndefinitely. divider _ BorderedSubpaneDividerMorph horizontal. dividerDelta _ 0. Preferences alternativeWindowLook ifTrue: [divider extent: 4 @ 4; color: Color transparent; borderColor: #raised; borderWidth: 2. volumeListMorph borderColor: Color transparent. patternMorph borderColor: Color transparent. dividerDelta _ 3]. row addMorph: (volumeListMorph autoDeselect: false) fullFrame: (LayoutFrame fractions: (0 @ 0 corner: 1 @ 1) offsets: (0 @ 0 corner: 0 @ patternHeight negated - dividerDelta)). row addMorph: divider fullFrame: (LayoutFrame fractions: (0 @ 1 corner: 1 @ 1) offsets: (0 @ patternHeight negated - dividerDelta corner: 0 @ patternHeight negated)). row addMorph: patternMorph fullFrame: (LayoutFrame fractions: (0 @ 1 corner: 1 @ 1) offsets: (0 @ patternHeight negated corner: 0 @ 0)). window addMorph: row fullFrame: (LayoutFrame fractions: upperFraction offsets: (0 @ offset corner: 0 @ 0)). Preferences alternativeWindowLook ifTrue: [row borderWidth: 2] ifFalse: [row borderWidth: 0]! ! !LedDigitMorph methodsFor: 'accessing' stamp: 'dew 1/16/2002 20:44'! drawOn: aCanvas | foregroundColor backgroundColor thickness hThickness vThickness hOffset vOffset | foregroundColor _ highlighted ifTrue: [Color white] ifFalse: [color]. backgroundColor _ color muchDarker. hThickness _ self height * 0.1. vThickness _ self width * 0.1. thickness _ hThickness min: vThickness. vOffset _ ((hThickness - thickness) // 2) max: 0. hOffset _ ((vThickness - thickness) // 2) max: 0. aCanvas fillRectangle: self bounds color: backgroundColor. "added to show the minus sign" (digit asString = '-') ifTrue: [digit _ 10]. HSegmentOrigins with: (HSegments at: digit+1) do: [:o :isLit | aCanvas fillRectangle: (Rectangle origin: (self position + (0@vOffset) + (o * self extent)) rounded extent: ((self width * 0.6) @ thickness) rounded) color: (isLit ifTrue: [foregroundColor] ifFalse: [backgroundColor])]. VSegmentOrigins with: (VSegments at: digit+1) do: [:o :isLit | aCanvas fillRectangle: (Rectangle origin: (self position + (hOffset@0) + (o * self extent)) rounded extent: (thickness @ (self height * 0.25)) rounded) color: (isLit ifTrue: [foregroundColor] ifFalse: [backgroundColor])]. ! ! !MenuMorph methodsFor: 'initialization' stamp: 'dew 2/11/2001 01:34'! setDefaultParameters | worldColor | ((Preferences menuColorFromWorld and: [Display depth > 4]) and: [(worldColor _ self currentWorld color) isColor]) ifTrue: [self setColor: (worldColor luminance > 0.7 ifTrue: [worldColor mixed: 0.85 with: Color black] ifFalse: [worldColor mixed: 0.4 with: Color white]) "Think about whether alpha should be included." borderWidth: Preferences menuBorderWidth borderColor: #raised] ifFalse: [self setColor: Preferences menuColor borderWidth: Preferences menuBorderWidth borderColor: Preferences menuBorderColor]. self layoutInset: 3.! ! !Preferences class methodsFor: 'text highlighting' stamp: 'dew 1/8/2002 01:07'! keyboardFocusColor "Answer the keyboard focus color, initializing it if necessary" ^ Parameters at: #keyboardFocusColor ifAbsentPut: [Color lightGray] " Parameters removeKey: #keyboardFocusColor. Preferences keyboardFocusColor "! ! !ScrollPane methodsFor: 'access' stamp: 'dew 3/23/2002 01:20'! flatColoredScrollBarLook "Currently only show the flat (not rounded) + colored-to-match-window scrollbar look when inboard." ^ Preferences alternativeScrollbarLook and: [retractableScrollBar not or: [ScrollBar alwaysShowFlatScrollbarForAlternativeLook]] ! ! !ScrollPane methodsFor: 'geometry' stamp: 'dew 1/19/2002 13:56'! innerBounds | inner | inner _ super innerBounds. retractableScrollBar | (submorphs includes: scrollBar) not ifTrue: [^ inner] ifFalse: [^ (scrollBarOnLeft ifTrue: [scrollBar right @ inner top corner: inner bottomRight] ifFalse: [inner topLeft corner: scrollBar left @ inner bottom])]! ! !ScrollPane methodsFor: 'geometry' stamp: 'dew 3/4/2002 00:40'! resizeScrollBar | w topLeft borderHeight innerWidth | w _ self scrollbarWidth. self flatColoredScrollBarLook ifTrue: [borderHeight _ borderWidth. innerWidth _ 0] ifFalse: [borderHeight _ 0. innerWidth _ 1]. topLeft _ scrollBarOnLeft ifTrue: [retractableScrollBar ifTrue: [bounds topLeft - (w-borderWidth@(0-borderHeight))] ifFalse: [bounds topLeft + (borderWidth-innerWidth@borderHeight)]] ifFalse: [retractableScrollBar ifTrue: [bounds topRight - (borderWidth@(0-borderHeight))] ifFalse: [bounds topRight - (w+borderWidth-innerWidth@(0-borderHeight))]]. scrollBar bounds: (topLeft extent: w @ (bounds height - (borderHeight * 2)))! ! !ScrollPane methodsFor: 'geometry' stamp: 'dew 3/4/2002 01:22'! scrollbarWidth "Includes border" self flatColoredScrollBarLook ifTrue: [(Preferences scrollBarsNarrow) ifTrue: [^ 10] ifFalse: [^ 14]] ifFalse: [(Preferences scrollBarsNarrow) ifTrue: [^ 12] ifFalse: [^ 16]] ! ! !SelectorBrowser methodsFor: 'as yet unclassified' stamp: 'dew 1/7/2002 01:49'! morphicWindow "Create a Browser that lets you type part of a selector, shows a list of selectors, shows the classes of the one you chose, and spawns a full browser on it. Answer the window SelectorBrowser new open " | window typeInView selectorListView classListView | window _ (SystemWindow labelled: 'later') model: self. window setStripeColorsFrom: self defaultBackgroundColor. selectorIndex _ classListIndex _ 0. typeInView _ PluggableTextMorph on: self text: #contents accept: #contents:notifying: readSelection: #contentsSelection menu: #codePaneMenu:shifted:. typeInView acceptOnCR: true. typeInView hideScrollBarIndefinitely. window addMorph: typeInView frame: (0@0 corner: 0.5@0.14). selectorListView _ PluggableListMorph on: self list: #messageList selected: #messageListIndex changeSelected: #messageListIndex: menu: #selectorMenu: keystroke: #messageListKey:from:. selectorListView menuTitleSelector: #selectorMenuTitle. window addMorph: selectorListView frame: (0@0.14 corner: 0.5@0.6). classListView _ PluggableListMorph on: self list: #classList selected: #classListIndex changeSelected: #classListIndex: menu: nil keystroke: #arrowKey:from:. classListView menuTitleSelector: #classListSelectorTitle. window addMorph: classListView frame: (0.5@0 corner: 1@0.6). window addMorph: ((PluggableTextMorph on: self text: #byExample accept: #byExample: readSelection: #contentsSelection menu: #codePaneMenu:shifted:) askBeforeDiscardingEdits: false) frame: (0@0.6 corner: 1@1). window setLabel: 'Method Finder'. ^ window! ! !SimpleHierarchicalListMorph methodsFor: 'drawing' stamp: 'dew 3/23/2002 01:36'! drawOn: aCanvas super drawOn: aCanvas. selectedMorph ifNotNil: [aCanvas fillRectangle: (((scroller transformFrom: self) invertBoundsRect: selectedMorph bounds) intersect: scroller bounds) color: color blacker]! ! !Slider methodsFor: 'initialize' stamp: 'dew 8/28/2001 11:49'! initialize super initialize. bounds := 0@0 corner: 16@100. color := Color lightGray. borderWidth := 1. borderColor := #inset. value _ 0.0. descending _ false. self initializeSlider! ! !Slider methodsFor: 'initialize' stamp: 'dew 1/19/2002 15:19'! initializeSlider slider := RectangleMorph newBounds: self totalSliderArea color: self thumbColor. sliderShadow := RectangleMorph newBounds: self totalSliderArea color: self pagingArea color. slider on: #mouseMove send: #scrollAbsolute: to: self. slider on: #mouseDown send: #mouseDownInSlider: to: self. slider on: #mouseUp send: #mouseUpInSlider: to: self. slider setBorderWidth: 1 borderColor: #raised. sliderShadow setBorderWidth: 1 borderColor: #inset. "(the shadow must have the pagingArea as its owner to highlight properly)" self pagingArea addMorph: sliderShadow. sliderShadow hide. self addMorph: slider. self computeSlider. ! ! !Slider methodsFor: 'access' stamp: 'dew 3/23/2002 01:38'! sliderColor "color scheme for the whole slider widget" sliderColor ifNil: [^ (color alphaMixed: 0.7 with: Color white) slightlyLighter]. ^ sliderColor! ! !Slider methodsFor: 'access' stamp: 'dew 3/4/2002 00:50'! sliderShadowColor ^ self sliderColor alphaMixed: 0.2 with: self pagingArea color! ! !Slider methodsFor: 'access' stamp: 'dew 1/21/2002 01:31'! thumbColor "Color of the draggable 'thumb'" ^ self sliderColor! ! !Slider methodsFor: 'other events' stamp: 'dew 3/4/2002 00:50'! mouseDownInSlider: event slider color: self thumbColor slightlyWhiter. sliderShadow color: self sliderShadowColor. sliderShadow cornerStyle: slider cornerStyle. sliderShadow bounds: slider bounds. sliderShadow show. ! ! !Slider methodsFor: 'other events' stamp: 'dew 1/15/2002 01:44'! mouseUpInSlider: event slider color: self thumbColor. sliderShadow hide.! ! !ScrollBar methodsFor: 'initialize' stamp: 'dew 3/4/2002 01:11'! initialize super initialize. scrollDelta _ 0.02. pageDelta _ 0.2. self roundedScrollbarLook ifTrue:[ self borderStyle: ((BorderStyle complexFramed width: 2) "baseColor: Color gray")].! ! !ScrollBar methodsFor: 'initialize' stamp: 'dew 3/4/2002 01:11'! initializeDownButton downButton := RectangleMorph newBounds: (self innerBounds bottomRight - self buttonExtent extent: self buttonExtent) color: self thumbColor. downButton on: #mouseDown send: #scrollDownInit to: self. downButton on: #mouseUp send: #finishedScrolling to: self. downButton addMorphCentered: (ImageMorph new image: (self cachedImageAt: (bounds isWide ifTrue: ['right'] ifFalse: ['down']) ifAbsentPut: [ self upArrow8Bit rotateBy: (bounds isWide ifTrue: [#right] ifFalse: [#pi]) centerAt: 0@0 ] ) ). self roundedScrollbarLook ifTrue:[ downButton color: Color veryLightGray. downButton borderStyle: (BorderStyle complexRaised width: 3). ] ifFalse:[ downButton setBorderWidth: 1 borderColor: #raised. ]. self addMorph: downButton. ! ! !ScrollBar methodsFor: 'initialize' stamp: 'dew 3/4/2002 01:13'! initializeEmbedded: aBool "aBool == true => inboard scrollbar aBool == false => flop-out scrollbar" self roundedScrollbarLook ifFalse:[^self]. aBool ifTrue:[ self borderStyle: (BorderStyle inset width: 2). self cornerStyle: #square. ] ifFalse:[ self borderStyle: (BorderStyle width: 1 color: Color black). self cornerStyle: #rounded. ]. self removeAllMorphs. self initializeSlider.! ! !ScrollBar methodsFor: 'initialize' stamp: 'dew 3/4/2002 01:13'! initializeMenuButton "Preferences disable: #scrollBarsWithoutMenuButton" "Preferences enable: #scrollBarsWithoutMenuButton" (Preferences valueOfFlag: #scrollBarsWithoutMenuButton) ifTrue: [^self]. self roundedScrollbarLook ifTrue:[ menuButton := RectangleMorph newBounds: ((bounds isWide ifTrue: [upButton bounds topRight] ifFalse: [upButton bounds bottomLeft]) extent: self buttonExtent) ] ifFalse:[ menuButton := RectangleMorph newBounds: (self innerBounds topLeft extent: self buttonExtent) color: self thumbColor. ]. menuButton on: #mouseEnter send: #menuButtonMouseEnter: to: self. menuButton on: #mouseDown send: #menuButtonMouseDown: to: self. menuButton on: #mouseLeave send: #menuButtonMouseLeave: to: self. menuButton addMorphCentered: (RectangleMorph newBounds: (0@0 extent: 4@2) color: Color black). self roundedScrollbarLook ifTrue:[ menuButton color: Color veryLightGray. menuButton borderStyle: (BorderStyle complexRaised width: 3). ] ifFalse:[ menuButton setBorderWidth: 1 borderColor: #raised. ]. self addMorph: menuButton ! ! !ScrollBar methodsFor: 'initialize' stamp: 'dew 3/4/2002 01:14'! initializePagingArea pagingArea := RectangleMorph newBounds: self totalSliderArea color: (Color r: 0.6 g: 0.6 b: 0.8). pagingArea borderWidth: 0. pagingArea on: #mouseDown send: #scrollPageInit: to: self. pagingArea on: #mouseUp send: #finishedScrolling to: self. self addMorph: pagingArea. self roundedScrollbarLook ifTrue:[pagingArea color: (Color gray: 0.9)].! ! !ScrollBar methodsFor: 'initialize' stamp: 'dew 3/4/2002 01:14'! initializeSlider self roundedScrollbarLook ifTrue:[ self initializeUpButton; initializeMenuButton; initializeDownButton; initializePagingArea. ] ifFalse:[ self initializeMenuButton; initializeUpButton; initializeDownButton; initializePagingArea. ]. super initializeSlider. self roundedScrollbarLook ifTrue:[ slider cornerStyle: #rounded. slider borderStyle: (BorderStyle complexRaised width: 3). sliderShadow cornerStyle: #rounded. ]. self sliderColor: self sliderColor.! ! !ScrollBar methodsFor: 'initialize' stamp: 'dew 3/4/2002 01:14'! initializeUpButton self roundedScrollbarLook ifTrue:[ upButton := RectangleMorph newBounds: (self innerBounds topLeft extent: self buttonExtent) ] ifFalse:[ upButton := RectangleMorph newBounds: ((menuButton ifNil: [self innerBounds topLeft] ifNotNil: [bounds isWide ifTrue: [menuButton bounds topRight] ifFalse: [menuButton bounds bottomLeft]]) extent: self buttonExtent) ]. upButton color: self thumbColor. upButton on: #mouseDown send: #scrollUpInit to: self. upButton on: #mouseUp send: #finishedScrolling to: self. upButton addMorphCentered: (ImageMorph new image: (self cachedImageAt: (bounds isWide ifTrue: ['left'] ifFalse: ['up']) ifAbsentPut: [ bounds isWide ifTrue: [ self upArrow8Bit rotateBy: #left centerAt: 0@0 ] ifFalse: [ self upArrow8Bit ] ] ) ). self roundedScrollbarLook ifTrue:[ upButton color: Color veryLightGray. upButton borderStyle: (BorderStyle complexRaised width: 3). ] ifFalse:[ upButton setBorderWidth: 1 borderColor: #raised. ]. self addMorph: upButton! ! !ScrollBar methodsFor: 'initialize' stamp: 'dew 3/3/2002 19:53'! thumbColor "Problem: Part of the ScrollBar/Slider code uses 'slider' to mean the entire scrollbar/slider widget, and part of it uses 'slider' to mean only the draggable 'thumb'. This should be cleaned up so that 'thumb' is used instead of 'slider' where appropriate. For now, the meaning of thumbColor is clear, at least." ^ self alternativeScrollbarLook ifTrue: [self sliderColor alphaMixed: 0.7 with: (Color gray: 0.95)] ifFalse: [Color veryLightGray]! ! !ScrollBar methodsFor: 'access' stamp: 'dew 3/23/2002 01:20'! roundedScrollbarLook "Rounded look currently only shows up in flop-out mode" ^Preferences alternativeScrollbarLook and: [Preferences inboardScrollbars not and: [self class alwaysShowFlatScrollbarForAlternativeLook not]] ! ! !ScrollBar methodsFor: 'access' stamp: 'dew 3/14/2002 02:09'! sliderColor: aColor "Change the color of the scrollbar to go with aColor." | buttonColor | super sliderColor: aColor. buttonColor _ self thumbColor. menuButton ifNotNil: [menuButton color: buttonColor]. upButton color: buttonColor. downButton color: buttonColor. slider color: buttonColor. self alternativeScrollbarLook ifTrue: [self roundedScrollbarLook ifTrue: [self color: Color transparent. pagingArea color: aColor muchLighter. self borderStyle style == #simple ifTrue:[self borderColor: aColor darker darker] ifFalse:[self borderStyle baseColor: aColor]] ifFalse: [pagingArea color: (aColor alphaMixed: 0.3 with: Color white). self borderWidth: 0]] ! ! !ScrollBar methodsFor: 'access' stamp: 'dew 3/4/2002 01:18'! sliderThickness ^ self roundedScrollbarLook ifTrue:[15] ifFalse:[super sliderThickness]! ! !ScrollBar methodsFor: 'scrolling' stamp: 'dew 3/4/2002 01:11'! finishedScrolling self stopStepping. self scrollBarAction: nil. self roundedScrollbarLook ifTrue:[ upButton borderStyle: (BorderStyle complexRaised width: upButton borderWidth). downButton borderStyle: (BorderStyle complexRaised width: downButton borderWidth). ] ifFalse:[ downButton borderRaised. upButton borderRaised. ]. ! ! !ScrollBar methodsFor: 'scrolling' stamp: 'dew 3/4/2002 01:17'! sliderShadowColor ^ self roundedScrollbarLook ifTrue: [self sliderColor darker] ifFalse: [super sliderShadowColor] ! ! !ScrollBar class methodsFor: 'as yet unclassified' stamp: 'dew 3/23/2002 01:30'! alwaysShowFlatScrollbarForAlternativeLook "Set this value to true, if you want to see the flat scrollbar look in flop-out mode as well as inboard. Otherwise the flop-out scrollbar will be rounded and inboard will be flat." ^ false! ! !SystemWindow methodsFor: 'label' stamp: 'dew 1/18/2002 00:17'! setStripeColorsFrom: paneColor "Set the stripe color based on the given paneColor" labelArea ifNotNil:[ Preferences alternativeWindowLook ifTrue:[labelArea color: paneColor lighter] ifFalse:[labelArea color: Color transparent]]. stripes ifNil: [^ self]. Preferences alternativeWindowLook ifFalse:[ self isActive ifTrue: [stripes second color: paneColor; borderColor: stripes second color darker. stripes first color: stripes second borderColor darker; borderColor: stripes first color darker] ifFalse: ["This could be much faster" stripes second color: paneColor; borderColor: paneColor. stripes first color: paneColor; borderColor: paneColor]. ] ifTrue:[ self isActive ifTrue: [stripes first borderColor: paneColor paler; color: stripes first borderColor. stripes second borderColor: stripes first color slightlyLighter; color: stripes second borderColor] ifFalse: ["This could be much faster" stripes second color: paneColor slightlyDarker; borderColor: stripes second color. stripes first color: paneColor; borderColor: paneColor]. ].! ! !SystemWindow methodsFor: 'panes' stamp: 'dew 1/19/2002 00:52'! paneColor | cc | (cc _ self valueOfProperty: #paneColor) ifNotNil:[^cc]. Display depth > 2 ifTrue:[ model ifNotNil: [ model isInMemory ifTrue: [ cc _ Color colorFrom: model defaultBackgroundColor. Preferences alternativeWindowLook ifTrue:[ (cc = Color lightYellow or: [cc = Color white]) ifTrue:[cc _ Color gray: 0.67] ifFalse:[cc _ cc duller]]. ]. ]. cc ifNil:[cc _ paneMorphs isEmptyOrNil ifFalse: [paneMorphs first color]]]. cc ifNil:[cc _ Color white]. self paneColor: cc. ^cc! ! "Postscript:" (Preferences preferenceAt: #alternativeWindowLook) categoryList: #('windows'). !