Die QuadratuHr

































Download: QuadratUhr.bas

'-----------------------------------------------------------------------------------------
'Titel : QuadratUhr
'Name : QuadratUhr.bas
'Autor : Arno Schweißinger
'Datum : 18.05.2009
'MicroContorller : AtMega8 1MHz
'Hardware : 16 Duo-LEDs rot/grün
' Quarz 32768Hz an Pin TOSC1/2
' 4x 74HC374
'Stromversorgung: : 5V für Logik,
'Besonderes : RC5-IR zum Zeitstellen
'
'PB.0=1 PA=MMMmmmms rot
'PB.1=1 PA=MMMMMMMM rot
'PB.2=1 PA=SSSSssss grün
'PB.3=1 PA=SSSSssss grün
'
'
'
'
'
'
'
'
'
'
'
'
'
'-----------------------------------------------------------------------------------------

$regfile = "m8def.dat"
$crystal = 1000000
$lib "mcsbyte.lbx" 'use byte library for smaller code

Config Portc = Output
Config Portd = Output
'Config Lcdpin = Pin , Db4 = Portc.0 , Db5 = Portc.1 , Db6 = Portc.2 , Db7 = Portc.3 , E = Portc.5 , Rs = Portc.4
'Config Lcd = 24 * 2
Config Rc5 = Pinb.1 ', Timer = 1
Config Date = Dmy , Separator = . ' ANSI-Format
Config Clock = Soft 'this is how simple it is

Enable Interrupts

Declare Sub Zeitstellen
Declare Sub Getziffer
Declare Sub Stundensignal
Declare Sub Set_led
Declare Sub Led_updat
Declare Sub Led_lauflicht
Declare Sub Led_minuten_aus
Declare Sub Led_stunden_aus
Declare Sub Init
Declare Sub Alleledaus
Declare Sub Bestaetigung

Soundpin Alias Pinb.0

Dim Zeile(4) As Byte
Dim I As Byte
Dim J As Byte ' Zählschleifen
Dim Led_sec As Byte , Led_min As Byte , Led_hour As Byte
Dim Temp As Byte
Dim Port As Byte , Led As Byte
Dim Address As Byte , Command As Byte 'reserve space for variables
Dim S As String * 1 ' Empfangscode RC5
Dim Zeit As String * 8 ' temp für Time$
Dim Togglebit As Bit
Dim Togglealt As Bit


'-------------------------
' Hauptprogramm
'-------------------------
'Begin
Sound Soundpin , 30 , 10 ' Bereitschaftston
Call Alleledaus
Call Init
Call Alleledaus
Call Zeitstellen

Do
Waitms 100 ' Warteschleife
Led_sec = _sec : Led_min = _min : Led_hour = _hour
Call Stundensignal
Call Led_updat
Loop
End ' ende Hauptprogramm

Sub Led_updat
Reset Zeile(1) ' alle Register löschen
Reset Zeile(2)
Reset Zeile(3)
Reset Zeile(4)

If Led_sec.0 = 0 Then Reset Portc.5 ' Sekunden blinken
If _sec.1 = 1 Then Set Portc.5

If Led_hour > 12 Then Led_hour = Led_hour - 12 ' 12 Stundenanzeige
Select Case Led_hour
Case 0 : Set Zeile(1).0
Case 1 : Set Zeile(2).6
Case 2 : Set Zeile(3).0
Case 3 : Set Zeile(4).6
Case 4 : Set Zeile(4).4
Case 5 : Set Zeile(4).2
Case 6 : Set Zeile(4).0
Case 7 : Set Zeile(3).6
Case 8 : Set Zeile(2).0
Case 9 : Set Zeile(1).6
Case 10 : Set Zeile(1).4
Case 11 : Set Zeile(1).2
End Select

Select Case Led_min
Case 1 To 4 : Set Zeile(1).1
Case 5 To 9 : Set Zeile(2).7
Case 10 To 14 : Set Zeile(3).1
Case 15 To 19 : Set Zeile(4).7
Case 20 To 24 : Set Zeile(4).5
Case 25 To 29 : Set Zeile(4).3
Case 30 To 34 : Set Zeile(4).1
Case 35 To 39 : Set Zeile(3).7
Case 40 To 44 : Set Zeile(2).1
Case 45 To 49 : Set Zeile(1).7
Case 50 To 54 : Set Zeile(1).5
Case 55 To 59 : Set Zeile(1).3
End Select

While Led_min > 5 '5er Minutenblock
Led_min = Led_min - 5
Wend

Select Case Led_min ' Minuten 0 bis 4
Case 1 : Set Zeile(2).5
Case 2 : Set Zeile(3).3
Case 3 : Set Zeile(3).5
Case 4 : Set Zeile(2).3
End Select

' Port Ausgabe
Portd = Zeile(1)
Set Portc.0
Waitus 10
Reset Portc.0

Portd = Zeile(2)
Set Portc.1
Waitus 10
Reset Portc.1

Portd = Zeile(3)
Set Portc.2
Waitus 10
Reset Portc.2

Portd = Zeile(4)
Set Portc.3
Waitus 10
Reset Portc.3

End Sub

Sub Alleledaus
Portd = &B00000000 ' alle 8 LEDS aus
Portc = &B00001111 ' out: 1-4 select ic
Waitus 10
Portc = &B00000000 ' out: 1-4 select ic
End Sub

Sub Init ' Lauflicht
Portd = &B00000001
For J = 0 To 3
For I = 1 To 8
Set Portc.j
Waitus 10
Reset Portc.j
Rotate Portd , Left
Waitms 50
Next I
Next J

Portd = &B01010101 ' Alle Leds rot
Portc = &B00001111
Waitus 10
Portc = 0
Waitms 500

Portd = &B10101010 ' Alle Leds grün
Portc = &B00001111
Waitus 10
Portc = 0
Waitms 500
End Sub


Sub Stundensignal
If _sec = 0 Then
If _min = 0 Then
Sound Soundpin , 20 , 40
Sound Soundpin , 40 , 40
Waitms 500
End If
End If
End Sub

Sub Zeitstellen
Led_sec = 1
For I = 0 To 05 Step 5
Led_min = I
Call Led_updat
Getrc5(address , Command)
If Command <> 0 Then Exit For ' Timeout
Next I

If Command = 0 Then Exit Sub ' Eingabe Stunden Minuten
Zeit = ""
For I = 1 To 4
Togglealt = Togglebit
While Togglealt = Togglebit
Gosub Getziffer
Wend
Sound Soundpin , 10 , 40 ' Bereitschaftston
Led_hour = Val(s)
Call Led_updat
Zeit = Zeit + S
If I = 2 Then Zeit = Zeit + ":"
Next I
Zeit = Zeit + ":00"
Time$ = Zeit
End Sub

Sub Getziffer
Do
Getrc5(address , Command)
If Address <> 255 Then
If Command > 127 Then ' bx0000000 (Bit 7)
Togglebit = 1 ' Togglebit merken
Else
Togglebit = 0
End If
Command = Command And &B00111111 ' clear the toggle bit
S = Lookupstr(command , Asciidaten )
End If

Temp = Asc(s)
If Temp > &H2F Then
If Temp < &H3A Then Exit Do
End If
Loop
End Sub






'------------------------------------- Decodieren der Tastatur -----------------
Asciidaten:
Data "1" , "2" , "9" , "4" , "0" , "p" , "<" , "5" , "8" , "o"
Data "v" , "r" , "L" , "b" , "ä" , "k" , "7" , "ü" , "l" , "S"
Data "E" , "y" , "#" , "j" , "4" , "i" , "3" , "u" , "m" , "x"
Data "O" , "f" , "6" , "2" , "z" , "n" , "L" , "1" , "d" , "g"
Data "5" , "t" , "q" , "w" , "e" , "3" , "s" , "a" , "?" , " "
Data "?" , "h" , "R" , "c" , "U" , "ö" , "?" , "?" , "?" , "?"
Data "?" , "?" , "?" , "R"
Data "" , "" , "" , "" , "" , "" , "" , "" , "" , ""