roboforum.ru

\ chu (vum@eml.ru) 19:00 16.01.2014
\ =====================================================================
\
\ rf 2.4 GHz band scanner
\ http://maniacbug.github.io/RF24/scanner_8pde-example.html

  marker =rf-scanner=

  &128 constant rf24-channels

  here rf24-channels cells allot constant bands

  : 0bands bands rf24-channels cells 0 fill ;

  : 1+! ( a -- ) dup @ 1+ swap ! ;   \ инкремент переменной, представленной адресом a

  : scan-rf  ( n --- )  \ n = количество проверок

    0bands
    radio-pw? 0= if radio-on then nRF24_CE  low

    0 ?do
        rf24-channels 0
        do i radio-ch!
             radio-rx+       
           \ see 6.4 of nRF24L01+ Product Specification v1.0
           [ 40 us/ ] literal
             ?delay

             nRF24_CE low   \ standby-I
             cd?   if bands i cells + 1+! then
        loop
      loop
    radio-off
    ;

  : scan-rf.
    0  \ total channels
    bands rf24-channels 0
    do
      i cells over + @
      ?dup if i 3 u0.r $3a emit     \ number&colon
              0 do $2a emit loop cr \ star bar
              swap 1+ swap          \ total count
           then
    loop
    drop
    ." total: " base @ swap decimal . base !
    ." channels" cr
    ;

  : scanrf ( n --- )
    ." start scanning @ " ?time. scan-rf
    ." stop  scanning @ " ?time. scan-rf.
    ;

\
\ nRF24_init regular twi.init
\ ~~~~~~~~~~eof~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
\
\ occupy 216 cells
\

amforth 5.2 ATmega32A 16000 kHz
reset source= 5

> regular twi.init
ok
> nRF24_init
ok
> decimal
ok
> 200 scanrf
start scanning @ 6.22.03.2014 10:11:07
stop  scanning @ 6.22.03.2014 10:12:19
029:**
030:***
032:*
045:****
046:**
047:**
048:*
049:*****
050:******
051:****
052:****
053:********
054:********
055:****
056:****
057:*
058:**
059:***
060:*
064:*
total: 20 channels
ok
> ?nrf24.

CONFIG..........00001001
EN_AA...........00111111
EN_RXADDR.......00000011
SETUP_AW........00000011
SETUP_RETR......00000011
RF_CH...........01111111
RF_SETUP........00001111
STATUS..........00001110
OBSERVE_TX......00000000
CD..............00000000
RX_ADDR_P0......E7 E7 E7 E7 E7
RX_ADDR_P1......C2 C2 C2 C2 C2
RX_ADDR_P2......C3
RX_ADDR_P3......C4
RX_ADDR_P4......C5
RX_ADDR_P5......C6
TX_ADDR.........E7 E7 E7 E7 E7
RX_PW_P0........0
RX_PW_P1........0
RX_PW_P2........0
RX_PW_P3........0
RX_PW_P4........0
RX_PW_P5........0
FIFO_STATUS.....00010001
DYNPD...........00000000
FEATURE.........00000000
ok
>

\
\ sim900.f
\ ~ilya
\ 12.02.2014
\ SIM900_TXD - PH0
\ SIM900_RXD - PH1
\ SIM900_RST - PL2
\ SIM900_PWR - PL3


\ ...... ............ .............. .. sim900 ........ ............ .. ........ "AT"

marker =sim900=
\ USART2
&214 constant UDR2   \ USART I/O Data Register
&208 constant UCSR2A   \ USART Control and Status Register A
  $80 constant UCSR2A_RXC2 \ USART Receive Complete
  $40 constant UCSR2A_TXC2 \ USART Transmitt Complete
  $20 constant UCSR2A_UDRE2 \ USART Data Register Empty
  $10 constant UCSR2A_FE2 \ Framing Error
  $08 constant UCSR2A_DOR2 \ Data overRun
  $04 constant UCSR2A_UPE2 \ Parity Error
  $02 constant UCSR2A_U2X2 \ Double the USART transmission speed
  $01 constant UCSR2A_MPCM2 \ Multi-processor Communication Mode
&209 constant UCSR2B   \ USART Control and Status Register B
  $80 constant UCSR2B_RXCIE2 \ RX Complete Interrupt Enable
  $40 constant UCSR2B_TXCIE2 \ TX Complete Interrupt Enable
  $20 constant UCSR2B_UDRIE2 \ USART Data register Empty Interrupt Enable
  $10 constant UCSR2B_RXEN2 \ Receiver Enable
  $08 constant UCSR2B_TXEN2 \ Transmitter Enable
  $04 constant UCSR2B_UCSZ22 \ Character Size
  $02 constant UCSR2B_RXB82 \ Receive Data Bit 8
  $01 constant UCSR2B_TXB82 \ Transmit Data Bit 8
&210 constant UCSR2C   \ USART Control and Status Register C
  $C0 constant UCSR2C_UMSEL2 \ USART Mode Select
  $30 constant UCSR2C_UPM2 \ Parity Mode Bits
  $08 constant UCSR2C_USBS2 \ Stop Bit Select
  $06 constant UCSR2C_UCSZ2 \ Character Size
  $01 constant UCSR2C_UCPOL2 \ Clock Polarity
&212 constant UBRR2   \ USART Baud Rate Register  Bytes


&258 constant PORTH   \ PORT H Data Register
&267 constant PORTL   \ PORT L Data Register
250 constant rbufsize   \ ............ ............

PORTH 0 portpin: SIM900_RXD \
PORTH 1 portpin: SIM900_TXD \
PORTL 2 portpin: SIM900_RST \
PORTL 3 portpin: SIM900_PWR \

rbufsize buffer: rx-tx-buf
variable b-count

: sim900-init
SIM900_RXD pin_input
SIM900_TXD pin_output
SIM900_PWR pin_output
SIM900_RST pin_output
;

: usart2-init ( n -- )
(  &8) UBRR2 c!   \ ...... 16 ...... ................ 115200
UCSR2B_RXCIE2    \ .................... .... .................. ..............
UCSR2B_RXEN2    \ .......... .......
UCSR2B_TXEN2    \ ................ .......
or or UCSR2B c!
;

\ ................ ............ .. .......... .. ............
: b2begin rx-tx-buf rbufsize erase 0 b-count ! ;
\ ................ ........ .. ..........
: b2buf ( n -- ) rx-tx-buf b-count @ + c! ;
\ .................. ........ ........ .. ..........
: 1b-rcv
UDR2 c@
b-count @ rbufsize <
   if
      b2buf 1 b-count +!
   else
      b2begin \ .............. .......... .. .............. ........
      b2buf
   then
;
\ .................... ........ ........
: 1b-send 1000 0 do UCSR2A c@ UCSR2A_UDRE2 and if leave then  loop UDR2 c! ;

: cr-send $0d 1b-send $0a 1b-send ;


: s1 b2begin over + swap ?do i c@ 1b-send loop cr-send ;
: t1 rx-tx-buf b-count @ cr type ;

: test
b2begin
sim900-init
100 ms
SIM900_PWR high
['] 1b-rcv 102 int! +int
8 usart2-init
100 ms
SIM900_PWR low
1000 ms


;

: usart2-init ( n -- )
  ( &8) UBRR2 c!       \ При 16 МГц скорость 115200
        UCSR2B_RXCIE2  \ Прерывение по получению символа
        UCSR2B_RXEN2   \ Прием вкл.
        UCSR2B_TXEN2   \ Передача вкл.
        or or UCSR2B c!
  ;

: usart2-init ( n -- )
  ( &8) UBRR2 c!       \ При 16 МГц скорость 115200
      [ UCSR2B_RXCIE2  \ Прерывение по получению символа
        UCSR2B_RXEN2   \ Прием вкл.
        UCSR2B_TXEN2   \ Передача вкл.
        or or
      ] literal
        UCSR2B c!
  ;

  marker =nRF24L01+=

\ Pins

\  m328p
\  PORTD 4 portpin: nRF24_CE
\  PORTD 5 portpin: nRF24_CSN
\  PORTD 3 portpin: nRF24_IRQ     \ == INT1

\  m32A
  PORTC 2 portpin: nRF24_CE      \ Chip Enable Activates RX or TX mode
  PORTC 3 portpin: nRF24_CSN     \ SPI Chip Select
  PORTD 3 portpin: nRF24_IRQ     \ == INT1
\

\ ============================================================================
\
\  nRF24l01+  Register Map

$00 constant nRF24_CONFIG        \ Configuration Register
$01 constant nRF24_EN_AA         \ Enable ‘Auto Acknowledgment’
$02 constant nRF24_EN_RXADDR     \ Enabled RX Addresses
$03 constant nRF24_SETUP_AW      \ Setup of Address Widths (common for all data pipes)
$04 constant nRF24_SETUP_RETR    \ Setup of Automatic Retransmission
$05 constant nRF24_RF_CH         \ RF Channel
$06 constant nRF24_RF_SETUP      \ RF Setup Register
$07 constant nRF24_STATUS        \ Status Register (In parallel to the SPI command
\ word applied on the MOSIpin, the STATUSregister is shifted serially out on the MISOpin)

$08 constant nRF24_OBSERVE_TX    \ Transmit observe register
$09 constant nRF24_CD            \ Carrier Detect. See page 74

\ Data pipes
$0A constant nRF24_RX_ADDR_P0    \ 0xE7E7E7E7E7
$0B constant nRF24_RX_ADDR_P1    \ 0xC2C2C2C2C2
$0C constant nRF24_RX_ADDR_P2    \ 0xC3
$0D constant nRF24_RX_ADDR_P3    \ 0xC4
$0E constant nRF24_RX_ADDR_P4    \ 0xC5
$0F constant nRF24_RX_ADDR_P5    \ 0xC6

$10 constant nRF24_TX_ADDR       \ Transmit address.
\ Used for a PTX device only. (LSByte is written first)
\ Set RX_ADDR_P0 equal to this address to handle automatic acknowledge
\ if this is a PTX  device with Enhanced ShockBurst™ enabled. See page 65.


\ Number of bytes in RX payload in data pipe (1 to 32 bytes).
\ 0=Pipe not used
$11 constant nRF24_RX_PW_P0
$12 constant nRF24_RX_PW_P1
$13 constant nRF24_RX_PW_P2
$14 constant nRF24_RX_PW_P3
$15 constant nRF24_RX_PW_P4
$16 constant nRF24_RX_PW_P5

$17 constant nRF24_FIFO_STATUS   \ FIFO Status Register

$1C constant nRF24_DYNPD         \ Enable dynamic payload length
$1D constant nRF24_FEATURE       \ Feature Register

\ ========================================================================
\
\  nRF24L01+   commands

  $00 constant nRF24_REG@        \
  $20 constant nRF24_REG!        \
  $61 constant nRF24_RX_PLOAD@   \
  $a0 constant nRF24_TX_PLOAD!   \
  $e1 constant nRF24_FLUSH_TX    \
  $e2 constant nRF24_FLUSH_RX    \
  $e3 constant nRF24_REUSE_TX_PL \
  $ff constant nRF24_NOP         \

  $60 constant RX_PL_WID@        \
  $a1 constant ACK_PAYLOAD!      \ ( pipe --- )
  $b0 constant TX_PAYLOAD_NOACK! \

\ ========================================================================

\ ========================================================================
\
\  some nRF24l01+ registers fields & constants

: bit  ( n --- m )  $7 and 1 swap lshift ;

  nRF24_STATUS     $70 bitmask: nrf24_flags
  nRF24_CONFIG   1 bit bitmask: radio-pw
  nRF24_CONFIG   0 bit bitmask: radio-rx
  nRF24_RF_CH      $7f bitmask: radio-ch
  nRF24_RF_SETUP 5 bit 3 bit or
                       bitmask: air-rate
  nRF24_SETUP_RETR $0f bitmask: arc
  nRF24_SETUP_RETR $f0 bitmask: ard
  nRF24_OBSERVE_TX $f0 bitmask: plos_cnt
  nRF24_OBSERVE_TX $0f bitmask: arc_cnt
  nRF24_RX_PW_P0   $3f bitmask: rx_pw \ Number of bytes in RX payload in data pipe
\
\ ========================================================================

> 5 bit dup .x .b
20 00100000 ok
>

> nrf24_flags .x
7  ok
> .b
01110000 ok
> air-rate .x .b
6 00101000 ok
>

\ ========================================================================
\  base nRF24l01+ transactions over spi

  : nrf24?  ( -- n )        \ read nRF24L01+ STATUS

    nRF24_NOP
    nRF24_CSN low
    c!@spi
    nRF24_CSN high
    ;


  : nrf24@  ( ra -- c )    \ ra - адрес регистра nRF24, 1байт
          nRF24_REG@ or
          nRF24_CSN low
          spi! spi@
          nRF24_CSN high
          ;

  : nrf24!  ( c ra -- )
          nRF24_REG! or
          nRF24_CSN low
          spi! spi!
          nRF24_CSN high
          ;

  : nrf24-cmd! ( cmd --- )
    nRF24_CSN low  spi!
    nRF24_CSN high
    ;

  : nRF24_init
    nRF24_CSN over over pin_output high
    nRF24_CE  over over pin_output low
    +spi  0  spi-mode!
    nrf24_flags nrf24!
    ;
\

\
\ установка, сброс, проверка
\ отдельных битов в регистре r,
\ m - маска
   
  : #bit+  ( m r --- )  dup >r nrf24@ or r> nrf24! ;   
  : #bit-  ( m r --- )  >r invert r@ nrf24@ and r> nrf24! ;
  : #tst?  ( m r --- f )  nrf24@  and ;

\ установка группы бит с в битовом поле m в регистре r
  : #set+  ( c m r --- )
    dup  >r
    nrf24@
    over invert and
    >r   and
    r>   or  r>
    nrf24!
    ;

\ установка группы бит с в битовом поле m в регистре r
  : #set+  ( c m r --- )
    over invert over nrf24@ and
    >r -rot and
    r> or  swap nrf24!
    ;

\ =====================================================================
\
\   

  : radio-pw?  ( -- f )  radio-pw #tst? ; \ power on?
  : radio-off  ( -- )    radio-pw #bit- ; \ power off
  : radio-on   ( -- )    radio-pw #bit+ pause 5 ms ; \ power up set bit

  : radio-ch!  ( n -- )  radio-ch #set+ ;
  : radio-ch@  ( -- n )  radio-ch #tst? ;

  : radio-rx?  ( -- f )  radio-rx #tst? ; \ test if receiver

  : radio-rx+         \ RX mode
    radio-rx #bit+    \ PRIM_RX set 1
    nRF24_CE high
    [ &130 us/ ]      \ RX setting
     literal ?delay
    ;

  : radio-tx+         \ TX mode
    nRF24_CE low
    radio-rx #bit-    \ clear PRIM_RX
    ;                 \ standby-I

  : cd?  ( -- f )  [ 0 bit ] literal nRF24_CD #tst? ; \ RPD


\
\ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
\
\ Air data rate
\

  $0  constant 1Mbps
  $08 constant 2Mbps
  $20 constant 250Kbps

  : rf-rate! ( m -- )  air-rate #set+  ;
  : rf-rate@ ( -- m )  air-rate #tst?  ;

\
\ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
\
\ Automatic Retransmission
\

  : retx-delay!  ( n --- )  4 lshift  ard #set+ ;
  : retx-delay@  ( --- n )  ard #tst? 4 rshift  ;

  : retx-count!  ( n --- )  arc #set+ ;
  : retx-count@  ( --- n )  arc #tst? ;

\
\ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
\

\
\ nRF24L01+dumpreg.f
\ chu 17:15 01.03.2014
\
\ =====================================================================
\
\ Read & Display all nRF24L01+ registers
\

  marker =?nrf24.=

  : nRF24[@].  ( ra n --- )  \

       swap
       nRF24_REG@ or
       nRF24_CSN low spi!
       0 ?do spi@ .x loop
       nRF24_CSN high
       ;

  : ?nrf24.

base @ decimal
cr
." CONFIG.........." nRF24_CONFIG        nrf24@ .b cr \ Configuration Register
." EN_AA..........." nRF24_EN_AA         nrf24@ .b cr \ Enable ‘Auto Acknowledgment’
." EN_RXADDR......." nRF24_EN_RXADDR     nrf24@ .b cr \ Enabled RX Addresses
." SETUP_AW........" nRF24_SETUP_AW      nrf24@ .b cr \ Setup of Address Widths (common for all data pipes)
." SETUP_RETR......" nRF24_SETUP_RETR    nrf24@ .b cr \ Setup of Automatic Retransmission
." RF_CH..........." nRF24_RF_CH         nrf24@ .b cr \ RF Channel
." RF_SETUP........" nRF24_RF_SETUP      nrf24@ .b cr \ RF Setup Register
." STATUS.........." nRF24_STATUS        nrf24@ .b cr \ Status Register (In parallel to the SPI command
\ word applied on the MOSIpin, the STATUSregister is shifted serially out on the MISOpin)

." OBSERVE_TX......" nRF24_OBSERVE_TX    nrf24@ .b cr \ Transmit observe register
." CD.............." nRF24_CD            nrf24@ .b cr \ Carrier Detect. See page 74

\ Data pipes
." RX_ADDR_P0......" nRF24_RX_ADDR_P0  5 nRF24[@]. cr \ 0xE77735F0D3
." RX_ADDR_P1......" nRF24_RX_ADDR_P1  5 nRF24[@]. cr \ 0xC2C2C2C2C2
." RX_ADDR_P2......" nRF24_RX_ADDR_P2    nrf24@ .x cr \ 0xC3
." RX_ADDR_P3......" nRF24_RX_ADDR_P3    nrf24@ .x cr \ 0xC4
." RX_ADDR_P4......" nRF24_RX_ADDR_P4    nrf24@ .x cr \ 0xC5
." RX_ADDR_P5......" nRF24_RX_ADDR_P5    nrf24@ .x cr \ 0xC6

." TX_ADDR........." nRF24_TX_ADDR     5 nRF24[@]. cr     \ Transmit address.
\ Used for a PTX device only. (LSByte is written first)
\ Set RX_ADDR_P0 equal to this address to handle automatic acknowledge if this is a PTX
\ device with Enhanced ShockBurst™ enabled. See page 65.


\ Number of bytes in RX payload in data pipe (1 to 32 bytes). 0=Pipe not used
." RX_PW_P0........" nRF24_RX_PW_P0     nrf24@ .  cr
." RX_PW_P1........" nRF24_RX_PW_P1     nrf24@ .  cr
." RX_PW_P2........" nRF24_RX_PW_P2     nrf24@ .  cr
." RX_PW_P3........" nRF24_RX_PW_P3     nrf24@ .  cr
." RX_PW_P4........" nRF24_RX_PW_P4     nrf24@ .  cr
." RX_PW_P5........" nRF24_RX_PW_P5     nrf24@ .  cr

." FIFO_STATUS....." nRF24_FIFO_STATUS  nrf24@ .b cr \ FIFO Status Register

\ ." The DYNPD register is used to enable the dynamic payload feature on each Rx pipe."
." DYNPD..........." nRF24_DYNPD        nrf24@ .b cr \ Enable dynamic payload length
." FEATURE........." nRF24_FEATURE      nrf24@ .b cr \ Feature Register
base !
;

\
\ ====EOF========================================================================
\

\ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
\
\ nRF24_STATUS test

  \ Data pipe number for the payload available for reading from RX_FIFO
  \ 110: Not Used
  \ 111: RX FIFO Empty
  : rx-pipe? ( -- n )  nrf24? 1 rshift $7 and ; \ read only

  : tx-full? ( -- f )  nrf24? [ 0 bit ] literal  and ; \ read only

  : rx-data? ( -- f )  nrf24? [ 6 bit ] literal  and ; ( RX_DR  )
  : tx-sent? ( -- f )  nrf24? [ 5 bit ] literal  and ; ( TX_DS  )
  : rtx-max? ( -- f )  nrf24? [ 4 bit ] literal  and ; ( MAX_RT )

  : tx-end   ( -- f )  nrf24? [ 5 bit 4 bit or ] literal and ;

  : rx-done  ( -- ) [ 6 bit ] literal ( RX_DR  ) nRF24_STATUS #bit+ ;
  : tx-sent  ( -- ) [ 5 bit ] literal ( TX_DS  ) nRF24_STATUS #bit+ ;
  : rtx-fix  ( -- ) [ 4 bit ] literal ( MAX_RT ) nRF24_STATUS #bit+ ;


\ nRF24_FIFO_STATUS

  : rx-empty?  ( -- f ) [ 0 bit ] literal ( RX_EMPTY ) nRF24_FIFO_STATUS #tst? ;
  : tx-empty?  ( -- f ) [ 4 bit ] literal ( TX_EMPTY ) nRF24_FIFO_STATUS #tst? ;

\
\ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
\ nRF24_OBSERVE_TX

  : tx-lost?   ( --- n )  plos_cnt #tst? &4 rshift ;
  : rtx-count? ( --- n )  arc_cnt  #tst? ;

\
\ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

\
\ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
\
\ n==0..5

  : ?pipe  dup 0 6 within 0= abort" illegal pipe#"  ;

\ c==Number of bytes in RX payload in data pipe n1
  : pipe#?  ( n1 --- c )  ?pipe rx_pw rot + #tst? ;
  : pipe#!  ( c n1 --- )  ?pipe rx_pw rot + #set+ ;

\ Enabled RX Addresses

  : pipe    ( n --- m ra )  ?pipe bit nRF24_EN_RXADDR  ;

  : pipe+   ( n --- ) pipe #bit+ ; \ set
  : pipe-   ( n --- ) pipe #bit- ; \ clear
  : pipe?   ( n - f ) pipe #tst? ; \ test

\ Enable ‘Auto Acknowledgment’

  : auto-ack   ( n --- m ra )  ?pipe bit nRF24_EN_AA  ;

  : auto-ack+  ( n --- ) auto-ack #bit+ ;
  : auto-ack-  ( n --- ) auto-ack #bit- ;
  : auto-ack?  ( n - f ) auto-ack #tst? ;

\ Enable dynamic payload length

  : +dyn  [ 2 bit ] literal ( EN_DPL ) nRF24_FEATURE #bit+ ;
  : -dyn  [ 2 bit ] literal ( EN_DPL ) nRF24_FEATURE #bit- ;

  : dyn-pl    ( n --- m ra )  ?pipe bit nRF24_DYNPD  ;

  : dyn-pl+   ( n --- ) dyn-pl #bit+ ;
  : dyn-pl-   ( n --- ) dyn-pl #bit- ;
  : dyn-pl?   ( n - f ) dyn-pl #tst? ;

\
\ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

\ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
\
\ block transfers over spi

\
  : >spi  ( a c --- )  over + swap  ?do i c@ spi! loop  ;
  : <spi  ( a c --- )  over + swap  ?do spi@ i c! loop  ;


\ LSByte is first
  : <end  ( a c -- a1 c 0 )  dup -rot + swap 0 ;

  : spi<  ( a c --- )  <end ?do 1- dup  c@ spi! loop drop ;
  : spi>  ( a c --- )  <end ?do 1- spi@ over c! loop drop ;

\
\ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
\
\ radio transceiver  addresses maintenance

\ LSByte is written first
\ a=address c=count ra=register_address

  : addrs!  ( a c ra --- )
    nRF24_CSN  low
    nRF24_REG! or spi! spi<
    nRF24_CSN  high
    ;
\
  : addrs@  ( a c ra --- )
    nRF24_CSN  low
    nRF24_REG@ or spi! spi>
    nRF24_CSN  high
    ;

\
\ Setup of Address Widths (common for all data pipes)

  : addrs_w!  ( n --- )
    dup 3 6 within 0= abort" illegal address width"
    2 - nRF24_SETUP_AW nrf24!
    ;

  : addrs_w@  ( --- n )
    nRF24_SETUP_AW  nrf24@  &3 and 2 +
    ;

\
         0
         5 -- transmitter
         5 -- receiver0
         5 -- receiver1
         1 -- receiver2
         1 -- receiver3
         1 -- receiver4
         1 -- receiver5
  constant   /addresses

  here dup /addresses dup allot 0 fill constant radio

  : ?receiver ( a1 #pipe -- a2 )
    case
    0 of receiver0 endof
    1 of receiver1 endof
    2 of receiver2 endof
    3 of receiver3 endof
    4 of receiver4 endof
    5 of receiver5 endof
    endcase
    ;

  : ?addr_w   ( #pipe -- aw )
    case
    0 2 range of addrs_w@ endof
    2 6 range of 1        endof
    endcase
    ;

   
\ Transmit address. Used for a PTX device only.
\ LSByte is written first

  : tx-addr!  ( a c --- ) \ ram version
    addrs_w@ over = 0= abort" wrong transmitter address width "
    nRF24_TX_ADDR addrs!
    ;

  : tx-addr@   radio transmitter addrs_w@ nRF24_TX_ADDR addrs@ ;

  : tx?addr.
    tx-addr@
    radio transmitter addrs_w@ over over
    over + swap do i c@ .x loop 
    2 spaces ." == " type cr
    ;


\ Receive address data # pipe
\ LSByte is written first.
\ Write the number of bytes defined by SETUP_AW

\ если строка ( а с ) длинная, те с>>addrs_w (SETUP_AW), то
\ в качестве адреса будут использованы младшие addrs_w символы.
\ те строка будет обрезана слева, например
\  если SETUP_AW=5,
\  и              s" my_remote_node" 1 rx-addr! ,
\  то    nRF24_RX_ADDR_P1 == "_node"

  : rx-addr!  ( a c #pipe --- )

   ?pipe dup               ( a c # # )
    nRF24_RX_ADDR_P0 + >r  ( a c # | r: reg )
    ?addr_w
    over over < abort" too short address string" \ test if c < aw
    >r ( a c | r: reg aw ) + r@ -
    r> r>  addrs!
    ;

  : rx-addr@  ( #pipe --- )
   
   ?pipe radio            ( # a1 )
    over ?receiver        ( # a2 )
    over ?addr_w          ( # a2 c )
    rot                   ( a2 c # )
    nRF24_RX_ADDR_P0 +    ( a2 c reg )
    addrs@
    ;

  : pipes?  6 0 do i rx-addr@ loop ;

  : pipes.
    radio
    6 0 do
        i dup ." RX_ADDR_P" .x ." = "
        over over
        ?receiver over
        ?addr_w   over over
        over + swap do i c@ .x loop
        ." = " type cr drop
    loop
    drop
    ;

  : rx?addr.  pipes? pipes. ;

\
\ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
\

  &32 constant #fifo  \ максимальная длина пакета, байт

\ буферы для приемника и передатчика со счетчиком

  here dup #fifo 1+ dup allot 0 fill ( erase ) constant rx-packet
  here dup #fifo 1+ dup allot 0 fill ( erase ) constant tx-packet

  : rx0buff    rx-packet #fifo 1+ 0  fill ;
  : tx0buff    tx-packet #fifo 1+ 0  fill ;

\
\ =====================================================================
\

\ flush_tx     Delete all packets from the Tx FIFO.
  : tx0fifo   nRF24_FLUSH_TX nrf24-cmd! ;

\ flush_rx     Delete all packets from the Rx FIFO.
  : rx0fifo   nRF24_FLUSH_RX nrf24-cmd! ;

\ flush rx&tx fifos & clear all status flags
  : tr-clear
    nrf24_flags #bit+
    rx0fifo
    tx0fifo
    ;

\
\ =====================================================================
\
\ загрузка TX FIFO передатчика из буфера
\ W_TX_PAYLOAD counted string at memory
\ нет проверки c == 1..32

  : >tx-fifo   ( a c --- )
    nRF24_CSN low
    nRF24_TX_PLOAD! spi! >spi
    nRF24_CSN high
    ;

\ чтение RX FIFO приемника в буфер
\ R_RX_PAYLOAD counted string at memory

  : <rx-fifo   ( a c --- )
    nRF24_CSN low
    nRF24_RX_PLOAD@ spi! <spi
    nRF24_CSN high
    ;

\ Reuse last transmitted payload.
\ TX payload reuse is active until W_TX_PAYLOAD or FLUSH TX is executed.
\ TX payload reuse must not be activated or deactivated during package transmission.

  : retx!    \ retransmit
    nRF24_REUSE_TX_PL nrf24-cmd!
    ;

\ Read RX payload width for the top
\ R_RX_PAYLOADin the RX FIFO.
\ note: Flush RX FIFO if
\ the read value is larger than 32 bytes.

  : rx-count@  ( -- n )      \ packet-count@
    nRF24_CSN  low
    RX_PL_WID@ spi! spi@
    nRF24_CSN  high
    ;

\ Used in RX mode.
\ Write Payload to be transmitted together with
\ ACK packet on PIPE n

  : >rx-ack+  ( a c n -- )   \ >packet-ack
    ?pipe
    nRF24_CSN  low
    ACK_PAYLOAD! or spi! >spi
    nRF24_CSN  high
    ;

\ Used in TX mode.
\ Disables AUTOACK on this specific packet.

  : >tx-noack  ( a c --- )   \ >packet-noack
    nRF24_CSN  low
    TX_PAYLOAD_NOACK! spi! >spi
    nRF24_CSN  high
    ;

\
\
  : startx
    nRF24_CE high [  10 us/ ] literal ?delay
    nRF24_CE low  [ 130 us/ ] literal ?delay
    ;

\
\ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
\ occupies 2026 cells
\
\ ==EOF===================================================================

\ =============================================================
\ nRF24L01+ranger.f
\ chu ( vum@eml.ru ) 13:26 21.03.2014

\
\ nRF24L01+.f required
\

\ Product Specification v1.0
\ Appendix C - Constant carrier wave output for testing
\
\ Configuration
\ 1. Set PWR_UP= 1 and PRIM_RX= 0 in the CONFIGregister.
\ 2. Wait 1.5ms PWR_UP->standby.
\ 3. In the RF register set:
\ - CONT_WAVE= 1.
\ - PLL_LOCK= 1.
\ - RF_PWR.
\ 4. Set the wanted RF channel.
\ 5. Set CEhigh.
\ 6. Keep CEhigh as long as the carrier is needed.
\
\ =============================================================

\ RF_PWR bits
  $0 constant -18dBm
  $2 constant -12dBm
  $4 constant -6dBm
  $6 constant 0dBm
\
\  &4 bit constant pll_lock
\  &7 bit constant cont_wave

  nRF24_RF_SETUP &7 bit &4 bit or bitmask: rf-test
  nRF24_RF_SETUP &2 bit &1 bit or bitmask: rf-pwr

  : carrier+ ( c1 c2 --- )    \ c1==rf_channel, c2==rf_output_power
    radio-pw? 0= if
    radio-on   then
    radio-tx+
    rf-pwr   #set+
    rf-test  #bit+
    radio-ch!
    nRF24_CE high
  \ The nRF24L01+ should now output an unmodulated centered carrier.
    ;

  : carrier-
    nRF24_CE low
    rf-test  #bit-
    radio-off
    ;

  : rfpw-tst   ( c1 c2 --- )    \ c1==rf_channel, c2==rf_output_power
    carrier+ ." The nRF24L01+ now output an unmodulated centered carrier." cr
    begin pause key? until key drop
    carrier- ." The output carrier stoped." cr
    ;

\

\
\ ====== mobile receiver range led indicator  ===========================

marker =range-led=

\ m328p
PORTB 0 portpin: blue
PORTB 1 portpin: green
PORTB 2 portpin: red

: 0led
   blue  over over pin_output high
   green over over pin_output high
   red   over over pin_output high
   ;

: b+ blue  low  ;
: b- blue  high ;
: g+ green low  ;
: g- green high ;
: r+ red   low  ;
: r- red   high ;

\
\ carrier+ must be executed on transmitter side of the rf channel
\

  : range-led ( c --- )  \ c==rf channel

    radio-ch! 0led
    radio-pw? 0= if radio-on then

    begin
         radio-rx+
         [ 40 us/ ]
         literal  ?delay \ If no packets are received the RPD is latched
         nRF24_CE low    \ at the end of a receive period as a result
                         \ of host MCU setting CE low (6.4 RPD measurements)
       \ standby-I
         cd? if r- g+ else g- r+ then

    key? until
    key  drop
    0led
    ;

\
\ ~~~~~~~~~~eof~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
\

  marker =bootstrap=

\
\
\ start-up
\ подменяет собой дефолтный applturnkey
\ сохраняя его в eeprom value old-start-up
\ смотрит источник сброса:
\
\ флаги       источников
\ биты        сброса
 
  $1  constant PORF
  $2  constant EXTRF
  $4  constant BORF
  &8  constant WDRF
  $10 constant JTRF

  PORF
  EXTRF or
  BORF  or
  WDRF  or
  JTRF  or
  constant  COLD

  : POWER?     ( --- f ) rstf c@ PORF BORF or and ;
  : COLD?      ( --- f ) rstf c@ COLD  and 0= ;
  : DEADLINE?  ( --- f ) rstf c@ WDRF  and ;
  : MANUAL?    ( --- f ) rstf c@ EXTRF and ;

\ ------------------------------------------
\

  ' turnkey defer@  value  my-old-start-up \

  : restore-turnkey my-old-start-up is turnkey ;

\                                         
\-------------------------------------------

  : start-ranger   nRF24_init  &13 ( radio-channel ) range-led ;

  : start-up

         my-old-start-up execute

         COLD?      if  noop
                    then
         POWER?     if  start-ranger \ require nRF24L01+ files.f
                    then
         MANUAL?    if  noop
                    then
         DEADLINE?  if  noop
                    then
        ;

\
\

  : insert-key         ['] start-up is turnkey ;

\   insert-key
\
\ =eof==================================================================
\

> &13 0dBm rfpw-tst
The nRF24L01+ now output an unmodulated centered carrier.

\ chu  9:33 22.03.2014
\

  marker =tune-up=

  : my-tune

    [
      6 bit        \ MASK_RX_DR
      5 bit or     \ MASK_TX_DS
      4 bit or     \ MASK_MAX_RT
      3 bit or     \ EN_CRC
    \ 2 bit or     \ CRCO
    ]   literal
        nRF24_CONFIG #bit+  \ no interrupt, 1byte crc enable
    $3e nRF24_EN_AA  #bit-  \ no auto-ack but 0&1 pipes
    $0f retx-count!         \ Up to 15 Re-Transmit on fail of AA
    $0f retx-delay!         \ Wait 4000µS
    ;

\ occupy 59 cells

\ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

  : setup-listen  ( c -- ) \ rf-channel

    my-tune
    radio-pw? 0= if radio-on then
    radio-rx+ rx0buff
    radio-ch! +dyn 0 dyn-pl+
    ?nrf24.
    ;

\
\ =============================================================

> &13 setup-listen

CONFIG..........01111011
EN_AA...........00000001
EN_RXADDR.......00000011
SETUP_AW........00000011
SETUP_RETR......11111111
RF_CH...........00001101
RF_SETUP........00001111
STATUS..........00001110
OBSERVE_TX......00000000
CD..............00000000
RX_ADDR_P0......E7 E7 E7 E7 E7
RX_ADDR_P1......C2 C2 C2 C2 C2
RX_ADDR_P2......C3
RX_ADDR_P3......C4
RX_ADDR_P4......C5
RX_ADDR_P5......C6
TX_ADDR.........E7 E7 E7 E7 E7
RX_PW_P0........0
RX_PW_P1........0
RX_PW_P2........0
RX_PW_P3........0
RX_PW_P4........0
RX_PW_P5........0
FIFO_STATUS.....00010001
DYNPD...........00000001
FEATURE.........00000100
ok
>

\ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
\

  : setup-sender ( c -- ) \ rf-channel

    my-tune   
    radio-pw? 0= if radio-on then
    radio-tx+ tx0buff
    radio-ch! +dyn 0 dyn-pl+
    ?nrf24.
    ;
\
\ =============================================================


> &13 setup-sender

CONFIG..........01111010
EN_AA...........00000001
EN_RXADDR.......00000011
SETUP_AW........00000011
SETUP_RETR......11111111
RF_CH...........00001101
RF_SETUP........00001111
STATUS..........00001110
OBSERVE_TX......00000000
CD..............00000000
RX_ADDR_P0......E7 E7 E7 E7 E7
RX_ADDR_P1......C2 C2 C2 C2 C2
RX_ADDR_P2......C3
RX_ADDR_P3......C4
RX_ADDR_P4......C5
RX_ADDR_P5......C6
TX_ADDR.........E7 E7 E7 E7 E7
RX_PW_P0........0
RX_PW_P1........0
RX_PW_P2........0
RX_PW_P3........0
RX_PW_P4........0
RX_PW_P5........0
FIFO_STATUS.....00010001
DYNPD...........00000001
FEATURE.........00000100
ok
>

\ chu 22:41 19.03.2014
\     14:08 26.03.2014
\

  marker =listener=

\  : rx-empty? ( -- f ) [ 0 bit ] literal ( RX_EMPTY ) nRF24_FIFO_STATUS #tst? ;
\  : rx-done   ( -- )   [ 6 bit ] literal ( RX_DR    ) nRF24_STATUS      #bit+ ;

  : rx-clear  rx0fifo rx-done ; \ clear rx fifo & rx_dr status flag

  : pipe-name.  ( # --- )
\    cr
    rx-pipe? radio
    over ?receiver
    swap ?addr_w
    ." from " type ." : "
    ;

\ распечатать содержимое буфера, если = длина пакета = 0 - не печатаем
  : msg. rx-packet count ?dup if type else drop then cr ;

  : get-packet
     rx-packet rx-count@
      #fifo  over < throw      \ если длина пакета >32 = исключение!
     over 1+ over <rx-fifo
     swap c!
    ;

  : get-msg
    ['] get-packet catch if    \ если исключение,
     ." invalid packet (="
     base @ decimal  rx-count@ .
     base ! ." )" cr
     rx0buff rx-clear
     then
     ;

  : more-msg  rx-empty? if rx-done then  ;

  : stop-listen
    key?
    if   key $03 =  \ control-C
    else 0
    then
    ;

\
\
  : listen

    rx-clear   \ flash rx fifo & clear status flags
    ." radio " &2400 radio-ch@ + . ." MHz" cr
    ." start listening @ " ?time.
    ." press ^C to terminate listening" cr cr

    begin rx-data?
          if
          ?time. pipe-name. get-msg msg. more-msg
          then
    stop-listen until

    ." stop  listening @ " ?time.
    ;

\ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

\
\ chu 2:34 24.03.2014
\
  marker =sender=

\  : tx-end
\  [
\    5 bit ( TX_DS  )
\    4 bit ( MAX_RT ) or
\  ] literal
\    nrf24? and
\    ;

\  : tx-sent     [ 5 bit ] literal ( TX_DS  )   nRF24_STATUS #bit+ ;
\  : rtx-fix     [ 4 bit ] literal ( MAX_RT )   nRF24_STATUS #bit+ ;
\  : tx-empty?   [ 4 bit ] literal ( TX_EMPTY ) nRF24_FIFO_STATUS  #tst? ;


  : (send)
    tx-empty?
    if  ." tx empty" cr
    else
        startx begin tx-end until
        rtx-max? throw
        tx-sent
    then
    ;

  : send
    ['] (send) catch

    if rtx-fix tx-lost? . ." lost packet" cr
       ." no link: " radio-ch@ &2400 over +
        base @ swap decimal . base !
       $ef00 + throw      \  исключение= номер rf канала - нет связи
    then
    ;


  : >tx  ( a c -- )
     tx-full? if
     send  begin
     tx-full? 0=
     until  then
    >tx-fifo
    ;

\ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

> listen
radio 2413 MHz
start listening @ 3.16.04.2014 21:10:14
press ^C to terminate listening

> s" Hello world! I'm nRF24L01+ radio" >tx send
ok
> ?nrf24.

CONFIG..........01111010
EN_AA...........00000001
EN_RXADDR.......00000011
SETUP_AW........00000011
SETUP_RETR......11111111
RF_CH...........00001101
RF_SETUP........00001111
STATUS..........00001110
OBSERVE_TX......00000000
CD..............00000000
RX_ADDR_P0......E7 E7 E7 E7 E7
RX_ADDR_P1......C2 C2 C2 C2 C2
RX_ADDR_P2......C3
RX_ADDR_P3......C4
RX_ADDR_P4......C5
RX_ADDR_P5......C6
TX_ADDR.........E7 E7 E7 E7 E7
RX_PW_P0........0
RX_PW_P1........0
RX_PW_P2........0
RX_PW_P3........0
RX_PW_P4........0
RX_PW_P5........0
FIFO_STATUS.....00010001
DYNPD...........00000001
FEATURE.........00000100
ok
>

3.16.04.2014 21:14:07
from : Hello world! I'm nRF24L01+ radio

> s" I am transmitter" >tx send ?nrf24.

CONFIG..........01111010
EN_AA...........00000001
EN_RXADDR.......00000011
SETUP_AW........00000011
SETUP_RETR......11111111
RF_CH...........00001101
RF_SETUP........00001111
STATUS..........00001110
OBSERVE_TX......00000000
CD..............00000000
RX_ADDR_P0......E7 E7 E7 E7 E7
RX_ADDR_P1......C2 C2 C2 C2 C2
RX_ADDR_P2......C3
RX_ADDR_P3......C4
RX_ADDR_P4......C5
RX_ADDR_P5......C6
TX_ADDR.........E7 E7 E7 E7 E7
RX_PW_P0........0
RX_PW_P1........0
RX_PW_P2........0
RX_PW_P3........0
RX_PW_P4........0
RX_PW_P5........0
FIFO_STATUS.....00010001
DYNPD...........00000001
FEATURE.........00000100
ok
>

3.16.04.2014 21:21:24
from : I am transmitter
stop  listening @ 3.16.04.2014 21:22:00
ok
> ?nrf24.

CONFIG..........01111011
EN_AA...........00000001
EN_RXADDR.......00000011
SETUP_AW........00000011
SETUP_RETR......11111111
RF_CH...........00001101
RF_SETUP........00001111
STATUS..........00001110
OBSERVE_TX......00000000
CD..............00000000
RX_ADDR_P0......E7 E7 E7 E7 E7
RX_ADDR_P1......C2 C2 C2 C2 C2
RX_ADDR_P2......C3
RX_ADDR_P3......C4
RX_ADDR_P4......C5
RX_ADDR_P5......C6
TX_ADDR.........E7 E7 E7 E7 E7
RX_PW_P0........0
RX_PW_P1........0
RX_PW_P2........0
RX_PW_P3........0
RX_PW_P4........0
RX_PW_P5........0
FIFO_STATUS.....00010001
DYNPD...........00000001
FEATURE.........00000100
ok
>

> s" this string is longer then fifo 32-bytes width buffer" dup . >tx send
53  ok
> ?nrf24.

CONFIG..........01111010
EN_AA...........00000001
EN_RXADDR.......00000011
SETUP_AW........00000011
SETUP_RETR......11111111
RF_CH...........00001101
RF_SETUP........00001111
STATUS..........00001110
OBSERVE_TX......00000000
CD..............00000000
RX_ADDR_P0......E7 E7 E7 E7 E7
RX_ADDR_P1......C2 C2 C2 C2 C2
RX_ADDR_P2......C3
RX_ADDR_P3......C4
RX_ADDR_P4......C5
RX_ADDR_P5......C6
TX_ADDR.........E7 E7 E7 E7 E7
RX_PW_P0........0
RX_PW_P1........0
RX_PW_P2........0
RX_PW_P3........0
RX_PW_P4........0
RX_PW_P5........0
FIFO_STATUS.....00010001
DYNPD...........00000001
FEATURE.........00000100
ok
>

> listen
radio 2413 MHz
start listening @ 3.16.04.2014 21:38:03
press ^C to terminate listening

3.16.04.2014 21:38:12
from : invalid packet (=53 )

> s" good width string" dup . >tx send
17  ok
>

3.16.04.2014 21:40:04
from : good width string
stop  listening @ 3.16.04.2014 21:40:28
ok
>

search

\ search.frt
\ Author: J.L. Bezemer http://thebeez.home.xs4all.nl/4tH/

marker =search=
0 constant false
\ -1 constant true
: search
  swap >r >r over             ( a1 n1 a1)
  over r@ - r> swap           ( a1 n1 a1 n2 n3)
  begin
    dup -1 >                  ( a1 n1 a1 n2 n3 f)
    if                        ( a1 n1 a1 n2 n3)
      -rot 2dup               ( a1 n1 n3 a1 n2 a1 n2)
      r@ over                 ( a1 n1 n3 a1 n2 a1 n2 a2 n2)
      compare                 ( a1 n1 n3 a1 n2 f)
      if                      ( a1 n1 n3 a1 n2)
        swap ( char+) 1+ swap       ( a1 n1 n3 a1+1 n2)
        rot 1- false          ( a1 n1 a1+1 n2 n3 -f)
      else                    ( a1 n1 n3 a1 n2)
        rot +                 ( a1 n1 a1 n2+n3)
        2>r 2drop 2r>         ( a1 n2+n3)
        true dup              ( a1 n2+n3 f f)   
      then
    else                      ( a1 n1 a1 n2 n3)
      drop 2drop false true
    then                      ( a1 n1 -f f)
  until
  r> drop
;