$regfile = "m32def.dat" 'informuje kompilator o pliku dyrektyw mikrokontrolera $crystal = 8000000 'informuje kompilator o czŕstotliwoťci oscylatora taktuj¦cego mikrokontroler Dim Timervalue As Word Dim X(18) As Word Dim Licznik As Byte Dim Flvalue As Byte , Nacisk As Single Dim I As Integer , J As Integer , K As Integer , L As Integer , M As Integer , N As Integer , O As Integer , runtheme as Integer Dim T As Integer , Powtarzam As Integer , Again As Integer , Rungora As Integer , Rundol As Integer , Maxlight As Integer Again = 0 Runtheme = 1 '-------------------------- konfiguracja klawiatury 'Config Pina.0 = Input 'porty jako wejściowe pstryki 'Config Pina.1 = Input Config Pinb.5 = Input 'porty jako wejściowe pstryki Config Pinb.6 = Input 'porty jako wejściowe pstryki Config Pind.6 = Input Config Portb.0 = Output Config Portb.1 = Output Config Portb.2 = Output Config Portb.3 = Output Config Porta.3 = Output Config Porta.4 = Output Config Porta.5 = Output Config Porta.6 = Output Config Porta.7 = Output Config Portc.7 = Output Config Portc.6 = Output Config Portc.5 = Output Config Portc.4 = Output Config Portc.3 = Output Config Portc.2 = Output Config Portc.1 = Output Config Portc.0 = Output Config Portd.7 = Output 'Set Pina.0 'Set Pina.1 Set Portb.5 Set Portb.6 Set Portd.6 'Swdol Alias Pina.0 'Swgora Alias Pina.1 Sw1 Alias Pinb.5 Sw2 Alias Pinb.6 Sw3 Alias Pind.6 S1 Alias Portb.0 S2 Alias Portb.1 S3 Alias Portb.2 S4 Alias Portb.3 S5 Alias Porta.3 S6 Alias Porta.4 S7 Alias Porta.5 S8 Alias Porta.6 S9 Alias Porta.7 S10 Alias Portc.7 S11 Alias Portc.6 S12 Alias Portc.5 S13 Alias Portc.4 S14 Alias Portc.3 S15 Alias Portc.2 S16 Alias Portc.1 S17 Alias Portc.0 S18 Alias Portd.7 For I = 1 To 17 'X(i) = 80 X(i) = 1 Next Config Timer1 = Timer , Prescale = 1 On Timer1 Czas Config Adc = Single , Prescaler = Auto , Reference = Internal Enable Interrupts 'oblokowanie przerwan globalnych Dim Odczyadc0 As Single , Odczyadc1 As Single , Odczyadc2 As Single Dim Wart_adc0 As Word , Wart_adc1 As Word , Wart_adc2 As Word ' buzerek Start Adc '$baud = 1200 '$baud = 9600 Timervalue = 64759 'Timervalue = 60000 '64566 on 10 MHz Enable Timer1 Timer1 = Timervalue If Sw1 = 0 Then Gosub Demo End If 'Gosub Firstlast Wait 1 Nacisk = 100 Flvalue = 17 T = 0 Rungora = 0 Rundol = 0 Powtarzam = 500 Maxlight = 100 'Config Watchdog = 2048 'Start Watchdog '-------------------------- sam poczatek programu ---------------------------------- Do Begin: Gosub Odczyt_adc If Odczyadc0 < 100 And T = 0 Then Gosub Gora If Odczyadc1 < 100 And T = 0 Then Gosub Dol If Odczyadc0 < 100 And T > 0 Then Again = 1 If Odczyadc1 < 100 And T > 0 Then Again = 1 If Again > 0 And T > 0 Then If Odczyadc0 < 100 Or Odczyadc1 < 100 Then Waitms 200 If Odczyadc0 < 100 Or Odczyadc1 < 100 Then T = T + Powtarzam End If End If If Rungora = 1 And T = 0 Then Gosub Slowupoff Rungora = 0 End If If Rundol = 1 And T = 0 Then Gosub Slowdownoff Rundol = 0 End If Waitms 10 If T > 0 Then T = T - 1 If T > 3000 Then T = 3000 If T = 300 Or T = 600 Or T = 900 Or T = 1200 Or T = 1500 Or T = 1800 Or T = 2100 Or T = 2400 Or T = 2700 Or T = 3000 Then If Rungora = 1 And Sw1 = 0 Then Gosub Landingupoff If Rundol = 1 And Sw1 = 0 Then Gosub Landingdownoff End If If Sw3 = 0 Then T = T + 10 End If 'Gosub Dol 'Gosub Updownon 'Waitms 200 'Gosub Updownoff 'Wait 1 If T = 0 And Rungora = 0 And Rundol = 0 Then If Sw2 = 0 Then If X(1) <> Flvalue Or X(17) <> Flvalue Then Gosub Firstlast Else X(1) = 1 X(17) = 1 End If End If 'Wait 1 'Gosub Allon 'Gosub Alloff Loop 'koniec nieskonczonej petli do-loop End 'koniec programu 'xxxxxxxxxxxxxxxxxxxxxxxxxxxxx PROCEDURY STERUJACE xxxxxxxxxxxxxxxxxxxxxxxxxx Gora: X(17) = 1 If Runtheme = 1 Then Gosub Slowupon End If If Runtheme = 2 Then Gosub Falaup End If If Runtheme = 3 Then Gosub Tetrisup End If If Runtheme = 4 Then Gosub Randm End If Runtheme = Runtheme + 1 T = Powtarzam Waitms 10 Rungora = 1 Rundol = 0 If Runtheme = 5 Then Runtheme = 1 End If Return Dol: X(1) = 1 If Runtheme = 1 Then Gosub Slowdownon End If If Runtheme = 2 Then Gosub Faladown End If If Runtheme = 3 Then Gosub Tetrisdown End If If Runtheme = 4 Then Gosub Randm End If Runtheme = Runtheme + 1 T = Powtarzam Waitms 10 Rundol = 1 Rungora = 0 If Runtheme = 5 Then Runtheme = 1 End If Return 'xxxxxxxxxxXXXXXXXXXXXXXXXXXXX PROCEDURY Wykonawcze XXXXXXXXXXXXXXXXXXXXXXXXXX Falaup: For J = 1 To 33 X(1) = J Waitms 4 Next For J = 34 To 66 X(1) = J L = J - 33 X(2) = L Waitms 4 Next For I = 1 To 17 For J = 67 To Maxlight X(i) = J If I < 17 Then K = I + 1 L = J - 33 X(k) = L End If If I < 16 Then M = I + 2 N = J - 66 X(m) = N End If Waitms 4 Next Next Return Faladown: For J = 1 To 33 X(17) = J Waitms 4 Next For J = 34 To 66 X(17) = J L = J - 33 X(17) = L Waitms 4 Next For I = 17 To 1 Step -1 For J = 67 To Maxlight X(i) = J If I > 1 Then K = I - 1 L = J - 33 X(k) = L End If If I > 2 Then M = I - 2 N = J - 66 X(m) = N End If Waitms 4 Next Next Return Slowupon: For I = 1 To 17 For J = 1 To Maxlight X(i) = J Waitms 1 Next Next Return Slowupoff: For I = 1 To 17 For J = Maxlight To 1 Step -1 X(i) = J Waitms 1 Next Next Return Slowdownon: For I = 17 To 1 Step -1 For J = 1 To Maxlight X(i) = J Waitms 1 Next Next Return Slowdownoff: For I = 17 To 1 Step -1 For J = Maxlight To 1 Step -1 X(i) = J Waitms 1 Next Next Return Firstlast: For I = 1 To Flvalue X(1) = I X(17) = I Waitms 20 Next Return Landingupoff: For I = 1 To 17 X(i) = 20 Waitms 30 X(i) = Maxlight Next Return Landingdownoff: For I = 17 To 1 Step -1 X(i) = 20 Waitms 30 X(i) = Maxlight Next Return Allon: For I = 1 To Maxlight For J = 1 To 17 X(j) = I Waitms 2 Next Next Return Alloff: For I = Maxlight To 1 Step -1 For J = 1 To 17 X(j) = I Waitms 2 Next Next Return Updownon: For I = 1 To 9 If I = 1 Then J = 17 If I = 2 Then J = 16 If I = 3 Then J = 15 If I = 4 Then J = 14 If I = 5 Then J = 13 If I = 6 Then J = 12 If I = 7 Then J = 11 If I = 8 Then J = 10 If I = 9 Then J = 9 For K = 1 To Maxlight X(i) = K X(j) = K Waitms 1 Next Next Return Updownoff: For I = 1 To 9 If I = 1 Then J = 17 If I = 2 Then J = 16 If I = 3 Then J = 15 If I = 4 Then J = 14 If I = 5 Then J = 13 If I = 6 Then J = 12 If I = 7 Then J = 11 If I = 8 Then J = 10 If I = 9 Then J = 9 For K = Maxlight To 2 Step -1 X(i) = K X(j) = K Waitms 1 Next Next Return Tetrisup: For I = 1 To 17 For J = 17 To 1 Step -1 X(j) = Maxlight Waitms 1 If I < J Then X(j) = 1 End If Next Next Return Tetrisdown: For I = 17 To 1 Step -1 For J = 1 To 17 X(j) = Maxlight Waitms 1 If I < J Then X(j) = 1 End If Next Next Return Randm: For I = 1 To 100 'random lights For J = 1 To 17 X(j) = Rnd(99) Waitms 1 Next Next For I = 1 To 100 'For J = 1 To 17 J = Rnd(18) X(j) = Maxlight Waitms 1 'Next Next Return Demo: For I = 1 To 100 'random lights For J = 1 To 17 X(j) = Rnd(99) Waitms 1 Next Next For J = 1 To 17 'all off X(j) = 1 Next For I = 1 To 17 'landing on up X(i) = 100 Waitms 30 X(i) = 1 Next For I = 17 To 1 Step -1 'landing on down X(i) = 100 Waitms 30 X(i) = 1 Next For I = 1 To 17 'landing on up X(i) = 100 Waitms 30 'X(i) = 1 Next For I = 17 To 1 Step -1 'landing on down X(i) = 1 Waitms 30 'X(i) = 1 Next Return '------------------ odczyt napięć -------------------- Odczyt_adc: Reset Watchdog Wart_adc0 = Getadc(0) Odczyadc0 = Wart_adc0 * 0.0026 Odczyadc0 = Odczyadc0 * 100 Wart_adc1 = Getadc(1) Odczyadc1 = Wart_adc1 * 0.0026 Odczyadc1 = Odczyadc1 * 100 Wart_adc2 = Getadc(2) Odczyadc2 = Wart_adc2 * 0.0026 Odczyadc2 = Odczyadc2 * 100 Return Czas: Timer1 = Timervalue If Licznik >= 120 Then Licznik = 1 'skocz do podprogramu Zero Incr Licznik If Licznik >= X(1) Then S1 = 0 Else S1 = 1 End If If Licznik >= X(2) Then S2 = 0 Else S2 = 1 End If If Licznik >= X(3) Then S3 = 0 Else S3 = 1 End If If Licznik >= X(4) Then S4 = 0 Else S4 = 1 End If If Licznik >= X(5) Then S5 = 0 Else S5 = 1 End If If Licznik >= X(6) Then S6 = 0 Else S6 = 1 End If If Licznik >= X(7) Then S7 = 0 Else S7 = 1 End If If Licznik >= X(8) Then S8 = 0 Else S8 = 1 End If If Licznik >= X(9) Then S9 = 0 Else S9 = 1 End If If Licznik >= X(10) Then S10 = 0 Else S10 = 1 End If If Licznik >= X(11) Then S11 = 0 Else S11 = 1 End If If Licznik >= X(12) Then S12 = 0 Else S12 = 1 End If If Licznik >= X(13) Then S13 = 0 Else S13 = 1 End If If Licznik >= X(14) Then S14 = 0 Else S14 = 1 End If If Licznik >= X(15) Then S15 = 0 Else S15 = 1 End If If Licznik >= X(16) Then S16 = 0 Else S16 = 1 End If If Licznik >= X(17) Then S17 = 0 Else S17 = 1 End If 'If Licznik >= X(18) Then 'S18 = 0 'Else 'S18 = 1 'End If Return