summaryrefslogtreecommitdiff
path: root/ebus-racket/layer7.rkt
diff options
context:
space:
mode:
Diffstat (limited to 'ebus-racket/layer7.rkt')
-rw-r--r--ebus-racket/layer7.rkt158
1 files changed, 0 insertions, 158 deletions
diff --git a/ebus-racket/layer7.rkt b/ebus-racket/layer7.rkt
deleted file mode 100644
index b335ddc..0000000
--- a/ebus-racket/layer7.rkt
+++ /dev/null
@@ -1,158 +0,0 @@
-#lang racket/base
-(require racket/list
- (planet lizorkin/sxml:2:1/sxml)
- (planet lizorkin/ssax:2:0/ssax)
- "layer2.rkt")
-
-(define logger (make-logger 'ebus-layer7 (current-logger)))
-
-(define definition
- (ssax:xml->sxml (open-input-file "../ebus-xml/ebus.xml")
- '[(#f . "http://xapek.org/ebus/0.1")]))
-
-(define (paket ebus-paket)
- (define primaryCommand (layer2-ebus-paket-primaryCommand ebus-paket))
- (define 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)
- (first ((sxpath "@name/text()") (device address))))
-
-
-(define (paket-fields ebus-paket)
- (define paket-definition (paket ebus-paket))
- (cond ((> (length paket-definition) 0)
- (let*
- ([paket-name (string-append
- (device-name (layer2-ebus-paket-source ebus-paket))
- "."
- (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 (void (log-message logger 'warning (format "Unknown Paket: ~s" ebus-paket) #t)))))
-
-(define (paket-fields-dispatch-decoder ebus-paket field paket-name)
- (define datatype ((sxpath "name()") field))
- (define name (string-append paket-name "." (first ((sxpath "@name/text()") field))))
- (define offset (string->number (first ((sxpath "@offset/text()") field))))
- (define 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 (void (log-message logger 'error (format "unknown datatype: ~a" datatype) #t)))))
-
-;; 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
- (/
- (+ (arithmetic-shift (u-not highByte) 4)
- (u-not (highNibble lowByte))
- (+ (u-not (lowNibble lowByte)) 1))
- 16.0))
- (+ (* 16 highByte)
- (arithmetic-shift lowByte -4)
- (/ (lowNibble lowByte) 16))))
-
-;; type byteEnum
-(define (field-decoder-byteEnum value field-definition)
- (define (pred l)
- (= value (list-ref l 0)))
- (define all-options (for/list ([option ((sxpath "option") field-definition)])
- (list (string->number (first ((sxpath "@value/text()") option))) ;; value, name
- (first ((sxpath "@name/text()") option)))))
- (define 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)
- (define 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)
- ;; read ebus from port an return fields from next paket
- (prefix-out layer7- read-ebus)
- (prefix-out layer7- logger)) \ No newline at end of file