home *** CD-ROM | disk | FTP | other *** search
/ BURKS 2 / BURKS_AUG97.ISO / BURKS / LANGUAGE / SMALTALK / TEXTBOOK / AP23.ST (.txt) < prev    next >
Text File  |  1997-04-22  |  24KB  |  816 lines
  1.  
  2. 'Smalltalk Textbook Appendix 23'!
  3.  
  4.  
  5.  
  6.  
  7.  
  8. Object subclass: #EngiLauncherIcon
  9.     instanceVariableNames: 'extent title image action '
  10.     classVariableNames: ''
  11.     poolDictionaries: ''
  12.     category: 'Engi-Launcher'!
  13. EngiLauncherIcon comment:
  14. '
  15.  
  16. Engi 0.07 (24 March 1994)
  17. Copyright (C) 1994 by Atsushi Aoki
  18.  
  19. '!
  20.  
  21.  
  22. !EngiLauncherIcon methodsFor: 'accessing'!
  23.  
  24. action
  25.     ^action!
  26.  
  27. action: aString 
  28.     action := aString!
  29.  
  30. extent
  31.     ^extent!
  32.  
  33. extent: sizePoint 
  34.     extent := sizePoint!
  35.  
  36. image
  37.     ^image!
  38.  
  39. image: anImage 
  40.     image := self makeIconFrom: anImage!
  41.  
  42. title
  43.     ^title!
  44.  
  45. title: aString 
  46.     title := aString! !
  47.  
  48. !EngiLauncherIcon methodsFor: 'evaluating'!
  49.  
  50. evaluate
  51.     self action isNil ifTrue: [^nil].
  52.     ^Compiler
  53.         evaluate: self action
  54.         for: self
  55.         logged: false! !
  56.  
  57. !EngiLauncherIcon methodsFor: 'displaying'!
  58.  
  59. displayBlock
  60.     ^[:gc :p | self image notNil ifTrue: [self image displayOn: gc at: p]]! !
  61.  
  62. !EngiLauncherIcon methodsFor: 'private'!
  63.  
  64. makeIconFrom: anImage 
  65.     | iconImage xRatio yRatio aPixmap blockClosure graphicsContext aPoint aRectangle |
  66.     self extent = anImage bounds extent
  67.         ifTrue: [iconImage := anImage]
  68.         ifFalse: 
  69.             [xRatio := (anImage bounds width / self extent x) asFloat.
  70.             yRatio := (anImage bounds height / self extent y) asFloat.
  71.             iconImage := anImage shrunkenBy: xRatio @ yRatio].
  72.     aPixmap := Pixmap extent: self extent.
  73.     blockClosure := 
  74.             [aPixmap background: (ColorValue brightness: 0.5).
  75.             aPixmap clear.
  76.             graphicsContext := aPixmap graphicsContext.
  77.             aPoint := aPixmap bounds center - iconImage bounds center.
  78.             iconImage displayOn: graphicsContext at: aPoint.
  79.             aRectangle := aPixmap bounds insetBy: (0 @ 0 corner: 1 @ 1).
  80.             graphicsContext paint: (ColorValue brightness: 0.10).
  81.             graphicsContext displayLineFrom: aRectangle bottomLeft to: aRectangle bottomRight.
  82.             graphicsContext displayLineFrom: aRectangle topRight to: aRectangle bottomRight.
  83.             graphicsContext paint: (ColorValue brightness: 0.90).
  84.             graphicsContext displayLineFrom: aRectangle topLeft to: aRectangle topRight.
  85.             graphicsContext displayLineFrom: aRectangle topLeft to: aRectangle bottomLeft.
  86.             aRectangle := aRectangle insetBy: (1 @ 1 corner: 1 @ 1).
  87.             graphicsContext paint: (ColorValue brightness: 0.25).
  88.             graphicsContext displayLineFrom: aRectangle bottomLeft to: aRectangle bottomRight.
  89.             graphicsContext displayLineFrom: aRectangle topRight to: aRectangle bottomRight.
  90.             graphicsContext paint: (ColorValue brightness: 0.75).
  91.             graphicsContext displayLineFrom: aRectangle topLeft to: aRectangle topRight.
  92.             graphicsContext displayLineFrom: aRectangle topLeft to: aRectangle bottomLeft.
  93.             iconImage := aPixmap asImage].
  94.     [blockClosure value]
  95.         valueNowOrOnUnwindDo: [aPixmap close].
  96.     ^iconImage! !
  97. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  98.  
  99. EngiLauncherIcon class
  100.     instanceVariableNames: ''!
  101.  
  102.  
  103. !EngiLauncherIcon class methodsFor: 'instance creation'!
  104.  
  105. extent: sizePoint title: titleString image: anImage action: actionString 
  106.     | icon pixmap block text gc point image |
  107.     anImage isNil
  108.         ifTrue: 
  109.             [pixmap := Pixmap extent: sizePoint.
  110.             block := 
  111.                     [(self backgroundImage: sizePoint)
  112.                         displayOn: pixmap graphicsContext at: Point zero.
  113.                     text := ComposedText
  114.                                 withText: titleString asText
  115.                                 style: TextAttributes default
  116.                                 compositionWidth: sizePoint x - 6.
  117.                     text centered.
  118.                     gc := pixmap graphicsContext.
  119.                     gc paint: (ColorValue
  120.                             red: 0.0
  121.                             green: 0.166646
  122.                             blue: 0.0).
  123.                     point := pixmap bounds center - text bounds center.
  124.                     text displayOn: gc at: point.
  125.                     image := pixmap asImage].
  126.             [block value]
  127.                 valueNowOrOnUnwindDo: [pixmap close]]
  128.         ifFalse: [image := anImage].
  129.     icon := super new.
  130.     icon extent: sizePoint.
  131.     icon title: titleString.
  132.     icon image: image.
  133.     icon action: actionString.
  134.     ^icon!
  135.  
  136. title: titleString image: anImage action: actionString 
  137.     ^self
  138.         extent: self defaultIconSize
  139.         title: titleString
  140.         image: anImage
  141.         action: actionString! !
  142.  
  143. !EngiLauncherIcon class methodsFor: 'defaults'!
  144.  
  145. defaultIconSize
  146.     ^50 @ 50! !
  147.  
  148. !EngiLauncherIcon class methodsFor: 'private'!
  149.  
  150. backgroundImage: extent 
  151.     "EngiDisplayModel openOn: (EngiLauncherIcon backgroundImage: 50@50)."
  152.  
  153.     | colors image |
  154.     colors := OrderedCollection new.
  155.     colors add: (ColorValue
  156.             red: 1.0
  157.             green: 1.0
  158.             blue: 0.833354).
  159.     colors add: (ColorValue
  160.             red: 0.833354
  161.             green: 1.0
  162.             blue: 0.833354).
  163.     colors add: (ColorValue
  164.             red: 0.833354
  165.             green: 1.0
  166.             blue: 1.0).
  167.     image := Image
  168.                 extent: extent
  169.                 depth: Screen default colorPalette depth
  170.                 palette: Screen default colorPalette.
  171.     ^self
  172.         gradation: image
  173.         palette: (MappedPalette withColors: colors)
  174.         origin: image bounds center
  175.         deviation: 0.5
  176.         figure: true!
  177.  
  178. gradation: anImage palette: aPalette origin: aPoint deviation: aNumber figure: aBoolean 
  179.     "
  180.     | colors image | 
  181.     colors := OrderedCollection new. 
  182.     colors add: ColorValue white. 
  183.     colors add: ColorValue gray. 
  184.     colors add: ColorValue black. 
  185.     image := Image 
  186.             extent: 50@50 
  187.             depth: Screen default colorPalette depth 
  188.             palette: Screen default colorPalette. 
  189.     EngiLauncherIcon 
  190.             graduation: image 
  191.             palette: (MappedPalette withColors: colors) 
  192.             origin: image bounds center 
  193.             deviation: 0.2 
  194.             figure: true. 
  195.     EngiDisplayModel openOn: image 
  196.     "
  197.  
  198.     | random uniform condition normal distribution width height box point index color value |
  199.     random := Random new.
  200.     uniform := 
  201.             [| x |
  202.             x := random next.
  203.             -1.0 + (x * (1.0 - -1.0))].
  204.     normal := 
  205.             [:mean :deviation | 
  206.             | v1 v2 s u |
  207.             condition := 
  208.                     [v1 := uniform value.
  209.                     v2 := uniform value.
  210.                     s := v1 squared + v2 squared.
  211.                     s >= 1].
  212.             condition whileTrue.
  213.             u := (-2.0 * s ln / s) sqrt.
  214.             mean + (deviation * v1 * u)].
  215.     distribution := 
  216.             [:x :y :p | 
  217.             | m |
  218.             aBoolean = true
  219.                 ifTrue: [m := (x - aPoint x) abs / p x max: (y - aPoint y) abs / p y]
  220.                 ifFalse: [m := (aPoint dist: x @ y)
  221.                                 / p r].
  222.             (normal value: m asFloat value: aNumber asFloat)
  223.                 * (aPalette size - 1)].
  224.     width := anImage width.
  225.     height := anImage height.
  226.     box := anImage bounds.
  227.     point := ((box left - aPoint x) abs max: (box right - aPoint x) abs)
  228.                 @ ((box top - aPoint y) abs max: (box bottom - aPoint y) abs).
  229.     0 to: width - 1 do: [:x | 0 to: height - 1
  230.             do: 
  231.                 [:y | 
  232.                 index := (distribution
  233.                             value: x
  234.                             value: y
  235.                             value: point) rounded.
  236.                 index := index min: aPalette size - 1.
  237.                 index := index max: 0.
  238.                 color := aPalette at: index.
  239.                 value := anImage palette indexOfPaintNearest: color.
  240.                 anImage
  241.                     atX: x
  242.                     y: y
  243.                     put: value]].
  244.     ^anImage! !
  245.  
  246. !EngiLauncherIcon class methodsFor: 'examples'!
  247.  
  248. example1
  249.     "EngiLauncherIcon example1."
  250.  
  251.     | anIcon |
  252.     anIcon := EngiLauncherIcon
  253.                 title: 'anonymous'
  254.                 image: Image fromUser
  255.                 action: 'Transcript cr; show: self title'.
  256.     anIcon evaluate.
  257.     ^anIcon!
  258.  
  259. example2
  260.     "EngiLauncherIcon example2."
  261.  
  262.     | anIcon activeWindow |
  263.     anIcon := EngiLauncherIcon
  264.                 title: 'anonymous'
  265.                 image: Image fromUser
  266.                 action: 'Transcript cr; show: self title'.
  267.     activeWindow := ScheduledControllers activeController view.
  268.     activeWindow clear.
  269.     anIcon displayBlock value: activeWindow graphicsContext value: 50 @ 50.
  270.     activeWindow sensor waitClickButton.
  271.     activeWindow display.
  272.     anIcon evaluate.
  273.     ^anIcon!
  274.  
  275. example3
  276.     "EngiLauncherIcon example3."
  277.  
  278.     | anIcon activeWindow |
  279.     anIcon := EngiLauncherIcon
  280.                 extent: 100 @ 30
  281.                 title: 'Browser'
  282.                 image: nil
  283.                 action: 'Browser open'.
  284.     activeWindow := ScheduledControllers activeController view.
  285.     activeWindow clear.
  286.     anIcon displayBlock value: activeWindow graphicsContext value: 50 @ 50.
  287.     activeWindow sensor waitClickButton.
  288.     activeWindow display.
  289.     anIcon evaluate.
  290.     ^anIcon! !
  291.  
  292.  
  293.  
  294.  
  295.  
  296. EngiDisplayView subclass: #EngiLauncherView
  297.     instanceVariableNames: 'popUp '
  298.     classVariableNames: ''
  299.     poolDictionaries: ''
  300.     category: 'Engi-Launcher'!
  301. EngiLauncherView comment:
  302. '
  303.  
  304. Engi 0.07 (24 March 1994)
  305. Copyright (C) 1994 by Atsushi Aoki
  306.  
  307. '!
  308.  
  309.  
  310. !EngiLauncherView methodsFor: 'accessing'!
  311.  
  312. popUp
  313.     ^popUp = true!
  314.  
  315. popUp: aBoolean 
  316.     popUp := aBoolean = true! !
  317.  
  318. !EngiLauncherView methodsFor: 'displaying'!
  319.  
  320. displayPressedArea: aRectangle 
  321.     | aBox graphicsContext |
  322.     graphicsContext := self graphicsContext