#lang racket/gui

;;EL ESPACIO CELULAR ES UNA MATRIZ CUADRADA DE 46 x 46.
;;CADA AUTÓMATA PROCESA SEGÚN LAS REGLAS DE CONWAY.
;;LAS RELACIONES DE VECINDAD SON LAS DE MOORE.

;;;Matrices
(require "Matrices.rkt")

;;;Vecindad
;; Ver fichero: Reglas-vecindad.rkt
(define filas 59); 0 to 17
(define columnas 59);45); 0 to 17

(define radio 8)

(printf "Número de filas ~a? " (add1 filas))
(set! filas (sub1 (read)))
(set! columnas filas)
(printf "Representación del autómata con radio ~a? " radio)
(set! radio (read))
(read-char)

(require "Reglas-vecindad.rkt")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Automatas
(define automata-celular%
  (class object%
    (field
     (estado 0)
     )
    (define/public set-estado
      (lambda (valor)
        (set! estado valor) ))
    (define/public get-estado
      (lambda ()
        estado ))
    (define cuantos-hay-de?
      (lambda (color vecinos)
        (let go ((v vecinos) 
                 (x-de-color 0)
                 )
          (if (null? v)
              x-de-color
              (if (= (car v) color)
                  (go (cdr v) (add1 x-de-color))
                  (go (cdr v) x-de-color)
                  )
              )
          )
        ))
    (define/public procesar!
      (lambda (inputs)
        (let ((son-rojos (cuantos-hay-de? 1 inputs))
              (son-azules (cuantos-hay-de? 2 inputs))
              (son-verdes (cuantos-hay-de? 3 inputs))
              )
          (set! 
           estado
           (cond
             ;;reglas del rojo
             ((and (= estado 0) (= son-rojos 3)); nace rojo 
              1)
             ((and (= estado 1) (= son-rojos 2)); supervive 
              1)
             ((and (= estado 1) (= son-rojos 3)); supervive
              1)
             ((and (= estado 1) (= son-rojos 4));se transforma
              2)
             ;;reglas del azul
             ((and (= estado 0) (= son-azules 3)); nace azul 
              2)
             ((and (= estado 2) (= son-azules 2)); supervive 
              2)
             ((and (= estado 2) (= son-azules 3)); supervive
              2)
             ((and (= estado 2) (= son-azules 4));se transforma
              3)
             ;;reglas del verde
             ((and (= estado 0) (= son-verdes 3)); nace verde 
              3)
             ((and (= estado 3) (= son-verdes 2)); supervive 
              3)
             ((and (= estado 3) (= son-verdes 3)); supervive
              3)
             ((and (= estado 3) (= son-verdes 4));se transforma
              1)
             (else 0); muere
             ) 
           )
          )
        ))
    (super-new) ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define red-celular%
  (class object%
    (init-field
     (ff 0)
     (cc 0)
     )
    (define haz-automata
      (lambda ()
        (let ((cell (make-object automata-celular%))
              (valor-e (random 4));blanco, rojo, azule o verde
              )
          (send cell set-estado valor-e)
          cell
          )
        ))
    (define set-matriz-automatas
      (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 (haz-automata))
                      (columnas (add1 m) n))
                    )
                )
              )
          )
        ))
    (define es-configuracion
      (lambda ()
        (map
         (lambda (fila)
           (map
            (lambda (obj)
              (send obj get-estado)
              )
            (vector->list fila))
           )
         (vector->list matriz-automatas)
         )
        ))
    (field
     (matriz-automatas
      (set-matriz-automatas
       (make-matriz ff cc)) )
     (configuracion (es-configuracion))
     )    
    (define/public get-matriz
      (lambda ()
        matriz-automatas ))
    (define/public get-configuracion
      (lambda ()
        configuracion ))
    (define/public procesar!
      (lambda ()
        (let rows
          ((i 0)
           (j filas)
           )
          (if (= i j)
              (set! configuracion (es-configuracion))
              (let columns
                ((m 0)
                 (n columnas)
                 )
                (if (= m n)
                    (rows (add1 i) j)
                    (let*-values
                        ([(v1 v2 v3 v4 v5 v6 v7 v8) (Moore i m filas columnas)]
                         [(estado-v1)
                          (matriz-ref 
                           configuracion (car v1) (cdr v1) list-ref)]
                         [(estado-v2)
                          (matriz-ref 
                           configuracion (car v2) (cdr v2) list-ref)]
                         [(estado-v3)
                          (matriz-ref 
                           configuracion (car v3) (cdr v3) list-ref)]
                         [(estado-v4)
                          (matriz-ref 
                           configuracion (car v4) (cdr v4) list-ref)]
                         [(estado-v5)
                          (matriz-ref 
                           configuracion (car v5) (cdr v5) list-ref)]
                         [(estado-v6)
                          (matriz-ref 
                           configuracion (car v6) (cdr v6) list-ref)]
                         [(estado-v7)
                          (matriz-ref 
                           configuracion (car v7) (cdr v7) list-ref)]
                         [(estado-v8)
                          (matriz-ref 
                           configuracion (car v8) (cdr v8) list-ref)]
                         [(todos)
                          (list estado-v1 estado-v2 estado-v3 estado-v4
                                estado-v5 estado-v6 estado-v7 estado-v8)]
                         )
                      (send 
                       (matriz-ref matriz-automatas i m vector-ref) 
                       procesar! todos)
                      (columns (add1 m) n)
                      )
                    )
                )
              )
          )
        ))
    (super-new)
    ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define red (make-object red-celular% (add1 filas) (add1 columnas)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; LAS FUNCIONES DE DIBUJO
;;; LAS HERRAMIENTAS GRÁFICAS
(define pen-0
  (make-object pen%
    "ghostwhite"
    radio
    'solid))
(define pen-1
  (make-object pen%
    "red"
    radio
    'solid))
(define pen-2
  (make-object pen%
    "blue"
    radio
    'solid))
(define pen-3
  (make-object pen%
    "green"
    radio
    'solid))
;;; PROCEDIMIENTOS DE DIBUJO
(define pinta-una-fila
  (lambda (output x y hoffset)
    (cond
      ((null? output) )
      ((= (car output) 1)
       (send dc set-pen pen-1)
       (send dc draw-point x y)
       (pinta-una-fila (cdr output) (+ x hoffset) y hoffset))
      ((= (car output) 2)
       (send dc set-pen pen-2)
       (send dc draw-point x y)
       (pinta-una-fila (cdr output) (+ x hoffset) y hoffset))
      ((= (car output) 3)
       (send dc set-pen pen-3)
       (send dc draw-point x y)
       (pinta-una-fila (cdr output) (+ x hoffset) y hoffset))
      (else
       (send dc set-pen pen-0)
       (send dc draw-point x y)
       (pinta-una-fila (cdr output) (+ x hoffset) y hoffset))
      ) ))
(define pinta-configuracion
  (lambda (configuracion)
    (do
        ((voffset 0 (+ voffset 1)) 
         (config configuracion (cdr config))
         )
      ((null? config) #t)
      (pinta-una-fila (car config) 0 (* voffset 10) 10)
      )
    ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define dibujo
  (lambda (dc)
    (pinta-configuracion (send red get-configuracion))))
;;; La ventana
(define ventana
  (make-object frame% 
    "Monitor del Brian's Brain" 
    #f 
    (+ 10 (* radio (add1 columnas))) (* radio (+ 10 filas))
    1200 0))
;;; El lienzo
(define lienzo
  (instantiate canvas%
    (ventana)
    (style '(border))
    (paint-callback
     (lambda (lienzo dc) (dibujo dc)))
    ))
(define dc (send lienzo get-dc))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define driver
  (lambda (dc)
    (pinta-configuracion (send red get-configuracion))
    (read-char)
    (let go ((i 0)
             (j 500))
      (if (= i j)
          #t
          (begin
            (send red procesar!)
            (dibujo dc)
            (printf "~a->" i)            
            (sleep/yield (/ 1 columnas)); 0.2)
            (go (add1 i) j)
            )
          )
      )
    ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(send ventana show #t)
(sleep/yield 1)

(driver dc)
