#lang racket/gui

;;EL ESPACIO CELULAR ES UNA MATRIZ CUADRADA DE 46 x 46.
;;CADA AUTÓMATA PROCESA SEGÚN LAS REGLAS DE EDWARD FREDKIN (1960).
;;LAS RELACIONES DE VECINDAD SON LAS DE VON NEUMANN.
(define prueba
  (list
   (list 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
   (list 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
   (list 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
   (list 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
   (list 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0)
   (list 0 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 0 0 0)
   (list 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0)
   (list 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
   (list 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
   (list 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
   (list 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
   (list 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
   ))
(define oscilador
  (list
   (list 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0)
   (list 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0)
   (list 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
   (list 0 0 0 0 0 0 0 0 0 0 1 1 1 1 0 0 0 0 0 0)
   (list 0 0 0 0 0 0 0 0 0 1 0 0 0 0 1 0 1 1 0 0)
   (list 0 0 0 0 0 0 0 0 0 1 0 0 1 0 1 0 1 1 0 0)
   (list 0 0 0 0 0 0 1 1 0 1 0 0 1 0 1 0 0 0 0 0)
   (list 0 0 0 0 0 0 1 1 0 1 0 1 0 0 1 0 0 0 0 0)
   (list 0 0 0 0 0 0 0 0 0 0 1 1 1 1 0 0 0 0 0 0)
   (list 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
   (list 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0)
   (list 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0)
   ))

(define glider
  (list
   (list 0 1 0)
   (list 0 0 1)
   (list 1 1 1)
   ))

(define xor-ini
  (list
   (list 0 0 1 0 0 0 0 0 1 0 0)
   (list 0 0 0 1 0 0 0 1 0 0 0)
   (list 0 0 1 1 1 1 1 1 1 0 0)
   (list 0 1 1 0 1 1 1 0 1 1 0)
   (list 1 1 1 1 1 1 1 1 1 1 1)
   (list 1 0 1 1 1 1 1 1 1 0 1)
   (list 1 0 1 0 0 0 0 0 1 0 1)
   (list 0 0 0 1 1 0 1 1 0 0 0)))

(define aux-ubica-figura-ini
  (lambda (c fig)
    (if (null? fig)
        '()
        (cons
         (let go ((m 0)
                  (n (add1 columnas))
                  (row '())
                  )
           (if (= m n)
               row
               (if (= m c)
                   (go (+ m (length (car fig))) n (append row (car fig)))
                   (go (add1 m) n (append row (list 0)))
                   )
               )
             )
         (aux-ubica-figura-ini c (cdr fig))
         )
        )
    ))

(define ubica-figura-ini
  (lambda (f c fig)
    (let go ((i 0)
             (j (add1 filas))
             (salida '())
             )
      (if (= i j)
          salida
          (if (= i f)
              (go 
               (+ i (length fig)) j 
               (append salida (aux-ubica-figura-ini c fig)))
              (let salta ((m 0)
                          (n (add1 columnas))
                          (row '())
                          )
                (if (= m n)
                    (go (add1 i) j (append salida (list row)))
                    (salta (add1 m) n (append row (list 0)))
                    )
                )
              )
          )
      )
    ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Matrices
(require "Matrices.rkt")

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

(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/public procesar!
      (lambda (inputs)
        (let* ((inputs+estado (cons estado inputs))
               (suma_inputs (apply + inputs+estado))
               )
          (set! 
           estado
           (cond
             ((even? suma_inputs) 0)
             ((odd? suma_inputs) 1)
             ) 
           )
          )
        ))
    (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 2))
              )
          (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)
         )
        ))
    (define/public configuracion-inicial
      (lambda (conf)
        (let go ((i 0)
                 (j ff)
                 )
          (if (= i j)
              (set! configuracion (es-configuracion))
              (let salta ((m 0)
                          (n cc)
                          )
                (if (= m n)
                    (go (add1 i) j)
                    (begin
                      (send
                       (matriz-ref matriz-automatas i m vector-ref)
                       set-estado
                       (matriz-ref conf i m list-ref)
                       )
                      (salta (add1 m) n)
                      )
                    )
                )
              )
          )
        ))
    (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) (von-Neumann 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)]
                         [(todos)
                          (list estado-v1 estado-v2 estado-v3 estado-v4)]
                         )
                      (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 brocha-roja
  (make-object brush%
    "red"
    'solid))
(define brocha-blanca
  (make-object brush%
    "white"
    'solid))
;;; La ventana
(define ventana
  (make-object frame% 
    "Monitor de autómata replicante ¿trivial?" 
    #f 
    (+ 10 (* 10 (add1 columnas))) (+ 30 (* 10 (add1 filas)))
    1200 0))
;;; El lienzo
(define lienzo
  (instantiate canvas%
    (ventana)
    (style '(border))
    ))
(define dc (send lienzo get-dc))
;;; PROCEDIMIENTOS DE DIBUJO
(define pinta-una-fila
  (lambda (output x y hoffset)
    (cond
      ((null? output) )
      ((= (car output) 1)
       (send dc set-brush brocha-roja)
       (send dc draw-ellipse x y 10 10); x y x y);
       (pinta-una-fila (cdr output) (+ x hoffset) y hoffset))
      (else
       (send dc set-brush brocha-blanca)
       (send dc draw-ellipse x y 10 10);x y 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 grid
  (lambda (dc)
    (let* ((lapiz0 (send dc get-pen))
           (lapiz1 (make-object pen% "black" 4 'solid))
           (x1 (/ (* 10 (add1 columnas)) 2))
           (y1 (* 10 (add1 filas)))
           (x2 (* 10 (add1 columnas)))
           (y2 (/ (* 10 (add1 filas)) 2))
           )
      (send dc draw-line x1 0 x1 y1)
      (send dc draw-line 0 y2 x2 y2)
      )
    ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define driver
  (lambda (dc jj)
    (let go ((i 0)
             (j jj))
      (if (= i j)
          (printf "~nIteraciones: ~a~n" (sub1 i))
          (begin
            (pinta-configuracion (send red get-configuracion))
            (printf "~a-->" (add1 i))
            (if (or (= i 0) (= i 16) (and (> i 23) (< i 30)) (= i 64) (= i 80))
                (read-char)
                #t
                )
            (send red procesar!)
            (sleep/yield (/ 1 columnas)); 0.2)
            (go (add1 i) j)
            )
          )
      )
    ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define configuracion-inicial-prueba
  (ubica-figura-ini 26 21 prueba))
(define configuracion-inicial-clock
  (ubica-figura-ini 19 13 oscilador))
(define configuracion-inicial-glider
  (ubica-figura-ini 23 24 glider))
(define configuracion-inicial-xor
  (ubica-figura-ini 25 25 xor-ini))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(send ventana show #t)
(sleep/yield 1)
(grid dc)

(send red configuracion-inicial configuracion-inicial-prueba)
(driver dc 30)
(read-char)


;(send red configuracion-inicial configuracion-inicial-clock)
;(driver dc)
;(sleep/yield 2)
;
;(send red configuracion-inicial configuracion-inicial-glider)
;(driver dc)
;(sleep/yield 2)

(send red configuracion-inicial configuracion-inicial-xor)
(driver dc 81)
