'pcm10
'Michael Ogden
'October 2017
'PicroMite Basic Module
'Original web interrupt and webparse code by matherp of "thebackshed.com"
'
'v0.5
'v.6 added protection for out of bounds errors
'v0.7 added mmm (messaging) function
'v0.8 added UDP function
'v0.9 add Init routines for UDP and WEB to tidy up Headers
'v1.0 Named Core Module for Picromite (pcmxx), specific program function to be built on top
'functions, UDP, Web, 1 sec Tick Timer

'Core Module Declares
option explicit
option default none
const cmver=1.0
const RedLed=40
dim casetemp$ 'pin15
dim ambtemp$ 'pin36
dim systemp$ 'cpu temp
dim integer secs
Dim temp%(10)
dim otemp$,ohum$,pres$,wind$,gust$,wdir$
dim netip$
'Initialise Modules
'udp
initUDP
'web
initWeb
'

dim integer flag(20)
'interupts
Settick 1000 ,T1,1 'establish seconds "Tick Timer"
'Define I/O
setpin Redled,dout 'act led
'init I/O
pin(Redled)=0


'nominate flags
'flag1=
'flag2=
'flag3= sensors


'
'Start
Print "Core Module Ver: ";cmver
'main program loop
Do

if flag(3)=1 then
flag(3)=0
sensors
end if

'udp test

UDP receive u1$,u2$,u3%
if u3%>0 then
print u1$,u2$,u3%
if u3%>0 and instr(u1$,"node=Weather")>0 then
parseWeather
end if
end if
Loop
end

'**************** Core Module *****************************
'***************** General routines ***********************
'T1 - 1second Tick interrupt
Sub T1
Pulse RedLed, 100
secs=secs+1 'update seconds timer

' sensors flag 5 seconds
if secs mod 10 = 0 then
flag(3)=1
end if
'
' if secs mod 15 = 0 then
' flag(4)=1
' end if
'
' if secs mod 60 = 0 then
' flag(5)=1
' end if
End Sub

sub sensors

casetemp$=str$(tempr(15),2,1)+ " "+chr$(96)+"C"
ambtemp$=str$(tempr(36),2,1)+ " "+chr$(96)+"C"
systemtemp

print casetemp$
print ambtemp$
print systemp$
print pres$

end sub

sub systemtemp
local l%
system "/opt/vc/bin/vcgencmd measure_temp",temp%()
systemp$=lgetstr$(temp%(),1,llen(temp%()))
systemp$=mid$(systemp$,6)
l%=len(systemp$)
systemp$=str$(val(left$(systemp$,l%-3)),2,1)+ " "+chr$(96)+"C"
longstring clear temp%()
end sub

' sub netstatus
' local l%
' system "sudo ip addr show",temp%()
' netip$=lgetstr$(temp%(),1,llen(temp%()))
' 'systemp$=mid$(systemp$,6)
' 'l%=len(systemp$)
' 'systemp$=left$(systemp$,l%-3)
' longstring clear temp%()
' print netip$
' end sub

sub UserArgs
local x%
for x%= 0 to 3
print arg$(1,x%)
next x%
if pg$="" then pg$="OK"
end sub

sub parseweather
'Otemp,Ohum,pres,wind,gust
otemp$=str$(val(mid$(parse$(u1$,3,"&"),4)),2,1)+ " "+chr$(96)+"C"
ohum$=str$(val(mid$(parse$(u1$,4,"&"),4)),2,1)+ " "+ "%"
pres$=str$(val(mid$(parse$(u1$,5,"&"),4)),4,1)+ " "+ "hPa"
wind$=str$(val(mid$(parse$(u1$,6,"&"),4)),2,1)+ " "+"km/h"
gust$=str$(val(mid$(parse$(u1$,7,"&"),4)),2,1)+ " "+"km/h"
wdir$=str$(val(mid$(parse$(u1$,10,"&"),4)),3,1)+ " "+ "degrees"
end sub



function IsFile%(fl$)
IsFile%=0
if dir$(fl$,File)<>"" then IsFile%=1 'check for file exists
end function

'********************************* string routines *****************************

Function parse$(s$,FieldNumber%,d$) as string
Local String stringArg$
Local Integer intOldY,intY,intX
print s$;" ";fieldnumber%;" ";d$
if d$="" then
d$=","
endif
on error skip
StringArg$ = S$ + d$
'if ChkErr()>0 then exit function
intOldY = 1:intX=0:intY=0
Parse$ = ""
do While intY < Len(StringArg$) And intX < FieldNumber%
intY = Instr(intOldY, StringArg$, d$)
intX = intX + 1
If intX = FieldNumber% Then
parse$ = Mid$(StringArg$, intOldY, intY - intOldY)
Endif
intOldY = intY + 1
loop
'print s$; intx; inty; intoldy
'print fieldnumber%;" ";parse$
End Function

Function Ltrim(sString As String)As String
ltrim=Str$(Val(sString))
End Function


'replaceString$(string$, replaceWhat$, replaceWith$)
FUNCTION replace$(R$, a$, b$) as string
local integer i,j,c,d
d=1
replace$=R$
i = LEN(a$) : j = LEN(b$)
do while INSTR(d,replace$, a$) > 0
c = INSTR(d,replace$, a$)
replace$ = LEFT$(replace$, c-1) + b$ + MID$(replace$, c+i)
d = c+j
loop
END FUNCTION

'********************************* Web routines *****************************

sub InitUdp
dim u1$,u2$
dim u3%
on error skip
udp close
udp server 5001
end sub

sub InitWeb
dim integer maxargs = 32
Dim a%(1000),i%
Dim s$,pg$
Dim security$="123456"
Dim arg$(1,maxargs-1)
Open "socket,data_arrival,100" As #2
transmit code 404 'clear socket
end sub

'data arrival
Sub data_arrival
Local p%=0, t%=0
Local g$,n$
print "Buffer:";loc(2)
Do While Not Eof(2) 'read the data from socket
n$=Input$(10,2)
print "data arrival:";n$
LongString append a%(),n$
Loop
p%=LInStr(a%(),"GET",1) 'check for GET and HTTP
t%=LInStr(a%(),"HTTP",1)
print "Header Get/Http:";p%;"/";t%
If p%<>0 And t%<>0 Then 'full request received
if t%=<p% then goto response 'P% must be larger than t%
s$=LGetStr$(a%(),p%,t%-p%+4)'filter out request string
print s$
LongString trim a%(),t%+4 'trim off used portion, keep the rest in buffer
pg$= parserequest$(s$,i%) 'Parse request
If i% Then 'there are arguments
if security$<>"" then 'if there is a security password
If arg$(0,0)="Security" And arg$(1,0)<>security$ Then 'Not valid update
pg$=""
goto Response
end if
EndIf
UserArgs
EndIf
'
Response:
print "Page:";pg$
if pg$="OK" then
print #2,"OK"
transmit noheader
exit sub
else
if isFile%(pg$)=0 then pg$="" 'file not found
end if
If Instr(pg$,"flavicon") Then
Transmit FILE pg$,"image/vnd.microsoft.icon"
Else If Instr(pg$,".css") Then
Transmit FILE pg$,"text/css"
Else If Instr(pg$,".jpg") Then
Transmit file pg$,"image/jpeg"
Else if Instr(pg$,".html") then
Transmit PAGE pg$
Else
Transmit code 404
End If
end if
End Sub


'Function to parse an HTML GET request'
' Assumes that the request starts with "GET /"
' and ends with "HTTP"
'
Function parserequest$(req$, paramcount As integer)
Local a$,b$
Local integer inpos,startparam,processargs,isequal
For inpos=0 To maxargs-1
arg$(0,inpos)=""
arg$(1,inpos)=""
Next inpos
paramcount=0
a$=Mid$(req$,6,Len(req$)-10) 'starts from char after GET / , ends before HTTP
inpos=Instr(a$,"?")
isequal=Instr(a$,"=")
If inpos>0 and isequal>0 Then 'parameters found both ? and =
print "Arguments ...."
processargs=1
parserequest$=Left$(a$,inpos-1)
a$=Mid$(a$,inpos+1) 'get rest of line after ?
Do 'loops through recovering args and values
arg$(0,paramcount)=""
arg$(1,paramcount)=""
inpos=Instr(a$,"=")
startparam=1
if inpos=0 then exit do 'finished
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
parserequest$=a$
print "parserequest:";a$
EndIf

If a$="" Then
parserequest$="index.html"
end if
' If Instr(parserequest$,".html")=0 And Instr(parserequest$,".HTML")=0 Then 'add html if missing
' parserequest$=parserequest$+".html"
' end if

End Function