#lang racket/gui
(require graphics/turtles)

;;Órdenes LOGO
(define forward draw)
(define fd draw)

(define back (lambda (n) (draw (- n))))
(define bk back)

(define left turn)
(define lt turn)

(define right (lambda (gr) (turn (- gr))))
(define rt right)

(define clearscreen clear)
(define cs clear)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;Interpretación à la LOGO
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define retrocede
  (lambda (lista step ang)
;    (printf "~a~n" lista)
;    (sleep/yield 0.001)
    (let go ((i 0)
             (j (length lista))
             )
      (if (= i j)
          #t
          (cond
            ((char=? (list-ref lista i) #\F) (move (- step)) (go (add1 i) j))
            ((char=? (list-ref lista i) #\S) (move (- step)) (go (add1 i) j))
            ((char=? (list-ref lista i) #\+) (rt ang) (go (add1 i) j))
            ((char=? (list-ref lista i) #\-) (lt ang) (go (add1 i) j))
            (else #t)
            )
          )
      )
    ))
(define con-corchetes
  (lambda (lista step ang)
    (let go ((i 0)
             (j (length lista))
             (moves #f)
             (pila '())
             )
      (if (= i j)
          #t
          (cond
            ((char=? (list-ref lista i) #\F) 
             (fd step)
             (if moves
                 (go (add1 i) j (cons #\F moves) pila)
                 (go (add1 i) j moves pila))
             )
            ((char=? (list-ref lista i) #\S) 
             (fd step)
             (if moves
                 (go (add1 i) j (cons #\S moves) pila)
                 (go (add1 i) j moves pila))
             )
            ((char=? (list-ref lista i) #\+) 
             (lt ang)
             (if moves
                 (go (add1 i) j (cons #\+ moves) pila)
                 (go (add1 i) j moves pila))
             )
            ((char=? (list-ref lista i) #\-)
             (rt ang)
             (if moves
                 (go (add1 i) j (cons #\- moves) pila)
                 (go (add1 i) j moves pila))
             )
            ((char=? (list-ref lista i) #\[)
             (if moves 
                 (go (add1 i) j '() (cons moves pila))
                 (go (add1 i) j '() pila))
             )
            ((char=? (list-ref lista i) #\])
             (if (null? pila)
                 (begin
                   (retrocede moves step ang)
                   (go (add1 i) j #f pila))
                 (begin
                   (retrocede moves step ang)
                   (go (add1 i) j (car pila) (cdr pila))) )
             )
            (else #t)
            )
          )
      )
    ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define interpretacion-ristra
  (lambda (ristra P A)
    (con-corchetes
     (string->list ristra)
     P
     A)
    ))
;;1. Hay que contar con un vocabulario
(define vocabulario (list #\S #\F #\+ #\- #\[ #\]))

;;2. Operación para formar expresiones compuestas
(define-syntax concatenar
  (syntax-rules ()
    [(concatenar x ...)
     (apply string-append
            (map
             (lambda (s)
               (cond
                 ((char? s) (string s))
                 ((string? s) s)
                 (else #f)
                 ))
             (list x ...))
            )
     ]
    ))
;;3. Predicado de tipo
(define-syntax ristra?
  (syntax-rules ()
    [
     (ristra? s)
     (andmap
      (lambda (char)
        (if (member char vocabulario)
            #t
            #f))
      (string->list s))
     ]
    ))
;;4. Reglas de producción
(define match-contexto
  (lambda (lista-contexto lista-ignore)
    (if (null? lista-ignore)
        lista-contexto
        (if (member (first lista-ignore) lista-contexto)
            (match-contexto (remove* (list (first lista-ignore)) lista-contexto) (rest lista-ignore))
            (match-contexto  lista-contexto (rest lista-ignore))
            )
        )
    ))
(define regla_F
  (lambda (signo contexto_i contexto_d)
;    (printf "~a CI:~a CD:~a~n" signo contexto_i contexto_d)
    (let ((lista-contexto-izqdo (match-contexto (string->list contexto_i) (list #\[ #\] #\- #\+)))
          (lista-contexto-dcho (string->list contexto_d))
          )
;      (printf "~a CI::~a~n" signo lista-contexto-izqdo)
      (if (and (char=? signo #\F) (string-member (list #\S) lista-contexto-izqdo));(char=? (last lista-contexto-izqdo) #\S))
          (concatenar "S")
          #f)
      )
    ))
(define regla_F2
  (lambda (signo contexto_i contexto_d)
    (if (char=? signo #\F)
        (concatenar #\F)
        #f)
    ))
(define regla_S
  (lambda (signo contexto_i contexto_d)
    (if (char=? signo #\S)
        (concatenar #\S)
        #f)
    ))
(define regla_+
  (lambda (signo contexto_i contexto_d)
    (if (char=? signo #\+)
        (concatenar #\+)
        #f)
    ))
(define regla_-
  (lambda (signo contexto_i contexto_d)
    (if (char=? signo #\-)
        (concatenar #\-)
        #f)
    ))
(define regla_B1
  (lambda (signo contexto_i contexto_d)
    (if (char=? signo #\[)
        (concatenar #\[)
        #f)
    ))
(define regla_B2
  (lambda (signo contexto_i contexto_d)
    (if (char=? signo #\])
        (concatenar #\])
        #f)
    ))
;;5. Se aplica una de las tres reglas
(define aplicar-reglas
  (lambda (signo contexto_i contexto_d)
    (or
     (regla_F signo contexto_i contexto_d)
     (regla_F2 signo contexto_i contexto_d)
     (regla_S signo contexto_i contexto_d)
     (regla_+ signo contexto_i contexto_d)
     (regla_- signo contexto_i contexto_d)
     (regla_B1 signo contexto_i contexto_d)
     (regla_B2 signo contexto_i contexto_d)
     )
    ))
;;6. Transformación
;;6.1 Contextos como substrings
(define string-member
  (lambda (subristra ristra); como listas
    (if (null? subristra)
        #t
        (if (member (car subristra) ristra)
            (string-member (cdr subristra) ristra)
            #f)
        )
    ))
(define contexto_i
  (lambda (ristra indice-signo)
    (let go ((i 0)
             (j (string-length ristra))
             (contexto "")
             )
      (if (= i j)
          contexto
          (if (= i indice-signo)
              contexto
              (go (add1 i) j (string-append contexto (substring ristra i (add1 i))))
              )
          )
      )
    ))
(define contexto_d
  (lambda (ristra indice-signo)
    (let go ((i 0)
             (j (string-length ristra))
             (contexto "")
             )
      (if (= i j)
          contexto
          (if (= i indice-signo)
              (substring ristra (add1 i) (string-length ristra))
              (go (add1 i) j (string-append contexto (substring ristra i (add1 i))))
              )
          )
      )
    ))
(define contextos
  (lambda (indice-signo ristra)
    (let ((context_i (contexto_i ristra indice-signo))
          (context_d (contexto_d ristra indice-signo))
          )
      (values
       context_i
       context_d
       )
      )
    ))
;;6.2 Procedimiento auxiliar de transformación
(define transformar
  (lambda (ristra)
    (let go ((i 0)
             (j (string-length ristra))
             (S "")
             )
      (if (= i j)
          S
          (let-values 
              ([(signo) (string-ref ristra i)]
               [(cont_i cont_d) (contextos i ristra)]
               )
            (go (add1 i) j (concatenar S (aplicar-reglas signo cont_i cont_d)))
            )
          )
      )
    ))
;;6.3 Método de transformación
(define derivacion_1
  (lambda (tesis)
    (if (ristra? tesis)
        (transformar tesis)
        (printf "~a ha de ser una tesis~n" tesis)
        )
    ))
;;7. Derivación de n aplicaciones
(define derivacion_n
  (lambda (tesis n)
    (let go ((i 0)
             (j n)
             (S tesis)
             )
      (if (= i j)
          S
          (go (add1 i) j (derivacion_1 S))
          )
      )
    ))

;(define axioma "S[-F[-F]F]F[[+F]F]F[-F]F")
(define axioma "S[+F]F[-F]F[+F]F")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;Resultado de la interpretación LOGO
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define interpretando
  (lambda (ristra P A N)
    (let* ((Paso P)
           (Angulo A)
           (n N)
           (S (derivacion_n ristra n))
           )
      (turtles)
      (sleep/yield 2)
      (turn 90)
      (bk 390)
      (interpretacion-ristra S Paso Angulo)
      )
    ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;(derivacion_n axioma 1)
;(derivacion_n axioma 2)
(derivacion_n axioma 3)
;(derivacion_n axioma 4)
;(derivacion_n axioma 5)
;(interpretando axioma 20 22.5 1)
(interpretando axioma 20 22.5 3)
