#lang racket/gui

;;; tortue-objet.rkt - La tortue avec la vraie couche-objet de Racket (exercice 14.5.3 page 338)
;;; Chapitre 14 (Objets et API graphique)
;;; Livre PCPS : "Premiers Cours de Programmation avec Scheme"
;;; Langage determine par le source

(require graphics/graphics)

(provide turtle% TURTLES repeat)   ; j'exporte une classe, une liste et une macro

(open-graphics)
(define SIZE 500)
(define SIZE/2 (quotient SIZE 2))
(define twin (open-viewport "Turtlegraphics" SIZE SIZE))
(define tr-segment (draw-line twin))
(define tr-pixel (draw-pixel twin))
(define pi/180 (/ pi 180))
(define 180/pi (/ 180 pi))

(define (turtlepoint->posn x y)
  (make-posn (+ SIZE/2 x) (- SIZE/2 y)))

(define (real-mod360 x)                     ; x réel modulo 360
  (- x (* 360 (floor (/ x 360.0)))))

(define-syntax repeat            ; la boucle (repeat n e1 e2 ...), avec n entier >= 0
  (syntax-rules ()
    ((repeat n e1 e2 ...) (let ()
                            (define (iter i)
                              (if (<= i 0) (void) (begin e1 e2 ... (iter (- i 1)))))
                            (iter n)))))

(define TURTLES '())     ; la liste globale de toutes les tortues, pour parler au peuple !

(define turtle%
  (class object%
    (init-field (XCOR 0) (YCOR 0) (CAP 0) (CRAYON? #t))
    (define/public (xcor)
      XCOR)
    (define/public (ycor)
      YCOR)
    (define/public (pos)
      (list XCOR YCOR))
    (define/public (cap)
      CAP)
    (define/public (fpos! x y)
      (when CRAYON? 
        (tr-segment (turtlepoint->posn XCOR YCOR) (turtlepoint->posn x y)))
      (set! XCOR x)
      (set! YCOR y))
    (define/public (fcap! a)
      (set! CAP (real-mod360 a)))
    (define/public (av d)
      (let ((a (* CAP pi/180)))
        (fpos! (+ XCOR (* d (sin a)))
               (+ YCOR (* d (cos a))))))
    (define/public (re d)
      (send this av (- d)))     ; <==> (av (- d))
    (define/public (ga a)
      (fcap! (- CAP a)))        ; <==> (send this fcap! (- cap a))
    (define/public (dr a)
      (fcap! (+ CAP a)))
    (define/public (point)
      (tr-pixel (turtlepoint->posn XCOR YCOR)))
    (define/public (lc)
      (set! CRAYON? #f))
    (define/public (bc)
      (set! CRAYON? #t))
    (define/public (init x y a . clear?)   ; (init pos cap #f) pour ne pas effacer la fenêtre
      (when (or (null? clear?) (equal? #t (car clear?)))
        ((clear-viewport twin)))
      (lc)
      (fpos! x y)
      (fcap! a)
      (bc))
    (define/public (toward L)    ; force la tortue a regarder vers le point L = (x y)
      (let ((x (car L)) (y (cadr L)))
        (let ((dx (- XCOR x)) (dy (- YCOR y)) (angle '?))
          (if (= dx 0) 
              (set! angle (if (> dy 0) -90 90))
              (set! angle (* (atan (/ dy dx)) 180/pi)))
          (set! angle (- angle))
          (when (> dx 0) (set! angle (+ angle 180)))  ; atant defini entre 0 et 180
          (fcap! (+ angle 90)))))
    (super-new)
    (set! TURTLES (cons this TURTLES))))

;;; ==========================================
;;; Ce qui suit n'est pas exporte du module et illustre une poursuite entre 4 tortues...

(require "while-for.rkt")

(define (distance t1 t2)   ; distance entre deux tortues
  (+ (abs (- (send t1 xcor) (send t2 xcor)))
     (abs (- (send t1 ycor) (send t2 ycor)))))

(define (wait n)    ; ne rien faire pendant n millisecondes
  (let ((start (current-milliseconds)))
    (while (< (- (current-milliseconds) start) n)
           (void))))

(define (poursuite)
  (let ((VT (build-vector 4 (lambda (i) (new turtle%)))))   ; le vecteur des 4 tortues
    (define (tortue i) 
      (vector-ref VT i))
    (send (tortue 0) init -250 250 90 #f)
    (send (tortue 1) init 250 250 180 #f)
    (send (tortue 2) init 250 -250 -90 #f)
    (send (tortue 3) init -250 -250 0 #f)
    (while (> (distance (tortue 0) (tortue 1)) 4)
           (for i from 0 to 3
             (let ((ti (tortue (modulo i 4))) (ti+1 (tortue (modulo (+ i 1) 4))))
               (send ti toward (send ti+1 pos))
               (send ti av 1)
               (wait 2))))))    ; pour ralentir les tortues...

;(poursuite)