(in-package klmnea)

(defmacro defnmeassage (name &rest slots)
  (multiple-value-bind (flat-names slot-names) (slot-names slots)
    `(progn
       (defclass ,name (nmeassage) 
	 ,(mapcar #'(lambda (n) (list n :initform nil)) flat-names))
       (defmethod init-nmeassage-from-lst ((message ,name) lst)
	 (setf
	  ,@(apply
	     #'append
	     (apply
	      #'append
	      (mapcar #'generate-slot-setters 
		      slots
		      (loop for i below (length slots) collect i)))))
	 message)
       (defmethod print-object ((object ,name) stream) ;too many mapcars...
	 (with-slots ,flat-names object
	   (let ((str
		  (with-output-to-string (s)
		    (format s ,(subseq (symbol-name name) 1))
		    ,@(mapcar
		       #'(lambda (names fmts)
			   `(format s ,(format nil "~~:[,~~;,~a~~]" fmts)
				    (and ,@names) ,@names))
		       slot-names
		       (mapcar 
			#'(lambda (s) 
			    (apply #'concatenate 'string 
				   (generate-format-string s))) 
			slots)))))
	     (format 
	      stream "$~:@(~a~)*~2,'0,,x" str
	      (apply #'logxor (map 'list #'char-code str))))))
       (eval-when (:compile-toplevel :load-toplevel :execute)                   
         (export ',name)))))

;$GPRMC,hhmmss.ss,A,LLLL.LL,a,yyyyy.yy,a,v.v,b.b,ddmmyy,x.x,d,m*hh

(defnmeassage $gprmc
    ((hours :integer 2)
     (minutes :integer 2)
     (seconds :float 2)) ; width BEFORE decimal point
  ((status))
  ((lat-deg :integer 2)
   (lat-min :float 2)) ; width BEFORE decimal point
  ((lat-dir))
  ((lon-deg :integer 3)
   (lon-min :float 2)) ; width BEFORE decimal point
  ((lon-dir))
  ((speed :float))
  ((course :float))
  ((day :integer 2)
   (month :integer 2)
   (year :integer 2))
  ((decl :float))
  ((decl-dir))
  ((mode)))

;$GPGGA,hhmmss.ss,ddmm.mmm,a,dddmm.mmm,b,q,xx,p.p,a.b,M,c.d,M,x.x,nnnn*hh

(defnmeassage $gpgga
    ((hours :integer 2)
     (minutes :integer 2)
     (seconds :float 2)) ; width BEFORE decimal point
   ((lat-deg :integer 2)
   (lat-min :float))
  ((lat-dir))
  ((lon-deg :integer 3)
   (lon-min :float))
  ((lon-dir))
  ((quality :integer))
  ((number-of-satellites :integer))
  ((hor-dilution :float))
  ((antenna-altitude :float))
  ((antenna-altitude-units))
  ((geoidal-height :float))
  ((geoidal-height-units))
  ((age :float))
  ((reference)))

(defnmeassage $gpgsa
    ((mode))
  ((fix :integer))
  ((sat01 :integer)) ((sat02 :integer)) ((sat03 :integer)) ((sat04 :integer)) 
  ((sat05 :integer)) ((sat06 :integer)) ((sat07 :integer)) ((sat08 :integer)) 
  ((sat09 :integer)) ((sat10 :integer)) ((sat11 :integer)) ((sat12 :integer))
  ((dilution :float))
  ((hor-dilution :float))
  ((ver-dilution :float)))

(defnmeassage $gpgsv
    ((number-of-messages :integer))
  ((message-number :integer))
  ((sats-in-view :integer))
  ((sat1 :integer))
  ((elevation1 :integer))
  ((azimuth1 :integer))
  ((snr1 :integer))
  ((sat2 :integer))
  ((elevation2 :integer))
  ((azimuth2 :integer))
  ((snr2 :integer))
  ((sat3 :integer))
  ((elevation3 :integer))
  ((azimuth3 :integer))
  ((snr3 :integer))
  ((sat4 :integer))
  ((elevation4 :integer))
  ((azimuth4 :integer))
  ((snr4 :integer)))
     
(defmethod process-nmeassage ((message $gprmc))
  (with-slots 
	(hours minutes seconds status lat-deg lat-min lat-dir lon-deg lon-min 
	       lon-dir speed course day month year decl decl-dir mode) message
    (format t "~{~a~%~}" 
	    (mapcar #'(lambda (a b) (cons a b))
		    '(hours minutes seconds status lat-deg lat-min lat-dir lon-deg lon-min lon-dir speed course day month year decl decl-dir mode)
		    (list hours minutes seconds status lat-deg lat-min lat-dir lon-deg lon-min lon-dir speed course day month year decl decl-dir mode)))))

(defun process-nmea (str)
  (if (> (length str) 3)
      (let ((nmea (cl-ppcre:split "[,*]" str))
	    (cs (apply #'logxor 
		       (map 'list #'char-code 
			    (subseq str 1 (- (length str) 3))))))
	(if (not (= cs (parse-integer (car (last nmea)) :radix 16)))
	    (error "Wrong NMEA checksum"))
	(let ((cl (find (car nmea)
			(c2mop:class-direct-subclasses (find-class 'nmeassage))
			:key #'(lambda (c) (symbol-name (class-name c)))
			:test #'string=)))
	  (if cl (process-nmeassage 
		  (init-nmeassage-from-lst 
		   (make-instance cl) (cdr (butlast nmea)))))))))