Permalink
Find file
Fetching contributors…
Cannot retrieve contributors at this time
1734 lines (1673 sloc) 49.5 KB
===== SQUEAK BY EXAMPLE ==========
Below follow all the (displayed) code examples from the book "Squeak by
Example".
For details about this book, see: http://SqueakByExample.org
The examples are provided, as is, for your convenience, in case you want
to copy and paste fragments to Squeak 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/SBEtesting.html
===== CHAPTER: Preface ==========
-----
3 + 4 "--> 7 if you select 3+4 and 'print it', you will see 7"
-----
===== CHAPTER: A quick tour of Squeak ==========
-----
Transcript show: 'hello world'; cr.
-----
3 + 4 "--> 7"
-----
testShout
self assert: ('Don''t panic' shout = 'DON''T PANIC!')
-----
shout
^ self asUppercase, '!'
-----
===== CHAPTER: A first application ==========
-----
SimpleSwitchMorph subclass: #SBECell
instanceVariableNames: 'mouseAction'
classVariableNames: ''
poolDictionaries: ''
category: 'SBE-Quinto'
-----
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: #SBEGame
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'SBE-Quinto'
-----
initialize
| sampleCell width height n |
super initialize.
n := self cellsPerSide.
sampleCell := SBECell 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 ].
-----
SBEGame>>cellsPerSide
"The number of cells along each side of the game"
^ 10
-----
SBEGame>>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 := SBECell 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].
-----
SBEGame>>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].
-----
SBECell>>mouseAction: aBlock
^ mouseAction := aBlock
-----
SBECell>>mouseUp: anEvent
mouseAction value
-----
SBEGame>>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 := SBECell 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
-----
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: Understanding message syntax ==========
-----
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 creates a Point object"
3 + 4 "--> 7"
10 - 1 "--> 9"
4 <= 3 "--> false"
(4/3) * 3 = 4 "--> true equality is just a binary message, and Fractions are exact"
(3/4) == (3/4) "--> false two equal Fractions are not the same object"
-----
1 to: 10 "--> (1 to: 10) creates an interval"
Color r: 1 g: 0 b: 0 "--> Color red creates a new color"
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 "unary message is sent first"
"--> aColor"
(2) aPen color: aColor "keyword message is sent next"
-----
aPen go: 100 + 20
(1) 100 + 20 "binary message first"
"--> 120"
(2) aPen go: 120 "then keyword message"
-----
1.5 tan rounded asString = (((1.5 tan) rounded) asString) "--> true parentheses not needed here"
3 + 4 factorial "--> 27 (not 5040)"
(3 + 4) factorial "--> 5040"
-----
(FMSound lowMajorScaleOn: FMSound clarinet) play
"(1) send the message clarinet to the FMSound class to create a clarinet sound.
(2) send this sound to FMSound as argument to the lowMajorScaleOn: keyword message.
(3) play the resulting sound."
-----
(65 @ 325 extent: 134 @ 100) center
(1) 65@325 "binary"
"--> aPoint"
(2) 134@100 "binary"
"--> anotherPoint"
(3) aPoint extent: anotherPoint "keyword"
"--> aRectangle"
(4) aRectangle center "unary"
"--> 132@375"
-----
3 + 4 * 5 "--> 35 (not 23) Binary messages sent from left to right"
3 + (4 * 5) "--> 23"
1 + 1/3 "--> (2/3) and not 4/3"
1 + (1/3) "--> (4/3)"
1/3 + 2/3 "--> (7/9) and not 1"
(1/3) + (2/3) "--> 1"
-----
"As there is no priority among binary messages, the leftmost message + is evaluated first even if by the rules of arithmetic the * should be sent first."
20 + 2 * 5
(1) 20 + 2 "--> 22"
(2) 22 * 5 "--> 110"
-----
"The messages surrounded by parentheses are evaluated first therefore * is sent prior to + which produces the correct behaviour."
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 ] "both the receiver and the argument must be blocks"
4 timesRepeat: [ Beeper beep ] "the argument is evaluated more than once, so must be a block"
(x isReady) ifTrue: [ y doSomething ] "receiver is evaluated once, so is not a block"
-----
| box |
box := 20@30 corner: 60@90.
box containsPoint: 40@50 "--> true"
-----
Transcript show: 'Squeak is '.
Transcript show: 'fun '.
Transcript cr.
-----
Transcript
show: 'Squeak is';
show: 'fun ';
cr
-----
Point new setX: 25 setY: 35; isZero "--> false"
-----
===== CHAPTER: The Smalltalk object model ==========
-----
3 + 4 "--> 7 send '+ 4' to 3, yielding 7"
20 factorial "--> 2432902008176640000 send factorial, yielding a big number"
-----
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. "Class side method blue"
aColor "--> Color blue"
aColor red "--> 0.0 Instance side accessor method red"
aColor blue "--> 1.0 Instance side accessor method blue"
-----
Object subclass: #Dog
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'SBE-CIV'
Dog class
instanceVariableNames: 'count'
Dog subclass: #Hyena
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'SBE-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: 'SBE-Quinto'
-----
TAuthor>>author
"Returns author initials"
^ 'on' "oscar nierstrasz"
-----
BorderedMorph subclass: #SBEGame
uses: TAuthor
instanceVariableNames: 'cells'
classVariableNames: ''
poolDictionaries: ''
category: 'SBE-Quinto'
-----
SBEGame 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"
(1@2) + 4 "--> 5@6 send message + with argument 4 to point (1@2)"
-----
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. If in MVC, then provide a Morphic window for it."
self couldOpenInMorphic
ifTrue: [self openInWorld: self currentWorld]
ifFalse: [self openInMVC]
-----
Morph>>openInWorld
"Add this morph to the world. If in MVC,
then provide a Morphic window for it."
self couldOpenInMorphic
ifTrue: [self openInWorld: self currentWorld]
ifFalse: [self openInMVC].
^ self "Don't do this unless you mean it!"
-----
BorderedMorph>>initialize
"initialize the state of the receiver"
super initialize.
self borderInitialize
-----
anEllipse initString "--> '(EllipseMorph newBounds: (0@0 corner: 50@40) color: Color yellow) setBorderWidth: 1 borderColor: Color black'"
-----
Morph>>initString
^ String streamContents: [:s | self fullPrintOn: s]
-----
BorderedMorph>>fullPrintOn: aStream
aStream nextPutAll: '('.
!\textbf{super fullPrintOn: aStream.}!
aStream nextPutAll: ') setBorderWidth: '; print: borderWidth;
nextPutAll: ' borderColor: ' , (self colorString: borderColor)
-----
Transcript show: 'Squeak 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 Squeak programming environment ==========
-----
SystemNavigation default browseAllCallsOn: #checkExtent: .
-----
SystemNavigation default browseAllCallsOn: #drawOn: from: ScaleMorph .
-----
SystemNavigation default browseAllImplementorsOf: #checkExtent: .
-----
Object>>asSQL
String>>asSQL
Date>>asSQL
-----
refactory := PackageInfo named: 'RefactoringEngine'.
-----
MCHttpRepository
location: 'http://squeaksource.com/SqueakByExample'
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 asCharacter.
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 = ''
-----
Smalltalk recover: 10000.
ChangeList browseRecentLog.
ChangeList browseRecent: 2000.
-----
===== CHAPTER: SUnit ==========
-----
TestCase subclass: #ExampleSetTest
instanceVariableNames: 'full empty'
classInstanceVariableNames: ''
poolDictionaries: ''
category: 'MyTest'
-----
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>>testRemove
"self run: #testRemove"
full remove: 5.
self assert: (full includes: 6).
self deny: (full includes: 5)
-----
(ExampleSetTest selector: #testRemove) debug
-----
ExampleSetTest debug: #testRemove
-----
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
-----
#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'
resumable: true]
-----
TestCase>>run
| result |
result := TestResult new.
self run: result.
^result
-----
TestCase>>run: aResult
aResult runCase: self
-----
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 areAllResourcesAvailable
ifFalse: [^TestResult signalErrorWith:
'Resource could not be initialized'].
[self run: result] ensure: [self resources do:
[:each | each reset]].
^result
-----
TestSuite>>run: aResult
self tests do:
[:each |
self sunitChanged: each.
each run: aResult]
-----
TestResource class>>isAvailable
^self current notNil
-----
TestResource class>>current
current isNil ifTrue: [current := self new].
^current
-----
TestResource>>initialize
self setUp
-----
===== CHAPTER: Basic Classes ==========
-----
Browser new printString "--> 'a Browser'"
-----
TTCFont>>printOn: aStream
aStream nextPutAll: 'TTCFont(';
nextPutAll: self familyName; space;
print: self pointSize; space;
nextPutAll: self subfamilyName;
nextPut: $)
-----
TTCFont allInstances anyOne printString "--> 'TTCFont(BitstreamVeraSans 6 Bold)'"
-----
true "--> true"
3@4 "--> 3@4"
$a "--> $a"
#(1 2 3) "--> #(1 2 3)"
-----
{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 value: 1"
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: Collections ==========
-----
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: {'Squeak' . 'cool'} "--> 'Squeak is cool'"
-----
'look-<t>-here' expandMacros "--> 'look- -here'"
'<1s> is <2s>' expandMacrosWith: 'Squeak' with: 'cool' "--> 'Squeak is cool'"
'<2s> is <1s>' expandMacrosWith: 'Squeak' with: 'cool' "--> 'cool is Squeak'"
'<1p> or <1s>' expandMacrosWith: 'Squeak' with: 'cool' "--> '''Squeak'' or Squeak'"
'<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 ] "error!"
-----
'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 | '*java*' 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 ] "--> 2"
-----
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: Streams ==========
-----
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"
-----
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. "--> true"
negative ifTrue: [stream next]. "ignores the minus character"
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 skip: 3. "stream is now after the d"
stream position. "--> 4"
stream skip: -2. "stream is after the b"
stream position. "--> 2"
stream reset.
stream position. "--> 0"
stream skipTo: $e. "stream is just after the e now"
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."
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: 'SBE-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.
^ self 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. "--> a ByteArray(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 ==========
-----
s := 'Morph' asMorph openInWorld.
s openViewerForArgument
-----
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: 'SBE-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
ifTrue: [self color: Color red].
anEvent yellowButtonPressed
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].
-----
menu := PopUpMenu
labelArray: #('circle' 'oval' 'square' 'rectangle' 'triangle')
lines: #(2 4).
menu startUpWithCaption: 'Choose a shape'
-----
Morph subclass: #ReceiverMorph
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'SBE-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: 'SBE-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: 'SBE-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]
-----
DieMorph>>drawOn: aCanvas
| theCanvas |
theCanvas := aCanvas asBalloonCanvas aaLevel: 3.
super drawOn: aCanvas.
(self perform: ('face' , dieValue asString) asSymbol)
do: [:aPoint | self drawDotOn: theCanvas at: aPoint]
DieMorph>>drawDotOn: aCanvas at: aPoint
aCanvas
drawOval: (Rectangle
center: self position + (self extent * aPoint)
extent: self extent / 6)
color: Color black
borderWidth: 0
borderColor: Color transparent
-----
===== CHAPTER: Classes and metaclasses ==========
-----
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(#alpha: #asNontranslucentColor #privateAlpha #pixelValueForDepth: #isOpaque #isTranslucentColor #storeOn: #pixelWordForDepth: #scaledPixelValue32 #alpha #bitPatternForDepth: #hash #convertToCurrentVersion:refStream: #isTransparent #isTranslucent #setRgb:alpha: #balancedPatternForDepth: #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 not 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"
-----