Code:
'=============================================
' PS/2 - Tastatur abfrage
'=============================================
$regfile = "m8def.dat"
$crystal = 8000000
'$baud = 9600
Config Portd = Output
Config Keyboard = Pinb.0 , Data = Pinb.1 , Keydata = Keydata
Dim Cursorposx As Byte
Dim Cursorposy As Byte
Dim Key As Byte
Dim S As String * 16 At $400 'Beide Variablen, String und Byte() liegen
Dim B(16) As Byte At $400 Overlay 'an der gleichen Stelle im Speicher
'===== Command ===========================================
Dim Text as String * 16
'====== Timer =============================================
Dim Seconds As Integer
Dim Hours As Integer
Dim Minutes As Integer
'==========================================================
$serialinput = Kbdinput
Declare Sub TimerT
Declare Sub Write_nible(byval D As Byte) 'ein Nible (D4-D7) schreiben
Declare Sub Lcd_write_data(byval D As Byte) 'ins Datenregister schreiben
Declare Sub Lcd_write_string 'String S ausgeben
Initlcd
Cls
Cursor On Blink
Lowerline
S = "Tastatur + Timer"
Call Lcd_write_string
Home
Cursorposx = 1
Cursorposy = 1
Text = ""
Do
Key = Getatkbd()
If Key <> 0 Then
If Key = 8 Then
Shiftcursor Left
S = " "
Call Lcd_write_string
Cursorposx = Cursorposx - 1
End If
If Key = 52 Then
Cursorposx = Cursorposx - 1
End If
If Key = 54 Then
Cursorposx = Cursorposx + 1
End If
If Key = 44 Then
S = " "
Call Lcd_write_string
Shiftcursor Left
End If
If Key = 56 Then
Cursorposy = 1
End If
If Key = 50 Then
Cursorposy = 2
End If
If Key <> 54 And Key <> 8 And Key <> 0 And Key <> 52 And Key <> 56 And Key <> 50 Then
Cursorposx = Cursorposx + 1
S = Chr(key)
Call Lcd_write_string
Text = Text + Chr(key)
End If
If Key = 13 Then
s = LCase(Text)
If Left(s , 5) = "timer" then TimerT
Text = ""
Cls
Home
Cursorposx = 1
Cursorposy = 1
End If
If Cursorposx < 1 And Cursorposy = 2 Then
Cursorposx = 16
Cursorposy = 1
End If
If Cursorposx < 1 And Cursorposy = 1 Then Cursorposx = 1
If Cursorposx > 16 And Cursorposy = 1 Then
Cursorposx = 1
Cursorposy = 2
End If
If Cursorposx > 16 And Cursorposy = 2 Then Cursorposx = 16
Locate Cursorposy , Cursorposx
End If
Loop
End
'==========================================================
'==========================================================
Sub TimerT
Deflcdchar 1 , 32 , 10 , 32 , 4 , 32 , 17 , 14 , 32 'little Smily
Deflcdchar 2 , 32 , 12 , 12 , 32 , 32 , 1 , 1 , 32 'big Smily ol
Deflcdchar 3 , 32 , 6 , 6 , 32 , 32 , 16 , 16 , 32 'big Smily or
Deflcdchar 4 , 32 , 24 , 28 , 15 , 3 , 32 , 32 , 32 'big Smily ul
Deflcdchar 5 , 32 , 3 , 7 , 30 , 24 , 32 , 32 , 32 'big Smily ur
Cls
Seconds = 0
Minutes = 0
Hours = 0
'Config Portb.1 = Output
'Config Portb.0 = Input
Cls
Lowerline
S = "By Bjoern " + Chr(1) + " " + Chr(4) + Chr(5)
Call Lcd_write_string
Do
Cursor Off
Waitms 110
Incr Seconds
If Seconds = 60 Then
Incr Minutes
Seconds = 0
End If
If Minutes = 60 Then
Incr Hours
Minutes = 0
End If
Home
Upperline
If Hours < 10 Then
S = "0" + Str(hours)
Else
S = " " + Str(hours)
End If
If Minutes < 10 Then
S = S + ":0" + Str(minutes)
Else
S = S + ":" + Str(minutes)
End If
If Seconds < 10 Then
S = S + ":0" + Str(seconds) + " Uhr " + Chr(2) + Chr(3)
Else
S = S + ":" + Str(seconds) + " Uhr " + Chr(2) + Chr(3)
End If
Call Lcd_write_string
Home
Portb.0 = 1
If Pinb.1 = 0 Then
Hours = -1
end IF
Loop until Hours = -1
End SUB
'==========================================================
'==========================================================
'==========================================================
Sub Write_nible(byval D As Byte)
If D.4 = 1 Then Portd.0 = 1 Else Portd.0 = 0
If D.5 = 1 Then Portd.1 = 1 Else Portd.1 = 0
If D.6 = 1 Then Portd.2 = 1 Else Portd.2 = 0
If D.7 = 1 Then Portd.3 = 1 Else Portd.3 = 0
Portd.5 = 1
Waitus 5
Portd.5 = 0
End Sub
'==========================================================
Sub Lcd_write_data(byval D As Byte)
Portd.4 = 1
Call Write_nible(d)
Waitus 50
D = D * 16
Call Write_nible(d)
Waitus 50
End Sub
'==========================================================
Sub Lcd_write_string
Dim Istring As Byte
For Istring = 1 To Len(s)
Call Lcd_write_data(b(istring))
Next Istring
End Sub
'==========================================================
'==========================================================
'==========================================================
Kbdinput:
'we come here when input is required from the COM port
'So we pass the key into R24 with the GetATkbd function
' We need some ASM code to save the registers used by the function
$asm
push r16 ; save used register
push r25
push r26
push r27
Kbdinput1:
rCall _getatkbd ; call the function
tst r24 ; check for zero
breq Kbdinput1 ; yes so try again
pop r27 ; we got a valid key so restore registers
pop r26
pop r25
pop r16
$end Asm
'just return
Return
'The tricky part is that you MUST include a normal call to the routine
'otherwise you get an error
'This is no clean solution and will be changed
Key = Getatkbd()
Keydata:
'normal keys lower case
Data 0 , 0 , 0 , 0 , 0 , 200 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , &H5E , 0
Data 0 , 0 , 0 , 0 , 0 , 113 , 49 , 0 , 0 , 0 , 122 , 115 , 97 , 119 , 50 , 0
Data 0 , 99 , 120 , 100 , 101 , 52 , 51 , 0 , 0 , 32 , 118 , 102 , 116 , 114 , 53 , 0
Data 0 , 110 , 98 , 104 , 103 , 121 , 54 , 7 , 8 , 44 , 109 , 106 , 117 , 55 , 56 , 0
Data 0 , 44 , 107 , 105 , 111 , 48 , 57 , 0 , 0 , 46 , 45 , 108 , 48 , 112 , 43 , 0
Data 0 , 0 , 0 , 0 , 0 , 92 , 0 , 0 , 0 , 0 , 13 , 0 , 0 , 92 , 0 , 0
Data 0 , 60 , 0 , 0 , 0 , 0 , 8 , 0 , 0 , 49 , 0 , 52 , 55 , 0 , 0 , 0
Data 48 , 44 , 50 , 53 , 54 , 56 , 0 , 0 , 0 , 43 , 51 , 45 , 42 , 57 , 0 , 0
'shifted keys UPPER case
Data 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0
Data 0 , 0 , 0 , 0 , 0 , 81 , 33 , 0 , 0 , 0 , 90 , 83 , 65 , 87 , 34 , 0
Data 0 , 67 , 88 , 68 , 69 , 0 , 35 , 0 , 0 , 32 , 86 , 70 , 84 , 82 , 37 , 0
Data 0 , 78 , 66 , 72 , 71 , 89 , 38 , 0 , 0 , 76 , 77 , 74 , 85 , 47 , 40 , 0
Data 0 , 59 , 75 , 73 , 79 , 61 , 41 , 0 , 0 , 58 , 95 , 76 , 48 , 80 , 63 , 0
Data 0 , 0 , 0 , 0 , 0 , 96 , 0 , 0 , 0 , 0 , 13 , 94 , 0 , 42 , 0 , 0
Data 0 , 62 , 0 , 0 , 0 , 8 , 0 , 0 , 49 , 0 , 52 , 55 , 0 , 0 , 0 , 0
Data 48 , 44 , 50 , 53 , 54 , 56 , 0 , 0 , 0 , 43 , 51 , 45 , 42 , 57 , 0 , 0
Mit diesem einfachen Programm kann ich 
Zitieren
Lesezeichen