'( ################################################################################ project: Simple FM Radio - RDA5807M chip -------------------------------------------------------------------------------- name : SFMR09.bas copyright : (c) Chris Hirt, OE3HBW, Austria, JN87AQ, 2022 purpose : FM Radio with RDA5807M micro : ATmega644-20PU programmer : mySmartUSB MK3 compiler : MCS BASCOM-AVR 2.0.8.5 - 004 flash : 30% code build : V09 @ 12122022 (12. Dec. 2022) status : Working gimmick with the RDA5807M -------------------------------------------------------------------------------- ########################### HARDWARE ########################################### '----------------------------- uC ATmega644 PDIP40 20 MHz PIN 01 PB0 PORTB.0 T0 / XCK0 --> Rotary Encoder A 02 PB1 PORTB.1 T1 / CLKO --> Rotary Encoder B 03 PB2 PORTB.2 INT2 / AIN0 --> LED FM 04 PB3 PORTB.3 OC0A / AIN1 --> LED AM 05 PB4 PORTB.4 OC0B / SS --> LED Stereo 06 PB5 MOSI MOSI --> ISP 07 PB6 MISO MISO --> ISP 08 PB7 SCK SCK --> ISP 09 /RESET RST --> ISP 10 VCC +5V 11 GND 0V 12 XTAL2 Quartz 18.3420 MHz 13 XTAL1 Quartz 18.3420 MHz 14 PD0 PORTD.0 RXD --> Beeper HMB-06 Piezo-Buzzer 15 PD1 PORTD.1 TXD --> SW6 (RE switch) 16 PD2 PORTD.2 INT0 / RXD1 --> SINT Switch Interrupt 17 PD3 PORTD.3 INT1 / TXD1 --> SW1 18 PD4 PORTD.4 OC1B / XCK1 --> SW2 19 PD5 PORTD.5 OC1A --> SW3 20 PD6 PORTD.6 OC2B / ICP --> SW4 21 PD7 PORTD.7 OC2A --> SW5 22 PC0 PORTC.0 TWI SCL --> I2C Bus SCL RDA5807M 23 PC1 PORTC.1 TWI SDA --> I2C Bus SDA RDA5807M 24 PC2 PORTC.2 TCK --> GLCD RST 25 PC3 PORTC.3 TMS --> GLCD CS2 26 PC4 PORTC.4 TDO --> GLCD CS1 27 PC5 PORTC.5 TDI --> GLCD E 28 PC6 PORTC.6 TOSC1 --> GLCD RW 29 PC7 PORTC.7 TOSC2 --> GLCD DI 30 AVCC VCC +5V 31 AGDN GND 0V 32 AREF ADC REF 33 PA7 PORTA.7 ADC7 --> GLCD D7 34 PA6 PORTA.6 ADC6 --> GLCD D6 35 PA5 PORTA.5 ADC5 --> GLCD D5 36 PA4 PORTA.4 ADC4 --> GLCD D4 37 PA3 PORTA.3 ADC3 --> GLCD D3 38 PA2 PORTA.2 ADC2 --> GLCD D2 39 PA1 PORTA.1 ADC1 --> GLCD D1 40 PA0 PORTA.0 ADC0 --> GLCD D0 ----------------------------- GLCD TG12864B-03a 128x64 Blue/White PIN 01 VSS GND 02 VDD +5V 03 VO 04 DI 05 RW 06 E 07 D0 08 D1 09 D2 10 D3 11 D4 12 D5 13 D6 14 D7 15 CS2 16 CS1 17 RST 18 VEE 19 K LED GND 20 A LED +5V display coordinates 0,0 ------------------------127,0 | | | | | | | | 0,63 -----------------------127,63 | | x,y Axis ----------------------------- Keypad + RE switch 5 x Key 1 x Rotary Encoder Switch 6 x Diodes for Interrupt 6 x 10n Internal Pull Up Resistor SW1 Menu SW2 Band (AM not implemented yet) SW3 KeyLeft < SW4 KeyRight > SW5 Quit SW6 Steps (RE switch) ----------------------------- Rotary Encoder "ddm427" A GND B 15 pulse / 360° CCW CW A B A B 1 1 1 1 1 0 0 1 0 0 0 0 0 1 1 0 1 1 1 1 ################################################################################ ') '$PROG &HFF,&HD7,&HD9,&HFC 'Take care - Fuse Bits !!! $regfile = "m644def.dat" 'ATmega644-20PU $crystal = 18342000 '18.4320 MHz 'stack and frame size not optimized! $hwstack = 200 $framesize = 400 $swstack = 300 $lib "glcdKS108.lbx" 'include GLCD Lib $lib "I2C_TWI.lbx" 'include TWI Lib --> force BASCOM to use the hardware TWI '----- Config I2C -------------------------------------------------------------- Config SDA = PortC.1 'Configures a port pin for use as serial data SDA Config SCL = PortC.0 'Configures a port pin for use as serial clock SCL Config Twi = 400000 'TWI = I2C clock speed is 400 kHz '----- Config GLCD ------------------------------------------------------------- Config GraphLCD = 128 * 64sed , Dataport = PortA , Controlport = PortC , _ Cd = 7 , Rd = 6 , Ce = 3 , Ce2 = 4 , Enable = 5 , Reset = 2 '----- Config Keypad ----------------------------------------------------------- DDRD = &b0000_0000 PORTD = &b1111_1010 'SW1-6 PullUp enabled Config Int0 = Falling On Int0 Isr_keypad 'Interrupt-Routine Externer Int0 --> PD2 '----- Config Rotary Encoder --------------------------------------------------- DDRB.0 = 0 'PB.0 as Input PortB.0 = 1 'and PullUp enabled for Rotary Encoder A DDRB.1 = 0 'PB.1 as Input PortB.1 = 1 'and PullUp enabled for Rotary Encoder B Config Timer0 = Timer , Prescale = 256 On Timer0 Isr_Timer0 'Timer0 Interrupt service routine on overflow '----- Config LEDs and Sound --------------------------------------------------- LEDFM Alias Portb.2 Config LEDFM = Output 'Orange LED LEDAM Alias Portb.3 Config LEDAM = Output 'Green LED LEDST Alias Portb.4 Config LEDST = Output 'Red LED Beeper Alias PortD.0 Config Beeper = Output 'Buzzer HMB-06 2.2kHz 5V 20mA '----- Config RDA5807M chip ---------------------------------------------------- const RegH02 = &b1001_0000_0000_0101 'register h02 default value 'DHIZ = 1 Audio Output normal 'DMUTE = 0 Mute on 'MONO = 0 Stereo on 'BASS = 1 Bass Boost enabled 'RCLK_NCM = 0 Clock always supplied 'RCLK_DIM = 0 Not direkt input mode (Quartz is used) 'SEEKUP = 0 Seek down 'SEEK = 0 Disable seek 'SKMODE = 0 Wrap at band limit 'CLKMODE = 000 32.7680 kHz Quartz 'RDS_EN = 0 RDS/RBDS disable 'NEWMETHD = 1 New demodulation method enable ??? 'SOFT_RST = 0 Not Soft_Reset 'ENABLE = 1 Power Up enable const RegH03 = &b0100_1111_1100_0000 'register h03 default value 'CHAN = 0100111111 Channel (default = h013F) 'DIRMODE = 0 Direct Control Mode disabled ??? 'TUNE = 0 Tune disabled 'BAND = 00 Band select 87-108 MHz (BC Europe) 'SPACE = 00 Channel spacing 100 kHz (BC Europe) const RegH04 = &b0000_1110_0000_0000 'register h04 default value 'RSVD = 0 Reserved 'STCIEN = 0 Seek/Tune complete interrupt disable --> no GPIO2 'RBDS = 0 RDS only 'RDSFIFOE = 0 RDS FIFO Mode disable 'DE = 1 Deemphasis 50 us (BC Europe) 'RDSFIFOC = 1 Clear RDS FIFO 'SOFTMUTE = 1 Softmute enable 'AFCD = 0 AFC enable 'RSVD = 00000000 Reserved (I2S, GPIO 1-3) const RegH05 = &b1000_1000_1010_1000 'register h05 default value 'INTMODE = 1 Interrupt mode ??? 'SEEKMODE = 00 New seek mode on; RSSI Seek mode off 'RSVD = 0 Reserved 'SEEKTH = 1000 Seek SNR threshold value 'LNA_PORT = 10 LNAP (positiv input) 'LNA_IC = 10 LNA current 2.5 mA (what is better ?) 'VOLUME = 1000 DAC gain control (Volume 0-15 log) --> 8 const RegH06 = &b0000_0000_0000_0000 'register h06 default value 'RSVD = 0 Reserved 'OPENMODE = 00 Only reading reserved registers 'I2S = 0000000000000 I2S parameter --> no I2S hardware ???? const RegH07 = &b0100_0010_0000_0010 'register h07 default value 'RSVD = 0 Reserved 'THSOFTBL = 10000 Noise soft blend threshold (2 dB steps) '6550MODE = 1 Default = 1 'RSVD = 0 Reserved 'SEEKTHOD = 000000 Threshold for old Seek mode (RSSI mode) 'SOFTBLEN = 1 Softblend enable 'FREQMODE = 0 No frequence seting in direct mode const RegH08 = &b0000_0000_0000_0000 'register h08 default value 'FREQ_DRCT No direct frequency setting '---- RDA5807M chip I2C address ---- 'Device Address = h10 for sequential read/write mode 'Device Address = h11 for random access read/write mode 'Sequential read/write mode Const SEQ_WriteAdr = &h20 Const SEQ_ReadAdr = &h21 'Random Access read/write mode Const RND_WriteAdr = &h22 Const RND_ReadAdr = &h23 '---- Frequency range for BC in Europe ----------------------------------------- Const FMstart = 87000000 'Start frequency in Hz Const FMend = 108000000 'End frequency in Hz '---- Max Frequency range in Expert Mode --------------------------------------- Const exFMstart = 50000000 'Start frequency = 50 MHz Const exFMend = 115535000 'End frequency = 115.535 MHz '----- Menu -------------------------------------------------------------------- Const mnuMaxN = 32 'Menu-Tree, max Nodes Const GLCDrows = 7 'GLCD - Font: 7 rows Max '----- Declarations ------------------------------------------------------------ Dim a As Byte Dim sw As Byte Dim KeyCode As Byte Dim REstate As Byte Dim REold As Byte Dim REnew As Byte Dim Freq As DWord 'FM frequency in Hz Dim SF As String*8 Dim SN As String*8 Dim VL As Word Dim VLold As Word Dim VX As Word Dim hB As Byte Dim lB As Byte Dim regW As Word Dim STC As Byte Dim fx As DWord Dim Vol As Word Dim MT As Word Dim BB As Word Dim si As Word Dim rssi As Byte Dim rssiold As Byte Dim m As Byte Dim n As Byte Dim STO As Word Dim AFC As Word Dim spg1 As Word Dim spg2 As Word Dim stat1 As Word Dim stat2 As Word Dim RChan As Word Dim FMtrue As Byte Dim Reg As Word Dim STHW As Word Dim fspace As DWord Dim fskhz As DWord Dim Chan As DWord Dim Val1 As DWord Dim FreqW As Word Dim FreqDW As DWord Dim FMHZ As DWord '--- RDS --- Dim RDS As Word Dim RDSstat1 As Word Dim RDSstat2 As Word Dim RDSstatus As Byte Dim RDSR As Byte Dim stat As Byte Dim RDSA As Word Dim RDSB As Word Dim RDSC As Word Dim RDSD As Word Dim RDSerr As Byte Dim GT As Byte Dim B0 As Byte Dim PS1 As Byte Dim PS0 As Byte Dim C10 As Byte Dim PSChr1 As String * 1 Dim PSChr0 As String * 1 Dim PSN As String * 8 Dim cnt As Byte Dim T1 As Byte Dim T2 As Byte Dim hours As Byte Dim minutes As Byte Dim LTO As Byte Dim Tms As String * 5 Dim TStr As String * 5 '----- Menu ----- Dim mnuSlct As Word 'Menu Selection Dim mnuSlctOld As Word 'past Menu Selection Dim mnuNCnt As Byte 'Number of Nodes for a given Menu Dim mnuRa As Byte 'Menu Return Address Dim mnuPntr As Byte 'Menu Pointer Dim mnuNNm(mnuMaxN) As String*15 'Menu Node Name array Dim mnuNode(mnuMaxN) As Word 'Menu Node Number array Dim i As Byte 'Menu run variable i Dim j As Byte 'Menu run variable j '----- Sub Declarations -------------------------------------------------------- Declare Sub Menu() Declare Sub mnuShow() Declare Sub InitDisplay() Declare Sub ShowBox() Declare Sub DrawIntro() Declare Sub Beep() Declare Sub ClearDrawingArea() Declare Sub FixFrequency(byVal rs As Byte) Declare Sub ShowRSSI() Declare Sub ControlVolume() Declare Sub DecodeRDSdata() Declare Sub ProcessRDS() Declare Sub ShowOverview() Declare Sub SeekWindow() Declare Sub TuneWindow() Declare Sub FMexWindow() Declare Sub AMWindow() Declare Sub I2CwriteRegister(ByVal reg As Byte , ByVal cont As Word) Declare Function I2CreadRegister(ByVal reg As Byte) As Word Declare Sub RDA5807M_SetMyDefault() Declare Sub RDA5807M_Init() Declare Sub RDA5807M_ReadSTC() Declare Sub RDA5807M_SetMuteOn() Declare Sub RDA5807M_SetMuteOff() Declare Sub RDA5807M_SetBassBoostOn() Declare Sub RDA5807M_SetBassBoostOff() Declare Sub RDA5807M_SetStereoON() Declare Sub RDA5807M_SetStereoOFF() Declare Sub RDA5807M_SetAFCon() Declare Sub RDA5807M_SetAFCoff() Declare Sub RDA5807M_SetVolume(ByVal VolNew As Word) Declare Sub RDA5807M_SetFreq() Declare Sub RDA5807M_SetSpacing(ByVal spg As Byte) Declare Sub RDA5807M_GetRSSI() Declare Sub RDA5807M_GetStatus() Declare Sub RDA5807M_Tune() Declare Sub RDA5807M_Seek() Declare Sub RDA5807M_RDSinit() Declare Sub RDA5807M_RDSstatus() Declare Sub RDA5807M_RDSdata() Declare Sub RDA5807M_SetDirFreq(ByVal newF As DWord) Declare Sub RDA5807M_SetExpertReg() '####################### Main ################################################## '----- Initialization ---------------------------------------------------------- REold = 0 'Rotary Encoder status REnew = 0 REstate = 0 a = 0 'Action code for nothing Keycode = &hFA 'KeyCode for nothing = b1111_1010 sw = 0 'no key (SW) mnuSlct = 0 'Menu Selector - Menu Layer 0 VL = 8 'start value of Volume Beeper = 0 'no beep Freq = FMstart 'Frequency start value fspace = 100000 'Frequency step = Space = 100 kHz Enable Int0 'enable Interrupt and Timer Enable Timer0 Enable Interrupts Call InitDisplay() 'initializing Graphic LED Display Call DrawIntro() 'draw intro to display Call RDA5807M_Init() 'initialized RDA5807M LEDAM = 1 ' 'green AM LED always ON because the AM option is not implemented yet LEDFM = 0 'orange LED OFF - symbolizes FM OFF LEDST = 0 'red LED OFF - symbolizes Stereo OFF Call Beep() '----- Main Loop --------------------------------------------------------------- Do 'Main loop Call Menu() 'Menu Loop 'end of main llop End 'end of program '######################## Subs ################################################# '------------------------ Menu ------------------------------------------------- Sub Menu() 'Menu tree Select Case mnuSlct Case 0: 'Main-Menu mnuNCnt = 4 'how many nodes in this layer mnuNode(1) = 1 'node number mnuNNm(1) = "Band" 'node name/text mnuNode(2) = 2 mnuNNm(2) = "Mode" mnuNode(3) = 3 mnuNNm(3) = "Settings" mnuNode(4) = 4 mnuNNm(4) = "Steps" mnuRa = 0 'if return then jump to node x Call mnuShow 'call menu display and navigation control Case 1: 'Band-Menu mnuNCnt = 3 mnuNode(1) = 11 mnuNNm(1) = "FM BC" mnuNode(2) = 12 mnuNNm(2) = "FM Expert" mnuNode(3) = 13 mnuNNm(3) = "AM" 'option feature - not yet realized mnuRa = 0 Call mnuShow Case 11: 'Fix Frequency Menu mnuNCnt = 6 mnuNode(1) = 111 mnuNNm(1) = "RS 1" mnuNode(2) = 112 mnuNNm(2) = "RS 2" mnuNode(3) = 113 mnuNNm(3) = "RS 3" mnuNode(4) = 114 mnuNNm(4) = "RS 4" mnuNode(5) = 115 mnuNNm(5) = "RS 5" mnuNode(6) = 116 mnuNNm(6) = "RS 6" mnuRa = 1 Call mnuShow Case 111: Call FixFrequency(1) mnuSlct = 11 Case 112: Call FixFrequency(2) mnuSlct = 11 Case 113: Call FixFrequency(3) mnuSlct = 11 Case 114: Call FixFrequency(4) mnuSlct = 11 Case 115: Call FixFrequency(5) mnuSlct = 11 Case 116: Call FixFrequency(6) mnuSlct = 11 Case 12: 'FM Expert Call FMexWindow() 'tuning in expert modus mnuSlct = 1 Case 13: 'AM (option) Call AMWindow() mnuSlct = 1 Case 2: 'Mode-Menu mnuNCnt = 2 mnuNode(1) = 21 mnuNNm(1) = "Tune" mnuNode(2) = 22 mnuNNm(2) = "Seek" mnuRa = 0 Call mnuShow Case 21: Call TuneWindow() mnuSlct = 0 Case 22: Call SeekWindow() 'call Seek modus mnuSlct = 0 Case 3: 'Settings-Menu mnuNCnt = 6 mnuNode(1) = 31 mnuNNm(1) = "Bassboost" mnuNode(2) = 32 mnuNNm(2) = "Stereo" mnuNode(3) = 33 mnuNNm(3) = "AFC" mnuNode(4) = 34 mnuNNm(4) = "RDS" mnuNode(5) = 35 mnuNNm(5) = "RSSI" mnuNode(6) = 36 mnuNNm(6) = "Overview" mnuRa = 0 Call mnuShow Case 31: mnuNCnt = 2 mnuNode(1) = 311 mnuNNm(1) = "BassBoost ON" mnuNode(2) = 312 mnuNNm(2) = "BassBoost OFF" mnuRa = 3 Call mnuShow Case 311: Call RDA5807M_SetBassBoostOn() 'set BassBoost ON mnuSlct = 3 Case 312: Call RDA5807M_SetBassBoostOff() 'set BassBoost OFF mnuSlct = 3 Case 32: mnuNCnt = 2 mnuNode(1) = 321 mnuNNm(1) = "Stereo ON" mnuNode(2) = 322 mnuNNm(2) = "Stereo OFF" mnuRa = 3 Call mnuShow Case 321: Call RDA5807M_SetStereoON() 'set Stereo ON mnuSlct = 3 Case 322: Call RDA5807M_SetStereoOFF() 'set Stereo OFF mnuSlct = 3 Case 33: mnuNCnt = 2 mnuNode(1) = 331 mnuNNm(1) = "AFC ON" mnuNode(2) = 332 mnuNNm(2) = "AFC OFF" mnuRa = 3 Call mnuShow Case 331: Call RDA5807M_SetAFCon() 'set AFC ON mnuSlct = 3 Case 332: Call RDA5807M_SetAFCoff() 'set AFC OFF mnuSlct = 3 Case 34: Call ProcessRDS() 'read out and show RDS data mnuSlct = 3 Case 35: Call ShowRSSI() 'read out and show RSSI data mnuSlct = 3 Case 36: Call ShowOverview() 'show Overview of Settings mnuSlct = 3 Case 4: 'Steps-Menu mnuNCnt = 2 mnuNode(1) = 41 mnuNNm(1) = "Volume" mnuNode(2) = 42 mnuNNm(2) = "Spacing" mnuRa = 0 Call mnuShow Case 41: Call ControlVolume() 'set Volume value mnuSlct = 4 Case 42: 'select Spacing in kHz mnuNCnt = 4 mnuNode(1) = 421 mnuNNm(1) = " 25 kHz" mnuNode(2) = 422 mnuNNm(2) = " 50 kHz" mnuNode(3) = 423 mnuNNm(3) = "100 kHz" mnuNode(4) = 424 mnuNNm(4) = "200 kHz" mnuRa = 4 Call mnuShow Case 421: Call RDA5807M_SetSpacing(&b0000_0011) 'set Spacing to 25 kHz mnuSlct = 4 Case 422: Call RDA5807M_SetSpacing(&b0000_0010) 'set Spacing to 50 kHz mnuSlct = 4 Case 423: Call RDA5807M_SetSpacing(&b0000_0000) 'set Spacing to 100 kHz mnuSlct = 4 Case 424: Call RDA5807M_SetSpacing(&b0000_0001) 'set Spacing to 200 kHz mnuSlct = 4 Case Else: mnuSlct = 0 End Select End Sub Sub mnuShow() 'Display and navigation for menu-tree mnuSlctOld = mnuSlct mnuPntr = 1 'the first element of an array is always one by default Call ClearDrawingArea() While mnuSlctOld = mnuSlct Lcdat 1 , 2 , " Menu " , 1 j = mnuPntr + GLCDrows Decr j 'because array base is 1 If j > mnuNCnt Then j = mnuNCnt For i = 1 To j If i = mnuPntr Then Lcdat i+1 , 10 , ">" , 1 'write ">" symbol Else Lcdat i+1 , 10 , " " , 0 End If Lcdat i+1 , 20 , mnuNNm(i) 'write Node Name Next i Do 'monitor user action If REstate <> 0 Then a = 1 'wait until RE is moved If KeyCode <> &hFA Then a = 1 'wait until key pressed Loop Until a <> 0 Disable timer0 'stop Timer0 for RE state If REstate = 1 Then If mnuPntr > 1 Then Decr mnuPntr 'KeyUp - Encoder increment End If If REstate = 2 Then If mnuPntr < mnuNCnt Then Incr mnuPntr 'KeyDwn - Encoder decrement End If Enable Timer0 'enable Timer0 Select Case KeyCode Case &hF2: 'SW1 Menu sw = 1 Call Beep() mnuSlct = 0 Case &hEA: 'SW2 Band (AM not implemented yet) sw = 2 Call Beep() mnuSlct = 1 Case &hDA: 'SW3 KeyLeft < sw = 3 mnuSlct = mnuRa Call Beep() Case &hBA: 'SW4 KeyRight > sw = 4 mnuSlct = mnuNode(mnuPntr) Call Beep() Case &h7A: 'SW5 Quit sw = 5 Call Beep() mnuSlct = 0 Case &hF8: 'SW6 Steps sw = 6 Call Beep() mnuSlct = 4 End Select KeyCode = &hFA 'reset KeyCode a = 0 'reset action flag REstate = 0 'reset incremental flag Wend End Sub '------------------------------------------------------------------------------- Sub Beep() 'short beep with 2.2kHz Beeper = 1 Waitms 150 Beeper = 0 End Sub Sub InitDisplay() 'init graphic display Glcdcmd &h3E , 1 : Glcdcmd &h3E , 2 'display off Waitms 100 'wait 100ms Glcdcmd &h3F , 1 : Glcdcmd &h3F , 2 'display on Setfont Font8x8 'load font 8x8 Cls 'clear display End Sub Sub ShowBox() 'show static display parts Box(0 , 0) -(127 , 63) , 1 'white border Boxfill(0 , 0) -(127 , 7) , 1 'white rectangle End Sub Sub ClearDrawingArea() 'overwrite text Lcdat 2 , 2 , " " , 0 Lcdat 3 , 2 , " " , 0 Lcdat 4 , 2 , " " , 0 Lcdat 5 , 2 , " " , 0 Lcdat 6 , 2 , " " , 0 Lcdat 7 , 2 , " " , 0 End Sub Sub DrawIntro() 'draw intro picture Showpic 0 , 0 , Intropic 'load a BGF coded intro picture Wait 3 'wait 3 sec Cls Call Beep() Call ShowBox() 'show static display parts Lcdat 1 , 2 , " FM Tuner " , 1 'show intro text Lcdat 3 , 2 , " V 0.9 " , 0 Lcdat 6 , 2 , " OE3HBW 2022 " , 0 Wait 2 End Sub Sub FixFrequency(byVal rs As Byte) 'load and show fix BC frequency Select Case rs Case 1: 'Radio Station 1 SF = Lookupstr(0 , RS1) 'Radio Station frequenz SN = Lookupstr(1 , RS1) 'Radio Station name Case 2: 'Radio Station 2 SF = Lookupstr(0 , RS2) 'Radio Station frequenz SN = Lookupstr(1 , RS2) 'Radio Station name Case 3: 'Radio Station 3 SF = Lookupstr(0 , RS3) 'Radio Station frequenz SN = Lookupstr(1 , RS3) 'Radio Station name Case 4: 'Radio Station 4 SF = Lookupstr(0 , RS4) 'Radio Station frequenz SN = Lookupstr(1 , RS4) 'Radio Station name Case 5: 'Radio Station 5 SF = Lookupstr(0 , RS5) 'Radio Station frequenz SN = Lookupstr(1 , RS5) 'Radio Station name Case 6: 'Radio Station 6 SF = Lookupstr(0 , RS6) 'Radio Station frequenz SN = Lookupstr(1 , RS6) 'Radio Station name End Select Freq = Val(SF) 'Freq in 10 kHz units Freq = Freq * 10000 'Freq in Hz If Len(SF) = 4 Then SF = Format(SF , "00.00") 'format string for < 100 MHz Else SF = Format(SF , "000.00") 'format string for >= 100 MHz End If Call RDA5807M_SetFreq() 'set RDA5807M fix frequency LEDFM = 1 'orange LED ON - symbolizes FM ON LEDST = 1 'red LED ON - symbolizes Stereo ON Call ClearDrawingArea() Lcdat 1 , 6 , " Fix Frequency " , 1 Lcdat 3 , 8 , " Radio Station " , 0 Lcdat 5 , 20 , SN , 0 Lcdat 7 , 20 , SF , 0 Lcdat 7 , 70 , "MHz" , 0 Do 'NOP Loop until KeyCode = &h7A 'SW5 Quit KeyCode = &hFA 'reset KeyCode a = 0 'reset action flag REstate = 0 'reset incremental flag LEDFM = 0 'orange LED OFF - symbolizes FM OFF LEDST = 0 'red LED OFF - symbolizes Stereo OFF End Sub Sub TuneWindow() 'Tune thru EU FM Band Freq = FMstart Call ClearDrawingArea() Lcdat 1 , 6 , " Tune " , 1 Lcdat 3 , 8 , " Radio Station " , 0 Call RDA5807M_Tune() 'Tune RDA5807M FM Frequency Do Do 'monitor user action If REstate <> 0 Then a = 1 'wait until RE is moved If KeyCode <> &hFA Then a = 1 Loop Until a <> 0 Disable timer0 'stop Timer0 for RE state If REstate = 1 Then 'KeyUp - Encoder decrement Freq = Freq - fspace End If If REstate = 2 Then 'KeyDwn - Encoder increment Freq = Freq + fspace End If Enable Timer0 'enable Timer0 If Freq < FMstart Then Freq = FMstart 'Lowest frequency of EU Band If Freq > FMend Then Freq = FMend 'Highest frequency of EU Band Call RDA5807M_Tune() 'Tune RDA5807M FM Frequency LEDFM = 1 'orange LED ON - symbolizes FM ON LEDST = 1 'red LED ON - symbolizes Stereo ON FMHZ = Freq / 10000 SF = Str(FMHZ) SF = LTrim(SF) If Len(SF) = 4 Then SF = Format(SF , "00.00") 'format string for < 100 MHz Else SF = Format(SF , "000.00") 'format string for >= 100 MHz End If Lcdat 5 , 10 , "Freq" , 0 'show Frequency in MHz Lcdat 5 , 50 , SF , 0 Lcdat 5 , 100 , "MHz" , 0 REstate = 0 a = 0 'reset incremental flag Loop until KeyCode = &h7A 'SW5 Quit Call RDA5807M_SetMyDefault() KeyCode = &hFA 'reset KeyCode a = 0 'reset action flag REstate = 0 'reset incremental flag LEDFM = 0 'orange LED OFF - symbolizes FM OFF LEDST = 0 'red LED OFF - symbolizes Stereo OFF End Sub Sub ShowRSSI() 'Show Received Signal Strength Indication - RSSI Lcdat 1 , 6 , " RSSI " , 1 Call ClearDrawingArea() Lcdat 3 , 20 , SN , 0 rssi = 0 Do rssiold = rssi Call RDA5807M_GetRSSI() 'read actual RSSI value Lcdat 4 , 20 , "RSSI" , 0 Lcdat 4 , 55 , rssi , 0 'show RSSI value Lcdat 7 , 6 , "1" , 0 Lcdat 7 , 55 , "9" , 0 Lcdat 7 , 100 , "+60" , 0 n = 3 For m = 1 To 9 'Scale S1...S9 n = n + 6 Line(n , 45) -(n , 48) , 1 Next m For m = 1 To 6 'Scale S9...S9+60 n = n + 10 Line(n , 45) -(n , 48) , 1 Next m Box(9 , 40) -(117 , 45) , 1 'show RSSI box Boxfill(10 , 41) -(rssi , 44) , 1 'show RSSI bar Waitms 600 If rssiold <> rssi Then Boxfill(10 , 41) -(116 , 44) , 0 'clear RSSI bar End If Loop until KeyCode = &h7A 'SW5 Quit KeyCode = &hFA 'reset KeyCode a = 0 'reset action flag REstate = 0 'reset incremental flag End Sub Sub ControlVolume() Call ClearDrawingArea() Lcdat 1 , 6 , " Volume " , 1 Lcdat 3 , 8 , " 0 - 15 " , 0 Lcdat 4 , 55 , VL , 0 'show Volume start value VX = VL*7 'scale VL to bar If VX > 105 Then VX = 105 'MAX scaled VL Box(9 , 40) -(117 , 50) , 1 'show Volume box Boxfill(10 , 41) -(VX+11 , 49) , 1 'show actual Volume bar Do VLold = VL Do 'monitor user action If REstate <> 0 Then a = 1 'wait until RE is moved If KeyCode <> &hFA Then a = 1 'wait until key pressed Loop Until a <> 0 Lcdat 4 , 2 , " " , 0 'clear old displayed Volume Disable timer0 'stop Timer0 for RE state If REstate = 1 Then 'KeyUp - Encoder increment If VL >= 1 Then Decr VL 'Volume MIN is 0 End If If REstate = 2 Then 'KeyDwn - Encoder decrement If VL <= 14 Then Incr VL 'Volume MAX is 15 End If Enable Timer0 'enable Timer0 Call RDA5807M_SetVolume(VL) 'set Volume in RegH05 Lcdat 4 , 55 , VL , 0 'show new Volume value VX = VL*7 'scale VL to bar If VX > 105 Then VX = 105 'MAX scaled VL If VL > VLold Then Boxfill(10 , 41) -(VX+11 , 49) , 1 'show Volume bar If VL < VLold Then Boxfill(10 , 41) -(116 , 49) , 0 'clear Volume bar Boxfill(10 , 41) -(VX+11 , 49) , 1 'show actual Volume bar End If REstate = 0 'reset incremental flag a = 0 Loop until KeyCode = &h7A 'SW5 Quit - exit loop KeyCode = &hFA 'reset KeyCode a = 0 'reset action flag REstate = 0 'reset incremental flag End Sub Sub ProcessRDS() 'Process RDS Call RDA5807M_RDSinit() 'init RDS register values PSN = Space(8) TStr = Space(5) cnt = 0 Call ClearDrawingArea() Lcdat 1 , 6 , " RDS Data " , 1 Lcdat 3 , 6 , " Name and Time " , 0 Do 'continuous polling of rds data RDSerr = 0 Call RDA5807M_RDSstatus() 'determine the RDS status If RDSR = 1 Then 'check RDS ready (RDSR) Call RDA5807M_RDSdata() 'read RDS Blocks If RDSerr = 0 Then Call DecodeRDSdata() 'decode RDS blocks End If End If If cnt = 4 Then PSN = Trim(PSN) Lcdat 5 , 30 , PSN , 0 'show Program Service Name cnt = 0 End If TStr = Trim(TStr) Lcdat 7 , 30 , TStr , 0 'show RDS Time (local time zone!) Waitms 40 Loop until KeyCode = &h7A 'SW5 Quit KeyCode = &hFA 'reset KeyCode a = 0 'reset action flag REstate = 0 'reset incremental flag End Sub Sub ShowOverview() 'show Overviews of Settings Call ClearDrawingArea() Lcdat 1 , 6 , " Overview 1 " , 1 'show Overview 1 Lcdat 3 , 2 , "Name" , 0 Lcdat 3 , 40 , SN , 0 Lcdat 4 , 2 , "Freq" Lcdat 4 , 40 , SF , 0 Lcdat 4 , 80 , "MHz" , 0 Lcdat 5 , 2 , "Spacing" , 0 fskhz = fspace / 1000 Lcdat 5 , 60 , fskhz , 0 Lcdat 5 , 90 , "kHz" , 0 Call RDA5807M_GetRSSI() 'read actual RSSI value Lcdat 6 , 2 , "Signal" , 0 Lcdat 6 , 60 , rssi , 0 Lcdat 7 , 2 , "Volume" , 0 Lcdat 7 , 60 , VL , 0 Do 'NOP Loop until KeyCode = &h7A 'SW5 Quit KeyCode = &hFA 'reset KeyCode reg = I2CreadRegister(&h02) 'read RegH02 Call ClearDrawingArea() Lcdat 1 , 6 , " Overview 2 " , 1 'show Overview 2 Lcdat 3 , 2 , "Stereo" , 0 If reg.13 = 0 Then 'Stereo ON Lcdat 3 , 60 , "ON" , 0 Else Lcdat 3 , 60 , "OFF" , 0 End If Lcdat 4 , 2 , "RDS" If reg.3 = 1 Then 'RDS ON Lcdat 4 , 60 , "ON" , 0 Else Lcdat 4 , 60 , "OFF" , 0 End If Lcdat 6 , 2 , "BB" , 0 If reg.12 = 1 Then 'BassBoost ON Lcdat 6 , 60 , "ON" , 0 Else Lcdat 6 , 60 , "OFF" , 0 End If reg = I2CreadRegister(&h04) 'read RegH04 Lcdat 5 , 2 , "AFC" , 0 If reg.8 = 0 Then 'AFC ON Lcdat 5 , 60 , "ON" , 0 Else Lcdat 5 , 60 , "OFF" , 0 End If Do 'NOP Loop until KeyCode = &h7A 'SW5 Quit KeyCode = &hFA 'reset KeyCode a = 0 'reset action flag REstate = 0 'reset incremental flag End Sub Sub SeekWindow() 'Scan Frequency Call ClearDrawingArea() Lcdat 1 , 6 , " Seek " , 1 Lcdat 3 , 10 , "Scan begin..." , 0 Wait 1 Call ClearDrawingArea() Call RDA5807M_Seek() Call ClearDrawingArea() Lcdat 3 , 10 , "Scan end." , 0 Lcdat 5 , 10 , "Station:" , 0 Lcdat 5 , 75 , cnt , 0 'show Station counter Do 'NOP Loop until KeyCode = &h7A 'SW5 Quit Call RDA5807M_SetMyDefault() 'set my default values KeyCode = &hFA 'reset KeyCode a = 0 'reset action flag REstate = 0 'reset incremental flag End Sub Sub FMexWindow() 'Expert Mode with direct Frequency input Call ClearDrawingArea() Lcdat 1 , 6 , " Expert Mode " , 1 'the frequency range of the expert mode goes from 50 - 115 MHz, 'but I implemented here only as a test from 87 - 108 MHz Freq = 92400000 'only for test --> exFMStart Call RDA5807M_SetDirFreq(Freq) Lcdat 4 , 20 , "Frequency" , 0 Lcdat 6 , 20 , Freq , 0 Lcdat 6 , 95 , "Hz" , 0 LEDFM = 1 'orange LED ON - symbolizes FM ON LEDST = 0 'red LED OFF - symbolizes Stereo OFF Do Do 'monitor user action If REstate <> 0 Then a = 1 'wait until RE is moved If KeyCode <> &hFA Then a = 1 Loop Until a <> 0 Disable timer0 'stop Timer0 for RE state If REstate = 1 Then 'KeyUp - Encoder increment If Freq <= exFMEnd Then Freq = Freq - 25000 End If If REstate = 2 Then 'KeyDwn - Encoder decrement If Freq >= exFMStart Then Freq = Freq + 25000 End If Enable Timer0 'enable Timer0 Call RDA5807M_SetDirFreq(Freq) Lcdat 6 , 20 , " " , 0 Lcdat 6 , 20 , Freq , 0 REstate = 0 a = 0 'reset incremental flag Loop until KeyCode = &h7A 'SW5 Quit Call RDA5807M_SetMyDefault() KeyCode = &hFA 'reset KeyCode a = 0 'reset action flag REstate = 0 'reset incremental flag LEDFM = 0 'orange LED OFF - symbolizes FM OFF LEDST = 0 'red LED OFF - symbolizes Stereo OFF End Sub Sub AMWindow() 'Option - AM receive --> other chip! Lcdat 1 , 6 , " AM Mode " , 1 Call ClearDrawingArea() Lcdat 4 , 4 , "Hardware option" , 0 Lcdat 5 , 4 , "Not implemented" , 0 LEDFM = 0 'orange LED OFF - symbolizes FM OFF LEDST = 0 'red LED OFF - symbolizes Stereo OFF Do 'NOP Loop until KeyCode = &h7A 'SW5 Quit KeyCode = &hFA 'reset KeyCode a = 0 'reset action flag REstate = 0 'reset incremental flag End Sub '------------------------ RDA5807M sub routines--------------------------------- Sub I2CwriteRegister(ByVal reg As Byte , ByVal cont As Word) 'write cont I2cstart 'START condition I2cwbyte RND_WriteAdr 'RDA5807M address / random write mode I2cwbyte reg 'Register reg I2cwbyte High(cont) 'High Byte of cont I2cwbyte Low(cont) 'Low Byte of cont I2cstop 'STOP condition End Sub Function I2CreadRegister(ByVal reg As Byte) As Word 'read from reg register I2cstart 'START condition I2cwbyte RND_WriteAdr 'RDA5807M address / random write mode I2cwbyte reg 'Register reg I2cstop 'STOP condition I2cstart 'START condition I2cwbyte RND_ReadAdr 'RDA5807M address / random read mode I2crbyte hB , ack 'read high Byte I2crbyte lB , Nack 'read low Byte I2cstop 'STOP condition regW = hb 'hb in word LSB shift regW , left , 8 'shift to MSB regW = regW + lB 'lB in LSB I2CreadRegister = regW 'return register Word End Function Sub RDA5807M_SetMyDefault() 'Set my default values I2cstart 'START condition I2cwbyte SEQ_WriteAdr 'RDA5807M address / sequential write mode I2cwbyte High(RegH02) I2cwbyte Low(RegH02) I2cwbyte High(RegH03) I2cwbyte Low(RegH03) I2cwbyte High(RegH04) I2cwbyte Low(RegH04) I2cwbyte High(RegH05) I2cwbyte Low(RegH05) I2cwbyte High(RegH06) I2cwbyte Low(RegH06) I2cwbyte High(RegH07) I2cwbyte Low(RegH07) I2cwbyte High(RegH08) I2cwbyte Low(RegH08) I2cstop 'STOP condition End Sub Sub RDA5807M_Init() 'Initialize chip Call I2CwriteRegister(&h02 , &b0000_0000_0000_0010) 'SOFT_RESET - reset chip Waitms 50 'wait 50 ms Call I2CwriteRegister(&h02 , &b0000_0000_0000_0001) 'ENABLE = 1 - Power On Waitms 600 'stabilization Call RDA5807M_SetMyDefault() 'set my default values Waitms 50 End Sub Sub RDA5807M_ReadSTC() 'Read Seek/Tune complete flag STC = &h00 'STC = 0 --> Seek/Tune not complete While STC = &h00 I2cstart 'START condition I2cwbyte RND_WriteAdr 'RDA5807M address / random write mode I2cwbyte &h0A 'Register h0A I2cstop 'STOP condition I2cstart 'START condition I2cwbyte RND_ReadAdr 'RDA5807M address / random read mode I2crbyte STC , Nack 'read high Byte in STC Byte I2cstop 'STOP condition STC = STC AND &b0100_0000 'STC = 1 --> Seek/Tune complete flag WEnd End Sub Sub RDA5807M_SetMuteOn() 'set mute - change state to Mute On MT = I2CreadRegister(&h02) If MT.14 = 1 Then 'No mute - normnal operation MT = MT XOR &b0100_0000_0000_0000 'Change to mute End If Call I2CwriteRegister(&h02 , MT) 'Write Mute state End Sub Sub RDA5807M_SetMuteOff() 'set unmute - change state to normal operation MT = I2CreadRegister(&h02) If MT.14 = 0 Then 'Mute MT = MT XOR &b0100_0000_0000_0000 'Change to normal operation End If Call I2CwriteRegister(&h02 , MT) 'Write Mute state End Sub Sub RDA5807M_SetBassBoostOn() 'set BassBoost ON BB = I2CreadRegister(&h02) If BB.12 = 0 Then 'BassBoost OFF BB = BB XOR &b0001_0000_0000_0000 'change to ON End If Call I2CwriteRegister(&h02 , BB) End Sub Sub RDA5807M_SetBassBoostOff() 'set BassBoost OFF BB = I2CreadRegister(&h02) If BB.12 = 1 Then 'BossBoost ON BB = BB XOR &b0001_0000_0000_0000 'change to OFF End If Call I2CwriteRegister(&h02 , BB) End Sub Sub RDA5807M_SetStereoON() 'set Stereo ON STO = I2CreadRegister(&h02) If STO.13 = 1 Then 'Stereo OFF STO = STO XOR &b0010_0000_0000_0000 'change to ON End If Call I2CwriteRegister(&h02 , STO) LEDST = 1 End Sub Sub RDA5807M_SetStereoOFF() 'set Stereo OFF STO = I2CreadRegister(&h02) If STO.13 = 0 Then 'Stereo ON STO = STO XOR &b0010_0000_0000_0000 'change to OFF End If Call I2CwriteRegister(&h02 , STO) LEDST = 0 End Sub Sub RDA5807M_SetAFCon() 'set AFC ON AFC = I2CreadRegister(&h04) If AFC.8 = 1 Then 'AFC OFF AFC = AFC XOR &b0000_0001_0000_0000 'change to ON End If Call I2CwriteRegister(&h04 , AFC) End Sub Sub RDA5807M_SetAFCoff() 'set AFC OFF AFC = I2CreadRegister(&h04) If AFC.8 = 0 Then 'AFC ON AFC = AFC XOR &b0000_0001_0000_0000 'change to OFF End If Call I2CwriteRegister(&h04 , AFC) End Sub Sub RDA5807M_SetVolume(ByVal VolNew As Word) 'Set Volume (0000 --> 1111) VolNew = VolNew AND &b0000_0000_0000_1111 'first nibble mask Vol = I2CreadRegister(&h05) 'read old RegH05 values Vol = Vol AND &b1111_1111_1111_0000 'mask with NOT first nibble Vol = Vol OR VolNew 'RegH05 with new Volume Call I2CwriteRegister(&h05, Vol) 'write new values in register End Sub Sub RDA5807M_SetFreq() 'Set Frequency If Freq < FMstart Then Freq = FMstart 'Lowest frequency of EU Band If Freq > FMend Then Freq = FMend 'Highest frequency of EU Band Call RDA5807M_SetMuteOn() 'Change Mute state to ON Chan = Freq - FMstart 'Freq --> Chan Chan = Chan / fspace Val1 = Chan Shift Val1 , left , 6 'Chan on Bits [15:6] of RegH03 Reg = Val1 Reg.4 = 1 'set Tune Bit Call I2CwriteRegister(&h03, Reg) 'write register H03 Waitms 50 Call RDA5807M_ReadSTC() 'Wait for Seek/Tune complete Call RDA5807M_SetMuteOff() 'Change Mute state to OFF End Sub Sub RDA5807M_SetSpacing(ByVal spg As Byte) 'Set Spacing spg1 = spg AND &b0000_0000_0000_0011 'Bit 1:0 mask spg2 = I2CreadRegister(&h03) 'read old RegH03 values spg2 = spg2 AND &b1111_1111_1111_1100 'mask with NOT Bits spg2 = spg2 OR spg1 'RegH03 with new Spacing Call I2CwriteRegister(&h03, spg2) 'write new values in register If spg1 = 0 Then fspace = 100000 'khZ If spg1 = 1 Then fspace = 200000 If spg1 = 2 Then fspace = 50000 If spg1 = 3 Then fspace = 25000 End Sub Sub RDA5807M_GetRSSI() 'return radio station strength information si = I2CreadRegister(&h0B) Shift si , right , 9 rssi = Low(si) End Sub Sub RDA5807M_GetStatus() 'Read the Tune/Seek status stat1 = I2CreadRegister(&h0A) 'Read RegH0A stat2 = I2CreadRegister(&h0B) 'Read RegH0B Waitms 20 STO = stat1.10 'Stereo indicator (Mono = 0) STC = stat1.14 'Seek/Tune complete flag 'SFF = stat1.13 'Seek fail flag RSSI < SeekTh ! FMtrue = stat2.8 'Station found flag rssi = stat2 AND &b1111_1110_0000_0000 'RSSI [9-15] Shift rssi , right , 9 RChan = stat1 AND &b0000_0011_1111_1111 'Channel of the station End Sub Sub RDA5807M_Tune() 'Tune FM Frequeny Call RDA5807M_SetMuteOn() 'Mute Chan = Freq - FMstart 'Freq --> Chan Chan = Chan / fspace Val1 = Chan Shift Val1 , left , 6 'Chan on Bits [15:6] of RegH03 Reg = Val1 Reg.4 = 1 'set Tune Bit Call I2CwriteRegister(&h03, Reg) 'write register H03 Waitms 50 Call RDA5807M_ReadSTC() 'Wait for Seek/Tune complete Call RDA5807M_SetMuteOff() 'Change Mute state to OFF End Sub '----- Software Seek/Scan ----- Sub RDA5807M_Seek() 'Scan Europe BC Band cnt = 0 'True Station counter STHW = 8 'default threshold = 8 of 15 Freq = 87500000 '87.5 MHz as Start Call RDA5807M_SetMuteOn() 'Mute 'set Seek control values Reg = I2CreadRegister(&h02) Reg.9 = 1 'SeekUp = 1 --> Seek up Reg.8 = 1 'Seek = 1 --> Enable Reg.7 = 1 'SKmode = 1 --> stop seeking at band limit Call I2CwriteRegister(&h02 , Reg) 'write RegH02 - start Seek Reg = I2CreadRegister(&h05) Shift STHW , left, 8 'shift left to [8-11] Reg = Reg OR STHW Call I2CwriteRegister(&h05 , Reg) 'write new threshold value Chan = Freq - FMstart 'Freq --> Chan Chan = Chan / fspace Val1 = Chan Shift Val1 , left , 6 'Chan on Bits [15:6] of RegH03 Reg = Val1 Reg.4 = 1 'set Tune Bit Call I2CwriteRegister(&h03, Reg) 'write register H03 Waitms 50 While Freq <= FMend 'Scan-Loop until last Frequency Call RDA5807M_GetStatus() 'read RegH0A, RegH0B If STC = 1 AND FMtrue = 1 Then 'Radio Station is true Incr cnt Call RDA5807M_SetMuteOff() Lcdat 3 , 10 , "Chan" , 0 Lcdat 3 , 50 , RChan , 0 Lcdat 7 , 10 , "Station:" , 0 Lcdat 7 , 75 , cnt , 0 'show Station counter LEDFM = 1 'orange LED ON - symbolizes FM ON LEDST = 1 'red LED ON - symbolizes Stereo ON Wait 4 'wait 4 sec and then go on scan '################################################################ '# For final radio code write here the evaluation and # '# storage routines for RChan, ST and RSSI etc # '################################################################ Call ClearDrawingArea() LEDFM = 0 'orange LED OFF - symbolizes FM OFF LEDST = 0 'red LED OFF - symbolizes Stereo OFF End If Call RDA5807M_SetMuteOn() Chan = Chan + 1 'new Channel Val1 = Chan Shift Val1 , left , 6 Reg = Val1 Reg.4 = 1 'set Tune Bit Call I2CwriteRegister(&h03, Reg) 'write register H03 Waitms 50 Freq = fspace * Chan Freq = Freq + FMStart 'new Frequency FMHZ = Freq / 10000 SF = Str(FMHZ) SF = LTrim(SF) If Len(SF) = 4 Then SF = Format(SF , "00.00") 'format string for < 100 MHz Else SF = Format(SF , "000.00") 'format string for >= 100 MHz End If Lcdat 5 , 10 , "Freq" , 0 'show Frequency in MHz Lcdat 5 , 50 , SF , 0 Lcdat 5 , 100 , "MHz" , 0 WEnd 'Scan-Loop end End Sub '----- RDS ----- Sub RDA5807M_RDSinit() 'init RDS - write RDS register values RDS = I2CreadRegister(&h02) 'Read RegH02 If RDS.3 = 0 Then RDS = RDS OR &b0000_0000_0000_1000 Call I2CwriteRegister(&h02 , RDS) 'RegH02 [3] RDS Enable Waitms 50 RDS = I2CreadRegister(&h04) 'Read RegH04 RDS.13 = 0 'RegH04 [13] Only RDS RDS.12 = 0 'RegH04 [12] RDS_FIFO disable RDS.10 = 0 'RegH04 [10] RDS_FIFO no clear Call I2CwriteRegister(&h04 , RDS) 'Config RDS Waitms 50 End Sub Sub RDA5807M_RDSstatus() 'RDS Status Byte 'Status Byte: RDSR, RDSS, BLK_EF, ABCD_E, BLERA BLERA, BLERB BLERB RDSstat1 = I2CreadRegister(&h0A) 'Read RegH0A RDSstat2 = I2CreadRegister(&h0B) 'Read RegH0B RDSstat2 = RDSstat2 AND &b0000_0000_0001_1111 RDSstat2.7 = RDSstat1.15 'RDSR - RDSready RDSstat2.6 = RDSstat1.12 'RDSS - RDSsync RDSstat2.5 = RDSstat1.11 'BLKEF RDSstatus = Low(RDSstat2) 'Status Byte RDSR = RDSstatus.7 'RDSready End Sub 'In the documented RDA5807M registers &h0A - &h0F no readout of the BLERC and 'BLERD is possible. Without a documented function description, it is also not 'possible to map the exact sequence of RDS synchronization in the program code. Sub RDA5807M_RDSdata() 'Read RDS data - Blocks and Group Type 'read RDS Data Blocks A-D RDSA = I2CreadRegister(&h0C) RDSB = I2CreadRegister(&h0D) RDSC = I2CreadRegister(&h0E) RDSD = I2CreadRegister(&h0F) RDSerr = 0 stat = RDSstatus AND &b0000_1100 If stat < 3 Then stat = RDSstatus AND &b0000_0011 'BLERA < 3 If stat < 2 Then 'BLERB < 2 GT = High(RDSB) 'Group Type Code GT = GT AND &b1111_0000 B0 = RDSB.11 'Version Flag A or B (0 or 1) 'mask Group Type for hexadecimal notation GT = &h0A OR GT GT = GT OR B0 Else RDSerr = 1 End If Else RDSerr = 1 End If End Sub Sub DecodeRDSdata() 'Decode RDS Data 'Simple version only for Program Service Name and Time. Only Group '0A, 0B and 4A are analyzed If GT = &h0A OR GT = &h0B Then 'Group Type h0A OR &h0B for PS C10 = Low(RDSB) C10 = C10 AND &b0000_0011 PS0 = Low(RDSD) 'b0 - b7 PS1 = High(RDSD) 'b8 - b15 PSChr1 = Chr(PS1) PSChr0 = Chr(PS0) Select Case C10 Case 0: MID(PSN , 1 , 1) = PSChr1 MID(PSN , 2 , 1) = PSChr0 Incr cnt Case 1: MID(PSN , 3 , 1) = PSChr1 MID(PSN , 4 , 1) = PSChr0 Incr cnt Case 2: MID(PSN , 5 , 1) = PSChr1 MID(PSN , 6 , 1) = PSChr0 Incr cnt Case 3: MID(PSN , 7 , 1) = PSChr1 MID(PSN , 8 , 1) = PSChr0 Incr cnt End Select End If If GT = &h4A Then 'Group Type for Time 'Minutes T1 = Low(RDSD) Shift T1 , right , 6 T2 = High(RDSD) AND &b0000_1111 Shift T2 , left , 2 minutes = T2 + T1 'Hours T1 = High(RDSD) Shift T1 , right , 4 T2 = Low(RDSC) AND &b0000_0001 Shift T2 , left , 4 hours = T2 + T1 'take into account Local Time Offset LTO = Low(RDSD) AND &b0001_1111 Shift LTO , right , 1 T1 = Low(RDSD) If T1.5 = 1 Then 'Sign of LTO is minus hours = hours - LTO Else hours = hours + LTO End If 'simple format the Time-String Tms = Str(hours) If hours < 10 Then Tms = "0" + Tms TStr = Tms + ":" Tms = Str(minutes) If minutes < 10 Then Tms = "0" + Tms TStr = TStr + Tms 'new local Time String at the full minute End If End Sub '----- Expert Mode ----- 'Frequency 50 - 115.535 MHz in Expert Mode with 1 kHz Space 'RegH02 [13] = &b1 --> Mono 'RegH03 [2-3] = &b11 --> Band 'RegH07 [9] = &b0 --> 65M_50M Mode 'RegH07 [0] = &b1 --> Freq_Mode 'RegH08 [0-15] = xxxx_xxxx_xxxx_xxxx --> Freq_Direct Sub RDA5807M_SetExpertReg() 'set register to expert values Call RDA5807M_SetMyDefault() 'Change to Expert Mode Call I2CwriteRegister(&h02, &b1010_0010_0000_0101) 'write register H02 LEDST = 0 Call I2CwriteRegister(&h03, &b0000_0000_0000_1100) 'write register H03 Call I2CwriteRegister(&h07, &b0100_0000_0000_0011) 'write register H07 End Sub Sub RDA5807M_SetDirFreq(ByVal newF As DWord) 'direct frequency input Call RDA5807M_SetMuteOn() 'change to Mute ON state Call RDA5807M_SetExpertReg() 'set register to expert values If newF < exFMstart Then newF = exFMstart 'Lowest frequency --> 50 MHz If newF > exFMend Then newF = exFMend 'Highest frequency --> 115 MHz fx = newF - exFMstart 'Difference frequency FreqDW = fx / 1000 'Frequency with Space 1 kHz FreqW = FreqDW 'Typecasting --> MAX = 65535 Call I2CwriteRegister(&h08 , FreqW) 'set frequency - RegH08 Waitms 300 'wait 300 ms ! Call RDA5807M_SetMuteOff() 'change to Mute OFF state End Sub '---------------------- Interrupt service requests ----------------------------- Isr_keypad: 'ISR - Keypad hardware INT KeyCode = PinD AND &b1111_1010 'read PortD and mask Return Isr_Timer0: 'ISR - Rotary Encoder Timer0 = 0 'Timer preset REnew.0 = PINB.0 'read RE A hardware REnew.1 = PINB.1 'read RE B hardware If REnew <> REold Then 'Rotary Encoder is turned 'Detection of the direction of rotation If REnew = &b0000_0000 AND REold = &b0000_0001 Then REstate = 2 'CW If REnew = &b0000_0000 AND REold = &b0000_0010 Then REstate = 1 'CCW If REnew = &b0000_0011 AND REold = &b0000_0010 Then REstate = 2 'CW If REnew = &b0000_0011 AND REold = &b0000_0001 Then REstate = 1 'CCW REold = REnew 'Update status End If Return '----- GLCD Data --------------------------------------------------------------- Intropic: $bgf "Tuner.bgf" $include "font8x8.font" '----- FM Radio Station Data | 6 fix FM broadcast frequencies at JN87AQ -------- '# set here your fix radio station frequencies in 10 kHz units RS1: Data "8820" , "OE3" RS2: Data "9030" , "OE1" RS3: Data "9240" , "FM4 " RS4: Data "9580" , "OE2 NOE" RS5: Data "9820" , "R886" RS6: Data "10290" , "Kronehit" '############################ End Of File ######################################