[squeak-dev] The Trunk: SmallLand-ColorTheme-fbs.1.mcz

commits at source.squeak.org commits at source.squeak.org
Tue Mar 5 09:33:56 UTC 2013


Frank Shearar uploaded a new version of SmallLand-ColorTheme to project The Trunk:
http://source.squeak.org/trunk/SmallLand-ColorTheme-fbs.1.mcz

==================== Summary ====================

Name: SmallLand-ColorTheme-fbs.1
Author: fbs
Time: 5 March 2013, 9:33:48.238 am
UUID: c4426ce9-1634-41c0-af8c-cb1b56a90aba
Ancestors: 

Put all the SmallLand colour themes in a separate package.

==================== Snapshot ====================

SystemOrganization addCategory: #'SmallLand-ColorTheme'!

ColorTheme subclass: #SmallLandColorTheme
	instanceVariableNames: 'darks normals lights'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'SmallLand-ColorTheme'!

SmallLandColorTheme subclass: #BlueSmallLandColorTheme
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'SmallLand-ColorTheme'!

----- Method: BlueSmallLandColorTheme>>baseColors (in category 'initialization') -----
baseColors
	" 
	BlueSmallLandColorTheme apply.  
	"
	^ Array
		with: (Color fromArray: #(0.2 0.3 0.9 ))
		with: (Color fromArray: #(0.6 0.7 1.0 ))
		with: (Color fromArray: #(0.85 0.9 1.0 ))!

SmallLandColorTheme subclass: #GraySmallLandColorTheme
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'SmallLand-ColorTheme'!

----- Method: GraySmallLandColorTheme>>baseColors (in category 'initialization') -----
baseColors
	" 
	GraySmallLandColorTheme apply.
	"
	^ Array
		with: (Color fromArray: #(0.4 0.4 0.4 ))
		with: (Color fromArray: #(0.8 0.8 0.8 ))
		with: (Color fromArray: #(0.97 0.97 0.97 ))!

SmallLandColorTheme subclass: #GreenSmallLandColorTheme
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'SmallLand-ColorTheme'!

----- Method: GreenSmallLandColorTheme>>baseColors (in category 'initialize-release') -----
baseColors
	" 
	GreenSmallLandColorTheme apply.
	"
	^ Array
		with: (Color fromArray: #(0.1 0.5 0.3 ))
		with: (Color fromArray: #(0.2 0.9 0.6 ))
		with: (Color fromArray: #(0.85 1.0 0.98 ))!

SmallLandColorTheme subclass: #MagentaSmallLandColorTheme
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'SmallLand-ColorTheme'!

----- Method: MagentaSmallLandColorTheme>>baseColors (in category 'initialization') -----
baseColors
	" 
	MagentaSmallLandColorTheme apply.
	"
	^ Array
		with: (Color fromArray: #(0.8 0.1 0.7 ))
		with: (Color fromArray: #(1.0 0.3 0.9 ))
		with: (Color fromArray: #(1.0 0.9 0.8 ))!

SmallLandColorTheme subclass: #OrangeSmallLandColorTheme
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'SmallLand-ColorTheme'!

----- Method: OrangeSmallLandColorTheme>>baseColors (in category 'initialization') -----
baseColors
"
OrangeSmallLandColorTheme apply.
"
	^ Array
		with: (Color fromArray: #(0.8 0.4 0.0 ))
		with: (Color fromArray: #(1.0 0.8 0.0 ))
		with: (Color fromArray: #(1.0 1.0 0.8 ))!

SmallLandColorTheme subclass: #RedSmallLandColorTheme
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'SmallLand-ColorTheme'!

----- Method: RedSmallLandColorTheme>>baseColors (in category 'initialization') -----
baseColors
	" 
	RedSmallLandColorTheme apply.  
	"
	^ Array
		with: (Color fromArray: #(0.8 0.0 0.2 ))
		with: (Color fromArray: #(0.97 0.13 0.3 ))
		with: (Color fromArray: #(1.0 0.88 0.97 ))!

----- Method: SmallLandColorTheme class>>allThemes (in category 'accessing') -----
allThemes
	"
SmallLandColorTheme allThemes.
	"
	^ self withAllSubclasses
		reject: [:each | each == self]!

----- Method: SmallLandColorTheme class>>chooseTheme (in category 'accessing') -----
chooseTheme
	" 
	SmallLandColorTheme chooseTheme.  
	"
	| themes menu |
	menu := MenuMorph new defaultTarget: self.
	menu addTitle: 'choose color theme' translated.
	Preferences noviceMode
		ifFalse: [menu addStayUpItem].
	""
	themes := self allThemes
				asSortedCollection: [:x :y | x themeName translated <= y themeName translated].
	themes
		do: [:each | ""menu
				addUpdating: #stringForTheme:
				target: each
				selector: #applyTheme:
				argumentList: {each}].
	""
	menu popUpInWorld!

----- Method: SmallLandColorTheme class>>stringForTheme: (in category 'accessing') -----
stringForTheme: aTheme 

	^ (aTheme == ColorTheme current class
		ifTrue: ['<on>']
		ifFalse: ['<off>'])
		, aTheme themeName translated.!

----- Method: SmallLandColorTheme class>>themeName (in category 'accessing') -----
themeName
	" 
	self themeName. 
	 
	BlueSmallLandColorTheme themeName.  
	GreenSmallLandColorTheme themeName.  
	"
	^ self name allButLast: 'SmallLandColorTheme' size.
!

----- Method: SmallLandColorTheme>>apply (in category 'applying') -----
apply
	Preferences installBrightWindowColors.
	""
	super apply.
	""
	self updateTopProject.
	self updateFlaps.
	self updateWorldMainDockingBar!

----- Method: SmallLandColorTheme>>balloonColor (in category 'theme') -----
balloonColor
	^ (self light: 1) twiceLighter alpha: 0.95"Color white alpha: 0.95"!

----- Method: SmallLandColorTheme>>baseColors (in category 'initialization') -----
baseColors
	"Answer a collection of the 3 base colors"
	^ self subclassResponsibility!

----- Method: SmallLandColorTheme>>cancelColor (in category 'theme') -----
cancelColor
	^ super cancelColor"self normal: 8"!

----- Method: SmallLandColorTheme>>dark: (in category 'private - colors') -----
dark: index
	^ darks at: index!

----- Method: SmallLandColorTheme>>defaultWorldColor (in category 'theme') -----
defaultWorldColor
	^ (self light: 1) twiceLighter twiceLighter !

----- Method: SmallLandColorTheme>>dialog3DTitles (in category 'theme - dialogs') -----
dialog3DTitles
	^ false!

----- Method: SmallLandColorTheme>>dialogBorderColor (in category 'theme - dialogs') -----
dialogBorderColor
	^ (self dark: 5) !

----- Method: SmallLandColorTheme>>dialogBorderWidth (in category 'theme - dialogs') -----
dialogBorderWidth
	^ 2!

----- Method: SmallLandColorTheme>>dialogButtonBorderWidth (in category 'theme - dialogs') -----
dialogButtonBorderWidth
	^ 1!

----- Method: SmallLandColorTheme>>dialogColor (in category 'theme - dialogs') -----
dialogColor
	^ self light: 3!

----- Method: SmallLandColorTheme>>dialogPaneBorderColor (in category 'theme - dialogs') -----
dialogPaneBorderColor
	^ self dialogTextBoxBorderColor !

----- Method: SmallLandColorTheme>>dialogPaneBorderWidth (in category 'theme - dialogs') -----
dialogPaneBorderWidth
	^ 1!

----- Method: SmallLandColorTheme>>dialogPaneRampOrColor (in category 'theme - dialogs') -----
dialogPaneRampOrColor
	^ self dialogTextBoxColor!

----- Method: SmallLandColorTheme>>dialogRampOrColor (in category 'theme - dialogs') -----
dialogRampOrColor
	^ self dialogColor!

----- Method: SmallLandColorTheme>>dialogTextBoxBorderColor (in category 'theme - dialogs') -----
dialogTextBoxBorderColor
	^ self normal: 1!

----- Method: SmallLandColorTheme>>dialogTextBoxColor (in category 'theme - dialogs') -----
dialogTextBoxColor
	^ self light: 1!

----- Method: SmallLandColorTheme>>dockingBarAutoGradient (in category 'theme - dockingbar') -----
dockingBarAutoGradient
	^ true!

----- Method: SmallLandColorTheme>>dockingBarColor (in category 'theme - dockingbar') -----
dockingBarColor
	^self normal:1!

----- Method: SmallLandColorTheme>>dockingBarGradientRamp (in category 'theme - dockingbar') -----
dockingBarGradientRamp
	^ {0.0 -> Color white. 1.0
		-> (self normal:1)}!

----- Method: SmallLandColorTheme>>helpColor (in category 'theme') -----
helpColor
^ self okColor!

----- Method: SmallLandColorTheme>>initialize (in category 'initialization') -----
initialize
	"Initialize the receiver"
	| baseColors |
	super initialize.
	""
	baseColors := self baseColors.
	""
	darks := baseColors first wheel: 8.
	normals := baseColors second wheel: 8.
	lights := baseColors third wheel: 8!

----- Method: SmallLandColorTheme>>insertionPointColor (in category 'theme') -----
insertionPointColor
	^ self normal: 7!

----- Method: SmallLandColorTheme>>keyboardFocusColor (in category 'theme') -----
keyboardFocusColor
	^ self normal: 8!

----- Method: SmallLandColorTheme>>labelForColor: (in category 'private - colors') -----
labelForColor: aColor 
	^ (aColor red roundTo: 0.01) asString , ' ' , (aColor green roundTo: 0.01) asString , ' ' , (aColor blue roundTo: 0.01) asString!

----- Method: SmallLandColorTheme>>light: (in category 'private - colors') -----
light: index 
	^ lights at: index!

----- Method: SmallLandColorTheme>>menuBorderColor (in category 'theme - menus') -----
menuBorderColor
	^self dark: 1!

----- Method: SmallLandColorTheme>>menuBorderWidth (in category 'theme - menus') -----
menuBorderWidth ^ 2.!

----- Method: SmallLandColorTheme>>menuColor (in category 'theme - menus') -----
menuColor
	^ self light: 1!

----- Method: SmallLandColorTheme>>menuLineColor (in category 'theme - menus') -----
menuLineColor
	^ self normal: 1!

----- Method: SmallLandColorTheme>>menuSelectionColor (in category 'theme - menus') -----
menuSelectionColor
	^ self dark: 1!

----- Method: SmallLandColorTheme>>menuTitleBorderColor (in category 'theme - menus') -----
menuTitleBorderColor
	^ self menuTitleColor !

----- Method: SmallLandColorTheme>>menuTitleBorderWidth (in category 'theme - menus') -----
menuTitleBorderWidth
	^ 6!

----- Method: SmallLandColorTheme>>menuTitleColor (in category 'theme - menus') -----
menuTitleColor
	^ self normal: 1!

----- Method: SmallLandColorTheme>>normal: (in category 'private - colors') -----
normal: index 
	^ normals at: index!

----- Method: SmallLandColorTheme>>okColor (in category 'theme') -----
okColor
	^ super okColor "self normal: 2"!

----- Method: SmallLandColorTheme>>printOn: (in category 'printing') -----
printOn: aStream 
	aStream nextPutAll: 'Small-Land Color Theme: ', self class themeName!

----- Method: SmallLandColorTheme>>rowOf: (in category 'private - colors') -----
rowOf: colors 
	| row |
	row := AlignmentMorph newRow.
	row cellInset: 5.
	row color: Color white.
	""
	colors
		do: [:each | 
			| box label | 
			box := RectangleMorph new.
			box extent: 100 @ 60.
			box color: each.
			box borderWidth: 2.
			box borderColor: box color muchDarker.
			""
			label := StringMorph
						contents: (self labelForColor: each).
			label color: each negated.
			box addMorphCentered: label.
			""
			row addMorphBack: box].
	""
	^ row !

----- Method: SmallLandColorTheme>>showColors (in category 'private - colors') -----
showColors
	" 
	BlueSmallLandColorTheme new showColors. 
	"
	| col |
	col := AlignmentMorph newColumn.
	col color: Color white.
	col
		addMorphBack: (self rowOf: darks).
	col
		addMorphBack: (self rowOf: normals).
	col
		addMorphBack: (self rowOf: lights).
	""
	col openInWorld!

----- Method: SmallLandColorTheme>>textHighlightColor (in category 'theme') -----
textHighlightColor
	^self normal: 1!

----- Method: SmallLandColorTheme>>updateFlaps (in category 'applying') -----
updateFlaps
	Flaps globalFlapTabs
		select: [:each | each flapID = 'Supplies' translated]
		thenDo: [:each | 
			each
				color: (self normal: 1);
				
				borderColor: (self normal: 1);
				 borderWidth: (self menuBorderWidth).
			""
			each referent
				color: (self light: 1);
				 borderWidth: (self menuBorderWidth);
				
				borderColor: (self normal: 1)]!

----- Method: SmallLandColorTheme>>updateTopProject (in category 'applying') -----
updateTopProject
	Project current == Project topProject
	ifFalse:[^ self].

""
			World color: Preferences defaultWorldColor.
			World submorphs
				select: [:each | ""
					(each isKindOf: StringMorph)
						and: [each contents = 'Squeak']]
				thenDo: [:each | each
						color: (self dark: 1)].
!

----- Method: SmallLandColorTheme>>updateWorldMainDockingBar (in category 'applying') -----
updateWorldMainDockingBar
	| oldPreference |
	oldPreference := Project current showWorldMainDockingBar.
	""
	Project current showWorldMainDockingBar: false.
	Project current showWorldMainDockingBar: oldPreference.
	TheWorldMainDockingBar updateInstances!

SmallLandColorTheme subclass: #VioletSmallLandColorTheme
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'SmallLand-ColorTheme'!

----- Method: VioletSmallLandColorTheme>>baseColors (in category 'as yet unclassified') -----
baseColors
	" 
	VioletSmallLandColorTheme apply.
	"
	^ Array
		with: (Color fromArray: #(0.6 0.0 1.0 ))
		with: (Color fromArray: #(0.8 0.4 1.0 ))
		with: (Color fromArray: #(0.95 0.95 1.0 ))!

SmallLandColorTheme subclass: #YellowSmallLandColorTheme
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'SmallLand-ColorTheme'!

----- Method: YellowSmallLandColorTheme>>baseColors (in category 'initialization') -----
baseColors
	" 
	YellowSmallLandColorTheme apply.
	"
	^ Array
		with: (Color fromArray: #(0.6 0.6 0.0 ))
		with: (Color fromArray: #(0.9 0.9 0.3 ))
		with: (Color fromArray: #(1.0 1.0 0.9 ))!



More information about the Squeak-dev mailing list