#lang scheme

(require (lib "world.ss" "htdp"))

;                                               
;                                               
;                                               
;          ;                                    
;          ;                                    
;          ;                                    
;    ;;;   ;   ;;;    ;;;    ;;;    ;;;    ;;;  
;   ;   ;  ;  ;   ;  ;   ;  ;   ;  ;   ;  ;   ; 
;   ;      ;      ;  ;      ;      ;   ;  ;     
;   ;      ;   ;;;;   ;;;    ;;;   ;;;;;   ;;;  
;   ;      ;  ;   ;      ;      ;  ;          ; 
;   ;   ;  ;  ;  ;;  ;   ;  ;   ;  ;   ;  ;   ; 
;    ;;;   ;   ;; ;   ;;;    ;;;    ;;;    ;;;  
;                                               
;                                               
;                                               

(define figure%
  (class object%
    (init-field [image empty] [x 0] [y 0] [classe figure%])
    
    (define/public (touche? autre-figure)
      (and (< (abs (- x (send autre-figure getX))) (send this getLargeur))
           (< (abs (- y (send autre-figure getY))) (send this getHauteur))))   
    
    (define/public (getX) x)
    (define/public (getY) y)
    (define/public (getImage) image)
    (define/public (getLargeur) (image-width image))
    (define/public (getHauteur) (image-height image))
    (define/public (getClasse) classe)
    (super-new)))

(define mobile%
  (class figure%
    (init-field [dx 0] [dy 0])
    
    (define/public (monte)
      (let* ([y (send this getY)]
             [nouveau-y 
              (if (> y (+ (/ (send this getHauteur) 2) 10)) 
                  (- y 10)
                  y)])
        
        (new (send this getClasse) 
             [image (send this getImage)] 
             [x (send this getX)] 
             [y nouveau-y]
             [classe (send this getClasse)])))
    
    (define/public (descend)
      (let* ([y (send this getY)]
             [nouveau-y 
              (if (< y (- HAUTEUR (+ (/ (send this getHauteur) 2) 10)))
                  (+ y 10)
                  y)])
        
        (new (send this getClasse) 
             [image (send this getImage)] 
             [x (send this getX)]
             [y nouveau-y]
             [classe (send this getClasse)])))
    
    (define/public (deplace dans-jeu)
      (new (send this getClasse) 
           [image (send this getImage)] 
           [x (+ (send this getX) dx)] 
           [y (+ (send this getY) dy)] 
           [dx (send this getdX)]
           [dy (send this getdY)]
           [classe (send this getClasse)]))
    
    (define/public (getdX) dx)
    (define/public (getdY) dy)
    (super-new)))

(define mobile-rebondissant%
  (class mobile%
    
    (define/override (deplace dans-jeu)
      (let* ([x (send this getX)]
             [y (send this getY)]
             [dx (send this getdX)]
             [dy (send this getdY)]
             [h (send this getHauteur)]
             [l (send this getLargeur)]
             [rg (jeu-raquette-gauche dans-jeu)]
             [rd (jeu-raquette-droite dans-jeu)]
             [delta-y
              (if (or (and (> y (- HAUTEUR (+ (/ h 2) 5))) (> dy 0)) 
                      (and (< y (+ (/ h 2) 5)) (< dy 0)))
                  (- dy)
                  dy)]
             [delta-x
              (if (or (and
                       (and (> x (- LARGEUR (+ (/ l 2) 10))) (> dx 0)) 
                       (send this touche? rd))
                      (and 
                       (and (< x (+ (/ h 2) 10)) (< dx 0))
                       (send this touche? rg)))
                  (- dx)
                  dx)])
        
        (new (send this getClasse) 
             [image (send this getImage)] 
             [x (+ (send this getX) dx)]
             (y (+ (send this getY) dy)) 
             [dx delta-x]
             [dy delta-y]
             [classe (send this getClasse)])))
    
    (super-new)))

(define joueur%
  (class mobile%
    (init-field [inertie 2] [compteur-inertie inertie])
    
    (define/private (visible? figure)
      (< (distance figure) (/ (random LARGEUR) 1.2)))
    
    (define/override (deplace dans-jeu)
      (let* ([balle (jeu-balle dans-jeu)]
             [d (distance balle)]
             [monte-un-cran (send this monte)]
             [nouveau-compteur-inertie
              (if (= compteur-inertie 0)
                  inertie
                  (- compteur-inertie 1))]                 
             [nouveau-joueur           
              (if (and (= compteur-inertie 0)
                       (visible? balle))
                  (cond [(>= (send monte-un-cran distance balle) d)                                        
                         (send this descend)]
                        [(= (send monte-un-cran distance balle) d)
                         this]
                        [else
                         monte-un-cran])
                  this)])    
        
        (new (send nouveau-joueur getClasse) 
             [image (send nouveau-joueur getImage)]
             [x (send nouveau-joueur getX)]
             [y (send nouveau-joueur getY)] 
             [dx (send nouveau-joueur getdX)]
             [dy (send nouveau-joueur getdY)]
             [compteur-inertie nouveau-compteur-inertie]
             [classe (send nouveau-joueur getClasse)])))
    
    (define/public (distance figure)
      (let ([x1 (send this getX)]
            [y1 (send this getY)]
            [x2 (send figure getX)]
            [y2 (send figure getY)])
        (sqrt (+ (sqr (- x2 x1)) (sqr (- y2 y1))))))
    
    (super-new)))    

;                                                                        
;                                                                        
;                                                                        
;     ;          ;                                                       
;    ;            ;                                                      
;   ;              ;                                           ;         
;                                                              ;         
;   ;;;  ;;; ;;; ;;;  ;; ;;    ;;;  ;; ;;  ;;    ;;;  ;; ;;   ;;;;  ;;;; 
;  ;   ;  ;   ; ;   ;  ;;  ;  ;   ;  ;;  ;;  ;  ;   ;  ;;  ;   ;   ;   ; 
;  ;;;;;   ; ;  ;;;;;  ;   ;  ;;;;;  ;   ;   ;  ;;;;;  ;   ;   ;    ;;   
;  ;       ; ;  ;      ;   ;  ;      ;   ;   ;  ;      ;   ;   ;      ;; 
;  ;   ;   ; ;  ;   ;  ;   ;  ;   ;  ;   ;   ;  ;   ;  ;   ;   ; ; ;   ; 
;   ;;;     ;    ;;;  ;;; ;;;  ;;;  ;;; ;;; ;;;  ;;;  ;;; ;;;  ;;; ;;;;  
;                                                                        
;                                                                        
;                                                                        

(define (jeu-suivant j)
  (map (lambda (mobile) (send mobile deplace j)) j)) 

(define (affiche-jeu j)
  (if (empty? (cdr j))
      (place-image (send (car j) getImage)
                   (send (car j) getX)
                   (send (car j) getY)
                   (empty-scene LARGEUR HAUTEUR))
      (place-image (send (car j) getImage)
                   (send (car j) getX)
                   (send (car j) getY)
                   (affiche-jeu (cdr j)))))

(define (gestion-clavier j a-key-event)
  (cond 
    [(key=? a-key-event #\a)
     (cons (send (jeu-raquette-gauche j) monte) (cdr j))]
    [(key=? a-key-event #\q) 
     (cons (send (jeu-raquette-gauche j) descend) (cdr j))]
    [(key=? a-key-event 'up) 
     (let ([raquettes (list (jeu-raquette-gauche j) (send (jeu-raquette-droite j) monte))])
       (append raquettes (cdr (cdr j))))]
    [(key=? a-key-event 'down) 
     (let ([raquettes (list (jeu-raquette-gauche j) (send (jeu-raquette-droite j) descend))])
       (append raquettes (cdr (cdr j))))]
    [else
     j]))

;                    
;                    
;                    
;                    
;                    
;                    
;   ; ; ;   ;  ; ;;  
;   ;;  ;   ;  ;;  ; 
;   ;   ;   ;  ;   ; 
;   ;   ;   ;  ;   ; 
;   ;   ;   ;  ;   ; 
;   ;   ;   ;  ;   ; 
;   ;    ;;;;  ;   ; 
;                    
;                    
;                    

(define LARGEUR 500)
(define HAUTEUR 300)

(define (jeu-raquette-gauche jeu)
  (car jeu))

(define (jeu-raquette-droite jeu)
  (car (cdr jeu)))

(define (jeu-balle jeu)
  (car (cdr (cdr jeu))))

(define make-raquette-ordinateur 
  (new joueur% 
       [image (rectangle 10 40 'solid 'red)] 
       [x 10] [y (/ HAUTEUR 2)]
       [classe joueur%]))

(define make-raquette-joueur 
  (new mobile% 
       [image (rectangle 10 40 'solid 'green)] 
       [x (- LARGEUR 10)] [y (/ HAUTEUR 2)] 
       [classe mobile%]))

(define make-balle-noire 
  (new mobile-rebondissant% 
       [image (circle 5 'solid 'black)]
       [x 100] [y 100]
       [dx 2.5] [dy 2]
       [classe mobile-rebondissant%]))

(big-bang LARGEUR HAUTEUR 0.01 (list make-raquette-ordinateur 
                                     make-raquette-joueur 
                                     make-balle-noire))

(on-tick-event jeu-suivant)
(on-redraw affiche-jeu)
(on-key-event gestion-clavier)