;********************** LA MAQUINA DE TURING ***************************
(LOAD WINDOWS)
(LOAD ADD2.MT)
(SETQ PROG 'ADD2.MT)
(DEFUN INICIALIZA()
(SETQ MT_PROG FUNCION_DE_TRANSICION)
(SETQ MT_ENTRADA ENTRADA)
(SETQ MT_INICIAL ESTADO_INICIAL)
;VERIFICAR QUE LA POSICION INICIAL DE LA CINTA ES VALIDA:
(COND ((< POSICION_INICIAL_CINTA 0) (SETQ MT_POS 0))
((>= POSICION_INICIAL_CINTA (LENGTH MT_ENTRADA))
(SETQ MT_POS (- (LENGTH MT_ENTRADA) 1)))
(T(SETQ MT_POS POSICION_INICIAL_CINTA))
)
(SETQ MT_SIMBS SIMBOLOS)
(SETQ EDO_ANT '())
(SETQ ACCION_ANT '())
(SETQ COMENTARIO '())
(SETQ MT_STEP 1)
(FIJA_ENT)
)
(DEFUN FIJA_ENT()
;ref_ent = en cual cuadro de la cinta inicia la muestra 1..19
;inicio_ent = desde cual puede mostrar 0..((length mt_entrada) - 1)
(SETQ REF_ENT (- 8 MT_POS))
(COND ((>= REF_ENT 1) (SETQ INICIO_ENT 0))
(T ((SETQ INICIO_ENT (- MT_POS 7))
(SETQ REF_ENT 1)))
)
)
(INICIALIZA)
(SETQ *INIT-WINDOW* "maq_turing")
(SETQ DRIVER 'WINDOWS)
(BORDER-COLOR 3)
(DEFUN "maq_turing" (COMMAND (EVAL MT_STEP) (EVAL MT_INICIAL)
(EVAL MT_POS) (EVAL MT_ENTRADA))
((EQ COMMAND 'CREATE-WINDOW)
(LIST "maq_turing" MT_STEP MT_INICIAL MT_POS MT_ENTRADA) )
((EQ COMMAND 'CLOSE-WINDOW))
(MENSAJE)
(UNWIND-PROTECT
(PROGN
((EQ COMMAND 'UPDATE-WINDOW) (SETQ *INITIAL-POSITION*))
(PARAMETROS)
(LOOP (EXECUTE-OPTION 'COMANDOS *MT-OPTIONS*))
)
)
)
(SETQ *MT-OPTIONS* '(
("Parametros " "ESTABLECER (ESC=menu principal)" (
("Edo_inicial " . SET-MT-INICIAL)
("Pos_cinta " . SET-MT-POS)
("Cinta (entrada) " . SET-MT-ENTRADA)
("Reinicializar" . REINICIALIZA) ))
("Step" . SET-STEP)
("Correr" . MT1)
("Ejemplos" "EJEMPLOS A ELEGIR"(
("Dup (s0,s1,s2)" . SET-DUP)
("Suma (s0,s1,s2)" . SET-SUMA)
("Resta (s0,s1)" . SET-RESTA)
("Add2 (s0,s1)" . SET-ADD2)))
("Load" . LOAD_ARCH)
("Opciones" OPCIONES (
("Color" . SET-COLOR)
("Dos" . GO-DOS) ))
("Quit" . EXIT)))
(DEFUN EXIT()
;(BORDER-COLOR 0)
(QUIT-PROGRAM)
)
(DEFUN REINICIALIZA()
(INICIALIZA)
(PARAMETROS)
)
(DEFUN PARAMETROS()
(CURRENT-WINDOW)
(CLEAR-SCREEN)
(SETQ MAX_ANT 0)
(CURRENT-WINDOW)
(SET-CURSOR 1 60)
(WRITE-STRING "PROG: ")
(SET-CURSOR 1 66)
(PRINC PROG)
(ENCABEZADOS)
(VALORES)
)
(DEFUN ENCABEZADOS()
(CURRENT-WINDOW)
(FOREGROUND-COLOR 7)
(SET-CURSOR 4 3)
(WRITE-STRING " ESTADO ACTUAL: ")
(SET-CURSOR 6 3)
(WRITE-STRING " SIMBOLO APUNTADO: ")
(SET-CURSOR 8 3)
(WRITE-STRING " POS. RELATIVA: ")
(SET-CURSOR 9 3)
(WRITE-STRING " EN CINTA ")
(SET-CURSOR 10 28)
(WRITE-STRING " C I N T A : ")
(SET-CURSOR 13 2)
(WRITE-STRING "==========================================================================")
(SET-CURSOR 15 2)
(WRITE-STRING "==========================================================================")
(SET-CURSOR 14 3)
(WRITE-STRING "| | | | | | | | | | | | | | | | | | |")
(SET-CURSOR 4 27)
(WRITE-STRING " REALIZO: ")
(SET-CURSOR 6 27)
(WRITE-STRING " COMENTARIO: ")
(SET-CURSOR 4 60)
(WRITE-STRING " POSIBLES SIG. ")
(FOREGROUND-COLOR 15)
(BACKGROUND-COLOR 0)
)
(DEFUN VALORES()
(CURRENT-WINDOW)
(SET-CURSOR 4 22)
(PRINC MT_INICIAL)
(WRITE-STRING " ")
(SET-CURSOR 6 22)
(PRINC (TRAE_SIMB))
(WRITE-STRING " ")
(SET-CURSOR 8 22)
(PRINC MT_POS)
(WRITE-STRING " ")
(SET-CURSOR 4 40)
(COND ((EQUAL EDO_ANT NIL) (WRITE-STRING " "))
(T( (PRINC EDO_ANT)
(WRITE-STRING " -> ")))
)
(SET-CURSOR 4 51)
(COND ((EQUAL ACCION_ANT NIL) ;el programa termino
((WRITE-STRING " ")
;(SETQ MT_ENTRADA (SIMP_CINTA MT_ENTRADA MAGT 0))
(COND ((>= MT_POS (LENGTH MT_ENTRADA))
(SETQ MT_POS (- (LENGTH MT_ENTRADA) 1)))))
)
(T (PRINC ACCION_ANT))
)
(SET-CURSOR 6 40)
(COND ((EQUAL COMENTARIO NIL) (WRITE-STRING " "))
(T( (PRINC COMENTARIO)
(WRITE-STRING " ") ))
)
(POSIBLES MT_INICIAL MT_PROG 0)
(MUESTRA_ENT 1)
)
(DEFUN MT1()
(MT MT_STEP)
(COND ((EQ MT_FIN 0)
((PROMPT-YN "continuar (S/N)? ") (MT1) )
)
)
)
(DEFUN MT(MT_STEP)
(COND ((OR (> MT_STEP 3) (EQ MT_STEP -1))
((SHOW-PROMPT "Presiona una tecla para abortar")
( ((LISTEN T)
(CLEAR-INPUT T)
((PROMPT-YN "Abortar ejecucion? (Y/N)? ")
((THROW 'SWITCH-SCREEN)
(EXECUTE-OPTION 'COMANDOS *MT-OPTIONS*) )
)
(SHOW-PROMPT "Presiona una tecla para abortar"))
)
)
)
)
(COND ((OR (EQ MT_STEP -1) ( > MT_STEP 0) )
(BUSCA (LIST MT_INICIAL (TRAE_SIMB))
MT_PROG MT_STEP))
(T(
(SETQ COMENTARIO 'Ok...continuar)
(VALORES)
(SETQ MT_FIN 0)
)
)
)
)
(DEFUN TRAE_SIMB()
(NTH MT_POS MT_ENTRADA)
)
(DEFUN BUSCA (EDO_ACTUAL MT_PROG_AUX MT_STEP)
(SETQ EDO_ANT EDO_ACTUAL)
(COND ((NULL MT_PROG_AUX)
((SETQ COMENTARIO 'Indefinido...FIN)
(SETQ ACCION_ANT '())
(VALORES)
(SETQ MT_FIN 1))
)
((EQUAL EDO_ACTUAL (CAAR MT_PROG_AUX))
(ACCION (SECOND (CAR MT_PROG_AUX)) MT_STEP) )
(T (BUSCA EDO_ACTUAL (CDR MT_PROG_AUX) MT_STEP))
)
)
(DEFUN ACCION (EDO_NUEVO MT_STEP)
;Inicia escribir simbolo
(COND ((EQ (- (LENGTH MT_ENTRADA) 1) MT_POS)
(INSERT_NTH B MT_ENTRADA (+ MT_POS 1)) )
)
(INSERT_NTH (FIRST EDO_NUEVO)
(DELETE_NTH MT_ENTRADA MT_POS)
MT_POS
)
(COND ((AND
(EQ (+ REF_ENT (- (LENGTH MT_ENTRADA) INICIO_ENT)) 20)
(> MT_POS 1))
(SETQ REF_ENT (- REF_ENT 1)) ;desp izq
)
)
(COND ((EQ REF_ENT 0)
((SETQ REF_ENT 1) (SETQ INICIO_ENT (+ INICIO_ENT 1)))
)
)
(COND ((EQ MT_POS 0)
(SETQ MT_POS 1)
(NTH MT_POS (INSERT_NTH B MT_ENTRADA 0))
(SETQ REF_ENT (- REF_ENT 1))
(COND ((EQ REF_ENT 0)
(SETQ REF_ENT 1)
)
)
)
)
;Termina escribir simbolo
;Inicia realizar movimiento (R, L o' S)
(COND ((EQ R (SECOND EDO_NUEVO)) (
(SETQ MT_POS (+ MT_POS 1))
(COND ((EQ MT_POS (LENGTH MT_ENTRADA))
(NTH MT_POS (INSERT_NTH B MT_ENTRADA MT_POS)))
)
(COND ((EQ (+ REF_ENT (- MT_POS INICIO_ENT)) 19)
;si esta en extremo der
; (+ ref_ent (eq (- mt_pos inicio_ent)) 19)
;y es right desplazar a la izq.
(SETQ REF_ENT (- REF_ENT 1))
(COND ((EQ REF_ENT 0)
((SETQ REF_ENT 1)
(SETQ INICIO_ENT (+ INICIO_ENT 1))))
)
)
)
(COND ((AND (EQ REF_ENT 1) (EQ (- MT_POS INICIO_ENT) 18))
;mostrando desde extremo izq (ref_ent=1) y
;estando en extremo der (eq (- mt_pos inicio_ent) 18)
;esconder un simbolo (desplaz a la izq)
(SETQ INICIO_ENT (+ INICIO_ENT 1))
)
)
))
((EQ L (SECOND EDO_NUEVO)) (
(SETQ MT_POS (- MT_POS 1))
(COND ((EQ MT_POS -1)
(SETQ MT_POS 0)
(NTH MT_POS (INSERT_NTH B MT_ENTRADA MT_POS))
(SETQ REF_ENT (- REF_ENT 1)) ;desp izq
(COND ((EQ REF_ENT 0) (SETQ REF_ENT 1)))
)
)
(COND ((AND
(EQ (+ REF_ENT (- (LENGTH MT_ENTRADA) INICIO_ENT)) 20)
(> REF_ENT 2))
(SETQ REF_ENT (- REF_ENT 1)) ;desp izq
)
)
(COND ((AND (EQ REF_ENT 1) (> INICIO_ENT 0)
(EQ (- MT_POS INICIO_ENT) -1))
;en extremo izq (ref_ent=1) and (eq (- mt_pos inicio_ent) -1)
;y tenemos entrada escondida (inicio_ent > 0) hay que sacar
;un simbolo (desplaz a la derecha)
(SETQ INICIO_ENT (- INICIO_ENT 1))
)
)
))
;Si es 'S' no se mueve
)
;Termina realizar movimiento
(SETQ ACCION_ANT EDO_NUEVO)
(VALORES)
(SETQ MT_INICIAL (THIRD EDO_NUEVO))
(COND ((NEQ MT_STEP -1) (MT (- MT_STEP 1)))
(T(MT MT_STEP)) ;mt_step=-1, no modificarlo
)
)
(DEFUN MUESTRA_ENT(INICIO_PANT)
(COND ((EQ INICIO_PANT 19)) ;SOLO DE 1 A 18
(T (
(SET-CURSOR 16 (+ (* INICIO_PANT 4) 1))
(COND ((EQ (+ REF_ENT (- MT_POS INICIO_ENT)) INICIO_PANT)
((FOREGROUND-COLOR 10)
(BACKGROUND-COLOR (SIXTH *WINDOW-COLORS*))
(WRITE-STRING "^")
(FOREGROUND-COLOR 4) (BACKGROUND-COLOR 3)
(SET-CURSOR 17 (- (* INICIO_PANT 4) 1) )
(WRITE-STRING " ")
(SET-CURSOR 17 (- (* INICIO_PANT 4) 0) )
(PRINC MT_INICIAL)
)
)
(T(
(FOREGROUND-COLOR 0)
(BACKGROUND-COLOR (SIXTH *WINDOW-COLORS*))
(WRITE-STRING " ")
(SET-CURSOR 17 (* INICIO_PANT 4) )
(WRITE-STRING " ")
(FOREGROUND-COLOR 15) (BACKGROUND-COLOR 3)
)
)
)
(SET-CURSOR 14 (* INICIO_PANT 4))
(WRITE-STRING " ")
(COND ((NEQ (NTH (+ INICIO_ENT (- INICIO_PANT REF_ENT)) MT_ENTRADA) NIL)
(PRINC (NTH (+ INICIO_ENT (- INICIO_PANT REF_ENT)) MT_ENTRADA) )
)
(T(
(FOREGROUND-COLOR 7) (BACKGROUND-COLOR 3)
(WRITE-STRING "B")
))
)
(WRITE-STRING " ")
(MUESTRA_ENT (+ INICIO_PANT 1))
)
)
)
)
(DEFUN POSIBLES (EDO_ACTUAL MT_PROG_AUX INICIAL)
(COND ((NULL MT_PROG_AUX)
((LIMPIAR_POSIBLES INICIAL MAX_ANT)
(SETQ MAX_ANT INICIAL)
)
)
((EQUAL EDO_ACTUAL (CAAAR MT_PROG_AUX))
((SET-CURSOR (+ 6 INICIAL) 60)
(PRINC (CAR MT_PROG_AUX))
(WRITE-STRING " ")
(POSIBLES EDO_ACTUAL (CDR MT_PROG_AUX) (+ INICIAL 1))
)
)
(T (POSIBLES EDO_ACTUAL (CDR MT_PROG_AUX) INICIAL))
)
)
(DEFUN LIMPIAR_POSIBLES (INICIAL MAX_ANT)
(COND ((>= INICIAL MAX_ANT) )
(T(
(SET-CURSOR (+ 6 INICIAL) 60)
(WRITE-STRING " ")
(LIMPIAR_POSIBLES (+ INICIAL 1) MAX_ANT)
))
)
)
(DEFUN INSERT_NTH (ELEM L POS)
(SETQ MT_ENTRADA (MI_INSERT ELEM L POS 0))
)
(DEFUN MI_INSERT(ELEM L POS CTA_POS)
(COND ( (EQ POS CTA_POS) (CONS ELEM (MI_INSERT ELEM L POS (+ CTA_POS 1))))
( (NULL L) L)
(T (CONS (CAR L) (MI_INSERT ELEM (CDR L) POS (+ CTA_POS 1))))
)
)
(DEFUN DELETE_NTH (L POS)
(SETQ MT_ENTRADA (MI_DELETE L POS 0))
)
(DEFUN MI_DELETE(L POS CTA_POS)
(COND ( (NULL L) L)
( (EQ POS CTA_POS) (MI_DELETE (CDR L) POS (+ CTA_POS 1)))
(T (CONS (CAR L) (MI_DELETE (CDR L) POS (+ CTA_POS 1))))
)
)
(DEFUN SIMP_CINTA (ENT SIMB_ANT CTA_SIMP) ;hace '(b b b 1 1 b b) -> '(b 1 1 b)
(COND ( (NULL ENT) ENT)
( (AND (NULL (CDR ENT)) (< CTA_SIMP 2)) ;si es el ultimo y cta<2 pegalo
(CONS (CAR ENT) (SIMP_CINTA (CDR ENT) (CAR ENT) (+ CTA_SIMP 1))))
((AND (EQ (CAR ENT) B) (EQ SIMB_ANT B) ) ;si simb_ant=simb_actual=b saltalo
(SIMP_CINTA (CDR ENT) SIMB_ANT CTA_SIMP))
(T (CONS (CAR ENT) (SIMP_CINTA (CDR ENT) (CAR ENT) (+ CTA_SIMP 1))) )
)
)
(DEFUN SET-STEP (STEP)
(RPLACA (CAR LET-STEP) MT_STEP)
(LOOP
((NOT (MODE-QUERY 'STEP LET-STEP)) NIL)
(SETQ STEP (PARSE-INTEGER (CAAR LET-STEP)))
((AND STEP (<= -1 STEP 99))
(SETQ MT_STEP STEP *INITIAL-POSITION*)
T )
(ERROR-BEEP)
)
)
(SETQ LET-STEP '( ("" 0 0 "Dame el step para ejecucion (-1 => continuo)" " " 3) ))
(DEFUN SET-MT-INICIAL (INICIAL)
(RPLACA (CAR LET-INICIAL) MT_INICIAL)
(LOOP
((NOT (MODE-QUERY 'INICIAL LET-INICIAL)) NIL)
(SETQ INICIAL (CAAR LET-INICIAL))
( (<= (LENGTH INICIAL) 4)
(SETQ AUX1 INICIAL)
(SETQ AUX AUX1)
(SETQ MT_INICIAL AUX)
T )
(ERROR-BEEP)
)
(PARAMETROS)
)
(SETQ LET-INICIAL '( ("" 0 0 "Dame el estado inicial" " " 6) ))
(DEFUN SET-MT-POS (POSICION)
(RPLACA (CAR LET-POS) MT_POS)
(LOOP
((NOT (MODE-QUERY 'POSICION LET-POS)) NIL)
(SETQ POSICION (PARSE-INTEGER (CAAR LET-POS)))
((AND POSICION (<= 0 POSICION (- (LENGTH MT_ENTRADA) 1)))
(SETQ MT_POS POSICION *INITIAL-POSITION*)
T )
(ERROR-BEEP)
)
(FIJA_ENT)
(PARAMETROS)
)
(SETQ LET-POS '( ("" 0 0 "Dame posicion inicial en cinta [0 -> ((length cinta) - 1)]" " " 3) ))
(DEFUN LOAD_ARCH (ARCH_ENT)
(SETQ COMMAND "DIR *.MT /B /A:-D /O /P")
(CURRENT-WINDOW)
(CLEAR-SCREEN)
(SET-CURSOR 1 20)
(WRITE-STRING " LISTA DE ARCHIVOS MT PARA ELEGIR ")
(SET-CURSOR 3 0)
(EXECUTE (GETSET 'COMSPEC) (PACK* "/C " COMMAND))
(LOOP
((NOT (MODE-QUERY 'ARCH LET-ARCH)) NIL)
(SETQ ARCH_ENT (CAAR LET-ARCH))
( (<= (LENGTH ARCH_ENT) 11)
(SETQ PROG ARCH_ENT)
(LOAD ARCH_ENT)
(INICIALIZA)
T )
(ERROR-BEEP)
)
(THROW 'SWITCH-SCREEN)
)
(SETQ LET-ARCH '( ("" 0 0 "Dame el archivo a cargar (Con extension)" " " 12) ))
(DEFUN SET-DUP()
(LOAD DUP.MT)
(SETQ PROG 'DUP.MT)
(INICIALIZA)
(PARAMETROS)
)
(DEFUN SET-SUMA()
(LOAD SUMA.MT)
(SETQ PROG 'SUMA.MT)
(INICIALIZA)
(PARAMETROS)
)
(DEFUN SET-RESTA()
(LOAD RESTA.MT)
(SETQ PROG 'RESTA.MT)
(INICIALIZA)
(PARAMETROS)
)
(DEFUN SET-ADD2()
(LOAD ADD2.MT)
(SETQ PROG 'ADD2.MT)
(INICIALIZA)
(PARAMETROS)
)
(DEFUN SET-MT-ENTRADA ()
(MODE-QUERY1 'ENTRADA "EJ: (b 1 1 b)<enter>" )
(PARAMETROS)
)
(DEFUN MENSAJE ()
(SET-CURSOR 0 17)
(BACKGROUND-COLOR 1)
(WRITE-STRING " SIMULADOR DE LA MAQUINA DE TURING v1.1 ")
(SET-CURSOR 0 65)
(WRITE-STRING " by magt ")
(CLEAR-STATUS "maq_turing")
(WRITE-STRING "FACULTAD DE ING. ELECTRICA U.M.S.N.H. Junio/95")
)
(PROGN (WRITE-LINE "Presiona la tecla ESC para iniciar ") T)