14. La Programmation par Objets et l’API Graphique
1 Exercice 14.5.1
Il suffit d’introduire une variable globale contenant la liste des objets créés. L’objet courant nouvellement créé se nomme this comme en Java.
(define LBALLES '()) |
|
(define balle% |
(class object% |
... |
(super-new) |
(set! LBALLES (cons this LBALLES)))) |
> LBALLES |
(#(struct:object:balle% 8 -15 (8 . -15)) |
#(struct:object:balle% 0 0 (0 . 0)) |
#(struct:object:balle% 35 0 (35 . 0))) |
2 Exercice 14.5.2
(define couple% ; les couples de valeurs quelconques en style objet |
(class object% |
(init-field (a '?) (b '?)) |
(define/public (first) |
a) |
(define/public (second) |
b) |
(super-new))) |
> (define c (make-object couple% 10 20)) ; <==> (new couple% (a 10) (b 20)) |
> (list (send c first) (send c second)) |
(10 20) |
Seconde version, avec mot de passe :
(define couple% |
(class object% |
(init-field (a '?) (b '?) (passwd '?)) |
(define a0 a) |
(define b0 b) |
(define/public (first) |
a) |
(define/public (second) |
b) |
(define/public (set-first! new-a pass) |
(if (equal? pass passwd) |
(set! a new-a) |
(printf "Accès refusé, mauvais mot de passe !\n"))) |
(define/public (set-second! new-b pass) |
(if (equal? pass passwd) |
(set! b new-b) |
(printf "Accès refusé, mauvais mot de passe !\n"))) |
(define/public (reset pass) |
(if (equal? pass passwd) |
(begin (set! a a0) (set! b b0)) |
(printf "Accès refusé, mauvais mot de passe !\n"))) |
(super-new))) |
> (define c (make-object couple% 10 20 'zorglub)) |
> (list (send c first) (send c second)) |
(10 20) |
> (send c set-first! 30 'thx1138) |
Accès refusé, mauvais mot de passe ! |
> (send c set-first! 30 'zorglub) |
> (list (send c first) (send c second)) |
(30 20) |
> (send c reset 'zorglub) |
> (list (send c first) (send c second)) |
(10 20) |
Comme il est mauvais pour l’esprit d’écrire plusieurs fois la même chose, j’enveloppe la vérification du mot de passe dans une macro. Notez que with-verif ne peut pas être une fonction, on lui passe du code en argument !
(define-syntax with-verif |
(syntax-rules () |
((with-verif pass passwd expr ...) (if (equal? pass passwd) |
(begin expr ...) |
(printf "Accès refusé !\n"))))) |
|
(define couple% |
(class object% |
(init-field (a '?) (b '?) (passwd '?)) |
(define a0 a) |
(define b0 b) |
(define/public (first) |
a) |
(define/public (second) |
b) |
(define/public (set-first! new-a pass) |
(with-verif pass passwd (set! a new-a))) |
(define/public (set-second! new-b pass) |
(with-verif pass passwd (set! b new-b))) |
(define/public (reset pass) |
(with-verif pass passwd (set! a a0) (set! b b0))) |
(super-new))) |
3 Exercice 14.5.3
La solution est dans le module tortue-objet.rkt.
4 Exercice 14.5.4
La solution est dans le module scroll-fac-gui.rkt.
5 Exercice 14.5.5
La méthode draw-bitmap de la classe canvas% permet de plaquer un bitmap en un point quelconque du canvas. J’utilise le fichier Charles-Darwin.jpg.
(define image |
(make-object bitmap% "Charles-Darwin.jpg")) ; fichier --> bitmap |
|
(define frame |
(new frame% (label "Image"))) |
|
(define canvas |
(new canvas% |
(parent frame) |
(min-width (send image get-width)) |
(min-height (send image get-height)) |
(paint-callback (lambda (c dc) |
(send dc draw-bitmap image 0 0))))) ; en (0,0) |
|
(send frame show #t) |
6 Exercice 14.5.6
Projet qui demande du souffle, à vous !...
7 Exercice 14.5.7
Le programme est dans le fichier more-buttons-no-mouse.rkt.
8 Exercice 14.5.8
Il suffit d’adopter la stratégie décrite à la page 331. La solution est dans le fichier more-buttons.rkt.
9 Exercice 14.5.9
Le programme se trouve dans le fichier file-browser.rkt. Il ne fonctionne que pour des fichiers qui sont des modules Racket débutant par #lang ... ou (module ...), mais pourrait être étendu à des fichiers Scheme dans le langage Etudiant avancé par exemple.
10 Exercice 14.5.10
J’utilise des chaînes de bits [les byte strings] pour aller plus vite, ainsi que - histoire de voir - la nouvelle possibilité qu’offre Racket, postérieure à la rédaction de mon livre PCPS, d’introduire define (presque) n’importe où dans du code... Fortement déviant par-rapport à la norme Scheme traditionnelle, mais j’aime assez finalement. Dans cette optique, define introduit une nouvelle liaison dans l’environnement courant [ou modifie une liaison existante] , alors que let introduit un nouvel environnement étendant l’environnement courant.
(define (visualiser url) ; url d'une image |
(define elts (cdr (regexp-match "http://([^/]+).*/([^/]+)$" url))) ; extraction des elements |
(define serveur (car elts)) |
(define fichier (cadr elts)) |
(printf "url=~s serveur=~s et fichier=~s\n" url serveur fichier) |
(define-values (p-in p-out) (tcp-connect serveur 80)) |
(file-stream-buffer-mode p-out 'none) |
(fprintf p-out "GET ~a HTTP/1.0\n\n" url) |
;Je cherche la taille du fichier dans l'en-tete |
(define size (do ((str (read-line p-in 'any) (read-line p-in 'any))) |
((regexp-match "Content-Length" str) str))) |
(set! size (string->number (car (regexp-match "[0-9]+" size)))) ; size = taille en octets |
; je cherche la ligne vide de l'en-tete |
(do ((str (read-line p-in) (read-line p-in))) |
((<= (string-length str) 2) (void))) |
(printf "Je lis les ~a octets de l'image sur ma connexion Internet.\n" size) |
(define bits (read-bytes size p-in)) |
(close-input-port p-in) |
(close-output-port p-out) |
; je viens de fermer les ports Internet. Je sauve l'image sur le disque dur |
(call-with-output-file fichier |
(lambda (p-out) |
(write-bytes bits p-out)) |
#:exists 'replace) |
; je construis un bitmap en memoire a-partir de l'image sur disque et le place dans un canvas |
(define bitmap (make-object bitmap% fichier)) |
(define frame (new frame% (label fichier))) |
(define canvas (new canvas% (parent frame) |
(min-width (send bitmap get-width)) |
(min-height (send bitmap get-height)) |
(paint-callback (lambda (c dc) |
(send dc draw-bitmap bitmap 0 0))))) |
(send frame show #t)) ; et zou ! |
> (visualiser "http://deptinfo.unice.fr/%7Eroy/PCPS/Charles-Darwin.jpg") ; %7E au lieu de ~ |
