'From Squeak 3.2 of 11 July 2002 [latest update: #4917] on 31 October 2002 at 11:29:13 am'! "Change Set: CGUI Date: 31 October 2002 Author: Chris Burkert CGUI is a set of Morphic Widgets. It has a modern Design, mouseOver Effects and always an Example of using it."! BorderedMorph subclass: #CGUIButtonMorph instanceVariableNames: 'target actionSelector ' classVariableNames: '' poolDictionaries: '' category: 'CGUI-Abstracts'! !CGUIButtonMorph commentStamp: '' prior: 0! I'm a abstract Class for special Buttons.! CGUIButtonMorph subclass: #CGUIButtonIconedMorph instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'CGUI-Morphs'! !CGUIButtonIconedMorph commentStamp: '' prior: 0! I'm a Button with a Icon from a File (GIF, JPG, ...).! CGUIButtonMorph subclass: #CGUIButtonLabeledMorph instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'CGUI-Morphs'! !CGUIButtonLabeledMorph commentStamp: '' prior: 0! I'm a Button with a Label.! CGUIButtonMorph class instanceVariableNames: ''! CGUIButtonIconedMorph class instanceVariableNames: ''! CGUIButtonLabeledMorph class instanceVariableNames: ''! BorderedMorph subclass: #CGUICheckboxMorph instanceVariableNames: 'target toggleSelector stateSelector ' classVariableNames: '' poolDictionaries: '' category: 'CGUI-Morphs'! !CGUICheckboxMorph commentStamp: '' prior: 0! I'm a Checkbox. I can toggle a Boolean.! CGUICheckboxMorph class instanceVariableNames: ''! Object subclass: #CGUIExamples instanceVariableNames: '' classVariableNames: 'CGUICheckboxExampleBoolean CGUITextFieldMorphText ' poolDictionaries: '' category: 'CGUI-Examples'! !CGUIExamples commentStamp: '' prior: 0! I'm a helping Class for the Examples.! CGUIExamples class instanceVariableNames: ''! LineMorph subclass: #CGUILineMorph instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'CGUI-Helper'! !CGUILineMorph commentStamp: '' prior: 0! I'm a Line.! CGUILineMorph class instanceVariableNames: ''! StringMorph subclass: #CGUIStringMorph instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'CGUI-Helper'! !CGUIStringMorph commentStamp: '' prior: 0! I'm a StringMorph.! CGUIStringMorph class instanceVariableNames: ''! !CGUIButtonMorph methodsFor: 'initialization' stamp: 'chbu 10/31/2002 10:41'! actionSelector: aSymbol actionSelector _ aSymbol.! ! !CGUIButtonMorph methodsFor: 'initialization' stamp: 'chbu 10/31/2002 10:41'! init super initialize. self drawStateInit.! ! !CGUIButtonMorph methodsFor: 'initialization' stamp: 'chbu 10/31/2002 10:41'! target: aTarget target _ aTarget.! ! !CGUIButtonMorph methodsFor: 'event handling' stamp: 'chbu 10/31/2002 10:41'! handlesMouseDown: evt ^true! ! !CGUIButtonMorph methodsFor: 'event handling' stamp: 'chbu 10/31/2002 10:42'! handlesMouseOver: evt ^true! ! !CGUIButtonMorph methodsFor: 'event handling' stamp: 'chbu 10/31/2002 10:42'! mouseDown: evt self drawStatePassive.! ! !CGUIButtonMorph methodsFor: 'event handling' stamp: 'chbu 10/31/2002 10:42'! mouseEnter: evt self drawStateFocused.! ! !CGUIButtonMorph methodsFor: 'event handling' stamp: 'chbu 10/31/2002 10:42'! mouseLeave: evt self drawStateFocusedNot.! ! !CGUIButtonMorph methodsFor: 'event handling' stamp: 'chbu 10/31/2002 10:42'! mouseUp: evt (target ~~ nil and: [actionSelector ~~ nil]) ifTrue: [target perform: actionSelector]. self drawStateFocusedNot. self drawStatePassiveNot.! ! !CGUIButtonMorph methodsFor: 'drawing' stamp: 'chbu 10/31/2002 10:42'! drawStateFocused self borderColor: ( Color gray ).! ! !CGUIButtonMorph methodsFor: 'drawing' stamp: 'chbu 10/31/2002 10:42'! drawStateFocusedNot self borderColor: ( Color black ).! ! !CGUIButtonMorph methodsFor: 'drawing' stamp: 'chbu 10/31/2002 10:42'! drawStateInit | fill | fill _ GradientFillStyle ramp: { 0.0 -> ( Color r: 0.8 g: 0.8 b: 0.8 ). 1.0 -> ( Color r: 1 g: 1 b: 1 ) }. fill origin: (-100@0); direction: 0@10; radial: false. self borderWidth: 1; borderColor: ( Color black ); color: ( Color r: 0.95 g: 0.95 b: 0.95 ); fillStyle: fill.! ! !CGUIButtonIconedMorph methodsFor: 'drawing' stamp: 'chbu 10/31/2002 10:36'! drawStateInit | fill | fill _ GradientFillStyle ramp: { 0.0 -> ( Color r: 0.8 g: 0.8 b: 0.8 ). 1.0 -> ( Color r: 1 g: 1 b: 1 ) }. fill origin: 0@0; direction: 0@(self height); radial: false. self borderWidth: 1; borderColor: ( Color black ); color: ( Color r: 0.95 g: 0.95 b: 0.95 ); fillStyle: fill.! ! !CGUIButtonIconedMorph methodsFor: 'drawing' stamp: 'chbu 10/31/2002 10:36'! drawStatePassive | icon | self borderColor: ( Color lightGray ). icon _ self submorphNamed: #icon. icon ifNotNilDo: [ :theIcon | theIcon hide ].! ! !CGUIButtonIconedMorph methodsFor: 'drawing' stamp: 'chbu 10/31/2002 10:36'! drawStatePassiveNot | icon | self borderColor: ( Color black ). icon _ self submorphNamed: #icon. icon ifNotNilDo: [ :theIcon | theIcon show ].! ! !CGUIButtonIconedMorph methodsFor: 'accessing' stamp: 'chbu 10/31/2002 10:36'! icon: aFile | icon | " delete the old Icon " (self submorphNamed: #icon) ifNotNilDo: [:oldIcon | oldIcon delete]. " set up the new Icon " icon _ ImageMorph new initialize image: (ImageReadWriter formFromFileNamed: aFile). icon name: #icon. self addMorph: icon; extent: self nominalExtent; drawStateInit. icon center: self center.! ! !CGUIButtonIconedMorph methodsFor: 'accessing' stamp: 'chbu 10/31/2002 10:36'! nominalExtent | icon | icon _ self submorphNamed: #icon. icon ifNil: [^ 40 @ 20]. ^ ((icon width) + 10)@((icon height) + 10).! ! !CGUIButtonLabeledMorph methodsFor: 'accessing' stamp: 'chbu 10/31/2002 10:37'! label: aLabel | label | " delete the old Label " (self submorphNamed: #label) ifNotNilDo: [:oldLabel | oldLabel delete]. " set up the new Label " label _ CGUIStringMorph contents: aLabel. label name: #label; lock. self addMorph: label; extent: self nominalExtent. label center: self center.! ! !CGUIButtonLabeledMorph methodsFor: 'accessing' stamp: 'chbu 10/31/2002 10:38'! nominalExtent | labelString | labelString _ self submorphNamed: #label. labelString ifNil: [^ 40 @ 20]. ^ labelString width + 10 @ 20.! ! !CGUIButtonLabeledMorph methodsFor: 'drawing' stamp: 'chbu 10/31/2002 10:37'! drawStatePassive | label | self borderColor: ( Color lightGray ). label _ self submorphNamed: #label. label ifNotNilDo: [ :theLabel | theLabel drawStatePassive ].! ! !CGUIButtonLabeledMorph methodsFor: 'drawing' stamp: 'chbu 10/31/2002 10:37'! drawStatePassiveNot | label | self borderColor: ( Color black ). label _ self submorphNamed: #label. label ifNotNilDo: [ :theLabel | theLabel drawStatePassiveNot ].! ! !CGUIButtonMorph class methodsFor: 'class initialization' stamp: 'chbu 10/31/2002 10:41'! on: aTarget whenPressedSend: aActionSelectorOfTheTarget | newButton | newButton _ self new init. ^newButton target: aTarget; actionSelector: aActionSelectorOfTheTarget.! ! !CGUIButtonIconedMorph class methodsFor: 'example' stamp: 'chbu 10/31/2002 10:36'! example " CGUIButtonIconedMorph example " | button | button _ self on: Transcript whenPressedSend: #open. button icon: 'icon.jpg'. self currentWorld addMorphFront: button. button position: 10@10.! ! !CGUIButtonLabeledMorph class methodsFor: 'example' stamp: 'chbu 10/31/2002 10:37'! example " CGUIButtonLabeledMorph example " | button | button _ self on: Transcript whenPressedSend: #open. button label: ' Open a new Transcript '. self currentWorld addMorphFront: button. button position: 10@10.! ! !CGUICheckboxMorph methodsFor: 'initialization' stamp: 'chbu 10/31/2002 10:39'! init super initialize. self drawStateInit; updateMyOwnLook.! ! !CGUICheckboxMorph methodsFor: 'initialization' stamp: 'chbu 10/31/2002 10:39'! stateSelector: aSymbol stateSelector _ aSymbol.! ! !CGUICheckboxMorph methodsFor: 'initialization' stamp: 'chbu 10/31/2002 10:39'! target: aTarget target _ aTarget.! ! !CGUICheckboxMorph methodsFor: 'initialization' stamp: 'chbu 10/31/2002 10:39'! toggleSelector: aSymbol toggleSelector _ aSymbol.! ! !CGUICheckboxMorph methodsFor: 'event handling' stamp: 'chbu 10/31/2002 10:38'! handlesMouseDown: evt ^true! ! !CGUICheckboxMorph methodsFor: 'event handling' stamp: 'chbu 10/31/2002 10:38'! handlesMouseOver: evt ^true! ! !CGUICheckboxMorph methodsFor: 'event handling' stamp: 'chbu 10/31/2002 10:38'! mouseDown: evt self drawStatePassive.! ! !CGUICheckboxMorph methodsFor: 'event handling' stamp: 'chbu 10/31/2002 10:38'! mouseEnter: evt self drawStateFocused.! ! !CGUICheckboxMorph methodsFor: 'event handling' stamp: 'chbu 10/31/2002 10:38'! mouseLeave: evt self drawStateFocusedNot.! ! !CGUICheckboxMorph methodsFor: 'event handling' stamp: 'chbu 10/31/2002 10:39'! mouseUp: evt (target ~~ nil and: [toggleSelector ~~ nil]) ifTrue: [target perform: toggleSelector]. self updateMyOwnLook.! ! !CGUICheckboxMorph methodsFor: 'updating' stamp: 'chbu 10/31/2002 10:38'! updateMyOwnLook (target ~~ nil and: [stateSelector ~~ nil]) ifTrue: [ (target perform: stateSelector) ifTrue: [ self drawStateChecked; drawStatePassiveNot. ] ifFalse: [ self drawStateCheckedNot; drawStatePassiveNot. ]. ].! ! !CGUICheckboxMorph methodsFor: 'drawing' stamp: 'chbu 10/31/2002 10:38'! drawStateChecked | secondLine cross | cross _ CGUILineMorph from: 0@0 to: 6@6. secondLine _ CGUILineMorph from: 6@0 to: 0@6. cross addMorphFront: secondLine; name: #cross. self addMorphFront: cross; borderColor: (Color black). cross center: (self center).! ! !CGUICheckboxMorph methodsFor: 'drawing' stamp: 'chbu 10/31/2002 10:38'! drawStateCheckedNot (self submorphNamed: #cross) ifNotNilDo: [:oldCross | oldCross delete].! ! !CGUICheckboxMorph methodsFor: 'drawing' stamp: 'chbu 10/31/2002 10:38'! drawStateFocused self borderColor: ( Color gray ).! ! !CGUICheckboxMorph methodsFor: 'drawing' stamp: 'chbu 10/31/2002 10:38'! drawStateFocusedNot self borderColor: ( Color black ).! ! !CGUICheckboxMorph methodsFor: 'drawing' stamp: 'chbu 10/31/2002 10:38'! drawStateInit | fill | fill _ GradientFillStyle ramp: { 0.0 -> ( Color r: 0.8 g: 0.8 b: 0.8 ). 1.0 -> ( Color r: 1 g: 1 b: 1 ) }. fill origin: (0@0); direction: 0@7; radial: false. self width: 15; height: 15; borderWidth: 1; borderColor: ( Color black); color: ( Color r: 0.95 g: 0.95 b: 0.95 ); fillStyle: fill.! ! !CGUICheckboxMorph methodsFor: 'drawing' stamp: 'chbu 10/31/2002 10:38'! drawStatePassive self borderColor: ( Color lightGray ).! ! !CGUICheckboxMorph methodsFor: 'drawing' stamp: 'chbu 10/31/2002 10:38'! drawStatePassiveNot self borderColor: ( Color black ).! ! !CGUICheckboxMorph class methodsFor: 'example' stamp: 'chbu 10/31/2002 11:27'! example " CGUICheckboxMorph example " | checkbox | CGUIExamples checkboxInit. checkbox _ self on: CGUIExamples toggleWith: #checkboxToggle getStateWith: #checkboxState. self currentWorld addMorphFront: checkbox. checkbox position: 10@10.! ! !CGUICheckboxMorph class methodsFor: 'class initialization' stamp: 'chbu 10/31/2002 10:39'! on: aTarget toggleWith: aToggleSelector getStateWith: aStateSelector | newCheckbox | newCheckbox _ self new. ^newCheckbox target: aTarget; toggleSelector: aToggleSelector; stateSelector: aStateSelector; init.! ! !CGUIExamples class methodsFor: 'CGUI Text Field' stamp: 'chbu 10/1/2002 20:09'! textFieldRead ^CGUITextFieldMorphText.! ! !CGUIExamples class methodsFor: 'CGUI Text Field' stamp: 'chbu 10/1/2002 20:09'! textFieldWrite: aText CGUITextFieldMorphText _ aText.! ! !CGUIExamples class methodsFor: 'CGUI Radio Button' stamp: 'chbu 10/1/2002 16:56'! radioButtonInit ^CGUIRadioButtonController target: self actionSelector: #radioButtonSelect:.! ! !CGUIExamples class methodsFor: 'CGUI Radio Button' stamp: 'chbu 9/30/2002 23:19'! radioButtonSelect: x! ! !CGUIExamples class methodsFor: 'CGUI Checkbox' stamp: 'chbu 10/31/2002 10:42'! checkboxInit CGUICheckboxExampleBoolean _ false.! ! !CGUIExamples class methodsFor: 'CGUI Checkbox' stamp: 'chbu 10/31/2002 10:43'! checkboxState ^CGUICheckboxExampleBoolean.! ! !CGUIExamples class methodsFor: 'CGUI Checkbox' stamp: 'chbu 10/31/2002 10:43'! checkboxToggle CGUICheckboxExampleBoolean _ CGUICheckboxExampleBoolean not.! ! !CGUILineMorph class methodsFor: 'as yet unclassified' stamp: 'chbu 10/31/2002 10:40'! example | line | line _ CGUILineMorph from: 20@20 to: 50@50. self currentWorld addMorphFront: line.! ! !CGUILineMorph class methodsFor: 'as yet unclassified' stamp: 'chbu 10/31/2002 10:40'! from: aFirstPoint to: aSecondPoint ^super from: aFirstPoint to: aSecondPoint color: (Color black) width: 1.! ! !CGUIStringMorph methodsFor: 'initialization' stamp: 'chbu 10/31/2002 10:40'! init super initialize. self drawStateInit.! ! !CGUIStringMorph methodsFor: 'drawing' stamp: 'chbu 10/31/2002 10:40'! drawStateInit self font: ( TextStyle defaultFont ); color: ( Color black ).! ! !CGUIStringMorph methodsFor: 'drawing' stamp: 'chbu 10/31/2002 10:40'! drawStatePassive self color: ( Color lightGray ).! ! !CGUIStringMorph methodsFor: 'drawing' stamp: 'chbu 10/31/2002 10:40'! drawStatePassiveNot self color: ( Color black ).! ! !CGUIStringMorph class methodsFor: 'instance creation' stamp: 'chbu 10/1/2002 13:36'! contents: aString | newString | newString _ self new init. ^newString contents: aString.! ! !CGUIStringMorph class methodsFor: 'example' stamp: 'chbu 9/28/2002 17:48'! example | string | string _ CGUIStringMorph contents: 'Example'. self currentWorld addMorphFront: string. string position: 10@10.! !