;;; -*- Mode:Lisp; Package:Dypar; Base:10; -*-

;;;          LastEditDate 14:00:00 We, 27-Sep-89  -- Jesus Gonzalez Boticario

;;; ---------------------------------------------------------------------------
;;;
;;;                 (c) Copyright, 1989,
;;;                         by Irene Rodriguez and 
;;;                         Jesus Gonzalez Boticario
;;;	                    para Rank Xerox Espana S.A.
;;;                         All rights reserved
;;;
;;; ---------------------------------------------------------------------------

;;; ORTO.LSP
;;; HISTORIA
;;; 27-Feb-01 Nuria Ripoll
;;; Modifico revisarfrase. Ahora ya no busca sinonimos de la palabra. Es igual que el
;;; codigo original salvo que si no encuentra error ortografico en la palabra, la 
;;; devuelve tal cual, para dar oportunidad de encontrar sinonimos de la misma, mas
;;; tarde, en la funcion smatch1 (xmatch6.lsp).
;;; 
;;; 16-Nov-00 Nuria Ripoll
;;; Modifico revisarfrase para que, en el caso de no encontrar errores ortograficos,
;;; busque palabras sinonimas con ayuda de Wordnet. OBSOLETO.
;;;
;;; 10-Nov-00 Nuria Ripoll
;;; Modifico "buscarerrorortogr" para que no de error al intentar invocar al 
;;; interfaz grafico simplemente anadiendo la condicion de que la variable 
;;; *interfaz* este a 'true'.
;;;  	(and *interfaz* ...)
;;;
;;; 18-Sep-89 Jesus Gonzalez Boticario para Rank Xerox, Espa¤a
;;;    Correccion en la funcion "buscarerrorortogr" para comprobar que
;;; la opcion dada por el usuario es un numero.
;;;
;;; 12-Sep-89 Jesus Gonzalez Boticario para Rank Xerox, Espa¤a
;;;    Modificacion del numero de argumentos de la funcion "buscarerrorortogr"
;;; para asĄ poder controlar la restauracion del interfaz. Esto es debido
;;; a que al llamar a esta funcion, puede ocurrir que cambie la disposicion
;;; de las ventanas para sacar todos los mensajes.
;;;
;;; 13-Sep-89 Jesus Gonzalez Boticario para Rank Xerox, Espa¤a
;;;   Cambio de la macro "dict-spec" a funcion debido a que si no da error
;;; a la hora de compilarse.

(in-package :dypar); :use '(:lisp :user :gclisp))

;;; variable que indica si se esta o no trabajando con el interfaz.
(proclaim '(special *interfaz*))

(dv *interfaz* nil)

(defun pinta-posibles (ventana orden palabra)
  (let ((posic-x-y (cond ((< orden 12) (list 3 (+ 2 orden)))
			 ((< orden 23) (list 28 (+ 3 (mod orden 12))))
			 ((< orden 35) (list 58 (+ 3 (mod orden 23)))))))
    (send ventana :set-cursorpos (car posic-x-y) (cadr posic-x-y))
    (send ventana :write-string (princ-to-string orden))
    (send ventana :set-cursorpos (+ 3 (car posic-x-y)) (cadr posic-x-y))
    (send ventana :write-string "->")
    (send ventana :set-cursorpos (+ 6 (car posic-x-y))(cadr posic-x-y))
    (send ventana :write-string (princ-to-string palabra))))

(defun buscarerrorortogr (palabra &key (restaurar nil))
  (let ((lcambios)
	(encontrada))
    (if (numberp palabra)
	(setq encontrada t)
      (setq encontrada (get-terminal-hash palabra)))
    (cond
      ((not encontrada)
       (setq lcambios (cambio palabra))
       (cond
	 (lcambios (cond
		     ((not (cdr lcambios))
		      (format t "~% ~% se cambia ~s por ==> ~s "
			      palabra (car lcambios))
		      (and *interfaz* restaurar (restaurar-resp-grande))
		      (setq palabra (car lcambios)))
		     (t 
		      (if (and *interfaz* (not restaurar))
			  (pinta-pant-correc-orto)) ;provoca el cambio de 
		                                    ;pantallas en el interfaz
		      ;; si hay mas de una palabra que podria corregir
		      ;; el error ortografico,          
		      ;;es necesario que el usuario indique la correcta:
		      
		      (let ((long (list-length lcambios)))
			;Nuria Ripoll. 10N.
			(and *interfaz* (send *standard-output* :clear-screen))
			(format t 
				" Error ortografico en ~a. ~%  ~
				existen varias palabras parecidas:" 
				palabra)
			(do ((posible lcambios (cdr posible))
			     (orden 1 (1+ orden)))
			    ((null posible)) 
			   ;Nuria Ripoll. 10N.
			  (and *interfaz* (pinta-posibles *standard-output* orden
							  (car posible))))
			
					;Nuria Ripoll. 10N
			(and *interfaz* (if (< long 8) 
			    (send *standard-output* 
				  :set-cursorpos 3 11)
			  (send *standard-output* 
				:set-cursorpos 3 15)))
			
			(format t "~s --->  ninguna de estas palabras  son correctas  "
				(1+ long))
			(format t "~%   ~s --->  la palabra ~a es correcta  ~%"
				(+ 2 long) palabra)
			(let ((num 0))
			  (do ((numero nil (read)))
			      ((and (numberp numero)
				    (> numero 0)
				    (<= numero (+ long 2)))
			       (setq num numero))
			    (format t 
           " ~% por favor, indique el numero de la palabra correcta (1..~D): "
	   (+ long 2)))
			  
			  (cond
			   ((= num (+ 2 long))
			    (format t "~& la palabra ~a no la conozco" palabra)
			    (and *interfaz* (restaurar-resp-grande) nil))
			   
			   ((= num (1+ long))
			    (format t "~% vuelva a escribir la palabra , por favor : ")
			     (setq palabra (read))
			     (buscarerrorortogr palabra :restaurar *interfaz*))
			   
			   (t (and *interfaz* (restaurar-resp-grande))
			      (setq palabra (nth (1- num) lcambios))))))
		      )))
	 
	 (t (and *interfaz* restaurar (restaurar-resp-grande)) 
	    (format t "~%No conozco la palabra  ~a" palabra))))
      (t (and *interfaz* restaurar (restaurar-resp-grande))
	 palabra))))


(defun cambio (pal) 
  (let ((inplen (length (string pal))))
    	  (append 
	    (spell-correct-mayor pal (dict-spec (1+ inplen))
				 inplen)
	    (spell-correct-menor pal (dict-spec (1- inplen))
				 inplen)
	    (spell-correct-igual pal (dict-spec inplen)
				 inplen))))


(defun dict-spec (n) (aref *dypar-terminal-array* n))


(defun revisarfrase (frase)
  (let ((frasen) (npal))
    (dolist (pal frase frasen)
      (setq npal (buscarerrorortogr pal))
      (if npal
	  (setq frasen (append frasen (list npal)))
	(setq frasen (append frasen (list pal)))
	;;Nuria Ripoll. 27F.
	;;(return nil)
	))))

;;; Nuria Ripoll.
;;; Esta siguiente es la funcion que buscaba sinonimos de la palabra a la vez que 
;;; los errores ortograficos.
;(defun revisarfrase (frase)
;  (let ((frasen)
;	(npal))
;    
;    (dolist (pal frase frasen)
;      ;; Se mira si tiene error ortografico.
;      (setq npal (buscarerrorortogr pal))
;      (if npal
;	  (setq frasen (append frasen (list npal)))
;	;; Intento buscar palabra equivalente en diccionario.
;	(progn
;	  (setq npal (busca-diccionario pal))
;	  (if npal
;	      (setq frasen (append frasen (list npal)))
;	    (setq frasen (append frasen (list pal)))))))))
;	    ;(return nil)))))));;; antes devolvia nil pero daba error con $w...


(defun spell-correct-igual (input dict-igual inplen)
  (declare (ignore inplen))
  (mapcan #'(lambda (dict-word)
	      (let ((focus (or (string< input dict-word)
			       (string> input dict-word))))
		(if (or (string= input dict-word :start1 (1+ focus)
				 :start2
				 (1+ focus))
			(and (string= input dict-word :start1 (1+ focus)
				      :start2 focus :end1 (+ 2 focus)
				      :end2
				      (1+ focus))
			     (string= input dict-word 
				      :start1 focus :start2 (1+ focus)
				      :end1
				      (1+ focus)
				      :end2
				      (+ 2 focus))
			     (string= input dict-word :start1 (+ 2 focus)
				      :start2
				      (+ 2 focus))))
		    (list dict-word)))) dict-igual))


(defun spell-correct-mayor (input dict-mayor inplen)
  (declare (ignore inplen))
  (mapcan #'(lambda (dict-word)
	      (let ((focus (or (string< input dict-word)
			       (string> input dict-word))))
		(if (string= input dict-word :start1 focus :start2 (1+ focus))
		    (list dict-word)))) dict-mayor))


(defun spell-correct-menor (input dict-menor inplen)
  (declare (ignore inplen))
  (mapcan #'(lambda (dict-word)
	      (let ((focus (or (string< input dict-word)
			       (string> input dict-word))))
		(if (string= input dict-word :start1 (1+ focus)
			     :start2 focus)
		    (list dict-word)))) dict-menor))

(defvar *orto-loaded* t)