Skip to content
Find file
Fetching contributors…
Cannot retrieve contributors at this time
2324 lines (2250 sloc) 67.7 KB
===== PHARO BY EXAMPLE ==========
Below follow all the (displayed) code examples from the book "Pharo by
Example".
For details about this book, see: http://pharo-project.org/PharoByExample
The examples are provided, as is, for your convenience, in case you want
to copy and paste fragments to Pharo to try out.
Note that in almost all cases the annotation "--> ..." suggests that you
can select and apply <print it> to the previous expression and you should
obtain as a result the value following the arrow.
Many of these actually serve as test cases for the book. For more details
about testing, see the Wiki link under:
http://www.squeaksource.com/PharoByExample.html
Last update: 2011-07-11T18:38:33-07:00
===== CHAPTER: Preface ==========
-----
3 + 4 "--> 7 「3+4を選択して'print it'を選ぶと7が得られる」"
%翻訳メモ: メニューは日本語版にあわせて翻訳しておくか?
-----
===== CHAPTER: Pharoの使い方 ==========
-----
BouncingAtomsMorph new openInWorld
-----
Transcript show: 'hello world'; cr.
-----
3 + 4 "--> 7"
-----
testShout
self assert: ('Don''t panic' shout = 'DON''T PANIC!')
-----
shout
^ self asUppercase, '!'
-----
===== CHAPTER: 最初のアプリケーション ==========
-----
SimpleSwitchMorph subclass: #LOCell
instanceVariableNames: 'mouseAction'
classVariableNames: ''
poolDictionaries: ''
category: 'PBE-LightsOut'
-----
initialize
super initialize.
self label: ''.
self borderWidth: 2.
bounds := 0@0 corner: 16@16.
offColor := Color paleYellow.
onColor := Color paleBlue darker.
self useSquareCorners.
self turnOff
-----
BorderedMorph subclass: #LOGame
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PBE-LightsOut'
-----
initialize
| sampleCell width height n |
super initialize.
n := self cellsPerSide.
sampleCell := LOCell new.
width := sampleCell width.
height := sampleCell height.
self bounds: (5@5 extent: ((width*n) @(height*n)) + (2 * self borderWidth)).
cells := Matrix new: n tabulate: [ :i :j | self newCellAt: i at: j ].
-----
LOGame>>cellsPerSide
"The number of cells along each side of the game"
^ 10
-----
LOGame>>newCellAt: i at: j
"Create a cell for position (i,j) and add it to my on-screen
representation at the appropriate screen position. Answer the new cell"
| c origin |
c := LOCell new.
origin := self innerBounds origin.
self addMorph: c.
c position: ((i - 1) * c width) @ ((j - 1) * c height) + origin.
c mouseAction: [self toggleNeighboursOfCellAt: i at: j]
-----
LOGame>>toggleNeighboursOfCellAt: i at: j
(i > 1) ifTrue: [ (cells at: i - 1 at: j ) toggleState].
(i < self cellsPerSide) ifTrue: [ (cells at: i + 1 at: j) toggleState].
(j > 1) ifTrue: [ (cells at: i at: j - 1) toggleState].
(j < self cellsPerSide) ifTrue: [ (cells at: i at: j + 1) toggleState].
-----
LOCell>>mouseAction: aBlock
^ mouseAction := aBlock
-----
LOCell>>mouseUp: anEvent
mouseAction value
-----
LOGame>>newCellAt: i at: j
"Create a cell for position (i,j) and add it to my on-screen
representation at the appropriate screen position. Answer the new cell"
| c origin |
c := LOCell new.
origin := self innerBounds origin.
self addMorph: c.
c position: ((i - 1) * c width) @ ((j - 1) * c height) + origin.
c mouseAction: [self toggleNeighboursOfCellAt: i at: j].
^ c
-----
LOGame>>mouseMove: anEvent
-----
MCHttpRepository
location: 'http://www.squeaksource.com/!\emph{YourProject}!'
user: '!\emph{yourInitials}!'
password: '!\emph{yourPassword}!'
-----
MCHttpRepository
location: 'http://www.squeaksource.com/!\emph{YourProject}!'
user: ''
password: ''
-----
===== CHAPTER: Syntax in a nutshell ==========
-----
(Smalltalk includes: Class) ifTrue: [ Transcript show: Class superclass ]
-----
+ - / \ * ~ < > = @ % | & ! ? ,
-----
2 raisedTo: 1 + 3 factorial "--> 128"
-----
1 + 2 * 3 "--> 9"
-----
1 + (2 * 3) "--> 7"
-----
Transcript cr.
Transcript show: 'hello world'.
Transcript cr
-----
Transcript cr;
show: 'hello world';
cr
-----
String>>lineCount
"Answer the number of lines represented by the receiver,
where every cr adds one line."
| cr count |
cr := Character cr.
count := 1 min: self size.
self do:
[:c | c == cr ifTrue: [count := count + 1]].
^ count
-----
[ 1 + 2 ] value "--> 3"
-----
[ :x | 1 + x ] value: 2 "--> 3"
[ :x :y | x + y ] value: 1 value: 2 "--> 3"
-----
[ :x :y | | z | z := x+ y. z ] value: 1 value: 2 "--> 3"
-----
| x |
x := 1.
[ :y | x + y ] value: 2 "--> 3"
-----
(17 * 13 > 220)
ifTrue: [ 'bigger' ]
ifFalse: [ 'smaller' ] "--> 'bigger'"
-----
n := 1.
[ n < 1000 ] whileTrue: [ n := n*2 ].
n "--> 1024"
-----
n := 1.
[ n > 1000 ] whileFalse: [ n := n*2 ].
n "--> 1024"
-----
n := 1.
10 timesRepeat: [ n := n*2 ].
n "--> 1024"
-----
result := String new.
1 to: 10 do: [:n | result := result, n printString, ' '].
result "--> '1 2 3 4 5 6 7 8 9 10 '"
-----
result := String new.
(1 to: 10) do: [:n | result := result, n printString, ' '].
result "--> '1 2 3 4 5 6 7 8 9 10 '"
-----
(1 to: 10) collect: [ :each | each * each ] "--> #(1 4 9 16 25 36 49 64 81 100)"
-----
'hello there' select: [ :char | char isVowel ] "--> 'eoee'"
'hello there' reject: [ :char | char isVowel ] "--> 'hll thr'"
'hello there' detect: [ :char | char isVowel ] "--> $e"
-----
(1 to: 10) inject: 0 into: [ :sum :each | sum + each ] "--> 55"
-----
+ aNumber
"Primitive. Add the receiver to the argument and answer with the result
if it is a SmallInteger. Fail if the argument or the result is not a
SmallInteger Essential No Lookup. See Object documentation whatIsAPrimitive."
<primitive: 1>
^ super + aNumber
-----
===== CHAPTER: メッセージ構文を理解しよう ==========
-----
89 sin "--> 0.860069405812453"
3 sqrt "--> 1.732050807568877"
Float pi "--> 3.141592653589793"
'blop' size "--> 4"
true not "--> false"
Object class "--> Object class The class of Object is Object class (!)"
-----
100@100 "--> 100@100 Pointオブジェクトを生成"
3 + 4 "--> 7"
10 - 1 "--> 9"
4 <= 3 "--> false"
(4/3) * 3 = 4 "--> true 同値性のテストも単なる2項メッセージ。分数オブジェクトは値を正確に表現できる"
(3/4) == (3/4) "--> false 別個に作られた2つの分数オブジェクトは同一ではない"
-----
1 to: 10 "--> (1 to: 10) 区間オブジェクトを生成"
Color r: 1 g: 0 b: 0 "--> Color red 色オブジェクトを返す"
12 between: 8 and: 15 "--> true"
nums := Array newFrom: (1 to: 5).
nums at: 1 put: 6.
nums "--> #(6 2 3 4 5)"
-----
1000 factorial / 999 factorial "--> 1000"
2 raisedTo: 1 + 3 factorial "--> 128"
-----
1 + 2 * 3 "--> 9"
1 + (2 * 3) "--> 7"
-----
[:aClass | aClass methodDict keys select: [:aMethod | (aClass>>aMethod) isAbstract ]] value: Boolean "--> an IdentitySet(#or: #| #and: #& #ifTrue: #ifTrue:ifFalse: #ifFalse: #not #ifFalse:ifTrue:)"
-----
aPen color: Color yellow
(1) Color yellow "単項メッセージがまず送られる"
"--> aColor"
(2) aPen color: aColor "キーワードメッセージが次に送られる"
-----
aPen go: 100 + 20
(1) 100 + 20 "2項メッセージがまず送られる"
"--> 120"
(2) aPen go: 120 "キーワードメッセージが次に送られる"
-----
1.5 tan rounded asString = (((1.5 tan) rounded) asString) "--> true かっこは不要"
3 + 4 factorial "--> 27 (5040ではない)"
(3 + 4) factorial "--> 5040"
-----
(FMSound lowMajorScaleOn: FMSound clarinet) play
"(1) メッセージclarinetがFMSoundクラスに送られ、クラリネットの音色オブジェクトが作られる。
(2) このオブジェクトがFMSoundに送られるlowMajorScaleOn:キーワードメッセージの引数として送られる。
(3) 結果の音オブジェクトにplayが送られ、演奏される。"
-----
(65@325 extent: 134@100) center
(1) 65@325 "2項"
"--> aPoint"
(2) 134@100 "2項"
"--> anotherPoint"
(3) aPoint extent: anotherPoint "キーワード"
"--> aRectangle"
(4) aRectangle center "単項"
"--> 132@375"
-----
3 + 4 * 5 "--> 35 (23ではない) 2項メッセージが左から右に実行されるため"
3 + (4 * 5) "--> 23"
1 + 1/3 "--> (2/3) 4/3ではない"
1 + (1/3) "--> (4/3)"
1/3 + 2/3 "--> (7/9) 1ではない"
(1/3) + (2/3) "--> 1"
-----
"2項メッセージ同士には優先順位の違いがないので、算数の約束としては*がまず先に実行されるべきですが、ここでは左端の+がまず評価されます。"
20 + 2 * 5
(1) 20 + 2 "--> 22"
(2) 22 * 5 "--> 110"
-----
"かっこで囲まれたメッセージが先に評価されるので、*が+の前に実行され、正しく動作します。"
20 + (2 * 5)
(1) (2 * 5) "--> 10"
(2) 20 + 10 "--> 30"
-----
aDict
at: (rotatingForm
rotateBy: angle
magnify: 2
smoothing: 1)
put: 3
-----
(x isNil)
ifTrue:[...]
-----
ord := OrderedCollection new.
(ord includes: $a)
ifTrue:[...]
-----
[ x isReady ] whileTrue: [ y doSomething ] "レシーバーと引数の両方ともブロックでなくてはならない"
4 timesRepeat: [ Beeper beep ] "引数は2回以上実行されるので、ブロックでなくてはならない"
(x isReady) ifTrue: [ y doSomething ] "引数は一度だけ評価されるのでブロックではない"
-----
| box |
box := 20@30 corner: 60@90.
box containsPoint: 40@50 "--> true"
-----
Transcript show: 'Pharo is '.
Transcript show: 'fun '.
Transcript cr.
-----
Transcript
show: 'Pharo is';
show: 'fun ';
cr
-----
Point new setX: 25 setY: 35; isZero "--> false"
-----
===== CHAPTER: Smalltalkオブジェクトモデル ==========
-----
3 + 4 "--> 7 '+ 4'を3に送ることで, 結果として7が得られます"
20 factorial "--> 2432902008176640000 factorialを送ると, 大きな数が得られます"
-----
1 class "--> SmallInteger"
20 factorial class "--> LargePositiveInteger"
'hello' class "--> ByteString"
#(1 2 3) class "--> Array"
(4@5) class "--> Point"
Object new class "--> Object"
-----
Point>>dist: aPoint
"Answer the distance between aPoint and the receiver."
| dx dy |
dx := aPoint x - x.
dy := aPoint y - y.
^ ((dx * dx) + (dy * dy)) sqrt
-----
1@1 dist: 4@5 "--> 5.0"
-----
aColor := Color blue. "クラス側のblueメソッド"
aColor "--> Color blue"
aColor red "--> 0.0 インスタンス側のアクセサメソッドred"
aColor blue "--> 1.0 インスタンス側のアクセサメソッドblue"
-----
Object subclass: #Dog
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PBE-CIV'
Dog class
instanceVariableNames: 'count'
Dog subclass: #Hyena
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PBE-CIV'
-----
Dog class>>initialize
super initialize.
count := 0.
Dog class>>new
count := count +1.
^ super new
Dog class>>count
^ count
-----
Dog initialize.
Hyena initialize.
Dog count "--> 0"
Hyena count "--> 0"
Dog new.
Dog count "--> 1"
Dog new.
Dog count "--> 2"
Hyena new.
Hyena count "--> 1"
-----
Object subclass: #WebServer
instanceVariableNames: 'sessions'
classVariableNames: ''
poolDictionaries: ''
category: 'Web'
-----
WebServer class
instanceVariableNames: 'uniqueInstance'
-----
WebServer class>>uniqueInstance
uniqueInstance ifNil: [uniqueInstance := self new].
^ uniqueInstance
-----
SmallInteger superclass "--> Integer"
Integer superclass "--> Number"
Number superclass "--> Magnitude"
Magnitude superclass "--> Object"
Object superclass "--> ProtoObject"
ProtoObject superclass "--> nil"
-----
Magnitude>>< aMagnitude
"Answer whether the receiver is less than the argument."
^self subclassResponsibility
-----
>= aMagnitude
"Answer whether the receiver is greater than or equal to the argument."
^(self < aMagnitude) not
-----
Character>>< aCharacter
"Answer true if the receiver's value < aCharacter's value."
^self asciiValue < aCharacter asciiValue
-----
Trait named: #TAuthor
uses: { }
category: 'PBE-LightsOut'
-----
TAuthor>>authorj
"著者の頭文字を返す"
^ 'on' "oscar nierstraszの頭文字"
-----
BorderedMorph subclass: #LOGame
uses: TAuthor
instanceVariableNames: -'cells'ss
classVariableNames: ''e
poolDictionaries: ''
category: 'PBE-LightsOut'
-----
LOGame new author "--> 'on'"
-----
Object subclass: #Behavior
uses: TPureBehavior @ {#basicAddTraitSelector:withMethod:->#addTraitSelector:withMethod:}
instanceVariableNames: 'superclass methodDict format'
classVariableNames: 'ObsoleteSubclasses'
poolDictionaries: ''
category: 'Kernel-Classes'
-----
% 3 + 4 "--> 7 send message + with argument 4 to integer 3"
3 + 4 "--> 7 整数「3」にメッセージ「+」と引数「4」を送信する"
% (1@2) + 4 "--> 5@6 send message + with argument 4 to point (1@2)"
(1@2) + 4 "--> 5@6 点「(1@2)」にメッセージ「+」と引数「4」を送信する"
-----
anEllipse := EllipseMorph new.
-----
anEllipse defaultColor "--> Color yellow"
-----
EllipseMorph>>defaultColor
"answer the default color/fill style for the receiver"
^ Color yellow
-----
Morph>>openInWorld
"Add this morph to the world."
self openInWorld: self currentWorld
-----
Morph>>openInWorld
"Add this morph to the world."
self openInWorld: self currentWorld
^ self "不要なので、通常はわざわざ書かないこと!"
-----
BorderedMorph>>initialize
"initialize the state of the receiver"
super initialize.
self borderInitialize
-----
anEllipse constructorString "--> '(EllipseMorph newBounds: (0@0 corner: 50@40) color: Color yellow)'"
-----
Morph>>constructorString
^ String streamContents: [:s | self printConstructorOn: s indent: 0].
-----
BorderedMorph>>fullPrintOn: aStream
aStream nextPutAll: '('.
!\textbf{super fullPrintOn: aStream.}!
aStream nextPutAll: ') setBorderWidth: '; print: borderWidth;
nextPutAll: ' borderColor: ' , (self colorString: borderColor)
-----
Transcript show: 'Pharo is fun and powerful' ; cr
-----
Smalltalk at: #Boolean "--> Boolean"
-----
Smalltalk at: #Smalltalk "-->a SystemDictionary(lots of globals)}"
-----
(Smalltalk at: #Smalltalk) == Smalltalk "--> true"
-----
SystemOrganization categoryOfElement: #Magnitude "--> #'Kernel-Numbers'"
-----
Object subclass: #Color
instanceVariableNames: 'rgb cachedDepth cachedBitPattern'
classVariableNames: 'Black Blue BlueShift Brown CachedColormaps ColorChart ColorNames ComponentMask ComponentMax Cyan DarkGray Gray GrayToIndexMap Green GreenShift HalfComponentMask HighLightBitmaps IndexedColors LightBlue LightBrown LightCyan LightGray LightGreen LightMagenta LightOrange LightRed LightYellow Magenta MaskingMap Orange PaleBlue PaleBuff PaleGreen PaleMagenta PaleOrange PalePeach PaleRed PaleTan PaleYellow PureBlue PureCyan PureGreen PureMagenta PureRed PureYellow RandomStream Red RedShift TranslucentPatterns Transparent VeryDarkGray VeryLightGray VeryPaleRed VeryVeryDarkGray VeryVeryLightGray White Yellow'
poolDictionaries: ''
category: 'Graphics-Primitives'
-----
Color class>>colorNames
ColorNames ifNil: [self initializeNames].
^ ColorNames
-----
Color class>>initialize
!\ldots!
self initializeNames
-----
ArrayedCollection subclass: #Text
instanceVariableNames: 'string runs'
classVariableNames: ''
!\textbf{poolDictionaries: 'TextConstants'}!
category: 'Collections-Text'
-----
Text>>testCR
^ CR == Character cr
-----
===== CHAPTER: The Pharo programming environment ==========
-----
SystemNavigation default browseAllCallsOn: #drawOn:
-----
SystemNavigation default browseAllCallsOn: #drawOn: from: ImageMorph
-----
SystemNavigation default browseAllImplementorsOf: #drawOn:
-----
Object>>asSQL
String>>asSQL
Date>>asSQL
-----
mc := PackageInfo named: 'Monticello'
-----
MCHttpRepository
location: 'http://squeaksource.com/PharoByExample'
user: ''
password: ''
-----
self - TimeStamp today
-----
suffix
"assumes that I'm a file name, and answers my suffix, the part after the last dot"
| dot dotPosition |
dot := FileDirectory dot.
dotPosition := (self size to: 1 by: -1) detect: [ :i | (self at: i) = dot ].
^ self copyFrom: dotPosition to: self size
-----
testSuffixFound
self assert: 'readme.txt' suffix = 'txt'
-----
testSuffixFound
self assert: 'readme.txt' suffix = 'txt'.
self assert: 'read.me.txt' suffix = 'txt'
-----
suffix
"assumes that I'm a file name, and answers my suffix, the part after the last dot"
| dot dotPosition |
dot := FileDirectory dot first.
dotPosition := (self size to: 1 by: -1) detect: [ :i | (self at: i) = dot ].
self halt.
^ self copyFrom: dotPosition to: self size
-----
testSuffixNotFound
self assert: 'readme' suffix = ''
-----
===== CHAPTER: SUnit ==========
-----
TestCase subclass: #ExampleSetTest
instanceVariableNames: 'full empty'
classVariableNames: ''
poolDictionaries: ''
category: 'MySetTest'
-----
ExampleSetTest>>setUp
empty := Set new.
full := Set with: 5 with: 6
-----
ExampleSetTest>>testIncludes
self assert: (full includes: 5).
self assert: (full includes: 6)
-----
ExampleSetTest>>testOccurrences
self assert: (empty occurrencesOf: 0) = 0.
self assert: (full occurrencesOf: 5) = 1.
full add: 5.
self assert: (full occurrencesOf: 5) = 1
-----
ExampleSetTest>>testRemove
full remove: 5.
self assert: (full includes: 6).
self deny: (full includes: 5)
-----
ExampleSetTest>>testIllegal
self should: [empty at: 5] raise: Error.
self should: [empty at: 5 put: #zork] raise: Error
-----
ExampleSetTest>>testIllegal
self should: [empty at: 5] raise: TestResult error.
self should: [empty at: 5 put: #zork] raise: TestResult error
-----
ExampleSetTest run: #testRemove "--> 1 run, 1 passed, 0 failed, 0 errors"
-----
ExampleSetTest suite run "--> 5 run, 5 passed, 0 failed, 0 errors"
-----
TestResource subclass: #MyTestResource
instanceVariableNames: ''
MyTestCase class>>resources
% "associate the resource with this class of test cases"
"このクラスのテストで使うリソースを返す"
^{ MyTestResource }
-----
| e |
e := 42.
self assert: e = 23
% description: 'expected 23, got ', e printString
description: '期待した値は 23 、実際の値は ', e printString
-----
#assert:description:
#deny:description:
#should:description:
#shouldnt:description:
-----
aCollection do: [ :each | self assert: each even]
-----
aCollection do:
[:each |
self
assert: each even
% description: each printString , ' is not even'
description: each printString , ' は偶数ではありません'
resumable: true]
-----
TestCase>>run
| result |
result := TestResult new.
self run: result.
^result
-----
TestCase>>run: aResult
aResult runCase: self
-----
%\begin{method}[testresultruncase]{\ct{TestCase} のエラーと失敗をキャッシュする}
TestResult>>runCase: aTestCase
| testCasePassed |
testCasePassed := true.
[[aTestCase runCase]
on: self class failure
do:
[:signal |
failures add: aTestCase.
testCasePassed := false.
signal return: false]]
on: self class error
do:
[:signal |
errors add: aTestCase.
testCasePassed := false.
signal return: false].
testCasePassed ifTrue: [passed add: aTestCase]
-----
TestCase>>runCase
[self setUp.
self performTest] ensure: [self tearDown]
-----
TestCase class>>testSelectors
^self selectors asSortedCollection asOrderedCollection select: [:each |
('test*' match: each) and: [each numArgs isZero]]
-----
TestSuite>>run
| result |
result := TestResult new.
self resources do: [ :res |
res isAvailable ifFalse: [^res signalInitializationError]].
[self run: result] ensure: [self resources do: [:each | each reset]].
^result
-----
TestSuite>>run: aResult
self tests do: [:each |
self changed: each.
each run: aResult].
-----
TestResource class>>isAvailable
^self current notNil and: [self current isAvailable]
-----
TestResource class>>current
current isNil ifTrue: [current := self new].
^current
-----
TestResource>>initialize
super initialize.
self setUp
-----
===== CHAPTER: Basic Classes ==========
-----
Browser new printString "--> 'a Browser'"
-----
Color>>printOn: aStream
| name |
(name := self name) ifNotNil:
[ ^ aStream
nextPutAll: 'Color ';
nextPutAll: name ].
self storeOn: aStream
-----
Color red printString "--> 'Color red'"
-----
true "--> true"
3@4 "--> 3@4"
$a "--> $a"
#(1 2 3) "--> #(1 2 3)"
Color red "--> Color red"
-----
{10@10. 100@100} "--> {10@10. 100@100}"
{Browser new . 100@100} "--> an Array(a Browser 100@100)"
-----
#(10@10 100@100) "--> #(10 #@ 10 100 #@ 100)"
-----
Point>>printOn: aStream
"The receiver prints on aStream in terms of infix notation."
x printOn: aStream.
aStream nextPut: $@.
y printOn: aStream
-----
Interval>>printOn: aStream
aStream nextPut: $(;
print: start;
nextPutAll: ' to: ';
print: stop.
step ~= 1 ifTrue: [aStream nextPutAll: ' by: '; print: step].
aStream nextPut: $)
-----
1 to: 10 "--> (1 to: 10) intervals are self-evaluating"
-----
Object>>= anObject
"Answer whether the receiver and the argument represent the same object.
If = is redefined in any subclass, consider also redefining the message hash."
^ self == anObject
-----
(1 + 2 i) = (1 + 2 i) "--> true same value"
(1 + 2 i) == (1 + 2 i) "--> false but different objects"
-----
Complex>>= anObject
anObject isComplex
ifTrue: [^ (real = anObject real) & (imaginary = anObject imaginary)]
ifFalse: [^ anObject adaptToComplex: self andSend: #=]
-----
(1 + 2 i) ~= (1 + 4 i) "--> true"
-----
Complex>>hash
"Hash is reimplemented because = is implemented."
^ real hash bitXor: imaginary hash.
-----
#'lulu' = 'lulu' "--> true"
'lulu' = #'lulu' "--> true"
-----
1 class "--> SmallInteger"
-----
1 isMemberOf: SmallInteger "--> true must be precisely this class"
1 isMemberOf: Integer "--> false"
1 isMemberOf: Number "--> false"
1 isMemberOf: Object "--> false"
-----
1 isKindOf: SmallInteger "--> true"
1 isKindOf: Integer "--> true"
1 isKindOf: Number "--> true"
1 isKindOf: Object "--> true"
1 isKindOf: String "--> false"
1/3 isKindOf: Number "--> true"
1/3 isKindOf: Integer "--> false"
-----
1 respondsTo: #, "--> false"
-----
a1 := { { 'harry' } }.
a1 "--> #(#('harry'))"
a2 := a1 shallowCopy.
a2 "--> #(#('harry'))"
(a1 at: 1) at: 1 put: 'sally'.
a1 "--> #(#('sally'))"
a2 "--> #(#('sally')) the subarray is shared!"
-----
a1 := { { 'harry' } } .
a2 := a1 copyTwoLevel.
(a1 at: 1) at: 1 put: 'sally'.
a1 "--> #(#('sally'))"
a2 "--> #(#('harry')) fully independent state"
-----
a1 := { { { 'harry' } } } .
a2 := a1 deepCopy.
(a1 at: 1) at: 1 put: 'sally'.
a1 "--> #(#('sally'))"
a2 "--> #(#(#('harry')))"
-----
a1 := { 'harry' }.
a2 := { a1 }.
a1 at: 1 put: a2.
a1 deepCopy "--> !\emph{... does not terminate!}!"
-----
Object>>copy
"Answer another instance just like the receiver.
Subclasses typically override postCopy;
they typically do not override shallowCopy."
^self shallowCopy postCopy
-----
Stack>>pop
"Return the first element and remove it from the stack."
self assert: [ self isEmpty not ].
^self linkedList removeFirst element
-----
1 doIfNotNil: [ :arg | arg printString, ' is not nil' ]
"--> !\emph{SmallInteger(Object)>>doIfNotNil: has been deprecated. use ifNotNilDo:}!"
-----
Object>>subclassResponsibility
"This message sets up a framework for the behavior of the class' subclasses.
Announce that the subclass should have implemented this message."
self error: 'My subclass should have overridden ', thisContext sender selector printString
-----
Number new + 1 "--> !\emph{Error: My subclass should have overridden \#+}!"
-----
ProtoObject>>initialize
"Subclasses should redefine this method to perform initializations on instance creation"
-----
Behavior>>new
"Answer a new initialized instance of the receiver (which is a class) with no indexable
variables. Fail if the class is indexable."
^ self basicNew initialize
-----
Magnitude>> < aMagnitude
"Answer whether the receiver is less than the argument."
^self subclassResponsibility
Magnitude>> > aMagnitude
"Answer whether the receiver is greater than the argument."
^aMagnitude < self
-----
1 + 2.5 "--> 3.5 Addition of two numbers"
3.4 * 5 "--> 17.0 Multiplication of two numbers"
8 / 2 "--> 4 Division of two numbers"
10 - 8.3 "--> 1.7 Subtraction of two numbers"
12 = 11 "--> false Equality between two numbers"
12 ~= 11 "--> true Test if two numbers are different"
12 > 9 "--> true Greater than"
12 >= 10 "--> true Greater or equal than"
12 < 10 "--> false Smaller than"
100@10 "--> 100@10 Point creation"
-----
1000 factorial / 999 factorial "--> 1000"
-----
Float pi "--> 3.141592653589793"
Float infinity "--> Infinity"
Float infinity isInfinite "--> true"
-----
6/8 "--> (3/4)"
(6/8) class "--> Fraction"
-----
6/8 * 4 "--> 3"
-----
SmallInteger maxVal = ((2 raisedTo: 30) - 1) "--> true"
SmallInteger minVal = (2 raisedTo: 30) negated "--> true"
-----
(SmallInteger maxVal + 1) class "--> LargePositiveInteger"
(SmallInteger minVal - 1) class "--> LargeNegativeInteger"
-----
n := 2.
3 timesRepeat: [ n := n*n ].
n "--> 256"
-----
$a < $b "--> true"
-----
Character space = (Character value: Character space asciiValue) "--> true"
-----
Character value: 1 "--> Character home"
Character value: 2 "--> Character value: 2"
Character value: 32 "--> Character space"
Character value: 97 "--> $a"
-----
$a asString "--> 'a'"
$a "--> $a"
$a printString "--> '$a'"
-----
(Character value: 97) == $a "--> true"
-----
Character characterTable size "--> 256"
(Character value: 500) == (Character value: 500) "--> false"
-----
'hello world' class "--> ByteString"
-----
'hel','lo' == 'hello' "--> false"
-----
('hel','lo') asSymbol == #hello "--> true"
-----
'hello' at: 2 put: $u; yourself "--> 'hullo'"
-----
#hello at: 2 put: $u "--> error!"
-----
#hello indexOf: $o "--> 5"
-----
'*or*' match: 'zorro' "--> true"
-----
(4 factorial > 20) ifTrue: [ 'bigger' ] ifFalse: [ 'smaller' ] "--> 'bigger'"
-----
True>>ifTrue: trueAlternativeBlock ifFalse: falseAlternativeBlock
^trueAlternativeBlock value
False>>ifTrue: trueAlternativeBlock ifFalse: falseAlternativeBlock
^falseAlternativeBlock value
-----
True>>not
"Negation--answer false since the receiver is true."
^false
-----
(1>2) & (3<4) "--> false must evaluate both sides"
(1>2) and: [ 3<4 ] "--> false only evaluate receiver"
(1>2) and: [ (1/0) > 0 ] "--> false argument block is never evaluated, so no exception"
-----
===== CHAPTER: コレクション ==========
-----
students select: [ :each | each gpa < threshold ]
-----
Array with: 1 "--> #(1)"
Array with: 1 with: 2 "--> #(1 2)"
Array with: 1 with: 2 with: 3 "--> #(1 2 3)"
Array with: 1 with: 2 with: 3 with: 4 "--> #(1 2 3 4)"
Array with: 1 with: 2 with: 3 with: 4 with: 5 "--> #(1 2 3 4 5)"
Array with: 1 with: 2 with: 3 with: 4 with: 5 with: 6 "--> #(1 2 3 4 5 6)"
-----
(1 to: 5) asOrderedCollection addAll: '678'; yourself "--> an OrderedCollection(1 2 3 4 5 $6 $7 $8)"
-----
Array withAll: #(7 3 1 3) "--> #(7 3 1 3)"
OrderedCollection withAll: #(7 3 1 3) "--> an OrderedCollection(7 3 1 3)"
SortedCollection withAll: #(7 3 1 3) "--> a SortedCollection(1 3 3 7)"
Set withAll: #(7 3 1 3) "--> a Set(7 1 3)"
Bag withAll: #(7 3 1 3) "--> a Bag(7 1 3 3)"
Dictionary withAll: #(7 3 1 3) "--> a Dictionary(1->7 2->3 3->1 4->3 )"
-----
Array newFrom: #(7 3 1 3) "--> #(7 3 1 3)"
OrderedCollection newFrom: #(7 3 1 3) "--> an OrderedCollection(7 3 1 3)"
SortedCollection newFrom: #(7 3 1 3) "--> a SortedCollection(1 3 3 7)"
Set newFrom: #(7 3 1 3) "--> a Set(7 1 3)"
Bag newFrom: #(7 3 1 3) "--> a Bag(7 1 3 3)"
Dictionary newFrom: {1 -> 7. 2 -> 3. 3 -> 1. 4 -> 3} "--> a Dictionary(1->7 2->3 3->1 4->3 )"
-----
anArray := Array new: 5.
anArray at: 1 put: 4.
anArray at: 2 put: 3/2.
anArray at: 3 put: 'ssss'.
anArray at: 1 "--> 4"
-----
Array with: 4 with: 3/2 with: 'lulu' "--> {4. (3/2). 'lulu'}"
-----
#(1 'here') size "--> 2"
-----
#(1+2) "--> #(1 #+ 2)"
-----
{ 1 + 2 } "--> #(3)"
{(1/2) asFloat} at: 1 "--> 0.5"
{10 atRandom . 1/3} at: 2 "--> (1/3)"
-----
anArray := #(1 2 3 4 5 6) copy.
anArray at: 3 "--> 3"
anArray at: 3 put: 33.
anArray at: 3 "--> 33"
-----
ordCol := OrderedCollection new.
ordCol add: 'Seaside'; add: 'SqueakSource'; addFirst: 'Monticello'.
ordCol "--> an OrderedCollection('Monticello' 'Seaside' 'SqueakSource')"
-----
ordCol add: 'Monticello'.
ordCol remove: 'Monticello'.
ordCol "--> an OrderedCollection('Seaside' 'SqueakSource' 'Monticello')"
-----
res := ordCol remove: 'zork' ifAbsent: [33].
res "--> 33"
-----
#(1 2 3) asOrderedCollection "--> an OrderedCollection(1 2 3)"
'hello' asOrderedCollection "--> an OrderedCollection($h $e $l $l $o)"
-----
Interval from: 1 to: 100 "--> (1 to: 100)"
-----
(Interval from: 1 to: 100) = (1 to: 100) "--> true"
-----
(Interval from: 1 to: 100 by: 0.5) size "--> 199"
(1 to: 100 by: 0.5) at: 198 "--> 99.5"
(1/2 to: 54/7 by: 1/3) last "--> (15/2)"
-----
colors := Dictionary new.
colors at: #yellow put: Color yellow.
colors at: #blue put: Color blue.
colors at: #red put: Color red.
colors at: #yellow "--> Color yellow"
colors keys "--> a Set(#blue #yellow #red)"
colors values "--> {Color blue. Color yellow. Color red}"
-----
colors := Dictionary newFrom: { #blue->Color blue . #red->Color red . #yellow->Color yellow }.
colors removeKey: #blue.
colors associations "--> {#yellow->Color yellow. #red->Color red}"
-----
a := 'foobar'.
b := a copy.
trouble := IdentityDictionary new.
trouble at: a put: 'a'; at: b put: 'b'.
trouble at: a "--> 'a'"
trouble at: b "--> 'b'"
trouble at: 'foobar' "--> 'a'"
-----
Smalltalk keys collect: [ :each | each class ] "--> a Set(ByteSymbol)"
-----
s := Set new.
s add: 4/2; add: 4; add:2.
s size "--> 2"
-----
(Set newFrom: #( 1 2 3 1 4 )) = #(1 2 3 4 3 2 1) asSet "--> true"
-----
{ Color black. Color white. (Color red + Color blue + Color green) } asSet size "--> 2"
-----
{ Color black. Color white. (Color red + Color blue + Color green) } asBag size "--> 3"
-----
(1 to: 6) union: (4 to: 10) "--> a Set(1 2 3 4 5 6 7 8 9 10)"
'hello' intersection: 'there' "--> 'he'"
#Smalltalk includes: $k "--> true"
-----
SortedCollection new add: 5; add: 2; add: 50; add: -10; yourself. "--> a SortedCollection(-10 2 5 50)"
-----
#(5 2 50 -10) asSortedCollection "--> a SortedCollection(-10 2 5 50)"
-----
'hello' asSortedCollection "--> a SortedCollection($e $h $l $l $o)"
-----
'hello' asSortedCollection asString "--> 'a SortedCollection($e $h $l $l $o)'"
-----
'hello' asSortedCollection as: String "--> 'ehllo'"
String newFrom: ('hello' asSortedCollection) "--> 'ehllo'"
String withAll: ('hello' asSortedCollection) "--> 'ehllo'"
-----
{ 5. 2/-3. 5.21 } asSortedCollection "--> a SortedCollection((-2/3) 5 5.21)"
-----
col := SortedCollection sortBlock: [:c1 :c2 | c1 luminance <= c2 luminance].
col addAll: { Color red. Color yellow. Color white. Color black }.
col "--> a SortedCollection(Color black Color red Color yellow Color white)"
-----
'Hello' "--> 'Hello'"
String with: $A "--> 'A'"
String with: $h with: $i with: $! "--> 'hi!'"
String newFrom: #($h $e $l $l $o) "--> 'hello'"
-----
s := 'no', ' ', 'worries'.
s "--> 'no worries'"
-----
s at: 4 put: $h; at: 5 put: $u.
s "--> 'no hurries'"
-----
(1 to: 3) , '45' "--> #(1 2 3 $4 $5)"
-----
s replaceAll: $n with: $N.
s "--> 'No hurries'"
s replaceFrom: 4 to: 5 with: 'wo'.
s "--> 'No worries'"
-----
s copyReplaceAll: 'rries' with: 'mbats' "--> 'No wombats'"
-----
(1 to: 6) copyReplaceAll: (3 to: 5) with: { 'three'. 'etc.' } "--> #(1 2 'three' 'etc.' 6)"
-----
'Linux *' match: 'Linux mag' "--> true"
'GNU/Linux #ag' match: 'GNU/Linux tag' "--> true"
-----
'GNU/Linux mag' findString: 'Linux' "--> 5"
'GNU/Linux mag' findString: 'linux' startingAt: 1 caseSensitive: false "--> 5"
-----
'Hello' isEmpty "--> false"
'Hello' includes: $a "--> false"
'JOE' anySatisfy: [:c | c isLowercase] "--> false"
'Joe' anySatisfy: [:c | c isLowercase] "--> true"
-----
'{1} is {2}' format: {'Pharo' . 'cool'} "--> 'Pharo is cool'"
-----
'look-<t>-here' expandMacros "--> 'look- -here'"
'<1s> is <2s>' expandMacrosWith: 'Pharo' with: 'cool' "--> 'Pharo is cool'"
'<2s> is <1s>' expandMacrosWith: 'Pharo' with: 'cool' "--> 'cool is Pharo'"
'<1p> or <1s>' expandMacrosWith: 'Pharo' with: 'cool' "--> '''Pharo'' or Pharo'"
'<1?Quentin:Thibaut> plays' expandMacrosWith: true "--> 'Quentin plays'"
'<1?Quentin:Thibaut> plays' expandMacrosWith: false "--> 'Thibaut plays'"
-----
'XYZ' asLowercase "--> 'xyz'"
'xyz' asUppercase "--> 'XYZ'"
'hilaire' capitalized "--> 'Hilaire'"
'1.54' asNumber "--> 1.54"
'this sentence is without a doubt far too long' contractTo: 20 "--> 'this sent...too long'"
-----
#ASymbol printString "--> '#ASymbol'"
#ASymbol asString "--> 'ASymbol'"
-----
#('bob' 'joe' 'toto') do: [:each | Transcript show: each; cr].
-----
#('bob' 'joe' 'toto') doWithIndex: [:each :i | (each = 'joe') ifTrue: [ ^ i ] ] "--> 2"
-----
res := ''.
#('bob' 'joe' 'toto') do: [:e | res := res, e ] separatedBy: [res := res, '.'].
res "--> 'bob.joe.toto'"
-----
String streamContents: [:stream | #('bob' 'joe' 'toto') asStringOn: stream delimiter: '.' ] "--> 'bob.joe.toto'"
-----
colors := Dictionary newFrom: { #yellow -> Color yellow. #blue -> Color blue. #red -> Color red }.
colors keysDo: [:key | Transcript show: key; cr]. "displays the keys"
colors valuesDo: [:value | Transcript show: value;cr]. "displays the values"
colors associationsDo: [:value | Transcript show: value;cr]. "displays the associations"
-----
double := OrderedCollection new.
#(1 2 3 4 5 6) do: [:e | double add: 2 * e].
double "--> an OrderedCollection(2 4 6 8 10 12)"
-----
#(1 2 3 4 5 6) collect: [:e | 2 * e] "--> #(2 4 6 8 10 12)"
-----
aCol := #( 2 -3 4 -35 4 -11).
result := aCol species new: aCol size.
1 to: aCol size do: [ :each | result at: each put: (aCol at: each) abs].
result "--> #(2 3 4 35 4 11)"
-----
#( 2 -3 4 -35 4 -11) collect: [:each | each abs ] "--> #(2 3 4 35 4 11)"
-----
'abc' collect: [:ea | ea asciiValue ] "エラー発生"
-----
'abc' asArray collect: [:ea | ea asciiValue ] "--> #(97 98 99)"
-----
(1 to: 5) collect: [ :ea | ea * 2 ] "--> #(2 4 6 8 10)"
-----
(2 to: 20) select: [:each | each isPrime] "--> #(2 3 5 7 11 13 17 19)"
-----
(2 to: 20) reject: [:each | each isPrime] "--> #(4 6 8 9 10 12 14 15 16 18 20)"
-----
'through' detect: [:each | each isVowel] "--> $o"
-----
Smalltalk allClasses detect: [:each | '*cobol*' match: each asString] ifNone: [ nil ] "--> nil"
-----
(1 to: 100) inject: 0 into: [:sum :each | sum + each ] "--> 5050"
-----
factorial := [:n | (1 to: n) inject: 1 into: [:product :each | product * each ] ].
factorial value: 10 "--> 3628800"
-----
Smalltalk allClasses count: [:each | 'Collection*' match: each asString ] "--> 3"
-----
colors := {Color white . Color yellow. Color red . Color blue . Color orange}.
colors includes: Color blue. "--> true"
-----
colors anySatisfy: [:c | c red > 0.5] "--> true"
-----
collection := OrderedCollection new add: 1; add: 2.
collection "--> 2"
-----
collection := OrderedCollection new.
collection add: 1; add: 2.
collection "--> an OrderedCollection(1 2)"
-----
collection := OrderedCollection new add: 1; add: 2; yourself "--> an OrderedCollection(1 2)"
-----
range := (2 to: 20) asOrderedCollection.
range do: [:aNumber | aNumber isPrime ifFalse: [ range remove: aNumber ] ].
range "--> an OrderedCollection(2 3 5 7 9 11 13 15 17 19)"
-----
range := (2 to: 20) asOrderedCollection.
range copy do: [:aNumber | aNumber isPrime ifFalse: [ range remove: aNumber ] ].
range "--> an OrderedCollection(2 3 5 7 11 13 17 19)"
-----
Book>>= aBook
self class = aBook class ifFalse: [^ false].
^ title = aBook title and: [ authors = aBook authors]
Book>>hash
^ title hash xor: authors hash
-----
===== CHAPTER: ストリーム ==========
-----
r := ReadStream on: (1 to: 1000).
r next. "--> 1"
r next. "--> 2"
r atEnd. "--> false"
-----
w := WriteStream on: (String new: 5).
w nextPut: $a.
w nextPut: $b.
w contents. "--> 'ab'"
-----
w := WriteStream on: (OrderedCollection new: 20).
%w nextPut: 12. "--> raises an error"
w nextPut: 12. "--> エラー"
-----
StandardFileStream
fileNamed: 'test.txt'
do: [:str | str
nextPutAll: '123';
cr;
nextPutAll: 'abcd'].
-----
stream := ReadStream on: #(1 (a b c) false).
stream next. "--> 1"
stream next. "--> #(#a #b #c)"
stream next. "--> false"
-----
stream := ReadStream on: 'abcdef'.
stream next: 0. "--> ''"
stream next: 1. "--> 'a'"
stream next: 3. "--> 'bcd'"
stream next: 2. "--> 'ef'"
-----
stream := ReadStream on: '-143'.
%negative := (stream peek = $-). "look at the first element without reading it"
negative := (stream peek = $-). "読み込むことなく最初の要素を調べる"
negative. "--> true"
%negative ifTrue: [stream next]. "ignores the minus character"
negative ifTrue: [stream next]. "マイナスの文字を無視する"
number := stream upToEnd.
number. "--> '143'"
-----
stream := '-143' readStream.
(stream peekFor: $-) "--> true"
stream upToEnd "--> '143'"
-----
stream := 'abcde' readStream.
stream position: 2.
stream peek "--> $c"
-----
stream := 'abcdef' readStream.
%stream next. "--> $a stream is now positioned just after the a"
stream next. "--> $a ストリームはaの真後ろに位置している"
%stream skip: 3. "stream is now after the d"
stream skip: 3. "dの後ろに位置している"
stream position. "--> 4"
%stream skip: -2. "stream is after the b"
stream skip: -2. "bの後ろに位置している"
stream position. "--> 2"
stream reset.
stream position. "--> 0"
%stream skipTo: $e. "stream is just after the e now"
stream skipTo: $e. "ストリームはeの後ろに移った"
stream next. "--> $f"
stream contents. "--> 'abcdef'"
-----
stream1 := #(1 4 9 11 12 13) readStream.
stream2 := #(1 2 3 4 5 10 13 14 15) readStream.
%"The variable result will contain the sorted collection."
"変数にはソートされたコレクションが含まれる."
result := OrderedCollection new.
[stream1 atEnd not & stream2 atEnd not]
whileTrue: [stream1 peek < stream2 peek
% "Remove the smallest element from either stream and add it to the result."
"両方のストリームのもっとも小さな要素が取り除かれてresultに加えられる."
ifTrue: [result add: stream1 next]
ifFalse: [result add: stream2 next]].
%"One of the two streams might not be at its end. Copy whatever remains."
"どちらかのストリームが終わりにない場合,残っている全てをコピーする."
result
addAll: stream1 upToEnd;
addAll: stream2 upToEnd.
result. "--> an OrderedCollection(1 1 2 3 4 4 5 9 10 11 12 13 13 14 15)"
-----
stream := String new writeStream.
stream
nextPutAll: 'This Smalltalk image contains: ';
print: Smalltalk allClasses size;
nextPutAll: ' classes.';
cr;
nextPutAll: 'This is really a lot.'.
stream contents. "--> 'This Smalltalk image contains: 2322 classes."
This is really a lot.'
-----
string := String streamContents:
[:stream |
stream
print: #(1 2 3);
space;
nextPutAll: 'size';
space;
nextPut: $=;
space;
print: 3. ].
string. "--> '#(1 2 3) size = 3'"
-----
[| temp |
temp := String new.
(1 to: 100000)
do: [:i | temp := temp, i asString, ' ']] timeToRun "--> 115176 (milliseconds)"
[| temp |
temp := WriteStream on: String new.
(1 to: 100000)
do: [:i | temp nextPutAll: i asString; space].
temp contents] timeToRun "--> 1262 (milliseconds)"
-----
String streamContents: [ :tempStream |
(1 to: 100000)
do: [:i | tempStream nextPutAll: i asString; space]]
-----
Object subclass: #History
instanceVariableNames: 'stream'
classVariableNames: ''
poolDictionaries: ''
category: 'PBE-Streams'
History>>initialize
super initialize.
stream := ReadWriteStream on: Array new.
-----
History>>goBackward
self canGoBackward ifFalse: [self error: 'Already on the first element'].
stream skip: -2.
^ stream next.
History>>goForward
self canGoForward ifFalse: [self error: 'Already on the last element'].
^ stream next
-----
History>>goTo: aPage
stream nextPut: aPage.
-----
History>>goTo: anObject
stream nextPut: anObject.
stream nextPut: nil.
stream back.
-----
History>>canGoBackward
^ stream position > 1
History>>canGoForward
^ stream atEnd not and: [stream peek notNil]
-----
History>>contents
^ stream contents
-----
History new
goTo: #page1;
goTo: #page2;
goTo: #page3;
goBackward;
goBackward;
goTo: #page4;
contents "--> #(#page1 #page4 nil nil)"
-----
stream := FileStream forceNewFileNamed: 'test.txt'.
stream
nextPutAll: 'This text is written in a file named ';
print: stream localName.
stream close.
stream := FileStream readOnlyFileNamed: 'test.txt'.
stream contents. "--> 'This text is written in a file named ''test.txt'''"
stream close.
-----
FileStream
forceNewFileNamed: 'test.txt'
do: [:stream |
stream
nextPutAll: 'This text is written in a file named ';
print: stream localName].
string := FileStream
readOnlyFileNamed: 'test.txt'
do: [:stream | stream contents].
string "--> 'This text is written in a file named ''test.txt'''"
-----
FileStream
forceNewFileNamed: 'test.bin'
do: [:stream |
stream
binary;
nextPutAll: #(145 250 139 98) asByteArray].
FileStream
readOnlyFileNamed: 'test.bin'
do: [:stream |
stream binary.
stream size. "--> 4"
stream next. "--> 145"
stream upToEnd. "--> #[250 139 98]"
].
-----
FileStream
forceNewFileNamed: 'test.pgm'
do: [:stream |
stream
nextPutAll: 'P5'; cr;
nextPutAll: '4 4'; cr;
nextPutAll: '255'; cr;
binary;
nextPutAll: #(255 0 255 0) asByteArray;
nextPutAll: #(0 255 0 255) asByteArray;
nextPutAll: #(255 0 255 0) asByteArray;
nextPutAll: #(0 255 0 255) asByteArray
]
-----
===== CHAPTER: Morphic ==========
-----
'Morph' asMorph openInWorld
-----
Color>>asMorph
^ Morph new color: self
-----
joe := Morph new color: Color blue.
joe openInWorld.
bill := Morph new color: Color red .
bill openInWorld.
-----
bill position: (joe position + (100@0))
-----
star := StarMorph new color: Color yellow.
joe addMorph: star.
star position: joe position.
-----
Morph subclass: #CrossMorph
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PBE-Morphic'
-----
drawOn: aCanvas
| crossHeight crossWidth horizontalBar verticalBar |
crossHeight := self height / 3.0 .
crossWidth := self width / 3.0 .
horizontalBar := self bounds insetBy: 0 @ crossHeight.
verticalBar := self bounds insetBy: crossWidth @ 0.
aCanvas fillRectangle: horizontalBar color: self color.
aCanvas fillRectangle: verticalBar color: self color
-----
containsPoint: aPoint
| crossHeight crossWidth horizontalBar verticalBar |
crossHeight := self height / 3.0.
crossWidth := self width / 3.0.
horizontalBar := self bounds insetBy: 0 @ crossHeight.
verticalBar := self bounds insetBy: crossWidth @ 0.
^ (horizontalBar containsPoint: aPoint)
or: [verticalBar containsPoint: aPoint]
-----
horizontalBar
| crossHeight |
crossHeight := self height / 3.0.
^ self bounds insetBy: 0 @ crossHeight
-----
verticalBar
| crossWidth |
crossWidth := self width / 3.0.
^ self bounds insetBy: crossWidth @ 0
-----
drawOn: aCanvas
aCanvas fillRectangle: self horizontalBar color: self color.
aCanvas fillRectangle: self verticalBar color: self color
-----
containsPoint: aPoint
^ (self horizontalBar containsPoint: aPoint)
or: [self verticalBar containsPoint: aPoint]
-----
m := CrossMorph new bounds: (0@0 corner: 300@300).
m openInWorld.
m color: (Color blue alpha: 0.3).
-----
drawOn: aCanvas
| topAndBottom |
aCanvas fillRectangle: self horizontalBar color: self color.
topAndBottom := self verticalBar areasOutside: self horizontalBar.
topAndBottom do: [ :each | aCanvas fillRectangle: each color: self color]
-----
horizontalBar
| crossHeight |
crossHeight := (self height / 3.0) rounded.
^ self bounds insetBy: 0 @ crossHeight
-----
verticalBar
| crossWidth |
crossWidth := (self width / 3.0) rounded.
^ self bounds insetBy: crossWidth @ 0
-----
CrossMorph>>handlesMouseDown: anEvent
^true
-----
CrossMorph>>mouseDown: anEvent
anEvent redButtonPressed "click"
ifTrue: [self color: Color red].
anEvent yellowButtonPressed "action-click"
ifTrue: [self color: Color yellow].
self changed
-----
CrossMorph>>handlesMouseOver: anEvent
^true
-----
CrossMorph>>mouseEnter: anEvent
anEvent hand newKeyboardFocus: self
-----
CrossMorph>>mouseLeave: anEvent
anEvent hand newKeyboardFocus: nil
-----
CrossMorph>>handleKeystroke: anEvent
| keyValue |
keyValue := anEvent keyValue.
keyValue = 30 "up arrow"
ifTrue: [self position: self position - (0 @ 1)].
keyValue = 31 "down arrow"
ifTrue: [self position: self position + (0 @ 1)].
keyValue = 29 "right arrow"
ifTrue: [self position: self position + (1 @ 0)].
keyValue = 28 "left arrow"
ifTrue: [self position: self position - (1 @ 0)]
-----
CrossMorph>>stepTime
^ 100
-----
CrossMorph>>step
(self color diff: Color black) < 0.1
ifTrue: [self color: Color red]
ifFalse: [self color: self color darker]
-----
keyValue = $+ asciiValue
ifTrue: [self startStepping].
keyValue = $- asciiValue
ifTrue: [self stopStepping].
-----
UIManager default request: 'What''s your name?' initialAnswer: 'no name'
-----
UIManager default
chooseFrom: #('circle' 'oval' 'square' 'rectangle' 'triangle')
lines: #(2 4) message: 'Choose a shape'
-----
Morph subclass: #ReceiverMorph
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PBE-Morphic'
-----
ReceiverMorph>>initialize
super initialize.
color := Color red.
bounds := 0 @ 0 extent: 200 @ 200
-----
ReceiverMorph>>wantsDroppedMorph: aMorph event: anEvent
^ aMorph color = Color blue
-----
ReceiverMorph>>repelsMorph: aMorph event: ev
^ (self wantsDroppedMorph: aMorph event: ev) not
-----
ReceiverMorph new openInWorld.
EllipseMorph new openInWorld.
-----
Morph subclass: #DroppedMorph
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PBE-Morphic'
-----
DroppedMorph>>initialize
super initialize.
color := Color blue.
self position: 250@100
-----
DroppedMorph>>rejectDropMorphEvent: anEvent
| h |
h := anEvent hand.
WorldState
addDeferredUIMessage: [h grabMorph: self].
anEvent wasHandled: true
-----
ReceiverMorph new openInWorld.
(DroppedMorph new color: Color blue) openInWorld.
(DroppedMorph new color: Color green) openInWorld.
-----
BorderedMorph subclass: #DieMorph
instanceVariableNames: 'faces dieValue isStopped'
classVariableNames: ''
poolDictionaries: ''
category: 'PBE-Morphic'
-----
DieMorph class>>faces: aNumber
^ self new faces: aNumber
-----
DieMorph>>initialize
super initialize.
self extent: 50 @ 50.
self useGradientFill; borderWidth: 2; useRoundedCorners.
self setBorderStyle: #complexRaised.
self fillStyle direction: self extent.
self color: Color green.
dieValue := 1.
faces := 6.
isStopped := false
-----
DieMorph>>faces: aNumber
"Set the number of faces"
(aNumber isInteger
and: [aNumber > 0]
and: [aNumber <= 9])
ifTrue: [faces := aNumber]
-----
DieMorph>>face1
^{0.5@0.5}
DieMorph>>face2
^{0.25@0.25 . 0.75@0.75}
DieMorph>>face3
^{0.25@0.25 . 0.75@0.75 . 0.5@0.5}
DieMorph>>face4
^{0.25@0.25 . 0.75@0.25 . 0.75@0.75 . 0.25@0.75}
DieMorph>>face5
^{0.25@0.25 . 0.75@0.25 . 0.75@0.75 . 0.25@0.75 . 0.5@0.5}
DieMorph>>face6
^{0.25@0.25 . 0.75@0.25 . 0.75@0.75 . 0.25@0.75 . 0.25@0.5 . 0.75@0.5}
DieMorph>>face7
^{0.25@0.25 . 0.75@0.25 . 0.75@0.75 . 0.25@0.75 . 0.25@0.5 . 0.75@0.5 . 0.5@0.5}
DieMorph >>face8
^{0.25@0.25 . 0.75@0.25 . 0.75@0.75 . 0.25@0.75 . 0.25@0.5 . 0.75@0.5 . 0.5@0.5 . 0.5@0.25}
DieMorph >>face9
^{0.25@0.25 . 0.75@0.25 . 0.75@0.75 . 0.25@0.75 . 0.25@0.5 . 0.75@0.5 . 0.5@0.5 . 0.5@0.25 . 0.5@0.75}
-----
DieMorph>>drawOn: aCanvas
super drawOn: aCanvas.
(self perform: ('face' , dieValue asString) asSymbol)
do: [:aPoint | self drawDotOn: aCanvas at: aPoint]
-----
DieMorph>>drawDotOn: aCanvas at: aPoint
aCanvas
fillOval: (Rectangle
center: self position + (self extent * aPoint)
extent: self extent / 6)
color: Color black
-----
(DieMorph faces: 6) openInWorld.
-----
DieMorph>>dieValue: aNumber
(aNumber isInteger
and: [aNumber > 0]
and: [aNumber <= faces])
ifTrue:
[dieValue := aNumber.
self changed]
-----
DieMorph>>stepTime
^ 100
DieMorph>>step
isStopped ifFalse: [self dieValue: (1 to: faces) atRandom]
-----
DieMorph>>handlesMouseDown: anEvent
^ true
DieMorph>>mouseDown: anEvent
anEvent redButtonPressed
ifTrue: [isStopped := isStopped not]
-----
DieMorph>>drawOn: aCanvas
| theCanvas |
theCanvas := aCanvas asAlphaBlendingCanvas: 0.5.
super drawOn: theCanvas.
(self perform: ('face' , dieValue asString) asSymbol)
do: [:aPoint | self drawDotOn: theCanvas at: aPoint]
-----
===== CHAPTER: クラスとメタクラス ==========
-----
Color blue "--> Color blue"
-----
Color blue class "--> Color"
-----
(Color blue alpha: 0.4) class "--> TranslucentColor"
-----
EllipseMorph new color: (Color blue alpha: 0.4); openInWorld
-----
TranslucentColor superclass "--> Color"
Color superclass "--> Object"
-----
translucentBlue := Color blue alpha: 0.4.
translucentBlue isKindOf: TranslucentColor "--> true"
translucentBlue isKindOf: Color "--> true"
translucentBlue isKindOf: Object "--> true"
-----
Color class "--> Color class"
Object class "--> Object class"
-----
Color subclasses "--> {TranslucentColor}"
TranslucentColor subclasses "--> #()"
TranslucentColor allSuperclasses "--> an OrderedCollection(Color Object ProtoObject)"
TranslucentColor instVarNames "--> #('alpha')"
TranslucentColor allInstVarNames "--> #('rgb' 'cachedDepth' 'cachedBitPattern' 'alpha')"
TranslucentColor selectors "--> an IdentitySet(#pixelWord32 #asNontranslucentColor #privateAlpha #pixelValueForDepth: #isOpaque #isTranslucentColor #storeOn: #pixelWordForDepth: #scaledPixelValue32 #alpha #bitPatternForDepth: #hash #isTransparent #isTranslucent #balancedPatternForDepth: #setRgb:alpha: #alpha: #storeArrayValuesOn:)"
-----
TranslucentColor class superclass "--> Color class"
TranslucentColor superclass class "--> Color class"
-----
TranslucentColor class "--> TranslucentColor class"
TranslucentColor class superclass "--> Color class"
TranslucentColor class superclass superclass "--> Object class"
-----
TranslucentColor blue "--> Color blue"
-----
TranslucentColor new class "--> TranslucentColor Behaviorのインスタンスではない!"
-----
TranslucentColor superclass "--> Color"
Color superclass "--> Object"
-----
TranslucentColor class superclass "--> Color class"
Color class superclass "--> Object class"
Object class superclass superclass "--> Class NB: skip ProtoObject class"
Class superclass "--> ClassDescription"
ClassDescription superclass "--> Behavior"
Behavior superclass "--> Object"
-----
TranslucentColor class class "--> Metaclass"
Color class class "--> Metaclass"
Object class class "--> Metaclass"
Behavior class class "--> Metaclass"
-----
Metaclass class class "--> Metaclass"
Metaclass superclass "--> ClassDescription"
-----
===== CHAPTER: Seaside by Example ==========
-----
WAHelloWorld>>renderContentOn: html
html text: 'hello world'
-----
WAHelloWorld class>>canBeRoot
^ true
-----
html text: 'hello world'. "テキストを表示"
html html: '&ndash;'. "XHTMLの直接指定"
html render: 1. "オブジェクトのレンダリング"
-----
html horizontalRule.
-----
SeasideDemo>>renderContentOn: html
html heading: 'Rendering Demo'.
html heading
level: 2;
with: 'Rendering basic HTML: '.
html div
class: 'subcomponent';
with: htmlDemo.
"render the remaining components ..."
-----
SeasideDemo>>children
^ { htmlDemo . formDemo . editDemo . dialogDemo }
-----
SeasideHtmlDemo>>renderContentOn: html
self renderParagraphsOn: html.
self renderListsAndTablesOn: html.
self renderDivsAndSpansOn: html.
self renderLinkWithCallbackOn: html
-----
SeasideHtmlDemo>>renderParagraphsOn: html
html paragraph: 'A plain text paragraph.'.
html paragraph: [
html
text: 'A paragraph with plain text followed by a line break. ';
break;
emphasis: 'Emphasized text ';
text: 'followed by a horizontal rule.';
horizontalRule;
text: 'An image URI: '.
html image
url: self squeakImageUrl;
width: '50']
-----
SeasideHtmlDemo>>renderListsAndTablesOn: html
html orderedList: [
html listItem: 'An ordered list item'].
html unorderedList: [
html listItem: 'An unordered list item'].
html table: [
html tableRow: [
html tableData: 'A table with one data cell.']]
-----
SeasideHtmlDemo>>renderDivsAndSpansOn: html
html div
id: 'author';
with: [
html text: 'Raw text within a div with id ''author''. '.
html span
class: 'highlight';
with: 'A span with class ''highlight''.']
-----
SeasideHtmlDemo>>renderLinkWithCallbackOn: html
html paragraph: [
html text: 'An anchor with a local action: '.
html span with: [
html anchor
callback: [toggleValue := toggleValue not];
with: 'toggle boolean:'].
html space.
html span
class: 'boolean';
with: toggleValue ]
-----
SeasideFormDemo>>renderContentOn: html
| radioGroup |
html heading: heading.
html form: [
html span: 'Heading: '.
html textInput on: #heading of: self.
html select
list: self colors;
on: #color of: self.
radioGroup := html radioGroup.
html text: 'Radio on:'.
radioGroup radioButton
selected: radioOn;
callback: [radioOn := true].
html text: 'off:'.
radioGroup radioButton
selected: radioOn not;
callback: [radioOn := false].
html checkbox on: #checked of: self.
html submitButton
text: 'done' ]
-----
SeasideDemoWidget>>style
^ '
body {
font: 10pt Arial, Helvetica, sans-serif, Times New Roman;
}
h2 {
font-size: 12pt;
font-weight: normal;
font-style: italic;
}
table { border-collapse: collapse; }
td {
border: 2px solid #CCCCCC;
padding: 4px;
}
#author {
border: 1px solid black;
padding: 2px;
margin: 2px;
}
.subcomponent {
border: 2px solid lightblue;
padding: 2px;
margin: 2px;
}
.highlight { background-color: yellow; }
.boolean { background-color: lightgrey; }
.field { background-color: lightgrey; }
'
-----
SeasideEditCallDemo>>renderContentOn: html
html span
class: 'field';
with: self text.
html space.
html anchor
callback: [self text: (self !\underline{call:}! (SeasideEditAnswerDemo new text: self text))];
with: 'edit'
-----
SeasideEditAnswerDemo>>renderContentOn: html
html form: [
html textInput
on: #text of: self.
html submitButton
callback: [ self !\underline{answer:}! self text ];
text: 'ok'.
]
-----
SeasideDialogDemo>>renderContentOn: html
html anchor
callback: [ self request: 'edit this' label: 'done' default: 'some text' ];
with: 'self request:'.
...
-----
...
html space.
html anchor
callback: [ self inform: 'yes!' ];
with: 'self inform:'.
...
-----
...
html space.
html anchor
callback: [
(self confirm: 'Are you happy?')
ifTrue: [ self inform: ':-)' ]
ifFalse: [ self inform: ':-(' ]
];
with: 'self confirm:'.
-----
WAConvenienceTest>>go
[ self chooseCheese.
self confirmCheese ] whileFalse.
self informCheese
-----
WAConvenienceTest>>chooseCheese
cheese := self
chooseFrom: #('Greyerzer' 'Tilsiter' 'Sbrinz')
caption: 'What''s your favorite Cheese?'.
cheese isNil ifTrue: [ self chooseCheese ]
-----
WAConvenienceTest>>confirmCheese
^self confirm: 'Is ', cheese, ' your favorite cheese?'
-----
WAConvenienceTest>>informCheese
self inform: 'Your favorite cheese is ', cheese, '.'
-----
WAStore>>renderContentOn: html
"... render the title bar ..."
html div id: 'body'; with: task
-----
WAStoreTask>>go
| shipping billing creditCard |
cart := WAStoreCart new.
self isolate:
[[self fillCart.
self confirmContentsOfCart]
whileFalse].
self isolate:
[shipping := self getShippingAddress.
billing := (self useAsBillingAddress: shipping)
ifFalse: [self getBillingAddress]
ifTrue: [shipping].
creditCard := self getPaymentInfo.
self shipTo: shipping billTo: billing payWith: creditCard].
self displayConfirmation.
-----
WANestedTransaction>>go
self inform: 'Before parent txn'.
self isolate:
[self inform: 'Inside parent txn'.
self isolate: [self inform: 'Inside child txn'].
self inform: 'Outside child txn'].
self inform: 'Outside parent txn'
-----
MyStackMachine>>initialize
super initialize.
contents := OrderedCollection new.
-----
MyStackMachineTest>>testDiv
stack
push: 3;
push: 4;
div.
self assert: stack size = 1.
self assert: stack top = (4/3).
-----
MyRPNWidget>>style
^ 'table.keypad { float: left; }
td.key {
border: 1px solid grey;
background: lightgrey;
padding: 4px;
text-align: center;
}
table.stack { float: left; }
td.stackcell {
border: 2px solid white;
border-left-color: grey;
border-right-color: grey;
border-bottom-color: grey;
padding: 4px;
text-align: right;
}
td.small { font-size: 8pt; }'
-----
MyKeypad>>renderStackButton: text callback: aBlock colSpan: anInteger on: html
html tableData
class: 'key';
colSpan: anInteger;
with:
[html anchor
callback: aBlock;
with: [html html: text]]
-----
MyKeypad>>renderStackButton: text callback: aBlock on: html
self
renderStackButton: text
callback: aBlock
colSpan: 1
on: html
-----
MyKeypad>>renderContentOn: html
self ensureStackMachineNotEmpty.
html table
class: 'keypad';
with: [
html tableRow: [
self renderStackButton: '+' callback: [self stackOp: #add] on: html.
self renderStackButton: '&ndash;' callback: [self stackOp: #min] on: html.
self renderStackButton: '&times;' callback: [self stackOp: #mul] on: html.
self renderStackButton: '&divide;' callback: [self stackOp: #div] on: html.
self renderStackButton: '&plusmn;' callback: [self stackOp: #neg] on: html ].
html tableRow: [
self renderStackButton: '1' callback: [self type: '1'] on: html.
self renderStackButton: '2' callback: [self type: '2'] on: html.
self renderStackButton: '3' callback: [self type: '3'] on: html.
self renderStackButton: 'Drop' callback: [self stackOp: #pop]
colSpan: 2 on: html ].
"and so on ... "
html tableRow: [
self renderStackButton: '0' callback: [self type: '0'] colSpan: 2 on: html.
self renderStackButton: 'C' callback: [self stackClearTop] on: html.
self renderStackButton: 'Enter'
callback: [self stackOp: #dup. self setClearMode]
colSpan: 2 on: html ]]
-----
MyKeypad>>type: aString
stackMachine push: (stackMachine pop asString, aString) asNumber.
-----
MyKeypad>>stackOp: op
[ stackMachine perform: op ] on: AssertionFailure do: [ ].
-----
MyKeypad>>type: aString
self inPushMode ifTrue: [
stackMachine push: stackMachine top.
self stackClearTop ].
self inClearMode ifTrue: [ self stackClearTop ].
stackMachine push: (stackMachine pop asString, aString) asNumber.
-----
html anchor
callback: [ self call: (MyDisplayStack new setMyStackMachine: stackMachine)];
with: 'open'
-----
html anchor
callback: [ self answer];
with: 'close'
-----
MyCalculator>>renderContentOn: html
html div id: 'keypad'; with: keypad.
html div id: 'display'; with: display.
-----
MyKeypad>>renderStackButton: text callback: aBlock colSpan: anInteger on: html
html tableData
class: 'key';
colSpan: anInteger;
with: [
html anchor
callback: aBlock;
onClick: "handle Javascript event"
(html updater
id: 'display';
callback: [ :r |
aBlock value.
r render: display ];
return: false);
with: [ html html: text ] ]
-----
MyCalculator class>>initialize
(self registerAsApplication: 'rpn')
addLibrary: SULibrary
-----
new Ajax.Updater(
'display',
'http://localhost/seaside/RPN+Calculator',
{'evalScripts': true,
'parameters': ['_s=zcdqfonqwbeYzkza', '_k=jMORHtqr','9'].join('&')});
return false
-----
===== CHAPTER: リフレクション ==========
-----
w := Workspace new.
w openLabel: 'My Workspace'.
w inspect
-----
w instVarNamed: 'contents' put: 'howdy!'; contentsChanged
-----
Object>>instVarAt: index
"プリミティブ。オブジェクト内で固定長配列で管理されたインスタンス変数を返す。..."
!\textbf{<primitive: 73>}!
"固定長配列の範囲を超えた変数にアクセスする。"
^self basicAt: index - self class instSize
-----
SketchMorph allInstances select: [:c | (c instVarNamed: 'owner') isWorldMorph]
-----
(1@2) instanceVariableValues "--> an OrderedCollection(1 2)"
-----
Object>>instanceVariableValues
"レシーバーのクラスが追加した、すべてのレシーバーのインスタンス変数の値を要素とするコレクションを返す。"
| c |
c := OrderedCollection new.
self class superclass instSize + 1
to: self class instSize
do: [ :i | c add: (self instVarAt: i)].
^ c
-----
1.5 class "--> Float"
1.5 isKindOf: Number "--> true"
1.5 isKindOf: Integer "--> false"
-----
1.5 respondsTo: #floor "--> true Numberがfloorを実装しているので"
1.5 floor "--> 1"
Exception respondsTo: #, "--> true 例外クラスはグループ化することができる"
-----
Morph allSuperclasses size. "--> 2 インヘリタンスの深さ"
Morph allSelectors size. "--> 1378 メソッドの数"
Morph allInstVarNames size. "--> 6 インスタンス変数の数"
Morph selectors size. "--> 998 Morphで新しく定義されたメソッドの数"
Morph instVarNames size. "--> 6 Morphで新しく定義されたインスタンス変数の数"
Morph subclasses size. "--> 45 直接のサブクラスの数"
Morph allSubclasses size. "--> 326 サブクラスの総数"
Morph linesOfCode. "--> 5968 総コード行数"
-----
Point someInstance "--> 0@0"
-----
ByteString allInstances "--> #('collection' 'position' ...)"
ByteString instanceCount "--> 104565"
String allSubInstances size "--> 101675"
-----
Point whichSelectorsAccess: 'x' "--> an IdentitySet(#'\\' #= #scaleBy: ...)"
Point whichSelectorsStoreInto: 'x' "--> an IdentitySet(#setX:setY: ...)"
Point whichSelectorsReferTo: #+ "--> an IdentitySet(#rotateBy:about: ...)"
Point crossReference "--> an Array("
an Array('*' an IdentitySet(#rotateBy:about: ...))
an Array('+' an IdentitySet(#rotateBy:about: ...))
...)
-----
Rectangle whichClassIncludesSelector: #inspect "--> Object"
Rectangle unreferencedInstanceVariables "--> #()"
-----
SystemNavigation default allClassesImplementing: #yourself "--> {Object}"
-----
SystemNavigation default allSentMessages size "--> 24930"
SystemNavigation default allUnsentMessages size "--> 6431"
SystemNavigation default allUnimplementedCalls size "--> 270"
-----
SystemNavigation default browseAllImplementorsOf: #ifTrue:
-----
SystemNavigation default browseMethodsWithSourceString: 'super'.
SystemNavigation default browseAllSelect: [:method | method sendsToSuper ].
-----
[:aClass| aClass methodDict keys select: [:aMethod |
(aClass superclass canUnderstand: aMethod) not ]] value: SmallInteger
"--> an IdentitySet(#threeDigitName #printStringBase:nDigits: ...)"
-----
[:aClass| aClass methodDict keys select: [:aMethod |
(aClass>>aMethod) isAbstract ]] value: Number
"--> an IdentitySet(#storeOn:base: #printOn:base: #+ #- #* #/ ...)"
-----
class := Collection.
SystemNavigation default
browseMessageList: (class withAllSubclasses gather: [:each |
each methodDict associations
select: [:assoc | assoc value sendsToSuper]
thenCollect: [:assoc | MethodReference class: each selector: assoc key]])
name: 'Supersends of ' , class name , ' and its subclasses'
-----
(Object>>#=) methodReference methodSymbol "--> #="
-----
((BrowserEnvironment new forClasses: (Collection withAllSubclasses))
selectMethods: [:method | method sendsToSuper])
label: 'Collection methods sending super';
open.
-----
((BrowserEnvironment new forClasses: (Collection withAllSubclasses))
selectMethods: [:method |
method sendsToSuper
and: [(method parseTree superMessages includes: method selector) not]])
label: 'Collection methods sending different super';
open
-----
Integer>>factorial
"レシーバーの階乗を返す。"
self = 0 ifTrue: [!\underline{thisContext explore. self halt.}! ^ 1].
self > 0 ifTrue: [^ self * (self - 1) factorial].
self error: 'Not valid for negative integers'
-----
SystemNavigation default browseMethodsWithSourceString: 'thisContext'
-----
Object>>subclassResponsibility
"このメッセージは問題のクラスの一連のサブクラスの振る舞いについてのフレームワークを設定する。"
"このメッセージがサブクラスで実装済みであるはずだ、と宣言する。"
self error: 'My subclass should have overridden ', thisContext sender selector printString
-----
OrderedCollection>>add: newObject
!\underline{self halt.}!
^self addLast: newObject
-----
OrderedCollection>>add: newObject
!\underline{self haltIf: \#testAdd.}!
^self addLast: newObject
-----
Object>>haltIf: condition
| cntxt |
condition isSymbol ifTrue: [
"only halt if a method with selector symbol is in callchain"
cntxt := thisContext.
[cntxt sender isNil] whileFalse: [
cntxt := cntxt sender.
(cntxt selector = condition) ifTrue: [Halt signal]. ].
^self.
].
...
-----
ProtoObject subclass: #LoggingProxy
instanceVariableNames: 'subject invocationCount'
classVariableNames: ''
poolDictionaries: ''
category: 'PBE-Reflection'
-----
Object methodDict size "--> 408"
-----
LoggingProxy>>initialize
invocationCount := 0.
subject := self.
-----
LoggingProxy>>invocationCount
^ invocationCount
-----
LoggingProxy>>doesNotUnderstand: aMessage
Transcript show: 'performing ', aMessage printString; cr.
invocationCount := invocationCount + 1.
^ aMessage sendTo: subject
-----
point := 1@2.
LoggingProxy new !\underline{become:}! point.
-----
point invocationCount "--> 0"
point + (3@4) "--> 4@6"
point invocationCount "--> 1"
-----
point class "--> LoggingProxy"
-----
point := 1@2.
LoggingProxy new become: point.
point invocationCount "--> 0"
point rect: (3@4) "--> 1@2 corner: 3@4"
point invocationCount "--> 1"
-----
Point>>rect: aPoint
^ Rectangle origin: (self min: aPoint) corner: (self max: aPoint)
-----
DynamicAcccessors>>doesNotUnderstand: aMessage
| messageName |
messageName := aMessage selector asString.
(self class instVarNames includes: messageName)
ifTrue: [
self class compile: messageName, String cr, ' ^ ', messageName.
^ aMessage sendTo: self ].
^ super doesNotUnderstand: aMessage
-----
myDA := DynamicAccessors new.
myDA x "--> nil"
-----
5 perform: #factorial "--> 120"
6 perform: ('fac', 'torial') asSymbol "--> 720"
4 perform: #max: withArguments: (Array with: 6) "--> 6"
-----
answer42
^42
run: oldSelector with: arguments in: aReceiver
^self perform: oldSelector withArguments: arguments
-----
Demo methodDict removeKey: #answer42 ifAbsent: []
-----
TestRunner>>runCoverage
| packages methods |
... "カバレッジを測定するメソッドを識別する"%@? ???
self collectCoverageFor: methods
-----
TestRunner>>collectCoverageFor: methods
| wrappers suite |
wrappers := methods collect: [ :each | TestCoverage on: each ].
suite := self
reset;
suiteAll.
[ wrappers do: [ :each | each install ].
[ self runSuite: suite ] ensure: [ wrappers do: [ :each | each uninstall ] ] ] valueUnpreemptively.
wrappers := wrappers reject: [ :each | each hasRun ].
wrappers isEmpty
ifTrue:
[ UIManager default inform: 'Congratulations. Your tests cover all code under analysis.' ]
ifFalse: ...
-----
TestCoverage class>>on: aMethodReference
^ self new initializeOn: aMethodReference
TestCoverage>>initializeOn: aMethodReference
hasRun := false.
reference := aMethodReference.
method := reference compiledMethod
-----
TestCoverage>>install
reference actualClass methodDictionary
at: reference methodSymbol
put: self
TestCoverage>>uninstall
reference actualClass methodDictionary
at: reference methodSymbol
put: method
-----
run: aSelector with: anArray in: aReceiver
self mark; uninstall.
^ aReceiver withArgs: anArray executeMethod: method
mark
hasRun := true
-----
SplitJointTest class>>documentation
<ignoreForCoverage>
"self showDocumentation"
^ 'This package provides function.... "
-----
(SplitJoinTest class >> #showDocumentation) pragmas.
"--> an Array(<ignoreForCoverage>)"
(Float>>#+) pragmas "--> an Array(<primitive: 41>)"
-----
Pragma allNamed: #ignoreForCoverage in: SplitJoinTest class "--> an Array(<ignoreForCoverage> <ignoreForCoverage> <ignoreForCoverage>)"
-----
Jump to Line
Something went wrong with that request. Please try again.