14. La Programmation par Objets et l’API Graphique
1 Exercice 14.5.1
2 Exercice 14.5.2
3 Exercice 14.5.3
4 Exercice 14.5.4
5 Exercice 14.5.5
6 Exercice 14.5.6
7 Exercice 14.5.7
8 Exercice 14.5.8
9 Exercice 14.5.9
10 Exercice 14.5.10
6.0.1.11

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.

titre

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 ~

Charles-Darwin.jpg