RC2 Decoder sound / voice playback

What is it?

It’s an very simple, only 2 resistors and 1 condensator, sound playback. And it sounds amazing good, check the TheFinalResult.mp3 file.This is based on an article by Mariano Barron in the Circuit Cellar #180 July 2005. Due the copyright I can’t publish the article here. You can buy your copy at the Circuit Cellar website.
The software we need to encode the WAV files is free available from the Circuit cellar ftp server, in this file there is also a short description how it works.With the Rc Sound Encoder software we compress the WAV to RC2 coding. This coding will be stored in eeprom and played back with this simple “Soundcard” Every sample requires only 1 bit, so for 1 second 44,1kHz sound we need 2726 Bytes storage space. It’s not much but for most MCU too much to store in the flash or internal eeprom. Therefore we store the sound samples in an external i2c eeprom.

Hardware

Schematic

Schematic is very simple. I’m using a Mega128 running on 16MHz. I2c eeprom (24c256) is connected with the hardware i2c (scl/sda). Software i2c will not work, this is to slow, maybe it will work with 22050hz samples but I didn’t try that.In the upper right corner we have the Rc2 decoder and optional an low pass filter and a simple amplifier.

Timing
Even the timer isr calculation is simple Crystal/prescaler/sample rate = 16000000/1/44100 = 362 = &H016A .
If you like to use an other sample rate or crystal you need to recalculate the timer.

Diy
The document RC2-Howto.pdf describes how to make your own Eeprom file with your sound or speech, this document can be found in the Zip file. The zip contains also the used WAV files, the ready to run demo Eeprom hex file and some ASM files.

Limitation
In all the routines are 16bits addressing used, therefore it’s not possible to use Eeprom’s larger then 512KB. If you change the routines you can use more then one 512KB i2c eeprom (you can hook up 4 to 1 i2c bus), but the RC-coder software uses also 16bits addresses and that’s something that we cannot change.

Required tools

 

The code
Code is written and tested in Bascom 1.11.9.0.001 license.

'------------------------------------------------------------------
'                      R2C Decoder voice playback
'     Playback sound and voice with very simple hardware 2xR 1xC
'        By Evert Dekker 2008 R2CDecoder@Evertdekker dotje com
'                   Created with Bascom-Avr: 1.11.9.0.100
'------------------------------------------------------------------

$regfile = "m128def.DAT"
$crystal = 16000000
$baud = 19200
$hwstack = 50
$swstack = 50
$framesize = 40

$lib "I2C_TWI.LBX"                                          'Setting up i2c hardware bus
Config Twi = 400000                                         'Hardware i2c bus speed
Config Scl = Portd.0                                        'TWI (i2c) ports on the Mega128
Config Sda = Portd.1
Const Addressw = &B10100000                                 'slave write address eeprom
Const Addressr = &B10100001                                 'slave read address eeprom


Vp1 Alias Porta.1                                           'Voice pin 1
Vp2 Alias Porta.2                                           'Voice pin 2
Config Porta.1 = Output
Config Porta.2 = Output


Config Timer1 = Timer , Prescale = 1 , Compare A = Set , Clear Timer = 1       'Setting up the timer
Compare1a = &H016A                                          'Timer1 comparator
Enable Interrupts
Enable Compare1a
On Compare1a Timer1_int
Stop Timer1                                                 'Stop the timer, not yet needed


'==== Declaration
Declare Sub Read_eeprom_word(byval Adress As Word , Valueword As Word)
Declare Sub Playsample(byval Sample As Byte)
Declare Sub Read_eeprom_index

Dim Samples As Word , Start_byte(10) As Word , Lenght(10) As Word       'If you have more then 10 voices programmed, then incr this here.
Dim Bytetodo As Word , Outbyte As Byte
Dim Temp As Byte , Tempw As Word , Lus As Byte
Dim Bitcount As Byte , Tempadress2 As Byte

'=== Main ===
Do
Read_eeprom_index                                           'Read the eeprom index because we need to know number of samples, startadress and lenght
Print Samples ; " Samples present in the eeprom"
For Lus = 1 To Samples
 Print Lus ; "e sample start at eeprom adress: &H" ; Hex(start_byte(lus)) ; " is &H" ; Hex(lenght(lus)) ; " bytes long."
Next For
Wait 3

For Lus = 1 To Samples
 Playsample Lus
Wait 1
Next Lus

Loop
End



'=== Sub routines ===
Sub Playsample(byval Sample As Byte)
Bytetodo = Lenght(sample)                                   'Number of bytes to be processed
Tempw = Start_byte(sample) * 2                              'Index is in word, need now bytes so *2
I2cstart                                                    'Generate start
I2cwbyte Addressw
Tempadress2 = High(tempw)                                   'High(adress)
I2cwbyte Tempadress2                                        'highbyte adress of EEPROM
Tempadress2 = Low(tempw)
I2cwbyte Tempadress2                                        'lowbyte adress of EEPROM
I2cstart                                                    'repeated start
I2cwbyte Addressr
Start Timer1                                                'Start the timer and therefore the playback
Do
If Bitcount = 7 Then                                        '1 byte processed
   I2crbyte Outbyte , Ack                                   'Read byte from eeprom
    Decr Bytetodo                                           '1 byte less todo
    Bitcount = 0                                            'Reset bits processed
End If
Loop Until Bytetodo = 0                                     'Do until all the bytes from the sample are processed
Stop Timer1                                                 'Ready stop the timer
I2crbyte Temp , Nack                                        'read extra byte with Nack to finish the i2c bus
I2cstop                                                     'Stop i2c
Vp2 = 0 : Vp1 = 0                                           'Silence the voice pins
End Sub



Timer1_int:
Vp2 = Vp1                                                   'Voice pin2 is the previous setting of voice pin1
If Bitcount > 0 Then Shift Outbyte , Right , 1              'shift the bits out
Vp1 = Outbyte.0                                             'Set voice pin1
Incr Bitcount                                               'Next bit
Return



Sub Read_eeprom_index                                       'Find the start adresse of each Voice. Adress is stored as word
      Read_eeprom_word 0 , Samples                          '1e Byte in the eeprom contens the number of programmed samples and is the low byte of the first sample
      Temp = Low(samples) : Temp = Temp -1                  '
      For Lus = 0 To Temp                                   'Loop the number of Samples found
          Tempw = Lus * 2                                   'Reading words, so steps 2
          Read_eeprom_word Tempw , Start_byte(lus + 1)      'Read the start adres of the samples
          Tempw = Start_byte(lus + 1)
          Tempw = Tempw * 2                                 'Reading words, so steps 2
          Read_eeprom_word Tempw , Lenght(lus + 1)          'Read the lenght of the sample from the eeprom
          Rotate Lenght(lus + 1) , Left , 8                 'Msb and Lsb are inverted so swap them
      Next Lus
End Sub




Sub Read_eeprom_word(byval Adress As Word , Valueword As Word)
   Local Tempadress As Byte , Valueh As Byte , Valuel As Byte,
   I2cstart                                                 'generate start
   I2cwbyte Addressw                                        'slave adsress
   Tempadress = High(adress)
   I2cwbyte Tempadress                                      'highbyte adress of EEPROM
   Tempadress = Low(adress)
   I2cwbyte Tempadress                                      'lowbyte adress of EEPROM
   I2cstart                                                 'repeated start
   I2cwbyte Addressr                                        'slave address (read)
   I2crbyte Valuel , Ack                                    'read byte
   I2crbyte Valueh , Nack
   I2cstop                                                  'generate stop
   Valueword = Makeint(valuel , Valueh)
End Sub

 

Manchester coding

For wireless communication you need Manchester coding. Manchester code provides simple encoding with no long period without a level transition. This helps clock recovery.
Here ‘s is a simple sample for a transmitter and receiver written in Bascom-avr.
1 will be coded as 01
0 will be coded as 10
00 and 11 are invalid
For the receiving part in VB6 check here .

Declare Function Make_manchester(byval Temp As Byte) As Word
Declare Function Decode_manchester(byval Tempw As Word ) As Byte



'== Demo prog ==
Dim Lus As Byte
Do
For Lus = 0 To 255
   Tempword = Make_manchester(lus)
   Print Decode_manchester(tempword)
Next Lus
Loop
End

 

'Subroutines
Sub Make_manchester(byval Temp As Byte) As Word
Local Bit_number As Byte
Local Manchester As Word
Bit_number = 8
Do
Shift Manchester , Left , 2
Decr Bit_number
If Temp.bit_number = 1 Then
Manchester = Manchester + 1                                 '01
Else
Manchester = Manchester + 2                                 '10
End If
Loop Until Bit_number = 0
Make_manchester = Manchester
End Sub


Sub Decode_manchester(byval Tempw As Word ) As Byte
Local Bit_number As Byte
Local Manchester As Word
Bit_number = 8
Do
Shift Manchester , Left , 1
Decr Bit_number
Temp_1 = Tempw And &B1100_0000_0000_0000
If Temp_1 = &B0100_0000_0000_0000 Then Incr Manchester      '01
If Temp_1 = &B1100_0000_0000_0000 Or Temp_1 = 0 Then Set Data_error       '11 or 00
Shift Tempw , Left , 2
Loop Until Bit_number = 0
If Data_error = 0 Then
   Decode_manchester = Manchester
Else
   Decode_manchester = 0
End If
Reset Data_error
End Sub
Rgb dimmer fading

Rgb dimmers are most of the time dimming according figure 1. It’s simple code, just increase al the colors 1 step a time,  but the disadvange is that blue is ready first and red the last and that looks not that realistic. It would be neater when all 3 colors will start and finishing together as seen in figure 2.
This code will fade all colors together.
Timer3 is used to controle the 3 pwm channels.
Timer0 is the delay for the steps. It’s with this xtal and preload an delay of 20ms. If you are going to use a other crystal then you need recalculate the timer0 preload.

rgb1
rgb2
PlayPause
previous arrow
next arrow
 
rgb1
rgb2
previous arrow
next arrow

 

Syntax

Fade Red,Green,Blue,Steps

Remarks

 Red  Constant or variable with new RED value.
 Green  Constant or variable with new GREEN value.
 Blue  Constant or variable with new BLUE value.
 Steps  Number of steps to fade between old and new value

 

 

 

 

 

 

Dowload the code here 

See the code below in action;

 

$regfile = "m128def.DAT"
$crystal = 7372800
$baud = 19200


Config Timer3 = Pwm , Prescale = 64 , Pwm = 8 , Compare A Pwm = Clear Down , Compare B Pwm = Clear Down , Compare C Pwm = Clear Down
Config Timer0 = Timer , Prescale = 1024

On Ovf0 Rgbint
Enable Timer3
Enable Ovf0
Enable Interrupts
Start Timer3
Timer0 = &H70
Stop Timer0


Declare Sub Fade(byval Newrood As Byte , Byval Newgroen As Byte , Byval Newblauw As Byte , Byval Stappen As Byte)
Dim Staprood As Single
Dim Stapgroen As Single
Dim Stapblauw As Single
Dim Roodw As Single
Dim Blauww As Single
Dim Groenw As Single
Dim Stappen As Byte
Dim Temps As Single
Dim Tempint As Integer
Dim Stap2 As Byte

Rood Alias Compare3a
Blauw Alias Compare3b
Groen Alias Compare3c

Rood = 0
Blauw = 0
Groen = 0


Do
Fade 25 , 25 , 25 , 10
Wait 2
Fade 255 , 0 , 0 , 50
Wait 2
Fade 0 , 255 , 0 , 50
Wait 2
Fade 0 , 0 , 255 , 50
Wait 2
Fade 150 , 150 , 75 , 50
Wait 2
Fade 0 , 0 , 0 , 10
Wait 2
Fade 225 , 225 , 225 , 100
Wait 2
Loop




Sub Fade(newrood As Byte , Newgroen As Byte , Newblauw As Byte , Stappen As Byte )
Stap2 = Stappen
Roodw = Rood : Groenw = Groen : Blauww = Blauw
Temps = Newrood - Rood
Staprood = Temps / Stappen
Temps = Newgroen - Groen
Stapgroen = Temps / Stappen
Temps = Newblauw - Blauw
Stapblauw = Temps / Stappen
Start Timer0
End Sub


Rgbint:
Roodw = Roodw + Staprood
Groenw = Groenw + Stapgroen
Blauww = Blauww + Stapblauw
Tempint = Round(roodw)
Rood = Tempint
Tempint = Round(blauww)
Blauw = Tempint
Tempint = Round(groenw)
Groen = Tempint
Decr Stap2
If Stap2 = 0 Then
 Stop Timer0
End If
Timer0 = &H70
Return
5″ Touchscreen

Schematic for the China version
3D Design
Finished Pcb
3D Design China version
Finished pcb China version
Finshed display
Touch display buildin
PlayPause
previous arrow
next arrow
 
Schematic for the China version
3D Design
Finished Pcb
3D Design China version
Finished pcb China version
Finshed display
Touch display buildin
previous arrow
next arrow

Here is the code in Bascom for my 5″ touchscreen. The schematic and code are adapted for the ledsee.com 240×128 touchscreen.
This code is not very well documentated, for a better explanation of the code check my 3″ application note at the Bascom web site.

Download code, schematic and buttons

$regfile = "m128def.DAT"
$crystal = 7372800
$baud = 19200
$eepleave
$loadersize = 512
$hwstack = 100
$swstack = 75
$framesize = 40


Config Graphlcd = 240 * 128 , Dataport = Porta , Controlport = Portc , Ce = 3 , Cd = 0 , Wr = 2 , Rd = 1 , Reset = 4 , Fs = 5 , Mode = 6
Config Adc = Single , Prescaler = Auto , Reference = Internal
Config Timer1 = Timer , Prescale = 1024
Const Timer1preload = 58336
Config Pinb.4 = Output
Rxtx Alias Porte.2
Speaker Alias Portf.7
Backlight Alias Portb.4
Const Buttonreturndelay = 20                                'Buttonreturndelay in ms
Dim Temp As Byte , X As Word , Y As Word
Dim Hoofdmenutijdrun As Bit
Dim Row As Byte , Keyarray(3) As Byte , Col As Byte , Key As Byte , Keylus As Byte
Dim Keypressed As Byte , Menu As Byte , Holdmenu As Bit
Dim Tijdcount As Byte
Enable Ovf1
Enable Interrupts
On Timer1 1secint
Start Adc
Start Timer1
Reset Hoofdmenutijdrun



' Main
Reset Backlight                                             'switch backlight on
 Cls
Cursor Off
Temp = 0
Gosub Showbasisknoppen
Gosub Showhoofdmenu
Do
'Your main prog here
   Gosub Readtouch
   Gosub Bepaaltoets
If Menu > 1 Then
    Hoofdmenutijdrun = 1
Else
   Hoofdmenutijdrun = 0
End If

If Keypressed > 0 Then
 Select Case Menu
  Case 1 : Select Case Keypressed                           'Hoofdmenu
                  Case 11 : Gosub Foutje                    'Key not used, so beep
                  Case 12 : Print "you pressed key " ; Keypressed ; " in menu " ; Menu
                            Gosub Showhoofdmenu             'Current menu must be reload to refill the buttons
                  Case 13 : Print "you pressed key " ; Keypressed ; " in menu " ; Menu
                            Gosub Showhoofdmenu             'Current menu must be reload to refill the buttons
                  Case 14 : Gosub Showwandmeubelmenu
                  Case 21 : Gosub Foutje
                  Case 22 : Print "you pressed key " ; Keypressed ; " in menu " ; Menu
                            Gosub Showhoofdmenu             'Current menu must be reload to refill the buttons
                  Case 23 : Print "you pressed key " ; Keypressed ; " in menu " ; Menu
                            Gosub Showhoofdmenu             'Current menu must be reload to refill the buttons
                  Case 24 : Print "you pressed key " ; Keypressed ; " in menu " ; Menu
                            Gosub Showhoofdmenu             'Current menu must be reload to refill the buttons
                  Case 31 : Gosub Foutje
                  Case 32 : Print "you pressed key " ; Keypressed ; " in menu " ; Menu
                            Gosub Showhoofdmenu             'Current menu must be reload to refill the buttons
                  Case 33 : Gosub Showjaloezvoormenu
                  Case 34 : Print "you pressed key " ; Keypressed ; " in menu " ; Menu
                            Gosub Showhoofdmenu             'Current menu must be reload to refill the buttons
                  Case 41 : Gosub Foutje
                  Case 42 : Print "you pressed key " ; Keypressed ; " in menu " ; Menu
                            Gosub Showhoofdmenu             'Current menu must be reload to refill the buttons
                  Case 43 : Print "you pressed key " ; Keypressed ; " in menu " ; Menu
                            Gosub Showhoofdmenu             'Current menu must be reload to refill the buttons
                  Case 44 : Gosub Showhoofdmenu2
                  End Select
  Case 2 : Select Case Keypressed                           'Jaloezieen voor menu
                  Case 11 : Gosub Foutje
                  Case 12 : Print "you pressed key " ; Keypressed ; " in menu " ; Menu
                            Gosub Showjaloezvoormenu        'Current menu must be reload to refill the buttons
                  Case 13 : Print "you pressed key " ; Keypressed ; " in menu " ; Menu
                            Gosub Showjaloezvoormenu        'Current menu must be reload to refill the buttons
                  Case 14 : Print "you pressed key " ; Keypressed ; " in menu " ; Menu
                            Gosub Showjaloezvoormenu        'Current menu must be reload to refill the buttons
                  Case 21 : Gosub Foutje
                  Case 22 : Print "you pressed key " ; Keypressed ; " in menu " ; Menu
                            Gosub Showjaloezvoormenu        'Current menu must be reload to refill the buttons
                  Case 23 : Print "you pressed key " ; Keypressed ; " in menu " ; Menu
                            Gosub Showjaloezvoormenu        'Current menu must be reload to refill the buttons
                  Case 24 : Gosub Foutje
                  Case 31 : Gosub Foutje
                  Case 32 : Print "you pressed key " ; Keypressed ; " in menu " ; Menu
                            Gosub Showjaloezvoormenu        'Current menu must be reload to refill the buttons
                  Case 33 : Print "you pressed key " ; Keypressed ; " in menu " ; Menu
                            Gosub Showjaloezvoormenu        'Current menu must be reload to refill the buttons
                  Case 34 : Gosub Foutje
                  Case 41 : Gosub Foutje
                  Case 42 : Gosub Foutje
                  Case 43 : Gosub Foutje
                  Case 44 : Gosub Showhoofdmenu
                  End Select

 Case 12 : Select Case Keypressed                           'Wandmeubel
                  Case 11 : Gosub Foutje
                  Case 12 : Print "you pressed key " ; Keypressed ; " in menu " ; Menu
                            Gosub Showwandmeubelmenu        'Current menu must be reload to refill the buttons
                  Case 13 : Print "you pressed key " ; Keypressed ; " in menu " ; Menu
                            Gosub Showwandmeubelmenu        'Current menu must be reload to refill the buttons
                  Case 14 : Gosub Foutje
                  Case 21 : Gosub Foutje
                  Case 22 : Print "you pressed key " ; Keypressed ; " in menu " ; Menu
                            Gosub Showwandmeubelmenu        'Current menu must be reload to refill the buttons
                  Case 23 : Print "you pressed key " ; Keypressed ; " in menu " ; Menu
                            Gosub Showwandmeubelmenu        'Current menu must be reload to refill the buttons
                  Case 24 : Gosub Foutje
                  Case 31 : Gosub Foutje
                  Case 32 : Print "you pressed key " ; Keypressed ; " in menu " ; Menu
                            Gosub Showwandmeubelmenu        'Current menu must be reload to refill the buttons
                  Case 33 : Print "you pressed key " ; Keypressed ; " in menu " ; Menu
                            Gosub Showwandmeubelmenu        'Current menu must be reload to refill the buttons
                  Case 34 : Gosub Foutje
                  Case 41 : Gosub Foutje
                  Case 42 : Print "you pressed key " ; Keypressed ; " in menu " ; Menu
                            Gosub Showwandmeubelmenu        'Current menu must be reload to refill the buttons
                  Case 43 : Print "you pressed key " ; Keypressed ; " in menu " ; Menu
                            Gosub Showwandmeubelmenu        'Current menu must be reload to refill the buttons
                  Case 44 : Gosub Showhoofdmenu             ' esc knop
                  End Select

  Case 21 : Select Case Keypressed                          'Hoofdmenu 2
                  Case 11 : Gosub Foutje
                  Case 12 : Print "you pressed key " ; Keypressed ; " in menu " ; Menu
                            Gosub Showhoofdmenu2            'Current menu must be reload to refill the buttons
                  Case 13 : Gosub Foutje
                  Case 14 : Gosub Showhoofdmenu             'Back to hoofdmenu1
                  Case 21 : Gosub Foutje
                  Case 22 : Gosub Foutje
                  Case 23 : Gosub Foutje
                  Case 24 : Gosub Foutje
                  Case 31 : Gosub Foutje
                  Case 32 : Gosub Foutje
                  Case 33 : Gosub Foutje
                  Case 34 : Gosub Foutje
                  Case 41 : Gosub Foutje
                  Case 42 : Gosub Foutje
                  Case 43 : Gosub Foutje
                  Case 44 : Gosub Foutje
                  End Select

End Select

 Keypressed = 0
End If
Loop


'=== Subroutines===


1secint:
If Hoofdmenutijdrun = 1 Then
   Incr Tijdcount
        If Tijdcount => 10 Then                             'Time delay return to hoofdmenu (mainmenu)
        Hoofdmenutijdrun = 0 : Tijdcount = 0
         If Holdmenu = 0 Then
          Gosub Showhoofdmenu
         End If
         Else
        End If
End If
Timer1 = Timer1preload
Return



Showwandmeubelmenu:
Menu = 12 : Holdmenu = 0
Showpic 0 , 0 , Hwandmeubel                                 'show a comnpressed picture
Showpic 6 , 36 , Ledsaan
Showpic 6 , 68 , Ledsuit
Showpic 6 , 100 , Leeg
Showpic 66 , 36 , Beidedeurenup
Showpic 66 , 68 , Beidedeurendown
Showpic 66 , 100 , Leeg
Showpic 126 , 36 , Linkerdeurup
Showpic 126 , 68 , Linkerdeurdown
Showpic 126 , 100 , Leeg
Showpic 186 , 36 , Rechterdeurup
Showpic 186 , 68 , Rechterdeurdown
Showpic 186 , 100 , Esc
Return


Showjaloezvoormenu:
Menu = 2 : Holdmenu = 0
Showpic 0 , 0 , Hjalvoor                                    'show a comnpressed picture
Showpic 6 , 36 , Pijlomhoog
Showpic 6 , 68 , Stopbutton
Showpic 6 , 100 , Pijlomlaag
Showpic 66 , 36 , Jalvf1
Showpic 66 , 68 , Jalvf3
Showpic 66 , 100 , Leeg
Showpic 126 , 36 , Jalvf2
Showpic 126 , 68 , Jalvf4
Showpic 126 , 100 , Leeg
Showpic 186 , 36 , Leeg
Showpic 186 , 68 , Leeg
Showpic 186 , 100 , Esc
Return


Showhoofdmenu:
Menu = 1 : Holdmenu = 0
Showpic 0 , 0 , Headerhoofdmenu                             'show a comnpressed picture
Showpic 6 , 36 , Lichteettafel
Showpic 66 , 36 , Lichtsalontafel
Showpic 126 , 36 , Lichtkeuken
Showpic 186 , 36 , Schemerlamp
Showpic 6 , 68 , Lichttuin
Showpic 66 , 68 , Leeg
Showpic 126 , 68 , Jalvoor
Showpic 186 , 68 , Jalachter
Showpic 6 , 100 , Wandmeubel
Showpic 66 , 100 , Versterker
Showpic 126 , 100 , Autoprog
Showpic 186 , 100 , Pijlrechts
Return

Showhoofdmenu2:
Menu = 21 : Holdmenu = 1
'Normaly the screen will go after 10sec back to the main menu. With Holdmenu=1 the screen will stay in this menu.
Showpic 0 , 0 , Hhoofdmenu2                                 'show a comnpressed picture
Showpic 6 , 36 , Leeg
Showpic 66 , 36 , Leeg
Showpic 126 , 36 , Leeg
Showpic 186 , 36 , Leeg
Showpic 6 , 68 , Leeg
Showpic 66 , 68 , Leeg
Showpic 126 , 68 , Leeg
Showpic 186 , 68 , Leeg
Showpic 6 , 100 , Pijllinks
Showpic 66 , 100 , Leeg
Showpic 126 , 100 , Leeg
Showpic 186 , 100 , Leeg
Return





Bepaaltoets:
Select Case X
            Case 160 To 317 : Col = 10
            Case 318 To 477 : Col = 20
            Case 478 To 633 : Col = 30
            Case 634 To 788 : Col = 40
            Case Else Col = 0
End Select
Select Case Y
            Case 329 To 414 : Row = 1
            Case 415 To 497 : Row = 2
            Case 498 To 584 : Row = 3
            Case 585 To 652 : Row = 4
            Case Else Row = 0
End Select
Key = Col + Row
'locate 4 , 2 : Lcd "Je drukte op knop ; " ; key
If Key > 0 Then
  Keyarray(keylus) = Key
  Incr Keylus
  If Keylus > 3 Then Keylus = 1
   If Keyarray(1) = Keyarray(2) Then
       If Keyarray(2) = Keyarray(3) Then
                  '  If Buzzertoggle = 0 then
                      Sound Speaker , 1 , 65000
                           Keypressed = Key
                           Gosub Showpressedkey
                           Tijdcount = 0
       End If
   End If
 End If
Return

Showpressedkey:                                             'Routine for "animated" buttons
Select Case Keypressed
Case 12
   Showpic 0 , 33 , Knopin
     Waitms Buttonreturndelay
   Showpic 0 , 33 , Knop
Case 13
   Showpic 0 , 65 , Knopin
     Waitms Buttonreturndelay
   Showpic 0 , 65 , Knop
Case 14
   Showpic 0 , 97 , Knopin
     Waitms Buttonreturndelay
   Showpic 0 , 97 , Knop
Case 22
   Showpic 61 , 33 , Knopin
     Waitms Buttonreturndelay
   Showpic 61 , 33 , Knop
Case 23
   Showpic 61 , 65 , Knopin
     Waitms Buttonreturndelay
   Showpic 61 , 65 , Knop
Case 24
   Showpic 61 , 97 , Knopin
     Waitms Buttonreturndelay
   Showpic 61 , 97 , Knop
Case 32
   Showpic 121 , 33 , Knopin
     Waitms Buttonreturndelay
   Showpic 121 , 33 , Knop
Case 33
   Showpic 121 , 65 , Knopin
     Waitms Buttonreturndelay
   Showpic 121 , 65 , Knop
Case 34
   Showpic 121 , 97 , Knopin
     Waitms Buttonreturndelay
   Showpic 121 , 97 , Knop
Case 42
Showpic 181 , 33 , Knopin
     Waitms Buttonreturndelay
   Showpic 181 , 33 , Knop
Case 43
Showpic 181 , 65 , Knopin
     Waitms Buttonreturndelay
   Showpic 181 , 65 , Knop
 Case 44
Showpic 181 , 97 , Knopin
     Waitms Buttonreturndelay
   Showpic 181 , 97 , Knop
End Select
Return

Showbasisknoppen:
Showpic 0 , 33 , Knop
Showpic 0 , 65 , Knop
Showpic 0 , 97 , Knop
Showpic 61 , 33 , Knop
Showpic 61 , 65 , Knop
Showpic 61 , 97 , Knop
Showpic 121 , 33 , Knop
Showpic 121 , 65 , Knop
Showpic 121 , 97 , Knop
Showpic 181 , 33 , Knop
Showpic 181 , 65 , Knop
Showpic 181 , 97 , Knop
Return

Readtouch:
Config Pinf.0 = Output
Config Pinf.2 = Output
Set Portf.0
Reset Portf.2
Ddrf.1 = 0 : Portf.1 = 1
Ddrf.3 = 0 : Portf.3 = 1
Waitms 20
Y = Getadc(3)
Y = 1024 - Y
'Locate 4 , 2 : Lcd "WAARDE X ; " ; X : Waitms 200
Config Pinf.1 = Output
Config Pinf.3 = Output
Set Portf.1
Reset Portf.3
Ddrf.0 = 0 : Portf.0 = 1
Ddrf.2 = 0 : Portf.2 = 1
Waitms 20
X = Getadc(2)
X = 1024 - X
'locate 4 , 2 : Lcd "WAARDE Y ; " ; Y :waitms 200
Return



Foutje:
Sound Speaker , 2 , 65000
Waitms 50
Return


Headerhoofdmenu:
$bgf "..\TouchbuttonsLarge\HeaderHoofdmenu.bgf"
Hhoofdmenu2:
$bgf "..\TouchbuttonsLarge\HHoofdmenu2.bgf"
Hjalvoor:
$bgf "..\TouchbuttonsLarge\HJalVoor.bgf"
Hwandmeubel:
$bgf "..\TouchbuttonsLarge\HWandmeubel.bgf"
Knop:
$bgf "..\TouchbuttonsLarge\knop.bgf"
Knopin:                                                     'Button pressed in
$bgf "..\TouchbuttonsLarge\knopin.bgf"
Leeg:
$bgf "..\TouchbuttonsLarge\Leeg.bgf"
Autoprog:
$bgf "..\TouchbuttonsLarge\Autoprog.bgf"
Lichtsalontafel:
$bgf "..\TouchbuttonsLarge\Lichtsalontafel.bgf"
Lichteettafel:
$bgf "..\TouchbuttonsLarge\Lichteettafel.bgf"
Lichtkeuken:
$bgf "..\TouchbuttonsLarge\LichtKeuken.bgf"
Lichttuin:
$bgf "..\TouchbuttonsLarge\LichtTuin.bgf"
Schemerlamp:
$bgf "..\TouchbuttonsLarge\Schemerlamp.bgf"
Jalvoor:
$bgf "..\TouchbuttonsLarge\Jalvoor.bgf"
Jalachter:
$bgf "..\TouchbuttonsLarge\JalAchter.bgf"
Wandmeubel:
$bgf "..\TouchbuttonsLarge\Wandmeubel.bgf"
Versterker:
$bgf "..\TouchbuttonsLarge\Versterker.bgf"
Pijlrechts:
$bgf "..\TouchbuttonsLarge\Pijlrechts.bgf"
Pijllinks:
$bgf "..\TouchbuttonsLarge\Pijllinks.bgf"
Pijlomhoog:
$bgf "..\TouchbuttonsLarge\Pijlomhoog.bgf"
Pijlomlaag:
$bgf "..\TouchbuttonsLarge\Pijlomlaag.bgf"
Jalvf1:
$bgf "..\TouchbuttonsLarge\JalvF1.bgf"
Jalvf2:
$bgf "..\TouchbuttonsLarge\JalvF2.bgf"
Jalvf3:
$bgf "..\TouchbuttonsLarge\JalvF3.bgf"
Jalvf4:
$bgf "..\TouchbuttonsLarge\JalvF4.bgf"
Esc:
$bgf "..\TouchbuttonsLarge\Esc.bgf"
Stopbutton:
$bgf "..\TouchbuttonsLarge\Stopbutton.bgf"
F1:
$bgf "..\TouchbuttonsLarge\F1.bgf"
F2:
$bgf "..\TouchbuttonsLarge\F2.bgf"
F3:
$bgf "..\TouchbuttonsLarge\F3.bgf"
F4:
$bgf "..\TouchbuttonsLarge\F4.bgf"
Linkerdeurup:
$bgf "..\TouchbuttonsLarge\Linkerdeurup.bgf"
Linkerdeurdown:
$bgf "..\TouchbuttonsLarge\Linkerdeurdown.bgf"
Rechterdeurup:
$bgf "..\TouchbuttonsLarge\Rechterdeurup.bgf"
Rechterdeurdown:
$bgf "..\TouchbuttonsLarge\Rechterdeurdown.bgf"
Beidedeurenup:
$bgf "..\TouchbuttonsLarge\Beidedeurenup.bgf"
Beidedeurendown:
$bgf "..\TouchbuttonsLarge\Beidedeurendown.bgf"
Ledsaan:
$bgf "..\TouchbuttonsLarge\Ledsaan.bgf"
Ledsuit:
$bgf "..\TouchbuttonsLarge\Ledsuit.bgf"
Graphic fonts

We know the Bascom font files from the graphic display with a KS108 controller. These controllers don’t have a build in font set, so Bascom creates the font by software and writes the letters pixel by pixel on the screen. We can create or modifier those fonts with the Font generator that’s build in Bascom. With this we have a limited flexibility .

The displays with a T6963 have build in font generator for the size 6×8 or 8×8. Custom fonts like the Euro sign or Greek letters is not (easy) to implement, larger or smaller fonts are also not possible with the build in fonts.

But now we have a routine that’s using the Bascom font files and can be used with all the graphics display supported by Bascom.

You can create your own font (share it with us please) or use one of the font’s supplied with Bascom.

All of the font’s can be inverted and/or rotated in 4 directions.

With the Bascom Locate statement it was not possible to place the text anywhere on the screen. Locate uses an 8×8 matrix to place the text. This routine uses a 1×1 matrix, so you can place the text precise under you graphic image etc.

 

Syntax

Lcdtext string, x , y , fontset , inverse , rotation

Remarks

 String  String to be displayd
 x  Constant or variable with x position.
 y  Constant or variable with y position.
 fontset  Fontset to be used to display the text
 Inverse  0= Normal 1= Inverted
 Rotation  0= Normal , 1=90 deg. 2=180 deg. 3=240 deg.

 

 

 

 

 

 

 

To add or remove fontsets modify these lines in the subroutine;

If Fontset = 1 Then Restore Font8x8
If Fontset = 2 Then Restore Font16x16
If Fontset = 3 Then Restore Font6x8
If Fontset = 4 Then Restore Font5x5
Sorry, but there was no better solution.

These are the name’s that you gave to the font, NOT the filename if you don’t know the font name, open the font file in the font editor, and there it is, right on top.

Don’t forget to $Include your font files at the end of the program.

 

Here are some sample’s created with the demo program.

Ks108
Ks108
T6963c
T6963c
Color display
Color display
PlayPause
previous arrow
next arrow
 
Ks108
Ks108
T6963c
T6963c
Color display
Color display
previous arrow
next arrow

 

Download it all here

Note : Due a bug in Bascom 1.11.8.8  it’s not possible to use fonts 32×32 or bigger.

Update 1:
Color version is now also available. Designed it for the popular Nokia 6100 displays, but it should work on every colordisplay supported by bascom.

Download the color version

Update 2:
Got mail from Mladen Bruck how lifes in Mostar, Bosnia and Herzegowine.
He optimized the graphicfont code and it should works now 10-15% faster.
Thanks for your contribution Mladen !
Download the optimized version here

 

'------------------------------------------------------------------
'                           GRAPHIC FONT
'     Use the Bascom font file's for all the graphic display's,
'              include inverted and/or rotated text.
'        By Evert Dekker 2007 GraphicFont@Evertdekker dotje com
'                   Created with Bascom-Avr: 1.11.8.8
'------------------------------------------------------------------

$regfile = "m128def.DAT"
$crystal = 7372800
$baud = 19200
$hwstack = 100
$swstack = 120
$framesize = 100

Config Graphlcd = 240 * 128 , Dataport = Porta , Controlport = Portc , Ce = 3 , Cd = 0 , Wr = 2 , Rd = 1 , Reset = 4 , Fs = 5 , Mode = 6
Cursor Off
Cls


Declare Sub Lcdtext(byval S As String , Byval Xoffset As Byte , Byval Yoffset As Byte , Byval Fontset As Byte , Byval Inverse As Byte , Byval Rotation As Byte)
'SYNTAX  Lcdtest String , Xoffset , Yoffset , Fontset , Inverse , Rotation
'
'* Xoffset and Yoffset is in pixels, so you can place text on every spot on the display
'* You determin yourself in the subroutine witch font belongs to the fontset


'=== Your main prog here ====
Do
Lcdtext "5X5 Font" , 10 , 2 , 4 , 0 , 0
Lcdtext "8X8 Font" , 2 , 120 , 2 , 1 , 3
Lcdtext "6X8 Font" , 10 , 20 , 3 , 0 , 0
Lcdtext "16X16 font" , 10 , 30 , 2 , 0 , 0
Lcdtext "Inverted" , 10 , 85 , 2 , 1 , 0
Lcdtext "If you can't read this then incr. Swstack" , 1 , 120 , 4 , 0 , 0
Wait 10
Cls
Lcdtext "0 deg.Rotation" , 10 , 10 , 1 , 0 , 0
Lcdtext "90 deg.Rotation" , 170 , 1 , 1 , 0 , 1
Lcdtext "180 deg.Rotation" , 120 , 20 , 1 , 0 , 2
Lcdtext "270 deg.Rotation" , 200 , 120 , 1 , 0 , 3
Lcdtext "Also inverted" , 150 , 80 , 1 , 1 , 2
Lcdtext "Every font" , 150 , 100 , 2 , 0 , 2
Wait 10
Cls
Loop
End



'=== Sub Routines ===
Sub Lcdtext(byval S As String , Xoffset As Byte , Yoffset As Byte , Fontset As Byte , Inverse As Byte , Rotation As Byte)
Local Tempstring As String * 1 , Temp As Byte               'Dim local the variables
Local A As Byte , Pixels As Byte , Count As Byte , Carcount As Byte , Lus As Byte
Local Row As Byte , Byteseach As Byte , Blocksize As Byte , Dummy As Byte
Local Colums As Byte , Columcount As Byte , Rowcount As Byte , Stringsize As Byte
Local Xpos As Byte , Ypos As Byte , Pixel As Byte , Pixelcount As Byte
If Inverse > 1 Then Inverse = 0                             'Inverse can't be greater then 1
If Rotation > 3 Then Rotation = 0                           'There are only 4 rotation's
Stringsize = Len(s) - 1                                     'Size of the text string -1 because we must start with 0
For Carcount = 0 To Stringsize                              'Loop for the numbers of caracters that must be displayed

 If Fontset = 1 Then Restore Font8x8                        'Add or remove here fontset's that you need or not,
 If Fontset = 2 Then Restore Font16x16                      'this is the name that you gave to the font, NOT the filename
 If Fontset = 3 Then Restore Font6x8                        'If you dont know the name, open the font file in wordpad, and there it is,
 If Fontset = 4 Then Restore Font5x5                        'right on top.

 Temp = Carcount + 1                                        'Cut the text string in seperate caracters
Tempstring = Mid(s , Temp , 1)
Read Row : Read Byteseach : Read Blocksize : Read Dummy     'Read the first 4 bytes from the font file
Temp = Asc(tempstring) - 32                                 'Font files start with caracter 32
For Lus = 1 To Temp                                         'Do dummie read to point to the correct line in the fontfile
   For Count = 1 To Blocksize
    Read Pixels
   Next Count
Next Lus
Colums = Blocksize / Row                                    'Calculate the numbers of colums
Row = Row * 8                                               'Row is always 8 pixels high = 1 byte, so working with row in steps of 8.
Row = Row - 1                                               'Want to start with row=0 instead of 1
Colums = Colums - 1                                         'Same for the colums
Select Case Rotation
    Case 0                                                  '0 degrees rotation
            For Rowcount = 0 To Row Step 8                  'Loop for numbers of rows
                  A = Rowcount + Yoffset
                  For Columcount = 0 To Colums              'Loop for numbers of Colums
                      Read Pixels : If Inverse = 1 Then Toggle Pixels       'Read the byte from the file and if inverse = true then invert de byte
                      Xpos = Columcount                     'Do some calculation to get the caracter on the correct Xposition
                      Temp = Carcount * Byteseach
                      Xpos = Xpos + Temp
                      Xpos = Xpos + Xoffset
                          For Pixelcount = 0 To 7           'Loop for 8 pixels to be set or not
                             Ypos = A + Pixelcount          'Each pixel on his own spot
                             Pixel = Pixels.0               'Set the pixel (or not)
                             Pset Xpos , Ypos , Pixel       'Finaly we can set the pixel
                             Shift Pixels , Right           'Shift the byte 1 bit to the right so the next pixel comes availible
                          Next Pixel
                  Next Columcount
            Next Rowcount
    Case 1                                                  '90 degrees rotation
            For Rowcount = Row To 0 Step -8                 'Loop is now counting down
                  A = Rowcount + Xoffset
                  A = A - 15                                'Correction to set Xpos on Xoffset with rotation
                  For Columcount = 0 To Colums
                      Read Pixels : If Inverse = 1 Then Toggle Pixels
                      Xpos = Columcount
                      Temp = Carcount * Byteseach
                      Xpos = Xpos + Temp
                      Xpos = Xpos + Yoffset                 'We want that Xoffset is still Xoffset, so we need here the change from x to y
                             For Pixelcount = 7 To 0 Step -1
                                Ypos = A + Pixelcount
                                Pixel = Pixels.0
                                Pset Ypos , Xpos , Pixel
                                Shift Pixels , Right
                             Next Pixel
                  Next Columcount
            Next Rowcount
    Case 2                                                  '180 degrees rotation
            For Rowcount = Row To 0 Step -8
                  A = Rowcount + Yoffset
                  A = A - 7                                 'Correction to set Xpos on Xoffset with rotation
                  For Columcount = Colums To 0 Step -1
                      Read Pixels : If Inverse = 1 Then Toggle Pixels
                      Xpos = Columcount
                      Temp = Carcount * Byteseach
                      Xpos = Xpos - Temp
                      Xpos = Xpos - 8                       'Correction to set Xpos on Xoffset with rotation
                      Xpos = Xpos + Xoffset
                          For Pixelcount = 7 To 0 Step -1
                             Ypos = A + Pixelcount
                             Pixel = Pixels.0
                             Pset Xpos , Ypos , Pixel
                             Shift Pixels , Right
                          Next Pixel
                  Next Columcount
            Next Rowcount
    Case 3                                                  '270 degrees rotation
            For Rowcount = 0 To Row Step 8
                  A = Rowcount + Xoffset
                    For Columcount = Colums To 0 Step -1
                      Read Pixels : If Inverse = 1 Then Toggle Pixels
                      Xpos = Columcount
                      Temp = Carcount * Byteseach
                      Xpos = Xpos - Temp
                      Xpos = Xpos - 8                       'Correction to set Xpos on Xoffset with rotation
                      Xpos = Xpos + Yoffset
                             For Pixelcount = 0 To 7
                                Ypos = A + Pixelcount
                                Pixel = Pixels.0
                                Pset Ypos , Xpos , Pixel
                                Shift Pixels , Right
                             Next Pixel
                  Next Columcount
            Next Rowcount
End Select
Next Carcount
End Sub                                                     'End of this amazing subroutine


'=== Includes ===
$include "Font8x8.font"                       'Includes here your font files
$include "Font16x16.font"                     'If you don't need the files in your program, don't include them,
$include "Font6x8.font"                       'these are flash memory eaters.
$include "Font5x5.font"