Jeu de Memory

Jeu de Mémory
utilisant une multitude de fonctions

Jouer avec AutoLisp ?

c'est n'importe quoi !!

NON ! car c'est ce que j'ai trouvé de plus "éducatif".

En effet donner des exemples ou faire des programmes pour expliquer les différentes fonctions est toujours délicat pour parler à des gens de différents milieux professionnels.
Trouver des exemples qui "parlent" aux gens est fonction de son propre parcours, un architecte n'a pas les mêmes besoins que le mécanicien qui ne comprend pas le géomètre et si un gestionnaire de réseaux humides parle à un créateur de circuits électriques il y a de forts risques que la discussion devienne un salmigondis provoquant bien des confusions.

J'ai donc décidé unilatéralement, et en parfait accord avec moi-même, de proposer un jeu, genre jeu de société, en l'occurrence un jeu de Memory.

La règle est des plus simples :
Il suffit de trouver des cases qui forment des paires.

Pour faire ce "jeu" on va avoir besoin de :

Fabriquer des nombres aléatoires
Faire des listes
Mélanger les listes
Dessiner des polylignes closes
Hachurer des zones
Écrire des textes dans des cases
Créer une interface en DCL pour les choix
Créer des styles de texte
Créer un bloc avec des attributs
Récupérer des valeurs par clic dans les cases
Vérifier les valeurs obtenues et les comparer
Si c'est une paire, Effacer les valeurs et les hachures
Modifier les attributs du bloc compteur
en comptant les paires réalisées, le pourcentage d'efficacité ...

Et c'est bien pour la création de toutes ces options que j'ai trouvé "éducatif" de créer un jeu.

Au départ, le lancement de la commande "memory" va se présenter ainsi :

Et quand on va "jouer" ça va donner quelque chose comme ça :

Principe :
- Lancer la case DCL
- Dans cette case de dialogue choisir le nombre de cases horizontales et le nombres de cases verticales
- Choisir aussi si on veut jouer avec des lettres ou des symboles, le choix majuscules/minuscules s'active et se désactive pour activer le choix Webdings ou Wingdings, le cas échéant, le passage de l'un à l'autre active et désactive automatiquement celui qui devint caduc.
- Des vérifications s'opèrent dans cette case de dialogue dont je vous en parlerai plus tard.
- En cliquant sur le bouton "On y va" les dessin de la case de jeu est lancé.
- Ce dessin consiste à placer des paires de lettres dans des cases et de les cacher
- Les cases sont composées de polylignes closes
- Les lettres ou symboles sont des entités "texte"
- Le masque qui cache les lettres ou symboles est une entité "hachure".

Il est possible de lancer ce programme dans un fichier vierge, en effet bien qu'il soit utilisé des noms de calques, un bloc avec des attributs, des styles de texte, le programme vérifie si ces éléments ont une définition dans les tables du fichier et si ce n'est pas le cas ce qui est nécessaire au fonctionnement du programme sera créé, que ce soit le bloc avec attribut, les calque ou les styles de texte.

les fonctions utilisées sont :

LM:rand et LM:randrange, deux fonctions écrites par Lee Mac personnage présent dans la page remerciement à juste titre. ces fonctions "calculent" des nombres aléatoires dans une plage donnée.
da:faire-bloc-3att, fonction sans argument qui créée un bloc avec trois attributs.
da:nouveau-calque, fonction avec deux arguments, nom-calque attendu sous forme de chaîne de caractères (string) et couleur sous forme de nombre entier (integer)
da:style-texte, fonction sans argument qui créée les trois styles de texte.
da:faire-hachure, fonction avec un argument attendu sous forme de nom d'entité (ename), cette fonction va hachurer l'entité donnée en argument.
da:cacher-cases, fonction sans argument qui va mettre en avant (ordretrace) les hachures par rapport au texte qui de ce fait sera caché.
da:despolycadre, fonction avec deux arguments attendus sous forme de nombres entiers (integer) cette fonction va dessiner une polyligne carrée dont le point de départ sera à moins 0.50  en X et moins 0.50 en Y par rapport aux deux nombres donnés en argument, les points suivants tournant dans le sens horaire comme cette image l'explique :

da:mise-a-zero, fonction sans argument qui va mettre les valeurs des attributs "Compte-Clic" à 0 (zéro).
maj-nb-clic, fonction avec trois arguments attendus sous forme de nombres entiers (integer) qui va renseigner ce bloc de l'avancement de la partie.
choix-case, fonction sans argument qui va "trouver" le contenu de la case en fonction des coordonnées du point cliqué à l'écran.
dess-grille, fonction avec trois arguments, les deux premiers sont extraits de la case de dialogue et sont donc par nature sous forme de chaîne de caractères (string) mais seront transformés ensuite, et le dernier est un nombre entier (integer) qui est le départ des lettres ou symboles, valeur du code ascii. cette fonction en lance d'autres déjà décrites.
c:jouer-grille, commande qui lance le jeu à proprement parler, c'est dans cette fonction que les clics vont déclencher des jeux de sélection par les diverses fonctions pré-citées.
Et enfin : c:memory, commande qui lance aussi des fonctions pré-citées, qui lance la case de dialogue, qui en récupère les valeurs, les analyse pour vérification et qui lance le dessin de la grille si tout est correct.

C'est donc, une fois le lisp chargé,  dans cet ordre qu'il faut taper les "commandes" en ligne de commande : MEMORY et JOUER-GRILLE

La vérification opérée dans la case de dialogue porte sur le fait que le nombre de cases est un nombre pair, ce qui est obligé, par exemple si l'utilisateur entre 5 et 5 dans les cases horizontal et vertical un message s'écrit et ne ferme pas la case, de même j'ai limité le ombre de cases à 52 car les symboles ascii ne sont plus des lettres au delà et la compréhension de la table de jeu me semblait problématique.

Je vous propose donc ce "jeu", qui peut sembler puéril de prime abord mais qui permet à l'apprenti programmeur de balayer pas mal de fonctions de gestion de listes ou de dessin.

Toujours à votre écoute par le formulaire de contact je suis attentif aux critiques et améliorations éventuelles.

La première sur laquelle je vais devoir travailler est la gestion des erreurs car je viens de me rendre compte que ce n'est pas tout à fit "propre"

Je diffuse la version originale :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449

(defun LM:rand (/ a c m)
(setq m 4294967296.0 a 1664525.0 c 1013904223.0 $xn (rem (+ c (* a (cond ($xn)((getvar 'date))))) m))
(/ $xn m)
) ;_ Fin de defun
;; Random in Range - Lee Mac
;; Returns a pseudo-random integral number in a given range (inclusive)
(defun LM:randrange (a b)
(+ (min a b) (fix (* (LM:rand) (1+ (abs (- a b))))))
) ;_ Fin de defun
;;(LM:randrange 1 6) renvoie un nombre alea entre 1 et 6, peut renvoyer 1 ou 6 les limites sont inclues
;|
vérification de l'existence du bloc "compte-clic" dans le dessin,
s'il n'existe pas, création d'un bloc avec trois attributs CLIC PAIRE et POURCENT
le tout entourés de lignes
|;
(defun da:faire-bloc-3att ()
(if (null (tblsearch "BLOCK" "Compte-Clic"))
(progn
(entmake '((0 . "BLOCK")(2 . "Compte-Clic")(70 . 2)(10 0.0 0.0 0.0)))
(entmake '((0 . "LINE")(8 . "0")(10 0.0 1.25 0.0)(11 5.0 1.25 0.0)))
(entmake '((0 . "LINE")(8 . "0")(10 0.0 0.50 0.0)(11 5.0 0.50 0.0)))
(entmake '((0 . "LINE")(8 . "0")(10 0.0 -0.25 0.0)(11 5.0 -0.25 0.0)))
(entmake '((0 . "LINE")(8 . "0")(10 0.0 -1.00 0.0)(11 5.0 -1.00 0.0)))
(entmake '((0 . "LINE")(8 . "0")(10 0.0 -1.00 0.0)(11 0.0 1.25 0.0)))
(entmake '((0 . "LINE")(8 . "0")(10 5.0 -1.00 0.0)(11 5.0 1.25 0.0))) 
(entmake '((0 . "ATTDEF") (8 . "0") (10 1.0 0.75 0.0) (1 . "") (2 . "CLIC") (3 . "Nombre de clics ?")
(40 . 0.25) (41 . 1.0) (50 . 0.0) (70 . 0) (71 . 0) (72 . 0)(73 . 2)))
(entmake '((0 . "ATTDEF") (8 . "0") (10 1.0 0.0 0.0) (1 . "") (2 . "PAIRE")(3 . "Nombre de paires ?")
(40 . 0.25) (41 . 1.0) (50 . 0.0) (70 . 0) (71 . 0) (72 . 0) (73 . 2)))
(entmake '((0 . "ATTDEF") (8 . "0") (10 1.0 -0.75 0.0) (1 . "") (2 . "POURCENT") (3 . "Pourcentage de réussite ?")
(40 . 0.25) (41 . 1.0) (50 . 0.0) (70 . 0) (71 . 0) (72 . 0)(73 . 2)))
(entmake '((0 . "ENDBLK")))
);fin du progn 
);fin du if le bloc n'existe pas
);fin du defun da:faire-bloc-3att
;|
Création d'un nouveau calque le premier argument est une string le deuxème un entier de nuémro de couleur
|;
(defun da:nouveau-calque (nom-calque couleur)
(entmake
(list
(cons 0 "LAYER") (cons 100 "AcDbSymbolTableRecord")(cons 100 "AcDbLayerTableRecord")
(cons 2 nom-calque) (cons 62 couleur) (cons 70 0))
)
(princ)
)
;|
création de trois styles de texte s'ils n'existent pas dans le dessin
|;
(defun da:style-texte ()
(if (not (tblsearch "style" "StyleWEBding"))
(entmakex
'((0 . "STYLE") (100 . "AcDbSymbolTableRecord") (100 . "AcDbTextStyleTableRecord")(2 . "StyleWEBding")
(70 . 0) (40 . 0.0) (41 . 1.0) (50 . 0.0) (71 . 0) (42 . 0.3) (3 . "webdings.ttf") (4 . ""))
)
)
(if (not (tblsearch "style" "StyleWingding"))
(entmakex
'((0 . "STYLE") (100 . "AcDbSymbolTableRecord") (100 . "AcDbTextStyleTableRecord") (2 . "StyleWingding")
(70 . 0) (40 . 0.0) (41 . 1.0) (50 . 0.0) (71 . 0) (42 . 0.3) (3 . "wingdings.ttf") (4 . ""))
)
)
(if (not (tblsearch "style" "StyleLettres"))
(entmakex
'((0 . "STYLE") (100 . "AcDbSymbolTableRecord") (100 . "AcDbTextStyleTableRecord") (2 . "StyleLettres")
(70 . 0) (40 . 0.0) (41 . 1.0) (50 . 0.0) (71 . 0) (42 . 0.3) (3 . "arial.ttf") (4 . ""))
)
)
);fin de defun da:style-texte
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun da:faire-hachure (e / doc space h)
;l'argument e attendu est un "ename"
(vl-load-com)
(setq doc (vla-get-activedocument (vlax-get-acad-object))
space (if (= (getvar 'cvport) 1)
(vla-get-paperspace doc)
(vla-get-modelspace doc)
)
)
(setq h (vlax-invoke space 'addhatch achatchobject "SOLID" :vlax-false))
(vlax-invoke h 'appendouterloop (list (vlax-ename->vla-object e)))
(vla-evaluate h)
);fin de defun da:faire-hachure
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun da:cacher-cases (/ jeupol jeufig jeuh)
(setq jeufig (ssget "_x" '((0 . "TEXT"))))
(command "_.draworder" jeufig "" "_back")
(setq jeuh (ssget "_x" '((0 . "HATCH"))))
(command "_.draworder" jeuh "" "_front")
(setq jeupol (ssget "_x" '((0 . "LWPOLYLINE"))))
(command "_.draworder" jeupol "" "_front")
);fin de defun da:cacher-cases
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;|
dessin de carré de 1 sur 1 sous forme de polyligne centrée sur un point arrondi à l'entier
arguments : deux nombres qui sont les x et y du point par raport auquel il faut dessiner la polyligne
|;
(defun da:despolycadre (x y)
(entmake
(list '(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
'(90 . 4)
'(70 . 1)
(cons 8 "Grille")
(cons 43 0.05)
(cons 38 0.0)
(cons 10 (list (- x 0.5) (- y 0.5)))
(cons 10 (list (- x 0.5) (+ y 0.5)))
(cons 10 (list (+ x 0.5) (+ y 0.5)))
(cons 10 (list (+ x 0.5) (- y 0.5)))
)
)
);;;fin de defun da:despolycadre
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun da:mise-a-zero (/ nb-essais nb-paires pourcent)
(setq nb-essais 0
nb-paires 0
pourcent 0
)
(maj-nb-clic 0 0 0) ; trois arguments : nombre essai nombre de paires trouvées pourcentage de réussite
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun maj-nb-clic (nb1 nb2 nb3 / jeuclic
entbloc att nouv-att1 nouv-att2 nouv-att3
)
(setq jeuclic (ssget "_x" (list (cons 0 "INSERT") (cons 2 "Compte-Clic"))))
(setq entbloc (ssname jeuclic 0))
(if (< nb1 2)
(setq nouv-att1 (strcat (itoa nb1) " Essai"))
(setq nouv-att1 (strcat (itoa nb1) " Essais"))
)
(if (< nb2 2)
(setq nouv-att2 (strcat (itoa nb2) " Paire trouvée"))
(setq nouv-att2 (strcat (itoa nb2) " Paires trouvées"))
)
(setq nouv-att3 (strcat (rtos nb3 2 1) " % de réussite"))
(setq att (subst
(cons 1 nouv-att1)
(assoc 1 (entget (entnext entbloc)))
(entget (entnext entbloc))
)
)
(entmod att)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq att (subst
(cons 1 nouv-att2)
(assoc 1 (entget (entnext (entnext entbloc))))
(entget (entnext (entnext entbloc)))
)
)
(entmod att)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq att (subst
(cons 1 nouv-att3)
(assoc 1 (entget (entnext (entnext (entnext entbloc)))))
(entget (entnext (entnext (entnext entbloc))))
)
)
(entmod att)
(entupd entbloc)
);fin defun maj-nb-clic
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun choix-case (/ p1 p11 p13)
(while (= ss1 nil)
(setq p1 (getpoint "\nCliquez une case ...\n"))
(setq p1 (mapcar (quote (lambda (x) (atoi (rtos x 2 0)))) p1))
(setq p1 (list (car p1) (cadr p1)))
(setq p11 (list (- (car p1) 0.5) (- (cadr p1) 0.5))
p13 (list (+ (car p1) 0.5) (+ (cadr p1) 0.5))
) ;_ Fin de setq
(setq ssTexte (ssget "_w" p11 p13 '((0 . "TEXT"))))
) ;fin de while
(setq ssHachure (ssget "_w" p11 p13 '((0 . "HATCH"))))
(command "_.draworder" ssTexte "" "_front")
(setq fig (cdr (assoc 1 (entget (ssname ss1 0)))))
) ;fin choix-case
;;;;;;;;;;;;;;;;;;;
(defun dess-grille (larg haut chrdepart / x y num n lstpos test pos lstdep dep lstmel2)
;|
le dessin de a grille se fait depuis le point 0 0 0
larg et haut sont extraits de la case de dialogue
chrdepart est un argument sous forme d'entier qui sert au départ des caractères pour les figures
97 est le "a", 65 est le "A"
|;
(setq num 1 n -1 x 0 y 0)
(command "_erase" "_all" "")
 
(if (not (tblsearch "layer" "Figures"))
(da:nouveau-calque "Figures" 5)
)
(if (not (tblsearch "layer" "Hachures"))
(da:nouveau-calque "Hachures" 9)
)
(if (not (tblsearch "layer" "Grille"))
(da:nouveau-calque "Grille" 7)
)
(setq paires-max (* larg haut))
;fin de la saisie de la grille
;|
création d'une liste qui va servir à mélanger la prochaine liste "lstdep"
cette liste va contenir des numéros entre 0 le nombre de cases
exemple pour 4x4 cases (2 11 14 4 12 8 3 10 6 7 1 0 5 9 13 15)
|;
(setq lstpos '())
(repeat (- paires-max 1)
(setq test 0)
(while (< test paires-max)
(setq pos (LM:randrange 0 (- paires-max 1)))
(if (not (member pos lstpos))
(setq lstpos (cons pos lstpos))
)
(setq test (length lstpos))
)
)
;|
création d'une liste qui va être mélangée grace à "lstpos"
au départ cette liste est sous la forme (104 103 102 101 100 99 98 97)
ensuite elle est dupliquée par append et retournée par reverse
pour qu'elle continne des paires de numéros qui seront écrites plus tard dans la grille
je pars du nombre 97 qui est la lettre "a" en ascii
exemple pour 4x4 cases (97 98 99 100 101 102 103 104 97 98 99 100 101 102 103 104)
|;
(setq lstdep nil)
(setq dep chrdepart)
(repeat (/ paires-max 2)
(setq lstdep (cons (setq dep (+ 1 dep)) lstdep))
)
(setq lstdep (reverse (append lstdep lstdep)))
;fin de création de la liste de départ
;|
création d'une liste mélangée grace à "lstpos"
exemple pour 4x4 cases (98 100 99 104 97 104 99 98 97 101 103 102 101 100 103 102)
|;
(setq lstmel2 nil n1 -1 )
(repeat paires-max
(setq pos (nth (setq n1 (+ 1 n1)) lstpos))
(setq lstmel2 (cons (nth pos lstdep) lstmel2))
) ;_ Fin de repeat
;|
écriture des données et dessin de la grille
|; ;
(repeat haut
(repeat larg
(setq num (chr (nth (setq n (+ 1 n)) lstmel2)))
(setvar "clayer" "Figures")
(command "_text" "mc" (list x y) "0.50" "100.0" num)
(da:despolycadre x y)
(setvar "clayer" "Hachures")
(da:faire-hachure (entlast))
(setq x (+ 1 x))
) ;_ Fin de repeat le nombre de case en large
(setq x 0
y (+ 1 y)
)
) ;_ Fin de repeat le nombre de case en haut
(setvar "clayer" "Grille")
(command "_insert"
"Compte-Clic"
(list (+ 0.5 larg) (+ 0.5 haut))
""
""
""
"." "." "."
)
(command "_zoom" "_e")
(da:mise-a-zero)
(da:cacher-cases)
) ;_ Fin de defun
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:jouer-grille ()
(setq p1 nil
p2 nil
ptlist nil
nb-essais 0
nb-paires 0
) ;_ Fin de setq
(setq oldosmode (getvar "osmode"))
(setvar "osmode" 0)
(while (< nb-paires (/ paires-max 2))
(setq ss1 nil)
(while (not ss1)
(setq p1 (getpoint "\nCliquez une case ...\n"))
(setq p1 (mapcar (quote (lambda (x) (atoi (rtos x 2 0)))) p1))
(setq p1 (list (car p1) (cadr p1)))
(setq p11 (list (- (car p1) 0.5) (- (cadr p1) 0.5))
p13 (list (+ (car p1) 0.5) (+ (cadr p1) 0.5))
) ;_ Fin de setq
(setq ss1 (ssget "_w" p11 p13 '((0 . "TEXT"))))
) ;fin du while pas de ss1
(setq ss1h (ssget "_w" p11 p13 '((0 . "HATCH"))))
(command "_.draworder" ss1 "" "_front")
(setq fig1 (cdr (assoc 1 (entget (ssname ss1 0)))))
;;;
;;; ;deuxième case
(setq ss2 nil)
(while (not ss2)
(setq p2 (getpoint p1 "\nCliquez une autre case ...\n"))
(setq p2 (mapcar (quote (lambda (x) (atoi (rtos x 2 0)))) p2))
(setq p2 (list (car p2) (cadr p2)))
(setq p21 (list (- (car p2) 0.5) (- (cadr p2) 0.5))
;p22 (list (- (car p2) 0.5) (+ (cadr p2) 0.5))
p23 (list (+ (car p2) 0.5) (+ (cadr p2) 0.5))
;p24 (list (+ (car p2) 0.5) (- (cadr p2) 0.5))
;ptlist (list p21 p22 p23 p24)
) ;_ Fin de setq
(setq ss2 (ssget "_w" p21 p23 '((0 . "TEXT"))))
) ;fin de pas de ss2
(setq ss2h (ssget "_w" p21 p23 '((0 . "HATCH"))))
(command "_.draworder" ss2 "" "_front")
(setq fig2 (cdr (assoc 1 (entget (ssname ss2 0)))))
(if (= fig1 fig2)
(progn
(entdel (ssname ss1 0))
(entdel (ssname ss1h 0))
(entdel (ssname ss2 0))
(entdel (ssname ss2h 0))
(setq nb-paires (+ 1 nb-paires))
(alert "OK, c'est une paire !")
) ;_ Fin de progn
) ;_ Fin de if
(if (/= fig1 fig2)
(progn
(alert "mauvais choix")
(da:cacher-cases)
) ;_ Fin de progn
) ;_ Fin de if
(setq nb-essais (+ 1 nb-essais))
(setq pourcent (* (/ (* 1.0 nb-paires) nb-essais) 100))
(maj-nb-clic nb-essais nb-paires pourcent)
(setq ss1 nil
ss1h nil
ss2 nil
ss2h nil
)
) ;_ Fin de while
(setq temps2 (getvar "millisecs"))
(alert "terminé")
)
;programme principal
(defun c:memory ( / dcl_id chrdepart)
(setvar "cmdecho" 0)
(da:style-texte)
(da:faire-bloc-3att)
(setvar "ucsicon" 0)
(setq DCL_id (load_dialog "Memory-09.dcl"))
(if (not (new_dialog "Memory" DCL_id)) (progn (alert "fichier DCL introuvable")(exit)));_ Fin de if
 
(setq rb1 nil rb2 nil rb3 nil rb4 nil rb5 nil rb6 nil)
 
;(set_tile "Edit1" "4");remplissage de la largeur
;(set_tile "Edit2" "4");remplissage de la hauteur
(set_tile "ErrEdit1" " ")
(mode_tile "Edit1" 2)
;(set_tile "rb1" "1");allumage du bouton majuscules
(action_tile
"rb1"
"(mode_tile \"rb3\" 0)
(mode_tile \"rb4\" 0)
(mode_tile \"rb5\" 1)
(mode_tile \"rb6\" 1)
(setq rb2 nil)
(setq rb1 (get_tile \"rb1\"))"
) ;_ Fin de action_tile choix lettres
(action_tile
"rb2"
"(mode_tile \"rb3\" 1)
(mode_tile \"rb4\" 1)
(mode_tile \"rb5\" 0)
(mode_tile \"rb6\" 0)
(setq rb2 $value)
(setq rb1 nil)
(setq rb2 (get_tile \"rb2\"))"
);_ Fin de action_tile choix symboles
(action_tile
"rb3"
"(mode_tile \"rb5\" 1)
(mode_tile \"rb6\" 1)
(setq rb4 nil)
(setq rb3 $value)" 
)
(action_tile
"rb4"
"(mode_tile \"rb5\" 1)
(mode_tile \"rb6\" 1)
(setq rb3 nil)
(setq rb4 $value)" 
)
(action_tile
"rb5"
"(mode_tile \"rb5\" 0)
(mode_tile \"rb6\" 0)
(setq rb6 nil) 
(setq rb5 $value)" 
)
(action_tile
"rb6"
"(mode_tile \"rb5\" 0)
(mode_tile \"rb6\" 0)
(setq rb5 nil)
(setq rb6 $value)" 
)
(action_tile "Edit1" "(setq larg (atoi $value))") ;_ Fin de action_tile récupération de largeur
(action_tile "Edit2" "(setq haut (atoi $value))") ;_ Fin de action_tile récupération de hauteur
;(action_tile "accept" "(done_dialog 1)")
(action_tile "accept" "(verif)")
(action_tile "cancel" "(done_dialog 0)")
(action_tile "help" "(done_dialog 2)")
(setq rep (start_dialog))
;;;(if (< larg 0) (load_dialog "Memory-06.dcl")) ne marche pas
(if (= 1 rep)
(cond
((and (= rb1 "1")(= rb3 "1")) (setvar "textstyle" "StyleLettres")(dess-grille larg haut 64))
((and (= rb1 "1")(= rb4 "1")) (setvar "textstyle" "StyleLettres")(dess-grille larg haut 96))
((and (= rb2 "1")(= rb5 "1")) (setvar "textstyle" "StyleWEBding")(dess-grille larg haut 96))
((and (= rb2 "1")(= rb6 "1")) (setvar "textstyle" "StyleWEBding")(dess-grille larg haut 96))
)
);fin if rep égale 1
(if (= 2 rep) 
(alert
"Jeu de mémoire, (la vôtre pas les barettes de RAM).
\nCe \"jeu\" se veut éducatif mais dans le sens de la programmation...
\nLe programme place au hasard des valeurs par paires sur le plateau de jeu
\nEn cliquant sur une case sa valeur est mise en surbrillance, on clique ensuite sur une autre case et si une paire est formée avec la première case cliquée, la paire s'efface et le compteur s'incrémente.
\nSi on n'a pas formé de paire, on recommence jusqu'à en former une.
\nDidier Aveline de www.da-code.fr" 
) 
)
(command "_zoom" "_e")
(command "_zoom" "0.95xp")
);fin de defun memory
(defun verif ()
(if (not (zerop (rem (* larg haut) 2)))
(progn
(set_tile "ErrEdit2" "Le nombre de cases obtenu doit être pair !")
(mode_tile "Edit1" 2)
(action_tile rb3 "0")
;(done_dialog 0)
);progn
(if (> (* larg haut) 52)
(progn
(set_tile "ErrEdit2" "trop de cases!")
(mode_tile "Edit1" 2)
;(done_dialog 0)
);progn
(done_dialog 1)
)
);if
); defun verif que le nombre de cases en largeur et hauteur soit un nombre pair

Et voici le DCL :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84

Memory : dialog {
label = "[www.da-code] Jeu de Memory ";
:boxed_column {
fixed_width = true;
: text { key = "Text1"; label = "Nombre de cases en LARGEUR"; }
: edit_box { key = "Edit1"; edit_width = 2; fixed_width = true;}
//: text { key = "ErrEdit1"; label = "++"; }
//spacer;
: text { key = "Text2"; label = "Nombre de cases en HAUTEUR";}
: edit_box { key = "Edit2"; edit_width = 2; fixed_width = true;}
: text { key = "ErrEdit2"; label = ""; }
}
spacer;
: boxed_radio_row {
label = "Figures ?";
: radio_button {
label = "Lettres";
key = "rb1";
//value = 1;
}
: radio_button {
label = "Symboles";
key = "rb2";
//value = 0;
}
}
: boxed_radio_row {
//label = "Caractères ?";
: radio_button {
label = "Majuscules";
key = "rb3";
//value = 1;
is_enabled = false; 
}
: radio_button {
label = "Minuscules";
key = "rb4";
//value = 0;
is_enabled = false;
}
}
: boxed_radio_row {
//label = "Apparence ?";
//is_enabled = false;
: radio_button {
label = "WEBding";
key = "rb5";
//value = 0;
is_enabled = false;
 
}
: radio_button {
label = "WINGding";
key = "rb6";
//value = 0;
is_enabled = false;
}
}
spacer;
: boxed_column {
: button {
key = "accept";
label = "On y va";
is_default = true;
}
: button {
key = "cancel";
label = "Stop ";
is_default = false;
is_cancel = true;
}
: button {
key = "help";
label = "À propos";
is_default = true;
}
}
:boxed_row {
: paragraph { //début du paragraphe
: text_part { label = "Créé par Didier Aveline";}
: text_part { label = "Site : www.da-code.fr";}
}
}
}//fin du dialog

J'ai mis des commentaires, comme je conseille à tous de faire, pour expliciter les fonctions.

Haut de page

Retour à "Programmes"

22 février 2019