gui.lisp

;;;(compile-file "ltk")
(load "ltk")

(defpackage :gui
	(:use :common-lisp :ltk)
	(:export #:main)
)

(in-package :gui)

(setq reglas (list)) 				;Diccionario de reglas
(setq procesos (list))					;Diccionario de procesos

(defun agregarProceso (proceso) 
	(setq x (read-from-string proceso)) 
	(setf procesos (cons x procesos)) 
)
(defun agregarRegla (regla) 
	(setq x (read-from-string regla)) 
	(setf reglas (cons x reglas)) 
	(intern (string (first x)) )
)

(defun iterar(cad) 
	(setq cadena "" ) 
	(setq cadena2 "" ) 
	(map 
		nil
		(lambda(x) 
			(setq cadena 
				(concatenate 'list cadena 
					(obtenerRegla (find-symbol (string-upcase x))))
			)
		) 
		cad
		
	)
	(mapcar 
		(lambda(x)(setq cadena2 (concatenate 'string cadena2 x))) cadena
	)
	cadena2
)

(defun obtenerProceso(x) 
	(first (last (assoc x procesos)))
)
(defun obtenerRegla(x) 
	(last (assoc x reglas))
)

(defun derivarCadena (cad x) 
	(if (= x 0) 
		cad 
		(derivarCadena (iterar cad) (+ x -1))
	)
)

(defun ejecutarCadena (cad)
	(map 
		nil 
		(lambda(x) 
			(eval (obtenerProceso (find-symbol (string-upcase x))))
		) 
		(read-from-string cad)
	
	)
)

(defun ejecutarComando (comando) 
	;(format t "Estoy en Comando: ~a~%" comando);Sí existe pero no evalúa :(
	(eval (read-from-string comando))
	;(eval "(print 'hola)")
)
(defvar *line* nil)
(defvar *canvas* nil)

(defun main()
	(setf *debug-tk* nil)
	(with-ltk ()
		(let* (
				(frameOpt (make-instance 'frame)) ;Frame donde estarán los botones y los entrys
				(entryCmd (make-instance 'entry :master frameOpt)) ;Entry para recibir un comando
				(buttonCmd (make-instance 'button :master frameOpt :text "Ejecutar Comando" :command ( ;Botón para ejecutar un comando
						lambda()(ejecutarComando (text entryCmd))
					))
				)

				(mb (make-menubar))
				(mfile (make-menu mb "File" ))
				(mf-load (make-menubutton mfile "Load" 
					(lambda () ;(error "asdf")
						(format t "Load File~&")
						(setf fl (get-open-file)) ;El nombre del archivo con la ruta completa está en fl
						(let ((in (open fl))) ;Se abre el archivo
							(loop for line = (read-line in nil) ;Se itera sobre sus líneas
         						while line do 
         							;(format t "Opt: ~a~%" line)
         							(setq line2 (read-line in nil))
         							(case (parse-integer (string line))
         								;(1 (format t "Inst: ~a~%" (string line2)));
         								(1 (ejecutarComando line2))
         								(2 (agregarRegla line2))
										(3 (agregarProceso line2))
										(4 (ejecutarCadena line2))
         								(otherwise (format t "Error ~%"))
         							)
         					)
							(close in) ;Se cierra el archivo
						)
					)
					:underline 1) ;Load, se le aplica underline a la letra en la posición 1 (o)
				)

				(sc (make-instance 'scrolled-canvas :borderwidth 1 :relief :raised))
				(c (canvas sc))
				(lines nil)
				;(line (create-line c (list 0 0 400 400 250 300 0 300)))
				;(text (create-text c 260 250 "L System"))
				
			)

			(configure c :borderwidth 2 :relief :sunken)
			(pack sc :side :top :fill :both :expand t)
			(scrollregion c 0 0 300 300)

			(pack frameOpt :side :left)

			(pack entryCmd :side :left)
			(pack buttonCmd :side :left)
			(push 0 lines)
			(push 0 lines)
			(push 0 lines)
			(push 0 lines)
			(setf *line* (create-line c lines))
			(setf *canvas* c)
		)
	)
)
;Para pintar, primero se hace una lista...

;Esto
;(setq listadepuntos nil)
;(push 0 listadepuntos)
;(push 0 listadepuntos)
;(push 10 listadepuntos)
;(push 10 listadepuntos)

;Es lo mismo que 
;(setq listadepuntos '(0 0 10 10))

;Y ya se dibujan así (*canvas* y *line* siempre van, la lista es la que varía)
;(set-coords *canvas* *line* listadepuntos)

(main)

input

1
(setq fib 0)
1
(format t "~a~%" fib)
2
(a "b")
2
(b "ab")
3
(a (setq fib (+ fib 1)))
3
(b (setq fib (+ fib 1)))
4
"ab"
1
(print fib)