'From Squeak 3.2 of 11 July 2002 [latest update: #4917] on 4 November 2002 at 10:04:50 am'! Object subclass: #CGUICheckboxModel instanceVariableNames: 'bool ' classVariableNames: '' poolDictionaries: '' category: 'CGUI-Examples'! BorderedMorph subclass: #CGUICheckboxMorph instanceVariableNames: 'model selectors cross ' classVariableNames: '' poolDictionaries: '' category: 'CGUI-Morphs'! BorderedMorph subclass: #CGUIIconedButtonMorph instanceVariableNames: 'model selectors ' classVariableNames: '' poolDictionaries: '' category: 'CGUI-Morphs'! Object subclass: #CGUILabelModel instanceVariableNames: 'label ' classVariableNames: '' poolDictionaries: '' category: 'CGUI-Examples'! StringMorph subclass: #CGUILabelMorph instanceVariableNames: 'model selectors ' classVariableNames: '' poolDictionaries: '' category: 'CGUI-Morphs'! CGUILabelMorph class instanceVariableNames: ''! BorderedMorph subclass: #CGUILabeledButtonMorph instanceVariableNames: 'model selectors ' classVariableNames: '' poolDictionaries: '' category: 'CGUI-Morphs'! !CGUICheckboxModel methodsFor: 'as yet unclassified' stamp: 'chbu 11/3/2002 18:50'! bool ^bool.! ! !CGUICheckboxModel methodsFor: 'as yet unclassified' stamp: 'chbu 11/3/2002 18:50'! bool: aBool bool _ aBool.! ! !CGUICheckboxModel methodsFor: 'as yet unclassified' stamp: 'chbu 11/3/2002 18:50'! toggle bool _ bool not.! ! !CGUICheckboxMorph methodsFor: 'initialization' stamp: 'chbu 11/3/2002 19:30'! onModel: theModel withSelectors: theSelectors | temp | super initialize. model _ theModel. selectors _ theSelectors. cross _ LineMorph from: 0@0 to: 6@6 color: (Color black) width: 1. temp _ LineMorph from: 6@0 to: 0@6 color: (Color black) width: 1. cross addMorphFront: temp; name: #cross. model when: #boolChanged send: #handleBoolChanged to: self. self on: #mouseEnter send: #handleMouseEnter to: self; on: #mouseLeave send: #handleMouseLeave to: self; on: #mouseDown send: #handleMouseDown to: self; on: #mouseUp send: #handleMouseUp to: self; drawStateInit; updateMyOwnLook.! ! !CGUICheckboxMorph methodsFor: 'event handling' stamp: 'chbu 11/3/2002 19:26'! handleMouseDown self drawStatePassive.! ! !CGUICheckboxMorph methodsFor: 'event handling' stamp: 'chbu 11/3/2002 19:14'! handleMouseEnter self drawStateFocused.! ! !CGUICheckboxMorph methodsFor: 'event handling' stamp: 'chbu 11/3/2002 19:14'! handleMouseLeave self drawStateFocusedNot.! ! !CGUICheckboxMorph methodsFor: 'event handling' stamp: 'chbu 11/3/2002 19:32'! handleMouseUp | toggle | toggle _ selectors at: 2. (model ~~ nil and: [toggle ~~ nil]) ifTrue: [model perform: toggle]. self updateMyOwnLook.! ! !CGUICheckboxMorph methodsFor: 'drawing' stamp: 'chbu 11/3/2002 19:06'! drawStateChecked self addMorphFront: cross; borderColor: (Color black). cross center: (self center).! ! !CGUICheckboxMorph methodsFor: 'drawing' stamp: 'chbu 11/3/2002 19:06'! drawStateCheckedNot (self submorphNamed: #cross) ifNotNilDo: [:oldCross | oldCross delete].! ! !CGUICheckboxMorph methodsFor: 'drawing' stamp: 'chbu 11/3/2002 19:00'! drawStateFocused self borderColor: ( Color gray ).! ! !CGUICheckboxMorph methodsFor: 'drawing' stamp: 'chbu 11/3/2002 19:00'! drawStateFocusedNot self borderColor: ( Color black ).! ! !CGUICheckboxMorph methodsFor: 'drawing' stamp: 'chbu 11/3/2002 18:59'! 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 11/3/2002 19:00'! drawStatePassive self borderColor: ( Color lightGray ).! ! !CGUICheckboxMorph methodsFor: 'drawing' stamp: 'chbu 11/3/2002 19:00'! drawStatePassiveNot self borderColor: ( Color black ).! ! !CGUICheckboxMorph methodsFor: 'drawing' stamp: 'chbu 11/3/2002 19:20'! updateMyOwnLook | toggle | toggle _ selectors at: 1. (model ~~ nil and: [toggle ~~ nil]) ifTrue: [ (model perform: toggle) ifTrue: [ self drawStateChecked; drawStatePassiveNot. ] ifFalse: [ self drawStateCheckedNot; drawStatePassiveNot. ]. ].! ! !CGUICheckboxMorph class methodsFor: 'class initialization' stamp: 'chbu 11/3/2002 18:55'! example | model checkbox | model _ CGUICheckboxModel new bool: true. checkbox _ self onModel: model withSelectors: #(#bool #toggle). self currentWorld addMorphFront: checkbox. checkbox position: 10@10.! ! !CGUICheckboxMorph class methodsFor: 'class initialization' stamp: 'chbu 11/3/2002 18:57'! onModel: theModel withSelectors: theSelectors " theModel is usually something like a Boolean. theSelectors is a Collection containing Selectors in the following order: - #getBoolSelector this has to return the Boolean. - #toggleBoolSelector: this toggles the Boolean. " ^self new onModel: theModel withSelectors: theSelectors.! ! !CGUIIconedButtonMorph methodsFor: 'initialization' stamp: 'chbu 11/3/2002 20:36'! onModel: theModel withSelectors: theSelectors super initialize. model _ theModel. selectors _ theSelectors. self on: #mouseEnter send: #handleMouseEnter to: self; on: #mouseLeave send: #handleMouseLeave to: self; on: #mouseDown send: #handleMouseDown to: self; on: #mouseUp send: #handleMouseUp to: self; drawStateInit.! ! !CGUIIconedButtonMorph methodsFor: 'event handling' stamp: 'chbu 11/3/2002 20:36'! handleMouseDown self drawStatePassive.! ! !CGUIIconedButtonMorph methodsFor: 'event handling' stamp: 'chbu 11/3/2002 20:36'! handleMouseEnter self drawStateFocused.! ! !CGUIIconedButtonMorph methodsFor: 'event handling' stamp: 'chbu 11/3/2002 20:36'! handleMouseLeave self drawStateFocusedNot.! ! !CGUIIconedButtonMorph methodsFor: 'event handling' stamp: 'chbu 11/3/2002 20:36'! handleMouseUp | toggle | toggle _ selectors at: 1. (model ~~ nil and: [toggle ~~ nil]) ifTrue: [model perform: toggle]. self drawStateFocusedNot; drawStatePassiveNot.! ! !CGUIIconedButtonMorph methodsFor: 'drawing' stamp: 'chbu 11/3/2002 20:36'! drawStateFocused self borderColor: ( Color gray ).! ! !CGUIIconedButtonMorph methodsFor: 'drawing' stamp: 'chbu 11/3/2002 20:36'! drawStateFocusedNot self borderColor: ( Color black ).! ! !CGUIIconedButtonMorph methodsFor: 'drawing' stamp: 'chbu 11/3/2002 21:10'! 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.! ! !CGUIIconedButtonMorph methodsFor: 'drawing' stamp: 'chbu 11/3/2002 20:36'! drawStatePassive | label | self borderColor: ( Color lightGray ). label _ self submorphNamed: #label. label ifNotNilDo: [ :theLabel | theLabel color: ( Color lightGray ) ].! ! !CGUIIconedButtonMorph methodsFor: 'drawing' stamp: 'chbu 11/3/2002 20:36'! drawStatePassiveNot | label | self borderColor: ( Color black ). label _ self submorphNamed: #label. label ifNotNilDo: [ :theLabel | theLabel color: ( Color black ) ].! ! !CGUIIconedButtonMorph methodsFor: 'accessing' stamp: 'chbu 11/3/2002 21:11'! icon: aFile | icon | " delete the old Icon " (self submorphNamed: #icon) ifNotNilDo: [:oldIcon | oldIcon delete]. " set up the new Icon " icon _ ImageMorph new image: (ImageReadWriter formFromFileNamed: aFile). icon name: #icon. self addMorph: icon; extent: self nominalExtent; drawStateInit. icon center: self center.! ! !CGUIIconedButtonMorph methodsFor: 'private' stamp: 'chbu 11/3/2002 21:08'! nominalExtent | icon | icon _ self submorphNamed: #icon. icon ifNil: [^ 40 @ 20]. ^ (icon width + 10)@(icon height + 10).! ! !CGUIIconedButtonMorph class methodsFor: 'class initialization' stamp: 'chbu 11/3/2002 20:40'! example | button | button _ self onModel: Transcript withSelectors: #(#open). button icon: 'icon.gif'. self currentWorld addMorphFront: button. button position: 10@10.! ! !CGUIIconedButtonMorph class methodsFor: 'class initialization' stamp: 'chbu 11/3/2002 20:36'! onModel: theModel withSelectors: theSelectors " theModel is usually something like a Application. theSelectors is a Collection containing Selectors in the following order: - #actionSelector: this sends the Selector to the Model. " ^self new onModel: theModel withSelectors: theSelectors.! ! !CGUILabelModel methodsFor: 'as yet unclassified' stamp: 'chbu 11/3/2002 17:58'! text ^label.! ! !CGUILabelModel methodsFor: 'as yet unclassified' stamp: 'chbu 11/3/2002 18:00'! text: aText label _ aText. self trigger: #labelChanged.! ! !CGUILabelMorph methodsFor: 'initialization' stamp: 'chbu 11/3/2002 17:31'! onModel: theModel withSelectors: theSelectors super initialize. model _ theModel. selectors _ theSelectors. model when: #labelChanged send: #labelChanged to: self. self contents: (model perform: (selectors at: 1)).! ! !CGUILabelMorph methodsFor: 'event handling' stamp: 'chbu 11/3/2002 18:02'! labelChanged self contents: (model perform: (selectors at: 1)).! ! !CGUILabelMorph class methodsFor: 'class initialization' stamp: 'chbu 11/3/2002 18:57'! example | model label | model _ CGUILabelModel new text: 'Hello World!!'. label _ self onModel: model withSelectors: #(#text). self currentWorld addMorphFront: label. label position: 10@10.! ! !CGUILabelMorph class methodsFor: 'class initialization' stamp: 'chbu 11/3/2002 18:57'! onModel: theModel withSelectors: theSelectors " theModel is usually something like a String or a Stream. theSelectors is a Collection containing Selectors in the following order: - #getLabelSelector this has to return the Label as String. " ^self new onModel: theModel withSelectors: theSelectors.! ! !CGUILabeledButtonMorph methodsFor: 'initialization' stamp: 'chbu 11/3/2002 19:47'! onModel: theModel withSelectors: theSelectors super initialize. model _ theModel. selectors _ theSelectors. self on: #mouseEnter send: #handleMouseEnter to: self; on: #mouseLeave send: #handleMouseLeave to: self; on: #mouseDown send: #handleMouseDown to: self; on: #mouseUp send: #handleMouseUp to: self; drawStateInit.! ! !CGUILabeledButtonMorph methodsFor: 'event handling' stamp: 'chbu 11/3/2002 19:37'! handleMouseDown self drawStatePassive.! ! !CGUILabeledButtonMorph methodsFor: 'event handling' stamp: 'chbu 11/3/2002 19:37'! handleMouseEnter self drawStateFocused.! ! !CGUILabeledButtonMorph methodsFor: 'event handling' stamp: 'chbu 11/3/2002 19:37'! handleMouseLeave self drawStateFocusedNot.! ! !CGUILabeledButtonMorph methodsFor: 'event handling' stamp: 'chbu 11/3/2002 19:43'! handleMouseUp | toggle | toggle _ selectors at: 1. (model ~~ nil and: [toggle ~~ nil]) ifTrue: [model perform: toggle]. self drawStateFocusedNot; drawStatePassiveNot.! ! !CGUILabeledButtonMorph methodsFor: 'drawing' stamp: 'chbu 11/3/2002 19:37'! drawStateFocused self borderColor: ( Color gray ).! ! !CGUILabeledButtonMorph methodsFor: 'drawing' stamp: 'chbu 11/3/2002 19:37'! drawStateFocusedNot self borderColor: ( Color black ).! ! !CGUILabeledButtonMorph methodsFor: 'drawing' stamp: 'chbu 11/3/2002 19:45'! 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@10; radial: false. self borderWidth: 1; borderColor: ( Color black); color: ( Color r: 0.95 g: 0.95 b: 0.95 ); fillStyle: fill.! ! !CGUILabeledButtonMorph methodsFor: 'drawing' stamp: 'chbu 11/3/2002 19:49'! drawStatePassive | label | self borderColor: ( Color lightGray ). label _ self submorphNamed: #label. label ifNotNilDo: [ :theLabel | theLabel color: ( Color lightGray ) ].! ! !CGUILabeledButtonMorph methodsFor: 'drawing' stamp: 'chbu 11/3/2002 19:49'! drawStatePassiveNot | label | self borderColor: ( Color black ). label _ self submorphNamed: #label. label ifNotNilDo: [ :theLabel | theLabel color: ( Color black ) ].! ! !CGUILabeledButtonMorph methodsFor: 'accessing' stamp: 'chbu 11/3/2002 21:05'! label: aLabel | label | " delete the old Label " (self submorphNamed: #label) ifNotNilDo: [:oldLabel | oldLabel delete]. " set up the new Label " label _ StringMorph contents: aLabel. label name: #label; lock. self addMorph: label; extent: self nominalExtent. label center: self center.! ! !CGUILabeledButtonMorph methodsFor: 'private' stamp: 'chbu 11/3/2002 20:18'! nominalExtent | labelString | labelString _ self submorphNamed: #label. labelString ifNil: [^ 40 @ 20]. ^ labelString width + 20 @ 20.! ! !CGUILabeledButtonMorph class methodsFor: 'class initialization' stamp: 'chbu 11/3/2002 20:41'! example | button | button _ self onModel: Transcript withSelectors: #(#open). button label: 'Open a new Transcript'. self currentWorld addMorphFront: button. button position: 10@10.! ! !CGUILabeledButtonMorph class methodsFor: 'class initialization' stamp: 'chbu 11/3/2002 19:38'! onModel: theModel withSelectors: theSelectors " theModel is usually something like a Application. theSelectors is a Collection containing Selectors in the following order: - #actionSelector: this sends the Selector to the Model. " ^self new onModel: theModel withSelectors: theSelectors.! ! CGUILabeledButtonMorph removeSelector: #drawStateChecked! CGUILabeledButtonMorph removeSelector: #drawStateCheckedNot! CGUILabeledButtonMorph removeSelector: #icon:! CGUILabeledButtonMorph removeSelector: #updateMyOwnLook! CGUIIconedButtonMorph removeSelector: #label:! CGUICheckboxMorph removeSelector: #boolChanged! CGUICheckboxMorph removeSelector: #labelChanged!