#lang racket/gui

;;EL ESPACIO CELULAR ES UNA MATRIZ CUADRADA DE 46 x 46.
;;CADA AUTÓMATA PROCESA SEGÚN LA TABLA DE LANGTON.
;;LAS RELACIONES DE VECINDAD SON LAS DE VON NEUMANN 
;;CON SISTEMETRÍA ROTACIONAL 4.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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 55); 0 to 4
(define columnas 55); 0 to 5
(define radio 5);10)

;(printf "Número de autómatas 250? ")
;(set! columnas (sub1 (read)))
(printf "Representación circular del autómata con radio 5? ")
(set! radio (read))

(require "Reglas-vecindad.rkt")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Automatas
(define automata-celular%
  (class object%
    (field
     (estado 0)
     (tabla '())
     )
    (define/public set-estado
      (lambda (valor)
        (set! estado valor) ))
    (define/public get-estado
      (lambda ()
        estado ))
    (define/public set-tabla
      (lambda (table)
        (set! tabla table) ))
    (define/public get-tabla
      (lambda ()
        tabla ))
    (define but-last
      (lambda (L)
        (take L (sub1 (length L)))))
    (define rotaciones
      (lambda (inputs)
        (let* ((t (first inputs))
               (r (second inputs))
               (b (third inputs))
               (l (fourth inputs))
               )
          (values
           (list t r b l)
           (list r b l t)
           (list b l t r)
           (list l t r b)
           )
          )
        ))
    
    (define/public procesar!
      (lambda (entrada)
        (letrec
            ((aux
              (lambda (inputs table)
                (if (null? table)
                    estado
                    (let*-values
                        ([(fila-tabla) (car table)]
                         [(fila-info) (but-last fila-tabla)]
                         [(N E S W) (rotaciones inputs)]
                         )
                      (cond
                        ((equal? fila-info (cons estado N)) (last fila-tabla))
                        ((equal? fila-info (cons estado W)) (last fila-tabla))
                        ((equal? fila-info (cons estado S)) (last fila-tabla))
                        ((equal? fila-info (cons estado E)) (last fila-tabla))
                        (else (aux inputs (cdr table)))
                        )
                      )
                    )
                ))
             )
          (set! estado (aux entrada tabla))
          estado
          ) ))
    (super-new) ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(require "Tabla-Langton-Loop.rkt")

(define la-tabla tabla-Langton-loop)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define red-celular%
  (class object%
    (init-field
     (ff 0)
     (cc 0)
     )
    (define haz-automata
      (lambda ()
        (let ((cell (make-object automata-celular%))
              )
          (send cell set-estado 0)
          (send cell set-tabla la-tabla)
          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 (sub1 ff))
           )
          (if (< j i)
              (set! configuracion (es-configuracion))
              (let columns
                ((m 0)
                 (n (sub1 cc))
                 )
                (if (< n m)
                    (rows i (sub1 j))
                    (let*-values
                        ([(v1 v2 v3 v4) (von-Neumann j n 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 j n vector-ref) 
                       procesar! todos)
                      (columns m (sub1 n))
                      )
                    )
                )
              )
          )
        ))
    (super-new)
    ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define red (make-object red-celular% (add1 filas) (add1 columnas)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; LAS FUNCIONES DE DIBUJO
;;; LAS HERRAMIENTAS GRÁFICAS
(define brocha-negra
  (make-object brush%
    "gray";"black"
    'solid))
(define brocha-azul
  (make-object brush%
    "blue"
    'solid))
(define brocha-roja
  (make-object brush%
    "red"
    'solid))
(define brocha-verde
  (make-object brush%
    "green"
    'solid))
(define brocha-amarilla
  (make-object brush%
    "yellow"
    'solid))
(define brocha-magenta
  (make-object brush%
    "magenta"
    'solid))
(define brocha-blanca
  (make-object brush%
    "white"
    'solid))
(define brocha-cyan
  (make-object brush%
    "cyan"
    'solid))
;;; La ventana
(define num-aut (* (add1 filas) (add1 columnas))) 
(define titulo
  (string-append 
   "Monitor del Langton's Loop auto-replicante ("
   (number->string num-aut)
   " autómatas)") )
(define ventana
  (make-object frame% 
    titulo 
    #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))
;;; PROCEDIMIENTOS DE DIBUJO
(define pinta-una-fila
  (lambda (output x y hoffset)
    (cond
      ((null? output) #t)
      ((= (car output) 0)
       (send dc set-brush brocha-negra)
       (send dc draw-ellipse x y radio radio)
       (pinta-una-fila (cdr output) (+ x hoffset) y hoffset))
      ((= (car output) 1)
       (send dc set-brush brocha-azul)
       (send dc draw-ellipse x y radio radio)
       (pinta-una-fila (cdr output) (+ x hoffset) y hoffset))
      ((= (car output) 2)
       (send dc set-brush brocha-roja)
       (send dc draw-ellipse x y radio radio)
       (pinta-una-fila (cdr output) (+ x hoffset) y hoffset))
      ((= (car output) 3)
       (send dc set-brush brocha-verde)
       (send dc draw-ellipse x y radio radio)
       (pinta-una-fila (cdr output) (+ x hoffset) y hoffset))
      ((= (car output) 4)
       (send dc set-brush brocha-amarilla)
       (send dc draw-ellipse x y radio radio)
       (pinta-una-fila (cdr output) (+ x hoffset) y hoffset))
      ((= (car output) 5)
       (send dc set-brush brocha-magenta)
       (send dc draw-ellipse x y radio radio)
       (pinta-una-fila (cdr output) (+ x hoffset) y hoffset))
      ((= (car output) 6)
       (send dc set-brush brocha-blanca)
       (send dc draw-ellipse x y radio radio)
       (pinta-una-fila (cdr output) (+ x hoffset) y hoffset))
      ((= (car output) 7)
       (send dc set-brush brocha-cyan)
       (send dc draw-ellipse x y radio radio)
       (pinta-una-fila (cdr output) (+ x hoffset) y hoffset))
      ) ))
(define pinta-configuracion
  (lambda (configuracion)
    (do
        ((voffset radio (+ voffset radio))
         (i 1 (add1 i))
         (config configuracion (cdr config))
         )
      ((null? config) #t)
      (pinta-una-fila
       (car config)
       4 voffset radio)
      )
    ))
(define dibujo
  (lambda (dc)
    (pinta-configuracion (send red get-configuracion))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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)
    (let go ((i 0)
             (j 1000)
             )
      (if (= i j)
          #t
          (begin
            (dibujo dc)
;            (pinta-configuracion (send red get-configuracion))
;            (if (= i 153) 
;                (begin (read-char) (printf "~a-->" i))
;                #t
;                )
;            (sleep/yield (/ 1 columnas)); 0.2)
            (send red procesar!)
            (go (add1 i) j)
            )
          )
      )
    ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define configuracion-inicial-langton
  (ubica-figura-ini
   (random (+ filas 2))
   (random (+ columnas 2))
;   (round (/ (add1 filas) 3)) 
;   (round (/ (add1 columnas) 3)) 
   Langton-loop-in))
(send red configuracion-inicial configuracion-inicial-langton)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(send ventana show #t)
(sleep/yield 1)
;(grid dc)

(driver dc)
