#lang racket/base
(require racket/list
         (planet lizorkin/sxml:2:1/sxml)
         (planet lizorkin/ssax:2:0/ssax)
         "layer2.rkt")

(define definition
  (ssax:xml->sxml (open-input-file "../ebus-xml/ebus.xml")
                  '[(#f . "http://xapek.org/ebus/0.1")]))


(define (paket ebus-paket)
  (let ([primaryCommand (layer2-ebus-paket-primaryCommand ebus-paket)]
        [secondaryCommand (layer2-ebus-paket-secondaryCommand ebus-paket)])
    ((sxpath (string-append "//packet[@primary=" (number->string primaryCommand)
                            " and @secondary=" (number->string secondaryCommand) "]"))
     definition)))

;; returns the full device-definition
(define (device address)
  ((sxpath (string-append "//devices/device[@address=" (number->string address) "]"))
   definition))

;; returns device-name in a list or empty-list
(define (device-name address)
  ((sxpath "@name/text()") (device address)))


(define (paket-fields ebus-paket)
  (let ([paket-definition (paket ebus-paket)])
    (cond ((> (length paket-definition) 0)
	   (let* 
	       ([paket-name (first ((sxpath "@name/text()") paket-definition))]
		[fields ((sxpath "fields/*") paket-definition)]
		[values 
		 (for/list ([field fields]) (paket-fields-dispatch-decoder ebus-paket field paket-name))])
	     ;; filter invalid values
	     (for/list ([value values] #:when (not (void? value)))
		       value)))
	  (else (display (format "Unknown Paket: ~s~n" ebus-paket))
		(void)))))

(define (paket-fields-dispatch-decoder ebus-paket field paket-name)
  (let ([datatype ((sxpath "name()") field)]
	[name (string-append paket-name "." (first ((sxpath "@name/text()") field)))]
	[offset (string->number (first ((sxpath "@offset/text()") field)))]
	[payload (layer2-ebus-paket-payload ebus-paket)])
    (cond ((string=? "bit" datatype)
	   (list name datatype offset
		 (field-decoder-bit (list-ref payload offset))))
	  ((string=? "bcd" datatype)
	   (list name datatype offset
		 (field-decoder-bcd (list-ref payload offset))))
	  ((string=? "data1b" datatype)
	   (list name datatype offset
		 (field-decoder-data1b (list-ref payload offset))))
	  ((string=? "data1c" datatype)
	   (list name datatype offset
		 (field-decoder-data1c (list-ref (layer2-ebus-paket-payload ebus-paket) offset))))
	  ((string=? "byte" datatype)
	   (list name datatype offset (list-ref payload offset)))
	  ((string=? "data2b" datatype)
	   (list name datatype offset
		 (field-decoder-data2b (list-ref payload offset)
				       (list-ref payload (+ offset 1)))))
	  ((string=? "data2c" datatype)
	   (list name datatype offset
		 (field-decoder-data2c (list-ref payload offset)
				       (list-ref payload (+ offset 1)))))
	  ((string=? "word" datatype)
	   (list name datatype offset
		 (field-decoder-word (list-ref payload offset)
				     (list-ref payload (+ offset 1)))))
	  ((string=? "byteEnum" datatype)
	   (list name datatype offset
		 (field-decoder-byteEnum (list-ref payload offset) field)))
	  (else (display (string-append "unknown datatype: " datatype "\n"))
		(void)))))

;; type bit
(define (field-decoder-bit value)
  (cond ((= value 1) 1)
        (else 0)))

;; type data1b
(define (field-decoder-data1b value)
  value)

;; type data1c
(define (field-decoder-data1c value)
  (/ value 2.0))

;; type data2b
(define (field-decoder-data2b lowByte highByte)
  (if (= (bitwise-and highByte 128) 128)
      (* -1 
	 (+ (+ 256 (bitwise-not highByte))
	    (/ (+ 256 (bitwise-not (+ lowByte 1))) 256.0)))
      (+ highByte (/ lowByte 256.0))))

;; type data2c
(define (field-decoder-data2c lowByte highByte)
  (define (lowNibble v)
    (bitwise-and v #x0f))
  (define (highNibble v)
    (arithmetic-shift v -4))
  (define (u-not v)
    (+ 256 (bitwise-not v)))
  (if (= (bitwise-and highByte 128) 128)
      (* -1
	 (+ (* 16 (u-not highByte))
	    (highNibble (u-not lowByte))
	    (/ (lowNibble (u-not lowByte) 16))))
      (+ (* 16 (u-not highByte))
	 (highNibble lowByte)
	 (/ (lowNibble lowByte) 16))))

;; type byteEnum
(define (field-decoder-byteEnum value field-definition)
  (define (pred l)
    (= value (list-ref l 0)))
  (let* ([all-options (for/list ([option ((sxpath "option") field-definition)])
				(list (string->number (first ((sxpath "@value/text()") option))) ;; value, name
				      (first ((sxpath "@name/text()") option))))]
	 [options (filter pred all-options)])
    (cond ((= (length options) 1)
	   (list-ref (first options) 1))
	  (else "<undefined>"))))

;; type word
(define (field-decoder-word lowByte highByte)
  (+ lowByte
     (arithmetic-shift highByte 8)))

;; type bcd
(define (field-decoder-bcd value)
  (+ (bitwise-and value #x0f)
     (arithmetic-shift value -4)))
  
;; read one ebus-paket or eof from input-port
;; or return #<eof>
(define (read-ebus input-port)
  (let* ([paket (layer2-read-ebus input-port)])
    (cond ((layer2-ebus-paket? paket)
	   (paket-fields paket))
	  (else paket))))

(provide (prefix-out layer7- paket)
         (prefix-out layer7- paket-fields)
         (prefix-out layer7- device)
         (prefix-out layer7- device-name)
	 (prefix-out layer7- read-ebus))