Annexe technique

Code des exemples du livre

Première partie

Page 11

Transcript show: 'Bonjour'.

Page 12

Display restoreAfter: [WarpBlt test1]

Page 17

<HTML>

<b> Squeak fonctionne à l'identique dans un navigateur Web </b>

<EMBED

type="application/x-squeak-source"

ALIGN="CENTER"

WIDTH="700"

HEIGHT="600">

</EMBED>

</HTML>

Page 18

<HTML>

<b> Squeak fonctionne à l'identique dans un navigateur Web </b>

<EMBED

type="application/x-squeak-source"

src ="http://m17.limsi.fr/Individu/xavier/maPremiereSqueaklet.sts"

ALIGN="CENTER"

WIDTH="700"

HEIGHT="600">

</EMBED>

</HTML>

Page 19

Display restoreAfter: [WarpBlt test1].

Page 21

MIDIFileReader playURLNamed:

'http://squeak.cs.uiuc.edu/Squeak2.0/midi/wtellovr.mid'.

Page 22

Speaker bigMan say: 'Around midnight'.

Page 23

(Speaker new pitch: 40.0;

              speed: 0.5;

              voice: (KlattVoice new tract: 10;

                                      diplophonia: 0.4;

              jitter: 0.3;

              shimmer: 0.5;

              turbulence: 50)) say: 'Hello from Hell'

Page 27

bunny move: up distance: 0.5

bunny move: forward distance: 2 duration: 4.

 

bunny drum setColor: green.

bunny drum resize: 1/5.

bunny head resize: 1.5.

 

bunny head turn: left turns: 1

 

bunny head turn: left turns: 2 speed: 2

 

saut := bunny move: up. chute := bunny move: down

 

bond := w doInOrder: { saut. chute }.

Page 28

bunny respondWith: [:event | bond start ] to: rightMouseClick.

 

bunny head pointAt: camera duration: eachFrame.

 

bunny head doEachFrame:

[bunny head

pointAt: (camera transformScreenPointToScenePoint: (Sensor mousePoint)

using: bunny)

duration: rightNow].

 

w makeActorFrom: 'path/to/actor.mdl'

Page 29

Celeste open

Page 32

Scamper open

HtmlParser parse: self content readStream

Page 43

Object subclass: #NameOfSubclass

        instanceVariableNames: ''

        classVariableNames: ''

        poolDictionaries: ''

        category: 'Livre-Exemples'

Page 44

ClockMorph new openInWorld

Page 45

ClockMorph subclass: #MyClockMorph

           instanceVariableNames: ''

           classVariableNames: ''

           poolDictionaries: ''

           category: 'Livre-Exemples'

Page 46

step

  | time |

  super step.

  time := String streamContents: [:aStrm | Time now print24: false showSeconds: (showSeconds == true) on: aStrm].

  self contents: time

Page 48

ClockMorph subclass: #MyClockMorph

           instanceVariableNames: ' format24 '

           classVariableNames: ''

           poolDictionaries: ''

           category: 'Livre-Exemples'

 

format24

  format24 isNil ifTrue: [format24 := false].

  ^format24

Page 49

format24: unBooleen

  format24 := unBooleen

Page 50

« ERRATA : dans l’ouvrage, en troisième ligne, on trouve « Time := String … ». Il faut évidemment lire « time := String … », puisqu’il s’agit d’une affectation dans la variable locale time, et non pas dans la variable globale Time, représentant la classe du même nom ».

step

  | time |

  super step.

  time := String streamContents: [:aStrm | Time now print24: self format24 showSeconds: (showSeconds == true) on: aStrm].

  self contents: time

 

 

(myClock := MyClockMorph new) openInWorld

 

 

Deuxième Partie

Page 72

Date class>>fromString: aString

  ^self readFrom: (ReadStream on: aString).

 

Date class>>fromDays: dayCount

  ^self fromJulianDayNumber: dayCount + 2415386

 

Date class>>daysInYear: yearInteger

  ^365 + (self leapYear: yearInteger)

Page 74

Magnitude subclass: #Date

           instanceVariableNames: 'julianDayNumber '

           classVariableNames: 'DaysInMonth FirstDayOfMonth MonthNames SecondsInDay WeekDayNames'

           poolDictionaries: ''

           category: 'Kernel-Magnitudes'

 

Date class>>initialize

  MonthNames := #(January February March April May June July August

  September October November December ).

  SecondsInDay := 24 * 60 * 60.

  DaysInMonth := #(31 28 31 30 31 30 31 31 30 31 30 31 ).

  FirstDayOfMonth := #(1 32 60 91 121 152 182 213 244 274 305 335 ).

  WeekDayNames := #(Monday Tuesday Wednesday Thursday Friday Saturday Sunday ).

 

 ArrayedCollection variableByteSubclass: #String

                    instanceVariableNames: ''

                    classVariableNames: 'AsciiOrder CSLineEnders CSNonSeparators CSSeparators CaseInsensitiveOrder CaseSensitiveOrder HtmlEntities LowercasingTable Tokenish UppercasingTable '

                    poolDictionaries: ''

                    category: 'Collections-Text'

Page 75

ArrayedCollection   subclass: #Text

                    instanceVariableNames: 'string runs '

                    classVariableNames: ''

                    poolDictionaries: 'TextConstants '

                    category: 'Collections-Text'

Page 81

Transcript show: 'hello'.

Transcript show: ' world'.

Transcript cr

 

Transcript show: 'hello' ; show: ' world' ;cr

 

(OrderedCollection with: 1) addAll: #(25 45); add: 35; add: 34

Page 82

Object subclass: #Moteur

        instanceVariableNames: 'puissance cylindree'

        classVariableNames: ''

        poolDictionaries: ''

        category: 'Mecanique'   

Page 83

« code disponible dans Squeak »

Page 84

« code disponible dans Squeak »

Page 86

| x |

x := 3.

x + 1

Page 87

Object subclass: #Moteur

        instanceVariableNames: 'puissance cylindree'

        classVariableNames: ''

        poolDictionaries: ''

        category: 'Mecanique'

 

Object subclass: #Moteur

        instanceVariableNames: 'puissance cylindree'

        classVariableNames: 'LesMoteurs'

        poolDictionaries: ''

        category: 'Mecanique'

Page 88

Array new : 4

String new

String with: $a…

Page 89

#JeSuisUnique

#JeSuisUnique == #JeSuisUnique 

 

| sta |

sta := #((1 + 2) 4).

sta at: 1

 

| dyn |

dyn := Array with: ( 1 + 2) with:4.

dyn at: 1

Page 90

| dyn |

dyn := Array new: 2.

dyn at: 1 put: (1 + 2).

dyn at: 2 put: 4.

dyn at: 1.

 

tableau

      ^#(1 2 3)

 

| t |

t := Exemple new tableau.

t at: 3 put: 4.

t := Exemple new tableau.

 

tableau

      ^#(1 2 3) copy

Page 91

[:y| |temp|

temp := y + 2.

temp sin] value: 3

 

 

x := [3 + 5].

y := 2 + x value

 

 

x := [

  3

     +

     5]. y := 2 +

  x

        value

 

 

|x y w|

x := 5.

y := [ :z | | k i|

k := x + 3.

i := k + 4.

i+k+z].

w := y value: 10.

 

Page 92

2000 factorial, Browser open.

1000 factorial / 999 factorial.

Page 93

Dictionary new at: #lulu put: 3.

Color r: 1 g: 0 b: 0.

MIDIFileReader playFileNamed: 'LetItBe.MID'.

Page 94

(HTTPSocket httpShowGif:

'http://www.altavista.digital.com/av/pix/default/av-adv.gif')

display

 

(FMSound lowMajorScaleOn: FMSound clarinet) play

 

Speaker manWithEditor say: 'Hello readers of this book, I hope you have fun with Squeak'

 

RecordingControlsMorph new openInWorld

Page 95

x := #(1 2).

y := #(1 2).

y = x

 

x := #(1 2).

y := #(1 2).

y == x

 

x := #(1 2).

y := x.

y == x

Page 96

| x |

x := 0.

(3<2) & (x := 1).

X

 

| x |

x := 0.

(3<2) and: [ x:= 1].

X

 

Page 97

| tt |

tt := TranscriptStream new.

tt openLabel: 'Transcript test 1'.

tt openLabel: 'Transcript test 2'.

tt clear.

[Sensor anyButtonPressed] whileFalse:

[1 to: 20 do: [:i | tt print: (2 raisedTo: i-1); cr; endEntry]].

Page 99

n := 100.

f := 1.

2 to: n do: [:i | f := f*i]

 

n := 100.

s := 0.

2 to: n by: 2 do: [:i | s := s+i].

 

n := 100.

f := 1.

[n > 1] whileTrue: [ f := f*n. n := n - 1].

 

|n f|

n := 4.

f := 1.

[n<1] whileFalse: [ f := f*n. n := n - 1].

 

|n f|

n := 4.

f := 1.

[f := f*n. n := n - 1. n<1] whileFalse.

 

array := #(56 1 5 78 5 -3 12 59).

max := array first.

array do: [:uneValeur| uneValeur > max ifTrue: [max := uneValeur]].

Max

Page 101

 | im |

 im := Form fromUser.

3 GIFReadWriter putForm: im onFileNamed: 'test.gif'

 

 | angle f |

 f := Form fromDisplay: (0@0 extent: 300@300).

 angle := 0.

 [Sensor anyButtonPressed] whileFalse:

     [((Form fromDisplay: (Rectangle center: Sensor cursorPoint extent: 130@66)) rotateBy: angle magnify: 2 smoothing: 1) display.

      angle := angle + 5].

f display

Page 102

 [| imageForm sketchMorph |

 "début de fermeture et déclaration de variables"

 (Delay forSeconds: 5) wait. "message à mots clés puis unaire"

 Smalltalk beep; beep. "deux messages unaires envoyés au meme objet"

 (Delay forSeconds: 1) wait.

 imageForm := World imageForm.

 sketchMorph := SketchMorph withForm: imageForm.

 sketchMorph scalePoint: ((1/2) @ (1/2)).

 sketchMorph openInWorld] fork. "fin de fermeture et création d'un processus"

Page 103

|warp src dest|

warp := (WarpBlt toForm: Display)

           cellSize: 1;

           sourceForm: Display;

           cellSize: 2;

           combinationRule: Form over.

src := Array with: -200@-100 with: -50@100 with: 50@100 with: 200@-100.

dest := 0@0 corner: 300@200.

Display restoreAfter: [[Sensor anyButtonPressed] whileFalse: [warp copyQuad: src + Sensor cursorPoint toRect: dest]]

 

 

|note1 note2 note3 instr| "des variables locales"

"un message à mots-clés envoyé à une classe"

instr := AbstractSound soundNamed: 'oboe1'.

"des messages à mots-clés avec plusieurs arguments"

note1 := instr soundForPitch: #c4 dur: 0.5 loudness: 0.4.

note2 := instr soundForPitch: #ef4 dur: 0.5 loudness: 0.4.

note3 := instr soundForPitch: #g4 dur: 0.5 loudness: 0.4.

(note1, note2, note3) play. "des messages binaires –la virgule, méthode de concaténation- et un message unaire -play-"

Page 107

OrderedCollection with: 3 with: 5

 

OrderedCollection new ; add: 3 ; add: 5

 

Page 110

#(1 2 3) * 3

 

#(1 2 3) * #(2 3 4)

Page 111

resultat := String new.

'je n''ai bientôt plus de voyelles' do: [:unCar|

     unCar isVowel

        ifFalse: [resultat := resultat, (String with: unCar)]].

resultat " 'j n'' bntôt pls d vylls' "

 

resultat := String new.

'je n''ai bientôt plus de voyelles' do: [:unCar|

     unCar isVowel

        ifFalse: [resultat := resultat, (String with: unCar)]] without: $n.

resultat "'j '' btôt pls d vylls'"

 

|s|

s := 0.

#(1 2 3 4) do: [:x| s := s+x] separatedBy: [ Transcript cr; show: ' la somme est '; show: s]

Page 112

(#(1 2 3 4 78 54 34 21) select: [:each| each even]) collect: [:each| each

raisedTo: 3]

 

#(1 2 3 4 78 54 34 21) select: [:each| each even] thenCollect: [:each| each

raisedTo: 3] (ou son symétrique collect: thenSelect:).

 

#('chien' 'chat' 'poisson' 'ver') detect: [:each| each size > 5]

Page 113

#('chien' 'chat' 'poisson' 'ver') detect: [:each| each size > 8]

 

#('chien' 'chat' 'poisson' 'ver') detect: [:each| each size > 8] ifNone:

[String new]

Page 121

'je suis découpée, par mes ponctuations : c''est dur' findBetweenSubStrs: #($: $, $.)

 

Mais ou est donc Ornicar' includesSubstring: 'ni' caseSensitive: true

 

'première ligne

deuxième ligne

troisième ligne' lineNumber: 2'aaaa' alike: 'bbbbsdgdfqg'  

'aaaa' alike: 'bbbb'  

'aaaa' alike: 'aaaa'  

 

'*' match: 'Squeak'

'Squea#' match: 'Squeak'

'*que*' match: 'Squeak'

'*q#e*' match: 'Squeak'

Page 126

Time millisecondsToRun: [10000 timesRepeat: [Smalltalk at: #String]].

Time millisecondsToRun: [10000 timesRepeat: [Smalltalk keyAtValue: String]].

 

Time millisecondsToRun: [1000000 timesRepeat: ['aaaaaaaaaaaaaaaaaaaaaaaaaaaaa' = 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaa']].

Time millisecondsToRun: [|x y| 1000000 timesRepeat: ['aaaaaaaaaaaaaaaaaaaaaaaaaaaaa' == 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaa']].

Page 127

 | rnd set max pt |

 set := Set new: 1000.

 rnd := Random new.

 max := 100.

 Time millisecondsToRun:[ 1 to: 10000 do:[:i| pt := (rnd next * max) truncated @ (rnd next * max) truncated. set add: pt]]

 

 | rnd set max pt |

 set := PluggableSet new: 1000.

 set hashBlock:[:item| (item x bitShift: 16) + item y].

 rnd := Random new.

 max := 100.

 Time millisecondsToRun:[1 to: 10000 do:[:i| pt := (rnd next * max) truncated @ (rnd next * max) truncated. set add: pt]]

Page 131

|st|

st := ReadWriteStream on: (OrderedCollection new).

"Ouvre une Stream en lecture-écriture

sur une collection vide"

st nextPut: 1. "Ajoute l'élément 1 à la collection"

st nextPutAll: #(4 8 2 6 7). "Ajoute les 5 éléments à la collection"

st contents. "Renvoie OrderedCollection (1 4 8 2 6 7)"

st reset. "Positionne la Stream au début de la

collection"

st next. "Renvoie 1"

st position: 3. "Positionne la Stream sur le 3e élément

de la collection"

st next "Renvoie 2"

st := #(1 2 5 3 7) readStream. "Ouvre une nouvelle Stream en lecture

sur l'Array (1 2 5 3 7) "

st next. "Renvoie 1. Stream est positionnée au

début de la collection"

st nextPut: 8. "erreur : message non approprié pour cet objet

"interdiction d'écrire avec ce type de Stream "

 

|x|

x := String new.

Time millisecondsToRun: [10000 timesRepeat: [x := x, 'toto']].

 

|x|

x := String new writeStream.

Time millisecondsToRun: [10000 timesRepeat: [x nextPutAll: 'toto']].

x contents

Page 137

|fic|

fic := (FileDirectory on: 'C:\Xavier Briffault\Eyrolles\Squeak\1')

fileNamed: 'test.txt'.

fic nextPutAll: 'chaîne de test'.

fic close.

fic := (FileDirectory on: 'C:\Xavier Briffault\Eyrolles\Squeak\1')

readOnlyFileNamed: 'test.txt'.

fic contentsOfEntireFile. "Renvoie 'chaîne de test'"

Page 156

|inst |

inst := Workspace new.

inst openLabel: 'Workspace'.

inst inspect

Page 157

| instance |

instance := SystemWindow someInstance.

instance class allInstVarNames do: [:each |

  Transcript

     nextPutAll: each ;

     nextPutAll: ' -> ';

     nextPutAll: (instance instVarNamed: each) asString; cr.].

Transcript flush

 

Browser allInstances select: [ :inst | (inst instVarNamed: 'systemOrganizer') notNil. ]

Page 158

SystemWindow instanceCount

 

Smalltalk allClasses select: [:aClass |

  aClass comment asString includesSubString: 'URL']

 

Point whichSelectorsAccess: 'x'

 

Point whichSelectorsStoreInto: 'x'

 

Rectangle whichSelectorsReferTo: #+

 

Point crossReference

 

Rectangle whichClassIncludesSelector: #+

 

Rectangle unreferencedInstanceVariables

 

Smalltalk allClassesImplementing: #+

 

Smalltalk allSentMessages

 

Smalltalk allUnSentMessages

 

Smalltalk allUnimplementedCalls

 

Smalltalk allCallsOn: (Smalltalk associationAt: Point name)

Page 159

niveauDHeritage := Browser allSuperclasses size.

nbMethodes := Browser allSelectors size.

nbInstances := Browser allInstVarNames size.

nbMethodesAjoutees := Browser selectors size.

nbInstanceAjoutees := Browser instVarNames size.

nbSouclasses := Browser subclasses size.

nbTotalSouclasses := Browser allSubclasses size.

Page 160

Browser selectors select: [:selector |

  | method |

  method := Browser compiledMethodAt: selector.

  (method sendsToSuper and: [(method messages includes: selector) not])]

 

ProtoObject allSubclassesDo: [:class |

  class selectors do: [:selector |

     | currentMethod superMethod |

     currentMethod := class compiledMethodAt:selector.

     superMethod := class superclass lookupSelector:selector.

     currentMethod = superMethod

        ifTrue:[

           Transcript

              show: class;

              show: '>>';

              show: selector; cr]]]

Page 161

|pt1 pt2|

pt1 := 0@0.

pt2 := 10@10.

Transcript show: 'pt1 ' ; show: pt1 printString; cr.

Transcript show: 'pt2 ' ; show: pt2 printString; cr.

pt1 become: pt2. "à partir d'ici, pt1 pointe sur pt2 et pt2 sur pt1"

Transcript show: 'pt1 ' ; show: pt1 printString; cr.

Transcript show: 'pt2 ' ; show: pt2 printString; cr.

Page 162

(1 class compiledMethodAt: #+) valueWithReceiver: 1 arguments: #(2)

Page 163

Object subclass: #Stuff

        instanceVariableNames: 'variables'

        classVariableNames: ''

        poolDictionaries: ''

        category: 'Scaffolding'

 

Stuff>>initialize

  variables := IdentityDictionary new.

 

Stuff class>>new

  ^ super new initialize

 

Stuff>>widget

  ^ variables at: #widget

 

Stuff>>widget: aWidget

  variables at: #widget put: aWidget

 

Stuff>>doesNotUnderstand: aMessage

  | key |

  aMessage selector isUnary

     ifFalse: [ key := (aMessage selector copyWithout: $:) asSymbol.

  variables at: key put: aMessage arguments first]

     ifTrue: [^ variables at: aMessage selector ifAbsent: [nil]]

Page 177

Object subclass: #Horloge

        instanceVariableNames: ' process stop '

        classVariableNames: ''

        poolDictionaries: ''

        category: 'Exemples'

 

Horloge>>start

  process resume.

 

Horloge>>stop

  stop := true.

  Transcript cr; show: 'l''horloge est arrêtée'

 

Horloge>>initialize

  process := [| delay |

  delay := Delay forSeconds: 3.

  [stop] whileFalse: [

     delay wait.

     Transcript cr; show: Time now printString]] newProcess.

  process priority: Processor timingPriority.

  stop := false

Page 178

[1 to: 10 do: [:i| Transcript show:' '; show: i printString. ]] fork.

[11 to: 20 do: [:i| Transcript show:' '; show: i printString. ]] fork.

 

p1 := [1 to: 10 do: [:i| Transcript show:' '; show: i printString. Processor yield]. ] newProcess.

p2 := [11 to: 20 do: [:j| Transcript show:' '; show: j printString. Processor yield]. ] newProcess .

p2 resume. p1 resume

Page 180

[1 to: 50 do: [:i| Transcript show:' '; show: i printString. ]] forkAt:

(Processor userBackgroundPriority).

 

[10 timesRepeat: [Transcript show:' '; show: '3'. Processor yield]] forkAt: 2.

[10 timesRepeat: [ Transcript show:' '; show: '2'. Processor yield]] forkAt: 3.

[10 timesRepeat: [ Transcript show:' '; show: '1'. Processor yield]] forkAt: 4.

Page 181

|s p1 p2|

s := Semaphore new.

p1 := [

  Transcript cr; show: 'P1 : je suis le premier'; cr.

  s wait.

  Transcript cr; show: 'P1 : je suis débloqué'; cr.] newProcess priority: 4.

p2 := [

  Transcript show: 'P2 : j''envoie signal au sémaphore S'; cr.

  s signal.

  Transcript show: 'P2 : j''ai envoyé signal à S'.] newProcess priority: 3.

p1 resume. p2 resume.

 

 

|s p1 p2|

s := Semaphore new.

p1 := [

  s wait.

  Transcript cr; show: 'P1 : je suis débloqué'; cr.] newProcess priority: 42.

p2 := [

  Transcript show: 'P2 : j''envoie signal au sémaphore S'; cr.

  s signal.

  Transcript show: 'P2 : j''ai envoyé signal au sémaphore S'.] newProcess priority: 43.

p1 resume.

p2 resume.

Page 183

Object subclass: #TableDePhilosophes

        instanceVariableNames: 'nombreDeDineurs fourchettes philosophes '

        classVariableNames: ''

        poolDictionaries: ''

        category: 'Philosophes'

 

Object subclass: #Philosophe

        instanceVariableNames: 'fourchetteGauche fourchetteDroite nom etat '

        classVariableNames: ''

        poolDictionaries: ''

        category: Philosophes

Page 184

Object subclass: #Fourchette

        instanceVariableNames: 'semaphore '

        classVariableNames: ''

        poolDictionaries: ''

        category: 'Philosophes'

 

Fourchette>> initialize

     semaphore := Semaphore forMutualExclusion

 

Fourchette>>signal

     semaphore signal.

 

Fourchette>>wait

     semaphore wait.

 

Fourchette>>initialize: n

     self nombreDeDineurs: n.

     self fourchettes: (Array new: n).

     self philosophes: (Array new: n).

     1 to: n do: [:p |

           self fourchettes at: p put: (Fourchette new).

           self philosophes at: p put: (Philosophe new: p)].

     1 to: n do: [:p |

           (self philosophes at: p)

           fourchetteGauche: (self fourchettes at: p)

           fourchetteDroite: (self fourchettes at: ((p\\n) + 1))].

Page 185

 

TablesDePhilosophes>>dine: rep

     1 to: self nombreDeDineurs do: [:p |

     (self philosophes at: p) philosopheCycle: rep].

 

Philosophe>>philosopheCycle: rep

     [rep timesRepeat: [

           self pense.

           self recupereFourchettes.

           self mange.

           self relacheFourchettes].

           self etat: #philosopheEndormi.] fork

 

Philosophe>>mange

     self etat: #philosopheMangeant.

     ( Random new next * 20 ) rounded timesRepeat: [Processor yield]

 

 

Philosophe>>pense

     self etat: #philosophePensant.

     ( Random new next * 20 ) rounded timesRepeat: [Processor yield]

Page 186

Philosophe>>recupereFourchettes

  self etat: #philosopheAffame.

  nom \\ 2 == 0

     ifTrue: [

        self fourchetteGauche wait.

        self fourchetteDroite wait.]

     ifFalse: [

        self fourchetteDroite wait.

        self fourchetteGauche wait.]

 

Philosophe>>relacheFourchettes

  self etat: #philosophePosant.

  self fourchetteDroite signal.

  self fourchetteGauche signal.

 

« ERRATA : Dans les deux dernières lignes, de la méthode philosopheCycle:, remplacer Pensant par Endormi »

Philosophe>>philosopheCycle: rep

  [rep timesRepeat: [

     self pense.

     Transcript cr; show: 'Philosophe ', self nom printString, ' est dans l''état #philosophePensant '.

     self recupereFourchettes.

     self mange.

     Transcript cr; show: 'Philosophe ', self nom printString, ' est dans l''état #philosopheMangeant '.

     self relacheFourchettes

     Transcript cr; show: 'Philosophe ', self nom printString, ' est dans l''état # philosophePosant '.].

  self etat: # philosopheEndormi.

  Transcript cr; show: 'Philosophe ', self nom printString, ' est dans l''état # philosopheEndormi '.] fork

 

Troisième Partie

Page 197

Object subclass: #Client

        instanceVariableNames: 'email interets '

        classVariableNames: ''

        poolDictionaries: '

        category: 'Applications-Routage de mails'

 

Object subclass: #Interet

        instanceVariableNames: 'motsRecherches '

        classVariableNames: ''

        poolDictionaries: ''

        category: 'Applications-Routage de mails'

 

Object subclass: #LecteurDeMail

        instanceVariableNames: 'clientPOP '

        classVariableNames: ''

        poolDictionaries: ''

        category: 'Applications-Routage de mails'

Page 198

Object subclass: #Mail

        instanceVariableNames: 'expediteur contenu '

        classVariableNames: ''

        poolDictionaries: ''

        category: 'Applications-Routage de mails'

 

Object subclass: #RouteurDeMail

        instanceVariableNames: 'clients '

        classVariableNames: ''

        poolDictionaries: ''

        category: 'Applications-Routage de mails'

 

Client>>interets

  ^interets

 

Client>>interets: uneCollectionDInterets

  interets := uneCollectionDInterets

Page 199

RouteurDeMail class>>new

  ^super new initialize

Page 200

RouteurDeMail>>initialize

  self clients: OrderedCollection new

 

Mail>>initialize

  self clients: OrderedCollection new

 

Interet>>initialize

  motsRecherches := OrderedCollection new

 

Client>>initialize

  motsRecherches := OrderedCollection new

Page 201

Interet class>>interet1

  | int |

  int := self new.

  int motsRecherches: #('UNIX' 'XML').

  ^int

 

Interet class>>interet2

  | int |

  int := self new.

  int motsRecherches: #('SQUEAK' ).

  ^int

 

Mail class>>message1

  | mess |

  mess := self new.

  mess expediteur: 'AFP@AFP.fr'.

  mess contenu: 'Nouveaux outils XML pour UNIX BSD'.

  ^mess

 

Mail class>>message4

  | mess |

  mess := self new.

  mess expediteur: 'AFP@AFP.fr'.

  mess contenu: 'Nouveaux outils pour SQUEAK sous Windows'.

  ^mess

Page 202

Mail class>>message7

  | mess |

  mess := self new.

  mess expediteur: 'AFP@AFP.fr'.

  mess contenu: 'Sans intérêt'.

  ^mess

 

Client class>>client1

  | client |

  client := self new.

  client email: 'xavier@limsi.fr'.

  client nouvelInteret: Interet interet1.

  client nouvelInteret: Interet interet2.

  ^ client

 

Client class>>client2

  | client |

  client := self new.

  client email: 'xavier@limsi.fr'.

  client nouvelInteret: Interet interet3.

  client nouvelInteret: Interet interet4.

  ^ client

 

Client>>clients

  ^OrderedCollection with: self client1 with: self client2

 

 RouteurDeMail class>>exemple

  | routeur |

  "RouteurDeMail exemple"

  routeur := self new.

  routeur clients: Client clients.

Page 203

Client>>nouvelInteret: unInteret

  self interets add: unInteret

Page 204

RouteurDeMail>>routeMessage: unMail

  | interets |

  self clients do: [:unClient|

     interets := unClient interetsPour: unMail.

     interets notEmpty

        ifTrue: [interets do: [:unInteret| unClient mailRecu: unMail pourLInteret: unInteret]]]

Page 206

Client>>interetsPour: unMail

  ^self interets select: [:unInteret| unInteret estInteressePar: unMail]

 

 Interet>>estInteressePar: unMessage

  | mots |

   mots := unMessage contenu mots.

   self motsRecherches do: [:unMot|

   (mots includes: unMot) ifFalse: [^false]].

   ^true

Page 207

MethodFinder methodFor: {{'Il est minuit'. $ }. #('Il' 'est' 'minuit') asOrderedCollection. }

 

Interet>>mots

  ^ self findTokens: Character space

 

Client>>mailRecu: unMail pourLInteret: unInteret

  Transcript cr;

              show: self printString;

              space; show: ' a été notifié du mail ';

              show: unMail printString;

              show: ' pour l''intérêt ';

              show: unInteret printString

Page 208

RouteurDeMail>>initialize

  self clients: OrderedCollection new.

  lecteurDeMail := LecteurDeMail new routeur: self.

 

RouteurDeMail>>demarrer

  lecteurDeMail commenceLectureToutesLes: 60.

 

RouteurDeMail>>arreter

  lecteurDeMail arreter

Page 209

Object subclass: #LecteurDeMail

        instanceVariableNames: 'serveurPOP nomUtilisateur motDePasse process nbSecondes actif routeur '

        classVariableNames: ''

        poolDictionaries: ''

        category: 'Applications-Routage de mails'

 

LecteurDeMail>>nomUtilisateur

  nomUtilisateur isNil

     ifTrue: [nomUtilisateur := FillInTheBlank request: 'POP User name'].

  ^nomUtilisateur

 

LecteurDeMail>>commenceLectureToutesLes: nombreDeSecondes

  | popSocket |

  nbSecondes := nombreDeSecondes.

  popSocket := POPSocket new.

  popSocket serverName: (self serveurPOP).

  popSocket userName: (self nomUtilisateur).

  popSocket password: (self motDePasse).

  actif := true.

  process :=

     [|messages|

        messages := OrderedCollection new.

        popSocket connectToPOP.

        [[actif] whileTrue: [

           popSocket messagesDo: [ :messageText | messages add: messageText].

           self notifierRouteurDesMessages: (messages collect: [:aPOPMail| Mail fromPOPMailString: aPOPMail]).

           (Delay forSeconds: nbSecondes) wait.

           messages := OrderedCollection new. ]]

        ensure: [

           popSocket disconnectFromPOP.

           messages := OrderedCollection new.]] newProcess.

  process resume.

Page 210

p1 := [1000 timesRepeat: [Transcript show: 'p1'. (Delay forMilliseconds: 200)]] newProcess.

p1 priority: 1.

p1 resume.

Page 211

(Delay forSeconds : 10) wait "attend 10 secondes"

(Delay forMilliseconds : 10) wait "attend 10 millisecondes"

Page 212

Mail>>fromPOPMailString: aPOPMailString

  | popMail mail |

  popMail := MailMessage from: aPOPMailString.

  mail := self new.

  mail expediteur:(popMail fields at: 'from') mainValue;

  contenu: (popMail body content).

  ^mail

Page 213

RouteurDeMail class>>exemplePOP

  | routeur |

  "RouteurDeMail exemplePOP"

  SMTPSocket deliverMailFrom: 'Squeak' to: #('xavier@limsi.fr') text:

  'From: Squeak

  To: xavier@limsi.fr

  Subject: this is a test

  Hello from SQUEAK !'usingServer: 'hendrix.limsi.fr'.

  Smalltalk garbageCollect.

  SMTPSocket deliverMailFrom: 'Squeak' to: #('xavier@limsi.fr') text:

  'From: Squeak

  To: xavier@limsi.fr

  Subject: this is a test

  Nouvelles de XML pour UNIX !'usingServer: 'hendrix.limsi.fr'.

  Smalltalk garbageCollect.

  SMTPSocket deliverMailFrom: 'Squeak' to: #('xavier@limsi.fr') text:

  'From: Squeak

  To: xavier@limsi.fr

  Subject: this is a test

  UNIX : ce mail n''est pas intéressant !'usingServer: 'hendrix.limsi.fr'.

  Smalltalk garbageCollect.

  routeur := self new.

  routeur clients: Client clients.

  routeur demarrer.

  ^routeur

Page 214

Client>>mailRecu: unMail pourLInteret: unInteret

  Transcript cr; show: self printString; space;

              show: ' a été notifié du mail '; show: unMail printString;

              show: ' pour l''intérêt '; show: unInteret printString.

  SMTPSocket deliverMailFrom: 'Routeur de mail Squeak'

  to: (Array with: email) text:

  ('From: ', 'Routeur de mail Squeak', ' To: ', email,

  ' Subject: notification pour l''interet ', unInteret printString,

  '\\\' withCRs, unMail contenu)

  usingServer: self serveurSMTP.

  Smalltalk garbageCollect

 

 RouteurDeMail class>>exempleSouscription

  | routeur |

   "RouteurDeMail exempleSouscription"

   SMTPSocket deliverMailFrom: 'xavier@limsi.fr' to: #('xavier@limsi.fr') text:

   'From: xavier@limsi.fr

   To: xavier@limsi.fr

   Subject: subscribe

   SQUEAK' usingServer: 'hendrix.limsi.fr'.

   Smalltalk garbageCollect.

   SMTPSocket deliverMailFrom: 'Squeak' to: #('xavier@limsi.fr') text:

   'From: Squeak

   To: xavier@limsi.fr

   Subject: this is a test

   Nouvelles de SQUEAK pour UNIX !'usingServer: 'hendrix.limsi.fr'.

   Smalltalk garbageCollect.

   routeur := self new.

   routeur demarrer.

   ^routeur

Page 215

LecteurDeMail>>notifierRouteurDesMessages: listeDeMessages

  (listeDeMessages select: [:unMessage| unMessage subject = 'subscribe'])

     do: [:unMessage|

        routeur nouvelInteret:(unMessage body content findTokens: Character space) pourLeClient: unMessage from].

  (listeDeMessages reject: [:unMessage| unMessage subject = 'subscribe'])

     do: [:unMessage|

        routeur routeMessage: (Mail fromPOPMailString: unMessage text)].

 

self notifierRouteurDesMessages:

  (messages collect: [:aPOPMail| Mail fromPOPMailString: aPOPMail])

 

self notifierRouteurDesMessages:

     (messages collect: [:unMessage| MailMessage from: unMessage]).

 

RouteurDeMail>>nouvelInteret: uneListeDeMots pourLeClient: unMail

  self creerClientSiNecessaire: unMail.

  self ajouterInteret: uneListeDeMots auClient: unMail.

Page 216

RouteurDeMail>>creerClientSiNecessaire: unMail

  | client |

  client := self clientDEMail: unMail.

  client isNil ifTrue: [client := Client new email: unMail].

  self clients add: client.

  ^ client

 

RouteurDeMail>>ajouterInteret: uneListeDeMots auClient: unMail

  (self clientDEMail: unMail) nouvelInteret: (Interet new motsRecherches: uneListeDeMots)

 

RouteurDeMail>>clientDEMail: unMail

  ^self clients detect: [:unClient| unClient email = unMail] ifNone: [nil].

Page 218

|x|

x := 0.

self halt.

10 timesRepeat: [x := x + 1].

Page 223

Morph   subclass: #TestMorph

        instanceVariableNames: ''

        classVariableNames: ''

        poolDictionaries: ''

        category: 'Exemples'

Page 224

TestMorph>>handlesMouseDown: evt

  ^ true

 

TestMorph>>mouseDown: evt

  self position: self position + (10 @ 0).

  Transcript cr; show: 'J''ai bougé'

 

TestMorph>>drawOn: aCanvas

  | colors |

  colors := Color wheel: 10.

  Colors withIndexDo: [:c :i |

     ACanvas  fillOval: (self bounds insetBy: self width // 25 * i + 1) color: c]

Page 225

AlignmentMorph newRow

  addMorph: (EllipseMorph new extent: 40@40; color: Color red);

  addMorph: (EllipseMorph new extent: 50@50; color: Color yellow);

  addMorph: (EllipseMorph new extent: 60@60; color: Color green);

  addMorph: (EllipseMorph new extent: 70@70; color: Color blue);

  position: 20@20;

  openInWorld

Page 226

StringMorph>>test

  | c |

  c := AlignmentMorph newColumn.

  SystemOrganization categories do: [:cat | c addMorph: (StringMorph new contents: cat)].

  ^ c

Page 227

 | s1 s2 s3 b1 b2 b3 row |

 s1 := Switch new.

 s2 := Switch new turnOn.

 s3 := Switch new.

 s2 onAction: [s3 turnOff].

 s3 onAction: [s2 turnOff].

 b1 := (PluggableButtonMorph on: s1 getState: #isOn action: #switch) label: 'S1'.

 b2 := (PluggableButtonMorph on: s2 getState: #isOn action: #turnOn)label: 'S2'.

 b3 := (PluggableButtonMorph on: s3 getState: #isOn action: #turnOn) label: 'S3'.

 b1 hResizing: #spaceFill;vResizing: #spaceFill.

 b2 hResizing: #spaceFill; vResizing: #spaceFill.

 b3 hResizing: #spaceFill; vResizing: #spaceFill.

 row := AlignmentMorph newRow hResizing: #spaceFill; vResizing: #spaceFill;

                       addAllMorphs: (Array with: b1 with: b2 with: b3); extent: 120 @ 35.

 ^ row

Page 228

Object subclass: #ExempleDeListe

        instanceVariableNames: 'list selectedIndex '

        classVariableNames: ''

        poolDictionaries: ''

        category: 'Morphic-Windows'

 

ExempleDeListe>>initialize

  list := (Collection withAllSubclasses collect: [:each | each name]) asSortedCollection: [:a :b | a < b].

  selectedIndex := 1

 

 ExempleDeListe>>openView

  | window aListMorph |

  aListMorph := PluggableListMorph

        on: self

        list: #list

        selected: #listIndex

        changeSelected: #listIndex:

        menu: #listMenu:.

  aListMorph color: Color white.

  window := SystemWindow labelled: 'Exemple de liste'.

  window color: Color blue; addMorph: aListMorph frame: (0 @ 0 corner: 1 @ 1).

  ^ window openInWorldExtent: 380 @ 220

Page 229

ExempleDeListe>>listMenu: aMenu

  | targetClass differentMenu className |

  className := list

     at: selectedIndex

     ifAbsent: [^ aMenu add: 'rien n''est sélectionné' target: self selector: #beep].

  targetClass := Smalltalk

     at: className

     ifAbsent: [^ aMenu add: 'Cette classe n''existe plus' target: self selector: #beep].

  differentMenu := DumberMenuMorph new.

  differentMenu add: 'browse' target: targetClass selector: #browse;

              add: 'inspect' target: targetClass selector: #inspect;

              add: 'explore' target: targetClass selector: #explore.

^ differentMenu

Page 233

| ps zps f32 out ff |

out := FileStream newFileNamed: 'luxo2.movie'.

out binary.

ff := Form extent: 64@64 depth: 32.

#(22 64 64 32 12 100000) , (7 to: 32) do: [:i | out nextInt32Put: i].

3 to: 36 by: 3 do: [:i |

  ps:=i printString. zps:=ps padded: #left to: 3 with: $0.

  f32 := Form fromFileNamed: 'luxo' , zps , '.bmp'.

  f32 displayOn: ff at: 0@0. "Convert down to 16 bits"

  ff display; writeOnMovie: out].

out close.

Page 235

Morph   subclass: #TestMorph

        instanceVariableNames: 'trajectoire '

        classVariableNames: ''

        poolDictionaries: ''

        category: 'Exemples'

 

TestMorph>>initialize

  super initialize.

  trajectoire := OrderedCollection new

 

TestMorph>>demarreAnimation

  trajectoire := OrderedCollection new.

  0

  to: 30

  do: [:i | trajectoire add: self position + (0 @ (10 * i))].

  trajectoire := trajectoire , trajectoire reversed.

  self startStepping

 

Page 236-237

TestMorph>>demarreAnimation

  trajectoire:=OrderedCollection new.

  0 to: 30 do: [:i | trajectoire add: self position + (0 @ (10 * i))].

  trajectoire := trajectoire , trajectoire reversed.

  self startStepping

 

TestMorph>>drawOn: aCanvas

  | colors |

  colors := Color wheel: 10.

  colors withIndexDo: [:c :i | aCanvas fillOval: (self bounds insetBy: self width // 25 * i + 1) color: c]

 

TestMorph>>handlesMouseDown: evt

  ^ true

 

TestMorph>>initialize

  super initialize.

  trajectoire := OrderedCollection new

 

TestMorph>>mouseDown: evt

  self demarreAnimation

 

TestMorph>>step

  trajectoire size > 0

     ifTrue: [self position: trajectoire removeFirst]

 

TestMorph>>stepTime

^ 50

Page 256

 <html><title>Calculateur de factorielle</title>

 <body>

 <form method="POST" action="factorial.html">

 <p><b>Valeur à calculer :</b>

 <input type=text name="number" value="<?request fields notNil

     ifTrue: [request fields at: 'number' ifAbsent: ['0']]

     ifFalse: ['0']?>" size=10 maxlength=10>

 <p><input type=submit name="action" value="Calcul de factorielle">

 <hr>

 <p><b>Factorielle</b>

 <p>

 <?request fields notNil ifTrue: [

     (request fields at: 'number' ifAbsent: ['0']) asNumber factorial] ifFalse: ['nothing yet']?>

 </form>

 </body>

 </html>

 

Page 259

 <html><title>Calculateur de factorielle</title>

 <body>

 <form method="POST" action="factorial.html">

 <p><b>Valeur à calculer :</b>

 <input type=text name="number" value="<?request fields notNil

     ifTrue: [request fields at: 'number' ifAbsent: ['0']]

     ifFalse: ['0']?>" size=10 maxlength=10>

 <p><input type=submit name="action" value="Calcul de factorielle">

 <hr>

 <p><b>Factorielle</b>

 <p>

 <?request fields notNil ifTrue: [

     (request fields at: 'number' ifAbsent: ['0']) asNumber factorial] ifFalse: ['nothing yet']?>

 </form>

 </body>

 </html>

<p>A quelle fréquence voulez vous que la page soit rafraichie (en secondes) ?

<INPUT TYPE="text" NAME="refresh" VALUE="<?(request isKindOf: Collection)

     ifFalse: [request fields at: 'refresh' ifAbsent: [120]] ifTrue: [120]?>" SIZE=3>

<p> <p>Entrez votre texte ici :

<textarea name="note" rows=10 cols=70> </textarea>

<p><input type=submit value="Envoyer votre message">

</FORM>

<HR>

<h2>20 dernières réponses</h2>

<?(request isKindOf: Collection)

     ifTrue: [HTMLformatter show: request reversed]

     ifFalse: [HTMLformatter show: (request fields at: 'current') reversed]?>

</BODY>

</HTML>

Page 270

MAT>>wantsDroppedMorph: aMorph event: evt

  ^ (aMorph isKindOf: SketchMorph) | "Est ce un graphique ? "

  (aMorph isKindOf: SoundTile) | "ou un son ? "

  (aMorph isKindOf: TextMorph) "ou encore un texte ?"

 

MAT>>acceptDroppingMorph: aMorph event: evt

  | contents form soundName txt attrib |

  (aMorph isKindOf: SketchMorph)

     ifTrue: [“Remplace la sélection par l'image déposée”

  form := aMorph form copy.

  aMorph delete.

  attrib := TextAnchor new anchoredMorph: form.

  txt := ' ' asText.

  txt addAttribute: attrib from: 2 to: 2.

  self handleEdit: [textMorph editor zapSelectionWith: txt]].

  (aMorph isKindOf: SoundTile)

     ifTrue: [“Remplace la sélection par un lien représentant le son déposé”

  soundName := aMorph literal copy.

  aMorph delete.

  self handleEdit: [textMorph editor zapSelectionWith: '**SOUND|',soundName,'**'].].

  (aMorph isKindOf: TextMorph)

     ifTrue: [“Remplace la sélection par un lien représentant le texte déposé”

  contents := aMorph contents copy.

  aMorph delete.

  self handleEdit: [textMorph editor zapSelectionWith: contents]].

Page 271

MAT>>wantsDroppedMorph: aMorph event: evt

  ^ aMorph isMATAcceptable

 

MAT>>acceptDroppingMorph: aMorph event: evt

  aMorph isSketch ifTrue: [self acceptDroppingSketch: aMorph event: evt].

  aMorph isText ifTrue: [self acceptDroppingText: aMorph event: evt].

  aMorph isSound ifTrue: [self acceptDroppingSound: aMorph event: evt].

  aMorph delete.

Page 272

MAT>>acceptDroppingSound: aMorph event: evt

  self handleEdit: [textMorph editor zapSelectionWith: '**SOUND|', (aMorph literal),'**'].

 

MAT>>addCustomMenuItems: aCustomMenu hand: aHandMorph

  super addCustomMenuItems: aCustomMenu hand: aHandMorph.

  aCustomMenu addLine.

  aCustomMenu add: 'save as HTML' action: #saveAsHTML.

 

MAT>>saveAsHTML

  self handleEdit: [textMorph editor saveAsHTML]

Page 273

ParagraphEditor>>saveAsHTML

  | sourceStream targetStream aLine start end specialCharacter text htmlFileName file link |

  " Création du fichier de sauvegarde"

  htmlFileName := FillInTheBlank request: 'Save as HTML' initialAnswer: 'mat.htm'.

  htmlFileName isEmpty ifTrue: [^nil].

  file := FileStream newFileNamed: htmlFileName.

  file text.

  specialCharacter := $*.

  " Traduit les attributs de textes utilisés par Squeak en tags HTML"

  text := self text.

  text := self translateSqueakToHTMLtags: text.

  sourceStream := ReadStream on: text.

  targetStream := WriteStream on: ''.

  [sourceStream atEnd] whileFalse: [

     aLine := sourceStream upTo: (Character cr).

     " Recherche les liens représentant des sons "

     start := 1.

     [(start := aLine indexOfSubCollection: (specialCharacter asString)

        startingAt: start ifAbsent: [0]) ~= 0 and: [start < aLine size]]

        whileTrue: ["Extrait les combinaisons contenant **LINK**"

           (aLine at: start+1) = specialCharacter

              ifFalse: [start := start + 1]

              ifTrue: [

                 (end := aLine indexOfSubCollection: (specialCharacter asString) startingAt: (start+2) ifAbsent: [0]) ~= 0

                    ifFalse: [start := start + 2]

                    ifTrue: [

                       (aLine at: end+1) = specialCharacter

                          ifFalse: [start := end+1]

                          ifTrue: [ link := self linkFor: (aLine copyFrom: start+2 to: end-1).

                    link isNil ifFalse: [“remplace la chaîne initiale par le lien http créé par linkFor: ”

                       aLine := aLine copyReplaceFrom: start to: end+1 with: link asString.].

           start := end + 2]]]]. " whileTrue:"

     targetStream nextPutAll: aLine.

     targetStream cr.]. " whileFalse: "

  " écrit les données HTML dans le fichier "

  file nextPutAll: targetStream contents.

  file close.

Page 274

ParagraphEditor>>linkFor: aString

  | fileName returnStr soundName entry samples samplingRate f |

  (soundName := self isStringASound: aString) ifNotNil: [

     "on a trouvé un lien représentant un son"

     fileName := FillInTheBlank request: 'Save as AIFF'

     initialAnswer: soundName,'.aif'.

     fileName isEmpty ifTrue: [^nil].

     " accède au son échantillonné, sauvé dans la librairie de sons "

     entry := SampledSound soundLibrary

        at: soundName asString

        ifAbsent: [self inform: soundName asString, 'non trouvé dans la librairie de sons'. ^ nil].

     entry ifNil: [^ nil].

     samples := entry at: 1.

     samples class isBytes ifTrue: [ samples := SampledSound convert8bitSignedTo16Bit: samples].

     samplingRate := (entry at: 2) asInteger.

     f := (FileStream fileNamed: fileName) binary.

     AbstractSound new storeAIFFSamples: samples samplingRate: samplingRate on: f.

     f close.

     returnStr := '<A HREF="',fileName,'">',fileName,'</A>'.

     ^returnStr.].

  ^nil.

 

ParagraphEditor>>isStringASound: aString

  (aString isNil) ifTrue: [^nil].

  (aString beginsWith: 'SOUND|')

     ifTrue: [^(aString copyFrom: 7 to: aString size)]

     ifFalse: [^nil].

Page 275

ParagraphEditor>>translateSqueakToHTMLtags: aText

  | runArray runs value values readStream targetStream rgbColor fontSize fileName |

  readStream := ReadStream on: (aText string).

  targetStream := WriteStream on: ''.

  targetStream nextPutAll: (HTMLformatter startPage: 'Page created in MAT').

  targetStream nextPutAll: '<PRE>'.

  runArray := aText runs.

  runs := runArray runs.

  values := runArray values.

  1 to: (runs size) do: [:index |

     value := values at: index.

     value do: [:attr |

        (attr isKindOf: TextEmphasis) ifTrue: [

           (attr = TextEmphasis bold)ifTrue: [targetStream nextPutAll: '<B>'].

           (attr = TextEmphasis italic) ifTrue: [targetStream nextPutAll: '<I>'].

           (attr = TextEmphasis underlined) ifTrue: [targetStream nextPutAll: '<U>'].].

           (attr isKindOf: TextColor) ifTrue: [

              rgbColor := MAT generateHTMLRGBfromColor: (attr color).

              targetStream nextPutAll: '<FONT COLOR="',rgbColor,'">'.].

           (attr isKindOf: TextFontChange) ifTrue: [

              fontSize := attr fontNumber + 2.

              targetStream nextPutAll: '<FONT SIZE="',fontSize asString,'">'.].

           (attr isKindOf: TextURL) ifTrue: [

              targetStream nextPutAll: '<A HREF="',attr info,'">'.].

           (attr isKindOf: TextAnchor) ifTrue: [

              fileName := FillInTheBlank request: 'Save as GIF' initialAnswer: 'mat.gif'.

           fileName isEmpty

              ifFalse: [

                 GIFReadWriter putForm: attr anchoredMorph onFileNamed: fileName.

                 targetStream nextPutAll: '<IMG SRC="',fileName,'">'.]." skip ' ' part "]].

     targetStream nextPutAll: (readStream next: (runs at: index)).

     value do: [:attr |

        (attr isKindOf: TextEmphasis) ifTrue: [

           (attr = TextEmphasis bold) ifTrue: [targetStream nextPutAll: '</B>'].

           (attr = TextEmphasis italic) ifTrue: [targetStream nextPutAll: '</I>'].

           (attr = TextEmphasis underlined) ifTrue: [targetStream nextPutAll: '</U>'].].

           (attr isKindOf: TextColor) ifTrue: [targetStream nextPutAll: '</FONT>'].

           (attr isKindOf: TextFontChange) ifTrue: [targetStream nextPutAll: '</FONT>'].

           (attr isKindOf: TextURL)ifTrue: [targetStream nextPutAll: '</A>'].].].

  targetStream nextPutAll: '</PRE>'.

  targetStream nextPutAll: (HTMLformatter endPage).

  ^targetStream contents.   

Page 276

ParagraphEditor>>saveAsHTML2

  | sourceStream targetStream aLine text file |

  (file := self createNewHTMLFile) ifNil: [^nil].

  text := self translateSqueakToHTMLtags2: self text.

  sourceStream := ReadStream on: text.

  targetStream := WriteStream on: ''.

  [sourceStream atEnd] whileFalse: [

     aLine := sourceStream upTo: (Character cr).

     targetStream nextPutAll: (self generateHTMLCodeForLine: aLine);cr.].

  file nextPutAll: targetStream contents.

  file close.

 

 

ParagraphEditor>>translateSqueakToHTMLtags2: aText

  | runArray runs values targetStream readStream |

  readStream := ReadStream on: (aText string).

  targetStream := WriteStream on: ''.

  targetStream nextPutAll: (HTMLformatter startPage: 'Page created in MAT').

  targetStream nextPutAll: '<PRE>'.

  runArray := aText runs.

  runs := aText runs runs.

  values := runArray values.

  1 to: (runs size) do: [:index |

     targetStream nextPutAll: (self   createTagsForTextAttributes: (values at: index)

                                      ofStream: readStream index: index withRuns: runs) ; cr].

  targetStream nextPutAll: '</PRE>'.

  targetStream nextPutAll: (HTMLformatter endPage).

  ^targetStream contents.            

Page 277

ParagraphEditor>>createTagsForTextAttributes: attributes ofStream: readStream index: index withRuns: runs

  | targetStream fileName |

  targetStream := String new writeStream.

  attributes do: [:attr |

     (attr isKindOf: TextAnchor)

        ifTrue: [

           fileName := FillInTheBlank request: 'Save as GIF' initialAnswer: 'mat.gif'.

           fileName isEmpty

              ifFalse: [

                 GIFReadWriter putForm: attr anchoredMorph onFileNamed: fileName.

                 targetStream nextPutAll: '<IMG SRC="',fileName,'">']]

        ifFalse: [targetStream nextPutAll: attr htmlStartTag.]].

  targetStream nextPutAll: (readStream next: (runs at: index)).

  attributes do: [:attr | targetStream nextPutAll: attr htmlEndTag].

  ^targetStream contents

 

TextEmphasis>>htmlStartTag

  (self = TextEmphasis bold) ifTrue: [^ '<B>'].

  (self = TextEmphasis italic) ifTrue: [^ '<I>'].

  (self = TextEmphasis underlined) ifTrue: [^'<U>' ]

Page 284

 GesturalVoice>>addSpeechArea

  | speechArea |

  speechArea := TextMorph new.

  speechArea extent:

  speechArea extent * (self width / speechArea width)) rounded.

  speechArea align: speechArea center with: self face lips position.

  speechArea color: Color red.

  self addMorphFront: speechArea

Page 307

``@aDict at: ``@aKey ifAbsent: ``@aBlock.

 

| `@Temps |

``@.Statements.

``@Boolean ifTrue: [^false].

^true

 

| `@Temps |

``@.Statements.

^``@Boolean not

 

``@object not ifTrue: ``@block

 

``@object ifFalse: ``@block.      

Page 309

TestCase   subclass: #ExampleSetTest

           instanceVariableNames: 'full empty'

           classVariableNames: ''

           poolDictionaries: ''

           category: 'SUnit-Tests'

 

ExampleSetTest>>setUp

  empty := Set new.

  full := Set with: 5 with: #abc

Page 310

ExampleSetTest>>testIncludes

  self assert: (full includes: 5).

  self assert: (full includes: #abc)

 

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: #abc).

  self deny: (full includes: 5)

 

ExampleSetTest>>testIllegal

  self should: [empty at: 5] raise: TestResult error.

  self should: [empty at: 5 put: #abc] raise: TestResult error

Page 315

TestCase   subclass: #TestDistributeur

           instanceVariableNames: 'client1 client2 router'

           classVariableNames: ''

           poolDictionaries: ''

           category: 'Router-Tests'

 

TestDistributeur>>setUp

  |interet1 interet2|

  interet1 := Interet motsRecherches: #('UNIX' 'XML').

  interet2 := Interet motsRecherches: #('SQUEAK' ).

  client1 := Client email: 'xavier@limsi.fr'.

  client1 nouvelInteret: interet1.

  client1 nouvelInteret: interet2.

  client1 := Client email: 'ducasse@iam.unibe.ch'.

  client1 nouvelInteret: interet2.

  router := Router new.

  router clients: Client clients.

 

TestDistributeur>>MessageAvecInteret

  | message1|

  clients: Client clients.

  message1 := Message new.

  message1 expediteur: 'AFP@AFP.fr'.

  message1 contenu: 'Nouveaux outils XML pour UNIX BSD'.

  routeur routeMessage: message1.

  self assert: (router doitNotifier: client1).

  self deny: (router doitNotifier: client2)

 

TestDistributeur>>MessageSansInteret

  | message1|

  message1 := Message new.

  message1 expediteur: 'AFP@AFP.fr'.

  message1 contenu: 'Sans intérêt'.

  routeur routeMessage: message1.

  self deny: (router doitNotifier: client1).

  self deny: (router doitNotifier: client2)