From VisualWorks® NonCommercial, 7.7.1 of 2010年7月26日 on 2011年8月3日 at 20:53:52
SSK bundle
SSK bundle
comment 'Smalltalk勉強会@京都'
Pane package
Pane package
comment 'Smalltalk勉強会@京都
'
PaneView
Smalltalk
UI.View
false
none
alignmentSymbol isScaling keepAspect
Pane
PaneView
Smalltalk勉強会@京都
PaneModel
Smalltalk
UI.Model
false
none
label picture
Pane
PaneModel
Smalltalk勉強会@京都
PaneExample
Smalltalk
UI.ApplicationModel
false
none
Pane
PaneExample
Smalltalk勉強会@京都
PaneController
Smalltalk
UI.Controller
false
none
Pane
PaneController
Smalltalk勉強会@京都
PaneModel class examples
example1
"PaneModel example1."
| aModel |
aModel := PaneModel new.
aModel label: 'Aoki'.
aModel picture: (JunImageUtility fromDisplay: (0 @ 0 extent: 256 @ 256)).
^aModel
example2
"PaneModel example2."
| aDirectory aFilename aModel |
aDirectory := Filename defaultDirectory directory construct: 'pictures'.
aFilename := aDirectory construct: 'BernhardRiemann.jpg'.
aModel := PaneModel filename: aFilename.
^aModel
PaneModel class resources
yellowButtonMenu
"Tools.MenuEditor new openOnClass: self andSelector: #yellowButtonMenu"
<resource: #menu>
^#(#{UI.Menu} #(
#(#{UI.MenuItem}
#rawLabel: 'Select image file'
#nameKey: #model
#value: #selectImageFile )
#(#{UI.MenuItem}
#rawLabel: 'Inspect'
#nameKey: #model
#value: #inspect ) ) #(1 1 ) nil ) decodeAsLiteralArray
PaneModel class instance creation
new
^(super new)
initialize;
yourself
filename: aFilename
| aModel anImage |
aModel := self new.
anImage := JunImageUtility fromFile: aFilename.
aModel picture: anImage.
aModel label: (Filename splitExtension: aFilename tail) first.
^aModel
PaneModel menu messages
selectImageFile
PaneModel accessing
picture: anImage
picture := anImage asImage
picture
^picture
label
^label
label: aString
"(aString isKindOf: String) ifFalse: [^nil]."
label := aString asString
PaneModel menu accessing
yellowButtonMenu
^self class yellowButtonMenu
PaneModel initialize-release
initialize
super initialize.
label := nil.
picture := nil.
^self
PaneExample class interface specs
windowSpec
"Tools.UIPainter new openOnClass: self andSelector: #windowSpec"
<resource: #canvas>
^#(#{UI.FullSpec}
#window:
#(#{UI.WindowSpec}
#label: 'Pane Example'
#min: #(#{Core.Point} 20 20 )
#max: #(#{Core.Point} 0 0 )
#bounds: #(#{Graphics.Rectangle} 640 400 896 656 ) )
#component:
#(#{UI.SpecCollection}
#collection: #(
#(#{UI.ArbitraryComponentSpec}
#layout: #(#{Graphics.LayoutFrame} 5 0 2 0.5 -2 1 -2 1 )
#name: #paneView1
#component: #paneView1 ) ) ) )
windowSpec2
"Tools.UIPainter new openOnClass: self andSelector: #windowSpec2"
<resource: #canvas>
^#(#{UI.FullSpec}
#window:
#(#{UI.WindowSpec}
#label: 'Pane Example'
#min: #(#{Core.Point} 20 20 )
#max: #(#{Core.Point} 0 0 )
#bounds: #(#{Graphics.Rectangle} 640 400 1152 656 ) )
#component:
#(#{UI.SpecCollection}
#collection: #(
#(#{UI.ArbitraryComponentSpec}
#layout: #(#{Graphics.LayoutFrame} 2 0 2 0 -1 0.5 -2 1 )
#name: #paneView1
#component: #paneView1 )
#(#{UI.ArbitraryComponentSpec}
#layout: #(#{Graphics.LayoutFrame} 1 0.5 2 0 -2 1 -2 1 )
#name: #paneView2
#component: #paneView2 ) ) ) )
PaneExample class examples
example31
"自力版"
"PaneExample example31."
| aPart aWindow |
aPart := CompositePart new.
#(#(0 2 0 2 0.5 -1 1 -2) #(0.5 1 0 2 1 -2 1 -2)) do:
[:anArray |
| aLayoutFrame aModel aView aWrapper |
aLayoutFrame := LayoutFrame
leftFraction: (anArray at: 1)
offset: (anArray at: 2)
topFraction: (anArray at: 3)
offset: (anArray at: 4)
rightFraction: (anArray at: 5)
offset: (anArray at: 6)
bottomFraction: (anArray at: 7)
offset: (anArray at: 8).
aModel := PaneModel new.
aView := PaneView model: aModel.
aWrapper := BorderedWrapper
on: aView
in: aLayoutFrame
border: SimpleBorder new.
aPart addWrapper: aWrapper].
aWindow := ScheduledWindow new.
aWindow label: 'Pane Example'.
aWindow component: aPart.
aWindow openWithExtent: 512 @ 256.
^aWindow
example4
"PaneExample example4."
| anExample |
anExample := PaneExample new.
anExample openInterface: #windowSpec2.
^anExample
example21
"自力版"
"PaneExample example21."
| aModel aView aWindow aWrapper aPart |
aModel := PaneModel new.
aView := PaneView model: aModel.
aWrapper := BorderedWrapper
on: aView
in: (LayoutFrame
leftFraction: 0
offset: 2
topFraction: 0
offset: 2
rightFraction: 1
offset: -2
bottomFraction: 1
offset: -2)
border: SimpleBorder new.
aPart := CompositePart new.
aPart addWrapper: aWrapper.
aWindow := ScheduledWindow new.
aWindow label: 'Pane Example'.
aWindow component: aPart.
aWindow openWithExtent: 256 @ 256.
^aWindow
example1
"例題プログラム:窓MVCを作り、ウィンドウに乗せて開く。"
"PaneExample example1."
| aModel aView aWindow |
aModel := PaneModel new.
aView := PaneView model: aModel.
aWindow := ScheduledWindow new.
aWindow label: 'Pane Example'.
aWindow component: aView.
aWindow openWithExtent: 256 @ 256.
^aWindow
example0
"例題プログラム:窓MVCを作って確かめる。"
"PaneExample example0."
| aModel aView |
aModel := PaneModel new.
aView := PaneView model: aModel.
aView controller.
^aView
example22
"他力版"
"PaneExample example22."
| anExample |
anExample := PaneExample new.
anExample open
example32
"他力版"
"PaneExample example32."
| anExample aWindow aRectangle |
anExample := PaneExample new.
anExample openInterface: #windowSpec2.
3 seconds wait.
aWindow := anExample builder window.
aRectangle := aWindow displayBox.
aRectangle := aRectangle expandedBy: (0 @ 0 corner: 50 @ 50).
aWindow displayBox: aRectangle.
^anExample
PaneExample class defaults
defaultDirectoryOfPictures
^Filename defaultDirectory directory construct: 'pictures'
PaneExample aspects
paneView1
| aModel aView |
aModel := self createPaneModel: 'BernhardRiemann.jpg'.
aView := PaneView model: aModel.
aView alignmentSymbol: #topRight.
^aView
paneView2
| aModel aView |
aModel := self createPaneModel: 'GeorgeBoole.jpg'.
aView := PaneView model: aModel.
aView alignmentSymbol: #bottomLeft.
^aView
PaneExample defaults
defaultDirectoryOfPictures
^self class defaultDirectoryOfPictures
PaneExample private
createPaneModel: localnameString
| aFilename aModel |
aFilename := self defaultDirectoryOfPictures construct: localnameString.
aModel := PaneModel filename: aFilename.
^aModel
PaneView accessing
isScaling
isScaling ifNil: [isScaling := true].
^isScaling
keepAspect: aBoolean
keepAspect := aBoolean = true
isScaling: aBoolean
isScaling := aBoolean = true
alignmentSymbol: aSymbol
(#(#topLeft #topCenter #topRight #leftCenter #center #rightCenter #bottomLeft #bottomCenter #bottomRight #origin #corner)
includes: aSymbol) ifFalse: [^nil].
alignmentSymbol := aSymbol
keepAspect
keepAspect ifNil: [keepAspect := true].
^keepAspect
alignmentSymbol
alignmentSymbol ifNil: [alignmentSymbol := #topLeft].
^alignmentSymbol
PaneView private
scalingFactor
| viewBounds imageBounds xScalingFactor yScalingFactor |
viewBounds := self bounds.
imageBounds := self model picture bounds.
xScalingFactor := viewBounds width / imageBounds width.
yScalingFactor := viewBounds height / imageBounds height.
self keepAspect
ifTrue:
[xScalingFactor := xScalingFactor min: yScalingFactor.
yScalingFactor := xScalingFactor].
^xScalingFactor @ yScalingFactor
PaneView displaying
displayOn: graphicsContext
self model picture
ifNotNil:
[:anImage |
| messageSelector scaledImage aRectangle |
messageSelector := self alignmentSymbol.
scaledImage := self isScaling
ifTrue: [anImage shrunkenBy: self scalingFactor reciprocal]
ifFalse: [anImage yourself].
aRectangle := scaledImage bounds.
aRectangle := aRectangle align: (aRectangle perform: messageSelector)
with: (self bounds perform: messageSelector).
scaledImage displayOn: graphicsContext at: aRectangle origin].
self model label
ifNotNil:
[:aString |
| aComposedText aPoint |
aComposedText := aString asComposedText.
aPoint := 4 @ 0.
graphicsContext paint: ColorValue white.
(-1 to: 1) do:
[:y |
(-1 to: 1)
do: [:x | aComposedText displayOn: graphicsContext at: aPoint + (x @ y)]].
graphicsContext paint: ColorValue black.
aComposedText displayOn: graphicsContext at: aPoint]
PaneView bounds accessing
bounds: newBounds
super bounds: newBounds.
Transcript
cr;
show: thisContext printString;
space;
show: newBounds printString;
space;
show: Time now printString
PaneView initialize-release
initialize
super initialize.
alignmentSymbol := #topLeft.
isScaling := true.
keepAspect := true
PaneView controller accessing
defaultControllerClass
"自分とペアになるコントローラのクラスを応答する。"
^PaneController
PaneController class resources
yellowButtonMenu
"Tools.MenuEditor new openOnClass: self andSelector: #yellowButtonMenu"
<resource: #menu>
^#(#{UI.Menu} #(
#(#{UI.MenuItem}
#rawLabel: 'Alignment'
#nameKey: #view
#value: #selectAlignment )
#(#{UI.MenuItem}
#rawLabel: 'Scaling'
#nameKey: #view
#value: #selectScaling )
#(#{UI.MenuItem}
#rawLabel: 'Keep aspect'
#nameKey: #view
#value: #slectKeepAspect ) ) #(3 ) nil ) decodeAsLiteralArray
PaneController events
yellowButtonPressedEvent: event
"マウスの右ボタンが押されたときの処理をする。"
| aMenu aSymbol |
aMenu := self model yellowButtonMenu.
aSymbol := aMenu startUp.
(aSymbol isKindOf: Symbol) ifTrue: [self model perform: aSymbol].
^nil
redButtonPressedEvent: event
"マウスの左ボタンが押されたときの処理をする。"
Transcript
cr;
show: thisContext printString;
space;
show: Time now printString.
^nil
SSK #(#(#package 'Pane'))