• Email
  • Forum

Różności

Krótkie kody. Może komuś akurat się przydadzą.

Prosty miernik FREQ, DUTY i TIME oczywiście w Bascom :D

Napisany kiedyś na szybko. Nie testowany głębiej, niemniej coś tam działa :D
Jest jakby komplementarny do poniższego generatora


[Rozmiar: 40135 bajtów]

$regfile = "m32def.dat"
$crystal = 16000000
$hwstack = 64
$swstack = 32
$framesize = 128

'***********************************************************
'*                                                         *
'*   PROSTY MIERNIK CZĘSTOTLIWOŚCI, WYPEŁNIENIA I CZASÓW   *
'*                                                         *
'* BARTek niveasoft                                        *
'***********************************************************

Config Lcd = 20x4
Config Lcdpin = Pin , Rs = Portb.4 , E = Portb.3 , Db4 = Portb.2 , Db5 = Porta.0 , Db6 = Porta.1 , Db7 = Porta.2
Cursor Off , Noblink
Cls

Config Timer1 = Counter , Prescale = 64 , Capture_edge = Falling , Noise_cancel = 1       '262ms max


Config Timer2 = Timer , Prescale = 1024 , Compare = Disconnect , Clear_timer = 1
 Enable Compare2 : On Compare2 Przerwanie_timer2 Nosave
Compare2 = 155                                         '10ms @16MHz/1024
 Dim Miliseconds As Byte , 500ms As Byte , 1000ms As Byte

Dim Mig As Byte , Helpb As Byte
Dim New_tim As Word , Old_tim As Word , New_hi As Word , New_lo As Word , Period As Word
Dim New_impuls As Byte , Countdown As Byte , Copy_hi As Word , Copy_lo As Word

Dim Helpd As Dword , Freq As Dword , Time_hi As Dword , Time_lo As Dword , Duty As Dword

Config Portd.6 = Input : Signal_in Alias Pind.6

On Capture1 Capture_isr Nosave

Enable Capture1
Enable Interrupts

Const Edge_fall = &B10000011
Const Edge_rise = &B11000011

Const Ticks = _xtal / 64                               ' for 16MHz = 250 000

Countdown = 1

Do

 If New_impuls = 1 Then
  New_impuls = 0

  If Countdown = 0 Then Cls

  Countdown = 10

 End If

 If 500ms = 1 Then
  500ms = 0

    Locate 1 , 16
    If Mig = 0 Then
     Mig = 1 : Lcd "*"
    Else
     Mig = 0 : Lcd " "
    End If

    If Countdown > 0 Then
     Decr Countdown



     If Countdown = 0 Then


      Locate 1 , 1 : Lcd "No signal..." ; Spc(4)

     Else

      Copy_hi = New_hi
      Copy_lo = New_lo

       Helpd = Copy_hi + Copy_lo                       'for 1kHz = 250

      'obliczanie wypelnienia
       Duty = Copy_hi : Duty = Duty * 100
        Duty = Duty / Helpd
         Locate 2 , 8 : Lcd "Duty=" ; Duty ; "% "

      'oblicznie freq
        Shift Helpd , Left , 6                         'for 1kHz = 16000
          Freq = _xtal / Helpd : Locate 2 , 1 : Lcd Freq ; "Hz "

        Shift Copy_hi , Left , 2
        Shift Copy_lo , Left , 2

        Locate 1 , 3 : Lcd Copy_hi ; "us/" ; Copy_lo ; "us"




     End If

    End If

 End If

Loop
End

Capture_isr:

   $asm
  !PUSH R16
  !PUSH R17
  !PUSH R20
  !PUSH R21
  !PUSH R23
  !PUSH R24
  !PUSH R25
  !PUSH R26
  !PUSH R27
  !in R24, sreg
  !PUSH  R24

  $end Asm
 If Signal_in = 0 Then
  New_hi = Capture1 - Old_tim
  Tccr1b = Edge_rise
 Else
  New_lo = Capture1 - Old_tim
   New_impuls = 1
  Tccr1b = Edge_fall
 End If
  Old_tim = Capture1

  '          Tuned with NoSave Tool 1.10
  $asm
  !POP  R24
  !out sreg, r24
  !POP R27
  !POP R26
  !POP R25
  !POP R24
  !POP R23
  !POP R21
  !POP R20
  !POP R17
  !POP R16
  $end Asm

Return

Przerwanie_timer2:
  $asm
  !PUSH R16
  !PUSH R24
  !PUSH R26
  !PUSH R27
  !in R24, sreg
  !PUSH  R24
  $end Asm

 If Miliseconds < 49 Then
  Incr Miliseconds
 Else
  Miliseconds = 0
   500ms = 1
 End If
  '          Tuned with NoSave Tool 1.10
  $asm
  !POP  R24
  !out sreg, r24
  !POP R27
  !POP R26
  !POP R24
  !POP R16
  $end Asm
Return

Gotowy kod BASCOM do taniego wyświetlacza na 2x74HC595

Pozwoli zaoszczędzić trochę czasu przy rozkminianiu co z czym bo schematu
nie ma nawet na stronie producenta(tutaj RobotDyn)


[Rozmiar: 73543 bajtów]

$regfile = "m328pdef.dat"
$crystal = 8000000
$hwstack = 64
$swstack = 32
$framesize = 128

'ROBOT DYN 6-DIGIT LED DISPLAY
' 6x50Hz=300Hz refresh rate ~3ms period

Rck_pin Alias Portd.0 : Config Rck_pin = Output
Clk_pin Alias Portd.1 : Config Clk_pin = Output
Dio_pin Alias Portd.2 : Config Dio_pin = Output


Dim Arr(2) As Byte , Mux As Byte
Dim Muxw As Word At Arr(1) Overlay

'           321 654
Arr(1) = &B01110111
Arr(2) = &B10111111                     '
'          *GFEDCBA
'   A
'   _
' F|_|B
' E|_|C
'   D
'

Do

 Incr Mux : If Mux > 6 Then Mux = 1

  Arr(1) = Lookup(mux , Displays)
  Arr(2) = Lookup(mux , Digits)

  Shiftout Dio_pin , Clk_pin , Muxw , 0
   Set Rck_pin : Reset Rck_pin

 Waitms 3
Loop
End

Displays:
'       dummy          1            2            3            4            5           6
Data &B00000000 , &B00010000 , &B00100000 , &B01000000 , &B00000001 , &B00000010 , &B00000100

Digits:
'        0             1            2            3           4            5
Data &B11000000 , &B11111001 , &B10100100 , &B10110000 , &B10011001 , &B10010010
'        6             7            8            9        10 blank
Data &B10000010 , &B11111000 , &B10000000 , &B10010000 , &B11111111

Jeśli masz pytanie to zadaj je na FORUM

RFM69 w BASCOM - prościej się nie da

Biblioteka "Arduino" przepisana dostosowana do Bascom

Przy okazji pokazuje, że kiedy jest już w jakimś języku gotowy kod do obsługi danego mikroukładu to można go z powodzeniem dostosować do Bascom.

[Rozmiar: 37989 bajtów]

...i działa
wystarczy napisać Initialize(Frequency, NodeID,NetID),
a potem można po prostu używać Send(Dane)

Prosty kod do kanapki czyli Bascom, Mega2560 i Ethernet Shield = Webserver

Kod nie potrzebuje plików na karcie SD by szybko wygenerować stronę która pokazuje
aktualny czas i datę. Dodatkowo strona odświeża się co sekundę więc możesz
obserwować jak zegarek automatycznie zsynchronizuje czas z serwerem czasu ;)
Atmega pobierze czas i będzie go synchronizować co godzinę

Kod może się przydać by szybko przetestować nową "kanapkę"

[Rozmiar: 44244 bajtów]

Paczkę możesz ściągnąć klikając w ikonkę
Pobierz

Prosty generator programowany z klawiatury czyli Simplest Bascom DDS

[Rozmiar: 102640 bajtów]

Taki kodzik może się czasem przydać by szybko coś wygenerować.
Możesz tego użyć do jakiegoś układu cyfrowego lub nawet generować "buczenie" czy pisk dla układów audio.
Działa spokojnie od 1Hz ;) Ja to wrzucam na płytę ZL3AVR
Wpisujesz częstotliwość z klawiatury i zatwierdzasz długim wciśnięciem przycisku A. Zatrzymujesz przyciskiem D.
Napisałem go dawno temu i się sprawdził nie raz. Może się komuś przyda ;)

Nowa wersja 2017 z regulacją wypełnienia :D

Na Forum znajdziesz wersję na uC Mega8 i trzy przyciski a Duty z dokładnością do 0.1%
Na Forum jest też wersja obsługiwana dwoma potencjometrami
'**************************************************
'*   GENERATOR PROGRAMOWANY Z KLAWIATURY 4x4      *
'*                                                *
'*   WPISUJESZ CZĘSTOTLIWOŚĆ I ZATWIERDZASZ       *
'*         DŁUGIM WCIŚNIĘCIEM "A"                 *
'*                                                *
'* ZA WYPEŁNIENIE PROCENTOWE ODPOWIEDZIALANA JEST *
'*              ZMIENNA "PROC"                    *
'*      KLIK W "B" ZWIĘKSZA WYPEŁNIENIE           *
'*      KLIK W "C" ZMNIEJSZA WYPEŁNIENIE          *
'*                                                *
'* by BARTek w Niedzielę (błąd mógł się wkraść)   *
'*                                                *
'* ver 1.02 2017                                  *
'**************************************************

$regfile = "m328Pdef.dat"
$crystal = 16000000
$hwstack = 80
$swstack = 80
$framesize = 80

Config Submode = New

Config Kbd = Portd , Debounce = 50 , Delay = 50
'W1-PA0, K4-PA7


Config Portb.1 = Output : Gen Alias Portb.1
Config Portb.0 = Output : Neg_gen Alias Portb.2

Config Lcdpin = Pin , Db4 = Portc.2 , Db5 = Portc.3 , Db6 = Portc.4 , Db7 = Portc.5 , E = Portc.1 , Rs = Portc.0
Config Lcd = 16x2
Cursor Off
Cls

Config Timer2 = Timer , Prescale = 1024 , Compare_a = Disconnect , Clear_timer = 1
 Compare2a = 155                                            '10ms @16MHz

Dim 10ms As Byte , Ticks As Byte
Dim Keyread As Byte , Key As String * 1 , Lock As Byte
Dim Got_key As Byte

Dim Status As Byte , Value_str As String * 10 , Pos As Byte , Lenght As Byte
Dim Value As Dword , Ustaw As Word , Prescaler As Word , Help_d As Dword
Dim Started As Byte , Wypelnienie As Word , Presc As Byte , Proc As Word

Const Ticks_max = 25
Const Freq = _xtal

'Config Portd.5 = Output

Proc = 20                                                   'taka początkowa wartośc, można wpisać 50

Sub Calc_duty()
  Help_d = Value * Proc
  Help_d = Help_d / 100
  Wypelnienie = Help_d
   Ocr1a = Wypelnienie
    Call Show_duty()
End Sub


Sub Show_duty()
 Locate 2 , 1 : Lcd "D=" ; Proc ; "%"
  If Proc < 10 Then Lcd " "
End Sub


Enable Interrupts

Dim Wartosc_dla_tccr1b As Byte

'----------------------------------------------------------------
'TCCR1A  -> |COM1A1| COM1A0 COM1B1 COM1B0 FOC1A FOC1B WGM11 WGM10   FOR MEGA32 MEGA8
'TCCR1B  -> | ICNC1|  ICES1   --   WGM13  WGM12  CS12  CS11  CS10
'----------------------------------------------------------------

'----------------------------------------------------------------
'TCCR1A  -> |COM1A1  COM1A0 COM1B1 COM1B0   --    --  WGM11 WGM10
'TCCR1B  -> | ICNC1   ICES1  --    WGM13  WGM12  CS12  CS11  CS10   FOR MEGA328P
'TCCR1C  -> | FOC1A  FOC1B   --     --     --     --    --    --
'----------------------------------------------------------------

'                    WGM13-|
   Const Pwm_presc1 = &B00010001                            'for TCCR1B
   Const Pwm_presc8 = &B00010010
  Const Pwm_presc64 = &B00010011
 Const Pwm_presc256 = &B00010100
Const Pwm_presc1024 = &B00010101

Const Set_output_mode = &B10100000                          'for TCCR1A

Locate 2 , 13 : Lcd "0 Hz"
 Call Show_duty()


Do

  'procedura odczytu klawiatury 4x4 z detekcja długiego przycisnięcia ;)
  '----------------------------------------------------------------------
   If Tifr2.ocf2a = 1 Then
    Tifr2.ocf2a = 1                                         'flagę kasuje się wpisując jedynkę

     Keyread = Getkbd()

       If Keyread <> 16 Then
           If Lock = 0 Then
            Key = Lookupstr(keyread , Dta)
             Select Case Keyread
               Case 0 To 11
                Lock = 1 : Got_key = 1
               Case 12 To 15
                If Ticks < Ticks_max Then
                 Incr Ticks
                  If Ticks = Ticks_max Then
                    If Key = "A" Then Key = "E"
                    If Key = "B" Then Key = "F"
                    If Key = "D" Then Key = "G"
                   Lock = 1 : Got_key = 1
                    Ticks = 0
                  End If
                End If
               Case 14 To 15
               Lock = 1 : Got_key = 1
              End Select

           End If
       Else
          Lock = 0
           If Ticks > 0 Then
            Ticks = 0
             Got_key = 1
           End If
       End If

   End If
   '-----------------------------------------------------------------------

   'mamy coś z klawiatury...
   '-----------------------------------------------------------------------
   If Got_key = 1 Then
        Got_key = 0



        Select Case Key

         Case "0" To "9"
          If Started <> 1 Then

           If Started = 2 Then
               Started = 0
               Value_str = ""
               Locate 2 , 1 : Lcd Spc(12) ; "0"
           End If

           Lenght = Len(value_str)
            If Lenght < 7 Then
             Value_str = Value_str + Key
             Pos = 13 - Lenght
             Locate 2 , Pos : Lcd Value_str

            End If
          End If

         Case "E"                                           'E oznacza długie nacisniecie A

          Help_d = Val(value_str)

          If Help_d > 0 Then

           Value = Freq                                     'przepisz Freq procka do zmiennej

            Select Case Help_d

             Case 1

              '256
               Wartosc_dla_tccr1b = Pwm_presc256
                Shift Value , Right , 8
               Presc = 25                                   'nie miesci sie 256

             Case 2 To 15
             '64
               Wartosc_dla_tccr1b = Pwm_presc64
                Shift Value , Right , 6
              Presc = 64

             Case 16 To 122                                 '16000000Hz/131072 = 15Hz  '
             '8
               Wartosc_dla_tccr1b = Pwm_presc8
                Shift Value , Right , 3
               Presc = 8

             Case Else                                      '16000000Hz/131072 = 122Hz
             '1
               Wartosc_dla_tccr1b = Pwm_presc1
               Presc = 1

            End Select

            Value = Value \ Help_d                          'rzeczywistą po preskalerze podziel przez żądaną
             Shift Value , Right , 1                        'podziel na pół (skróć bo stan odwraca się raz na okres)

             Decr Value : Ustaw = Value                     'odejmij jeden

             Call Calc_duty()

             Home : Lcd Spc(16)
             Home : Lcd "Pre=" ; Presc ; " Val=" ; Value    'info

              Icr1 = Ustaw

               Tccr1a = Set_output_mode                     'set count up, reset count down
               Tccr1b = Wartosc_dla_tccr1b                  'ustaw prescaler i WGM13

              Started = 1

          End If

         Case "B"
           If Proc < 99 Then
            Incr Proc
             Call Show_duty()
             Call Calc_duty()
           End If


         Case "C"

           If Proc > 1 Then
            Decr Proc
             Call Show_duty()
             Call Calc_duty()
           End If

         Case "D"                                           'krótkie nacisniecie D wyłacza sygnał

         Config Timer1 = Timer , Prescale = 1 , Compare_a = Disconnect , Compare_b = Disconnect , Clear_timer = 1
          Stop Timer1

           Reset Gen

              If Started = 1 Then
               Started = 2
              Else
               Value_str = ""
                Locate 2 , 1 : Lcd Spc(12) ; "0"
                 Call Show_duty()
              End If

        End Select


   End If

  Portb.0 = Not Portb.1
Loop
End

Dta:
Data "1" , "4" , "7" , "*" , "2" , "5" , "8" , "0" , "3" , "6" , "9" , "#" , "A" , "B" , "C" , "D"

Jeśli masz pytanie to zadaj je na FORUM

Poniżej poprzednia wersja

$regfile = "m32def.dat"
$crystal = 16000000
$hwstack = 80
$swstack = 80
$framesize = 80

Config Submode = New

Config Kbd = Porta , Debounce = 50 , Delay = 50
'W1-PA0, K4-PA7


Config Portd.5 = Output : Gen Alias Portd.5

Config Lcdpin = Pin , Db4 = Portc.2 , Db5 = Portc.3 , Db6 = Portc.4 , Db7 = Portc.5 , E = Portc.1 , Rs = Portc.0
Config Lcd = 16x2
Cursor Off
Cls

Config Timer2 = Timer , Prescale = 1024 , Compare = Disconnect , Clear_timer = 1
 Compare2 = 155                                             '10ms @16MHz

Dim 10ms As Byte , Ticks As Byte
Dim Keyread As Byte , Key As String * 1 , Lock As Byte
Dim Got_key As Byte

Dim Status As Byte , Value_str As String * 10 , Pos As Byte , Lenght As Byte
Dim Value As Dword , Ustaw As Word , Prescaler As Word , Help_d As Dword
Dim Started As Byte

Const Ticks_max = 25
Const Freq = _Xtal  'obliczenia będą automatyczne do zastosowanego rezonatora

Config Portd.5 = Output


Enable Interrupts


Locate 2 , 13 : Lcd "0 Hz"

Do

  'procedura odczytu klawiatury 4x4 z detekcja długiego przycisnięcia ;)
  '----------------------------------------------------------------------
   If Tifr.ocf2 = 1 Then
    Tifr.ocf2 = 1                                          'flagę kasuje się wpisując jedynkę

     Keyread = Getkbd()

       If Keyread <> 16 Then
           If Lock = 0 Then
            Key = Lookupstr(keyread , Dta)
             Select Case Keyread
               Case 0 To 11
                Lock = 1 : Got_key = 1
               Case 12 To 15
                If Ticks < Ticks_max Then
                 Incr Ticks
                  If Ticks = Ticks_max Then
                    If Key = "A" Then Key = "E"
                    If Key = "B" Then Key = "F"
                    If Key = "D" Then Key = "G"
                   Lock = 1 : Got_key = 1
                    Ticks = 0
                  End If
                End If
               Case 14 To 15
               Lock = 1 : Got_key = 1
              End Select

           End If
       Else
          Lock = 0
           If Ticks > 0 Then
            Ticks = 0
             Got_key = 1
           End If
       End If

   End If
   '-----------------------------------------------------------------------

   'mamy coś z klawiatury...
   '-----------------------------------------------------------------------
   If Got_key = 1 Then
        Got_key = 0



        Select Case Key

         Case "0" To "9"
          If Started <> 1 Then

           If Started = 2 Then
               Started = 0
               Value_str = ""
               Locate 2 , 1 : Lcd Spc(12) ; "0"
           End If

           Lenght = Len(value_str)
            If Lenght < 7 Then
             Value_str = Value_str + Key
             Pos = 13 - Lenght
             Locate 2 , Pos : Lcd Value_str

            End If
          End If

         Case "E"                                           'E oznacza długie nacisniecie A

            Help_d = Val(value_str)

          If Help_d > 0 Then

            Select Case Help_d

             Case 1 To 3
             '256
              Config Timer1 = Timer , Prescale = 256 , Compare_a = Toggle , Compare_b = Disconnect , Clear_timer = 1
               Value = Freq
               Shift Value , Right , 8

             Case 4 To 29
             '64
              Config Timer1 = Timer , Prescale = 64 , Compare_a = Toggle , Compare_b = Disconnect , Clear_timer = 1
               Value = Freq
               Shift Value , Right , 6


             Case 30 To 243
             '8
              Config Timer1 = Timer , Prescale = 8 , Compare_a = Toggle , Compare_b = Disconnect , Clear_timer = 1
               Value = Freq
               Shift Value , Right , 3


             Case Else
             '1
              Config Timer1 = Timer , Prescale = 1 , Compare_a = Toggle , Compare_b = Disconnect , Clear_timer = 1
              Value = Freq

            End Select

            Value = Value \ Help_d
            Shift Value , Right , 1

             Decr Value : Ustaw = Value
             Home : Lcd Value ; Spc(6)  'wyswietla obliczona wartość (dla porównania z kalkulatorami - Debug)'

              Compare1a = Ustaw

              Started = 1

          End If

         Case "D"                                           'krótkie nacisniecie D wyłacza sygnał

         Config Timer1 = Timer , Prescale = 1 , Compare_a = Disconnect , Compare_b = Disconnect , Clear_timer = 1
          Stop Timer1

           Reset Gen

              If Started = 1 Then
               Started = 2
              Else
               Value_str = ""
               Locate 2 , 1 : Lcd Spc(12) ; "0"
              End If

        End Select


   End If


Loop
End

Dta:
Data "1" , "4" , "7" , "*" , "2" , "5" , "8" , "0" , "3" , "6" , "9" , "#" , "A" , "B" , "C" , "D"

Poniżej film w którym ten generator nie jest głównym bohaterem. Film pokazuje mój program na Mega8 który pozwala zmieniać wskazania prędkościomierzy samochodowych. Kiedy założysz inne koła to taki układ potrafi skorygować wskazania licznika. Na filmie mnożnik został ustawiony na 1,12. Dlatego częstotliwości wygenerowane jako 100Hz lub 1000Hz po przejściu przez urządzenie dają już wynik 112Hz i 1120Hz



Korekcja narastania jasności LED sterowanej PWM "My Gamma correction in Bascom"

Diody mają nieliniową charakterystykę jasności świecenia w stosunku do prądu jaki przez nie przepuszczasz (tak w skrócie).
Kiedy PWM ma wartość 1, 2, 3, 4 czyli niską to przyrost jasności w tych pierwszych krokach jest duży. Póżniej jednak "dokładanie" już zmienia niewiele. Taki prosty, liniowy PWM powodowałby że ściemnianie i rozświetlanie diody nie wyglądałoby tak jak teraz tylko szybko by się rozjaśniała a przy wyłączaniu długo długo nic by się nie działo po czym by zgasła.. Tak więc wpadłem na pomysł by wydłużać odstępy pomiędzy zmianami PWM kiedy jego wartość jest niska, a przyspieszać zmiany kiedy wartości są większe.

Teraz trochę prostej matematyki

Kiedy PWM ma wartość 1 to odejmuję 1 od 127 czyli mam 126
Żeby uzyskać efekt "do kwadratu" mnożę ten wynik razy 2
Zamiast mnożenia razy 2 użyłem szybszego Shift
Wartość 127 bierze się z tego że kiedy PWM ma wartość 0 to wynik (127) nawet pomnożony razy dwa (254) mieści się w bajcie.
Ta wartość jest wyliczana po to by odliczać czas pomiędzy zmianami wartości PWM. Kiedy PWM ma wartość 0 to odczekać należy 254 tick`i zegara. Kiedy ma wartość 99 to wystarczy już 56 ticków by wartość się zmieniła. Przeliczeń dokonuję wtedy kiedy wartości się zmieniają. Czyli jeśli wartość PWM dojdzie do 100 lub do 0 to już wartość ta zgadza się z poprzednim odczytem (Old_val) i nie są dokonywane dalsze obliczenia. Shift potrafi dzielić lub mnożyć przez potęgę liczby 2. Shift Left 1 oznacza "pomnóż przez dwa"


Kod z filmu powstał na potrzeby odpowiedzi na forum

$regfile = "m8def.dat"
$crystal = 8000000
$hwstack = 80
$swstack = 64
$framesize = 64


Ddrb = &B00011111 : Portb = &B11100000
Ddrc = &B00111100 : Portc = &B00000000
Ddrd = &B11111111 : Portd = &B00000000

Config Timer2 = Timer , Prescale = 8 , Compare = Disconnect , Clear Timer = 1
Enable Compare2 : On Compare2 Tim2_isr : Compare2 = 124

Enable Interrupts

'******************  Zmienne *******************
'***********************************************
Dim Licznik As Byte
Dim Led(3) As Byte                                          'pomocnicza


Dim Z As Byte

D1 Alias Portc.2 : D2 Alias Portc.3 : D3 Alias Portc.4

'***************   przyciski     *****************
Sw1 Alias Pinb.5

Dim Leds_pwm As Byte , M As Byte , Speed As Byte , Old_val As Byte

Do

 If Speed = 0 Then
  If Sw1 = 0 Then
    If Leds_pwm < 100 Then Incr Leds_pwm
  Else
    If Leds_pwm > 0 Then Decr Leds_pwm
  End If

  If Old_val <> Leds_pwm Then 'jesli wartość różni się od poprzedniej
      Old_val = Leds_pwm       ' to zapamiętaj tę wartość

   Speed = 127 - Leds_pwm   ' odejmij aktualną wartość PWM od 127
    Shift Speed , Left , 1  ' Pomnóż razy dwa

    M = Memcopy(leds_pwm , Led(1) , 3 , 2)  ' skopiuj obliczenia do trzech bajtów

  End If
 End If

Loop

'************ Przerwanie timer 0 ***************
'***********************************************
Tim2_isr:
 Incr Licznik

 If Licznik = 100 Then Licznik = 0

 If Licznik < Led(1) Then Set D1 Else Reset D1
 If Licznik < Led(2) Then Set D2 Else Reset D2
 If Licznik < Led(3) Then Set D3 Else Reset D3
  If Speed > 0 Then Decr Speed
Return

Memcopy to wykonywane maszynowo, bardzo szybkie kopiowanie pomiędzy tablicami (zbiór bajtów o tej samej nazwie tylko z indeksami) Można więc szybko skopiować jedną wartość do tych trzech Led(1), Led(2) i Led(3) Memcopy potrzebuje jednej jakiejś pomocniczej zmiennej która musisz postawić przed nią. Użyłem "M" a normalnie wykorzystuję jakiś podręczny pomocniczy Bajt H_byte. Memcopy ma kilka możliwych konfiguracji. Użyłem takiej która skopiuje 1 bajt do trzech kopiując jeden i ten sam wzorzec (czyli Leds_pwm do trzech bajtów)


Jeśli masz pytanie to zadaj je na FORUM

Skala do radia

Funkcji Draw_scale() podajesz tylko częstotliwość bez przecinka


$regfile = "m32adef.dat"
$crystal = 8000000
$hwstack = 128
$swstack = 128
$framesize = 128

 Config Submode = New


Config Lcd = 16x2
Config Lcdpin = Pin , Db4 = Portd.4 , Db5 = Portd.1 , Db6 = Portd.7 , Db7 = Portd.0 , E = Portd.5 , Rs = Portd.6

Deflcdchar 1 , 32 , 32 , 32 , 32 , 32 , 4 , 4 , 21

Deflcdchar 2 , 16 , 16 , 16 , 16 , 16 , 20 , 20 , 21
Deflcdchar 3 , 8 , 8 , 8 , 8 , 8 , 12 , 12 , 29
Deflcdchar 4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , 21
Deflcdchar 5 , 2 , 2 , 2 , 2 , 2 , 6 , 6 , 23
Deflcdchar 6 , 1 , 1 , 1 , 1 , 1 , 5 , 5 , 21

Cursor Off Noblink
Cls

' 16 kratek x 5 pozycji = 80 // Na tyle moze być podzielona skala
' 87,5MHz - 108MHz    1080-875=205     205/80=2,5625  <<<< 256(Shift 8)

Dim Value As Word
Dim Skala As String * 16
Skala = String(16 , 1)

'---------[FOR ENCODER ONNLY]---------------------------------
Config Portd.2 = Input : Set Portd.2 : Encoder_a Alias Pind.2
Config Portb.1 = Input : Set Portb.1 : Encoder_b Alias Pinb.1
Config Portc.7 = Input : Set Portc.7 : Encoder_sw Alias Pinc.7
Config Porta.0 = Output : Relay Alias Porta.0 : Reset Relay

Config Int0 = Falling : Enable Int0 : On Int0 Encoder_isr Nosave
Dim Encoder_turn_left As Byte , Encoder_turn_right As Byte

Enable Interrupts
'-------------------------------------------------------------

Sub Draw_scale(byval Value As Word)


  Local Help_w As Word
  Local Help_b As Byte
  Local X_pos As Byte
  Local Char As Byte

  Local Freq As String * 5
   Freq = Str(value)
    Freq = Format(freq , "00.0")

   Locate 1 , 4
    If Value < 1000 Then Lcd Chr(32)
     Lcd Freq ; "MHz"

  Lowerline : Lcd Skala

  Help_w = Value - 875
   Help_w = Help_w * 100
    Shift Help_w , Right , 8
    Help_b = Help_w

   X_pos = Help_b / 5
   X_pos = X_pos + 1
   Char = Help_b Mod 5
   Char = Char + 2

   Locate 2 , 1 : Lcd Skala
   Locate 2 , X_pos : Lcd Chr(char)

 End Sub


  Value = 892

Call Draw_scale(value)

Do
 If Encoder_turn_right > 0 Then
     Decr Encoder_turn_right

      If Value < 1079 Then                                  '79 zero based = 80
       Incr Value
        Call Draw_scale(value)
      End If

 End If

 If Encoder_turn_left > 0 Then
     Decr Encoder_turn_left

      If Value > 875 Then
       Decr Value
        Call Draw_scale(value)
      End If

 End If


Loop
End

Encoder_isr:

  $asm
  PUSH R24
  !in R24, sreg
  PUSH  R24
  $end Asm

 If Encoder_b = 1 Then
    Encoder_turn_right = 1
 Else
    Encoder_turn_left = 1
 End If
  '          Tuned with NoSave Tool

  $asm
  POP  R24
  !out sreg, r24
  POP R24
  $end Asm

Return

Kontrolowanie głośności komputera AVR`kiem

Do jednego z moich projektów potrzebna mi była możliwość emulowania klawiatury multimedialnej
Za pomocą tego urządzenia możemy zwiększyć lub zmniejszyć siłę głosu komputera.
Urządzenie nie wymaga żadnych sterowników ponieważ przedstawia się jako HID
Przedstawiam to by oszczędzić innym czasu który ja poświęciłem na uruchomienie tego.
Teraz wystarczy zaprogramować wsadem Tiny85 lub dowolny inny mikrokontroler. W paczce znajdują się kody źródłowe. Specjalnie pozostawiłem tam większość funkcji i bardzo łatwo można rozbudować kod o kolejne funkcje.

[Rozmiar: 23266 bajtów]
Paczkę możesz ściągnąć klikając w ikonkę
Pobierz

Oszczędzanie energii w urządzeniach bateryjnych -Powerdown w Bascom

Dobre baterie tanie nie są, a ładowanie akumulatorków kosztuje czas. Każdy pewnie się ucieszy jeśli jego urządzenie pracowałoby dłużej na bateriach. Postanowiłem pokazać krótki przykład i wyjaśnić o co chodzi.
Mikrokontroler można uśpić tak by brał mniej prądu, ale z niektórych stanów uśpienia mogą go wybudzić tylko przerwanie albo ...reset. Mikrokontroler ma też w sobie zaszyte narzędzie które resetuje go jeśli je włączymy a potem zostawimy same sobie. Taki odliczający sekundnik. Można to wykorzystać. Można go ustawić na maksymalną długość - w przypadku Attiny2313 na około 2 sekundy. Po dwóch sekundach układ się zresetuje.
Normalnie jednak wszystkie zmienne podczas Reset są zerowane. Można temu zapobiec wpisując dyrektywę $noramclear
Teraz wystarczy wziąć jedną zmienną i co dwie sekundy kiedy mikrokontroler się obudzi dodawać jeden. Kiedy nazbiera się odpowiadająca nam wartość dopiero wykonać interesujące nas czynności. Kiedy licznik nie ma jeszcze ustalonej wartości mikrokontroler budzi się, dodaje do licznika i znów zasypia. To go dużo nie kosztuje.
W przykładzie migam diodą co 10 sekund na czas 25ms. Resztę tego czasu mikrokontroler śpi.
Można to wykorzystać na przykład w zewnętrznych nadajnikach zbierających odczyty temperatury. 

$regfile = "ATtiny2313.dat"
$crystal = 8000000
$hwstack = 32
$swstack = 16
$framesize = 32

$noramclear                                                 'nie czysc zmiennych w SRAM
Config Watchdog = 2048                                      'okolo 2s

Config Portd.6 = Output : Set Portd.6 : Led Alias Portd.6

Dim Wake_counter As Byte                                    'zmienna nie bedzie czyszczona przy RESET



'tutaj od nowa startuje program

  Incr Wake_counter

   If Wake_counter = 5 Then                                 '5 x 2s = 10s
       Wake_counter = 0

      'tutaj kod do wykonania co okreslony czas

    'przykladowe migniecie dioda
     Reset Led
      Waitms 20
       Set Led
   End If



      Start Watchdog
    Config Powermode = Powerdown

 End

Bascom i CRC w DS18B20

Każdy kto bawił się tymi czujnikami temperatury nie raz pewnie widział jakieś dziwne chwilowe odczyty. Pewnie obiło się też o uszy coś takiego jak to, że te czujniki nadają sumę kontrolną.
Jeśli nie chcesz już nigdy więcej oglądać krzaków na LCD to uzależnij przyjęcie danych jako poprawne od tego czy zgadza się suma kontrolna ;) To bardzo proste! Wystarczy odczytać wszystkie 9 bajtów zamiast zwyczajowych dwóch i porównać ostatni 9 bajt w którym nadawana jest suma kontrolna z obliczeniami jakich dokona Bascom na tych pierwszych ośmiu bajtach. Muszą się zgadzać. Jeśli nie to znaczy że w transmisji nastąpił błąd.

$regfile = "m32def.dat"
$crystal = 8000000
$hwstack = 64
$swstack = 32
$framesize = 32

Config Submode = New

'timer
Config Timer1 = Timer , Prescale = 256 , Compare_a = Disconnect , Compare_b = Disconnect , Clear_timer = 1
 Compare1a = 31249                                          '1s @8MHz/256

Dim 1s As Byte
Dim Bytes(9) As Byte , Sum As Byte
Dim T As Integer At Bytes(1) Overlay                        'dwa pierwsze bajty tablicy tworzą tez Integer ;)

Config 1wire = Portb.1

 1wreset
   1wwrite &HCC
   1wwrite &H44


Do

 If Tifr.ocf1a = 1 Then                                     'jesli uplynela sekunda (te flage ustawia Timer)
   Tifr.ocf1a = 1                                           'skasuj flage by w petli dokonywalo sie to tylko raz na 1s

     1wreset
      1wwrite &HCC
      1wwrite &HBE
      Bytes(1) = 1wread(9)                  'odczytaj 9 bajtów do tablicy (8 bajtów i CRC obliczone przez czujnik)

       Sum = Crc8(bytes(1) , 8)             'sam oblicz CRC z ośmiu bajtów

        If Bytes(8) = &H10 Then                             'sprawdzenie czy ósmy bajt zawiera &H10

          If Sum = Bytes(9) Then               'jeśli nasze obliczenia zgadzaja się z tymi od czujnika...

            T = T * 10
            T = T \ 16
             Home : Lcd T                      'należy sobie dorysować przecinek :D

          End If

        End If

      1wreset
       1wwrite &HCC
       1wwrite &H44                                         'przygotuj nastepny odczyt temperatury
 End If

Loop

Najprostszy odbiornik Rc5w Bascom

Pilot przy przytrzymaniu przycisku nie nadaje stale tylko z przerwami ponawia komendę. Sterowany w ten sposób silnik by szarpał a dioda lub żarówka by migała. Poniższy kod utrzymuje pin portu w jednym stanie do momentu puszczenia przycisku pilota.

'Odbiornik RC5
'Wyjścia w stanie niskim tak długo jak trzyma się przycisk
$regfile = "attiny13a.dat"                                  '44% Flash
$crystal = 9600000
$hwstack = 24
$swstack = 18
$framesize = 16

$lib "mcsbyte.lbx"                                          'wykorzystamy bibliotekę która ogranicza się do
                                                             'uzywania tylko bajtów celem zmniejszenia kodu
Config Portb.3 = Output
Config Portb.4 = Output                                     'tu diody ale mogą to być wyjścia
Led_r Alias Portb.3
Led_l Alias Portb.4
Set Led_r                                                   'żeby nie włączyć dwóch kierunków na raz
Set Led_l

Config Rc5 = Pinb.0

Dim Address As Byte                                         'typ urządzenia np.0-telewizor, 8-sat
Dim Command As Byte                                         'np 17 ciszej,16 głośniej
Dim Odczekaj As Byte
Const Deelay = 20

Enable Interrupts                                           ' zezwolenie na przerwania
'*** START ***
Do

Getrc5(address , Command)                                   'sprawdź czy pilot nadaje

If Address <> 255 Then                                      'jeśli Wpisać "If Address=0 Then"
  Command = Command And &B01111111                          'to zawęzimy tylko do telewizorów

 Select Case Command

   Case 16                                                  'przycisk pilota +
      Reset Led_l
      Odczekaj = Deelay
   Case 17                                                  'przycisk pilota -
      Reset Led_r
      Odczekaj = Deelay

  End Select

End If

If Odczekaj <> 0 Then Decr Odczekaj

If Odczekaj = 0 Then
 Set Led_l
 Set Led_r
End If

Loop
End
'*** KONIEC ***

Przyciski trochę inne

Jeśli chcesz przełączać osiem pinów jednego portu przyciskami innego portu i mieć jeszcze możliwość różnej reakcji na długie i krótkie wciśnięcie to możesz zaadoptować na swoje potrzeby poniższy kod.
W momencie przyciśnięcia przycisku stan portu przycisków jest zapamiętywany w pomocniczej zmiennej Help_byte, ponieważ po puszczeniu przycisku to ona będzie pamiętać który przycisk był wciśnięty i to posłuży do przełączenia żądanego pinu.
Sprawa nie jest skomplikowana i zamyka osiem do szesnastu spraw w jednej procedurze :D
Wyłuskujemy wciśnięty przycisk, ale w całym bajcie ma on wtedy zapis stanu niskiego 0. Do odwrócenia portu poprzez XOR potrzebujemy 1 więc odwracamy stan całego bajtu poprzez Bajt = NOT Bajt i tym sposobem możemy już odwrócić stan wybranego pinu. Długie i krótkie przyciśniecie rozwiązywane jest prosto - jeśli przed puszczeniem przycisku zmienna _counter osiągnie zadaną wartość znaczy, że to długie wciśnięcie.

Dim Przyciski_port As Byte , Help_byte As Byte , _counter As Byte , Wyjscia_port As Byte



'*** obsluga przyciskow wołana z petli głównej na przykład co 5ms ***
Przyciski:
  Przyciski_port = Pina       

  If Przyciski_port <> &B11111111 Then      
    Help_byte = Przyciski_port

    If _counter < 255 Then Incr _counter
    If _counter = 100 Then
      Select Case Przyciski_port
        'osiem różnych, zależnych od przycisku, kodów do wykonania po długim naciśnieciu
      End Select
    'cos wykonywane zawsze niezależnie który przycisk, na przykład BEEP
  End If
Else
  If _counter > 1 Then
    If _counter < 100 Then
      Help_byte = Not Help_byte
      Wyjscia_port = Pinb
      Wyjscia_port = Wyjscia_port Xor Help_byte
      Portb = Wyjscia_port
      'odwraca stan pinu innego portu odpowiadajacy wcisnietemu przyciskowi
    End If
      _counter = 0
    End If
  End If

Return

Powerdown - oszczędzanie prądu

On/Off na jednym przycisku

Jeśli używasz urządzenia na bateriach to możesz chcieć je wyłączyć, ale na przykład za pomocą jednego przycisku, a nie mechanicznego wyłącznika. Możesz uśpić procesor poleceniami konfigurującymi oszczędzanie energii. Jest ich więcej i nie wszystkie wyłączają Timery, więc wariacji może być więcej, ale tu pokażę te z którego wybudzić procesor może tylko przerwanie zewnętrzne albo Watchdog. Żeby włączanie i wyłączanie działało na tym samym przycisku rozwiązane być musiało tak, że tryb Powerdown i zezwolenie na przerwanie włączane jest dopiero po puszczeniu przycisku. 

Dim Lock As Word                                            'ilosc cykli do ponownego wcisniecia
Dim Turn_off As Bit                                         'flaga ustawiana by zadziałało po puszczeniu

Config Portc.5 = Output : Set Portc.5                       'dowolny port na przykład podświetlanie LCD
Led Alias Portc.5                                           '+ z procesora, dioda do masy

Config Portd.2 = Input : Set Portd.2                        'przycisk na wejściu INTx
Switch Alias Pind.2

Config Int0 = Low Level                                     'ważne "LOW LEVEL"
On Int0 Int0_isr
Enable Interrupts

'*** START ***
Do

If Switch = 0 Then                                          'jesli wcisnieto przycisk
 If Lock = 0 Then                                           'a zmienna już wyzerowana
    Lock = 10000                                            'to zablokuj poprzez wpis do zmiennej
    Turn_off = 1                                            'ustaw flage by po puszczeniu przycisku zadziałało
 End If
Else
 If Lock > 0 Then Decr Lock                                 'jesli blokada to zdejmuj po jednej
 If Lock = 0 Then                                           'jesli blokada równa zero
  If Turn_off = 1 Then                                      'a byl wcisniety przycisk
     Turn_off = 0                                           'to skasuj flage
       Reset Led                                            'zgas diode
       Enable Int0                                          'dopiero zezwalaj na przerwanie(inaczej ten kod by sie nie wykonal)
       'Display Off                                          'ewentualne wyłaczenie/czyszczenie LCD
       Config Powermode = Powerdown                         'idź spac
   End If
  End If
End If

Loop
End
'*** KONIEC ***

Int0_isr:
Disable Int0                                                'wylacz to przerwanie
Set Led                                                     'wlacz diode
'Display On                                                  'wlacz LCD
Lock = 10000                                                'zablokuj automatyczne przejscie znow
Return

Zegar - prostszy nie będzie - soft RTC w Bascom

Jeśli potrzebujesz w swoim projekcie zegar i Twój projekt może pracować na wewnętrznym kwarcu, to możesz zamiast rezonatora podłączyć taki malutki zegarkowy i mieć zegar oraz sygnał upłynięcia sekundy pisząc cztery linijki kodu.
Wpisując "Config Clock = Soft" kompilator użyje Timera2 oraz stworzy zmienne _sec, _min, _hour, _day, _month, i _year do których oczywiście masz dostęp. To naprawdę proste i łatwe do wykorzystania. Twój projekt może pracować normalnie z prędkością wewnętrznego oscylatora. Nie trzeba oczywiście wyświetlać wszystkich danych. Można jedynie korzystać z danych. Instrukcje Date$ i Time$ formatują tylko, po prostu dane tak, że niepotrzebne jest wstawianie zer jeśli dane mniejsze od dziesięciu i układaja je w całość za nas.

$regfile = "m328pdef.dat"
$crystal = 8000000                                          'procesor działa na WEWNĘTRZNYM oscylatorze
$hwstack = 64
$swstack = 64
$framesize = 64


Config Clock = Soft                                         'zamiast "kwarca" podłacz kwarc zegarkowy 32kHz
Config Date = Dmy , Separator = /

Date$ = "20/11/14"
Time$ = "12:00:50"

Dim Old_sec As Byte

Enable Interrupts
'*** START ***
Do
'miejsce na kod programu'


'co sekunde lub jak bedziesz chciał sprawdzic czas'
If Old_sec <> _sec Then                                     'jesli zapamietana sekunda rózni sie od aktualnej
   Old_sec = _sec                                           'zapamietaj aktualna
    Locate 1 , 2 : Lcd Date$ ; Spc(2) ; Time$
End If
Loop
End
'*** KONIEC ***

Ekspresowy termometr czterokanałowy ;)

(Każdy na osobnym pinie mikrokontrolera)

'### TERMOMETR 4xDS18B20 ###
$regfile = "m328pdef.dat"
$crystal = 8000000
$hwstack = 128
$swstack = 64
$framesize = 64
 
Config Lcdpin = Pin , Db4 = Portb.2 , Db5 = Portb.3 , Db6 = Portb.4 , Db7 = Portb.5 , E = Portb.1 , Rs = Portc.0
Config Lcd = 20x4
Cursor Off
Cls
 
Dim N As Byte
Dim T As Integer
Dim S As String * 5
Dim Linia As Byte , Pozycja As Byte
 
Do
'jesli piny sa obok siebie to po kolei
For N = 4 To 7                                              'od numeru pinu w porcie do numeru pinu w porcie
 1wreset Pind , N                                           'dzialaj dla aktualnie ustawionego pinu
  1wwrite &HCC , 1 , Pind , N
  1wwrite &HBE , 1 , Pind , N
  T = 1wread(2 , Pind , N)
  T = T * 10
  T = T / 16
  S = Str(t)
  S = Format(s , "+0.0")
 
 Select Case N                                              'w zaleznosci od tego ktory to pin
  Case 4                                                    'ustaw kursor na wlasciwej pozycji
    Linia = 1
    Pozycja = 1
  Case 5
    Linia = 1
    Pozycja = 9
  Case 6
    Linia = 2
    Pozycja = 1
  Case 7
    Linia = 2
    Pozycja = 9
 End Select
 
  Locate Linia , Pozycja                                    'rysuj na wybranym miejscu
   Lcd S ; Chr(223) ; "C "
 
 1wreset Pind , N                                           'kaz przygotowac kolejny odczyt
  1wwrite &HCC , 1 , Pind , N
  1wwrite &H44 , 1 , Pind , N
Next
 
Wait 1
 
Loop
End

Tak to wygląda. Zdjęcie wykonałem jeszcze na płytce testowej. Napisany z myślą o LCD16x2. Dla temperatur ujemnych pokazuje minus.

[Rozmiar: 39751 bajtów]

Ekspresowy termometr dwukanałowy ;)

Na jednym pinie, bez przyuczania numerow seryjnych ;)

'### PODWÓJNY TERMOMETR ###
Config Lcdpin = Pin , Db4 = Portd.1 , Db5 = Portd.2 , Db6 = Portd.3 , Db7 = Portd.4 , E = Portd.0 , Rs = Portd.5
Config Lcd = 16 * 2
Cursor Off
Cls

Config 1wire = Portd.6

Dim Dsid1(8) As Byte , Dsid2(8) As Byte
Dim N As Byte
Dim T As Integer
Dim S As String * 5
Const Blad = " ERROR " 'dla powtarzajacych sie tekstow warto wpisac je tylko raz

Dsid1(1) = 1wsearchfirst()
Dsid2(1) = 1wsearchnext()

Lcd "  IN       OUT"
'*** START ***
Do

1wreset
 1wwrite &HCC
 1wwrite &H44
   Waitms 500

Locate 2 , 1

'1wreset
' 1wwrite &H55
1wverify Dsid1(1)     '1wreset i 1wwrite &H55 niepotrzebne bo 1wverify samo to przeprowadza
 If Err = 0 Then
 1wwrite &HBE
 T = 1wread(2)
 T = T * 10
 T = T / 16
  S = Str(t)
  S = Format(s , "+0.0")
  Lcd S ; Chr(223) ; "C "
 Else
  Lcd Blad
 End If

1wreset
 1wwrite &HCC
 1wwrite &H44
   Waitms 500

Locate 2 , 10

'1wreset
' 1wwrite &H55
1wverify Dsid2(1)     '1wreset i 1wwrite &H55 niepotrzebne bo 1wverify samo to przeprowadza
 If Err = 0 Then
 1wwrite &HBE
 T = 1wread(2)
 T = T * 10
 T = T / 16
  S = Str(t)
  S = Format(s , "+0.0")
  Lcd S ; Chr(223) ; "C "
 Else
  Lcd Blad
 End If

Loop
End
[Rozmiar: 32385 bajtów]

Programowe PWM na ośmiu kanałach na Attiny2313 i każdym innym - Soft PWM Bascom

Tak się pobawiłem żeby sprawdzić. Można każdą diodę ustawić na oddzielną wartość PWM. Cały PORTD wolny wiec można tym sterować w dowolny sposób. Samo Programowe PWM prawie nic nie waży. Generowanie różnych sekwencji dopiero.
Podoba mi się muzyka więc i Wam pokażę.

Pomysł zaczerpnięty stąd http://mirley.firlej.org/kody_zrodlowe


$regfile = "attiny2313.dat"
$crystal = 8000000

'*** Timer0 Config for 8kHz  Interrupt CTC Mode ***
Config Timer0 = Timer , Prescale = 8 , Compare A = Disconnect , Compare B = Disconnect , Clear Timer = 1
Enable Compare0a : On Compare0a Int0_isr : Compare0a = 124
Config PORTB = Output
'******************  Zmienne *******************
'***********************************************
Dim Licznik As Byte                                         'liczy od 1 do 100 w przerwaniu
Dim Pwm_led(8) As Byte                                      'osiem bajtów, dla każdego kanału wartosc PWM 0%-100%
Dim N As Byte
Enable Interrupts


Do

 'w pętli wpisuj żądane wartości PWM w bajtach
 'w miedzyczasie program moze robić coś innego
Pwm_led(1) = 20
Pwm_led(2) = 20
Pwm_led(3) = 20
Pwm_led(4) = 20
Pwm_led(5) = 20
Pwm_led(6) = 20
Pwm_led(7) = 20
Pwm_led(8) = 20


Loop
End



'************ Przerwanie timer 0 ***************
'***********************************************
Int0_isr:
 Incr Licznik                                               'zwieksz Licznik o jeden
 If Licznik = 100 Then Licznik = 0                          'jesli Licznik = 100 to wyzeruj

 'pętla dla wartości 0 do 7 czyli tak jak numery bitów w porcie
  For N = 0 To 7
 'jesli Licznik ma mniej niż PWM dla danego pinu to ustaw 0 na pin , w przeciwnym wypadku ustaw 1
 ' (do N trzeba dodac 1 bo tablice zaczynaja sie od 1, nie ma wartosci 0)
   If Licznik < Pwm_led(n + 1) Then Reset Portb.n Else Set Portb.n
  Next

Return

Inny przykład zastosowania takiego PWM - rozpalanie wszystkich

Zastosowałem tam też takie rozwiązanie które wymaga wyjaśnienia. Diody led się zapalają juz przy niskiej wartości PWM wiec wymyśliłem sobie że im niższa wartość PWM tym dłużej wartość tego PWM ma sie nie zmieniać. Czyli jeśli PWM ma wartosc 1 to odejmuję 1 od 127 i mam 126. 126 mnoże razy dwa i zawsze mieszczę sie w bajcie. 252 cykle muszą upłynąć zanim znów zmienię wartość PWM. Za to potem wszystko przyspiesza proporcjonalnie ;)


$regfile = "attiny2313.dat"
$crystal = 8000000
$hwstack = 40
$swstack = 16
$framesize = 24
 
 
Config Portb = &B11111111 : Portb = &B11111111              'PORTB cały wyjscia, PORTB cały w stan wysoki
Config Portd = &B00000000 : Portd = &B11111111              'nieużywany PORTD cały wejście właczone podciąganie
 
'*** Timer0 Config for 8kHz  Interrupt CTC Mode ***
Config Timer0 = Timer , Prescale = 8 , Compare A = Disconnect , Compare B = Disconnect , Clear Timer = 1
Enable Compare0a : On Compare0a Int0_isr : Compare0a = 124
 
Enable Interrupts
 
'******************  Zmienne *******************
'***********************************************
Dim Licznik As Byte                                         'liczy od 1 do 100 w przerwaniu
Dim Pwm_led(8) As Byte                                      'osiem bajtów, dla każdego kanału wartosc PWM 1%-100%
Dim N As Byte                                               'pomocnicza
Dim Speed As Byte                                           'spowolnienie akcji
Dim Scenario As Byte                                        'wybor dwoch trybów
Dim Led_nr As Byte                                          'numer bajtu w tablicy PWM'ów
 
Led_nr = 1                                                  'zmienna ma 0 wiec nadaje jej wartosc 1
 
'**************  Petla glowna ******************
'***********************************************
Do
 
If Speed = 0 Then                                           'jesli nadszedl czas na zmiane PWM
 
 
 
Select Case Scenario                                        'sprawdz co robimy
 
Case 0                                                      'Scenariusz rozpalamy
 
   If Pwm_led(led_nr) < 100 Then                            'jesli wartosc pwm AKTUALNIE OBRABIANEJ DIODY...
   'zmienna led_nr pamieta ktora diode akurat rozjasniamy lub sciemniamy
       Incr Pwm_led(led_nr)
       Speed = 127 - Pwm_led(led_nr)
       Speed = Speed * 2
    Else                                                    'jesli doszlismy do 100 to bierzemy kolejna diode
       If Led_nr < 8 Then
         Incr Led_nr
        Else                                                'jesli doszlismy do konca to zabieram sie za sciemnianie
         Scenario = 1
         Led_nr = 1                                         'zaczynamy sciemniac od poczatku
        End If
    End If
 
Case 1
 
   If Pwm_led(led_nr) > 0 Then
       Decr Pwm_led(led_nr)
       Speed = 127 - Pwm_led(led_nr)
       Speed = Speed * 2
    Else
       If Led_nr < 8 Then
         Incr Led_nr
        Else
         Scenario = 0
         Led_nr = 1
        End If
    End If
 
 
End Select
 
 
End If
Loop
End
 
 
'************ Przerwanie timer 0 ***************
'***********************************************
Int0_isr:
 Incr Licznik                                               'zwieksz Licznik o jeden
 If Licznik = 100 Then Licznik = 0                          'jesli Licznik = 100 to wyzeruj
 
 'pętla dla wartości 0 do 7 czyli tak jak numery bitów w porcie
  For N = 0 To 7
 'jesli Licznik ma mniej niż PWM dla danego pinu to ustaw 0 na pin , w przeciwnym wypadku ustaw 1
 ' (do N trzeba dodac 1 bo tablice zaczynaja sie od 1, nie ma wartosci 0)
   If Licznik < Pwm_led(n + 1) Then Reset Portb.n Else Set Portb.n
  Next
 
  'odliczanie do zmiann wartosci
   If Speed > 0 Then Decr Speed                             'jesli Speed wieksza od zera to odejmuj jeden
Return

Można to na końcu wykorzystać do sterowania podświetleniem schodów ;)


Ruchoma skala dla wyświetlacza graficznego

Taka oto skala która przewija się na wyświetlaczu. Skala ma 10 możliwych stanów (offset). Co ciekawe napisana jest jako Sub więc można go załączyć do każdego projektu ponieważ w większości operuje na swoich zmiennych lokalnych. Mogę dopisać automatyczne dopasowanie się do żądanej długości i tym podobne , ale żeby pokazać zasadę działania załączam najprostszą wersję ;)
Żeby ją użyć wystarczy w programie wywołać ją Call Draw_skale(kierunek,offset,pozycja)
W swoim programie musimy tylko zadeklarować dwie zmienne trzymające pozycję i offset dla każdej ze skal jeśli jest ich więcej.




Sub Draw_scale(byval Kierunek As Byte , Byval Offset As Byte , Byval Pozycja As Byte)
'mozliwe kierunki Lewo = 1, Prawo = 2, Tylko_rysuj = 0
'mozliwe offsety 0 - 9
'Pozycja to pozycja linii

 Local Help_x As Byte
 Local Help_y As Byte , Help_y2 As Byte , Help_y3 As Byte
 Local N As Byte , X_offset As Byte , Del_byte As Byte , Help_byte As Byte

  Help_y = Pozycja

   Line(0 , Help_y) -(239 , Help_y) , 255                   'rysowanie dwoch linii skali
  Incr Help_y
   Line(0 , Help_y) -(239 , Help_y) , 255

  Help_y = Pozycja + 2 : Help_y2 = Pozycja + 10 : Help_y3 = Pozycja + 5       'wysokosci kreseczek

  X_offset = Offset                                         'na ktorej pozycji pierwsza duza kreska


  For N = 0 To 239

     If N = X_offset Then
         X_offset = X_offset + 10

       Line(n , Help_y) -(n , Help_y2) , 255                'rysowanie dluzszych

          If N < 235 Then
           Help_x = N + 5
            Del_byte = N + 4
          Else
           Help_byte = N + 5
           Help_x = Help_byte - 240
          End If

           Select Case Kierunek
            Case Prawo
             Del_byte = Help_x - 1
              If Del_byte > 239 Then Del_byte = 239
            Case Lewo
             Del_byte = Help_x + 1
              If Del_byte > 239 Then Del_byte = 0
            End Select

        Line(help_x , Help_y) -(help_x , Help_y3) , 255     'rysowanie krotszych
        Line(del_byte , Help_y) -(del_byte , Help_y3) , 0   'kasowanie krotszych

        Select Case Kierunek
           Case Prawo
            If N = 0 Then
             Help_x = 239
            Else
             Help_x = N - 1
            End If
           Case Lewo
            If N = 239 Then
             Help_x = 0
            Else
             Help_x = N + 1
            End If
         End Select

   If Kierunek <> Tylko_rysuj Then Line(help_x , Help_y) -(help_x , Help_y2) , 0       'kasowanie dluzszych

      End If
   Next

End Sub

Ruchoma skala w pionie..z cyferkami :D

Sub Draw_scale2(byval Kierunek As Byte , Byval Offset As Byte , Byval Pozycja As Byte)
 
 Local Help_y As Byte
 Local Help_x As Byte , Help_x2 As Byte , Help_x3 As Byte
 Local N As Byte , Y_offset As Byte , Del_byte As Byte , Help_byte As Byte
 
  Help_x = Pozycja
 
   Line(help_x , 0) -(help_x , 127) , 255                   'rysowanie dwoch linii skali
  Incr Help_x
   Line(help_x , 0) -(help_x , 127) , 255
 
  Help_x = Pozycja + 2 : Help_x2 = Pozycja + 10 : Help_x3 = Pozycja + 5       'wysokosci kreseczek
 
  Y_offset = Offset                                         'na ktorej pozycji pierwsza duza kreska
 
 
  For N = 0 To 127
 
     If N = Y_offset Then
         Y_offset = Y_offset + 10
 
       Line(help_x , N) -(help_x2 , N) , 255                'rysowanie dluzszych
 
          If N < 123 Then
           Help_y = N + 5
            Del_byte = N + 4
          Else
           Help_byte = N + 5
           Help_y = Help_byte - 128
          End If
 
           Select Case Kierunek
            Case Prawo
             Del_byte = Help_y - 1
              If Del_byte > 127 Then Del_byte = 127
            Case Lewo
             Del_byte = Help_y + 1
              If Del_byte > 127 Then Del_byte = 0
            End Select
 
        Line(help_x , Help_y) -(help_x3 , Help_y) , 255     'rysowanie krotszych
        Line(help_x , Del_byte) -(help_x3 , Del_byte) , 0   'kasowanie krotszych
 
        Select Case Kierunek
           Case Prawo
            If N = 0 Then
             Help_y = 127
            Else
             Help_y = N - 1
            End If
           Case Lewo
            If N = 127 Then
             Help_y = 0
            Else
             Help_y = N + 1
            End If
         End Select
 
   If Kierunek <> Tylko_rysuj Then Line(help_x , Help_y) -(help_x2 , Help_y) , 0       'kasowanie dluzszych
 
      End If
   Next
 
End Sub

PWM 0-255 regulowane niepełną skalą ADC

Może się tak zdarzyć że mamy sygnał z potencjometru w jakimś "okrojonym" zakresie
Na przykład 0,5V do 4,5V a chcemy sterować współczynnikiem wypełnienia impulsu PWM
Ten kod uczy się skrajnych wartości i potem przelicza je na pełny zakres dla PWM.


[Rozmiar: 18233 bajtów]
$regfile = "attiny13.dat"
$crystal = 9600000
$hwstack = 12
$swstack 6
$framesize = 16

' Full Range PWM from ADC by BARTek
' https://bart-projects.pl/
' The device is able to calculate the full scale PWM from ADC incomplete scope
' For example, the values range from 23 to 1010 will be scaled to the value 0 - 255 PWM
' To calibrate, press button (short pin to ground) and enter the potentiometer lowest and highest value.
' After releasing the button, the value will be calculated and memorized
' Fuses for ATtiny13  LOW 7A  HIGH FF
 
'$sim

Config Timer0 = Pwm , Compare A Pwm = Clear Down , Prescale = 1

Config Adc = Single , Prescaler = Auto , Reference = Avcc
Start Adc

Config Portb = &B00001 : Portb = &B10110

V_out Alias Portb.0

Potenc Alias Pinb.3
Switch Alias Pinb.4

Dim Minimum As Word , Maximum As Word
Dim Pot As Word , Help As Word , Suma As Word , Wynik As Word
Dim Lock As Byte , Przelicznik As Dword , Wart As Byte , Mem As Word

Readeeprom Mem , 2
Readeeprom Minimum , 4

Do

    Pot = Getadc(3)


      Select Case Lock
       Case 0
          If Switch = 0 Then
              Waitms 50
               If Switch = 0 Then
                   Lock = 1
                   Minimum = 512
                   Maximum = 512
               End If
            Else
                 'digital filter for ADC values
                  Help = Suma
                  Shift Help , Right , 3
                  Suma = Suma - Help
                  Suma = Suma + Pot
                  Help = Suma
                  Shift Help , Right , 3

              If Help < Minimum Then Help = Minimum

              If Help <> Wynik Then
                  Wynik = Help
                   Help = Wynik - Minimum
                   Przelicznik = Help * Mem
                   Przelicznik = Przelicznik \ 4000
                   Wart = Przelicznik
                    Pwm0a = Wart

              End If
           End If

        Case 1

          If Switch = 1 Then
              Lock = 0
              Help = Maximum - Minimum
              Przelicznik = 1024000 \ Help
              Mem = Przelicznik

              Writeeeprom Mem , 2
              Writeeeprom Minimum , 4

           Else

             If Pot > Maximum Then Maximum = Pot
             If Pot < Minimum Then Minimum = Pot

          End If

       End Select


Loop
End

Jeśli masz pytanie to zadaj je na FORUM


Email

Jeśli mogę w czymś pomóc, napisz.