Le Mémento du SCHEMEUR [5-6]

 
MP2-MI2 1. Nombres, expressions, fonctions
MP2-MI2 2. Doublets et listes
MI2   3. Macros
MI2   4. Aspects impératifs
opt MI2 * 5. Programmation par objets
opt MI2 * 6. Programmation graphique

Ces notes forment [seulement] un mémento fixant la terminologie et permettant de ne pas s'ennuyer dans les bus. Pour les livres de référence, consulter la bibliographie. Le dialecte utilisé dans ces notes est DrScheme, version 202.

5ème partie : La Programmation par Objets

DrScheme offre un système de classes modelé [souplement] sur celui de Java. On peut y définir des classes avec des attributs publics ou privés, des sous-classes avec héritage, des interfaces, et une API analogue à l'AWT pour construire des interfaces graphiques. Un nom de classe se termine par %, un nom d'interface par <%>. La racine de l'arbre des classes est object%. Il est indispensable de consulter la documentation [PLT MzLib Librairies Manual, chap. 3] car ce qui suit ne peut être qu'une introduction. Enfin, cette couche-objet est propre à DrScheme et n'est pas normalisée [cf schemers.org pour d'autres implémentations].

On charge la couche-objet via une librairie de la collection MzLib [inutile si l'on est en Assez Gros Scheme] :

(require (lib "class.ss"))

Une classe spécifie des champs [ou attributs] avec des valeurs initiales, des méthodes ainsi que des variables d'initialisation qui seront liées aux arguments de l'un des deux constructeurs make-object et instantiate. Contrairement aux classes des versions < 200, les méthodes ne sont plus simplement des champs de type procédure, et ont un statut à part comme en Java. Une instance de la classe bidule% comporte deux champs nom et poids, 3 méthodes publiques et une méthode privée : 

(define bidule%
  (let ((nb 0))                                       ; variable de classe privée
    (class* object% ()
      (init-field (name "Inconnu") (price 0))         ; pour le constructeur
      (field (x 100))                                 ; variable d'instance publique
      (define y -1)                                   ; variable d'instance privée
      (define/public (get-name) name)                 ; methode d'instance publique
      (define/public (set-name! n) (set! name n))     ; methode d'instance publique
      (define/public (get-price) (calc price))        ; methode d'instance publique
      (define/private (calc x) (* x 10))              ; methode d'instance privee
      (define/public (stats) (printf "[x=~a nb=~a]~n" x nb))   ; methode d'instance publique
      (super-instantiate ())                          ; appel au constructeur de la classe-mère
      (set! nb (+ nb 1)))))                           ; fin de l'initialisation de l'instance

> bidule%                                             ; une valeur de type classe
#<struct:class:bidule%>
> (class? bidule%)
#t

N.B. Le dernier exemple montre que contrairement à Java [qui a râté le coche], les classes forment un type comme les procédures : on peut les passer en paramètre à des fonctions, les stocker dans des structures de données, etc. bref ce sont des valeurs... de première classe ! Si vous voulez voir l'équivalent en Java, cliquez ici...

On définit un objet [une instance] de la classe avec le constructeur universel (make-object classe arg ...) où les arguments [optionnels] sont dans l'ordre les valeurs initiales des champs nom et poids. On peut aussi utiliser instantiate en précisant dans un ordre quelconque les noms de certains champs et leurs valeurs : 

> (define foo1 (make-object bidule%))                ; nom = "Inconnu" et poids = 0
> (define foo2 (make-object bidule% "A" 12))         ; nom = "A" et poids = 12
> (define foo3 (instantiate bidule% () (poids 45)))  ; nom = "Inconnu" et poids = 45

On invoque une méthode publique avec le transmetteur de message (send obj method arg ...) : 

> (send foo1 get-name)       ; j'envoie à foo1 le message get-name
"Inconnu"
> (send foo3 get-price)
[x=100 et ss=-1]
450
> (send foo1 set-name! "Nihao")
> (send foo1 get-name)
> "Nihao"
> (send foo1 stats)          ; 3 objets créés, nb est incrémenté à chaque création
[x=100 nb=3]
> (send foo1 calc 8)         ; la méthode d'instance calc est privée !
send: no such method: calc

On accède à un champ public soit via un accesseur public [comme get-name ci-dessus], soit de manière dynamique en générant l'accesseur ! 

> (send foo2 get-name)           ; mais pas de get-x
"Foo2"
> (define access-name (class-field-accessor bidule% name))
> (define access-x (class-field-accessor bidule% x))
> (list (access-name foo2) (access-x foo2))
("Foo2" 100)
> (define access-y (class-field-accessor bidule% y))   ; private !
class-field-accessor: no such field: y

De même, on modifie un champ soit avec un modificateur [comme set-name!] soit en le générant lui aussi dynamiquement : 

> (define mutate-x! (class-field-mutator bidule% x))
> (begin (mutate-x! foo1 40) (access-x foo1))
40

Une interface [son nom se termine par <%>] déclare les noms des méthodes qui doivent être définies dans toute classe qui implémente l'interface : 

; Toute classe implémentant l'interface stack<%> doit s'engager
; à implémenter les fonctions push!, pop! et empty?.

(define stack<%>
  (interface ()                       ; aucune sur-interface
     push! pop! empty?))

> (interface? stack<%>)           ; une valeur de type interface
#t
> (make-object stack<%>)          ; on ne peut pas instancier une interface
instantiate: expects argument of type <class>

Une classe peut implémenter une interface en concrétisant les variables d'interface :
  
(define stack%
  (class* object% (stack<%>)      ; extends object% implements stack<%>
    (init-field (name 'stack))
    (define L '())                ; la liste privée qui implémente la pile
    (define/public (push! v) (set! L (cons v L)))
    (define/public (pop!) (set! L (cdr L)))
    (define/public (empty?) (null? L))
    (define/public (top) (car L))
    (super-instantiate ())))

> (define p1 (make-object stack% 'ma-pile))
> (begin (send p1 push! 'a)(send p1 push! 'b)(send p1 push! 'c)(send p1 pop!)(send p1 top))
b
> ((class-field-accessor stack% name) p1)
ma-pile

N.B. Une classe peut implémenter plusieurs interfaces. Cette possibilité pallie à l'absence d'héritage multiple [une classe ne peut étendre qu'une seule classe].

Un objet d'une sous-classe peut utiliser [c'est l'héritage] les méthodes publiques de sa classe-mère et peut redéfinir [override] certaines méthodes de sa classe-mère. La classe sstack% ci-dessous étend la classe stack% en redéfinissant la méthode pop! [pour qu'elle retourne l'objet dépilé] et en ajoutant une nouvelle méthode dpush! qui empile deux fois. Afin de pouvoir utiliser les méthodes push! et top de la classe-mère, on les déclare inherit. Dans la mesure où on redéfinit pop!, il est nécessaire de renommer le pop! antérieur avec rename si l'on souhaite l'utiliser dans le nouveau : 

(define sstack%
  (class* stack% ()           ; extends stack% implements rien d'autre
    (inherit top push!)       ; pour l'utiliser dans pop! ci-dessous
    (rename (super-pop! pop!))
    (define/override (pop!) (let ((x (top))) (super-pop!) x))
    (define/public (dpush! x) (push! x) (push! x))
    (super-instantiate ())))

> (define p2 (make-object sstack%))
> ((class-field-accessor stack% name) p2)
sa-pile
> (send p2 dpush! 'a)
> (send p2 top)
a
> (send p2 pop!)
a
> (send p2 top)
a
> (send p2 pop!)
a
> (send p2 empty?)
#t

Au sein d'une méthode d'instance, l'objet this fait référence à l'instance courante. En l'utilisant explicitement, on pouvait donc éviter l'usage de inherit ci-dessus. Par contre, (send this pop!) invoquerait la méthode redéfinie ! 

(define sstack%
  (class* stack% ()
    (rename [super-pop! pop!])
    (define/override (pop!) (let ((x (send this top))) (super-pop!) x))
    (define/public (dpush! x) (send this push! x) (send this push! x))
    (super-instantiate ())))

6ème partie : Programmation graphique

Graphisme cartésien simplifié [non objet]
Graphisme polaire de la tortue [non objet]
Graphisme avec l'API [objet]

Le graphisme cartésien simplifié [non objet]

Très rudimentaire, mais bien pratique pour de petits programmes graphiques, il est décrit dans les fichiers d'aide en français sur DrScheme [ajouts locaux] et permet de dessiner des points, des segments, des rectangles, des ellipses, en couleurs, et de gérer les boutons de la souris. Ouvrez dans cette doc en français :

Le Mémento du Schemeur/Le graphisme standard

Entrez le code ci-dessous dans l'éditeur, puis cliquez le bouton Execute...  

(require (lib "graphics.ss" "graphics"))

(open-graphics)

(define mywin
  (open-viewport "Dessin" 300 300))

(define rouge (make-rgb 1 0 0))
(define bleu (make-rgb 0 0 1))
(define vert (make-rgb 0 1 0))

(define (dessin)
  ((draw-solid-ellipse mywin) (make-posn 0 0) 200 100 rouge)
  ((draw-rectangle mywin) (make-posn 10 10) 100 150 bleu)
  ((draw-solid-rectangle mywin) (make-posn 90 30) 40 100 vert)
  ((draw-rectangle mywin) (make-posn 90 30) 40 100)
  ((draw-line mywin) (make-posn 10 10) (make-posn 130 130)))

(dessin)

La gestion simplifiée de la souris [non objet]

Il est extrèmement facile de gérer la souris en graphisme cartésien, sans recourir à la couche-objet. Voici un exemple de programme rudimentaire qui fait apparaître une fenêtre et dessine un cercle à chaque clic-gauche de la souris : 

(require (lib "graphics.ss" "graphics"))

(open-graphics)

(define mywin (open-viewport "Essai graphique" 300 300))

(define yellow (make-rgb 1 1 0))
(define red (make-rgb 1 0 0))
(define blue (make-rgb 0 0 1))

((draw-viewport mywin) yellow)             ; le fond

((draw-string mywin) (make-posn 5 290) "Cliquez sur le bouton droit pour finir...")

(define (go n)
  (let* ((click (get-mouse-click mywin))   ; un 'descripteur de clic'
         (posn (mouse-click-posn click)))
    (printf "click en (~a,~a)~n" (posn-x posn) (posn-y posn))
    (cond ((left-mouse-click? click)
           ((draw-ellipse mywin) 
            (make-posn (- (posn-x posn) 10) (- (posn-y posn) 10)) 20 20 red)
           (go (+ n 1)))
          (else (flasher 8) (list n 'cercles)))))

(define (flasher nfois)
  (if (> nfois 0)
      (begin ((flip-viewport mywin))
             (sleep/yield 0.05)            ; en secondes
             (flasher (- nfois 1))))) 

(go 0)

(close-viewport mywin)

(close-graphics)

Le graphisme polaire de la TORTUE [non objet]

Il consiste à piloter un animal virtuel [modèle d'un robot ou d'une table traçante], n'ayant qu'une connaissance locale de sa position. Il navigue donc en polaire en effectuant des déplacements dans le plan [translations et rotations]. Il y a deux couches tortue : celle qui est primitive à DrScheme, et celle made in UNSA [chargement d'un fichier spécial] qui offre en plus un repérage absolu de la tortue pour faire... des choses non tortueuses. Les primitives se trouvent dans le secteur français de la doc sur DrScheme [cf plus haut]. Exemple de programme tortue, le tracé d'un carré de côté C, en utilisant la forme spéciale (repeat n expr ...) propre à la géométrie tortue : 

(define (carre C)           ; un carré de côté C
  (repeat 4
    (forward C)
    (left 90)))

Graphisme avec l'API de la couche objet

DrScheme possède un système de classes modelé souplement sur Java, avec beaucoup de classes graphiques de base. Nous vous renvoyons à la documentation [1.5Mo au format pdf] sur cette couche-objet, nous contenant de donner quelques exemples minimaux de programmation graphique, juste pour faire démarrer des projets. Il suffit d'entrer les codes ci-dessous dans l'éditeur et de cliquer le bouton Execute...

Exemple 1 : un dialogue

; Demande d'un nom via un dialogue.
; Le nom est stocke dans la variable globale $nom

(define $dialog
  (make-object dialog% "Exemple" #f #f #f 200 100))

(define $texte
  (make-object text-field% "Votre nom:" $dialog void))

(define $panel (make-object horizontal-panel% $dialog))

(define $nom #f)

(define $bouton-ok
  (make-object button% "Ok" $panel
               (lambda (b e)
                 (let ((nom (send $texte get-value)))
                   (set! $nom nom)
                   (send $dialog show #f)))))

(send $panel set-alignment 'center 'center)

(define (go)
  (printf "Votre nom est initialement : ~a~n" $nom)
  (send $dialog show #t)
  (printf "Votre nom est maintenant : ~a~n" $nom))

(go)

Exemple 2 : Dessins dans une fenêtre graphique

; On ouvre une fenêtre de titre "Dessin" de taille 300x200, à la position
; 5,5 sans case de taille:

(define $frame
  (make-object frame% "Dessin" #f 300 200 5 5))

; A l'intérieur de cette fenêtre, on va associer un canvas [feuille de dessin]
; pour y dessiner:

(define $canvas
  (make-object canvas% $frame))

; On recupère le device context [dc] du canvas qui représente l'endroit
; réel où vont se faire les affichages [les molécules de la feuille de dessin]:

(define $dc (send $canvas get-dc))

; On définit deux pinceaux et deux brosses. Un pinceau sert à dessiner
; les lignes et les frontières de formes graphiques comme le périmètre d'une ellipse. 
; La brosse sert à remplir l'intérieur de l'ellipse par exemple:

(define $no-pen (make-object pen% "black" 1 'transparent))
(define $blue-pen (make-object pen% "blue" 1 'solid))
(define $black-pen (make-object pen% "black" 1 'solid))
(define $no-brush (make-object brush% "black" 'transparent))
(define $red-brush (make-object brush% "red" 'solid))
(define $green-brush (make-object brush% "green" 'solid))

; le programme principal:

(define (dessin dc)                ; on dessine directement dans le dc
  (send dc set-pen $no-pen)        ; contour transparent
  (send dc set-brush $red-brush)   ; et intérieur rouge
  (send dc draw-ellipse 0 0 200 100)
  (send dc set-pen $blue-pen)      ; contour bleu
  (send dc set-brush $no-brush)    ; et intérieur transparent
  (send dc draw-rectangle 10 10 100 150)
  (send dc set-pen $black-pen)     ; contour noir
  (send dc set-brush $green-brush) ; et intérieur vert
  (send dc draw-rectangle 90 30 40 100)
  (send dc draw-line 10 10 130 130))

(send $frame show #t)           ; on active la fenêtre
(sleep/yield 0.5)               ; on laisse un peu souffler le système !!!
(dessin $dc)                    ; et on dessine dans $dc

Le seul inconvénient de ce programme est que si vous recouvrez la fenêtre graphique par une autre fenêtre et si vous la faites revenir au premier plan, son contenu n'est pas automatiquement restauré. Voir l'exemple suivant pour y remédier...

Exemple 3 : Rafraîchissement de la fenêtre graphique

; Dessins dans une fenetre graphique. Mais on gère maintenant
; le redessin de la fenetre apres recouvrement, en définissant
; une sous-classe de canvas% qui redéfinit la méthode on-paint.

; On définit deux pinceaux et deux brosses. Un pinceau sert
; à dessiner les lignes et les frontières de formes graphiques
; comme le périmètre d'une ellipse. La brosse sert à remplir
; l'intérieur de l'ellipse par exemple:

(define $no-pen (make-object pen% "black" 1 'transparent))
(define $blue-pen (make-object pen% "blue" 1 'solid))
(define $black-pen (make-object pen% "black" 1 'solid))
(define $no-brush (make-object brush% "black" 'transparent))
(define $red-brush (make-object brush% "red" 'solid))
(define $green-brush (make-object brush% "green" 'solid))

; le programme principal:

(define (dessin dc)   ; on dessine directement dans le dc
  (send dc set-pen $no-pen)        ; contour transparent
  (send dc set-brush $red-brush)   ; et interieur rouge
  (send dc draw-ellipse 0 0 200 100)
  (send dc set-pen $blue-pen)      ; contour bleu
  (send dc set-brush $no-brush)    ; et interieur transparent
  (send dc draw-rectangle 10 10 100 150)
  (send dc set-pen $black-pen)     ; contour noir
  (send dc set-brush $green-brush) ; et interieur vert
  (send dc draw-rectangle 90 30 40 100)
  (send dc draw-line 10 10 130 130))

; construction d'un bitmap 300x200 pour sauver l'image du dc

(define $bitmap (make-object bitmap% 300 200))
(define $bitmap-dc (make-object bitmap-dc%))
(send $bitmap-dc set-bitmap $bitmap)
(send $bitmap-dc clear)

(dessin $bitmap-dc)     ; on dessine dans le $bitmap-dc

; construction d'une fenêtre 300x200

(define $frame
  (make-object frame% "Dessin" #f 300 200 5 5))

; définition d'une sous-classe de canvas% qui redéfinit la
; méthode on-paint:

(define $bitmap-canvas%
  (class* canvas% ()
    (inherit get-dc)
    (define/override on-paint 
      (lambda () (send (get-dc) draw-bitmap $bitmap 0 0)))
    (super-instantiate ())))

(define $canvas
  (make-object $bitmap-canvas% $frame))

(send $frame show #t)

Allez, on va s'arrêter là pour aujourd'hui... A ciao et bon dimanche.

Dernières corrections en date du 03.11.2002

Jean-Paul Roy
Département Informatique
Faculté des Sciences de Nice