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