[racket] Difference between drscheme and racket

From: Aomar Maddi (Aomar.Maddi at univ-rennes1.fr)
Date: Wed Oct 23 09:57:40 EDT 2013

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)
   )
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.racket-lang.org/users/archive/attachments/20131023/7365771c/attachment-0001.html>

Posted on the users mailing list.