NIBOBee mit BASCOM Programmieren

Hallo pinsel,

einen kleinen Teilerfolg kann ich vermelden. Das DOGM Display braucht eine spezielle Initialisierung. Das habe ich mal ausprobiert und es funktioniert sogar. Allerdings taucht dann das nächste Problem auf. Die Cursor Positionierung stimmt nicht ganz. Das liegt ebenfalls am DOGM163, bzw. wie die Zeichen im Display RAM abgelegt werden. Und ich habe keine Ahnung wie man das ändern kann, sorry.

Die beigefügte lib muß gegen die vorhandene lcd_i2c.lib ausgetauscht werden.

Hi m.a.r.v.i.n,

danke für die Anpassung der Datei.

Ich habe die Lib ausgetauscht, das oben von mir angegebene Programm neu kompiliert und geflasht. Bei mir zeigt das Display in der 3. Zeile nichts an, Zeile 1 und 2 werden richtig positioniert - ist das bei dir auch so?

EDIT: Ich habe einen Weg gefunden, wie die 3. Zeile auch verwendet wird mit

Code:

---

$regfile = "m16def.dat"
$crystal = 15000000
$baud = 9600

$lib "Lcd_i2c.lib"                                          'I2c driver for the LCD
Config I2cdelay = 1
Const Pcf8574_lcd = &H4E                                    'Defines the address of the I/O expander for LCD
Config Scl = Portc.0                                        'Configure i2c SCL
Config Sda = Portc.1                                        'Configure i2c SDA

Dim _lcd_e As Byte                                          'Needed to control 4 line LCD
Enable Interrupts

Config Lcd = 16 * 3                                        'configure lcd screen

I2cstart

_lcd_e = 128                                                'Upper half of 4-line display is selected
Cls                                                        'clear the LCD display
Lcd "ABCDEFGHIJKLMNOP"                                      'display this at the top line
Waitms 1
Lowerline                                                  'select the lower line
Lcd "QRSTUVWXYZ1234567890abcdefghijk"
Waitms 1                                                    'display this at the lower line
_lcd_e = 64                                                'Lower half of 4-line display is selected
Lcd "nix"
Waitms 1
Lowerline
Lcd "nix"

---

Probier es mal aus.

Hallo pinsel,

ja verhält sich bei mir genauso.
Hier habe ich noch etwas interessantes entdeckt:
http://avrhelp.mcselec.com/index.html?config_lcd.htm

vielleicht hilft das ja:

Code:

---

Config Lcd = 16 * 3 , Chipset = Dogm163v5    '16*3 type LCD display 5V

---

Hallo

Bascom ist zwar etwas "sperriger" als C, aber grundsätzlich nicht schlechter ;) Mein "Grundgerüst" beherrscht nun die Tasten, die Leds, Motor-PWM, Liniensensoren und Odometry:

Code:

---

' nibobee mit Bascom                                                11.12.09 mic

$regfile = "m16def.dat"
$crystal = 15000000
$hwstack = 32
$swstack = 8
$framesize = 24

$baud = 19200

Led0 Alias Portb.0
Led1 Alias Portb.1
Led2 Alias Portb.2
Led3 Alias Portb.3
Lineled Alias Portb.4

Config Led0 = Output                                        ' LEDs 0-3
Config Led1 = Output
Config Led2 = Output
Config Led3 = Output
Config Lineled = Output                                    ' Lineled

Config Portc.4 = Input                                      ' keys
Config Portc.5 = Input
Config Portc.6 = Input
Config Portc.7 = Input

Config Portd.2 = Input                                      ' odo_l int0
Config Portd.3 = Input                                      ' odo_r int1
Config Portd.4 = Output                                    ' pmw_r
Config Portd.5 = Output                                    ' pwm_l
Config Portd.6 = Output                                    ' dir_l
Config Portd.7 = Output                                    ' dir_r

'Config Com1 = Dummy , Synchrone = 0 , Parity = None , Stopbits = 1 , Databits = 8 , Clockpol = 0
Config Timer1 = Pwm , Pwm = 10 , Compare A Pwm = Clear Up , Compare B Pwm = Clear Up , Prescale = 1
Config Adc = Single , Prescaler = 64 , Reference = Avcc    ' 235 kHz
Config Int0 = Change
Config Int1 = Change

Declare Sub Motorpwm(byval Pwm_l As Byte , Byval Pwm_r As Byte)
Declare Sub Motordir(byval Dir_l As Byte , Byval Dir_r As Byte)
Declare Sub Setleds(byval Leds As Byte)
Declare Function Getkeys() As Byte

Dim B As Byte , W As Word
Dim Odo_count_l As Word , Odo_count_r As Word

Start Adc
On Int0 Isr_int0
On Int1 Isr_int1
Enable Int0
Enable Int1
Enable Interrupts

Portc = &B11110000                                          'Tasten-PullUp Bit 4-7 einschalten

Call Setleds(0)
Lineled = 0                                                ' Lineled on
Waitms 10

Print
Print "nibobee in Bascom                                          11.12.09 mic"
Print
Print "Liniensensoren (l-m-r): " ; Getadc(5) ; "-" ; Getadc(6) ; "-" ; Getadc(7)
Lineled = 1                                                ' Lineled off

While Getkeys() = 0                                        'warten auf Taste (mit aktiver Odometry;)
  Led1 = Not Pinb.1
  Led2 = Not Pinb.1
  Print Odo_count_l ; " - " ; Odo_count_r
  Waitms 200
Wend
Call Setleds(0)
Wait 2

Do
  Disable Interrupts
  Odo_count_l = 0
  Odo_count_r = 0
  Enable Interrupts

  Call Motordir(1 , 1)
  Call Motorpwm(100 , 100)
  Call Setleds(2)

  Do
      W = Odo_count_l + Odo_count_r
  Loop Until W > 300

  Call Motorpwm(0 , 0)
  Wait 1

  Disable Interrupts
  Odo_count_l = 0
  Odo_count_r = 0
  Enable Interrupts

  Call Motordir(1 , 0)
  Call Motorpwm(100 , 100)
  Call Setleds(4)

  Do
      W = Odo_count_l + Odo_count_r
  Loop Until W > 115                                      'ca. 180°

  Call Motorpwm(0 , 0)
  Wait 1

Loop
End

Sub Motorpwm(byval Pwm_l As Byte , Byval Pwm_r As Byte)
  Pwm1a = Pwm_l * 4
  Pwm1b = Pwm_r * 4
End Sub

Sub Motordir(byval Dir_l As Byte , Byval Dir_r As Byte)
  If Dir_l = 0 Then Portd.6 = 0 Else Portd.6 = 1
  If Dir_r = 0 Then Portd.7 = 1 Else Portd.7 = 0
End Sub

Sub Setleds(byval Leds As Byte)
      Led0 = Leds.0
      Led1 = Leds.1
      Led2 = Leds.2
      Led3 = Leds.3
End Sub

Function Getkeys() As Byte
  Getkeys = Pinc / 16                                      ' Pins einlesen und nach rechts schieben
  Getkeys = Getkeys Xor 255                                ' invertieren
  Getkeys = Getkeys And 15                                ' Bit4-7 ausblenden
End Function

Isr_int0:
  Incr Odo_count_l
  Led0 = Pind.2
Return

Isr_int1:
  Incr Odo_count_r
  Led3 = Pind.3
Return

---

In Motordir() hatte sich ein Bug eingeschlichen den ich in dieser Version erschlagen habe:)

Gruß

mic

Hallo,

ich habe versucht ein Programm zu machen, das die Bee nicht vom Tisch fallen lässt:

Code:

---

'Verwendeter Compiler Bascom V 1.11.9.7
'
'Aufgabe:
'NIBOBee fällt nicht vom Tisch
'Autor: Pinsel120866
'###################################################

$regfile = "m16def.dat"
$crystal = 15000000
$hwstack = 32
$swstack = 8
$framesize = 24

Lineled Alias Portb.4

Config Lineled = Output                                    ' Lineled
Config Adc = Single , Prescaler = 64 , Reference = Avcc    ' 235 kHz

Declare Sub Motorpwm(byval Pwm_l As Byte , Byval Pwm_r As Byte)
Declare Sub Motordir(byval Dir_l As Byte , Byval Dir_r As Byte)
Declare Sub Frontled(byval Ledstatus As Byte)
Declare Sub Linedata()

Dim Linesensl As Integer
Dim Linesensc As Integer
Dim Linesensr As Integer

Start Adc
Wait 3

Do

  Call Frontled(0)
  Call Linedata

  If Linesensl > 30 Or Linesensc > 30 Or Linesensr > 30 Then
      Call Motordir(0 , 0)
      Call Motorpwm(0 , 0)
      Waitms 500
      Call Motordir(0 , 0)
      Call Motorpwm(100 , 100)
      Waitms 500
      Call Motordir(1 , 0)
      Call Motorpwm(100 , 100)
      Waitms 500
      Call Motordir(1 , 1)
      Call Motorpwm(100 , 100)

  Else
      Call Motordir(1 , 1)
      Call Motorpwm(100 , 100)

  End If
  Loop
End

Sub Motorpwm(byval Pwm_l As Byte , Byval Pwm_r As Byte)
  Pwm1a = Pwm_l * 4
  Pwm1b = Pwm_r * 4
End Sub

Sub Motordir(byval Dir_l As Byte , Byval Dir_r As Byte)
  If Dir_l = 0 Then Portd.6 = 0 Else Portd.6 = 1
  If Dir_r = 0 Then Portd.7 = 1 Else Portd.7 = 0
End Sub

Sub Frontled(byval Ledstatus As Byte)                      ' LED für Liniensensor ein-/aus-schalten
  Ddrb.4 = 1
  Portb.4 = Ledstatus.0
End Sub

Sub Linedata()                                              ' Liniensensoren lesen
  Config Portb.4 = Output
  Portb.4 = 1
  Linesensl = Getadc(5)
  Linesensc = Getadc(6)
  Linesensr = Getadc(7)
  Portb.4 = 0
End Sub

---

Lässt sich fehlerfrei kompilieren und flashen, aber die Bee rührt sich nicht.
Warum?

Bitte um Hilfe.

Hallo

Config Timer1 fehlt, der Timer1 erzeugt die PWM-Ansteuerung für die Motoren. Außerdem müssen die Motorpins PD4 bis PD7 auf Ausgang konfiguriert werden. Nach dem Schalten der LineLED sollte man kurz warten, denn auch LEDs brauchen etwas Zeit um volle Leuchtstärke zu erreichen bzw. dunkel zu werden:

Code:

---

Sub Linedata()                                              ' Liniensensoren lesen
  Config Portb.4 = Output
  Portb.4 = 1
  Linesensl = Getadc(5)
  Linesensc = Getadc(6)
  Linesensr = Getadc(7)
  Portb.4 = 0
End Sub

---

Die Anoden der LineLeds (IR3+4) hängen direkt an Vcc, deshalb muss PB4 auf low geschaltet werden damit die LEDs leuchten.

Übrigends ist "vom Tisch fallen" die häufigste Ursache für ein frühes Ableben von Kleinrobotern.

Gruß

mic

Danke Radbruch, jetzt hat's geklappt.

Der Vollständigkeit halber noch der richtige Code:

Code:

---

'Verwendeter Compiler Bascom V 1.11.9.7
'
'Aufgabe:
'NIBOBee fällt nicht vom Tisch
'Autor: Pinsel120866
'###################################################

$regfile = "m16def.dat"
$crystal = 15000000
$hwstack = 32
$swstack = 8
$framesize = 24

Lineled Alias Portb.4

Config Portd.4 = Output                                    ' pmw_r
Config Portd.5 = Output                                    ' pwm_l
Config Portd.6 = Output                                    ' dir_l
Config Portd.7 = Output                                    ' dir_r
Config Lineled = Output                                    ' Lineled
Config Adc = Single , Prescaler = 64 , Reference = Avcc    ' 235 kHz
Config Timer1 = Pwm , Pwm = 10 , Compare A Pwm = Clear Up , Compare B Pwm = Clear Up , Prescale = 1

Declare Sub Motorpwm(byval Pwm_l As Byte , Byval Pwm_r As Byte)
Declare Sub Motordir(byval Dir_l As Byte , Byval Dir_r As Byte)
Declare Sub Frontled(byval Ledstatus As Byte)
Declare Sub Linedata()

Dim Linesensl As Integer
Dim Linesensc As Integer
Dim Linesensr As Integer
Dim _lcd_e As Byte                                          'Needed to control 4 line LCD
Enable Interrupts

Start Adc
$lib "Lcd_i2c_DOGM.lib"                                    'I2c driver for the LCD
Config I2cdelay = 1
Const Pcf8574_lcd = &H4E                                    'Defines the address of the I/O expander for LCD
Config Scl = Portc.0                                        'Configure i2c SCL
Config Sda = Portc.1                                        'Configure i2c SDA
Config Lcd = 16 * 3 , Chipset = Dogm163v5    '16*3 type LCD display 5V

I2cstart

Call Linedata

_lcd_e = 128                                                'Upper half of 4-line display is selected
Cls                                                        'clear the LCD display
Lcd "*Liniensensoren*"                                      'display this at the top line
Waitms 1
Lowerline                                                  'select the lower line
Lcd "R-" ; Linesensr ; " M-" ; Linesensc ; " L-" ; Linesensl
Waitms 1                                                    'display this at the lower line
_lcd_e = 64                                                'Lower half of 4-line display is selected
Lcd "nix"
Waitms 1
Lowerline
Lcd "nix"

Wait 3

Do

  Call Frontled(0)
  Waitms 10
  Call Linedata
      _lcd_e = 128                                          'Upper half of 4-line display is selected
      Cls                                                        'clear the LCD display
      Lcd "*Liniensensoren*"                                      'display this at the top line
      Waitms 1
      Lowerline                                                  'select the lower line
      Lcd "R-" ; Linesensr ; " M-" ; Linesensc ; " L-" ; Linesensl
      Waitms 1                                                    'display this at the lower line
      _lcd_e = 64                                                'Lower half of 4-line display is selected
      Lcd "nix"
      Waitms 1
      Lowerline
      Lcd "nix"

  Waitms 10

  If Linesensc < 7 Or Linesensr < 12 Or Linesensl < 22 Then      'hier anpassen!
      Call Motordir(0 , 0)
      Call Motorpwm(0 , 0)
      Waitms 500
      Call Motordir(0 , 0)
      Call Motorpwm(100 , 100)
      Waitms 500
      Call Motordir(1 , 0)
      Call Motorpwm(100 , 100)
      Waitms 500
      Call Motordir(1 , 1)
      Call Motorpwm(100 , 100)

  Else
      Call Motordir(1 , 1)
      Call Motorpwm(100 , 100)

  End If
  Loop
End

Sub Motorpwm(byval Pwm_l As Byte , Byval Pwm_r As Byte)
  Pwm1a = Pwm_l * 4
  Pwm1b = Pwm_r * 4
End Sub

Sub Motordir(byval Dir_l As Byte , Byval Dir_r As Byte)
  If Dir_l = 0 Then Portd.6 = 0 Else Portd.6 = 1
  If Dir_r = 0 Then Portd.7 = 1 Else Portd.7 = 0
End Sub

Sub Frontled(byval Ledstatus As Byte)                      ' LED für Liniensensor ein-/aus-schalten
  Ddrb.4 = 1
  Portb.4 = Ledstatus.0
End Sub

Sub Linedata()                                              ' Liniensensoren lesen
  Config Portb.4 = Output
  Portb.4 = 1
  Linesensl = Getadc(5)
  Linesensc = Getadc(6)
  Linesensr = Getadc(7)
  Portb.4 = 0
End Sub

---

Sind bei euch die 3 Liniensensor-Werte auch so unterschiedlich?

Hallo

Um das Bascom mit der bee etwas zu pushen habe ich die ACS-Funktion von C nach Bascom umgeschrieben:

Code:

---

' nibobee ACS mit Bascom (und zusätzlich allgemeinene Funktionen)      16.1.10 mic

' https://www.roboternetz.de/phpBB2/vi...=480966#480966

Declare Sub Motorpwm(byval Pwm_l As Byte , Byval Pwm_r As Byte)      'Pwm für Motoren setzen (0-255)
Declare Sub Motordir(byval Dir_l As Byte , Byval Dir_r As Byte)      'Drehrichtungen der Motoren setzen (1/0)
Declare Sub Setleds(byval Leds As Byte)                    'Leds als Bitmuster setzen &B000xxxx
Declare Function Getkeys() As Byte                          'Bitmuster der Tasten einlesen &B0000xxxx
Declare Sub Odo_reset                                      ' Odometryzähler auf null setzen
Declare Sub Sleep(byval Pause As Byte)                      'Pause 1/36000 Sekunde warten
Declare Sub Msleep(byval Pause As Word)                    'Pause 1/1000 Sekunde warten
Declare Sub Acs                                            ' acs_left und acs_right aktuallisieren

$regfile = "m16def.dat"
$crystal = 15000000
$hwstack = 48                                              ' kleiner 48 ergibt Stapelüberlauf!
$swstack = 8
$framesize = 24

$baud = 19200

Acs_led_left Alias Porta.2                                  'acs Anoden
Acs_led_right Alias Porta.3
Acs_led_36khz Alias Portc.2                                ' Kathode mit Widerstand
Acs_tsop Alias Pinc.3                                      'Eingang!

Led0 Alias Portb.0
Led1 Alias Portb.1
Led2 Alias Portb.2
Led3 Alias Portb.3
Lineled Alias Portb.4

Config Led0 = Output                                        ' LEDs 0-3
Config Led1 = Output
Config Led2 = Output
Config Led3 = Output
Config Lineled = Output                                    ' Lineled

Config Acs_led_left = Output                                'acs
Config Acs_led_right = Output
Config Acs_led_36khz = Output
Config Acs_tsop = Input

Config Portc.4 = Input                                      ' keys
Config Portc.5 = Input
Config Portc.6 = Input
Config Portc.7 = Input
Portc = &B11110000                                          'Tasten-PullUp Bit 4-7 einschalten

Config Portd.2 = Input                                      ' odo_l int0
Config Portd.3 = Input                                      ' odo_r int1
Config Portd.4 = Output                                    ' pmw_r
Config Portd.5 = Output                                    ' pwm_l
Config Portd.6 = Output                                    ' dir_l
Config Portd.7 = Output                                    ' dir_r

'Config Com1 = Dummy , Synchrone = 0 , Parity = None , Stopbits = 1 , Databits = 8 , Clockpol = 0
Config Timer1 = Pwm , Pwm = 10 , Compare A Pwm = Clear Up , Compare B Pwm = Clear Up , Prescale = 1
Config Timer2 = Pwm , Compare Pwm = Disconnect , Prescale = 1      'gemessene 36kHz!
Ocr2 = 151                                                  '36kHz mit Puls:Pause 50:50
Tcnt2 = 99                                                  'Frequenzkorrektur beim Start
Config Adc = Single , Prescaler = 64 , Reference = Avcc    ' 235 kHz
Config Int0 = Change
Config Int1 = Change

Dim B As Byte , W As Word
Dim Odo_count_l As Word , Odo_count_r As Word
Dim Count36khz As Byte
Dim Acs_left As Byte , Acs_right As Byte
Dim Acs_count As Byte

Start Adc
On Oc2 Isr_timer2_comp
On Ovf2 Isr_timer2_ovl
On Int0 Isr_int0
On Int1 Isr_int1
Enable Oc2
Enable Ovf2
Enable Int0
Enable Int1
Enable Interrupts

Do
  Call Acs
  Reset Led0
  Reset Led1
  Reset Led2
  Reset Led3
  If Acs_left > 251 Then
      Set Led1
  Else
      If Acs_left > 230 Then Set Led0
  End If
  If Acs_right > 251 Then
      Set Led2
  Else
      If Acs_right > 230 Then Set Led3
  End If
  Call Msleep(100)
Loop
End

Sub Acs
  Ocr2 = 253
  Set Acs_led_left
  While Acs_tsop = 1 And Ocr2 > 151
      Acs_count = 8
      While Acs_count > 0
      Wend
      Ocr2 = Ocr2 - 1
  Wend
  Reset Acs_led_left
  Acs_left = Ocr2
  While Acs_tsop = 0
  Wend

  Ocr2 = 253
  Set Acs_led_right
  While Acs_tsop = 1 And Ocr2 > 151
      Acs_count = 8
      While Acs_count > 0
      Wend
      Ocr2 = Ocr2 - 1
  Wend
  Reset Acs_led_right
  Acs_right = Ocr2
  While Acs_tsop = 0
  Wend
End Sub

Sub Motorpwm(byval Pwm_l As Byte , Byval Pwm_r As Byte)
  Pwm1a = Pwm_l * 4
  Pwm1b = Pwm_r * 4
End Sub

Sub Motordir(byval Dir_l As Byte , Byval Dir_r As Byte)
  If Dir_l = 0 Then Portd.6 = 0 Else Portd.6 = 1
  If Dir_r = 0 Then Portd.7 = 1 Else Portd.7 = 0
End Sub

Sub Setleds(byval Leds As Byte)
      Led0 = Leds.0
      Led1 = Leds.1
      Led2 = Leds.2
      Led3 = Leds.3
End Sub

Function Getkeys() As Byte
  Getkeys = Pinc / 16                                      ' Pins einlesen und nach rechts schieben
  Getkeys = Getkeys Xor 255                                ' invertieren
  Getkeys = Getkeys And 15                                ' Bit4-7 ausblenden
End Function

Sub Odo_reset
  Disable Interrupts
  Odo_count_l = 0
  Odo_count_r = 0
  Enable Interrupts
End Sub

Sub Sleep(byval Pause As Byte)
  Count36khz = Pause
  While Count36khz > 0
  Wend
End Sub

Sub Msleep(byval Pause As Word)
  While Pause > 0
      Call Sleep(36)
      Decr Pause
  Wend
End Sub

Isr_int0:
  Incr Odo_count_l
  Led0 = Pind.2
Return

Isr_int1:
  Incr Odo_count_r
  Led3 = Pind.3
Return

Isr_timer2_comp:
  Toggle Acs_led_36khz
Return

Isr_timer2_ovl:
  Tcnt2 = Tcnt2 + 99                                      'Frequenzkorrektur 36kHz
  Reset Acs_led_36khz
  If Count36khz > 0 Then Decr Count36khz
  If Acs_count > 0 Then Decr Acs_count
Return

---

Die Werte meiner Liniensensoren sind auch unterschiedlich. Die Mitte hat (aufbaubedingt?) immer den höchsten Wert, die linke Seite schwächelt etwas und hat ca. 50 weniger als die rechte Seite bei hell.

Gruß

mic

[Edit]
Setup Timer2 geändert!!!

Super, tolle Arbeit - danke mic.

Ich habe mir dein Programm gleich geschnappt und so erweitert, dass die Bee autonom durch den Raum fährt:

Code:

---

'Verwendeter Compiler Bascom V 1.11.9.3
'
'Aufgabe:
'Autonome Bewegung mit
'Abstandsmessung (IR-LEDs 2x links, 2x rechts)
'und Werte auf DODM 3x16 LCD ausgeben
'Autor: Pinsel120866
'###################################################

Declare Sub Motorpwm(byval Pwm_l As Byte , Byval Pwm_r As Byte)      'Pwm für Motoren setzen (0-255)
Declare Sub Motordir(byval Dir_l As Byte , Byval Dir_r As Byte)      'Drehrichtungen der Motoren setzen (1/0)
Declare Sub Setleds(byval Leds As Byte)                    'Leds als Bitmuster setzen &B000xxxx
Declare Function Getkeys() As Byte                          'Bitmuster der Tasten einlesen &B0000xxxx
Declare Sub Odo_reset                                      ' Odometryzähler auf null setzen
Declare Sub Sleep(byval Pause As Byte)                      'Pause 1/36000 Sekunde warten
Declare Sub Msleep(byval Pause As Word)                    'Pause 1/1000 Sekunde warten
Declare Sub Acs                                            ' acs_left und acs_right aktuallisieren

$regfile = "m16def.dat"
$crystal = 15000000
$hwstack = 48                                              ' kleiner 48 ergibt Stapelüberlauf!
$swstack = 8
$framesize = 24

$baud = 19200

Acs_led_left Alias Porta.1                                  'acs Anoden
Acs_led_right Alias Porta.0
Acs_led_36khz Alias Porta.3                                ' Kathode mit Widerstand
Acs_tsop Alias Pina.2                                      'Eingang!

Led0 Alias Portb.0
Led1 Alias Portb.1
Led2 Alias Portb.2
Led3 Alias Portb.3
Lineled Alias Portb.4

$lib "Lcd_i2c_DOGM.lib"                                    'I2c driver for the LCD
Config I2cdelay = 1
Const Pcf8574_lcd = &H4E                                    'Defines the address of the I/O expander for LCD
Config Scl = Portc.0                                        'Configure i2c SCL
Config Sda = Portc.1                                        'Configure i2c SDA

Config Led0 = Output                                        ' LEDs 0-3
Config Led1 = Output
Config Led2 = Output
Config Led3 = Output
Config Lineled = Output                                    ' Lineled

Config Acs_led_left = Output                                'acs
Config Acs_led_right = Output
Config Acs_led_36khz = Output
Config Acs_tsop = Input

Config Portc.4 = Input                                      ' keys
Config Portc.5 = Input
Config Portc.6 = Input
Config Portc.7 = Input
Portc = &B11110000                                          'Tasten-PullUp Bit 4-7 einschalten

Config Portd.2 = Input                                      ' odo_l int0
Config Portd.3 = Input                                      ' odo_r int1
Config Portd.4 = Output                                    ' pmw_r
Config Portd.5 = Output                                    ' pwm_l
Config Portd.6 = Output                                    ' dir_l
Config Portd.7 = Output                                    ' dir_r

'Config Com1 = Dummy , Synchrone = 0 , Parity = None , Stopbits = 1 , Databits = 8 , Clockpol = 0
Config Timer1 = Pwm , Pwm = 10 , Compare A Pwm = Clear Up , Compare B Pwm = Clear Up , Prescale = 1
Config Timer2 = Phase Correct , Compare Pwm = Disconnect , Prescale = 1
Ocr2 = 151                                                  '36kHz mit Puls:Pause 50:50
Tcnt2 = 99                                                  'Frequenzkorrektur beim Start
Config Adc = Single , Prescaler = 64 , Reference = Avcc    ' 235 kHz
Config Int0 = Change
Config Int1 = Change

Dim B As Byte , W As Word
Dim Odo_count_l As Word , Odo_count_r As Word
Dim Count36khz As Byte
Dim Acs_left As Byte , Acs_right As Byte
Dim Acs_count As Byte
Dim _lcd_e As Byte                                          'Needed to control 4 line LCD

Config Lcd = 16 * 3 , Chipset = Dogm163v5                  '16*3 type LCD display 5V

I2cstart
Start Adc
On Oc2 Isr_timer2_comp
On Ovf2 Isr_timer2_ovl
On Int0 Isr_int0
On Int1 Isr_int1
Enable Oc2
Enable Ovf2
Enable Int0
Enable Int1
Enable Interrupts

_lcd_e = 128                                                'Upper half of 4-line display is selected
Cls                                                        'clear the LCD display
Lcd "Pinsel's NIBOBee"                                      'display this at the top line
Waitms 1
Lowerline                                                  'select the lower line
Lcd "Abstandsmessung mit 2x2 IR-LEDs"
Waitms 1                                                    'display this at the lower line
_lcd_e = 64                                                'Lower half of 4-line display is selected
Lcd "nix"
Waitms 1
Lowerline
Lcd "nix"

Waitms 500

Do
  Call Acs

  Reset Led0
  Reset Led1
  Reset Led2
  Reset Led3

  Call Motordir(1 , 1)
  Call Motorpwm(197 , 197)

  If Acs_left > 251 And Acs_right > 251 Then
      _lcd_e = 128
      Cls
      Lcd ""                                                  'display this at the top line
      Waitms 1
      Lowerline                                                'select the lower line
      Lcd "Abstand li: " ; Acs_left ; " Abstand re: " ; Acs_right ;      'Wert ausgeben auf Display
      Set Led1
      Call Motordir(1 , 0)
      Call Motorpwm(0 , 0)
      Waitms 100
      Call Motorpwm(127 , 127)
      Waitms 300
  End If

  If Acs_left > 251 Then
      _lcd_e = 128
      Cls
      Lcd ""                                                  'display this at the top line
      Waitms 1
      Lowerline                                                'select the lower line
      Lcd "Abstand li: " ; Acs_left ; " Abstand re: " ; Acs_right ;      'Wert ausgeben auf Display
      Set Led1
      Call Motordir(1 , 1)
      Call Motorpwm(0 , 0)
      Waitms 100
      Call Motorpwm(127 , 0)
      Waitms 300
  End If

  If Acs_right > 251 Then
      _lcd_e = 128
      Cls
      Lcd ""                                                  'display this at the top line
      Waitms 1
      Lowerline                                                'select the lower line
      Lcd "Abstand li: " ; Acs_left ; " Abstand re: " ; Acs_right ;      'Wert ausgeben auf Display
      Set Led2
      Call Motordir(1 , 1)
      Call Motorpwm(0 , 0)
      Waitms 100
      Call Motorpwm(0 , 127)
      Waitms 300
  End If

Loop
End

Sub Acs
  Ocr2 = 253
  Set Acs_led_left
  While Acs_tsop = 1 And Ocr2 > 151
      Acs_count = 8
      While Acs_count > 0
      Wend
      Ocr2 = Ocr2 - 1
  Wend
  Reset Acs_led_left
  Acs_left = Ocr2
  While Acs_tsop = 0
  Wend

  Ocr2 = 253
  Set Acs_led_right
  While Acs_tsop = 1 And Ocr2 > 151
      Acs_count = 8
      While Acs_count > 0
      Wend
      Ocr2 = Ocr2 - 1
  Wend
  Reset Acs_led_right
  Acs_right = Ocr2
  While Acs_tsop = 0
  Wend
End Sub

Sub Motorpwm(byval Pwm_l As Byte , Byval Pwm_r As Byte)
  Pwm1a = Pwm_l * 4
  Pwm1b = Pwm_r * 4
End Sub

Sub Motordir(byval Dir_l As Byte , Byval Dir_r As Byte)
  If Dir_l = 0 Then Portd.6 = 0 Else Portd.6 = 1
  If Dir_r = 0 Then Portd.7 = 1 Else Portd.7 = 0
End Sub

Function Getkeys() As Byte
  Getkeys = Pinc / 16                                      ' Pins einlesen und nach rechts schieben
  Getkeys = Getkeys Xor 255                                ' invertieren
  Getkeys = Getkeys And 15                                ' Bit4-7 ausblenden
End Function

Sub Odo_reset
  Disable Interrupts
  Odo_count_l = 0
  Odo_count_r = 0
  Enable Interrupts
End Sub

Sub Sleep(byval Pause As Byte)
  Count36khz = Pause
  While Count36khz > 0
  Wend
End Sub

Sub Msleep(byval Pause As Word)
  While Pause > 0
      Call Sleep(36)
      Decr Pause
  Wend
End Sub

Isr_int0:
  Incr Odo_count_l
  Led0 = Pind.2
Return

Isr_int1:
  Incr Odo_count_r
  Led3 = Pind.3
Return

Isr_timer2_comp:
  Toggle Acs_led_36khz
Return

Isr_timer2_ovl:
  Tcnt2 = Tcnt2 + 99                                      'Frequenzkorrektur 36kHz
  Reset Acs_led_36khz
  If Count36khz > 0 Then Decr Count36khz
  If Acs_count > 0 Then Decr Acs_count
Return

---

Hallo

Sieht gut aus, ich kann es leider nicht testen, weil mir deine LCD-Lib fehlt :(

Aber wenn es bei dir funktioniert ist es prima. Vielleicht kannst du uns ein Video zeigen?

Eigentlich brauchen wir bei Bascom die Sleep/Msleep-Funktionen nicht, oder?

Gruß

mic

[Edit]
Klasse, es funktioniert wunderbar. Ich habe in meinem Programm lediglich die Hauptscheife ausgetauscht:

Code:

---

Do
  Call Acs

  Reset Led0
  Reset Led1
  Reset Led2
  Reset Led3

  Call Motordir(1 , 1)
  Call Motorpwm(197 , 197)

  If Acs_left > 251 And Acs_right > 251 Then
      Set Led1
      Call Motordir(1 , 0)
      Call Motorpwm(0 , 0)
      Waitms 100
      Call Motorpwm(127 , 127)
      Waitms 300
  End If

  If Acs_left > 251 Then
      Set Led1
      Call Motordir(1 , 1)
      Call Motorpwm(0 , 0)
      Waitms 100
      Call Motorpwm(127 , 0)
      Waitms 300
  End If

  If Acs_right > 251 Then
      Set Led2
      Call Motordir(1 , 1)
      Call Motorpwm(0 , 0)
      Waitms 100
      Call Motorpwm(0 , 127)
      Waitms 300
  End If

Loop
End

---

http://www.youtube.com/watch?v=upszgUzs69g
Kann es sein, dass waitms länger dauert als erwartet?