'Nachtnurflügler mit WS2812-Leds (RC-gesteuert) 'Leuchteffekte werden mittels RC-Signal um einen Effekt weiter oder zurück geschaltet 'RC Signal muss nach einem Effektwechsel wieder zum Mittelwert (Todband, Mittelstellung) zurückgebracht werden, bevor ein erneutes Schalten möglich ist 'Bascom Version 2.0.8.0 '$sim $regfile = "attiny85.dat" $crystal = 8000000 $hwstack = 32 'default use 32 for the hardware stack $swstack = 10 'default use 10 for the SW stack $framesize = 40 'default use 40 for the frame space Const Cooling = 55 '55 (for taller flame -> decrease value) Const Sparking = 200 '200 (lower value = more short sparks appear) Const Num_leds = 30 '30 (Anzahl LEDs pro Strip) Dim Color_heat As Byte Config Rainbow = 2 , Rb0_len = Num_leds , Rb0_port = Portb , Rb0_pin = 2 , Rb1_len = Num_leds , Rb1_port = Portb , Rb1_pin = 1 ' ^ connected to pin x ' ^------------ connected to portx ' ^-------------------------- x leds on stripe ' ^------------------------------------- x channel Declare Function Fade_out(byval F As Byte , Byval H_farbe As Byte)as Byte 'spart Speicherplatz im Gegensatz zu meiner Methode Const Cooling_10 = Cooling * 10 Const Cooling_10_2 = Cooling * 12 ' Constante wird benötigt, weil Flamme von Kanal 2 stets höher war als Flamme vom Kanal 1 Const Sparking_2 = Sparking - 25 ' Constante wird benötigt, weil Flamme von Kanal 2 zu wenig Sparkings gespuckt hat Const Num_leds_1 = Num_leds - 1 Const Num_leds_2 = Num_leds_1 * 2 Dim Heat1(num_leds) As Integer Dim Heat2(num_leds) As Integer Dim N As Word Dim X As Integer Dim Y As Integer Dim Loading As Bit Dim Position As Word 'Tropfen, Knight Rider, Rainbow Cycle Dim Position_1 As Word 'Tropfen, Rainbow Cycle Dim Direction As Bit 'Knight Rider Dim A As Byte Dim B As Byte Dim C As Byte Dim Stripe_change_counter As Byte 'Knight Rider Dim Zielfarbe_erreicht As Byte 'Tropfen Dim Speed As Byte 'Bayernfarben Dim Prog_counter As Word ' Police Dim Farbe(3) As Byte Rot Alias Farbe(_base) Gruen Alias Farbe(_base + 1) Blau Alias Farbe(_base + 2) Dim Farbe_(3) As Byte 'Tropfen R_ Alias Farbe_(_base) G_ Alias Farbe_(_base + 1) B_ Alias Farbe_(_base + 2) Dim Farbe_h(3) As Byte 'Tropfen Hintergrundfarbe R_h Alias Farbe_h(_base) G_h Alias Farbe_h(_base + 1) B_h Alias Farbe_h(_base + 2) Dim Delta(3) As Byte Dim Up_down As Bit Dim Effect As Byte Dim Effect_old As Byte Dim Impulslaenge_1 As Byte Dim Rc_frequency As Word 'Häufigkeit der RC-Abfragen Const Rc_schwellwert_1 = 120 'Unterhalb dieses Wertes wird um einen Effekt zurückgeschaltet (>100) Const Rc_schwellwert_2 = 130 'Unterer Wert des Mittelstellungs-Todpunkts (muss höher sein als Rc_schwellwert_1) Const Rc_schwellwert_3 = 170 'Oberer Wert des Mittelstellungs-Todpunkts (muss niedriger sein als Rc_schwellwert_4) Const Rc_schwellwert_4 = 180 'Oberhalb dieses Wertes wird um einen Effekt weiter geschaltet (<200) Const Stufen = 50 'Tropfen, 50x so schnelles hochdimmen Const Alignment = 768 / Num_leds 'Rainbow Cycle, Aufteilung des Farbspektrums auf die Anzahl der LEDs Config Pinb.4 = Input 'RC Signal Eingang Loading = 0 Effect = 0 Waitms 500 '######################### Start Hauptprogramm (Auswahl der Effekte)############################### Do Select Case Effect Case 0 : Gosub Green Case 1 : Gosub Police Case 2 : Gosub Bayern Case 3 : Gosub Feuerkugelwerfer Case 4 : Gosub Knight Case 5 : Gosub Tropfen Case 6 : Gosub Fire Case 7 : Gosub Rainbow_cycle Case Else : Gosub Green 'nur zur Sicherheit End Select If Effect = 8 Then Effect = 0 If Effect = 255 Then Effect = 7 Loop '#################################### Ende Hauptprogramm ########################################### '############################### Effekte ####################################### '############################### Green ####################################### Green: Do For A = 0 To 1 'Beide Strips bearbeiten Rb_selectchannel A Rot = 0 Gruen = 255 Blau = 0 Rb_fillstripe Farbe() Next A '=========================== RC Abfrage ========================= Gosub Rc_abfrage '================================================================ Loop Until Effect <> Effect_old 'solange wiederholen bis ein neuer Effekt gewünscht wird Effect_old = Effect Loading = 0 Return 'und wieder zur Abfrage springen '############################## Fire ##################################### Fire: Do '----------------------------- Flamme 1 --------------------------------- ' Step 1. Cool down every cell a little For N = 0 To Num_leds_1 X = Cooling_10 / Num_leds : Y = Rnd(x) + 3 '3 Heat1(n) = Heat1(n) - Y If Heat1(n) < 0 Then Heat1(n) = 0 Next N ' Step 2. Heat1 from each cell drifts 'up' and diffuses a little For N = Num_leds_1 To 2 Step -1 X = Heat1(n -1) : X = X + Heat1(n -2) : X = X + Heat1(n -2) : X = X / 3 Heat1(n) = X Next N ' Step 3. Randomly ignite new 'sparks' of heat near the bottom If Rnd(255) < Sparking Then X = Rnd(7) Y = 170 + Rnd(85) '170 Heat1(x) = Heat1(x) + Y If Heat1(x) > 255 Then Heat1(x) = 255 '255 End If ' Step 4. Map from heat cells to LED colors For N = 0 To Num_leds_1 X = Heat1(n) ' X = X / Color_heat ' bei Potibetrieb X = X / 7 X = X * 3 Rot = Lookup(x , Farben) X = X + 1 : Gruen = Lookup(x , Farben) X = X + 1 : Blau = Lookup(x , Farben) Rb_selectchannel 0 'welcher Kanal soll angesteuert werden Rb_setcolor N , Farbe() ' Farbe in den Farbspeicher schreiben Next N Rb_send ' Farben vom Farbspeicher zum Strip schicken '----------------------------- Flamme 2 --------------------------------- ' Step 1. Cool down every cell a little For N = 0 To Num_leds_1 X = Cooling_10_2 / Num_leds : Y = Rnd(x) + 3 Heat2(n) = Heat2(n) - Y If Heat2(n) < 0 Then Heat2(n) = 0 Next N ' Step 2. Heat2 from each cell drifts 'up' and diffuses a little For N = Num_leds_1 To 2 Step -1 X = Heat2(n -1) : X = X + Heat2(n -2) : X = X + Heat2(n -2) : X = X / 3 Heat2(n) = X Next N ' Step 3. Randomly ignite new 'sparks' of heat near the bottom If Rnd(255) < Sparking_2 Then X = Rnd(7) Y = 170 + Rnd(85) '170 Heat2(x) = Heat2(x) + Y If Heat2(x) > 255 Then Heat2(x) = 255 '255 End If ' Step 4. Map from heat2 cells to LED colors For N = 0 To Num_leds_1 X = Heat2(n) ' X = X / Color_heat ' bei Potibetrieb X = X / 7 X = X * 3 Rot = Lookup(x , Farben) X = X + 1 : Gruen = Lookup(x , Farben) X = X + 1 : Blau = Lookup(x , Farben) Rb_selectchannel 1 Rb_setcolor N , Farbe() Next N Rb_send '=========================== RC Abfrage ========================= Incr Rc_frequency If Rc_frequency > 12 Then Gosub Rc_abfrage '12 Wert abhängig von der Durchlaufzeit des jeweiligen Effekts '================================================================ Loop Until Effect <> Effect_old 'solange wiederholen bis ein neuer Effekt gewünscht wird Effect_old = Effect Loading = 0 Return 'und wieder zur Abfrage springen '################ Knight Rider, exponentiellen Nachglüheffekt + Hintergrundfarbe ####################### Knight: Do If Loading = 0 Then 'Farben berechnen und Strip laden B = 0 Stripe_change_counter = 0 'Hintergrundfarbe setzen R_h = 10 G_h = 0 B_h = 0 'Sollfarbe setzen Rot = 255 Gruen = 0 Blau = 0 Position = 0 Loading = 1 End If 'Runterdimmen auf Hintergrundfarbe For A = 0 To 1 'Beide Strips bearbeiten Rb_selectchannel A For N = 0 To Num_leds_1 Farbe_(1) = Rb_getcolor(n) For Y = 0 To 1 'Nachglühdauer einstellen (höherer Wert, kürzere Nachglühdauer) 'folgende Zeilen werden durch die Funktion "Fade_out" ersetzt '( If R_ > 200 Then R_ = R_ - 10 'pseudo 3 Punkte Kurve für exponentielles Dimmen If R_ < 200 And R_ > 120 Then R_ = R_ - 7 If R_ < 120 And R_ > 50 Then R_ = R_ - 4 If R_ > R_h Then Decr R_ Else R_ = R_h 'originale Zeile bei linearem Dimmen If G_ > 200 Then G_ = G_ - 10 If G_ < 200 And G_ > 120 Then G_ = G_ - 7 If G_ < 120 And G_ > 50 Then G_ = G_ - 4 If G_ > G_h Then Decr G_ Else G_ = G_h If B_ > 200 Then B_ = B_ - 10 If B_ < 200 And B_ > 120 Then B_ = B_ - 7 If B_ < 120 And B_ > 50 Then B_ = B_ - 4 If B_ > B_h Then Decr B_ Else B_ = B_h ') R_ = Fade_out(r_ , R_h) 'rot G_ = Fade_out(g_ , G_h) 'grün B_ = Fade_out(b_ , B_h) 'blau Next Y Rb_setcolor N , Farbe_() Next N Rb_send Next A 'Lauflicht bewegen Rb_selectchannel B If Stripe_change_counter = Num_leds_2 Then ' falls ein Stripwechsel ansteht, erste LED (0) auf dem neuen Strip setzen und Berechnung der neuen Position EINMAL überspringen Rb_setcolor Position , Farbe() Rb_send Stripe_change_counter = 0 Goto Stripe_change End If If Direction = 0 And Position < Num_leds_1 Then 'bis zur vorletzten LED... Position = Position + 1 'wird die Position um eins erhöht... Rb_setcolor Position , Farbe() 'und LED gesetzt Rb_send End If If Direction = 1 And Position > 0 Then Position = Position - 1 Rb_setcolor Position , Farbe() Rb_send End If If Position = Num_leds_1 Then 'ist die letzte LED erreicht... Direction = 1 'wird die Richtung für den nächsten Durchgang geändert... Rb_setcolor Position , Farbe() 'und die letzte LED gesetzt Rb_send End If If Position = 0 Then Direction = 0 Rb_setcolor Position , Farbe() Rb_send If B = 0 Then 'Stripe wechseln B = 1 Else B = 0 End If End If Incr Stripe_change_counter Stripe_change: 'Waitms 1 ' Lauflichtgeschwindigkeit einstellen '=========================== RC Abfrage ========================= Incr Rc_frequency If Rc_frequency > 25 Then Gosub Rc_abfrage '15 Wert abhängig von der Durchlaufzeit des jeweiligen Effekts '================================================================ Loop Until Effect <> Effect_old 'solange wiederholen bis ein neuer Effekt gewünscht wird Effect_old = Effect Loading = 0 Return 'und wieder zur Abfrage springen '########################### Bayern Farben ################################### Bayern: Do If Loading = 0 Then 'Farben berechnen und Strip laden For X = 0 To 1 Rb_selectchannel X ' Strip auswählen Rot = 0 ' Blaue Farbe einstellen Gruen = 0 Blau = 255 For N = 0 To 7 Rb_setcolor N , Farbe() ' Farbe in den Farbspeicher schreiben Next N For N = 15 To 22 Rb_setcolor N , Farbe() Next N Rot = 200 ' Weiße Farbe einstellen Gruen = 200 Blau = 200 For N = 8 To 14 Rb_setcolor N , Farbe() ' Farbe in den Farbspeicher schreiben Next N For N = 23 To 29 Rb_setcolor N , Farbe() Next N Rb_send Next X Loading = 1 End If Incr Speed If Speed > 7 Then Rb_selectchannel 0 'Farben rotieren von Stripende zum Stripanfang Rb_rotateleft 0 , 30 Rb_send Rb_selectchannel 1 Rb_rotateleft 0 , 30 Rb_send Speed = 0 End If '=========================== RC Abfrage ========================= Gosub Rc_abfrage '================================================================ Loop Until Effect <> Effect_old 'solange wiederholen bis ein neuer Effekt gewünscht wird Effect_old = Effect Loading = 0 Return 'und wieder zur Abfrage springen '########################### Police Strobe ################################### Police: Do If Prog_counter < 7 Then 'Blitzdauer hier einstellen For A = 0 To 1 'Beide Strips bearbeiten Rb_selectchannel A If A = 0 Then 'ein Strip rot, den anderen blau Rot = 255 Gruen = 0 Blau = 0 Else Rot = 0 Gruen = 0 Blau = 255 End If If C <= 1 Then 'Die ersten Balken 2x aufblitzen lassen, dann.... For N = 0 To 6 Rb_setcolor N , Farbe() Next N For N = 15 To 22 Rb_setcolor N , Farbe() Next N Else '...die nächsten Balken 2x aufblitzen lassen For N = 7 To 14 Rb_setcolor N , Farbe() Next N For N = 23 To 29 Rb_setcolor N , Farbe() Next N End If Rb_send Next A Else For A = 0 To 1 'Beide Strips bearbeiten Rb_selectchannel A Rb_clearcolors If A = 0 Then 'Hintergrundfarben einstellen Rot = 10 'für Strip 0 Gruen = 10 Blau = 10 Else Rot = 10 'für Strip 1 Gruen = 10 Blau = 10 End If Rb_fillcolors Farbe() Rb_send Next A End If Incr Prog_counter If Prog_counter > 9 Then 'Pausendauer hier einstellen (Blitzdauerwert + x) Prog_counter = 0 Incr C 'Blitzzähler If C >= 4 Then C = 0 End If '=========================== RC Abfrage ========================= Gosub Rc_abfrage '================================================================ Loop Until Effect <> Effect_old 'solange wiederholen bis ein neuer Effekt gewünscht wird Effect_old = Effect Loading = 0 Return 'und wieder zur Abfrage springen '############################### Tropfen ##################################### Tropfen: Do If Loading = 0 Then 'Hintergrundfarbe setzen R_h = 0 G_h = 0 B_h = 0 'Sollfarbe setzen Rot = 255 Gruen = 0 Blau = 255 Position = 0 Position_1 = 15 Loading = 1 End If For X = 0 To 1 Rb_selectchannel X 'Runterdimmen auf Hintergrundfarbe For N = 0 To Num_leds_1 Farbe_(1) = Rb_getcolor(n) R_ = Fade_out(r_ , R_h) 'rot G_ = Fade_out(g_ , G_h) 'grün B_ = Fade_out(b_ , B_h) 'blau Rb_setcolor N , Farbe_() Next N 'Hochdimmen auf Sollfarbe Farbe_(1) = Rb_getcolor(position) For N = 1 To Stufen If R_ < Rot Then Incr R_ Else Zielfarbe_erreicht.0 = 1 If G_ < Gruen Then Incr G_ Else Zielfarbe_erreicht.1 = 1 If B_ < Blau Then Incr B_ Else Zielfarbe_erreicht.2 = 1 Next N Rb_setcolor Position , Farbe_() Rb_setcolor Position_1 , Farbe_() If Zielfarbe_erreicht = 7 Then Zielfarbe_erreicht = 0 Incr Position Incr Position_1 If Position > Num_leds_1 Then Position = 0 If Position_1 > Num_leds_1 Then Position_1 = 0 End If Rb_send ' Waitms 5 Next X '=========================== RC Abfrage ========================= Incr Rc_frequency If Rc_frequency > 3 Then Gosub Rc_abfrage '1 Wert abhängig von der Durchlaufzeit des jeweiligen Effekts '================================================================ Loop Until Effect <> Effect_old 'solange wiederholen bis ein neuer Effekt gewünscht wird Effect_old = Effect Loading = 0 Return 'und wieder zur Abfrage springen '########################## Feuerkugelwerfer ################################# Feuerkugelwerfer: Do If Loading = 0 Then 'Hintergrundfarbe setzen R_h = 0 G_h = 0 B_h = 0 'Sollfarbe setzen Rot = 255 Gruen = 130 Blau = 50 Position = 0 Position_1 = 14 Loading = 1 End If For X = 0 To 1 Rb_selectchannel X 'Runterdimmen auf Hintergrundfarbe For N = 0 To Num_leds_1 Farbe_(1) = Rb_getcolor(n) If R_ >= 2 Then ' Runterdimmen beschleunigen, um höhere Lauflichtgeschwindigkeit erreichen zu können If R_ > R_h Then R_ = R_ -2 Else R_ = R_h End If If G_ >= 2 Then If G_ > G_h Then G_ = G_ -2 Else G_ = G_h End If If B_ >= 2 Then If B_ > B_h Then B_ = B_ -2 Else B_ = B_h End If Rb_setcolor N , Farbe_() Next N 'Hochdimmen auf Sollfarbe If X = 0 Then Farbe_(1) = Rb_getcolor(position) Else Farbe_(1) = Rb_getcolor(position_1) End If For N = 1 To 50 If R_ < Rot Then Incr R_ Else Zielfarbe_erreicht.0 = 1 If G_ < Gruen Then Incr G_ Else Zielfarbe_erreicht.1 = 1 If B_ < Blau Then Incr B_ Else Zielfarbe_erreicht.2 = 1 Next N If X = 0 Then Rb_setcolor Position , Farbe_() Else Rb_setcolor Position_1 , Farbe_() End If If Zielfarbe_erreicht = 7 Then Zielfarbe_erreicht = 0 Incr Position Incr Position_1 If Position > Num_leds_1 Then Position = 0 If Position_1 > Num_leds_1 Then Position_1 = 0 End If Rb_send Waitms 1 Next X '=========================== RC Abfrage ========================= Incr Rc_frequency If Rc_frequency > 30 Then Gosub Rc_abfrage '30 Wert abhängig von der Durchlaufzeit des jeweiligen Effekts '================================================================ Loop Until Effect <> Effect_old 'solange wiederholen bis ein neuer Effekt gewünscht wird Effect_old = Effect Loading = 0 Return 'und wieder zur Abfrage springen '############################ Rainbow Cycle ################################## Rainbow_cycle: Do If Loading = 0 Then Position = 0 Loading = 1 End If For A = 0 To 1 'Beide Strips bearbeiten Rb_selectchannel A For N = 0 To Num_leds_1 Select Case Position Case 0 To 255 Rot = Position '0-255 Gruen = 255 - Position '255-0 Blau = 0 Case 256 To 511 Position_1 = Position - 256 '0-255 Rot = 255 - Position_1 '255-0 Gruen = 0 Blau = Position_1 '0-255 Case 512 To 767 Position_1 = Position - 512 '0-255 Rot = 0 Gruen = Position_1 '0-255 Blau = 255 - Gruen '255-0 End Select Rb_setcolor N , Farbe() Position = Position + Alignment 'Farbspektrum für die nächste LED verschieben If Position > 767 Then Position = Position - 768 End If Next N Position = Position - 16 'hier Richtung und Geschwindigkeit einstellen (-12 = Stillstand) Rb_send Next A 'Waitms 20 '=========================== RC Abfrage ========================= Gosub Rc_abfrage '================================================================ Loop Until Effect <> Effect_old 'solange wiederholen bis ein neuer Effekt gewünscht wird Effect_old = Effect Loading = 0 Return 'und wieder zur Abfrage springen End '############################ Programmende ################################### Rc_abfrage: Pulsein Impulslaenge_1 , Pinb , 4 , 1 'Werte zwischen 100 (1ms) und 200 (2ms) If Impulslaenge_1 > Rc_schwellwert_4 Then 'einen Effekt weiter schalten If Up_down = 0 Then Incr Effect End If Up_down = 1 End If If Impulslaenge_1 < Rc_schwellwert_1 Then 'einen Effekt zurück schalten If Up_down = 0 Then Decr Effect End If Up_down = 1 End If If Impulslaenge_1 > Rc_schwellwert_2 And Impulslaenge_1 < Rc_schwellwert_3 Then 'Nähe Mittelstellung Up_down = 0 End If Rc_frequency = 0 Return Function Fade_out(byval F As Byte , Byval H_farbe As Byte)as Byte Select Case F Case 50 To 120 : F = F - 4 Case 120 To 200 : F = F - 7 Case Is > 200 : F = F - 10 End Select If F > H_farbe Then Decr F Else F = H_farbe End If Fade_out = F End Function 'Original (Farbwert 6 einstellen) Farben: Data 0 , 0 , 0 Data 8 , 2 , 0 Data 16 , 3 , 0 Data 32 , 4 , 0 Data 40 , 5 , 0 Data 44 , 6 , 0 Data 50 , 7 , 0 Data 64 , 8 , 0 Data 70 , 9 , 0 Data 80 , 10 , 0 Data 100 , 11 , 0 Data 128 , 18 , 0 Data 160 , 29 , 0 Data 200 , 33 , 0 Data 230 , 41 , 0 Data 250 , 44 , 0 Data 255 , 51 , 0 'ff3300 Data 255 , 56 , 0 'ff3800 Data 255 , 69 , 0 'ff4500 Data 255 , 71 , 0 'ff4700 Data 255 , 82 , 0 'ff5200 Data 255 , 83 , 0 'ff5300 Data 255 , 93 , 0 'ff5d00 Data 255 , 93 , 0 'ff5d00 Data 255 , 102 , 0 'ff6600 Data 255 , 101 , 0 'ff6500 Data 255 , 111 , 0 'ff6f00 Data 255 , 109 , 0 'ff6d00 Data 255 , 118 , 0 'ff7600 Data 255 , 115 , 0 'ff7300 Data 255 , 124 , 0 'ff7c00 Data 255 , 121 , 0 'ff7900 Data 255 , 130 , 0 'ff8200 Data 255 , 126 , 0 'ff7e00 Data 255 , 135 , 0 'ff8700 Data 255 , 131 , 0 'ff8300 Data 255 , 141 , 11 'ff8d0b Data 255 , 137 , 18 'ff8912 Data 255 , 146 , 29 'ff921d Data 255 , 142 , 33 'ff8e21 Data 255 , 152 , 41 'ff9829 Data 255 , 147 , 44 'ff932c Data 255 , 157 , 51 'ff9d33 Data 255 , 152 , 54 'ff9836 Data 255 , 162 , 60 'ffa23c Data 255 , 157 , 63 'ff9d3f Data 255 , 166 , 69 'ffa645 Data 255 , 161 , 72 'ffa148 Data 255 , 170 , 77 'ffaa4d Data 255 , 165 , 79 'ffa54f Data 255 , 174 , 84 'ffae54 Data 255 , 169 , 87 'ffa957 Data 255 , 178 , 91 'ffb25b Data 255 , 173 , 94 'ffad5e Data 255 , 182 , 98 'ffb662 Data 255 , 177 , 101 'ffb165