;;; C-scanf() like format analogon for input.
;;;
;;; $Id$

(proclaim '(optimize (speed 3) (safety 0) (space 0)))


(defmacro with-type (type expr)
  `(the ,type ,(if (atom expr)
                   expr
                   (expand-call type (binarize expr)))))

(defun expand-call (type expr)
  `(,(car expr) ,@(mapcar #'(lambda (a)
                              `(with-type ,type ,a))
                          (cdr expr))))

(defun binarize (expr)
  (if (and (nthcdr 3 expr)
           (member (car expr) '(+ - * /)))
      (destructuring-bind (op a1 a2 . rest) expr
        (binarize `(,op (,op ,a1 ,a2) ,@rest)))
      expr))



(defun whitespace-char-p (c)
  "(c)

Returns non-nil iff c is a non visible character like space or newline."

  (position c #(#\Space
		#\Newline
		#\Tab
		#\Linefeed
		#\Return
		#\Page
		#\Backspace		; questionable
		#\Rubout)))		; questionable


(defun string-to-unsigned-fixnum (str &key (start 0) (end nil) (radix 10))

  "(str &key (start 0) (end nil) (radix 10))

Converts part of a string str to an unsigned fixnum.

Starts converting at position start, stops at end when specified or at
end of string or when a non-convertible character is seen. If end is
specified then it must not be greater than the length of the string.

Assumes the specified radix and does neither recognize a radix
encoding in the string nor a sign nor even leading whitespace.

Returns the converted number and the position of the first character
in the string behind that number. Returns 0 when no convertible
characters where seen at all."

  (declare (simple-string str)
           (fixnum start radix))
  (let ((len (or end (length str))))
    (declare (fixnum len))
    (do ((i start (1+ i))
         (n 0))
        ((= i len)
         (values n i))
      (declare (fixnum i n))
      (let ((d (digit-char-p (schar str i) radix)))
        (if d
            (setq n (with-type fixnum (+ d (* n radix))))
            (return (values n i)))))))


(defun string-to-unsigned-integer (str &key (start 0) (end nil) (radix 10))

  "(str &key (start 0) (end nil) (radix 10))

Converts part of a string str to an integer.

Starts converting at position start, stops at end when specified or at
end of string or when a non-convertible character is seen. If end is
specified then it must not be greater than the length of the string.

Assumes the specified radix and does neither recognize a radix
encoding in the string nor a sign nor even leading whitespace.

Returns the converted number and the position of the first character
in the string behind that number. Returns nil when no convertible
characters where seen at all."

  (declare (simple-string str)
           (fixnum start end radix))
  (let ((len (or end (length str))))
    (do ((i start (1+ i))
         (n 0))
        ((= i len)
         (values n len))
      (let ((d (digit-char-p (schar str i) radix)))
        (if d
            (setq n (with-type integer (+ d (* n radix))))
            (return (if (> i start)
			(values n i))))))))


(defun string-to-integer (str &key (start 0) (end nil) (radix 10))

  "(str &key (start 0) (end nil) (radix 10))

Converts part of a simple-string str to an integer.

Skips leading whitespace and recognizes #\+ and #\- as signs.

Converts up to end (if specified) or end of string or until a
non-convertible character is seen, whichever comes first.

Uses the specified radix as number conversion base. Alas the specified
radix may be overwritten from the input in the string using a syntax
of #x, #o, #b, #nnr for hex, octal, binary or other.

Returns nil on error or the resulting integer and the position of the
first character behind the integer."

  (declare (simple-string str)
	   (fixnum start radix))
  (let* ((len (let ((l (length str)))
		(if end (min l end) l)))
	 (i (position-if-not #'whitespace-char-p str
			     :start start :end len))
	 (negative nil)
	 (n nil))
    (declare (fixnum len i))
    (when (= i len)
      (return nil))
    (case (schar str i)
      (#\- (setq negative t)
	   (incf i)
	   (when (= i len)
	     (return nil)))
      (#\+ (incf i)
	   (when (= i len)
	     (return nil))))
    (when (char= #\# (schar str i))
      (incf i)
      (if (= i len)
	  (return nil))
      (case (schar str i)
	(#\b (incf i) (setf radix #b10))
	(#\o (incf i) (setf radix #o10))
	(#\x (incf i) (setf radix #x10))
	((t) (multiple-value-setq (radix i)
	       (string-to-unsigned-fixnum str :start i :end end))
	 (when (not radix)
	   (return nil))
	 (when (= i len)
	   (return nil))
	 (unless (char-equal (schar str i) #\r)
	   (return nil))
	 (incf i))))
    (multiple-value-setq (n i)
      (string-to-unsigned-integer str :start i :end end :radix radix))
    (when (not n)
      (return nil))
    (values (if negative (- n) n) i)))


#|

(defun string-to-integer-1 (str &key (start 0) (end nil) (radix 10))
  (declare (string str)
           (fixnum start end radix))
  (let* ((l (length str))
         (r (if end (min l end) l)))
    (do ((i start (1+ i))
         (d 0 (if (< i r)
                  (digit-char-p (char str i) radix)))
         (n 0 (+ d (* n radix))))
        ((not d)
         (values n (1- i))))))


(defun test-string-to-integer (fun n)
  (dotimes (i n)
    (let ((k (funcall fun "12345"))))))

(compile 'string-to-fixnum)
(compile 'string-to-integer)
(compile 'string-to-integer-1)
(compile 'test-string-to-integer)

|#


(defun string-to-float (str &key width (radix 10))
  (multiple-value-bind (int-part int-part-len)
      (string-to-integer str width radix)
    (if (or (not width) (< int-part-len width))
        (cond (char str int-part-len)

  (let* ((l (length str))
         (w (if width (min l width) l)))
    (do ((i 0 (1+ i))
         (d 0 (if (< i w)
                  (digit-char-p (char str i) radix)))
         (n 0 (+ d (* n radix))))
        ((not d)
         (values n (1- i))))))

(defun scan-formatted (form )
  (let (result)
    (labels
        ((scan-character (width)
           (push (read-char strm) result))
         (scan-string (width)
           (push (read-char strm) result))
         (scan-integer (width)
           (push (stream-parse-integer strm) result))
         (scan-float (width)
           (push (stream-parse-integer strm) result))
         (dispatch (c)
           (case c
             (#\~
              (let ((width (stream-parse-integer form))
                    (form-char (read-char form nil nil)))
                (case form-char
                  (#\c (scan-character width))
                  (#\s (scan-string width))
                  (#\d (scan-integer width))
                  (#\f (scan-float width))
                  (otherwise nil))))
             (otherwise
              (let ((d (read-char strm)))
                (eq c d))))))
      (do* ((c (read-char form nil nil)
               (read-char form nil nil)))
           ((or (not c)
                (not (dispatch c)))
            (if c
                ;; EOF in form not hit, means error, return nil.
                nil
                ;; EOF in form, means all formats processed.
                ;; Return reversed result list.
                (values-list (nreverse result))))))))

(defun read-daxa ()
  (with-open-file (daxa "daxa.asc"
                        :direction :input)
    (do ((line (read-line daxa nil nil)
               (read-line daxa nil nil))
         (result nil
                 (cons (multiple-value-list
                           (scan-string-string
                            "~2d~2d~2d,~3d.~3d,~3d.~3d,~3d.~3d,~3d.~3d"
                            line))
                       result)))
        ((not line) result)))
)