PROGRAMMATION DE LA GÉOMÉTRIE
CLASSE Carreau
ApplicationModel subclass: #Carreau
instanceVariableNames: 'origine motif visibilité '
classVariableNames: ''
poolDictionaries: ''
category: 'carrelages et papiers'!
Carreau comment:
'champs de la classe Carreau
motifChoisi : le motif sélectionné sur l''écran et auquel on parle.
tracesR : ''invisibles'' ''visibles'' pour la position initiale de l''objet dans une rotation.
tracesT : ''invisibles'' ''visibles'' pour la position initiale de l''objet dans une translation.
tracesS : ''invisibles'' ''visibles'' pour la position initiale de l''objet dans une symétrie.'!
MÉTHODES QUI DONNENT LES CHAMPS DE LA CLASSE Carreau
!Carreau methodsFor: 'valeur des champs'!
motif
^motif!
motif: t1
motif := t1.
^self!
origine
^origine!
origine: t1
origine := t1.
^self!
visibilité
visibilité isNil ifTrue: [visibilité := 'oui'].
^visibilité!
visibilité: t1
visibilité := t1! !
MÉTHODES CRÉES PAR LES ÉL
ÈVES DE CM2!Carreau methodsFor: 'élèves'!
damier
self répète: 5 fois: [self glisseVersLaDroite: 2].
self vaDépartCaché.
self glisseVersLeBas:1.
self glisseVersLaDroite:1.
self soisVisible.
self répète: 5 fois: [self glisseVersLaDroite: 2].
self vaDépartCaché.
self glisseVersLeBas:2.
self soisVisible.
self répète: 5 fois: [self glisseVersLaDroite: 2].
self vaDépartCaché.
self glisseVersLeBas:3.
self glisseVersLaDroite:1.
self soisVisible.
self répète: 5 fois: [self glisseVersLaDroite: 2].!
damier2
self répète: 5 fois: [self glisseVersLaDroite: 2].
self vaDépartCaché.
self glisseVersLeBas:1.
self soisVisible.
self répète: 5 fois: [self glisseVersLaDroite: 2].
self vaDépartCaché.
self glisseVersLeBas:2.
self glisseVersLaDroite: 1.
self soisVisible.
self répète: 5 fois: [self glisseVersLaDroite: 2].
self vaDépartCaché.
self glisseVersLeBas:3.
self soisVisible.
self répète: 5 fois: [self glisseVersLaDroite: 2].! !
ISOMÉTRIES DU PLAN (ROTATIONS ET SYMÉTRIES)
!Carreau methodsFor: 'rotation-symétrie'!
symétrieHorizontale
"exécute une symétrie du motif par rapport a un axe horizontal"
| t |
Carreau tracesS = 'invisibles' ifTrue: [self effaceToi].
self motif: self motif reflectedInY.
t := Carreau tracesT.
Carreau tracesT: 'visibles'.
self glisseVersLeBas: 1.
Carreau tracesT: t.
^self!
symétrieHorizontaleHaut
"exécute une symétrie du motif par rapport a un axe horizontal"
| t |
Carreau tracesS = 'invisibles' ifTrue: [self effaceToi].
t := Carreau tracesT.
Carreau tracesT: 'visibles'.
self motif: self motif reflectedInY.
self glisseVersLeHaut: 1.
Carreau tracesT: t.
^self!
symétrieVerticale
"exécute une symétrie du motif par rapport a un axe vertical"
| t |
Carreau tracesS = 'invisibles' ifTrue: [self effaceToi].
t := Carreau tracesT.
Carreau tracesT: 'visibles'.
self motif: self motif reflectedInX.
self glisseVersLaDroite: 1.
Carreau tracesT: t.
^self!
symétrieVerticaleGauche
"exécute une symétrie du motif par rapport a un axe vertical"
| t |
Carreau tracesS = 'invisibles' ifTrue: [self effaceToi].
t := Carreau tracesT.
Carreau tracesT: 'visibles'.
self motif: self motif reflectedInX.
self glisseVersLaGauche: 1.
Carreau tracesT: t.
^self!
tourneDroite90
| largeur hauteur |
Carreau tracesR = 'invisibles' ifTrue: [self effaceToi].
largeur := self motif extent x.
hauteur := self motif extent y.
self motif: (self motif rotatedByQuadrants: 1).
"cas où le rectangle est horizontal"
largeur > hauteur ifTrue: [
self origine: (largeur -hauteur) + self origine x @self origine y].
self montreToi.!
tourneGauche90
| largeur hauteur |
Carreau tracesR = 'invisibles' ifTrue: [self effaceToi].
largeur := self motif extent x.
hauteur := self motif extent y.
self motif: (self motif rotatedByQuadrants: 1).
self motif: self motif reflectedInX.
self motif: self motif reflectedInY.
largeur < hauteur ifTrue: ["cas où le rectangle est vertical"
self origine: (self origine x) @ ( hauteur - largeur + self origine y)].
self montreToi.
^self! !
RÉCUPÉRATION DU RECTANGLE QUI ENTOURE CHAQUE Carreau
!Carreau methodsFor: 'rectangles'!
tonRectangle
^self origine extent: self motif extent!
tonRectangleBis
^self origine extent: self tonRectangle extent x - 1 @ (self tonRectangle extent y - 1)! !
MÉTHODES SUR LES POSITIONS ET TRANSLATIONS
!Carreau methodsFor: 'position-translation'!
colonne: t1
self répète: t1 fois: [self glisseVersLeBas: 1].
^self!
en: t1
Carreau tracesT = 'invisibles' ifTrue: [ self effaceToi].
self origine: t1.
self montreToi.
^self!
glisseVersLaDroite
self glisseVersLaDroite: 1!
glisseVersLaDroite: t1
| t2 |
Carreau tracesT = 'invisibles' ifTrue: [ self effaceToi].
t2 := self motif extent x.
self origine: self origine x + (t1 * t2) @ self origine y.
self montreToi.
^self!
glisseVersLaGauche
self glisseVersLaGauche: 1!
glisseVersLaGauche: t1
| t2 |
Carreau tracesT = 'invisibles' ifTrue: [ self effaceToi].
t2 := self motif extent x.
self origine: self origine x - (t1 * t2) @ self origine y.
self montreToi.
^self!
glisseVersLeBas
self glisseVersLeBas: 1!
glisseVersLeBas: t1
| t2 |
Carreau tracesT = 'invisibles' ifTrue: [ self effaceToi].
t2 := self motif extent y.
self origine: self origine x @ (self origine y + (t1 * t2)).
self montreToi.
^self!
glisseVersLeHaut
self glisseVersLeHaut: 1!
glisseVersLeHaut: t1
| t2 |
Carreau tracesT = 'invisibles' ifTrue: [ self effaceToi].
t2 := self motif extent y.
self origine: self origine x @ (self origine y - (t1 * t2)).
self montreToi.
^self!
ligne: t1
self répète: t1 fois: [self glisseVersLaDroite: 1].
^self!
vaDépartCaché
Carreau tracesT = 'invisibles' ifTrue: [ self effaceToi].
"s'il y est déjà il doit s'y retirer lui même"
self origine: 0 @ 0.
self visibilité: 'non'.!
vaDépartVisible
Carreau tracesT = 'invisibles' ifTrue: [ self effaceToi].
self visibilité: 'oui'.
self origine: 0 @ 0.
self montreToi.
^self!
vaEn: t1
Carreau tracesT = 'invisibles' ifTrue: [ self effaceToi].
self origine: t1.
self montreToi.
^self! !
CRÉATION DU RÉP
ÈTE!Carreau methodsFor: 'répéter'!
répète: t1 fois: t2
t1 timesRepeat: t2.
^self! !
COULEUR DU BORD DU Carreau
!Carreau methodsFor: 'couleur du bord'!
entoureToiDe: couleur
"exemple
Nounours entoureToiDe:'blanc'.
Nounours entoureToiDe:'bleu'.
Nounours entoureToiDe:'jaune'.
Rose entoureToiDe:'noir'.
Rose entoureToiDe:'rouge'.
Rose entoureToiDe:'vert'.
Rose entoureToiDe:'violet'."
| hauteur largeur |
largeur := self motif extent x.
hauteur := self motif extent y.
"couleur='blanc' ifTrue:[ coul :=ColorValue white].
couleur='bleu' ifTrue:[ coul :=ColorValue blue].
couleur='jaune' ifTrue:[ coul :=ColorValue yellow].
couleur='noir' ifTrue:[ coul :=ColorValue black].
couleur='rouge' ifTrue:[ coul :=ColorValue red].
couleur='vert' ifTrue:[ coul :=ColorValue green].
couleur='magenta' ifTrue:[ coul :=ColorValue magenta].
couleur='violet' ifTrue:[ coul :=ColorValue magenta]."
0 to: hauteur - 1 do: [:i | self motif valueAtPoint: 0 @i put: couleur].
1 to: largeur do: [:j | self motif valueAtPoint: j @ hauteur - 1 put: couleur].
1 to: hauteur -1 do: [:k | self motif valueAtPoint: largeur - 1 @ k put: couleur].
1 to: largeur -1 do: [:l | self motif valueAtPoint: l @ 0 put: couleur].
self montreToi.!
entoureToiDeBlanc
self entoureToiDe: ColorValue white.!
entoureToiDeBleu
self entoureToiDe: ColorValue blue.!
entoureToiDeJaune
self entoureToiDe: ColorValue yellow.!
entoureToiDeNoir
self entoureToiDe: ColorValue black.!
entoureToiDeRouge
self entoureToiDe: ColorValue red.!
entoureToiDeVert
self entoureToiDe: ColorValue green.!
entoureToiDeViolet
self entoureToiDe: ColorValue magenta.! !
PROGRAMME DE CRÉATION DE PAPIERS PEINTS
!Carreau methodsFor: 'création de papiers'!
créePapier
Colombe effaceTout.
Colombe vaDépartVisible.
Colombe créeUneRangée.
Colombe vaDépartCaché.
Colombe symétrieHorizontale.
Colombe soisVisible.
Colombe créeUneRangée.
Colombe vaDépartCaché.
Colombe glisseVersLeBas: 1.Colombe symétrieHorizontale. Colombe soisVisible.
Colombe créeUneRangée.
Colombe vaDépartCaché.
Colombe glisseVersLeBas: 2.Colombe symétrieHorizontale. Colombe soisVisible.
Colombe créeUneRangée.!
créePapierBis
self effaceTout.
self en: 0@0.
self rangée.
self vaDépartCaché.
self symétrieHorizontale. self soisVisible.
self rangée.
self vaDépartCaché.
self glisseVersLeBas: 1.self symétrieHorizontale. self soisVisible.
self rangée.
self vaDépartCaché.
self glisseVersLeBas: 2.self symétrieHorizontale. self soisVisible.
self rangée.!
créeUneRangée
Colombe répète: 8 fois: [ Colombe symétrieVerticale].!
rangée
self répète: 8 fois: [ self symétrieVerticale].! !
RENSEIGNEMENTS SUR CE QUI SE PASSE AUTOUR DU POINT CLIQUÉ ET LISTE DES CARREAUX AFFICHÉS
!Carreau methodsFor: 'autour-pointCliqué'!
carreauxOrigineIntérieure: unRect
"rend la liste de tous les carreaux dont l'origine est intérieure à ce rectangle"
| prem mo listeCarreaux |
listeCarreaux := OrderedCollection new.
Comp components size > 0 ifTrue: [prem := Comp components removeFirst].
mo := Comp components select: [:f | (unRect containsPoint: f origin)
| (unRect containsPoint: f origin + f component extent) | (unRect containsPoint: f origin + (f component width @ 0)) | (unRect containsPoint: f origin + (0 @ f component height))].
Comp components addFirst: prem.
mo
do:
[:x |
| t |
t := Carreau new.
t origine: x origin.
t motif: x component.
listeCarreaux add: t].
^listeCarreaux!
listeCarreaux
"rend la liste de tous les carreaux affichés"
| prem mo listeCar |
listeCar := OrderedCollection new.
Comp components size > 0 ifTrue: [prem := Comp components removeFirst].
mo := Comp components .
mo
do:
[:x |
| t |
t := Carreau new.
t origine: x origin.
t motif: x component.
listeCar add: t].
Comp components addFirst: prem.
^listeCar!
rendAutour: unPoint
"rend la liste de tous les carreaux affichés pour lequel ce point est intérieur"
| prem mo listeCarreaux |
listeCarreaux := OrderedCollection new.
Comp components size > 0 ifTrue: [prem := Comp components removeFirst].
mo := Comp components select: [:x | (x origin extent: x component extent)
containsPoint: unPoint].
mo
do:
[:x |
| t |
t := Carreau new.
t origine: x origin.
t motif: x component.
listeCarreaux add: t].
Comp components addFirst: prem.
^listeCarreaux!
rendObjetCliqué
"rend l'objet sur lequel on clique"
| obj listeObjets |
listeObjets := (self rendAutour: Vue controller sensor waitClickButton ) .
listeObjets size > 0 ifTrue: [ obj := listeObjets first] ifFalse: [obj := nil].
^obj!
supprimeCarreauxAutour: unPoint
"efface tous les carreaux affichés pour lequel ce point est intérieur"
| prem mo |
Comp components size > 0 ifTrue: [prem := Comp components removeFirst].
mo := Comp components reject: [ :x | (x origin extent: x component extent) containsPoint: unPoint ].
mo addFirst: prem.
Comp components: mo.
Build1 window refresh.
Win refresh.! !
AFFICHAGE DES CARREAUX À L'ÉCRAN
!Carreau methodsFor: 'affichage-écran'!
effaceToi
self supprimeCarreauxAutour: self origine.
"rafraîchissement de la fenêtre Visual"
Build1 window refresh.
Win refresh.
Win1 refresh.
effaceTout
| nbre |
nbre := Comp components size - 1.
nbre timesRepeat: [Comp components removeLast].
"rafraîchissement de la fenêtre Visual"
Build1 window refresh.
Win refresh.
Win1 refresh.!
montreToi
| prem mo |
Comp components size > 0 ifTrue: [prem := Comp components removeFirst].
self visibilité = 'oui'
ifTrue:
["on supprime les objets déjà présents au même endroit que l'objet"
mo := Comp components reject: [:u | u origine = self origine].
mo addFirst: prem.
Comp components: mo.
Comp add: self motif at: self origine.
"Build1 window refresh."
"Win refresh"].
self visibilité = 'non'
ifTrue:
["on supprime l'objet s'il est déjà présent visible"
mo := Comp components reject: [:u | u component = self motif & (u origine = self origine)].
mo addFirst: prem.
Comp components: mo].
"T1 est un objet de la classe CarreauCoordonnées créé par la méthode début"
T1 abscisse value = Carreau motifCourant origine x ifFalse: [
T1 abscisse value: Carreau motifCourant origine x].
T1 ordonnée value = Carreau motifCourant origine y ifFalse: [T1 ordonnée value: Carreau motifCourant origine y].
T1 affichePoint value: 'POINT: ' , Carreau motifCourant origine printString.!
soisInvisible
self visibilité: 'non'.
self effaceToi.!
soisVisible
self visibilité: 'oui'.
self montreToi! !
INVERSION VIDÉO AVEC COMBINAISON DE COULEURS
!Carreau methodsFor: 'superpositions'!
combineAvec: unAutre en: unPoint règle: unNombre
| im1 im2 bis im0 rectangleUt ori |
im1 := (self motif) copy.
im2 := unAutre motif.
rectangleUt := ( self encadrement: unAutre).
"ori est le point d'origine des nouveaux axes"
ori := rectangleUt origin.
im0 := Image extent: (rectangleUt extent) depth: im1 depth palette: im1 palette .
"*******"
im0 copy: (self origine - ori extent: im1 extent)
from: 0@0
in: im1
rule: unNombre.
"********"
im0 copy: (unAutre origine - ori extent: im2 extent)
from: 0@0
in: im2
rule: unNombre.
bis := self class new.
bis motif: im0.
bis origine: unPoint.
bis visibilité: 'oui'.
^bis!
encadrement: car
"cette méthode crée le rectangle minimum qui contient les deux rectangles à partir du carreau self et du carreau car"
| x1 x2 xm y1 y2 ym coin1 coin2 xM yM |
"pour les origines on prend les minima"
x1 := self origine x. y1 := self origine y.
x2 := car origine x. y2 := car origine y.
xm := x1 min: x2. ym := y1 min: y2.
"pour les coins on prend les maxima"
coin1 := self tonRectangle corner.
coin2 := car tonRectangle corner.
x1 := coin1 x. y1 := coin1 y.
x2 := coin2 x. y2 := coin2 y.
xM := x1 max: x2. yM := y1 max: y2.
"on rend le rectangle"
^ xm @ ym corner: xM @yM.! !
ACTIONS GÉOMÉTRIQUES DIVERSES
!Carreau methodsFor: 'actions-diverses'!
rotationAvecTrace
Carreau tracesR: 'visibles'!
rotationSansTrace
Carreau tracesR: 'invisibles'!
symétrieAvecTrace
Carreau tracesS: 'visibles'!
symétrieSansTrace
Carreau tracesS: 'invisibles'!
translationAvecTrace
Carreau tracesT: 'visibles'!
translationSansTrace
Carreau tracesT: 'invisibles'! !
!
Carreau class
instanceVariableNames: 'motifCourant tracesR tracesT tracesS '!
MÉTHODES D'INITIALISATION (SAUVEGARDE SUR DISQUE DES DESSINS NÉCÉSSAIRES POUR LE LOGICIEL)
!Carreau class methodsFor: 'démarrage'!
coordonnées
T1 := Carreau new.
Carreau openOn: T1!
créeGlobales
"on crée les variables globales Rose,Nounours,PetitTrain.....,Clown,Eléphant qui sont sauvées sont comme objets Carreau dans le dossier dessins"
| chemin |
chemin := Filename findDefaultDirectory head .
Liste:= ( Filename named: chemin,'dessins') directoryContents. Liste do: [:nom|Smalltalk at: nom asSymbol put: (MonOutil ramèneObjetEnregistréSous: chemin,'dessins:', nom)].
"***********************"
Smalltalk at: #Imprimante put: (MonOutil ramèneObjetEnregistréSous: chemin,'dessins:','Imprimante').
Smalltalk at: #PetitTrainBis put: (MonOutil ramèneObjetEnregistréSous: chemin,'dessins:','PetitTrain').
Smalltalk at: #PandaBis put: (MonOutil ramèneObjetEnregistréSous: chemin,'dessins:','Panda').
Smalltalk at: #PetitAneBis put: (MonOutil ramèneObjetEnregistréSous: chemin,'dessins:','PetitAne').
Smalltalk at: #PerroquetBis put: (MonOutil ramèneObjetEnregistréSous: chemin,'dessins:','Perroquet').
Smalltalk at: #ClownBis put: (MonOutil ramèneObjetEnregistréSous: chemin,'dessins:','Clown').
Smalltalk at: #EléphantBis put: (MonOutil ramèneObjetEnregistréSous: chemin,'dessins:','Eléphant').
Smalltalk at: #SirèneBis put: (MonOutil ramèneObjetEnregistréSous: chemin,'dessins:','Sirène').
Smalltalk at: #NainBis put: (MonOutil ramèneObjetEnregistréSous: chemin,'dessins:','Nain').
Smalltalk at: #LampeBis put: (MonOutil ramèneObjetEnregistréSous: chemin,'dessins:','Lampe').
Smalltalk at: #CosmonauteBis put: (MonOutil ramèneObjetEnregistréSous: chemin,'dessins:','Cosmonaute').
Smalltalk at: #LapinBis put: (MonOutil ramèneObjetEnregistréSous: chemin,'dessins:','Lapin').
Smalltalk at: #CanardPeterBis put: (MonOutil ramèneObjetEnregistréSous: chemin,'dessins:','CanardPeter').!
début
| rect |
rect := Win displayBox.
Win close.
Comp := EcranPartage new.
Comp add: Vue borderedIn: La.
Win component: (BoundedWrapper on: Comp).
Win openIn: rect.
"GCPapierPeint := Win graphicsContext."
^self!
initialiseToi
Vue := CarreauVue new.
(Ct := CarreauControleur new) view: Vue.
Win := ScheduledWindow openNewIn: (100 @100 corner: 150 @ 150) withType: #normal backgroundColor: ColorValue orchid .Win close. Win open.
(Comp := EcranPartage new) .
La := LayoutFrame new.
La leftFraction: 0.
La rightFraction:1.
La topFraction: 0.
La bottomFraction: 1.
Carreau motifCourant: Rose.
Carreau tracesR: 'visibles'! !
MÉTHODES DE LA CLASSE Carreau (CRÉATION D'OBJETS)
!Carreau class methodsFor: 'création objets'!
copieUnRectangle: unRectangle
" exemple: Carreau copieUnRectangle: (0@0 corner: 40@40)"
CopieEcran copieEcranSur:unRectangle.!
créeRectangle: unPoint couleur: uneCouleur
| t im c |
"crée un rectangle creux de couleur uneCouleur"
c := Carreau new.
t := (Pixmap extent: unPoint).
t graphicsContext paint: uneCouleur;
displayPolygon: ( Array with: 0@0 with: unPoint x @0 with:unPoint with: 0@unPoint y ).
t graphicsContext paint: ColorValue white ; displayRectangle: (1@1 extent: unPoint - (2@2)).
im :=t asImage.
c motif: im.
c visibilité: 'oui'.
c origine: 0@0.
^c!
créeUnGrandObjet
| t1 |
(t1 := Carreau new) origine: 0 @ 0.
t1 visibilité: 'oui'.
t1 motif: CopieEcran copieEcranSurGrandCarré.
^t1!
créeUnMoyenObjet
| t1 |
(t1 := Carreau new) origine: 0 @ 0.
t1 visibilité: 'oui'.
t1 motif: CopieEcran copieEcranSurMoyenCarré.
^t1!
créeUnObjet
| t1 |
(t1 := Carreau new) origine: 0 @ 0.
t1 visibilité: 'oui'.
t1 motif: CopieEcran copieEcranSurPetitCarré.
^t1!
créeUnObjetQuelconque
"exemple
Carreau créeUnObjetQuelconque."
| t1 |
(t1 := Carreau new) origine: 0 @ 0.
t1 visibilité: 'oui'.
t1 motif: Image fromUser.
^t1!
créeUnTrèsGrandObjet
| t1 |
(t1 := Carreau new) origine: 0 @ 0.
t1 visibilité: 'oui'.
t1 motif: CopieEcran copieEcranSurTrèsGrandCarré.
^t1! !
MÉTHODES DE LA CLASSE Carreau (CONNAISSANCE DU MOTIF COURANT c'est à dire le carreau actif dans papier peint )
!Carreau class methodsFor: 'valeur des champs'!
motifCourant
"motifCourant remplace Truc"
motifCourant isNil ifTrue: [ motifCourant := Rose] ifFalse:
[^motifCourant]!
motifCourant: t1
"motifCourant remplace Truc"
motifCourant := t1!
tracesR
^tracesR!
tracesR: t1
tracesR := t1!
tracesS
^tracesS!
tracesS: t1
tracesS := t1!
tracesT
^tracesT!
tracesT: t1
tracesT := t1! !
MÉTHODES DE LA CLASSE Carreau (menus)
!Carreau class methodsFor: 'resources'!
menu1
"UIMenuEditor new openOnClass: self andSelector: #menu1"
^#(#PopUpMenu #('début' ) #() #(#(#PopUpMenu #('Carreau début' 'CarreauVisual début' ) #() #(#début #visualDébut ) ) ) ) decodeAsLiteralArray! !
MÉTHODES DE LA CLASSE Carreau (travaux d'élèves)
!Carreau class methodsFor: 'élèves'!
superDamierAvec: motif1 Et: motif2
motif1 effaceTout.
motif1 vaDépartVisible.
motif1 damier .
motif2 vaDépartCaché.
motif2 glisseVersLaDroite.
motif2 soisVisible.
motif2 damier2.! !
CLASSE ObjetsDivers (SOUS CLASSE DE Carreau)
Carreau subclass: #ObjetsDivers
instanceVariableNames: 'mini '
classVariableNames: ''
poolDictionaries: ''
category: 'carrelages et papiers'!
MÉTHODES DE GESTION DES ObjetsDivers AVEC LA SOURIS
!ObjetsDivers methodsFor: 'souris-click'!
effaceDernierAvecSouris
| point |
"on s'assure qu'au moins un objet a été posé sur l'écran"
Comp components size < 2
ifFalse:
[point := self pointCliquéAttendu.
(self fabriqueRectangle containsPoint: point)
ifTrue: [Carreau motifCourant effaceToi]].
^point!
emmèneAvecSouris: unObjet
| ori gc |
ori := unObjet origine.
gc := Win1 graphicsContext.
unObjet motif follow: [ori := Vue1 controller sensor cursorPoint]
while: [Vue1 controller sensor noButtonPressed ]
on: gc.
unObjet en: ori.
Carreau motifCourant: unObjet.
^ori!
fabriqueRectangle
"fabrique le rectangle du dernier objet posé"
| forme origin rect |
Comp components size < 2
ifFalse:
[forme := Comp components last component.
origin := Comp components last origin.
rect := Rectangle origin: origin extent: forme extent.
^rect]!
pointCliqué
^Vue controller sensor waitButton!
pointCliquéAttendu
^Vue1 controller sensor waitClickButton!
rendObjetCliqué
"rend l'objet sur lequel on clique"
| obj listeObjets |
listeObjets := (self rendAutour: Vue1 controller sensor waitClickButton ) .
listeObjets size > 0 ifTrue: [ obj := listeObjets first] ifFalse: [obj := nil].
^obj! !
MÉTHODES QUI AFFICHENT LES ObjetsDivers SUR L'ÉCRAN ET QUI ASSURENT LEUR SAUVEGARDE SUR LE DISQUE DUR
!ObjetsDivers methodsFor: 'affichage-écran'!
montreToi
Comp components size > 0 ifTrue: [Prem := Comp components removeFirst].
"on supprime les objets déjà présents au même endroit que l'objet"
Mo := Comp components reject: [:u | u origine = self origine].
Mo addFirst: Prem.
Comp components: Mo.
Comp add: self motif at: self origine.! !
!ObjetsDivers methodsFor: 'actions-sauvegarde'!
chercherSurDisqueC
"propose un menu déroulant où l'enfant peut reprendre une forme sauvée dans le dossier des carreaux"
| listeMenu menu t listeCarreaux nomDossier utilisateur chemin |
utilisateur:= ObjetsDivers prénom.
chemin := Filename findDefaultDirectory head .
nomDossier := chemin,utilisateur,' carreaux:'.
listeCarreaux := (Filename named: nomDossier) directoryContents.
listeMenu := OrderedCollection new.
listeCarreaux do: [:x | listeMenu add: (Array with: x)].
menu := PopUpMenu labelList: listeMenu values: listeCarreaux.
"t vaut zéro quand on clique en dehors du menu"
t := menu startUp.
t = 0
ifFalse:
[Carreau motifCourant: (MonOutil ramèneObjetEnregistréSous: nomDossier,t).
Carreau motifCourant en: 0 @ 0]!
chercherSurDisqueP
" propose un menu déroulant où l'enfant peut reprendre unpapier créé"
| utilisateur nomDossier listePapiers listeMenu menu t liste chemin |
utilisateur:= ObjetsDivers prénom.
chemin := Filename findDefaultDirectory head .
nomDossier := chemin,utilisateur,' papiers:'.
listePapiers := (Filename named: nomDossier) directoryContents.
listeMenu := OrderedCollection new.
listePapiers do: [:x | listeMenu add: (Array with: x)].
menu := PopUpMenu labelList: listeMenu values: listePapiers.
t := menu startUp.
"t vaut zéro quand on clique en dehors du menu"
t = 0
ifFalse:
[liste := MonOutil ramèneListeEnregistréeSous: nomDossier,t.
liste do: [:x| x montreToi]]!
nomElève
"on demande le prénom de l'élève et s'il n'existe pas encore 2 dossier vides sont créés à son nom, l'un pour les carreaux l'autre pour les papiers"
| t t1 t2 chemin |
chemin := Filename findDefaultDirectory head .
t := DialogView request: 'quel est ton prénom ?'.
ObjetsDivers prénom: t.
t1 := t,' carreaux'.
t2 := t,' papiers'.
(Filename named: chemin,t1 ) exists ifFalse: [(Filename named: chemin,t1) makeDirectory].
(Filename named: chemin,t2) exists ifFalse: [(Filename named: chemin,t2) makeDirectory].!
sauverSurDisqueC
| t utilisateur nomDossier chemin |
utilisateur:= ObjetsDivers prénom.
chemin := Filename findDefaultDirectory head .
nomDossier := chemin,utilisateur,' carreaux:'.
t := (DialogView request: 'sauve l''objet en: ').
"on sauve l'objet sur le disque"
MonOutil sauve: Carreau motifCourant en: nomDossier,t .
"éventuellement on crée une variable globale qui permettra à l'enfant de parler à son objet"
"Smalltalk at: t asSymbol put: Carreau motifCourant ."!
sauverSurDisqueP
| t liste utilisateur nomDossier chemin |
"on sauve dans le dossier Alain papiers le papier-peint"
t := (DialogView request: 'sauve l''objet en: ').
chemin := Filename findDefaultDirectory head .
utilisateur:= ObjetsDivers prénom.
nomDossier := chemin,utilisateur,' papiers:'.
" liste donne la liste des carreaux affichés sur l'écran"
liste := self listeCarreaux.
MonOutil sauveListe: liste en: nomDossier,t.! !
ACTIONS SUR LES IC
ONES AVEC LA SOURIS!ObjetsDivers methodsFor: 'actions-icônes'!
bateau
Carreau motifCourant: BateauBis.
self emmèneAvecSouris: BateauBis.!
canardPeter
Carreau motifCourant: CanardPeterBis.
self emmèneAvecSouris: CanardPeterBis.!
clown
Carreau motifCourant: ClownBis.
self emmèneAvecSouris: ClownBis.!
cosmonaute
Carreau motifCourant: CosmonauteBis.
self emmèneAvecSouris: CosmonauteBis.!
lampe
Carreau motifCourant: LampeBis.
self emmèneAvecSouris: LampeBis.!
lapin
Carreau motifCourant: LapinBis.
self emmèneAvecSouris: LapinBis.!
nain
Carreau motifCourant: NainBis.
self emmèneAvecSouris: NainBis.!
panda
Carreau motifCourant: PandaBis.
self emmèneAvecSouris: PandaBis.!
perroquet
Carreau motifCourant: PerroquetBis.
self emmèneAvecSouris: PerroquetBis.!
petitAne
Carreau motifCourant: PetitAneBis.
self emmèneAvecSouris: PetitAneBis.!
petitTrain
Carreau motifCourant: PetitTrainBis.
self emmèneAvecSouris: PetitTrainBis.!
sirène
Carreau motifCourant: SirèneBis.
self emmèneAvecSouris: SirèneBis.!
éléphant
Carreau motifCourant: EléphantBis.
self emmèneAvecSouris: EléphantBis.! !
DÉPLACEMENT DES Objetsdivers AVEC LES BOUTONS
!ObjetsDivers methodsFor: 'actions-déplacements'!
glisseVersLaDroite
Carreau motifCourant: (self rendObjetCliqué).
Carreau motifCourant glisseVersLaDroite: 1.!
glisseVersLaGauche
Carreau motifCourant: (self rendObjetCliqué).
Carreau motifCourant glisseVersLaGauche: 1.!
glisseVersLeBas
Carreau motifCourant: (self rendObjetCliqué).
Carreau motifCourant glisseVersLeBas: 1.!
glisseVersLeHaut
Carreau motifCourant: (self rendObjetCliqué).
Carreau motifCourant glisseVersLeHaut: 1.!
symétrieHorizontale
Carreau motifCourant: (self rendObjetCliqué).
Carreau motifCourant symétrieHorizontale.!
symétrieVerticale
Carreau motifCourant: (self rendObjetCliqué).
Carreau motifCourant symétrieVerticale.!
tourneDroite
Carreau motifCourant: (self rendObjetCliqué).
"Carreau motifCourant effaceToi."
Carreau motifCourant tourneDroite90.!
tourneGauche
Carreau motifCourant: (self rendObjetCliqué).
"Carreau motifCourant effaceToi."
Carreau motifCourant tourneGauche90.! !
MODIFICATION DES ObjetsDivers AFFICHÉS SUR L'ÉCRAN
!ObjetsDivers methodsFor: 'actions'!
début
Vue1 := ObjetsDiversVue new.
(Ct := Controller new) view: Vue1.
Win1 := ScheduledWindow new.
(Comp := EcranPartage new) .
La := LayoutFrame new.
La leftFraction: 0.
La rightFraction:1.
La topFraction: 0.
La bottomFraction: 1.
Comp := EcranPartage new.
Comp add: Vue1 borderedIn: La.
Win1 component: (BoundedWrapper on: Comp).
Win1 openIn: (21@260 corner: 605@480).!
décalqueAvecSouris
| t gc ori |
t := (self rendObjetCliqué).
gc := Win1 graphicsContext.
Carreau motifCourant: t.
Carreau motifCourant motif follow: [ori := Vue1 controller sensor cursorPoint]
while: [Vue1 controller sensor noButtonPressed ]
on: gc.
Carreau motifCourant en: ori.!
déplaceAvecSouris
| gc ori |
gc := Win1 graphicsContext.
Carreau motifCourant: (self rendObjetCliqué).
Carreau motifCourant effaceToi.
Carreau motifCourant motif follow: [ori := Vue1 controller sensor cursorPoint]
while: [Vue1 controller sensor noButtonPressed ]
on: gc.
Carreau motifCourant en: ori.!
entoureToiDeBlanc
Carreau motifCourant: (self rendObjetCliqué).
Carreau motifCourant entoureToiDeBlanc.!
entoureToiDeNoir
Carreau motifCourant: (self rendObjetCliqué).
Carreau motifCourant entoureToiDe: ColorValue black!
grandeGomme
self effaceTout.
Win1 refresh.!
inverseVidéo
| c u remp |
"création d'un objet de même taille que l'objet cliqué et de la couleur choisie"
u := self rendObjetCliqué.
"sauvegarde du remplissage"
remp := ObjetsDivers remplissage.
ObjetsDivers remplissage: 'oui'.
c := ObjetsMorceaux rectangle: u motif extent.
c origine: u origine.
(u combineAvec: c en: u origine) montreToi.
ObjetsDivers remplissage: remp.!
nouveauDessin
"on crée un carreau qui aura pour motif la copie d'écran située dans ce rectangle"
| t |
t := Carreau créeUnObjetQuelconque.
Carreau motifCourant: t.
t vaDépartVisible.
Win1 refresh.
^t.!
nouvelObjet
| r li res |
r := Rectangle fromUser.
"on se ramène à Win1 comme origine"
r := (r origin) - (Win1 globalOrigin) extent: r extent.
"on prend la liste des carreaux intérieurs à ce rectangle"
li := self carreauxOrigineIntérieure: r.
li size >0 ifTrue: [res := li removeFirst .res effaceToi ].
li do: [ :c | res :=
(res combineAvec: c en: res origine). c effaceToi.].
res vaDépartVisible.
Carreau motifCourant: res.!
petiteGomme
self supprimeCarreauxAutour: self pointCliquéAttendu.
Win1 refresh.! !
MODIFICATION DE LA COULEUR DES ObjetsDivers
!ObjetsDivers methodsFor: 'actions-couleurs'!
bleu
ObjetsDivers couleurChoisie: ColorValue blue.
^ColorValue blue!
jaune
ObjetsDivers couleurChoisie: ColorValue yellow.
^ColorValue yellow!
noir
ObjetsDivers couleurChoisie: ColorValue black.
^ColorValue black!
orange
ObjetsDivers couleurChoisie: ColorValue orange.
^ColorValue orange!
rose
ObjetsDivers couleurChoisie: ColorValue pink.
^ColorValue pink!
rouge
ObjetsDivers couleurChoisie: ColorValue red.
^ColorValue red!
vert
ObjetsDivers couleurChoisie: ColorValue green.
^ColorValue green!
violet
ObjetsDivers couleurChoisie: ColorValue magenta.
^ColorValue magenta! !
!ObjetsDivers methodsFor: 'aspects'!
mini
^self! !
!
MÉTHODES DE LA CLASSE ObjetsDivers
ObjetsDivers class
instanceVariableNames: 'couleurChoisie tailleChoisie remplissage prénom '!
!ObjetsDivers class methodsFor: 'interface specs'!
arcEnCiel
^ArcEnCiel motif!
bateau
^Bateau motif!
canardPeter
" on crée un objet EléphantBis qui ne sera pas affecté par les changements de Eléphant pour que l'icône reste correcte"
^CanardPeterBis motif!
clown
" on crée un objet clownBis qui ne sera pas affecté par les changements de Clown pour que l'icône reste correcte"
^ClownBis motif!
cosmonaute
" on crée un objet clownBis qui ne sera pas affecté par les changements de Clown pour que l'icône reste correcte"
^CosmonauteBis motif!
creuxPlein
^CreuxPlein motif!
lampe
" on crée un objet lampeBis qui ne sera pas affecté par les changements de lampe pour que l'icône reste correcte"
^LampeBis motif!
lapin
" on crée un objet LapinBis qui ne sera pas affecté par les changements de Lapin pour que l'icône reste correcte"
^LapinBis motif!
nain
" on crée un objet perroquetBis qui ne sera pas affecté par les changements de Perroquet pour que l'icône reste correcte"
^NainBis motif!
panda
" on crée un objet pandaBis qui ne sera pas affecté par les changements de Panda pour que l'icône reste correcte"
^PandaBis motif!
perroquet
" on crée un objet perroquetBis qui ne sera pas affecté par les changements de Perroquet pour que l'icône reste correcte"
^PerroquetBis motif!
petitAne
" on crée un objet PetitAneBis qui ne sera pas affecté par les changements de PetitAne pour que l'icône reste correcte"
^PetitAneBis motif!
petitesFilles
^ PetitesFilles motif!
petitTrain
" on crée un objet PetitTrainBis qui ne sera pas affecté par les changements de PetitAne pour que l'icône reste correcte"
^PetitTrainBis motif!
sirène
" on crée un objet PetitTrainBis qui ne sera pas affecté par les changements de PetitAne pour que l'icône reste correcte"
^SirèneBis motif!
éléphant
" on crée un objet EléphantBis qui ne sera pas affecté par les changements de Eléphant pour que l'icône reste correcte"
^EléphantBis motif! !
MÉTHODES DE LA CLASSE ObjetsDivers (menus)
!ObjetsDivers class methodsFor: 'resources'!
menu
"UIMenuEditor new openOnClass: self andSelector: #menu"
^#(#PopUpMenu #('démarrage' 'disque dur' 'utilisateur' 'traces' ) #() #(#(#PopUpMenu #('début' ) #() #(#début ) ) #(#PopUpMenu #('sauver un carreau' 'ramener un carreau' 'sauver un papier-peint' 'ramener un papier-peint' ) #() #(#sauverSurDisqueC #chercherSurDisqueC #sauverSurDisqueP #chercherSurDisqueP ) ) #(#PopUpMenu #('donne ton prénom' ) #() #(#nomElève ) ) #(#PopUpMenu #('rotation avec trace' 'rotation sans trace' 'translation avec trace' 'translation sans trace' 'symétrie avec trace' 'symétrie sans trace' ) #() #(#rotationAvecTrace #rotationSansTrace #translationAvecTrace #translationSansTrace #symétrieAvecTrace #symétrieSansTrace ) ) ) ) decodeAsLiteralArray!
menuCouleurs
"UIMenuEditor new openOnClass: self andSelector: #menuCouleurs"
^#(#PopUpMenu #('rouge' 'jaune' 'vert' 'violet' 'bleu' 'orange' 'noir' 'rose' ) #(1 2 3 4 5 6 7 ) #(#rouge #jaune #vert #violet #bleu #orange #noir #rose ) ) decodeAsLiteralArray!
MÉTHODES DE LA CLASSE ObjetsDivers( démarrage, initialisation)
!ObjetsDivers class methodsFor: 'démarrage'!
début
| chemin |
chemin := Filename findDefaultDirectory head .
Smalltalk at: #PetitTrainBis put: (MonOutil ramèneObjetEnregistréSous: chemin,'dessins:','PetitTrain') .
Smalltalk at: #PandaBis put: (MonOutil ramèneObjetEnregistréSous: chemin,'dessins:','Panda').
Smalltalk at: #PetitAneBis put: (MonOutil ramèneObjetEnregistréSous: chemin,'dessins:','PetitAne') .
Smalltalk at: #PerroquetBis put: (MonOutil ramèneObjetEnregistréSous: chemin,'dessins:','Perroquet').
Smalltalk at: #ClownBis put: (MonOutil ramèneObjetEnregistréSous: chemin,'dessins:','Clown').
Smalltalk at: #EléphantBis put: (MonOutil ramèneObjetEnregistréSous: chemin,'dessins:','Eléphant').
ObjetsDivers open.! !
!ObjetsDivers class methodsFor: 'initialisation'!
initialiseToi
| chemin t1 t2 |
ColorValue initializeColors.
couleurChoisie := ColorValue blue.
prénom := 'inconnu'.
remplissage:= 'oui'.
tailleChoisie := 80.
"on crée deux dossiers pour sauver les oeuvres de l'élève inconnu…"
chemin := Filename findDefaultDirectory head .
t1 := 'inconnu carreaux'.
t2 := 'inconnu papiers'.
(Filename named: chemin,t1 ) exists ifFalse: [(Filename named: chemin,t1) makeDirectory].
(Filename named: chemin,t2) exists ifFalse: [(Filename named: chemin,t2) makeDirectory].! !
MÉTHODES DE LA CLASSE ObjetsDivers (champs de la classe)
!ObjetsDivers class methodsFor: 'champ de la classe'!
couleurChoisie
couleurChoisie isNil ifTrue: [ couleurChoisie := ColorValue blue] ifFalse: [^couleurChoisie]!
couleurChoisie: t1
couleurChoisie := t1!
prénom
prénom isNil ifTrue: [prénom := 'inconnu'] ifFalse: [ ^prénom]!
prénom: t1
prénom := t1!
remplissage
^( remplissage isNil ifTrue: [ remplissage:= 'oui'] ifFalse: [^remplissage])!
remplissage: t1
remplissage := t1!
tailleChoisie
tailleChoisie isNil ifTrue: [tailleChoisie := 80] ifFalse: [ ^tailleChoisie]!
tailleChoisie: t1
tailleChoisie := t1! !
CRÉATION DE LA CLASSE ObjetsMorceaux sous-classe de la classe ObjetsDivers
ObjetsDivers subclass: #ObjetsMorceaux
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'carrelages et papiers'!
MÉTHODES POUR DÉTERMINER LA TAILLE DES ObjetsMorceaux
!ObjetsMorceaux methodsFor: 'hasard'!
longueurHasard
| has d |
"tirage d'un entier qui sera le diamètre"
has := Random fromGenerator:1
seededWith: (Time millisecondClockValue).
d := (100 * has next) asInteger.
^d! !
!ObjetsMorceaux methodsFor: 'actions-taille'!
grand
^ self class tailleChoisie: 80.!
minuscule
^ self class tailleChoisie: 10.!
moyen
^ self class tailleChoisie: 40.!
petit
^ self class tailleChoisie: 20.!
énorme
^ self class tailleChoisie: 120.! !
MÉTHODES POUR DÉTERMINER LA FORME DES ObjetsMorceaux
!ObjetsMorceaux methodsFor: 'actions-formes'!
cercle
"tirage d'un entier qui sera le diamètre"
| obj long |
"obj := self class cercle: self longueurHasard."
long := ObjetsMorceaux tailleChoisie.
obj := ObjetsMorceaux cercle: long.
" on donne pour origine le point du click"
obj origine: (obj emmèneAvecSouris: obj).
^obj!
demiCarré
"tirage d'un entier qui sera le diamètre"
| obj |
"obj := self class cercle: self longueurHasard."
obj := ObjetsMorceaux demiCarré: ObjetsMorceaux tailleChoisie.
" on donne pour origine le point du click"
obj origine: (obj emmèneAvecSouris: obj).
C3 := obj.
^obj!
rectangle
"tirage d'un entier qui sera le diamètre"
| obj long |
long := ObjetsMorceaux tailleChoisie.
obj := ObjetsMorceaux rectangle: 3*long @ long.
" on donne pour origine le point du click"
obj origine: (obj emmèneAvecSouris: obj).
^obj!
triangle
"tirage d'un entier qui sera le diamètre"
| obj long |
"obj := ObjetsMorceaux triangle: self longueurHasard."
long := ObjetsMorceaux tailleChoisie.
obj := ObjetsMorceaux triangle: long.
" on donne pour origine le point du click"
obj origine: (obj emmèneAvecSouris: obj).
^obj! !
MÉTHODES POUR DÉTERMINER LES EFFETS DE COULEUR DES ObjetsMorceaux
!ObjetsMorceaux methodsFor: 'actions-invVidéo'!
combine2
| u |
u := (self rendObjetCliqué) combineAvec: (self rendObjetCliqué).
u vaDépartVisible!
combineIntersection
| res listeObjets prem |
listeObjets := (self rendAutour: Vue1 controller sensor waitClickButton ) .
listeObjets size >0 ifTrue: [ prem := listeObjets removeFirst].
res := prem.
listeObjets do: [ :c | res := (res combineAvec: c en: res origine)].
res en: 0@0.
^res! !
!ObjetsMorceaux methodsFor: 'actions-creux'!
creux
ObjetsDivers remplissage: 'non'!
plein
ObjetsDivers remplissage: 'oui'! !
!ObjetsMorceaux methodsFor: 'actions'!
début
Vue1 := ObjetsDiversVue new.
(Ct := Controller new) view: Vue1.
Win1 := ScheduledWindow new.
(Comp := EcranPartage new) .
La := LayoutFrame new.
La leftFraction: 0.
La rightFraction:1.
La topFraction: 0.
La bottomFraction: 1.
Comp := EcranPartage new.
Comp add: Vue1 borderedIn: La.
Win1 component: (BoundedWrapper on: Comp).
Win1 openIn: (3@204 corner: 632@470).! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
MÉTHODES DE LA CLASSE ObjetsMorceaux (MENUS)
ObjetsMorceaux class
instanceVariableNames: ''!
!ObjetsMorceaux class methodsFor: 'resources'!
menu
"UIMenuEditor new openOnClass: self andSelector: #menu"
^#(#PopUpMenu #('démarrage' 'disque dur' 'utilisateur' 'traces' ) #() #(#(#PopUpMenu #('début' ) #() #(#début ) ) #(#PopUpMenu #('sauver un carreau' 'ramener un carreau' 'sauver un papier-peint' 'ramener un papier-peint' ) #() #(#sauverSurDisqueC #chercherSurDisqueC #sauverSurDisqueP #chercherSurDisqueP ) ) #(#PopUpMenu #('donne ton prénom' ) #() #(#nomElève ) ) #(#PopUpMenu #('rotation avec trace' 'rotation sans trace' 'translation avec trace' 'translation sans trace' 'symétrie avec trace' 'symétrie sans trace' ) #() #(#rotationAvecTrace #rotationSansTrace #translationAvecTrace #translationSansTrace #symétrieAvecTrace #symétrieSansTrace ) ) ) ) decodeAsLiteralArray!
menuCreux
"UIMenuEditor new openOnClass: self andSelector: #menuCreux"
^#(#PopUpMenu #('creux' 'plein' ) #(1 ) #(#creux #plein ) ) decodeAsLiteralArray!
menuTailles
"UIMenuEditor new openOnClass: self andSelector: #menuTailles"
^#(#PopUpMenu #('minuscule' 'petit' 'moyen' 'grand' 'énorme' ) #(1 2 3 4 ) #(#minuscule #petit #moyen #grand #énorme ) ) decodeAsLiteralArray!
MÉTHODES DE LA CLASSE ObjetsMorceaux (DÉMARRAGE)
!ObjetsMorceaux class methodsFor: 'démarrage'!
début
self open.!
initialiseToi
super début.
Win1 openIn: (0@100 extent: 400@300).
GG := Win1 graphicsContext.! !
!ObjetsMorceaux class methodsFor: 'création-objets'!
cercle: unDiamètre
| t r im c |
c := self new.
r := (unDiamètre //2) asInteger.
t := (Pixmap extent: unDiamètre@unDiamètre).
t graphicsContext paint: ObjetsDivers couleurChoisie;
displayDotOfDiameter: unDiamètre at: (r@r).
ObjetsDivers remplissage = 'non' ifTrue: [
t graphicsContext paint: ColorValue white ; displayDotOfDiameter: (unDiamètre - 4) at: (r@r) ].
im := t asImage.
c motif: im.
c visibilité: 'oui'.
c origine: 0@0.
^c!
demiCarré: unCôté
| t im c |
c := self new.
t := (Pixmap extent: unCôté@unCôté).
t graphicsContext paint: ObjetsDivers couleurChoisie;
displayPolygon: ( Array with: 0@0 with: 0@unCôté with: unCôté@unCôté).
ObjetsDivers remplissage = 'non' ifTrue: [
t graphicsContext paint: ColorValue white ; displayPolygon: ( Array with:2@4 with: 2@(unCôté - 2) with: (unCôté@unCôté) - (4@2) )].
im :=t asImage.
c motif: im.
c visibilité: 'oui'.
c origine: 0@0.
^c!
nouveau
| t |
t := self new.
^t!
rectangle: unPoint
| t im c |
c := self new.
t := (Pixmap extent: unPoint).
t graphicsContext paint: ObjetsDivers couleurChoisie;
displayPolygon: ( Array with: 0@0 with: unPoint x @0 with:unPoint with: 0@unPoint y ).
ObjetsDivers remplissage = 'non' ifTrue: [
t graphicsContext paint: ColorValue white ; displayRectangle: (2@2 extent: unPoint - (4@4)) ].
im :=t asImage.
c motif: im.
c visibilité: 'oui'.
c origine: 0@0.
^c!
triangle: unCôté
| t im c |
c := self new.
t := (Pixmap extent: unCôté@unCôté).
t graphicsContext paint: ObjetsDivers couleurChoisie;
displayPolygon: ( Array with: 0@0 with: unCôté@0 with: (unCôté // 2)@(unCôté* 0.866)).
ObjetsDivers remplissage = 'non' ifTrue: [
t graphicsContext paint: ColorValue white ; displayPolygon: ( Array with: 3@2 with: ((unCôté -3) @2) with: ((unCôté - 4) // 2)+ 2 @(((unCôté - 4)* 0.866) ))].
im :=t asImage.
c motif: im.
c visibilité: 'oui'.
c origine: 0@0.
^c! !
CRÉATION DE LA CLASSE PAPIER
Carreau subclass: #Papier
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'carrelages et papiers'!!
Papier class
instanceVariableNames: ''!
!Papier class methodsFor: 'creation'!
nouveau
| p |
p := super new.
p := Carreau créeUnObjetQuelconque.
^p! !
CRÉATION DE LA CLASSE
CarreauVisual (INTERFACE AVEC VISUALWORKS)Carreau subclass: #CarreauVisual
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'carrelages et papiers'!
ACTIONS DANS LA CLASSE
CarreauVisual!CarreauVisual methodsFor: 'actions-motifs'!
canard
Carreau motifCourant: Canard.!
citrouille
Carreau motifCourant: Citrouille.!
colombe
Carreau motifCourant: Colombe.!
diplôme
Carreau motifCourant: Diplôme.!
nounours
Carreau motifCourant: Nounours.!
nouveauMotif
Carreau motifCourant: Carreau créeUnObjetQuelconque.
^Carreau motifCourant.!
petitTrain
Carreau motifCourant: PetitTrain.!
pingouin
Carreau motifCourant: Pingouin.!
rose
Carreau motifCourant: Rose.!
sirène
Carreau motifCourant: Sirène.! !
!CarreauVisual methodsFor: 'actions-rotations'!
turnLeft
Carreau motifCourant tourneGauche90!
turnRight
Carreau motifCourant tourneDroite90! !
!CarreauVisual methodsFor: 'actions-symétries'!
sH
Carreau motifCourant symétrieHorizontale!
sHB
Carreau motifCourant symétrieHorizontale!
sHH
Carreau motifCourant symétrieHorizontaleHaut!
sV
Carreau motifCourant symétrieVerticale!
sVD
Carreau motifCourant symétrieVerticale!
sVG
Carreau motifCourant symétrieVerticaleGauche! !
!CarreauVisual methodsFor: 'actions-translations'!
down
Carreau motifCourant glisseVersLeBas: 1.
^self!
left
Carreau motifCourant glisseVersLaGauche: 1.
^self!
right
Carreau motifCourant glisseVersLaDroite: 1.!
up
Carreau motifCourant glisseVersLeHaut: 1.
^self! !
!CarreauVisual methodsFor: 'actions-couleurs'!
eBla
Carreau motifCourant entoureToiDeBlanc!
eBle
Carreau motifCourant entoureToiDeBleu!
eJ
Carreau motifCourant entoureToiDeJaune!
eN
Carreau motifCourant entoureToiDeNoir!
eR
Carreau motifCourant entoureToiDeRouge!
eV
Carreau motifCourant entoureToiDeVert!
eVi
Carreau motifCourant entoureToiDeViolet! !
!CarreauVisual methodsFor: 'actions-divers'!
effaceToi
Carreau motifCourant effaceToi!
effaceTout
Carreau motifCourant effaceTout!
invisible
Carreau motifCourant effaceToi.
Carreau motifCourant visibilité: 'non'!
montreToi
Carreau motifCourant visibilité: 'oui'.
Carreau motifCourant montreToi!
vaDépartCaché
Carreau motifCourant vaDépartCaché!
vaDépartVisible
Carreau motifCourant vaDépartVisible!
visible
Carreau motifCourant visibilité: 'oui'.
Carreau motifCourant montreToi! !
!CarreauVisual methodsFor: 'Carreau'!
rotationSansTraces
Carreau tracesR: 'invisibles'! !
MÉTHODES DE LA CLASSE
CarreauVisual (initialisation, menus…)CarreauVisual class
instanceVariableNames: ''!
!CarreauVisual class methodsFor: 'initialisation'!
début
"ne pas oublier d'initialiser la classe par ''CarreauVisual initialiseToi'' ce qui aura pour effet de créer le BUILDER : Build1; fermer la fenêtre créée"
"On lancera la logiciel de géométrie par ''CarreauVisual début'' "
"On impose au Build1 de prendre pour composite le Comp créé précédemment dans la classe Carreau, en fait Comp fait maintenant partie de la sous-classe ÉcranPartagé"
(Comp := EcranPartage new) .
Comp add: Vue .
Build1 composite: Comp.
Build1 openIn: Win displayBox.!
initialiseToi
Build1 := CarreauVisual open.! !
!CarreauVisual class methodsFor: 'resources'!
menu
"UIMenuEditor new openOnClass: self andSelector: #menu"
^#(#PopUpMenu #('translations' 'rotations' 'symétries' 'contours' 'motifs' 'divers' 'traces' ) #() #(#(#PopUpMenu #('glisseVersLaDroite' 'glisseVersLaGauche' 'glisseVersLeBas' 'glisseVersLeHaut' ) #() #(#right #left #down #up ) ) #(#PopUpMenu #('tourneSensAiguillesMontre' 'tourneSensInverseAiguillesMontre' ) #() #(#turnRight #turnLeft ) ) #(#PopUpMenu #('symétrieHorizontale (en bas)' 'symétrieHorizontale (en haut)' 'symétrieVerticale (à droite)' 'symétrieVerticale (à gauche)' ) #() #(#sHB #sHH #sVD #sVG ) ) #(#PopUpMenu #('entoureToiDeNoir' 'entoureToiDeBleu' 'entoureToiDeJaune' 'entoureToiDeRouge' 'entoureToiDeVert' 'entoureToiDeViolet' 'entoureToiDeBlanc' ) #() #(#eN #eBle #eJ #eR #eV #eVi #eBla ) ) #(#PopUpMenu #('Rose' 'Nounours' 'Pingouin' 'PetitTrain' 'Citrouille' 'Colombe' 'Canard' 'Diplôme' 'nouveau' ) #() #(#rose #nounours #pingouin #petitTrain #citrouille #colombe #canard #diplôme #nouveauMotif ) ) #(#PopUpMenu #('montreToi' 'effaceToi' 'effaceTout' 'visible' 'invisible' 'vaDépartVisible' 'vaDépartCaché' ) #() #(#montreToi #effaceToi #effaceTout #visible #invisible #vaDépartVisible #vaDépartCaché ) ) #(#PopUpMenu #('rotation avec trace' 'rotation sans trace' 'translation avec trace' 'translation sans trace' 'symétrie avec trace' 'symétrie sans trace' ) #() #(#rotationAvecTrace #rotationSansTrace #translationAvecTrace #translationSansTrace #symétrieAvecTrace #symétrieSansTrace ) ) ) ) decodeAsLiteralArray! !
CRÉATION DE LA CLASSE CarreauCoordonnées
QUI GÈRE LES COORDONNÉES DES CARREAUX SUR L'ÉCRAN.
Carreau subclass: #CarreauCoordonnées
instanceVariableNames: 'abscisse ordonnée affichePoint '
classVariableNames: ''
poolDictionaries: ''
category: 'carrelages et papiers'!
MÉTHODES DE LA CLASSE CarreauCoordonnées
!CarreauCoordonnées methodsFor: 'actions'!
début
Comp := EcranPartage new.
Comp add: Vue borderedIn: La.
Win component: (BoundedWrapper on: Comp).
Win openIn: (21@285 corner: 598@480).!
vaZy
"(self abscisse value = (Carreau motifCourant) origine x) & (self ordonnée value = (Carreau motifCourant) origine y)
ifFalse:"
Carreau motifCourant origine: self abscisse value @ self ordonnée value.
Carreau motifCourant montreToi.!
visualDébut
CarreauVisual début.! !
!CarreauCoordonnées methodsFor: 'aspects'!
abscisse
abscisse isNil ifTrue: [^abscisse := 0 asValue].
^abscisse!
abscisse: t1
self abscisse value: t1!
affichePoint
affichePoint isNil ifTrue: [^affichePoint := 'position: ' asValue].
^affichePoint!
ordonnée
ordonnée isNil ifTrue: [^ordonnée := 0 asValue].
^ordonnée!
ordonnée: t1
self ordonnée value: t1! !
!CarreauCoordonnées methodsFor: 'affichage-écran'!
montreToi
super montreToi.
T1 := CarreauCoordonnées new.
T1 abscisse value = Carreau motifCourant origine x ifFalse: ["mise à jour du champs abscisse"
T1 abscisse value: Carreau motifCourant origine x].
T1 ordonnée value = Carreau motifCourant origine y ifFalse: [T1 ordonnée value: Carreau motifCourant origine y].
T1 affichePoint value: 'POINT: ' , Carreau motifCourant origine printString.! !
!CarreauCoordonnées methodsFor: 'initialize'!
initialize
"Carreau coordonnées gère un objet T1 qui est le self ici"
super initialize.
"ce qui suit ne sera utilisé si on veut que les sliders déplacent directement les formes sur l'écran"
"self abscisse onChangeSend: #vaZy to: self.
self ordonnée onChangeSend: #vaZy to: self."! !!
CarreauCoordonnées class
instanceVariableNames: ''!
!CarreauCoordonnées class methodsFor: 'mise à jour'!
miseAJour! !
!CarreauCoordonnées class methodsFor: 'démarrage'!
début
"l'objet T1 sert dans la méthode montreToi de la classe carreau"
Smalltalk at: #T1 put: CarreauCoordonnées new.
(CarreauCoordonnées openOn: T1) .! !
Image subclass: #CopieEcran
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'carrelages et papiers'!
CRÉATION DE LA CLASSE CopieEcran SOUS CLASSE DE LA CLASSE Image
CopieEcran class
instanceVariableNames: ''!
!CopieEcran class methodsFor: 'petit,moyen,grand'!
copieEcranSur: unRectangle
"copie l'écran sur un rectangle
exemple : CopieEcran copieEcranSur: (0@0 corner: 40@40) "
^Screen default completeContentsOfArea:unRectangle!
copieEcranSurGrandCarré
"rend une copie d'écran sur un carré de 120 sur 120"
^Screen default completeContentsOfArea: (Rectangle originFromUser: 120@120 grid: 1@1 whileButton: 1 isDown: false)!
copieEcranSurMoyenCarré
"rend une copie d'écran sur un carré de 80 sur 80"
^Screen default completeContentsOfArea: (Rectangle originFromUser: 80@80 grid: 1@1 whileButton: 1 isDown: false)!
copieEcranSurPetitCarré
"rend une copie d'écran sur un carré de 40 sur 40"
^Screen default completeContentsOfArea: (Rectangle originFromUser: 40@40 grid: 1@1 whileButton: 1 isDown: false)!
copieMinus
"rend une copie d'écran sur un carré de 16 sur 16"
^Screen default completeContentsOfArea: (Rectangle originFromUser: 16@16 grid: 1@1 whileButton: 1 isDown: false)!
fromUser1
"rend un carré de 40 sur 40"
^Screen default completeContentsOfArea: (Rectangle originFromUser: 40@40 grid: 1@1 whileButton: 1 isDown: false)!
fromUser2
"rend un carré de 80 sur 80"
^Screen default completeContentsOfArea: (Rectangle originFromUser: 80@80 grid: 1@1 whileButton: 1 isDown: false)!
fromUser3
"rend un carré de 160 sur 160"
^Screen default completeContentsOfArea: (Rectangle originFromUser: 160@160 grid: 1@1 whileButton: 1 isDown: false)!
CRÉATION DE LA CLASSE CarreauControleur
(sous classe de ControllerWithMenu)
ControllerWithMenu subclass: #CarreauControleur
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'carrelages et papiers'!
MÉTHODES DE LA CLASSE CarreauControleur
!CarreauControleur methodsFor: 'nom des objets'!
Canard
Carreau motifCourant: Canard.
^self!
Chaton
Carreau motifCourant: Chaton.
^self!
Citrouille
Carreau motifCourant: Citrouille.
^self!
Colombe
Carreau motifCourant: Colombe.
^self!
Diplôme
Carreau motifCourant: Diplôme.
^self!
Lapin
Carreau motifCourant: Lapin.
^self!
LapinPeter
Carreau motifCourant: LapinPeter.
^self!
Maison
Carreau motifCourant: Maison.
^self!
Motif1
Carreau motifCourant: Motif1.
^self!
Motif2
Carreau motifCourant: Motif2.
^self!
Nounours
Carreau motifCourant: Nounours.
^self!
PetitTrain
Carreau motifCourant: PetitTrain.
^self!
Pingouin
Carreau motifCourant: Pingouin.
^self!
Poisson
Carreau motifCourant: Poisson.
^self!
Pélican
Carreau motifCourant: Pélican.
^self!
Rose
Carreau motifCourant: Rose.
^self!
Snoopy
Carreau motifCourant: Snoopy.
^self!
Tangram
Carreau motifCourant: Tangram.
^self! !
!CarreauControleur methodsFor: 'ordres'!
effaceTout
Carreau motifCourant effaceTout.!
glisseVersLaDroite
Carreau motifCourant glisseVersLaDroite: 1.
^self!
glisseVersLaGauche
Carreau motifCourant glisseVersLaGauche: 1.
^self!
glisseVersLeBas
Carreau motifCourant glisseVersLeBas: 1.
^self!
glisseVersLeHaut
Carreau motifCourant glisseVersLeHaut: 1.
^self!
sV
Carreau motifCourant symétrieVerticale.
^self!
t90
Carreau motifCourant tourneDroite90.
^self!
vaDépartVisible
Carreau motifCourant vaDépartVisible.
^self! !
!CarreauControleur methodsFor: 'menu divers'!
menu
^PopUpMenu
labels: 'Rose\Lapin\Pélican\Poisson\Chaton\Snoopy\Canard\Maison\Motif1\Motif2\Tangram' withCRs
lines: #(1 2 3 4 5 6 7 8 9 10)
values: #(#Rose #LapinPeter #Pélican #Poisson #Chaton#Snoopy #Canard# Maison#Motif1#Motif2#Tangram)!
redButtonActivity
| t |
t := ( PopUpMenu
labels: 'glisseVersLaDroite\glisseVersLaGauche\glisseVersLeBas\glisseVersLeHaut\tourne90\symetrieVerticale\vaDépartVisible\effaceTout' withCRs
lines: #(1 2 3 4 5 6 7 )
values: #(#glisseVersLaDroite#glisseVersLaGauche #glisseVersLeBas#glisseVersLeHaut #t90 #sV #vaDépartVisible#effaceTout )) startUp.
t==0 ifTrue:[] ifFalse: [self perform: t].! !
CRÉATION DE LA CLASSE CarreauVue (sous classe de la classe View)
View subclass: #CarreauVue
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'carrelages et papiers'!