' _____________________________________________________________________________ '|Program "analizator widma akustycznego 16*2 - V2" kompilator bascom 1.11.9.0 | '|Autor: HUNTERHOUSE(Adam Kêdzierski) i czê½ciowo MANEKINEN(Pawe³ Kisielewski) | '| data: 21.12.2009 | '| | '| info: http://www.elektroda.pl/rtvforum/topic776332-0.html | '| www: http://diy.elektroda.eu/analizator-widma-v2 | '| wszelkie modyfikacje dozwolone, publikuj¹c nale¿y zachowaæ ten nag³ówek | '| WY£¥CZNIE DO U¯YTKU NIEKOMERCYJNEGO - NON-COMMERCIAL USE ONLY | ' ----------------------------------------------------------------------------- $regfile = "m8def.dat" $crystal = 16000000 Const Falloff = 1 'ilo½æ cykli po jakim s³upki opadn¹, wolne opadanie Const Timer1_h = _xtal / 44000 Const Timer1_l = _xtal / 2000 Reset Watchdog Config Watchdog = 256 Stop Watchdog Dim Div As Iram Integer At 16 Dim K As Byte Dim I As Byte Dim Tmp_s As Integer Dim Tmp_c As Integer Dim Beta As Iram Byte Dim Suma As Word Dim Sam As Byte Dim Sampling As Bit Dim Rex_t As Integer , Imx_t As Integer Dim Dane(32) As Integer Dim Sample_h(32) As Integer Dim Sample_l(32) As Integer Dim Okno(32) As Byte Dim Rex(16) As Integer Dim Sinus(40) As Integer Dim Wynik(16) As Byte , Wynik_o(16) As Byte 'x Dim Sing As Single Dim Poziom As Integer Dim Line1d(16) As Byte 'x Dim Line2d(16) As Byte 'x Dim Falloff_count(16) As Byte 'x $lib "lcd4busy.lib" Const _lcdport = Portd Const _lcdddr = Ddrd Const _lcdin = Pind Const _lcd_e = 3 Const _lcd_rw = 2 Const _lcd_rs = 1 Config Lcd = 16 * 2 'x '****** dodano w wesji 2 *********** Dim Jasnosc_e As Eram Byte At 1 Dim Czulosc_e As Eram Byte At 2 Dim Efekt_e As Eram Byte At 3 Dim Jasnosc As Byte Dim Jasnosc_vfd As Byte Dim Czulosc As Byte Dim Poziom_a As Byte Dim Efekt As Byte Dim Lazienka_jest_zamknieta As Byte 'hahaha a czemu nie! Dim Uklad As Byte Dim Jasnosc_flaga As Bit Dim Czulosc_flaga As Bit Config Portb = &B00001000 Portb = &B11111111 Config Portc = Input Portc.5 = 1 Portc.4 = 1 Jasn_up Alias Pinb.5 Jasn_dn Alias Pinb.4 Czul_up Alias Pinb.2 Czul_dn Alias Pinb.1 Tryb Alias Pinb.0 Presc Alias Pinc.5 Vfd Alias Pinc.4 'Dim Presc As Bit 'Dim Vfd As Bit 'Presc = 0 'Vfd = 0 Efekt = Efekt_e Gosub Lcdchr Czulosc = Czulosc_e 'Czulosc = 15 '************************** Poziom_a = Czulosc * 0.4 Poziom_a = 8 - Poziom_a Jasnosc = Jasnosc_e 'Jasnosc = 50 '************************** Config Timer2 = Pwm , Prescale = 1 , Compare Pwm = Clear Up If Vfd = 0 Then Jasnosc_vfd = Jasnosc / 10 If Jasnosc_vfd > 3 Then Jasnosc_vfd = 3 Lcdcontrast Jasnosc_vfd Else Ocr2 = Jasnosc * 5 End If '***** ****ec ********************** Config Adc = Single , Prescaler = 4 , Reference = Avcc Start Adc Config Timer1 = Timer , Prescale = 1 On Compare1a Sampleh On Compare1b Samplel Compare1a = Timer1_h Compare1b = Timer1_l Enable Timer1 Start Timer1 Enable Interrupts Disable Int0 Disable Int1 For K = 0 To 31 Sinus(k + 1) = Lookup(k , Tab_sin) 'Okno(k + 1) = 255 'Okno(k + 1) = Lookup(k , Okno_blackman) 'Okno(k + 1) = Lookup(k , Okno_hamming) Okno(k + 1) = Lookup(k , Okno_hanning) Next K Sinus(33) = Lookup(0 , Tab_sin) Sinus(34) = Lookup(1 , Tab_sin) Sinus(35) = Lookup(2 , Tab_sin) Sinus(36) = Lookup(3 , Tab_sin) Sinus(37) = Lookup(4 , Tab_sin) Sinus(38) = Lookup(5 , Tab_sin) Sinus(39) = Lookup(6 , Tab_sin) Sinus(40) = Lookup(7 , Tab_sin) Start Watchdog Main: Do Reset Watchdog Gosub Buttons Gosub Sample_h Main_1: If Sampling = 1 Then Goto Main_1 Gosub Sample_l Gosub Copy_low Gosub Dft Gosub Przelicz_low Gosub Copy_high Gosub Dft Gosub Przelicz_high Main_3: If Sampling = 1 Then Goto Main_3 Gosub Save Loop Copy_high: Poziom = 0 For K = 1 To 32 Div = Sample_h(k) asr r17:ror r16:asr r17:ror r16 Sample_h(k) = Div Poziom = Poziom + Sample_h(k) Next K Div = Poziom asr r17:ror r16:asr r17:ror r16:asr r17:ror r16:asr r17:ror r16 asr r17:ror r16 Poziom = Div For K = 1 To 32 Dane(k) = Sample_h(k) - Poziom Dane(k) = Dane(k) * Okno(k) Div = Dane(k) asr r17:ror r16:asr r17:ror r16:asr r17:ror r16:asr r17:ror r16 asr r17:ror r16:asr r17:ror r16:asr r17:ror r16:asr r17:ror r16 Dane(k) = Div If Dane(k) > 127 Then Dane(k) = 127 If Dane(k) < -127 Then Dane(k) = -127 Next K Return Copy_low: Poziom = 0 For K = 1 To 32 Div = Sample_l(k) asr r17:ror r16:asr r17:ror r16 Sample_l(k) = Div Poziom = Poziom + Sample_l(k) Next K Div = Poziom asr r17:ror r16:asr r17:ror r16:asr r17:ror r16:asr r17:ror r16 asr r17:ror r16 Poziom = Div For K = 1 To 32 Dane(k) = Sample_l(k) - Poziom Dane(k) = Dane(k) * Okno(k) Div = Dane(k) asr r17:ror r16:asr r17:ror r16:asr r17:ror r16:asr r17:ror r16 asr r17:ror r16:asr r17:ror r16:asr r17:ror r16:asr r17:ror r16 Dane(k) = Div If Dane(k) > 127 Then Dane(k) = 127 If Dane(k) < -127 Then Dane(k) = -127 Next K Return Dft: For K = 1 To 15 Rex_t = 0 Imx_t = 0 For I = 0 To 31 Beta = I * K Beta = Beta And 31 Tmp_s = Sinus(beta + 1) * Dane(i + 1) Tmp_c = Sinus(beta + 8) * Dane(i + 1) Div = Tmp_s asr r17:ror r16:asr r17:ror r16:asr r17:ror r16:asr r17:ror r16 asr r17:ror r16:asr r17:ror r16:asr r17:ror r16:asr r17:ror r16 Tmp_s = Div Div = Tmp_c asr r17:ror r16:asr r17:ror r16:asr r17:ror r16:asr r17:ror r16 asr r17:ror r16:asr r17:ror r16:asr r17:ror r16:asr r17:ror r16 Tmp_c = Div Rex_t = Rex_t + Tmp_c Imx_t = Imx_t - Tmp_s Next I Div = Rex_t asr r17:ror r16:asr r17:ror r16:asr r17:ror r16 Rex_t = Div Div = Imx_t asr r17:ror r16:asr r17:ror r16:asr r17:ror r16 Imx_t = Div Tmp_c = Rex_t * Rex_t Tmp_s = Imx_t * Imx_t Tmp_c = Tmp_c + Tmp_s Rex(k + 1) = Sqr(tmp_c) Next K Return Sample_l: 'pobiera 32 próbki z czêstotliwo½ci¹ 2kHz Config Adc = Single , Prescaler = Auto , Reference = Avcc Start Adc Timer1 = 0 Enable Compare1b Sam = 0 Sampling = 1 Return Samplel: Timer1 = 0 Incr Sam Sample_l(sam) = Getadc(1) 'NI¯SZE PASMO If Sam = 32 Then Disable Compare1b Sampling = 0 End If Return Sample_h: 'pobiera 32 próbki z czêstotliwo½ci¹ 44kHz If Presc = 0 Then Config Adc = Single , Prescaler = 4 , Reference = Avcc Else Config Adc = Single , Prescaler = 2 , Reference = Avcc End If 'ADC dzia³a ju¿ do½æ niestabilnie na preskalerze 2 ale na 4 ju¿ sie nie wyrobi i prubkuje z f=37kHz ' przez du¿e f pojawiaja sie szumy jak podajemy sygna³ z generatora Start Adc Timer1 = 0 Enable Compare1a Sam = 0 Sampling = 1 Return Sampleh: Timer1 = 0 Incr Sam Sample_h(sam) = Getadc(0) 'WY¯SZE PASMO If Sam = 32 Then Disable Compare1a Sampling = 0 End If Return Przelicz_high: 'x Suma = Rex(3) Wynik(9) = Suma Suma = Rex(4) Wynik(10) = Suma Suma = Rex(5) Wynik(11) = Suma Suma = Rex(6) Wynik(12) = Suma Suma = Rex(7) If Rex(8) > Suma Then Suma = Rex(8) Wynik(13) = Suma Suma = Rex(9) If Rex(10) > Suma Then Suma = Rex(10) Wynik(14) = Suma Suma = Rex(11) If Rex(12) > Suma Then Suma = Rex(12) If Rex(13) > Suma Then Suma = Rex(13) Wynik(15) = Suma Suma = Rex(14) If Rex(15) > Suma Then Suma = Rex(15) If Rex(16) > Suma Then Suma = Rex(16) Wynik(16) = Suma Return Przelicz_low: 'x Suma = Rex(2) Wynik(1) = Suma Suma = Rex(3) Wynik(2) = Suma Suma = Rex(4) Wynik(3) = Suma Suma = Rex(5) If Rex(6) > Suma Then Suma = Rex(6) Wynik(4) = Suma Suma = Rex(7) If Rex(8) > Suma Then Suma = Rex(8) Wynik(5) = Suma Suma = Rex(9) If Rex(10) > Suma Then Suma = Rex(10) Wynik(6) = Suma Suma = Rex(11) If Rex(12) > Suma Then Suma = Rex(12) If Rex(13) > Suma Then Suma = Rex(13) Wynik(7) = Suma Suma = Rex(14) If Rex(15) > Suma Then Suma = Rex(15) If Rex(16) > Suma Then Suma = Rex(16) Wynik(8) = Suma Return Return Save: For K = 1 To 16 'x Sing = Wynik(k) * 0.1 If K = 1 Then Sing = Sing * 0.6 'pierwsze dwa znaki pierwszej po³ówki zbyt mocno siê wychylaj¹, bas If K = 2 Then Sing = Sing * 0.7 If K = 8 Then Sing = Sing * 1.3 'x 'ostatni znak pierwszej po³ówki jest przyt³umiony przez filtr wiêc go wzmacniam Sing = Log10(sing) Sing = Czulosc * Sing Tmp_c = Sing + Poziom_a If Tmp_c < 0 Then Tmp_c = 0 If Tmp_c > 16 Then Tmp_c = 16 Wynik(k) = Tmp_c If Wynik(k) > Wynik_o(k) Then Wynik_o(k) = Wynik(k) Else If Falloff_count(k) = Falloff Then If Wynik_o(k) > 0 Then Decr Wynik_o(k) Falloff_count(k) = 0 End If Incr Falloff_count(k) End If '****** dodano do wersji 2 ************** Lazienka_jest_zamknieta = Wynik_o(k) + Uklad Line1d(k) = Lookup(lazienka_jest_zamknieta , L1) Line2d(k) = Lookup(lazienka_jest_zamknieta , L2) Locate 1 , K Lcd Chr(line1d(k)) Locate 2 , K Lcd Chr(line2d(k)) 'po wyliczeniu ka¿dego s³upka jest on od razu wpisywany na wy½wietlacz. 'poni¿ej wcze½niejsze rozwi¹zanie, wysy³ane by³y wszystkie s³upki naraz po zakoñczeniu przeliczania. 'sam nie wiem która metoda jest szybsza, nie widaæ ró¿nicy go³ym okiem. 'teoretycznie teraz powinno byæ wolniej bo za ka¿dym razem program komunikuje siê z lcd a poprzednio tylko raz, czyli 16 razy rzadziej. 'ale musia³em tak zrobiæ ze wzglêdu na problem z opcj¹ overlay (u¿ywanie znaku chr(0)), a zalety - ostatnie s³upki chodz¹ p³ynniej :) '******* ****ec *********************** Next K 'Locate 1 , 1 'Lcd Line1; 'Locate 2 , 1 'Lcd Line2; Return '****** dodano do wersji 2 ************** Buttons: If Jasn_up = 0 Then Incr Jasnosc If Jasnosc = 51 Then Jasnosc = 50 Jasnosc_flaga = 1 End If If Jasn_dn = 0 Then Decr Jasnosc If Jasnosc = 255 Then Jasnosc = 0 Jasnosc_flaga = 1 End If If Jasnosc_flaga = 1 Then Jasnosc_flaga = 0 If Vfd = 0 Then Jasnosc_vfd = Jasnosc / 10 If Jasnosc_vfd > 3 Then Jasnosc_vfd = 3 Lcdcontrast Jasnosc_vfd Else Ocr2 = Jasnosc * 5 End If Locate 1 , 3 Lcd "Jasnosc: " ; Jasnosc ; "(" ; Jasnosc_vfd ; ")" Waitms 10 End If If Czul_up = 0 Then Incr Czulosc If Czulosc = 51 Then Czulosc = 50 Czulosc_flaga = 1 End If If Czul_dn = 0 Then Decr Czulosc If Czulosc = 255 Then Czulosc = 0 Czulosc_flaga = 1 End If If Czulosc_flaga = 1 Then Czulosc_flaga = 0 Poziom_a = Czulosc * 0.4 Poziom_a = 8 - Poziom_a Locate 1 , 5 Lcd "Czulosc: " ; Czulosc Waitms 10 End If If Tryb = 0 Then Stop Watchdog Incr Efekt If Efekt = 5 Then Efekt = 0 Gosub Lcdchr Efekt_e = Efekt 'ustawienia jasno½ci i czu³o½ci s¹ zapisywane dopiero wraz ze zmian¹ efektu, wyd³u¿y to ¿ycie eepromu. Czulosc_e = Czulosc Jasnosc_e = Jasnosc Waitms 10 Start Watchdog End If Return '------- Lcdchr: 'Initlcd 'Waitms 10 'Initlcd 'Cursor Off 'Start Watchdog Select Case Efekt 'slupki 1 Case 0 : Deflcdchar 0 , 32 , 32 , 32 , 32 , 32 , 32 , 32 , 31 Deflcdchar 1 , 32 , 32 , 32 , 32 , 32 , 32 , 31 , 31 Deflcdchar 2 , 32 , 32 , 32 , 32 , 32 , 31 , 31 , 31 Deflcdchar 3 , 32 , 32 , 32 , 32 , 31 , 31 , 31 , 31 Deflcdchar 4 , 32 , 32 , 32 , 31 , 31 , 31 , 31 , 31 Deflcdchar 5 , 32 , 32 , 31 , 31 , 31 , 31 , 31 , 31 Deflcdchar 6 , 32 , 31 , 31 , 31 , 31 , 31 , 31 , 31 Deflcdchar 7 , 31 , 31 , 31 , 31 , 31 , 31 , 31 , 31 Uklad = 0 'slupki 2 Case 1 : Deflcdchar 0 , 32 , 32 , 32 , 32 , 32 , 32 , 32 , 27 Deflcdchar 1 , 32 , 32 , 32 , 32 , 32 , 32 , 27 , 27 Deflcdchar 2 , 32 , 32 , 32 , 32 , 32 , 27 , 27 , 27 Deflcdchar 3 , 32 , 32 , 32 , 32 , 27 , 27 , 27 , 27 Deflcdchar 4 , 32 , 32 , 32 , 27 , 27 , 27 , 27 , 27 Deflcdchar 5 , 32 , 32 , 27 , 27 , 27 , 27 , 27 , 27 Deflcdchar 6 , 32 , 27 , 27 , 27 , 27 , 27 , 27 , 27 Deflcdchar 7 , 27 , 27 , 27 , 27 , 27 , 27 , 27 , 27 'slupki 3 Case 2 : Deflcdchar 0 , 32 , 32 , 32 , 32 , 32 , 32 , 32 , 31 Deflcdchar 1 , 32 , 32 , 32 , 32 , 32 , 32 , 17 , 31 Deflcdchar 2 , 32 , 32 , 32 , 32 , 32 , 31 , 17 , 31 Deflcdchar 3 , 32 , 32 , 32 , 32 , 17 , 31 , 17 , 31 Deflcdchar 4 , 32 , 32 , 32 , 31 , 17 , 31 , 17 , 31 Deflcdchar 5 , 32 , 32 , 17 , 31 , 17 , 31 , 17 , 31 Deflcdchar 6 , 32 , 31 , 17 , 31 , 17 , 31 , 17 , 31 Deflcdchar 7 , 17 , 31 , 17 , 31 , 17 , 31 , 17 , 31 'owal Case 3 : Deflcdchar 0 , 32 , 32 , 32 , 32 , 32 , 32 , 14 , 31 Deflcdchar 1 , 32 , 32 , 32 , 32 , 32 , 14 , 31 , 14 Deflcdchar 2 , 32 , 32 , 32 , 32 , 14 , 31 , 14 , 32 Deflcdchar 3 , 32 , 32 , 32 , 14 , 31 , 14 , 32 , 32 Deflcdchar 4 , 32 , 32 , 14 , 31 , 14 , 32 , 32 , 32 Deflcdchar 5 , 32 , 14 , 31 , 14 , 32 , 32 , 32 , 32 Deflcdchar 6 , 14 , 31 , 14 , 32 , 32 , 32 , 32 , 32 Deflcdchar 7 , 31 , 14 , 32 , 32 , 32 , 32 , 32 , 32 Uklad = 17 Case 4: Deflcdchar 0 , 32 , 32 , 32 , 32 , 32 , 32 , 32 , 31 Deflcdchar 1 , 32 , 32 , 32 , 32 , 32 , 31 , 32 , 31 Deflcdchar 2 , 32 , 32 , 32 , 31 , 32 , 31 , 32 , 31 Deflcdchar 3 , 32 , 31 , 32 , 31 , 32 , 31 , 32 , 31 Uklad = 35 End Select Cls 'Start Timer1 'Start Timer0 'Enable Interrupts Return 'wspólna tablica dla ró¿nych efektów L1: 'efekt 0 i 1 >>>>!<<<< efekt 2 i 3 >>>>!<<<< efekt 4 Data 32 , 32 , 32 , 32 , 32 , 32 , 32 , 32 , 32 , 0 , 1 , 2 , 3 , 4 , 5 , 6 , 7 , 32 , 32 , 32 , 32 , 32 , 32 , 32 , 32 , 32 , 0 , 1 , 2 , 3 , 4 , 5 , 6 , 7 , 32 , 32 , 32 , 32 , 32 , 32 , 32 , 32 , 32 , 0 , 0 , 1 , 1 , 2 , 2 , 3 , 3 L2: 'efekt 0 i 1>!<<<< efekt 2 i 3 >>>>!<<<< efekt 4 Data 32 , 0 , 1 , 2 , 3 , 4 , 5 , 6 , 7 , 7 , 7 , 7 , 7 , 7 , 7 , 7 , 7 , 32 , 0 , 1 , 2 , 3 , 4 , 5 , 6 , 7 , 32 , 32 , 32 , 32 , 32 , 32 , 32 , 32 , 32 , 32 , 0 , 0 , 1 , 1 , 2 , 2 , 3 , 3 , 3 , 3 , 3 , 3 , 3 , 3 , 3 , 3 '********* ****ec ************ ' tabela 32 liczb 16 bitowych ze znakiem ' za³o¿ony format: MSB - czê½æ ca³kowita, LSB - czê½æ u³amkowa ' kwantyzacja: 0.19635 rad ' tabela I æwiartki sin(x), 8 pozycji (co 11,25 stopnia od 0 do 78.75) Tab_sin: Data 0% , 50% , 98% , 142% , 181% , 213% , 237% , 251% ' tabela II æwiartki sin(x), (co 11,25 stopnia od 90 do 178.75) Data 255% , 251% , 237% , 213% , 181% , 142% , 98% , 50% ' tabela III i IV æwiartki sin(x), (co 11,25 stopnia od 180 do 258.75 i 270 - 348.75) ' zanegowane 2 poprzednie tabele Data 0% , -50% , -98% , -142% , -181% , -213% , -237% , -251% Data -255% , -251% , -237% , -213% , -181% , -142% , -98% , -50% Okno_hanning: Data 0 , 3 , 10 , 23 , 40 , 60 , 84 , 109 , 134 , 160 , 184 , 206 , 225 , 240 , 250 , 255 , 255 , 250 , 240 , 225 , 206 , 184 , 160 , 134 , 109 , 84 , 60 , 40 , 23 , 10 , 3 , 0 'Okno_hamming: 'Data 20 , 23 , 30 , 42 , 57 , 76 , 97 , 120 , 144 , 168 , 190 , 210 , 228 , 241 , 251 , 255 , 255 , 251 , 241 , 228 , 210 , 190 , 168 , 144 , 120 , 97 , 76 , 57 , 42 , 30 , 23 , 20 'Okno_blackman: 'Data 0 , 1 , 4 , 10 , 18 , 31 , 48 , 69 , 94 , 122 , 151 , 181 , 208 , 230 , 246 , 255 , 255 , 246 , 230 , 208 , 181 , 151 , 122 , 94 , 69 , 48 , 31 , 18 , 10 , 4 , 1 , 0
دیدگاه