home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BURKS 2
/
BURKS_AUG97.ISO
/
BURKS
/
LANGUAGE
/
SMALTALK
/
TEXTBOOK
/
AP23.ST
(
.txt
)
< prev
next >
Wrap
Text File
|
1997-04-22
|
24KB
|
816 lines
'Smalltalk Textbook Appendix 23'!
Object subclass: #EngiLauncherIcon
instanceVariableNames: 'extent title image action '
classVariableNames: ''
poolDictionaries: ''
category: 'Engi-Launcher'!
EngiLauncherIcon comment:
'
Engi 0.07 (24 March 1994)
Copyright (C) 1994 by Atsushi Aoki
'!
!EngiLauncherIcon methodsFor: 'accessing'!
action
^action!
action: aString
action := aString!
extent
^extent!
extent: sizePoint
extent := sizePoint!
image
^image!
image: anImage
image := self makeIconFrom: anImage!
title
^title!
title: aString
title := aString! !
!EngiLauncherIcon methodsFor: 'evaluating'!
evaluate
self action isNil ifTrue: [^nil].
^Compiler
evaluate: self action
for: self
logged: false! !
!EngiLauncherIcon methodsFor: 'displaying'!
displayBlock
^[:gc :p | self image notNil ifTrue: [self image displayOn: gc at: p]]! !
!EngiLauncherIcon methodsFor: 'private'!
makeIconFrom: anImage
| iconImage xRatio yRatio aPixmap blockClosure graphicsContext aPoint aRectangle |
self extent = anImage bounds extent
ifTrue: [iconImage := anImage]
ifFalse:
[xRatio := (anImage bounds width / self extent x) asFloat.
yRatio := (anImage bounds height / self extent y) asFloat.
iconImage := anImage shrunkenBy: xRatio @ yRatio].
aPixmap := Pixmap extent: self extent.
blockClosure :=
[aPixmap background: (ColorValue brightness: 0.5).
aPixmap clear.
graphicsContext := aPixmap graphicsContext.
aPoint := aPixmap bounds center - iconImage bounds center.
iconImage displayOn: graphicsContext at: aPoint.
aRectangle := aPixmap bounds insetBy: (0 @ 0 corner: 1 @ 1).
graphicsContext paint: (ColorValue brightness: 0.10).
graphicsContext displayLineFrom: aRectangle bottomLeft to: aRectangle bottomRight.
graphicsContext displayLineFrom: aRectangle topRight to: aRectangle bottomRight.
graphicsContext paint: (ColorValue brightness: 0.90).
graphicsContext displayLineFrom: aRectangle topLeft to: aRectangle topRight.
graphicsContext displayLineFrom: aRectangle topLeft to: aRectangle bottomLeft.
aRectangle := aRectangle insetBy: (1 @ 1 corner: 1 @ 1).
graphicsContext paint: (ColorValue brightness: 0.25).
graphicsContext displayLineFrom: aRectangle bottomLeft to: aRectangle bottomRight.
graphicsContext displayLineFrom: aRectangle topRight to: aRectangle bottomRight.
graphicsContext paint: (ColorValue brightness: 0.75).
graphicsContext displayLineFrom: aRectangle topLeft to: aRectangle topRight.
graphicsContext displayLineFrom: aRectangle topLeft to: aRectangle bottomLeft.
iconImage := aPixmap asImage].
[blockClosure value]
valueNowOrOnUnwindDo: [aPixmap close].
^iconImage! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
EngiLauncherIcon class
instanceVariableNames: ''!
!EngiLauncherIcon class methodsFor: 'instance creation'!
extent: sizePoint title: titleString image: anImage action: actionString
| icon pixmap block text gc point image |
anImage isNil
ifTrue:
[pixmap := Pixmap extent: sizePoint.
block :=
[(self backgroundImage: sizePoint)
displayOn: pixmap graphicsContext at: Point zero.
text := ComposedText
withText: titleString asText
style: TextAttributes default
compositionWidth: sizePoint x - 6.
text centered.
gc := pixmap graphicsContext.
gc paint: (ColorValue
red: 0.0
green: 0.166646
blue: 0.0).
point := pixmap bounds center - text bounds center.
text displayOn: gc at: point.
image := pixmap asImage].
[block value]
valueNowOrOnUnwindDo: [pixmap close]]
ifFalse: [image := anImage].
icon := super new.
icon extent: sizePoint.
icon title: titleString.
icon image: image.
icon action: actionString.
^icon!
title: titleString image: anImage action: actionString
^self
extent: self defaultIconSize
title: titleString
image: anImage
action: actionString! !
!EngiLauncherIcon class methodsFor: 'defaults'!
defaultIconSize
^50 @ 50! !
!EngiLauncherIcon class methodsFor: 'private'!
backgroundImage: extent
"EngiDisplayModel openOn: (EngiLauncherIcon backgroundImage: 50@50)."
| colors image |
colors := OrderedCollection new.
colors add: (ColorValue
red: 1.0
green: 1.0
blue: 0.833354).
colors add: (ColorValue
red: 0.833354
green: 1.0
blue: 0.833354).
colors add: (ColorValue
red: 0.833354
green: 1.0
blue: 1.0).
image := Image
extent: extent
depth: Screen default colorPalette depth
palette: Screen default colorPalette.
^self
gradation: image
palette: (MappedPalette withColors: colors)
origin: image bounds center
deviation: 0.5
figure: true!
gradation: anImage palette: aPalette origin: aPoint deviation: aNumber figure: aBoolean
"
| colors image |
colors := OrderedCollection new.
colors add: ColorValue white.
colors add: ColorValue gray.
colors add: ColorValue black.
image := Image
extent: 50@50
depth: Screen default colorPalette depth
palette: Screen default colorPalette.
EngiLauncherIcon
graduation: image
palette: (MappedPalette withColors: colors)
origin: image bounds center
deviation: 0.2
figure: true.
EngiDisplayModel openOn: image
"
| random uniform condition normal distribution width height box point index color value |
random := Random new.
uniform :=
[| x |
x := random next.
-1.0 + (x * (1.0 - -1.0))].
normal :=
[:mean :deviation |
| v1 v2 s u |
condition :=
[v1 := uniform value.
v2 := uniform value.
s := v1 squared + v2 squared.
s >= 1].
condition whileTrue.
u := (-2.0 * s ln / s) sqrt.
mean + (deviation * v1 * u)].
distribution :=
[:x :y :p |
| m |
aBoolean = true
ifTrue: [m := (x - aPoint x) abs / p x max: (y - aPoint y) abs / p y]
ifFalse: [m := (aPoint dist: x @ y)
/ p r].
(normal value: m asFloat value: aNumber asFloat)
* (aPalette size - 1)].
width := anImage width.
height := anImage height.
box := anImage bounds.
point := ((box left - aPoint x) abs max: (box right - aPoint x) abs)
@ ((box top - aPoint y) abs max: (box bottom - aPoint y) abs).
0 to: width - 1 do: [:x | 0 to: height - 1
do:
[:y |
index := (distribution
value: x
value: y
value: point) rounded.
index := index min: aPalette size - 1.
index := index max: 0.
color := aPalette at: index.
value := anImage palette indexOfPaintNearest: color.
anImage
atX: x
y: y
put: value]].
^anImage! !
!EngiLauncherIcon class methodsFor: 'examples'!
example1
"EngiLauncherIcon example1."
| anIcon |
anIcon := EngiLauncherIcon
title: 'anonymous'
image: Image fromUser
action: 'Transcript cr; show: self title'.
anIcon evaluate.
^anIcon!
example2
"EngiLauncherIcon example2."
| anIcon activeWindow |
anIcon := EngiLauncherIcon
title: 'anonymous'
image: Image fromUser
action: 'Transcript cr; show: self title'.
activeWindow := ScheduledControllers activeController view.
activeWindow clear.
anIcon displayBlock value: activeWindow graphicsContext value: 50 @ 50.
activeWindow sensor waitClickButton.
activeWindow display.
anIcon evaluate.
^anIcon!
example3
"EngiLauncherIcon example3."
| anIcon activeWindow |
anIcon := EngiLauncherIcon
extent: 100 @ 30
title: 'Browser'
image: nil
action: 'Browser open'.
activeWindow := ScheduledControllers activeController view.
activeWindow clear.
anIcon displayBlock value: activeWindow graphicsContext value: 50 @ 50.
activeWindow sensor waitClickButton.
activeWindow display.
anIcon evaluate.
^anIcon! !
EngiDisplayView subclass: #EngiLauncherView
instanceVariableNames: 'popUp '
classVariableNames: ''
poolDictionaries: ''
category: 'Engi-Launcher'!
EngiLauncherView comment:
'
Engi 0.07 (24 March 1994)
Copyright (C) 1994 by Atsushi Aoki
'!
!EngiLauncherView methodsFor: 'accessing'!
popUp
^popUp = true!
popUp: aBoolean
popUp := aBoolean = true! !
!EngiLauncherView methodsFor: 'displaying'!
displayPressedArea: aRectangle
| aBox graphicsContext |
graphicsContext := self graphicsContext