Emisor:
' Program to create telephone pad tone
' Oscillator must be set to 20MHz
DEVICE = 16F628a
XTAL = 4
ALL_DIGITAL = TRUE
PORTB_PULLUPS = ON ' Enable PORTB pull-ups
LCD_DTPIN = PORTb.4
LCD_RSPIN = PORTa.0
LCD_ENPIN = PORTa.2
LCD_INTERFACE = 4 ' 4-bit Interface
LCD_LINES = 2
LCD_TYPE = 0
' Define program variables
Dim Col as Byte ' Keypad column
Dim Row as Byte ' Keypad row
Dim Key as Byte ' Key value
Dim Tone as Byte ' Tone number
dim XLCD as Byte
dim YLCD As Byte
dim Pitch as byte
dim Clave as Byte
dim Digitos as byte
dim Posicion as byte
dim Leer as byte
' Define program Symbol
Symbol Altavoz = PORTa.1 ' Alias speaker pin
Symbol Rele = porta.3
symbol Led = porta.4
'trisa=%11111111
Delayms 50 ' Estavilizacion LCD
' Comienza el programa ran-up
'********************1234567890123456
high Led
Print at 1,1,"Teclado / Clave "
Print at 2,1,"IBERICA 2000/1.0"
Delayms 2000
low led
cls
Cero: posicion = 0
digitos = 0
Inicio:
'*********************************************************************************
'*** Lee EEprom para conprovar que la memoria
'*** no se a escrito nunca y pide clave nueva
'*********************************************************************************
Leer = eread 0 'LEE EL LA EEPROM LA POSICION CERO
if Leer = $FF then Nueva 'COMPUEBA QUE VALE LA POSICION CERO
goto vieja 'SI VALE FF PIDE CLAVA NUEVA, SI NO VA A VIEJA
Nueva:
high Led
'********************1234567890123456
Print at 1,1,"Leyendo Memoria "
Print at 2,1," Codigo Activa "
Delayms 2000
cls
'********************1234567890123456
print at 1,1," Clave Nueva: "
print at 2,1,"> <"
xlcd=2
ylcd=2
Otra: 'SE GENERA UN BUCLE DE PARA INTRODUCIR 4 DIGITOS
For digitos = 0 to 3
Gosub Getkey
Lookup Tone,["0123456789*0#"],Key'
ewrite Posicion,[key] 'GRABA EN LA EEPROM LAS TECLAS PULSADAS
posicion = posicion +1 'INCREMENTA UNA POSICION EN LA EEPROM
Print at Xlcd,ylcd, Key 'INPRIMA EL LA LCD LA TECLA PULSADA
ylcd = ylcd +1 'INCREMENTA CURSOR A LA DERECHA
Dtmfout Altavoz, [Tone] 'GENERA TONO DE GRABACION
Next 'SALE DEL BUCLE
'****************** 1234567890123456
Print Cls, "CLAVE Grabada " '
print at 2,1,"En Memoria EEPro"
Dtmfout Altavoz, [12]
Delayms 2000
cls
Vieja:
high Led
'****************** 1234567890123456
Print Cls, " Teclea Clave"
print at 2,1,"> <"
xlcd = 2
ylcd = 2
Clave = 0
Digitos = 0
' Oprotunidad = 0
Posicion = 0
Loop:
if ylcd >= 17 then Inicio
Gosub Getkey ' Get a key from the keypad
Leer = eread Posicion
posicion = posicion + 1
Lookup Tone,["0123456789*0#"],Key
Print at Xlcd,ylcd,Key
if Leer = Key then Clave = Clave + 1
ylcd = ylcd +1
Dtmfout Altavoz, [Tone]
if ylcd = 6 then Compara
Goto Loop ' Do it forever
Compara:
if Clave = 4 Then Abre
Cierra:
'****************** 1234567890123456
print cls , "Acceso Denegado"
Dtmfout Altavoz, [3]
Delayms 2000
goto vieja
Abre: high Rele
print Cls , "Acceso Permitido"
For Pitch = 0 to 120
Sound Altavoz,[Pitch,1]
Next
Delayms 2000
low Rele
goto vieja
' Subroutine to get a key from keypad
Getkey:
Delayms 50 ' Debounce
Getkeyu:
' Wait for all keys up
PORTB = 0 ' All output pins low
TRISB = $f0 ' Bottom 4 pins out, top 4 pins in
If (PORTB >> 4) <> $0F Then Getkeyu ' If any keys down, loop
Delayms 50 ' Debounce
Getkeyp:
' Wait for keypress
For Col = 0 To 3 ' 4 columns in keypad
PORTB = 0 ' All output pins low
TRISB = (Dcd Col) ^ $FF ' Set one column pin to output
Row = PORTB >> 4 ' Read row
If Row <> $0F Then Gotkey ' If any keydown, exit
Next
Goto Getkeyp ' No keys down, go look again
' Change row and column to key number 0 - 15
Gotkey:
Key = (Col * 3) + (Ncd (Row ^ $0F)) -1
'Key = (Col * 3) + (Ncd (Row ^ $0F))
' Translate key to telephone keypad tone
' 10 = *
' 11 = #
' 12 = A
' 13 = B
' 14 = C
' 15 = D
Lookup Key,[1,2,3,4,5,6,7,8,9,10,11,12],Tone
Return ' Subroutine over
End
Receptor:
'****************************************************************
'* Name : emiTemp.BAS *
'* Author : Miguel Noe Garcia Perez *
'* Notice : Copyright (c) 2010 Iberica 2000 *
'* : All Rights Reserved *
'* Date : 10/03/2010 *
'* Version : 1.0 *
'* Notes : *
'* : *
'****************************************************************
Device 16F877a
XTAL = 4
' LCD pin Configuracion
lcd_type = 0
LCD_LINES = 4
LCD_DTPIN = PORTb.4
LCD_RSPIN = PORTb.3
LCD_ENPIN = PORTb.2
LCD_INTERFACE = 4
'***************************************************************************************
Cls ' Clear LCD
ALL_DIGITAL = True ' Set ports to digital mode
Clear ' Clear buffers
******************************************************************************************
'********************* SIMBOLOS DEL PROGRAMA *********************************************
'******************************************************************************************
' declare serial_Data 8
' ALL_DIGITAL = True
' PORTB_PULLUPS = ON
SYMBOL BaudMode = 16468
'*******************************************************************************************
'*************************** VARIABLES A$ **************************************************
'*******************************************************************************************
' Dim Index As Byte ' Variable de uso general
' Dim ROMCODE[8] As Byte ' Arreglo almacena el serial
' Dim SERIAL[8] As Byte ' Arreglo almacena serial
' Dim X As Word
' Dim Contador As Word
' Dim TEMPERATURA As Word ' Variable alm. temperatura
' Dim FL_TEMP As Float ' Variable alm. temperatura
' 'Dim FL_TEMP As word ' Variable alm. temperatur
DIM Cifra as byte
' Dim Sign as Byte
' Dim Cnt as Byte
' Dim Count_Per_Deg as Byte
Dim Temp as word
' Dim Temp_Dec as Byte
DIM Puntero AS BYTE
dim dato as byte
'**************************************************************************************
'******************************* TERMOMETRO *******************************************
'**************************************************************************************
' MAIN:
' GoSub Conversion ' Rutina convertir Temperatura
' GoSub Mostrar ' Rutina mostrar los valores
' DelayMS 500
' 'Gosub Text
' GoTo Main
' Conversion:
' OWrite DQ,1,[$CC,$44] ' Comando Convertir Temp
' 'gosub Resete
' High DQ ' DQ en alto por 750 ms
''******************* Tiempo de Conversion ************************
' 'DelayMS 200 'Nota: Para el DS 1820 200 ms y para el DS 18S20 750 ms
' OWrite DQ,1,[$CC,$BE] ' Comando leer SCRATCHPAD.
' 'ORead DQ,0,[TEMP.LowByte,TEMP.HighByte]
' OREAD DQ,2,[Temp.LOWBYTE,Temp.HIGHBYTE,Cnt,Cnt,Cnt,Cnt,Cnt,Count_Per_Deg] 'Lee el scratchpad
' Return
'Mostrar:
' Temp_Dec = (6.25 * Cnt)
' 'Signo:
' If Temp.8=1 Then
' Temp=(Temp.LowByte ^ $FF) >> 1
' If Cnt = 0 then Temp = Temp + 1
' Sign = "-"
' Else
' Temp=(Temp >> 1)
' Sign = " "
' Temp_Dec = 100 - Temp_Dec
' Endif
Temp=0
Inicio:
'Print at 1,1, "T="
'delayms 500
'Serin PORTd.3,19697,[dato] ' Display "Hello", next line
'serin portd.3,19697,[Dato]
'serin portd.2,16468,[Temp]
oread portd.2,3,[Temp]
'DatoTemp = Dato
delayms 1000
cls
Print at 1,1, "T= ", Dec Temp
goto inicio
'Print at 2,1, "T= ",dec TEMPERATURA
'**************************************************************************************
'********* TODO ESTO ES DE MI AMIGO TRIGO TODOS LOS DERECHOS SON DE TRIGO *************
'**************************************************************************************
'PRIMERO IMPRIMIMOS LAS DECENAS
Cifra = dig temp, 1 'Decenas de grado.
Puntero = 64 'Primer carácter de la CGRAM, numerado como 0
Gosub Que_cifra
print AT 1,9, 0,1
print AT 2,9, 2,3
'Y A CONTINUACIÓN LAS UNIDADES
Cifra = dig temp, 0 'Unidades de grado.
Puntero = 96 'Quinto carácter de la CGRAM, numerado como 4
Gosub Que_cifra
print AT 1,11, 4,5, "TEMP"
print AT 2,11, 6,7, "."',Dec DIG Temp_Dec, 1, 223 'el 223 es el símbolo de grado
'************************ e m i t e ***********************************************
'dato = temp
'serout portc.3,16468,[dato]
return
Que_cifra:
select Cifra.
case 0: gosub cero: RETURN 'Rutinas para crear los gráficos correspondientes a esas cifras en gran formato
CASE 1: GOSUB UNO: RETURN
CASE 2: GOSUB DOS: RETURN
CASE 3: GOSUB TRES: RETURN
CASE 4: GOSUB CUATRO: RETURN
CASE 5: GOSUB CINCO: RETURN
CASE 6: GOSUB SEIS: RETURN
CASE 7: GOSUB SIETE: RETURN
CASE 8: GOSUB OCHO: RETURN
CASE 9: GOSUB NUEVE: RETURN
ENDSELECT
goto inicio
'CARGANDO LOS CARACTERES PERSONALIZADOS EN LA CGRAM
CERO:
'SI:
Print 254,Puntero,$07,$0F,$1C,$18,$18,$18,$18,$18
'SD:
Print 254,Puntero + 8,$18,$1C,$0E,$06,$06,$06,$06,$06
'II:
Print 254,Puntero + 16,$18,$18,$18,$18,$18,$1C,$0F,$07
'ID:
Print 254,Puntero + 24,$06,$06,$06,$06,$06,$0E,$1C,$18
RETURN
UNO:
'SI:
Print 254,Puntero,$00,$00,$00,$01,$01,$00,$00,$00
'SD:
Print 254,Puntero + 8,$0C,$1C,$1C,$1C,$1C,$0C,$0C,$0C
'II:
Print 254,Puntero + 16,$00,$00,$00,$00,$00,$00,$00,$00
'ID:
Print 254,Puntero + 24,$0C,$0C,$0C,$0C,$0C,$0C,$1E,$1E
RETURN
DOS:
'SI:
Print 254,Puntero,$07,$0F,$1C,$18,$00,$00,$00,$00
'SD:
Print 254,Puntero + 8,$18,$1C,$0E,$06,$06,$06,$0E,$1C
'II:
Print 254,Puntero + 16,$01,$03,$07,$0E,$1C,$18,$1F,$1F
'ID:
Print 254,Puntero + 24,$18,$10,$00,$00,$00,$00,$1E,$1E
RETURN
TRES:
'SI:
Print 254,Puntero,$07,$0F,$1C,$18,$00,$00,$01,$01
'SD:
Print 254,Puntero + 8,$18,$1C,$0E,$06,$06,$0E,$1C,$18
'II:
Print 254,Puntero + 16,$00,$00,$00,$18,$18,$1C,$0F,$07
'ID:
Print 254,Puntero + 24,$1C,$0E,$06,$06,$06,$0E,$1C,$18
RETURN
CUATRO:
'SI:
Print 254,Puntero,$00,$00,$01,$01,$03,$03,$07,$06
'SD:
Print 254,Puntero + 8,$1C,$18,$18,$10,$10,$00,$00,$00
'II:
Print 254,Puntero + 16,$0E,$0C,$1C,$1F,$1F,$00,$00,$00
'ID:
Print 254,Puntero + 24,$0C,$0C,$0C,$1E,$1E,$0C,$0C,$0C
RETURN
CINCO:
'SI:
Print 254,Puntero,$1F,$1F,$18,$18,$18,$18,$1F,$1F
'SD:
Print 254,Puntero + 8,$1E,$1E,$00,$00,$00,$00,$18,$1C
'II:
Print 254,Puntero + 16,$00,$00,$00,$00,$18,$1C,$0F,$07
'ID:
Print 254,Puntero + 24,$0E,$06,$06,$06,$06,$0E,$1C,$18
RETURN
SEIS:
'SI:
Print 254,Puntero,$07,$0F,$1C,$18,$18,$18,$1B,$1F
'SD:
Print 254,Puntero + 8,$18,$1C,$0E,$06,$00,$00,$18,$1C
'II:
Print 254,Puntero + 16,$1C,$18,$18,$18,$18,$1C,$0F,$03
'ID:
Print 254,Puntero + 24,$0E,$06,$06,$06,$06,$0E,$1C,$18
RETURN
SIETE:
'SI:
Print 254,Puntero,$1F,$1F,$00,$00,$00,$00,$00,$01
'SD:
Print 254,Puntero + 8,$1E,$1E,$06,$0E,$0C,$1C,$18,$18
'II:
Print 254,Puntero + 16,$01,$03,$03,$07,$06,$0E,$0C,$0C
'ID:
Print 254,Puntero + 24,$10,$10,$00,$00,$00,$00,$00,$00
RETURN
OCHO:
'SI:
Print 254,Puntero,$07,$0F,$1C,$18,$18,$1C,$0F,$0F
'SD:
Print 254,Puntero + 8,$18,$1C,$0E,$06,$06,$0E,$1C,$18
'II:
Print 254,Puntero + 16,$1C,$18,$18,$18,$18,$1C,$0F,$03
'ID:
Print 254,Puntero + 24,$0E,$06,$06,$06,$06,$0E,$1C,$18
RETURN
NUEVE:
'SI:
Print 254,Puntero,$07,$0F,$1C,$18,$18,$18,$18,$1C
'SD:
Print 254,Puntero + 8,$18,$1C,$0E,$06,$06,$06,$06,$0E
'II:
Print 254,Puntero + 16,$0F,$07,$00,$00,$18,$1C,$0F,$07
'ID:
Print 254,Puntero + 24,$1E,$16,$06,$06,$06,$0E,$1C,$18
RETURN
Resete:
' REPEAT
' DELAYMS 25 ' Wait until conversion is complete
' OREAD DQ,4,[Cnt] ' Keep reading low pulses until
' UNTIL Cnt=0 ' the DS1820 is finished
Return
