home *** CD-ROM | disk | FTP | other *** search
/ European Smalltalk User Group 2004 September / esugcd.iso / Books-Tutorial-Lectures / Books / FreeBooks / GuzdialBookDrafts / Boxes.st next >
Text File  |  2003-03-31  |  3KB  |  132 lines
  1.  
  2. Object subclass: #Box
  3.     instanceVariableNames: 'position size tilt '
  4.     classVariableNames: ''
  5.     poolDictionaries: ''
  6.     category: 'Boxes'!
  7.  
  8. !Box methodsFor: 'drawing' stamp: 'mjg 9/14/1998 15:38'!
  9. draw
  10.     | myPen |
  11.     myPen _ Pen new.
  12.     myPen up.
  13.     myPen goto: position.
  14.     myPen turn: tilt.
  15.     myPen color: (Color black).
  16.     myPen down.
  17.     4 timesRepeat: [myPen go: size; turn: 90].
  18. ! !
  19.  
  20. !Box methodsFor: 'drawing' stamp: 'mjg 3/27/98 22:02'!
  21. grow: increment
  22.     self undraw.
  23.     size _ size + increment.
  24.     self draw.
  25. ! !
  26.  
  27. !Box methodsFor: 'drawing' stamp: 'mjg 3/27/98 22:02'!
  28. move: pointIncrement
  29.     self undraw.
  30.     position _ position + pointIncrement.
  31.     self draw.
  32. ! !
  33.  
  34. !Box methodsFor: 'drawing' stamp: 'mjg 3/30/98 15:21'!
  35. moveTo: aPoint
  36.     self undraw.
  37.     position _ aPoint.
  38.     self draw.
  39. ! !
  40.  
  41. !Box methodsFor: 'drawing' stamp: 'mjg 3/27/98 22:01'!
  42. turn: degrees
  43.     self undraw.
  44.     tilt _ tilt + degrees.
  45.     self draw.
  46. ! !
  47.  
  48. !Box methodsFor: 'drawing' stamp: 'mjg 9/14/1998 15:50'!
  49. undraw
  50.     | myPen |
  51.     myPen _ Pen new.
  52.     myPen up.
  53.     myPen goto: position.
  54.     myPen turn: tilt.
  55.     myPen color: (Color white).
  56.     myPen down.
  57.     4 timesRepeat: [myPen go: size; turn: 90].
  58. ! !
  59.  
  60.  
  61. !Box methodsFor: 'initialization' stamp: 'mjg 3/27/98 22:04'!
  62. initialize
  63.     position _ 50@50.
  64.     size _ 50.
  65.     tilt _ 0.
  66.     self draw.
  67. ! !
  68.  
  69. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  70.  
  71. Box class
  72.     instanceVariableNames: ''!
  73.  
  74. !Box class methodsFor: 'initialization' stamp: 'mjg 3/27/98 21:54'!
  75. clearWorld
  76. (Form extent: 600@200) fillWhite display! !
  77.  
  78. !Box class methodsFor: 'initialization' stamp: 'mjg 3/27/98 21:55'!
  79. new
  80.     ^super new initialize! !
  81.  
  82.  
  83.  
  84. Box subclass: #NamedBox
  85.     instanceVariableNames: 'name '
  86.     classVariableNames: ''
  87.     poolDictionaries: ''
  88.     category: 'Boxes'!
  89.  
  90. !NamedBox methodsFor: 'access' stamp: 'mjg 3/30/98 15:17'!
  91. name
  92.     ^name! !
  93.  
  94. !NamedBox methodsFor: 'access' stamp: 'mjg 3/30/98 15:16'!
  95. name: aName
  96.     name _ aName! !
  97.  
  98.  
  99. !NamedBox methodsFor: 'drawing' stamp: 'mjg 3/30/98 15:54'!
  100. draw
  101.     super draw.
  102.     self drawNameColor: (Color black).! !
  103.  
  104. !NamedBox methodsFor: 'drawing' stamp: 'mjg 3/30/98 15:19'!
  105. drawNameColor: aColor
  106.     | displayName |
  107.     (name isNil) ifTrue: [name _ 'Unnamed'].
  108.     displayName _ name asDisplayText.
  109.     displayName foregroundColor: aColor backgroundColor: (Color white).
  110.     displayName displayAt: position.
  111. ! !
  112.  
  113. !NamedBox methodsFor: 'drawing' stamp: 'mjg 3/30/98 15:54'!
  114. undraw
  115.     super undraw.
  116.     self drawNameColor: (Color white).! !
  117.  
  118. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  119.  
  120. NamedBox class
  121.     instanceVariableNames: ''!
  122.  
  123. !NamedBox class methodsFor: 'initialization' stamp: 'mjg 3/30/98 15:19'!
  124. named: aName
  125.     | newBox |
  126.     newBox _ super new.
  127.     newBox undraw.
  128.     newBox name: aName.
  129.     newBox draw.
  130.     ^newBox! !
  131.  
  132.