home *** CD-ROM | disk | FTP | other *** search
/ European Smalltalk User Group 2004 September / esugcd.iso / Books-Tutorial-Lectures / Books / FreeBooks / GuzdialBookDrafts / CRCmorphs.cs < prev    next >
Encoding:
Text File  |  2003-03-31  |  6.1 KB  |  197 lines
  1.  
  2. 'From Squeak 2.5 of August 6, 1999 on 15 September 1999 at 4:28:30 pm'!
  3. "Change Set:        CRCCard
  4. Date:            10 April 1999
  5. Author:            Mark Guzdial and Lex Spoon
  6.  
  7. A basic CRC Card and morphic interface."!
  8.  
  9. BorderedMorph subclass: #GridMorph
  10.     instanceVariableNames: 'paneMorphs paneRects '
  11.     classVariableNames: ''
  12.     poolDictionaries: ''
  13.     category: 'Morphic-Windows'!
  14. GridMorph subclass: #LabelledGridMorph
  15.     instanceVariableNames: 'labelMorph labelBorderMorph '
  16.     classVariableNames: ''
  17.     poolDictionaries: ''
  18.     category: 'Morphic-Windows'!
  19. LabelledGridMorph subclass: #CRCCard
  20.     instanceVariableNames: 'classname responsibilities collaborators '
  21.     classVariableNames: ''
  22.     poolDictionaries: ''
  23.     category: 'Morphic-Windows'!
  24.  
  25. !GridMorph commentStamp: '<historical>' prior: 0!
  26. Lays out objects in a grid, like SystemWindows do.!
  27.  
  28. !GridMorph methodsFor: 'as yet unclassified' stamp: 'ls 4/10/1999 15:00'!
  29. addMorph: aMorph frame: relFrame
  30.  
  31.     self addMorph: aMorph.
  32.     paneMorphs _ paneMorphs copyReplaceFrom: 1 to: 0 with: (Array with: aMorph).
  33.     paneRects _ paneRects copyReplaceFrom: 1 to: 0 with: (Array with: relFrame).
  34.  
  35.     aMorph borderWidth: 1; borderColor: Color black;
  36.         bounds: ((relFrame scaleBy: self paneArea extent) translateBy: self paneArea topLeft) truncated.
  37. ! !
  38.  
  39. !GridMorph methodsFor: 'as yet unclassified' stamp: 'ls 4/10/1999 14:44'!
  40. extent: newExtent
  41.     super extent: newExtent.
  42.     self setBoundsOfPaneMorphs.! !
  43.  
  44. !GridMorph methodsFor: 'as yet unclassified' stamp: 'ls 4/10/1999 14:47'!
  45. initialize
  46.     super initialize.
  47.  
  48.     paneMorphs _ #().
  49.     paneRects _ #().
  50.  
  51.     self color: Color white.
  52.     self extent: 300@200.
  53. ! !
  54.  
  55. !GridMorph methodsFor: 'as yet unclassified' stamp: 'ls 4/10/1999 14:47'!
  56. paneArea
  57.     "return the bounds where panes are to be placed"
  58.     ^self bounds! !
  59.  
  60. !GridMorph methodsFor: 'as yet unclassified' stamp: 'ls 4/10/1999 14:46'!
  61. setBoundsOfPaneMorphs
  62.     | paneArea |
  63.     paneArea _ self paneArea.
  64.  
  65.     paneMorphs with: paneRects do:
  66.         [:m :frame |
  67.         m bounds: (((frame scaleBy: paneArea extent) translateBy: paneArea topLeft)) truncated]! !
  68.  
  69.  
  70. !LabelledGridMorph commentStamp: '<historical>' prior: 0!
  71. A lot like a system window, except it doesn't do expand/contract, and it doesn't have a notion of the "active" window!
  72.  
  73. !LabelledGridMorph methodsFor: 'as yet unclassified' stamp: 'ls 4/10/1999 15:02'!
  74. extent: newExtent
  75.     super extent: newExtent.
  76.     self recenterLabel.! !
  77.  
  78. !LabelledGridMorph methodsFor: 'as yet unclassified' stamp: 'ls 4/10/1999 15:13'!
  79. initialize
  80.     labelMorph _ StringMorph new contents: ''.
  81.     labelBorderMorph _ RectangleMorph new.
  82.     labelBorderMorph color: Color white; borderWidth: 2.
  83.  
  84.     super initialize.
  85.  
  86.  
  87.     self addMorph: labelBorderMorph.
  88.     labelBorderMorph addMorph: labelMorph.! !
  89.  
  90. !LabelledGridMorph methodsFor: 'as yet unclassified' stamp: 'ls 4/10/1999 15:06'!
  91. label: aStringOrText
  92.     labelMorph contents: aStringOrText.
  93.     self recenterLabel.! !
  94.  
  95. !LabelledGridMorph methodsFor: 'as yet unclassified' stamp: 'ls 4/10/1999 15:13'!
  96. paneArea
  97.     ^self bounds  withTop: (self bounds top + labelMorph height + 6)! !
  98.  
  99. !LabelledGridMorph methodsFor: 'as yet unclassified' stamp: 'ls 4/10/1999 15:13'!
  100. recenterLabel
  101.     labelBorderMorph extent: (self width @ (labelMorph height + 6)).
  102.     labelMorph position: (
  103.         labelBorderMorph position + (3@3) + 
  104.         ((labelBorderMorph width - labelMorph width / 2 max: 0) @ 0)
  105.     ) truncated.! !
  106.  
  107. Smalltalk renameClassNamed: #CRCWindow as: #CRCCard!
  108.  
  109. !CRCCard methodsFor: 'all' stamp: 'ls 4/10/1999 14:10'!
  110. className
  111.     ^classname! !
  112.  
  113. !CRCCard methodsFor: 'all' stamp: 'ls 4/10/1999 14:10'!
  114. className: aString
  115.     classname _ aString.
  116.     ^ true! !
  117.  
  118. !CRCCard methodsFor: 'all' stamp: 'mjg 9/25/1998 16:00'!
  119. collaborators
  120.     ^collaborators! !
  121.  
  122. !CRCCard methodsFor: 'all' stamp: 'mjg 9/25/1998 16:26'!
  123. collaborators: aString
  124.     collaborators _ aString.
  125.     ^true! !
  126.  
  127. !CRCCard methodsFor: 'all' stamp: 'ls 4/10/1999 13:51'!
  128. initialExtent
  129.     ^360@230! !
  130.  
  131. !CRCCard methodsFor: 'all' stamp: 'mjg 9/15/1999 16:22'!
  132. initialize
  133.     ^self openAsMorph
  134. ! !
  135.  
  136. !CRCCard methodsFor: 'all' stamp: 'ls 4/10/1999 15:37'!
  137. openAsMorph
  138.     "open a set of windows for viewing this browser"
  139.     |win  |
  140.     "create a window for it"
  141.     win _ LabelledGridMorph new.
  142.     win label: 'CRC Card'.
  143.  
  144.     "create a class view"
  145.     win addMorph: (TextComponent new setText: 'Class:') frame: (0.0@0.0 extent: 0.2@0.1).
  146.     win addMorph: (PluggableTextMorph on: self text: #className accept: #className:) frame: (0.2@0.0 extent: 0.8@0.1).
  147.  
  148.     "create a Responsibilities frame"
  149.     win addMorph: (TextComponent new setText: 'Responsibilities:') frame: (0.0@0.1 extent: 0.5@0.10).
  150.     win addMorph: (PluggableTextMorph on: self text: #responsibilities accept: #responsibilities:) frame: (0.0@0.20 extent: 0.5@0.80).
  151.  
  152.     "create a Collaborators frame"
  153.     win addMorph: (TextComponent new setText: 'Collaborators:') frame: (0.5@0.10 extent: 0.5@0.10).
  154.     win addMorph: (PluggableTextMorph on: self text: #collaborators accept: #collaborators:) frame: (0.5@0.20 extent: 0.5@0.80).
  155.  
  156.     
  157.     win openInWorld.
  158.     ^win! !
  159.  
  160. !CRCCard methodsFor: 'all' stamp: 'ls 4/10/1999 15:28'!
  161. openAsMorphOrig
  162.     "(Mark's original version, using SystemWindow)"
  163.     "open a set of windows for viewing this browser"
  164.     |win  |
  165.     "create a window for it"
  166.     win _ SystemWindow labelled: 'CRC'.
  167.     win model: self.
  168.     "create a class view"
  169.     win addMorph: (TextComponent new setText: 'Class:') frame: (0.0@0.0 extent: 0.10@0.1).
  170.     win addMorph: (PluggableTextMorph on: self text: #className accept: #className:) frame: (0.10@0.0 extent: 0.90@0.1).
  171.  
  172.     "create a Responsibilities frame"
  173.     win addMorph: (TextComponent new setText: 'Responsibilities:') frame: (0.0@0.1 extent: 0.5@0.10).
  174.     win addMorph: (PluggableTextMorph on: self text: #responsibilities accept: #responsibilities:) frame: (0.0@0.20 extent: 0.5@0.80).
  175.  
  176.     "create a Collaborators frame"
  177.     win addMorph: (TextComponent new setText: 'Collaborators:') frame: (0.5@0.10 extent: 0.5@0.10).
  178.     win addMorph: (PluggableTextMorph on: self text: #collaborators accept: #collaborators:) frame: (0.5@0.20 extent: 0.5@0.80).
  179.  
  180.     
  181.     win openInWorld.
  182.     ^win! !
  183.  
  184. !CRCCard methodsFor: 'all' stamp: 'mjg 9/25/1998 16:00'!
  185. responsibilities
  186.     ^responsibilities! !
  187.  
  188. !CRCCard methodsFor: 'all' stamp: 'mjg 9/25/1998 16:26'!
  189. responsibilities: aString
  190.     responsibilities _ aString.
  191.     ^true! !
  192.  
  193.  
  194. CRCCard removeSelector: #class!
  195. CRCCard removeSelector: #class:!
  196.  
  197.