$regfile = "m8def.dat"
$hwstack = 32
$swstack = 10
$framesize = 40
$baud = 9600
$crystal = 8000000
Config Sda = Portc.4
Config Scl = Portc.5
Config Portb.1 = Output
Config Portb.0 = Output
Config Portd.7 = Output
Reset Portb.1
Reset Portb.0
Reset Portd.7
Rfm12_rst Alias Portd.4
Config Rfm12_rst = Input
Test_pin Alias Portc.3
Rfm12_cs Alias Portb.2
Config Portb.2 = Output
Set Rfm12_cs
Rfm12_sdi Alias Portb.3
Config Portb.3 = Output
Rfm12_sdo Alias Pinb.4
Config Pinb.4 = Input
Set Portb.4
Rfm12_sck Alias Portb.5
Config Portb.5 = Output
Rx_led Alias Portc.0
Config Portc.0 = Output
Tx_led Alias Portc.1
Config Portc.1 = Output
Error_led Alias Portc.2
Config Portc.2 = Output
Rx_en Alias Portb.6
Config Portb.6 = Output
Tx_en Alias Portb.7
Config Portb.7 = Output
Config Spi = Hard , Interrupt = Off , Data Order = Msb , Master = Yes , _
Polarity = Low , Phase = 0 , Clockrate = 4 , Noss = 1
Spiinit
Declare Function Compass() As String
Declare Sub Rfm12_spi_wrt
Declare Sub Rfm12_tx(txarray As Byte)
Declare Sub Rfm12_rx(rxarray As Byte)
Declare Sub Rfm12_tx_ready
Declare Sub Rfm12_rx_wait
Declare Sub Rfm12_get_status_bit
Declare Sub Saveflags
Declare Sub Rfm12_clear_fifo
Declare Sub Rfm12_rx_on
Declare Sub Rfm12_init
Declare Sub Printflags
Declare Sub Send(send_str As String)
Const Fc = 435.00
Const Fr =(fc - 430) * 400
Const Fcmnd = &HA000 + Fr
Const Payload_size = 90
Const Pls_plus1 = Payload_size + 1
Dim Gga As String * 90
Dim Gll As String * 60
Dim Gsa As String * 80
Dim Gsv As String * 80
Dim Rmc As String * 90
Dim Vtg As String * 60
Dim Zda As String * 50
Dim Cmpss As String * 13
Dim Spi_tx_wrd As Word
Dim Spi_tx_l As Byte At Spi_tx_wrd Overlay
Dim Spi_tx_h As Byte At Spi_tx_wrd + 1 Overlay
Dim Spi_rx_wrd As Word
Dim Spi_rx_l As Byte At Spi_rx_wrd Overlay
Dim Spi_rx_h As Byte At Spi_rx_wrd + 1 Overlay
Dim Rx_status_bit As Bit
Dim Rxbuffer(pls_plus1) As Byte
Dim Rxstring As String * Payload_size At Rxbuffer(1) Overlay
Rxbuffer(pls_plus1) = 0
Dim Txindex As Byte
Dim Txbuffer(pls_plus1) As Byte
Dim Txstring As String * Payload_size At Txbuffer(1) Overlay
Txbuffer(pls_plus1) = 0
Dim Timeout As Word
Dim Flags As Byte
Echoflag Alias Flags.0
Beaconflag Alias Flags.1
Sermsgflag Alias Flags.2
Rxonflag Alias Flags.3
Txonflag Alias Flags.4
Dim Savedflags As Eram Byte
Wait 1
Set Rx_led
Set Tx_led
Set Error_led
Waitms 500
Reset Rx_led
Reset Tx_led
Reset Error_led
Waitms 500
Rfm12_init
Rfm12_rx_on
Flags = Savedflags
Dim St_b As Byte
St_b = 1
Dim Inp_str_temp As String * 6
Dim Str_temp As String * Payload_size
Str_temp = ""
Dim Get_str As String * Payload_size
Dim Comp_buffer As Byte
Comp_buffer = 0
Dim Count As Long
Dim Index As Word
Index = 0
On Urxc Rec_isr
Enable Serial
Enable Interrupts
'Gga = "$GPGGA,104549.04,2447.2038,N,12100,4990,E,1,06,01.7,00078.8,M,0016.3, M,,*5C"
'Gll = "$GPGLL,10454904,A,2447.2038,N,12100.4990,E,016.0,3.3,W,A*22"
'Gsa = "$GPGSA,10454904,A,2447.2038,N,12100..0,221.0,250304,003.3,W,A*22"
'Gsv = "$GPGSV,10454904,A,2447.20.4990,E,016.0,221.0,250304,003.3,W,A*22"
'Rmc = "$GPRMC,10454904,A,2447.2038,N,12100.4990,E,016.0,221.0,250304,003.3,W ,A*22"
'Vtg = "$GPVTG,10454904,A,2447.2038,016.0,221.0,250304,003.3,W,A*22"
'Zda = "$GPZDA,10454904,E,016.0,221.0,250304,003.3,W,A*22"
Cmpss = "000.0"
Do
Reset Tx_en
Set Rx_en
Rfm12_get_status_bit
If Rx_status_bit = 1 Then
Disable Urxc
Rfm12_rx Rxbuffer(1)
Reset Rx_en
Get_str = Rxstring
If Get_str = "0" Then
Get_str = Get_str + " is OK"
Reset Portb.1
Reset Portb.0
Reset Portd.7
Get_str = Get_str + " is OK"
End If
If Get_str = "1" Then
Reset Portb.1
Reset Portb.0
Set Portd.7
Get_str = Get_str + " is OK"
End If
If Get_str = "2" Then
Reset Portb.1
Set Portb.0
Reset Portd.7
Get_str = Get_str + " is OK"
End If
If Get_str = "3" Then
Reset Portb.1
Set Portb.0
Set Portd.7
Get_str = Get_str + " is OK"
End If
If Get_str = "4" Then
Set Portb.1
Reset Portb.0
Reset Portd.7
Get_str = Get_str + " is OK"
End If
If Get_str = "5" Then
Set Portb.1
Reset Portb.0
Set Portd.7
Get_str = Get_str + " is OK"
End If
If Get_str = "6" Then
Reset Portb.1
Set Portb.0
Set Portd.7
Get_str = Get_str + " is OK"
End If
If Get_str = "7" Then
Set Portb.1
Set Portb.0
Set Portd.7
Get_str = Get_str + " is OK"
End If
If Get_str = "8" Then Get_str = Get_str + " is incorrect"
If Get_str = "9" Then Get_str = Get_str + " is incorrect"
Call Send(get_str)
If Gga <> "" Then
Call Send(gga)
Gga = ""
End If
Cmpss = Compass()
If Cmpss <> "" Then
Cmpss = "Compass=" + Cmpss
Call Send(cmpss)
End If
If Gll <> "" Then
Call Send(gll)
Gll = ""
End If
If Gsa <> "" Then
Call Send(gsa)
Gsa = ""
End If
If Gsv <> "" Then
Call Send(gsv)
Gsv = ""
End If
Cmpss = Compass()
If Cmpss <> "" Then
Cmpss = "Compass=" + Cmpss
Call Send(cmpss)
End If
If Rmc <> "" Then
Call Send(rmc)
Rmc = ""
End If
If Vtg <> "" Then
Call Send(vtg)
Vtg = ""
End If
If Zda <> "" Then
Call Send(zda)
Zda = ""
End If
Cmpss = Compass()
If Cmpss <> "" Then
Cmpss = "Compass=" + Cmpss
Call Send(cmpss)
End If
Enable Urxc
End If
Loop
End 'end program
Rec_isr:
Disable Serial
If Udr = 36 Then '36=$
'star buffer
St_b = 1
Str_temp = ""
End If
If St_b = 1 Then
If Udr > 35 Then
If Udr < 123 Then
Str_temp = Str_temp + Chr(udr)
End If
End If
If Udr = 13 Then
St_b = 0 'stop buffer
Inp_str_temp = Mid(str_temp , 1 , 6)
Select Case Inp_str_temp
Case "$GPGGA":
Gga = Str_temp
Case "$GPGLL":
Gll = Str_temp
Case "$GPGSA":
Gsa = Str_temp
Case "$GPGSV":
Gsv = Str_temp
Case "$GPRMC":
Rmc = Str_temp
Case "$GPVTG":
Vtg = Str_temp
Case "$GPZDA":
Zda = Str_temp
End Select
End If
End If
Enable Serial
Return
Sub Send(send_str As String)
Txstring = Send_str
Reset Rx_en
Set Tx_en
Rfm12_tx Txbuffer(1)
Reset Tx_en
Txstring = ""
Waitus 350
End Sub
Sub Printflags
If Beaconflag = 1 Then
Print "Beacon ON"
Else
Print "Beacon OFF"
End If
If Echoflag = 1 Then
Print "Echo ON"
Else
Print "Echo OFF"
End If
End Sub
Sub Saveflags
'save to eram
Flags = Flags And 3
Savedflags = Flags
End Sub
Sub Rfm12_init
Local I As Byte
'Print "Init values:"
'Initialize RFM12
Restore Init_data
For I = 1 To 14
Read Spi_tx_wrd
Rem Print Hex(spi_tx_wrd)
'send init data to RFM12.
Rfm12_spi_wrt
'waitms 100
Next I
'Print
End Sub
'******************************************************************** ***
'The following data lines are RFM12 commands used to initialize the device.
'read the RFM12 progamming guide and data sheets for a complete
'description of these commands.
'
'Configuration settings:
'
'&h80D8 = Configure module for 433Mhz band.
'
'RF center Freq. setting
'select freq with const "Fc" above.
'Fcmnd is a constant that holds the Freq command.
'see the "const" statments at the top of this code.
'example: &hA000 + Fr = &hA7D0 for 435MHz
'
'To change the data rate the following values will need to be adjusted.
'
'bit rate
'&hC611 = 19.2kbps works well at 8MHz
'&hC608 = 38.3kbps works at 8MHz
'
'Rx band width
'&h94A0 = Rx BW = 134KHz works at 8MHz
'&h9480 = 200kHz works at 8MHz
'
'Tx deviation
'&h9850 = 90kHz works at 8MHz
'&h9870 = 120kHz works at 8MHz
Init_data:
Data &H80D8% , &H8298% , Fcmnd% , &HC611% , &H94A0% , &HC2AC% , &HCA81%
Data &HCED4% , &HC483% , &H9850% , &HCC17% , &HE000% , &HC800% , &HC040%
'******************************************************************** *****
Sub Rfm12_clear_fifo
'Clear FIFO
Spi_tx_wrd = &HCA81
Rfm12_spi_wrt
Spi_tx_wrd = &HCA83
Rfm12_spi_wrt
End Sub
Sub Rfm12_tx(txarray As Byte)
Local I As Byte
Set Tx_led
'turn on Tx
Spi_tx_wrd = &H8239
Rfm12_spi_wrt
Txonflag = 1
Waitus 150
'Send Preamble.
Restore Txpreamble_data
For I = 1 To 5
Read Spi_tx_wrd
Rfm12_tx_ready
If Timeout = 0 Then Exit For
Rfm12_spi_wrt
Next I
'Send payload.
For I = 1 To Payload_size
Rfm12_tx_ready
If Timeout = 0 Then Exit For
Spi_tx_wrd = &HB800 + Txarray(i)
Rfm12_spi_wrt
Next I
Rfm12_tx_ready
Rfm12_rx_on
Reset Tx_led
End Sub
Txpreamble_data:
Data &HB8AA% , &HB8AA% , &HB8AA% , &HB82D% , &HB8D4%
Sub Rfm12_tx_ready
Reset Rfm12_cs
Timeout = 65500
While Rfm12_sdo = 0
Decr Timeout
Waitus 6
If Timeout = 0 Then
'Print "Tx Timeout"
Exit While
End If
Wend
End Sub
Sub Rfm12_rx_on
'Start Rx
Spi_tx_wrd = &H8299
Rfm12_spi_wrt
Rfm12_clear_fifo
Rxonflag = 1
Waitus 80
End Sub
Sub Rfm12_rx(rxarray As Byte)
Local I As Byte
Timeout = 1
Set Rx_led
Spi_tx_wrd = &HB000
For I = 1 To Payload_size
Rfm12_rx_wait
If Timeout = 0 Then
Reset Rx_led
Set Error_led
Exit For
End If
Rfm12_spi_wrt
Rxarray(i) = Spi_rx_l
Next I
Rxarray(i) = 0
Rfm12_clear_fifo
Reset Rx_led
End Sub
Sub Rfm12_rx_wait
Timeout = 35500
Do
Rfm12_get_status_bit
'timeout if nothing happens.
Decr Timeout
If Timeout = 0 Then
Reset Error_led
'Print "Rx Timeout"
Exit Do
End If
Loop Until Rx_status_bit = 1
End Sub
Sub Rfm12_get_status_bit
Reset Rfm12_sdi
Reset Rfm12_cs
Set Rfm12_sck
Rx_status_bit = Rfm12_sdo
Reset Rfm12_sck
Set Rfm12_cs
End Sub
Sub Rfm12_spi_wrt
'Send word (SPI_Tx_wrd) to RFM12.
'Also receive word (SPI_Rx_wrd).
'RFM12 Chip select
Reset Rfm12_cs
'send hi byte.
Spi_rx_h = Spimove(spi_tx_h)
'send lo byte.
Spi_rx_l = Spimove(spi_tx_l)
'deselect chip.
Set Rfm12_cs
End Sub
'-------------------------------- Function -------------------------------------
Function Compass() As String
Dim Hi As Byte
Dim Lo As Byte
Dim Heading As Integer
Dim Heading_si As Single
I2cstart
I2cwbyte &HC0
I2cwbyte &HC1
I2cstop
I2cstart
I2cwbyte &HC1
I2crbyte Hi , Ack
I2crbyte Hi , Ack
I2crbyte Lo , Nack
I2cstop
'Waitms 50
'Hi = 14 'Max Hi 360
'Lo = 16 'Max Lo 360
Heading = Makeint(lo , Hi)
Heading_si = Heading / 10
'Compass = Str(heading_si)
Compass = Fusing(heading_si , "&.#")
End Function
صفحه اصلی
انجمن
جستجو
فهرست اعضا
افزونه های فایرفاکس
» 
تشکر شده توسط :
![[تصویر: ECA-090910104822.png]](http://www.ecapic.ir/image/ECA-090910104822.png)
