#lang racket/gui

(require "Matrices.rkt")
(require "Reglas-vecindad.rkt")
(require "Animat.rkt")
;;;;;;;;;;;;;;
(define elemento%
  (class color%
    (init-field
     (estado 0)
     (dureza 0)
     (olor 'objeto_tipo_olor)
     )
    (define/public set-olor
      (lambda (obj)
        (set! olor obj)
        ))
    (define/public get-olor
      (lambda ()
        olor
        ))
    (define/public get-rgb
      (lambda ()
        (let ((r (send this red))
              (g (send this green))
              (b (send this blue))
              (o (send this alpha))
              )
          (list r g b o)
          )
        ))
    (define/public get-color
      (lambda ()
        this ))
    (define/public get-estado
      (lambda ()
        estado ))
    (define/public get-dureza
      (lambda ()
        dureza ))
    (define cuantos-hay-de?
      (lambda (e objetos)
        (if (null? objetos)
            0
            (if (= (send (car objetos) get-estado) e)
                (+ 1 (cuantos-hay-de? e (cdr objetos)))
                (cuantos-hay-de? e (cdr objetos))
                )
            )
        ))
    (define/public proceso!
      (lambda (obj lista-obj-vecinos)
        (let ((verdes (cuantos-hay-de? 2 lista-obj-vecinos))
              (azules (cuantos-hay-de? 3 lista-obj-vecinos))
              (negros (cuantos-hay-de? 4 lista-obj-vecinos))
              (resp #f)
              )
          (set! resp
                (cond
                  ((= estado 1) obj)
                  ((and (= estado 0) (= verdes 3)) verde)
                  ((and (= estado 0) (= azules 4)) azul)
                  ((and (= estado 0) (= negros 4)) negro)
                  ((and (= estado 2) (> verdes 3)) blanco)
                  ((and (= estado 3) (> azules 4)) blanco)
                  ((and (= estado 4) (> negros 4)) blanco)
                  (else obj)
                  ))
          resp
          )
        ))
    (super-new)
    ))
;;Objetos del tipo OLOR
(define olor%
  (class object%
    (init-field
     (tipo 0)
     (intensidad 0)
     )
    (define/public get-olor
      (lambda ()
        (cons tipo intensidad) ))
    (define/public get-intensidad
      (lambda ()
        intensidad ))
    (define/public update-intensidad
      (lambda (valor);entero positivo o -1
        (set! intensidad
              (+ intensidad valor))
        ))
    (super-new)
    ))
;;;;;;;;;;;;
(define olor0;inodora
  (make-object olor% 0 0))
(define olor1;feromonas
  (make-object olor% 1 30))
(define olor2;comida
  (make-object olor% 2 10))
(define olor3;
  (make-object olor% 3 10))
;;Estado dureza olor R   G   B   O
(define blanco
  (make-object elemento% 0 0 olor0 255 255 255 1.0))
(define rojo
  (make-object elemento% 1 5 olor0 255 0 0 1.0))
(define verde
  (make-object elemento% 2 2 olor2 0 255 0 1.0))
(define azul
  (make-object elemento% 3 7 olor0 0 0 255 1.0))
(define negro
  (make-object elemento% 4 10 olor0 0 0 0 1.0))
;;;;;;;;;;;;;;
(define entorno%
  (class object%
    (init-field
     (ff 0)
     (cc 0)
     )
    (define set-matriz
      (lambda (matriz)
        (let rows ((i 0)
                   (j ff))
          (if (= i j)
              matriz
              (let columnas ((m 0)
                             (n cc))
                (if (= m n)
                    (rows (add1 i) j)
                    (begin
                      (matriz-set! matriz i m blanco)
                      (columnas (add1 m) n))
                    )
                )
              )
          )
        ))
    (define/public set-configuracion
      (lambda ()
        (set! configuracion (es-configuracion))
        ))
    (define es-configuracion
      (lambda ()
        (map
         (lambda (fila)
           (map
            (lambda (obj)
              obj;
              )
            (vector->list fila))
           )
         (vector->list matriz-objetos)
         )
        ))
    (define/public set-locus!
      (lambda (f c obj)
        (matriz-set! matriz-objetos f c obj)
        #t
        ))
    (field
     (matriz-objetos
      (set-matriz
       (make-matriz ff cc)))
     (configuracion (es-configuracion))
     )
    (define/public get-matriz
      (lambda ()
         matriz-objetos ))
    (define/public get-dimensiones
      (lambda ()
        (cons ff cc) ))
    (define/public get-obj
      (lambda (x y)
        (matriz-ref matriz-objetos x y vector-ref)
        ))
    (define/public get-configuracion
      (lambda ()
        (es-configuracion) ))
    (define son-estimulos
      (lambda (e1 e2 e3 e4 e5 e6 e7 e8 orientacion)
        (cond
          ((eq? orientacion 'N) (values e1 e2 e3))
          ((eq? orientacion 'E) (values e3 e4 e5))
          ((eq? orientacion 'S) (values e5 e6 e7))
          ((eq? orientacion 'O) (values e7 e8 e1))
          )
        ))
    (define to_empujar
      (lambda (x y orientacion)
        (let-values ([(xx yy)
                      (cond
                        ((eq? orientacion 'N) (values (sub1 x)  y))
                        ((eq? orientacion 'E) (values x (add1 y)))
                        ((eq? orientacion 'S) (values (add1 x) y))
                        ((eq? orientacion 'O) (values x (sub1 y)))
                        )]
                     )
          (set! xx
                (cond
                  ((> xx (sub1 ff)) 0)
                  ((< xx 0) (sub1 ff))
                  (else xx)
                  ))
          (set! yy
                (cond
                  ((> yy (sub1 cc)) 0)
                  ((< yy 0) (sub1 cc))
                  (else yy)
                  ))
          (cons xx yy)
          )
        ))
    (define ley-basica
      (lambda (vec anim clave)
        (let* ((vec_obj (matriz-ref matriz-objetos (car vec) (cdr vec) vector-ref))
               (rgb_vec (send vec_obj get-rgb))
               )
          (cond
            ((eq? clave 'avanzar) (equal? rgb_vec (send blanco get-rgb)))
            ((eq? clave 'comer) (equal? rgb_vec (send verde get-rgb)))
            (else #f)
            )
          )
        ))
    (define ley-resistencia
      (lambda (vec anim clave)
        (let* ((coord_next (to_empujar (car vec) (cdr vec) anim))
               (x_next (car coord_next))
               (y_next (cdr coord_next))
               (next_obj (matriz-ref matriz-objetos x_next y_next vector-ref))
               (resistencia_obj (send next_obj get-resistencia))
               )
          (cond
            ((eq? clave 'empujar) (equal? resistencia_obj (send blanco get-resistencia)))
            (else #f)
            )
          )
        ))
    (define nace
      (lambda (list-obj obj obj-tipo)
        (let ((total
               (apply +
                      (map
                       (lambda (ob)
                         (if (equal? (send ob get-rgb) (send obj-tipo get-rgb))
                             1
                             0)
                         )
                       list-obj)) )
              )
          (if (= total 3)
              obj-tipo
              obj)
          )
        ))
    (define muere
      (lambda (list-obj obj obj-tipo)
        (let ((total
               (apply +
                      (map
                       (lambda (ob)
                         (if (equal? (send ob get-rgb) (send obj-tipo get-rgb))
                             1
                             0)
                         )
                       list-obj)) )
              )
          (if (> total 3);(or (> total 3) (< total 2))
              blanco
              obj)
          )
        ))
    (define ley
      (lambda (list-obj obj obj-tipo)
        (cond
          ((equal? (send obj get-rgb) (send blanco get-rgb)) 
           (nace list-obj obj obj-tipo) )
          ((equal? (send obj get-rgb) (send obj-tipo get-rgb)) 
           (muere list-obj obj obj-tipo) )
          (else obj)
          ) 
        ))
    (define cambio!;diacronía
      (lambda (obj-tipo)
        (printf "Cambio en el entorno~n")
        (let rows
          ((i 0)
           (j ff)
           )
          (if (= i j)
              (set! configuracion (es-configuracion))
              (let columns
                ((m 0)
                 (n cc)
                 )
                (if (= m n)
                    (rows (add1 i) j)
                    (let ((Obj (matriz-ref matriz-objetos i m vector-ref)))
                      (if (is-a? Obj animat%)
                          (columns (add1 m) n)
                          (let*-values ([(Obj) (matriz-ref matriz-objetos i m vector-ref)]
                                        [(v1 v2 v3 v4 v5 v6 v7 v8) (Moore i m (sub1 ff) (sub1 cc))]
                                        [(obj-v1)
                                         (matriz-ref 
                                          matriz-objetos (car v1) (cdr v1) vector-ref)]
                                        [(obj-v2)
                                         (matriz-ref 
                                          matriz-objetos (car v2) (cdr v2) vector-ref)]
                                        [(obj-v3)
                                         (matriz-ref 
                                          matriz-objetos (car v3) (cdr v3) vector-ref)]
                                        [(obj-v4)
                                         (matriz-ref 
                                          matriz-objetos (car v4) (cdr v4) vector-ref)]
                                        [(obj-v5)
                                         (matriz-ref 
                                          matriz-objetos (car v5) (cdr v5) vector-ref)]
                                        [(obj-v6)
                                         (matriz-ref 
                                          matriz-objetos (car v6) (cdr v6) vector-ref)]
                                        [(obj-v7)
                                         (matriz-ref 
                                          matriz-objetos (car v7) (cdr v7) vector-ref)]
                                        [(obj-v8)
                                         (matriz-ref 
                                          matriz-objetos (car v8) (cdr v8) vector-ref)]
                                        [(new-obj) 
                                         (ley (list obj-v1 obj-v2 obj-v3 obj-v4 obj-v5 obj-v6 obj-v7 obj-v8) Obj obj-tipo)]
                                         
                                        )
                            (matriz-set! matriz-objetos i m new-obj)
                            (columns (add1 m) n)
                            )
                          )
                      )
                    )
                )
              )
          )
        ))
    (define multiplo-de?
      (lambda (x y)
        (and
         (> (quotient x y) 0)
         (= (remainder x y) 0))
        ))
    (define/public procesar!
      (lambda (iter)
        (when (multiplo-de? iter 100);(multiplo-de? iter 50)
          (cambio! verde)
          (cambio! azul)
          (cambio! negro))
        (set! configuracion (es-configuracion))
        (let rows
          ((i 0)
           (j ff)
           )
          (if (= i j)
              (set! configuracion (es-configuracion))
              (let columns
                ((m 0)
                 (n cc)
                 )
                (if (= m n)
                    (rows (add1 i) j)
                    (let ((Obj (matriz-ref configuracion i m list-ref))
                          )
                      (cond
                        ((is-a? Obj animat%)
                         (printf "~nIteración-~a  " iter)
                         (let*-values
                             ([(p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12 p13 p14 p15 p16)
                               (Moore2 i m (sub1 ff) (sub1 cc))]
                              [(obj-p1)
                               (matriz-ref 
                                configuracion (car p1) (cdr p1) list-ref)]
                              [(obj-p2)
                               (matriz-ref 
                                configuracion (car p2) (cdr p2) list-ref)]
                              [(obj-p3)
                               (matriz-ref 
                                configuracion (car p3) (cdr p3) list-ref)]
                              [(obj-p4)
                               (matriz-ref 
                                configuracion (car p4) (cdr p4) list-ref)]
                              [(obj-p5)
                               (matriz-ref 
                                configuracion (car p5) (cdr p5) list-ref)]
                              [(obj-p6)
                               (matriz-ref 
                                configuracion (car p6) (cdr p6) list-ref)]
                              [(obj-p7)
                               (matriz-ref 
                                configuracion (car p7) (cdr p7) list-ref)]
                              [(obj-p8)
                               (matriz-ref 
                                configuracion (car p8) (cdr p8) list-ref)]
                              [(obj-p9)
                               (matriz-ref 
                                configuracion (car p9) (cdr p9) list-ref)]
                              [(obj-p10)
                               (matriz-ref 
                                configuracion (car p10) (cdr p10) list-ref)]
                              [(obj-p11)
                               (matriz-ref 
                                configuracion (car p11) (cdr p11) list-ref)]
                              [(obj-p12)
                               (matriz-ref 
                                configuracion (car p12) (cdr p12) list-ref)]
                              [(obj-p13)
                               (matriz-ref 
                                configuracion (car p13) (cdr p13) list-ref)]
                              [(obj-p14)
                               (matriz-ref 
                                configuracion (car p14) (cdr p14) list-ref)]
                              [(obj-p15)
                               (matriz-ref 
                                configuracion (car p15) (cdr p15) list-ref)]
                              [(obj-p16)
                               (matriz-ref 
                                configuracion (car p16) (cdr p16) list-ref)]
                              [(v1 v2 v3 v4 v5 v6 v7 v8) (Moore i m (sub1 ff) (sub1 cc))]
                              [(obj-v1)
                               (matriz-ref 
                                configuracion (car v1) (cdr v1) list-ref)]
                              [(obj-v2)
                               (matriz-ref 
                                configuracion (car v2) (cdr v2) list-ref)]
                              [(obj-v3)
                               (matriz-ref 
                                configuracion (car v3) (cdr v3) list-ref)]
                              [(obj-v4)
                               (matriz-ref 
                                configuracion (car v4) (cdr v4) list-ref)]
                              [(obj-v5)
                               (matriz-ref 
                                configuracion (car v5) (cdr v5) list-ref)]
                              [(obj-v6)
                               (matriz-ref 
                                configuracion (car v6) (cdr v6) list-ref)]
                              [(obj-v7)
                               (matriz-ref 
                                configuracion (car v7) (cdr v7) list-ref)]
                              [(obj-v8)
                               (matriz-ref 
                                configuracion (car v8) (cdr v8) list-ref)]
                              [(vecinos-coord) (list v1 v2 v3 v4 v5 v6 v7 v8)]
                              [(vecinos-obj) (list obj-v1 obj-v2 obj-v3 obj-v4 obj-v5 obj-v6 obj-v7 obj-v8)]
                              [(horiz-coord) (list p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12 p13 p14 p15 p16)]
                              [(horiz-obj) (list obj-p1 obj-p2 obj-p3 obj-p4 obj-p5 obj-p6 obj-p7 obj-p8 obj-p9 obj-p10 obj-p11 obj-p12 obj-p13 obj-p14 obj-p15 obj-p16)]
                              [(accion vec anim)
                               (send Obj procesar! i m vecinos-coord vecinos-obj horiz-coord horiz-obj)]
                              )
                           (cond
                             ((eq? accion 'avanzar)
                              (when (ley-basica vec anim accion)
                                (let
                                    ((vec_obj (matriz-ref matriz-objetos (car vec) (cdr vec) vector-ref)) )
                                  (matriz-set! matriz-objetos (car vec) (cdr vec) Obj)
                                  (matriz-set! matriz-objetos i m vec_obj)
                                  )) )
                             ((eq? accion 'comer)
                              (when (ley-basica vec anim accion)
                                (matriz-set! matriz-objetos (car vec) (cdr vec) blanco)) )
                             ((eq? accion 'empujar)
                              (when (ley-resistencia vec anim accion)
                                (let* ((obj (matriz-ref matriz-objetos (car vec) (cdr vec) vector-ref))
                                       (coord_next (to_empujar (car vec) (cdr vec) anim))
                                       (x_next (car coord_next))
                                       (y_next (cdr coord_next))
                                       (next_obj (matriz-ref matriz-objetos x_next y_next vector-ref))
                                       (resistencia_obj (send next_obj get-resistencia))
                                       )
                                  (matriz-set! matriz-objetos x_next y_next obj)
                                  (matriz-set! matriz-objetos (car vec) (cdr vec) blanco)
                                  )
                                ) )
                             ((eq? accion 'girar) )
                             )
                            (rows j j)
                           ) )
                        (else (columns (add1 m) n))
                        )
                      )
                    )
                )
              )
          )
        ))
    (super-new)
    ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define M (make-object entorno% 50 50))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define ubica-objetos
  (lambda (dimensiones)
    (let rows ((i 0)
             (j (car dimensiones))
             )
      (if (>= i j)
          #t
          (let columns
            ((m 0)
             (n (cdr dimensiones))
             )
            (if (>= m n)
                (rows (+ 1 i) j)
                (let ((x (random 20)))
                  (cond
                    ((= x 0) (send M set-locus! i m verde))
                    ((= x 1) (send M set-locus! i m azul))
                    ((= x 2) (send M set-locus! i m blanco))
                    ((= x 3) (send M set-locus! i m negro))
                    (else (send M set-locus! i m blanco))
                    )
                  (columns (+ 1 m) n)
                  )
                )
            )
          )
      )
    ))
(define blancos-en
  (lambda (matriz dimensiones)
    (let rows
      ((i 0)
       (j (car dimensiones))
       (salida '())
       )
      (if (= i j)
          salida
          (let columns
            ((m 0)
             (n (cdr dimensiones))
             )
            (if (= m n)
                (rows (add1 i) j salida)
                (if (equal? (list 255 255 255 1.0)
                            (send
                             (send M get-obj i m)
                             get-rgb))
                    (begin
                      (set! salida (cons (cons i m) salida))
                      (columns (add1 m) n)
                      )
                    (columns (add1 m) n))
                )
            )
          )
      )
    ))
(define ubica-animat
  (lambda (animat)
    (let* 
        ((hay-blancos
          (blancos-en (send M get-matriz) (send M get-dimensiones)))
         (azar (random (length hay-blancos)))
         (locus (list-ref hay-blancos azar))
         )
      (send M set-locus! (car locus) (cdr locus) animat)
      )
    ))
(ubica-objetos (send M get-dimensiones))

(ubica-animat A1)
;(ubica-animat A2)
                
(provide M)
