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

;;;        LastEditDate = Thu Nov 2 21:44:40 1984  - Jesus Glez Boticario

;;; --------------------------------------------------------
;;;
;;;	Copyright (c) by Jesus Gonzalez Boticario
;;;	              en Rank Xerox Espana S.A.
;;; 		
;;;		Noviembre de 1989
;;;
;;; --------------------------------------------------------

(in-package :dypar)

;;; Contiene funciones para escribir lineas en un fichero de tal forma que     
;;; no haya palabras partidas en el mismo.
(defmacro escribir-palabras (stream &rest palabras)
  `(do ((pal ',palabras (cdr pal))
	       (posic 0)
	       (long))
	      ((null pal) posic)
	    (cond ((> (setq posic 
			    (+ (setq long 
				     (length (princ-to-string (car pal))))
			       posic (if (stringp (car pal)) 3 1))) 
		      80)
		   (princ #\Newline ,stream)
		   (setq posic (+ long 1))))
	    (format ,stream "~S " (car pal))))



(defun leer-desde-string (str &optional (finp nil) (valor-fin 'fin)
			    &key (start 0))
  (cond ((< start (length str))
	 (setq str (subseq str start))
	 (with-input-from-string (var str)
	   (do ((car (read-char var finp 'fin)
		     (read-char var finp 'fin))
		(pos start (1+ pos))
		(str-resul (make-string-output-stream))
		(leido))
	       ((cond 
		  (leido
		    (cond ((equal 'fin car)
			   (return (values 
				     (get-output-stream-string str-resul) 
				     (+ pos 2))))
			((char-equal #\Space car)
			 (return (values (get-output-stream-string str-resul) 
					 (1+ pos))))))
		  ((equal 'fin car)  (return (values valor-fin (+ 2 pos))))))
	     (write-char car str-resul)
	     (if (char/= car #\Space)
		 (setq leido t)))))
	(t (values valor-fin (+ start 2)))))

(defun escribir-string (string &optional (stream *standard-output*))
    (do ((pal)
	 (long-pal)
	 (long-string (length string))
	 (inicio 0)
	 (posic 0))
	((>= inicio long-string) posic)
      (multiple-value-setq (pal inicio)
	(leer-desde-string string nil 'fin :start inicio))
      (if (> (setq posic  (+ (setq long-pal 
				   (length pal))
			     posic 1))
	   80)
	  (dotimes (n (- 80 (- posic long-pal 1)) (setq posic (+ long-pal 1)))
	    (princ #\Space stream)))
      (format stream "~A " pal)))
  



(defun igual-valor (num)
  (= num
     (floor num)))

;;; anade tantos blancos como hubiera en el string original dado a la funcion
;;; mi-read-line.
(defun anade-blancos (str str-resul)
  (dotimes (n (- (length str) (length str-resul))  str-resul)
    (setq str-resul
	  (concatenate 'string  " " str-resul))))

;;; cambia en un string los numeros nnn.0 por nnn para cualquier longitud y 
;;; valores de nnn.
(defun mi-read-line (string)
  (do ((long-string (length string))
       (val)
       (valor)
       (anterior 0 siguiente)
       (siguiente 0)
       (salida ""))
      ((>= siguiente long-string) salida)
    (multiple-value-setq (val siguiente)
      (leer-desde-string string nil 'fin :start anterior))
    (if (and (numberp (setq valor (read-from-string val)))
	     (igual-valor valor))
	(setq salida
	      (concatenate 'string 
			   (and (not (zerop anterior))
				(concatenate 'string salida " "))
			   (anade-blancos val
					  (princ-to-string (floor valor)))))
      (setq salida (concatenate 'string 
				(and (not (zerop anterior))
				     (concatenate 'string salida " "))
				val)))))
 
(defvar *conexion-loaded* t)