Code Body

To use this file copy and paste this: // #URL-lib "http://pin1.org/forthlib/flb/Miscl/HA Interface v1.0.fth" into BV Terminal 3 or here to download.

// Home Automation Project // S. Clarkson // 03-Feb-2009 //

// REQUIRES: // #URL-lib "http://pin1.org/forthlib/flb/General/soft1.flb" sid=99 // #URL-lib "http://pin1.org/forthlib/flb/General/pinsel.flb" sid=100

Full Contents of File

// Home Automation Project
// S. Clarkson
// 03-Feb-2009
//

// REQUIRES:
// #URL-lib "http://pin1.org/forthlib/flb/General/soft1.flb" sid=99
// #URL-lib "http://pin1.org/forthlib/flb/General/pinsel.flb" sid=100

// VARIABLES:
// INPUTS
v a r i a b l e I _k W h -p
v a r i a b l e I _a l m -s e t
v a r i a b l e I _i n t r u d e

// OUTPUTS
v a r i a b l e O _l e d

// Initialise the ports for use by the HA system

// Port configuration will be as follows:
//
// INPUTS
// P1.16 - KWh Pulse - 200 pulses = 1 KWh
// P1.17 - Alarm armed
// P1.18 - Alarm activated (intruder)
// P1.27 - Escape run loop (for debug)
//
// OUTPUTS
// P0.31 - Flash with kWh pulse trailing edge
//

// Word to initialise the I/O ports
: init-io
        1 6 i o 1 -i n
        1 7 i o 1 -i n
        1 8 i o 1 -i n
        2 7 i o 1 -i n
        2 8 i o 1 -i n

        3 1 i o 0 -o u t
;

// Words to implement the io scans
: scan-in
        // Scan inputs
        1 6 p 1 @ I _k w h -p !
        1 7 p 1 @ I _a l m -s e t !
        1 8 p 1 @ I _i n t r u d e !
;

: wr-out
        // Write outputs

        O _l e d @ 3 1 p 0 !
;

// ---------------------------------------------------------

// Below are the user logic sections

v a r i a b l e k W
v a r i a b l e k w h
v a r i a b l e k w h -1 0 0 0 t h
v a r i a b l e o s f
v a r i a b l e a 1
v a r i a b l e p r
v a r i a b l e b p o s
v a r i a b l e p r e v -c
v a r i a b l e i n p k t // True when an STX has been received but no ETX yet
v a r i a b l e A d d r e s s // our bus address - configured in sys-init

// Comms constants and variables
2 c o n s t a n t S T X
6 c o n s t a n t A C K
2 1 c o n s t a n t N A K
3 c o n s t a n t E T X
1 6 c o n s t a n t D L E
1 c o n s t a n t S O H
2 7 c o n s t a n t E S C

// Packet constants
2 0 c o n s t a n t S Y N C -C L K
2 1 c o n s t a n t R Q -K W H
2 2 c o n s t a n t S D -K W H
2 3 c o n s t a n t R Q -W
2 4 c o n s t a n t S D -W

2 0 c o n s t a n t B L E N

B L E N v s p a c e $ d -b u f f // data goes here
B L E N v s p a c e $ s -b u f f // send data goes here

: inpkt?
        i n p k t @ 0 <>
;

: c-buf
        // Empty internal buffer
        0 b p o s !
        B L E N f o r 0 i d -b u f f + c ! n e x t
        0 i n p k t !
;

: dump-buf
I N T: k
        // Clear the h/w input buffer, if we get an ETX with no preceding ESC, stop
        0 => k
        b e g i n
                k e y 1 ? k E T X <> a n d
        w h i l e
                k e y 1 => k
                p r e v -c @ E S C = i f 0 => k t h e n // If previous key was esc, throw away this key
                k p r e v -c !
        r e p e a t

        // Empty local buffer too
        c -b u f
        0 p r e v -c !
;

// Wait for an STX character that was not preceded with ESC
: stx?
        -1 // if we are already inside packet processing, send true
        i n p k t ? 0 = i f
                d r o p
                0
                k e y 1 ? i f
                        // Key on the serial input buffer
                        d r o p
                        p r e v -c @ E S C <> // Get previous key and store true if not escape
                        k e y 1 d u p p r e v -c ! // Store as previous key
                        S T X = a n d // True if received STX and previous was not escape char
                        d u p i f -1 i n p k t ! t h e n // Set flag to indicate that we are processing a packet
                t h e n
        t h e n
;

: get-buf
        // Get characters from serial buffer, return -1 after an ETX has been received
        // Characters are added to the buffer until either it is full or we get an ETX
        -2 // Will return -2 if the buffer is full
        b p o s @ B L E N < i f
                d r o p
                -3 // Will return -3 if no keys on serial port
                k e y 1 ? i f
                        d r o p
                        p r e v -c @ E S C <> // Do check for preceding esc
                        k e y 1 d u p p r e v -c ! // Get character and store as previous char
                        d u p E S C <> i f // Don't store escape chars
                                d u p d -b u f f b p o s @ + c ! // Store character
                                b p o s @ 1 + b p o s ! // Increment buffer pointer
                        t h e n
                        E T X = a n d // Return true if ETX without ESC preceding
                t h e n
        t h e n
;

: getall
        // Get as many characters as are available on the port
        b e g i n
                g e t -b u f d u p 0 =
        w h i l e
                d r o p
        r e p e a t
;

: send-data
        k w h @ i u .
        4 6 e m i t 1
        k w h -1 0 0 0 t h @ i u .
        3 2 e m i t 1
        k w @ i u .
        8 7 e m i t 1
        1 3 e m i t 1
        1 0 e m i t 1
        1 0 e m i t 1
;

: send-nak
        N A K e m i t 1
;

: send-ack
        A C K e m i t 1
;

: chk-len?
        // Check packet length is at least minimum
i n t: l e n
        -1
        b p o s @ 6 < i f
                d r o p
                s e n d -n a k
                0
        t h e n

        // Now check that packet length matches declared length
        d -b u f f 3 + c @ => l e n // declared data length (bytes)
        b p o s @ 6 l e n + <> i f
                // Packet different than declared
                d r o p
                s e n d -n a k
                0
        t h e n

        // length is OK
;

: !sync-clk { src }
        s e n d -a c k
;

: !send-kwh { src }
        s e n d -a c k
        S T X e m i t 1
        A d d r e s s @ e m i t 1
        s r c e m i t 1
        S D -K W H e m i t 1
        9 e m i t 1
        k w h @ <# # # # # # #> s t y p e 1
        4 6 e m i t 1
        k w h -1 0 0 0 t h @ <# # # # #> s t y p e 1
        0 e m i t 1 // CRC omitted for now
        E T X e m i t 1
;

: !send-w { src }
        s e n d -a c k
        S T X e m i t 1
        A d d r e s s @ e m i t 1
        s r c e m i t 1
        S D -W e m i t 1
        5 e m i t 1
        k w @ <# # # # # # #> s t y p e 1
        0 e m i t 1 // CRC omitted for now
        E T X e m i t 1
;

: do-pkt
        // Decode the received packet and respond accordingly
i n t: s r c c m d l e n c r c

        // Minimum packet length is 6 characters. If this is less than that, send a NAK
        c h k -l e n ? i f
                // Packet basic length check OK
                // Break up packet
                d -b u f f c @ => s r c
                d -b u f f 2 + c @ => c m d
                d -b u f f 3 + c @ => l e n
                d -b u f f 4 l e n + + c @ => c r c

                // Add CRC check later!

                // Process command
                c m d S Y N C -C L K = i f
                        // Synchronise RTC to source
                        s r c !s y n c -c l k
                t h e n

                c m d R Q -K W H = i f
                        // Send KWH
                        s r c !s e n d -k w h
                        0 k w h ! 0 k w h -1 0 0 0 t h !
                t h e n

                c m d R Q -W = i f
                        // Send W
                        s r c !s e n d -w
                t h e n
        t h e n
;

: parse-pkt { p-status --- Status from get-buff}
        // Determine if this packet is for us and if so is it valid, if it is process it
i n t #: o u r m s g 0 // true if message addressed to us

        p -s t a t u s -3 <> i f
                // Packet is complete or buffer is full, we need to check

                // Check if addressed to us
                b p o s 1 > i f
                        // See if we are addressed (buffer + 1 since we don't store the STX)
                        d -b u f f 1 + c @ A d d r e s s @ = => o u r m s g
                t h e n

                p -s t a t u s -2 = i f
                        // Buffer is full, we need to clear our receive
                        // buffer and send a NAK if addressed to us
                        d u m p -b u f
                        o u r m s g i f s e n d -n a k t h e n
                t h e n

                p -s t a t u s -1 = i f
                        // We have a complete packet -
                        // or at least one that ended with ETX
                        // Is this for us?
                        o u r m s g i f
                                d o -p k t
                        t h e n
                        // dump our buffer
                        c -b u f
                t h e n
        t h e n
;

: do-comms
// Handle bus comms

        // Don't do anything before we get a non escaped STX
        s t x ? i f
                // While we have an stx, get all the data
                // from the packet and parse it when complete
                g e t a l l p a r s e -p k t
        t h e n

;

: 1st-scan
        // This word will be executed on the first program
        // scan only


        1 0 0 0 s e t -t 1
        1 5 0 0 s e t -t 2
        7 0 0 s e t -t 3
        1 8 0 0 0 0 0 0 0 s e t -t 4 // for calculating Kw load
        1 O _l e d !

        0 k W !
        0 k w h !
        0 k w h -1 0 0 0 t h !        // reset kwh pulse counter

        0 o s f !
;

// Logic loop
: ob1
        // This word is called on every program scan

        // Reset t4 when done (this would be <= 1W usage)
        t 4 -d n 0 = i f e n -t 4 t h e n

        // Debounce falling edge
        o s f @ 1 = I _k w h -p @ 0 <> a n d i f
                e n -t 2
        t h e n

        o s f @ 1 = t 2 -d n a n d i f
                // Ensure one shot
                0 o s f !

                // i.e. pulse off (logic true) and timer done
                5 k w h -1 0 0 0 t h @ + k w h -1 0 0 0 t h !

                // Check for roll into kwh
                k w h -1 0 0 0 t h @ 9 9 9 > i f
                        0 k w h -1 0 0 0 t h !
                        1 k w h @ + k w h !
                t h e n

                // If kw, kwh-1000th and kwh zero ignore
                k w h @ 0 <> k w h -1 0 0 0 t h @ 0 <> o r i f
                        // Calculate instant Kw usage (actually Watts)
                        t 4 p r e @ d u p t 4 a c c @ - / kw !
                        // Reset kW timer
                        t 4 p r e @ t 4 a c c !
                t h e n

                1 p r !
        t h e n

        I _k w h -p @ 0 = i f
                e n -t 1
        t h e n // Run debounce timer while ip on

        // Store flag - debounce on done
        t 1 -d n i f
                1 o s f !
        t h e n

        // Flash led for n ms (t3)

        // while timer done, run the off debounce
        t 2 -d n t 3 -t t o r i f
                e n -t 3
        t h e n

        1 O _l e d !
        t 3 -t t i f
                0 O _l e d !
        t h e n

;

// Test mode logic
: ob1-test

        // Reflect sensor input to on board led for tuning
        I _k w h -p @ O _l e d !
;

// ----------------------------------------------------------
// END OF USER LOGIC
// ----------------------------------------------------------

: sys-init

        i n i t -i o

        6 5 A d d r e s s !
        c -b u f // Initialise the comms by clearing the internal buffer

        1 s t -s c a n

        t -i n i t
;

// ---------------------------------------------------------

// Main program loop

: sgl-step
// Main program loop here
                s c a n -i n
                o b 1
                w r -o u t
                d o -c o m m s

                // Timer status handling
                T S T A T S
;

: test-m
// Test program loop here
                s c a n -i n
                o b 1 -t e s t
                w r -o u t
                d o -c o m m s

                // Timer status handling
                T S T A T S
;

// Initialise system, then loop through the
: run

// Initialise io & timers
        s y s -i n i t

        // 1000 ms

        b e g i n
                2 7 p 1 @ -1 =
        w h i l e
                // Normal running
                2 8 p 1 @ -1 = i f
                        s g l -s t e p
                t h e n

                // Setup mode
                2 8 p 1 @ 0 = i f
                        t e s t -m
                t h e n

        r e p e a t

        d r o p d r o p

        // Clear all outputs

        1 O _l e d !

        // Final output cycle
        w r -o u t
;