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:
;(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)
)
____________________
Racket Users list:
http://lists.racket-lang.org/users
