'From Squeak 2.5 of August 6, 1999 on 15 September 1999 at 4:28:30 pm'! "Change Set: CRCCard Date: 10 April 1999 Author: Mark Guzdial and Lex Spoon A basic CRC Card and morphic interface."! BorderedMorph subclass: #GridMorph instanceVariableNames: 'paneMorphs paneRects ' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Windows'! GridMorph subclass: #LabelledGridMorph instanceVariableNames: 'labelMorph labelBorderMorph ' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Windows'! LabelledGridMorph subclass: #CRCCard instanceVariableNames: 'classname responsibilities collaborators ' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Windows'! !GridMorph commentStamp: '' prior: 0! Lays out objects in a grid, like SystemWindows do.! !GridMorph methodsFor: 'as yet unclassified' stamp: 'ls 4/10/1999 15:00'! addMorph: aMorph frame: relFrame self addMorph: aMorph. paneMorphs _ paneMorphs copyReplaceFrom: 1 to: 0 with: (Array with: aMorph). paneRects _ paneRects copyReplaceFrom: 1 to: 0 with: (Array with: relFrame). aMorph borderWidth: 1; borderColor: Color black; bounds: ((relFrame scaleBy: self paneArea extent) translateBy: self paneArea topLeft) truncated. ! ! !GridMorph methodsFor: 'as yet unclassified' stamp: 'ls 4/10/1999 14:44'! extent: newExtent super extent: newExtent. self setBoundsOfPaneMorphs.! ! !GridMorph methodsFor: 'as yet unclassified' stamp: 'ls 4/10/1999 14:47'! initialize super initialize. paneMorphs _ #(). paneRects _ #(). self color: Color white. self extent: 300@200. ! ! !GridMorph methodsFor: 'as yet unclassified' stamp: 'ls 4/10/1999 14:47'! paneArea "return the bounds where panes are to be placed" ^self bounds! ! !GridMorph methodsFor: 'as yet unclassified' stamp: 'ls 4/10/1999 14:46'! setBoundsOfPaneMorphs | paneArea | paneArea _ self paneArea. paneMorphs with: paneRects do: [:m :frame | m bounds: (((frame scaleBy: paneArea extent) translateBy: paneArea topLeft)) truncated]! ! !LabelledGridMorph commentStamp: '' prior: 0! A lot like a system window, except it doesn't do expand/contract, and it doesn't have a notion of the "active" window! !LabelledGridMorph methodsFor: 'as yet unclassified' stamp: 'ls 4/10/1999 15:02'! extent: newExtent super extent: newExtent. self recenterLabel.! ! !LabelledGridMorph methodsFor: 'as yet unclassified' stamp: 'ls 4/10/1999 15:13'! initialize labelMorph _ StringMorph new contents: ''. labelBorderMorph _ RectangleMorph new. labelBorderMorph color: Color white; borderWidth: 2. super initialize. self addMorph: labelBorderMorph. labelBorderMorph addMorph: labelMorph.! ! !LabelledGridMorph methodsFor: 'as yet unclassified' stamp: 'ls 4/10/1999 15:06'! label: aStringOrText labelMorph contents: aStringOrText. self recenterLabel.! ! !LabelledGridMorph methodsFor: 'as yet unclassified' stamp: 'ls 4/10/1999 15:13'! paneArea ^self bounds withTop: (self bounds top + labelMorph height + 6)! ! !LabelledGridMorph methodsFor: 'as yet unclassified' stamp: 'ls 4/10/1999 15:13'! recenterLabel labelBorderMorph extent: (self width @ (labelMorph height + 6)). labelMorph position: ( labelBorderMorph position + (3@3) + ((labelBorderMorph width - labelMorph width / 2 max: 0) @ 0) ) truncated.! ! Smalltalk renameClassNamed: #CRCWindow as: #CRCCard! !CRCCard methodsFor: 'all' stamp: 'ls 4/10/1999 14:10'! className ^classname! ! !CRCCard methodsFor: 'all' stamp: 'ls 4/10/1999 14:10'! className: aString classname _ aString. ^ true! ! !CRCCard methodsFor: 'all' stamp: 'mjg 9/25/1998 16:00'! collaborators ^collaborators! ! !CRCCard methodsFor: 'all' stamp: 'mjg 9/25/1998 16:26'! collaborators: aString collaborators _ aString. ^true! ! !CRCCard methodsFor: 'all' stamp: 'ls 4/10/1999 13:51'! initialExtent ^360@230! ! !CRCCard methodsFor: 'all' stamp: 'mjg 9/15/1999 16:22'! initialize ^self openAsMorph ! ! !CRCCard methodsFor: 'all' stamp: 'ls 4/10/1999 15:37'! openAsMorph "open a set of windows for viewing this browser" |win | "create a window for it" win _ LabelledGridMorph new. win label: 'CRC Card'. "create a class view" win addMorph: (TextComponent new setText: 'Class:') frame: (0.0@0.0 extent: 0.2@0.1). win addMorph: (PluggableTextMorph on: self text: #className accept: #className:) frame: (0.2@0.0 extent: 0.8@0.1). "create a Responsibilities frame" win addMorph: (TextComponent new setText: 'Responsibilities:') frame: (0.0@0.1 extent: 0.5@0.10). win addMorph: (PluggableTextMorph on: self text: #responsibilities accept: #responsibilities:) frame: (0.0@0.20 extent: 0.5@0.80). "create a Collaborators frame" win addMorph: (TextComponent new setText: 'Collaborators:') frame: (0.5@0.10 extent: 0.5@0.10). win addMorph: (PluggableTextMorph on: self text: #collaborators accept: #collaborators:) frame: (0.5@0.20 extent: 0.5@0.80). win openInWorld. ^win! ! !CRCCard methodsFor: 'all' stamp: 'ls 4/10/1999 15:28'! openAsMorphOrig "(Mark's original version, using SystemWindow)" "open a set of windows for viewing this browser" |win | "create a window for it" win _ SystemWindow labelled: 'CRC'. win model: self. "create a class view" win addMorph: (TextComponent new setText: 'Class:') frame: (0.0@0.0 extent: 0.10@0.1). win addMorph: (PluggableTextMorph on: self text: #className accept: #className:) frame: (0.10@0.0 extent: 0.90@0.1). "create a Responsibilities frame" win addMorph: (TextComponent new setText: 'Responsibilities:') frame: (0.0@0.1 extent: 0.5@0.10). win addMorph: (PluggableTextMorph on: self text: #responsibilities accept: #responsibilities:) frame: (0.0@0.20 extent: 0.5@0.80). "create a Collaborators frame" win addMorph: (TextComponent new setText: 'Collaborators:') frame: (0.5@0.10 extent: 0.5@0.10). win addMorph: (PluggableTextMorph on: self text: #collaborators accept: #collaborators:) frame: (0.5@0.20 extent: 0.5@0.80). win openInWorld. ^win! ! !CRCCard methodsFor: 'all' stamp: 'mjg 9/25/1998 16:00'! responsibilities ^responsibilities! ! !CRCCard methodsFor: 'all' stamp: 'mjg 9/25/1998 16:26'! responsibilities: aString responsibilities _ aString. ^true! ! CRCCard removeSelector: #class! CRCCard removeSelector: #class:!