<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"> <html> <head> <meta http-equiv="content-type" content="text/html; charset=ISO-8859-1"> </head> <body bgcolor="#ffffff" text="#000000"> <div id="gt-src-tools"> <div id="gt-src-tools-l"> <div style="display: inline-block;" id="gt-input-tool"> <div id="itamenu"></div> </div> </div> </div> <div id="gt-res-content" class="almost_half_cell"> <div dir="ltr" style="">I wrote a program using drscheme scheme. I'm having trouble getting it to work with racketeering. He tells me the mistakes that I do not understand. Thank you for your help. Here is the source of this program:</div> </div> ;(require (lib "compile.ss")) ;(compile-file "gplateau.scm" "../gplateau.zo") (module gplateau racket (provide (all-defined-out)) (require racket/math) (require racket/list) (require racket/class) (require racket/draw) (require racket/gui) (require framework) (require (file "sol-awale.zo")) (require (file "meo-plateau.zo")) (define bitmapdir (string-append (current-load-relative-directory) "Bitmaps/")) ;; Le numero de joueur courant (define JoueurCourant 1) ;; Le plateau courant (define PlateauCourant (InitialiserPlateau 4 4 4 4 4 4 4 4 4 4 4 4)) ;; les scores (define score1 0) (define score2 0) ;; les dimensions du plateau (define plateauX 800) (define plateauY 300) ;; La reinitialisation du plateau (define initp (lambda () (set! JoueurCourant 1) (set! PlateauCourant (InitialiserPlateau 4 4 4 4 4 4 4 4 4 4 4 4)) (set! score1 0) (set! score2 0))) ;; Le constructeur de case-graphique ;; ncase: [1;12] x naturel x naturel -> case-graphique ;; n, x, y -> case-graphique avec le numero de case n et la position en x et y du sommet ;; (haut a gauche) du carre dans lequel est inscrit le cercle de la case (define ncase (lambda (n x y) (cons (cons n x) y))) ;; les extracteurs correspondant (define num caar) (define xpos cdar) (define ypos cdr) ;; Le rayon et le diametre d'une case (graphique) (define rayon-case 50) (define diametre-case (* 2 rayon-case)) ;; La position des 12 cases graphiques (define lesCases (list (ncase 1 10 170) (ncase 2 130 170) (ncase 3 250 170) (ncase 4 370 170) (ncase 5 490 170) (ncase 6 610 170) (ncase 7 610 30) (ncase 8 490 30) (ncase 9 370 30) (ncase 10 250 30) (ncase 11 130 30) (ncase 12 10 30))) ;; pos-case: [1;12] -> case-graphique ;; c -> la case graphique correspondant a c (define pos-case (lambda (c) (list-ref lesCases (- c 1)))) ;; distance: reel x reel --> reel+ ;; x, y --> la distance separant le ;; point de coord. x,y de l'origine. (define distance (lambda (x y) (sqrt (+ (* x x) (* y y))))) ;; dans-case: nombre x nombre x nombre x nombre -> booleen ;; x1, y1, x2, y2 -> le point de coordonnees (x2, y2) est dans ;; la case dont le cercle est inscrit dans le carre dont le sommet haut ;; gauche est de coordonnees (x1, y1) (define dans-case (lambda (x1 y1 x2 y2) (let [[dist (distance (- x2 (- x1 rayon-case)) (- y2 (- y1 rayon-case)))]] (< dist rayon-case)))) (define numero-aux (lambda (x y l) (cond [(null? l) #f] [(dans-case x y (xpos (car l)) (ypos (car l))) (num (car l))] [#t (numero-aux x y (cdr l))]))) ;; numero-case: nombre x nombre -> [1;2] U {#f} ;; x, y -> donne le numero de la case dans laquelle ;; figure le point de coordonnees (x,y) et faux si le point ;; est en dehors des cases (define numero-case (lambda (x y) (numero-aux x y lesCases))) (define mouse-handler (lambda (mo) (cond [(not (send mo button-down?)) '()] [#t (let [[num-case (numero-case (send mo get-x) (send mo get-y))]] (cond [(not num-case) '()] [(not (CaseAppartient? num-case JoueurCourant)) '()] [(= (NbGrainesCase PlateauCourant num-case) 0) '()] [#t (let* [[res (ActionJoueur PlateauCourant JoueurCourant num-case)] [nouveau-plateau (car res)] [gain (cdr res)]] (if (= JoueurCourant 1) (set! score1 (+ score1 gain)) (set! score2 (+ score2 gain))) (set! PlateauCourant nouveau-plateau) (set! JoueurCourant (Adversaire JoueurCourant)) (AffichePlateau PlateauCourant) (cond ((and (= JoueurCourant 1) (FinJeu? PlateauCourant 1)) (set! score2 (+ score2 (CollecterGraines PlateauCourant 1 6))) (AffichePlateau PlateauCourant) (FinJeu)) ((and (= JoueurCourant 2) (FinJeu? PlateauCourant 2)) (set! score1 (+ score1 (CollecterGraines PlateauCourant 7 12))) (AffichePlateau PlateauCourant) (FinJeu))))]))]))) (define popup (make-object frame% "Fin du Jeu!" #f 200 100)) (define msg-popup (make-object message% "+++++++++++++++++++++++++" popup)) (make-object button% "OK" popup (lambda (button event) (begin (send popup show #f)))) ;; La bitmap et le "drawing context" associe, pour le plateau (define bitmap (make-object bitmap% plateauX plateauY)) (define dcbit (make-object bitmap-dc%)) (define frame (make-object frame% "Sol-Awale" #f plateauX (+ plateauY 30))) (define affiche (lambda(dc) (send dc draw-bitmap bitmap 0 0))) ;; Le canvas associe au plateau dont les methodes on-paint et on-event sont respectivement surchargees ;; par les methodes affiche et le mouse-handler defini au dessus (define mycanvas% (class canvas% (frame) (inherit get-dc) (override [on-paint (lambda () (affiche (get-dc)))]) (override [on-event (lambda (mo) (mouse-handler mo))]) (sequence (super-init frame )))) (define canvas (make-object mycanvas% frame)) (define dc (send canvas get-dc)) (define pen1 (make-object pen% "BLACK" 1 'transparent)) (define brush1 (make-object brush% "RED" 'solid)) ;; dessine-case: [1;12] x naturel -> vide ;; c, n -> dessine la case c avec n graines (define dessine-case (lambda (c n) (let* [[case (pos-case c)] [xc (xpos case)] [yc (ypos case)] [n2 (if (> n 12) 12 n)]] ;; au dela de 12 graines on ne differencie plus (send dcbit draw-bitmap (list-ref lbitmap n2) xc yc)))) (define black (make-object color% 0 0 0)) (define white (make-object color% 255 255 255)) (define red (make-object color% 255 0 0)) (send dcbit set-text-background white) (send dcbit set-text-foreground black) ;; AffichePlateau: plateau -> vide ;; p -> affiche le plateau p (define AffichePlateau (lambda (p) (AfficheAux p 1) (if (= JoueurCourant 1) (send dcbit set-text-foreground black) (send dcbit set-text-foreground red)) (send dcbit draw-text "Joueur 2" 730 60 #f) (send dcbit draw-rectangle 730 80 800 125) (send dcbit draw-text (number->string score2) 730 80 #f) (if (= JoueurCourant 1) (send dcbit set-text-foreground red) (send dcbit set-text-foreground black)) (send dcbit draw-text "Joueur 1" 730 200 #f) (send dcbit draw-rectangle 730 220 800 225) (send dcbit draw-text (number->string score1) 730 220 #f) (affiche dc) )) (define AfficheAux (lambda (p c) (cond ((= c 12) (dessine-case c (NbGrainesCase p c)) (affiche dc)) (#t (dessine-case c (NbGrainesCase p c)) (AfficheAux p (CaseSuivante c)))))) (define FinJeu (lambda () (cond ((= score1 score2) (send msg-popup set-label "Egalite!")) ((> score1 score2) (send msg-popup set-label (string-append "Le joueur 1 gagne " (number->string score1) " a " (number->string score2)))) (#t (send msg-popup set-label (string-append "Le joueur 2 gagne " (number->string score2) " a " (number->string score1))))) (send popup show #t))) ;; Definition du clipping pour l'affichage des bitmaps correspondant aux cases dans ;; des cercles propres (les bitmaps sont toujours rectangulaires :-/ ) (define clip (make-object region% dcbit)) (for-each (lambda (case) (let [[clip2 (make-object region% dcbit)]] (send clip2 set-ellipse (xpos case) (ypos case) diametre-case diametre-case) (send clip union clip2))) lesCases) (define clip2 (make-object region% dcbit)) ;; On ajoute aussi le rectangle pour l'affichage des scores. (send clip2 set-rectangle 725 60 800 250) (send clip union clip2) ;; Chargement de la bitmap de fond du plateau (define wood (make-object bitmap% 100 100)) (send wood load-file (string-append bitmapdir "wood.xpm") 'xpm) ;; Chargement de la liste de bitmaps pour tous les etats de case possible 0, 1, 2...12+ graines (define lbitmap (map (lambda (n) (let [[b (make-object bitmap% 100 100)]] (send b load-file (string-append bitmapdir (number->string n) ".xpm") 'xpm) b)) (list 0 1 2 3 4 5 6 7 8 9 10 11 12))) (send brush1 set-stipple wood) (send dcbit set-bitmap bitmap) (send dcbit clear) (send dcbit set-brush brush1) (send dcbit set-pen pen1) (send dcbit draw-rectangle 0 0 plateauX plateauY) (send dcbit set-clipping-region clip) (AffichePlateau PlateauCourant) (make-object button% "Recommencer" frame (lambda (button event) (initp) (AffichePlateau PlateauCourant))) (send frame show #t) (sleep/yield 1) (affiche dc) ) </body> </html>