diff options
Diffstat (limited to 'ebus-racket')
| -rw-r--r-- | ebus-racket/db.rkt | 21 | ||||
| -rw-r--r-- | ebus-racket/layer2.rkt | 127 | ||||
| -rw-r--r-- | ebus-racket/layer7.rkt | 123 |
3 files changed, 141 insertions, 130 deletions
diff --git a/ebus-racket/db.rkt b/ebus-racket/db.rkt index 14817e5..9ebdfa9 100644 --- a/ebus-racket/db.rkt +++ b/ebus-racket/db.rkt @@ -22,16 +22,19 @@ ;; Get ID of sensor given by sensor-name ;; define sensor if needed (define (sensor-id sensor-name) - (let ([id (get-sensor-id sensor-name)]) - (cond ((void? id) (create-sensor-id sensor-id)) - (else id)))) + (define id (get-sensor-id sensor-name)) + (cond ((void? id) (create-sensor-id sensor-id)) + (else id))) (define (insert sensor-name value-float value-int value-string) - (let ([sensor-id (sensor-id sensor-name)] - [type (cond ((not (void? value-string)) "string") + (define sensor-id (sensor-id sensor-name)) + (define type (cond ((not (void? value-string)) "string") ((not (void? value-float)) "float") - ((not (void? value-int)) "int"))]) - (db:query-exec (string-append "INSERT INTO value(timestamp, sensor_id, type, value_float, value_int, value_string) " - "VALUES (now(), $1, $2, $3, $4, $5)") - sensor-id type value-float value-int value-string))) + ((not (void? value-int)) "int"))) + (db:query-exec (string-append "INSERT INTO value(timestamp, sensor_id, type, value_float, value_int, value_string) " + "VALUES (now(), $1, $2, $3, $4, $5)") + sensor-id type value-float value-int value-string)) + +(provide + (prefix-out db- insert)) diff --git a/ebus-racket/layer2.rkt b/ebus-racket/layer2.rkt index 42d50b3..e0f9fbd 100644 --- a/ebus-racket/layer2.rkt +++ b/ebus-racket/layer2.rkt @@ -24,49 +24,54 @@ #:transparent) ;; single, maybe escaped, payload data byte -(define ebus-payload (choice (seq escape-seq <- ebus-const-escape - escape-code <- (byte-in (list 0 1)) - (return (cond - ((= escape-code 0) ebus-const-escape) - ((= escape-code 1) bytes ebus-const-syn)))) - any-byte - )) - -(define parse-ebus-broadcast (token (seq crc <- any-byte - syn <- ebus-const-syn - (return (ebus-body-broadcast crc))))) - -(define parse-ebus-mastermaster (token (seq crc <- any-byte - ack <- ebus-const-ackok ;; ACK des Empfängers - syn <- ebus-const-syn ;; SYN des Senders - (return (ebus-body-mastermaster crc))))) - -(define parse-ebus-masterslave (token (seq crc <- any-byte - ack <- ebus-const-ackok ;; ACK des Empfängers - payloadSlaveLength <- any-byte - payloadSlave <- (repeat ebus-payload payloadSlaveLength payloadSlaveLength) - crcSlave <- any-byte - ackSlave <- ebus-const-ackok ;; ACK des Senders - synSlave <- ebus-const-syn ;; SYN des Senders - (return (ebus-body-masterslave crc payloadSlaveLength payloadSlave crcSlave))))) +(define ebus-payload + (choice (seq escape-seq <- ebus-const-escape + escape-code <- (byte-in (list 0 1)) + (return (cond + ((= escape-code 0) ebus-const-escape) + ((= escape-code 1) bytes ebus-const-syn)))) + any-byte + )) + +(define parse-ebus-broadcast + (token (seq crc <- any-byte + syn <- ebus-const-syn + (return (ebus-body-broadcast crc))))) + +(define parse-ebus-mastermaster + (token (seq crc <- any-byte + ack <- ebus-const-ackok ;; ACK des Empfängers + syn <- ebus-const-syn ;; SYN des Senders + (return (ebus-body-mastermaster crc))))) + +(define parse-ebus-masterslave + (token (seq crc <- any-byte + ack <- ebus-const-ackok ;; ACK des Empfängers + payloadSlaveLength <- any-byte + payloadSlave <- (repeat ebus-payload payloadSlaveLength payloadSlaveLength) + crcSlave <- any-byte + ackSlave <- ebus-const-ackok ;; ACK des Senders + synSlave <- ebus-const-syn ;; SYN des Senders + (return (ebus-body-masterslave crc payloadSlaveLength payloadSlave crcSlave))))) (define parse-ebus-master-or-slave (token (choice parse-ebus-mastermaster parse-ebus-masterslave))) -(define parse-ebus-paket (token (seq source <- any-byte - destination <- any-byte - primaryCommand <- any-byte - secondaryCommand <- any-byte - payloadLength <- any-byte - payload <- (repeat ebus-payload payloadLength payloadLength) - body <- (cond ((= destination ebus-const-broadcastaddr) parse-ebus-broadcast) - (else parse-ebus-master-or-slave)) - (return (ebus-paket source - destination - primaryCommand - secondaryCommand - payloadLength - payload - body))))) +(define parse-ebus-paket + (token (seq source <- any-byte + destination <- any-byte + primaryCommand <- any-byte + secondaryCommand <- any-byte + payloadLength <- any-byte + payload <- (repeat ebus-payload payloadLength payloadLength) + body <- (cond ((= destination ebus-const-broadcastaddr) parse-ebus-broadcast) + (else parse-ebus-master-or-slave)) + (return (ebus-paket source + destination + primaryCommand + secondaryCommand + payloadLength + payload + body))))) (define ebus-sync (tokens syncs <- (seq (repeat (string->bytes/latin-1 "\xaa"))) (return (length syncs)))) @@ -75,23 +80,25 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (read-ebus input-port) - (let ([syn ((make-reader ebus-sync #:sof? #f #:eof? #f) input-port)] - [paket ((make-reader parse-ebus-paket #:sof? #f #:eof? #f) input-port)]) - (cond ((not (false? syn)) - (display (format "drop ~s x SYN (~s) ~n" syn ebus-const-syn)))) - (cond ((not (false? paket)) - paket) - ((eof-object? (peek-byte input-port)) - eof) - (else - (let ([byte (read-byte input-port)]) - (display (format "drop ~s 0x~x ~n" byte byte))) - ;; skip one byte - (read-byte input-port) - (read-ebus input-port))))) - -(provide (prefix-out layer2- read-ebus) - (prefix-out layer2- (struct-out ebus-paket)) - (prefix-out layer2- (struct-out ebus-body-broadcast)) - (prefix-out layer2- (struct-out ebus-body-mastermaster)) - (prefix-out layre2- (struct-out ebus-body-masterslave))) + (define syn ((make-reader ebus-sync #:sof? #f #:eof? #f) input-port)) + (define paket ((make-reader parse-ebus-paket #:sof? #f #:eof? #f) input-port)) + (cond ((not (false? syn)) + (display (format "drop ~s x SYN (~s) ~n" syn ebus-const-syn)))) + (cond ((not (false? paket)) + paket) + ((eof-object? (peek-byte input-port)) + eof) + (else + (let ([byte (read-byte input-port)]) + (display (format "drop ~s 0x~x ~n" byte byte))) + ;; skip one byte + (read-byte input-port) + (read-ebus input-port)))) + +(provide + ;; Read Layer Ebus-Paket `ebus-paket` + (prefix-out layer2- read-ebus) + (prefix-out layer2- (struct-out ebus-paket)) + (prefix-out layer2- (struct-out ebus-body-broadcast)) + (prefix-out layer2- (struct-out ebus-body-mastermaster)) + (prefix-out layer2- (struct-out ebus-body-masterslave))) diff --git a/ebus-racket/layer7.rkt b/ebus-racket/layer7.rkt index 5cb4477..95739e6 100644 --- a/ebus-racket/layer7.rkt +++ b/ebus-racket/layer7.rkt @@ -10,11 +10,11 @@ (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))) + (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) @@ -27,55 +27,55 @@ (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-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) + (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=? "byteEnum" datatype) - (list name datatype offset - (field-decoder-byteEnum (list-ref payload offset) field))) - (else (display (string-append "unknown datatype: " datatype "\n")) - (void))))) + ((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) @@ -119,13 +119,13 @@ (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)]) + (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))))] - [options (filter pred all-options)]) - (cond ((= (length options) 1) - (list-ref (first options) 1)) - (else "<undefined>")))) + (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) @@ -140,13 +140,14 @@ ;; 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)))) + (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))
\ No newline at end of file |