'********************************************************************
'* Relay controller
'* Language:    BASCOM-AVR 1.11.9.1
'* Date:        2008.Oct.22
'* Version:     V1.00
'********************************************************************
 
$regfile = "2313def.dat"
$crystal = 8000000
 
$baud = 9600
 
Declare Sub Avr_os()
Declare Sub Initialize()
Declare Sub Printprompt()
Declare Sub Docommand()
Declare Sub Getinput(byval Pbbyte As Byte)
Declare Sub Status()
Declare Sub Poweron(byval Relay As Byte)
Declare Sub Poweroff(byval Relay As Byte)
Declare Sub Lcddisplay(pos As Byte)
 
' If you change this number you must setup the PORT mappings
' in the initalize section.
Const Relays = 4
 
Const Cpcinput_len = 30                                     ' max. length of user-Input
 
Dim Rport(relays) As Byte
Dim Gbinp As Byte                                           ' holds user input
Dim Gspcinput As String * Cpcinput_len                      ' holds user-input
Dim Gspcinp(cpcinput_len) As Byte At Gspcinput Overlay
Dim Gbpcinputpointer As Byte                                ' string-pointer during user-input
Dim Command As String * 5
 
Dim P1 As Byte , P2 As Byte
Dim I As Byte
Dim J As Byte
 
Config Portb = Output
Open "Com1:" As Binary As #1
' Serial communication to LCD is via port b.6
Open "Comb.6:9600,8,n,1" For Output As #2
 
Enable Interrupts
 
'LCD reset
Reset Portb.5
Waitms 400
Set Portb.5
Waitms 400
 
Initialize
Avr_os
End
 
 
Sub Initialize
  ' Setup Port to relay mapping
  Rport(1) = 2 : Rport(2) = 3 : Rport(3) = 4 : Rport(4) = 7
  ' Set all Relays OFF
  For I = 1 To Relays
    Set Portb.rport(i)
  Next I
End Sub
 
 
Sub Avr_os
  Print #1 , ""
  Print #1 , "Ready"
  Print #2 , "Ready"
  Printprompt
  Do
    Gbinp = Inkey(#1)                                       ' get user input
    If Gbinp <> 0 Then                                      ' something typed in?
      Getinput Gbinp                                        ' give input to interpreter
    End If
  Loop                                                      ' do forever
End Sub
 
Sub Printprompt
  Gbpcinputpointer = 1
  Gspcinput = ""
  Print #1 , ">";
End Sub
 
 
Sub Getinput(pbbyte As Byte)
   ' stores bytes from user and wait for CR (&H13)
   Select Case Pbbyte
      Case &H0A                                             ' do nothing
      Case &H0D                                             ' Line-end?
         Print #1 , Chr(&H0d) ; Chr(&H0a) ;
         Docommand                                          ' analyse command and execute
         Printprompt
      Case &H08                                             ' backspace ?
         If Gbpcinputpointer > 1 Then
            Print #1 , Chr(&H08);
            Decr Gbpcinputpointer
         End If
      Case Else                                             ' store user-input
         If Gbpcinputpointer <= Cpcinput_len Then
            Mid(gspcinput , Gbpcinputpointer , 1) = Pbbyte
            Incr Gbpcinputpointer
            Mid(gspcinput , Gbpcinputpointer , 1) = &H00    ' string-terminator
            Print #1 , Chr(pbbyte);                         ' echo back to user
         End If
   End Select
End Sub
 
Sub Docommand
      Gspcinput = Ucase(gspcinput)
 
      Select Case Gspcinput
         Case "STATUS" : Status
         Case Else
            I = Instr(gspcinput , " ")
            Decr I
            Command = Mid(gspcinput , 1 , I)
            I = I + 2
            J = Gspcinp(i) - 48
 
             ' test first word
             Select Case Command
                Case "ON" : Poweron J
                Case "OFF" : Poweroff J
                Case "LCD" : Lcddisplay I
                Case Else
                  Print #1 , "Command '" ; Gspcinput ; "' not recognized"
             End Select
      End Select
 
End Sub
 
'*****************************************************************************
 
Sub Lcddisplay(pos As Byte)
  Print #2 , Mid(gspcinput , Pos)
End Sub
 
Sub Poweron(relay As Byte)
  If Relay <= Relays Then
    Reset Portb.rport(relay)
  End If
End Sub
 
Sub Poweroff(relay As Byte)
  If Relay <= Relays Then
     Set Portb.rport(relay)
  End If
End Sub
 
Sub Status
  For I = 1 To Relays
    Print #1 , "relay." ; I ; "=";
    If Portb.rport(i) = 1 Then
       Print "off"
    Else
       Print "on"
    End If
  Next I
End Sub