Squeak 4.6: SmallLand-ColorTheme-fbs.6.mcz

Chris Muller uploaded a new version of SmallLand-ColorTheme to project Squeak 4.6:
http://source.squeak.org/squeak46/SmallLand-ColorTheme-fbs.6.mcz

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

Name: SmallLand-ColorTheme-fbs.6
Author: fbs
Time: 31 December 2013, 2:14:02.015 pm
UUID: a78b81e3-3b11-c24e-9c84-3bb5319e0858
Ancestors: SmallLand-ColorTheme-nice.5

Remove references to preferences that are now pragma based.

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

SystemOrganization addCategory: #'SmallLand-ColorTheme'!

----- Method: Preferences class>>smallLand (in category '*SmallLand-ColorTheme') -----
smallLand
        "Small-Land theme. It install the complete Small-Land theme  
        (Preferences, Fonts, Colors, etc)"
        "
        Preferences smallLand.  
        "
        self smallLandPreferences.
        self smallLandFonts.
        SmallLandColorTheme current apply!

----- Method: Preferences class>>smallLandBigFonts (in category '*SmallLand-ColorTheme') -----
smallLandBigFonts
        "private - change the fonts to small-land's choices"

        "
        Preferences smallLandBigFonts.
        "

        #(
                (setButtonFontTo: #BitstreamVeraSansMono 15)

                (setListFontTo: #BitstreamVeraSans 15)
                (setMenuFontTo: #BitstreamVeraSans 15)
                (setSystemFontTo: #BitstreamVeraSans 15)

                (setWindowTitleFontTo: #BitstreamVeraSans 15)

                (setCodeFontTo: #BitstreamVeraSerif 15)

                (setFlapsFontTo: #KomikaText 24)
                (setEToysFontTo: #KomikaText 24)
                (setHaloLabelFontTo: #KomikaText 24)
                (setEToysTitleFontTo: #KomikaText 36)
  )
                do: [:triplet |
                        Preferences
                                perform: triplet first
                                with: (StrikeFont familyName: triplet second pointSize: triplet third)
                ].

        BalloonMorph setBalloonFontTo: (StrikeFont familyName: #BitstreamVeraSans pointSize: 15).
!

----- Method: Preferences class>>smallLandFonts (in category '*SmallLand-ColorTheme') -----
smallLandFonts
        "private - change the fonts to small-land's  
        choices"
        "
        Preferences smallLandFonts.  
        "
        Preferences bigDisplay
                ifTrue: [^ self smallLandBigFonts].
        Preferences tinyDisplay
                ifTrue: [^ self smallLandTinyFonts].
        self smallLandSmallFonts!

----- Method: Preferences class>>smallLandPreferences (in category '*SmallLand-ColorTheme') -----
smallLandPreferences
        "Private - change the preferences according to small-land taste"

        self setPreferencesFrom: #(
                (haloEnclosesFullBounds true)
                (showBoundsInHalo       true)
                (cmdGesturesEnabled false)
                (easySelection true)
                (abbreviatedBrowserButtons       true)
                (alternativeBrowseIt             true)
                (alwaysShowVScrollbar            false)
                (annotationPanes                 true)
                (balloonHelpInMessageLists       true)
                (classicNewMorphMenu             true)
                (collapseWindowsInPlace          true)
                (diffsWithPrettyPrint            true)
                (dragNDropWithAnimation          true)
                (duplicateControlAndAltKeys      true)
                (eToyFriendly                    true)
                (extraDebuggerButtons            true)
                (extractFlashInHighestQuality    true)
                (fastDragWindowForMorphic        false)
                (includeSoundControlInNavigator  true)
                (menuKeyboardControl             true)
                (menuAppearance3d false)
                (gradientMenu false)
                (mouseOverForKeyboardFocus       true)
                (optionalButtons                 true)
                (projectViewsInWindows           true)
                (propertySheetFromHalo           true)
                (scrollBarsNarrow                true)
                (scrollBarsOnRight               true)
                (selectiveHalos                  true)
                (showDirectionForSketches        true)
                (showDirectionHandles            true)
                (translationWithBabel            true)
                (unlimitedPaintArea              true)
                (unlimitedPaintArea              true)

                (menuColorFromWorld false)
                (noviceMode true)
                (uniqueNamesInHalos true)
                (infiniteUndo true)
                (useUndo true)
                (soundStopWhenDone true)
        ).

        self setParameter: #balloonHelpDelayTime to: 100.
!

----- Method: Preferences class>>smallLandSmallFonts (in category '*SmallLand-ColorTheme') -----
smallLandSmallFonts
        "private - change the fonts to small-land's choices"

        "
        Preferences smallLandFonts.
        "

        #(
                (setButtonFontTo: #BitstreamVeraSansMono 12)

                (setListFontTo: #BitstreamVeraSans 12)
                (setMenuFontTo: #BitstreamVeraSans 12)
                (setSystemFontTo: #BitstreamVeraSans 12)

                (setWindowTitleFontTo: #BitstreamVeraSans 15)

                (setCodeFontTo: #BitstreamVeraSerif 12)

                (setFlapsFontTo: #KomikaText 15)
                (setEToysFontTo: #KomikaText 15)
                (setHaloLabelFontTo: #KomikaText 15)
                (setEToysTitleFontTo: #KomikaText 24)
  )
                do: [:triplet |
                        Preferences
                                perform: triplet first
                                with: (StrikeFont familyName: triplet second pointSize: triplet third)
                ].

        BalloonMorph setBalloonFontTo: (StrikeFont familyName: #BitstreamVeraSans pointSize: 12).
!

----- Method: Preferences class>>smallLandTinyFonts (in category '*SmallLand-ColorTheme') -----
smallLandTinyFonts
        "private - change the fonts to small-land's choices"

        "
        Preferences smallLandTinyFonts.
        "

        #(
                (setButtonFontTo: #AccujenMono 9)

                (setListFontTo: #Accujen 9)
                (setMenuFontTo: #Accujen 9)
                (setSystemFontTo: #Accujen 9)

                (setWindowTitleFontTo: #Accujen 10)

                (setCodeFontTo: #Accuny 9)

                (setFlapsFontTo: #Atlanta 11)
                (setEToysFontTo: #Atlanta 11)
                (setHaloLabelFontTo: #Atlanta 11)
                (setEToysTitleFontTo: #Atlanta 11)
  )
                do: [:triplet |
                        Preferences
                                perform: triplet first
                                with: (StrikeFont familyName: triplet second pointSize: triplet third)
                ].

        BalloonMorph setBalloonFontTo: (StrikeFont familyName: #Accujen pointSize: 9).
!

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 class>>unload (in category 'as yet unclassified') -----
unload
        ColorTheme current: ColorTheme defaultTheme.!

----- 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 printShowingMaxDecimalPlaces: 2) , ' ' , (aColor green printShowingMaxDecimalPlaces: 2) , ' ' , (aColor blue printShowingMaxDecimalPlaces: 2)!

----- 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 ))!