TheBackShed.com

Option explicit
option default integer
const MaxLen=4096
const max=20

' Global variables
const quote=chr$(34)
CONST SSID$=quote+"mySSID"+quote
CONST SSIDPassword$=quote+"myPASSWORD"+quote
'
const crlf$=chr$(13)+chr$(10)
const header$="<!DOCTYPE html>"
const starttext$="HTTP"
const pnf$="<html><body>Page not Found</body></html>"
const title$="<html><meta charset="+quote+"UTF-8"+quote+"><head><title>Remote Thermostat</title></head><body>"
const ending$="</form></body></html>"
const form$="<form name='f1' method='get' action='D'>"
const h2$="<h2 align='left'>Remote Thermostat V3.0</h2>"
const code$="Update Code: <input type='text' name='S' size='6' value='000000'><br>"
const tstart$="<p><TABLE BORDER='1' CELLSPACING='0' CELLPADDING='5'>"
const heat$="<TR><TD>Heating</TD>"
const hon$="<TD BGCOLOR='#ff0000'> On</TD></TR>"
const hoff$="<TD BGCOLOR='#00ff00'>Off</TD></TR>"
const tend$="</TABLE></p>"
const h3$="<TR><TD></TD><TD>Temperature</TD></TR>"
const s1$="<TR><TD>Current</TD><TD>"
const s2$="<TR><TD>Max</TD><TD>"
const s3$="<TR><TD>Min</TD><TD>"
const check$="<input name='C' type='checkbox' value='R' onClick='this.form.submit()'> Reset Max/Min"
const s4$="<TR><TD>Thermostat</TD>"
const s5$="<TD><input name='R' type='radio' checked='checked' value='"
const s6$="<TD><input name='R' type='radio' value='"
const click$=" 'onClick='this.form.submit()'> "
const degree$="C<br></TD>"
const offstr$="Off<br></TD>"
const onstr$="On<br></TD>"
const ON=1
const off=0
'
' Set up parameters
'
const starttemp=20 'set the lowest temperature on the thermostat select radio buttons
const hysteresis=2 ' 2 tenths of a degree either side of the setpoint
const waittime=1000 'wait time in readrequest before timeout
const password$="123456" 'password to access change mode

'
const dspin=42
const relaypin=5
'
Dim arg$(2,max) length 20
DIM integer inbuf(Maxlen\8) 'global input buffer

dim integer IPDno 'global IPD numbers used to ensure transmit is on correct IPD
dim integer heater,currenttemp,maxtemp,mintemp,setpoint
dim integer nparams
dim mypage$ 'variables used by main loop only
DIM integer obuff(2048\8) 'used to buffer writes to the internet to optimise speed

Init:
tempr start dspin,3 'measure temp to 0.0625 degree accuracy
mintemp=1000 'set to silly value to force reset if not saved
maxtemp=-1000
currenttemp=cint(tempr(dspin)*10)
tempr start dspin,3
var restore 'recover the setpoint and min and max temps if already saved
maxmin 'update the maximum and minimum and save them if changed
heater=off
pin(relaypin)=heater
setpin relaypin,dout
setpoint=asc("E")
pause 2000 'wait for ESP8266 to wake up afer power on
open "com2:115200,4096" as #1
close #1 'clear the buffer
open "com2:115200,4096" as #1
IF NOT Command(0, "AT",obuff(), 500) THEN END
IF NOT Command(0, "AT+RST",obuff(), 10000,"WIFI GOT IP") THEN 'reset and check for valid connection
PRINT "Set up WIFI on SSID: ",SSID$
IF NOT Command(0, "AT+CWMODE_DEF=1",obuff(), 5000) THEN END 'set device mode (1=client, 2=AP, 3=both)
IF NOT Command(0, "AT+CWLAP",obuff(), 30000) THEN END 'scan for WiFi hotspots
longstring print inbuf() 'output the list of valid networks
IF NOT Command(0, "AT+CWJAP_DEF="+SSID$+","+SSIDPassword$,obuff(), 20000,"WIFI GOT IP") THEN END 'connect
IF NOT Command(0, "AT+CIFSR",obuff(), 5000) THEN END 'check IP address
ENDIF

IF NOT Command(0, "AT+CIPMUX=1",obuff(), 5000) THEN END
IF NOT Command(0, "AT+CIPSERVER=1,80",obuff(), 5000) THEN END
Print "Connected"

main:
DO
currenttemp=cint(tempr(dspin)*10)
updateheater
tempr start dspin,3
maxmin 'update the maximum and minimum and save them if changed
if ReadRequest(waittime) then 'process HTML request
mypage$=ucase$(parsehtmldata$(nparams)) 'parse the html request and get the page requested
if mypage$<>"" then 'real request so do something
if mypage$= "INDEX" then
drawpage
elseif mypage$="D" then
if nparams<>0 then 'we have parameters to process
if arg$(0,0)="S" and arg$(1,0) = password$ then
if arg$(0,1)="C" and arg$(1,1)="R" then 'reset the max min to current
maxtemp=currenttemp
mintemp=currenttemp
var save setpoint,maxtemp,mintemp
endif
if arg$(0,1)="R" then 'change the setpoint and update the heater if applicable
setpoint=asc(arg$(1,1))
var save setpoint,maxtemp,mintemp
updateheater
endif
endif
endif
drawpage
else
SendText pnf$+crlf$+crlf$'invalid page
endif
EndSend 'clear the write buffer and terminate the write
endif
endif
LOOP
end
'
Function parsehtmldata$(paramcount as integer)
local a$,b$
local integer buf(Maxlen\8)
local integer inpos,startparam,processargs
paramcount=0
inpos=lInstr(inbuf(),"GET /",1)
if inpos=0 then
parsehtmldata$=""
else
longstring mid buf(),inbuf(),inpos+5,1000
inpos=lInstr(buf(),starttext$,1)
If inpos>2 Then 'page request found
inpos=inpos-2
a$=lGetStr$(buf(),1,inPos)
inpos=Instr(a$,"?")
If inpos<>0 Then 'parameters found
processargs=1
parsehtmldata$=Left$(a$,inpos-1)
a$=Mid$(a$,inpos+1)
Do
arg$(0,paramcount)=""
arg$(1,paramcount)=""
inpos=Instr(a$,"=")
startparam=1
arg$(0,paramcount)=Mid$(a$,startparam,inpos-startparam)
startparam=inpos+1
inpos=Instr(a$,"&")
If inpos<>0 Then
arg$(1,paramcount)=Mid$(a$,startparam,inpos-startparam)
a$=Mid$(a$,inpos+1)
paramcount=paramcount+1
Else
arg$(1,paramcount)=Mid$(a$,startparam)
paramcount=paramcount+1
processargs=0
EndIf
Loop while processargs
Else
parsehtmldata$=a$
EndIf
Else ' no page requested
parsehtmldata$="INDEX"
EndIf
endif
End Function

sub maxmin
local integer update=off
if currenttemp>maxtemp then
maxtemp=currenttemp
update=on
endif
if currenttemp<mintemp then
mintemp=currenttemp
update=on
endif
if update then var save setpoint,maxtemp,mintemp
end sub

sub updateheater
local integer hcalc
if setpoint=asc("L") then
pin(relaypin)=ON
heater=on
endif
if setpoint=asc("A") then
pin(relaypin)=OFF
heater=oFF
endif
if setpoint>=asc("B") and setpoint<=asc("K") then
hcalc=(setpoint-asc("B")+starttemp)*10 'setpoint temperature * 10
hcalc = hcalc + hysteresis
if currenttemp>=hcalc then 'turn heating off
pin(relaypin)=OFF
heater=oFF
endif
hcalc = hcalc - hysteresis - hysteresis
if currenttemp<=hcalc then 'turn heating on
pin(relaypin)=ON
heater=oN
endif
endif
end sub

sub drawpage
local integer loopcounter,tempconvert
local b$
sendText header$
sendText title$+form$+h2$+code$
sendText tstart$+heat$
if heater then
sendText hon$+tend$
else
sendText hoff$+tend$
endif
sendText tstart$
sendText h3$
b$=s1$+outtemp$(currenttemp)+degree$
b$=b$+s2$+outtemp$(maxtemp)+degree$
b$=b$+s3$+outtemp$(mintemp)+degree$
sendText b$
sendText tend$
sendText check$
sendText tstart$
sendText s4$
for loopcounter=asc("A") to asc("L")
if loopcounter=setpoint then
sendText s5$+chr$(loopcounter)
else
sendText s6$+chr$(loopcounter)
endif
sendText click$
tempconvert=loopcounter-asc("B")+starttemp
if loopcounter>asc("A") and loopcounter<asc("L") then sendText str$(tempconvert,2)+degree$
if loopcounter=asc("A") then sendText offstr$
if loopcounter=asc("L") then sendText onstr$
next loopcounter
sendText tend$
sendText ending$+crlf$+crlf$
end sub
'
function outtemp$(t as integer)
local integer tenths=t mod 10
local integer units= t\10
outtemp$=str$(units,3)+"."+chr$(tenths+48)
end function
'
sub EndSend
local b$
pause 25
b$="AT+CIPSEND="+CHR$(IPDno+48)+","+STR$(llen(obuff())) 'send anything still in the buffer
IF NOT Command(0,b$,obuff(), 500,">") THEN
if lInstr(inbuf(),"link is not valid") then exit sub
endif
IF NOT Command(1, b$, obuff(),500) THEN END
pause 25
IF NOT Command(0, "AT+CIPCLOSE="+CHR$(IPDno+48),obuff(), 500) THEN
if lInstr(inbuf(),"UNLINK") then
longstring clear obuff()
exit sub
else
end
endif
endif
longstring clear obuff()
end sub

sub SendText(a$)
local b$
if len(a$)+llen(obuff())< 2048 then 'add the new string to the output buffer
longstring append obuff(),a$
else 'too big to fit so send the current output buffer
pause 25
b$="AT+CIPSEND="+CHR$(IPDno+48)+","+STR$(llen(obuff()))
IF NOT Command(0,b$,obuff(),1000,">") THEN
if lInstr(inbuf(),"link is not valid") then exit sub
endif
IF NOT Command(1, b$, obuff(),1000) THEN END
longstring clear obuff()
longstring append obuff(),a$
endif
end sub
'
FUNCTION ReadRequest(timeout%) as integer
ReadRequest=0
longstring Clear inbuf()
timer=0
do while TIMER<timeout% and LOC(#1)=0
loop
if TIMER>=timeout% then exit function
do while loc(#1)<>0
longstring append inbuf(),input$(min(255,loc(#1)),#1)
loop
if (NOT lInstr(inbuf(),"favicon",0)) and (NOT lInstr(inbuf(),"CONNECT FAIL",1)) then ReadRequest=1 'junk the favicon requests and disconnects
IF lInstr(inbuf(),"IPD,0",1) then IPDno=0
IF lInstr(inbuf(),"IPD,1",1) then IPDno=1
end function
'

end sub
'
FUNCTION Command(mode, AT$, outdata%(), timeout%, other$) as integer 'send a command and wait for the answer
local i%=0,j%,ex%=0
Local a$
Command=0
longstring Clear inbuf()
if mode=0 then
print #1,AT$+crlf$;
else
longstring print #1,obuff();
endif
TIMER=0
i%=0
do
if TIMER>timeout% then
ex%=0
EXIT DO
endif
j%=LOC(#1)
if j%>0 then
i%=i%+min(255,j%)
longstring append inbuf(),input$(min(255,j%),#1)
if llen(inbuf())>4 and other$="" then
if lInstr(inbuf(),"OK",1) then
ex%=1
exit DO
endif
endif
if llen(inbuf())>7 then
if lInstr(inbuf(),"ERROR",1) then
ex%=2
exit DO
endif
endif
if llen(inbuf())>len(other$)+2 then
if lInstr(inbuf(),other$,1) then
ex%=3
exit DO
endif
endif
endif
loop
select case ex%
case 0
Print "Timeout : "+AT$
case 1
Command=1
case 2
Print "ERROR : "+AT$
case 3
Command=1
end select
end function