! Acal Calorie Counter/Tracker for rfo-basic (BASIC!) ! !by C. Terpin !mookiebearapps@2018 ! HTML.OPEN 0 BUNDLE.CREATE g bundle.put g,"mode","h" FN.DEF ohno() IF !rset("speak") THEN FN.RTN 0 f=400 TONE f,300 TONE f*0.96,500 FN.END FN.DEF yahoo() IF !rset("speak") THEN FN.RTN 0 f=RND()*440+200 TONE f,300 TONE f*1.5,300 TONE f*1.33,300 TONE f*1.5,300 FN.END FN.DEF ToggleSetting(s$) !toggle setting s$ TRUE/FALSE wset(s$,!rset(s$)) FN.END FN.DEF waitclick$(main) cstart2=CLOCK() auto=rset("auto") DO wait() BUNDLE.GET 1,"home",b IF !b THEN D_U.BREAK HTML.GET.DATALINK data$ IF (CLOCK()-cstart2)>8000 IF main & auto THEN FN.RTN "QUIT" ENDIF UNTIL data$ <> "" IF !b THEN leave() IF IS_IN("DAT:",data$)=1 data$=MID$(data$,5) ELSEIF IS_IN("BAK:",data$)=1 FN.RTN "QUIT" ELSEIF IS_IN("LNK:file:///",data$)=1&IS_IN("?",data$) i=IS_IN("?",data$):data$="SUBMIT&"+MID$(data$,i+1)+"&" ENDIF FN.RTN data$ FN.END FN.DEF appendln(f$,m$) TEXT.OPEN a,h,f$ TEXT.WRITELN h,m$ TEXT.CLOSE h FN.END FN.DEF tallybundle(b,k$,newv) LET k$=LOWER$(k$) BUNDLE.CONTAIN b,k$,e IF e THEN BUNDLE.GET b,k$,v BUNDLE.PUT b,k$,v+newv FN.END FN.DEF grab$(f$) FN.RTN readln$(f$) FN.END FN.DEF exercise(d$) ! total calories burned for date d$ BUNDLE.GET 1,"db",db SQL.QUERY c,db,"diary","SUM(calories)","cast(calories as real)<0 and date='"+d$+"' GROUP BY date" SQL.NEXT done,c,cv1$ IF IS_NUMBER(cv1$) LET tot=VAL(cv1$) ENDIF FN.RTN -tot FN.END FN.DEF str2$(v) IF FRAC(v)<>0 THEN FN.RTN STR$(v) FN.RTN INT$(v) FN.END FN.DEF WAIT() PAUSE 100 FN.END FN.DEF SaveNumBundle(b$,b) BUNDLE.SAVE b,b$ FN.END FN.DEF LoadNumBundle(b$,b) FILE.EXISTS e,b$ IF !e THEN FN.RTN 0 BUNDLE.LOAD b,b$ FN.END FN.DEF grabday$(d$) !grab diary for date d$ from database BUNDLE.GET 1,"db",db SQL.QUERY cursor,db,"diary","food,calories,date,time","date='"+d$+"'" DO SQL.NEXT done,cursor,cv1$,cv2$,cv3$,cv4$ IF !done THEN r$+=cv1$+"\t"+cv2$+"\t"+cv3$+"\t"+cv4$+"\n" UNTIL done FN.RTN r$ FN.END FN.DEF gettime$() TIME Y$,M$,D$,H$,Mi$,S$,WkD,DST FN.RTN h$+":"+mi$ FN.END FN.DEF SetFlag(f$) wset(f$,1) FN.END FN.DEF ClearFlag(f$) wset(f$,0) FN.END FN.DEF f$(n) !format number for stat$() FN.RTN TRIM$(FORMAT$("######",n)) FN.END FN.DEF stat$(a[]) ARRAY.LENGTH n,a[]:ARRAY.MAX max,a[] ARRAY.MIN min,a[]:ARRAY.STD_DEV sd,a[] ARRAY.AVERAGE avg,a[]:range=max-min s$="n="+INT$(n)+" "+"avg:"+f$(avg)+"\nmin:"+f$(min)+" max:"+f$(max)+"\nsd:"+f$(sd)+" range:"+f$(range)+" median:"+f$(median(a[]))+"\n" FN.RTN s$ FN.END FN.DEF frmcal$(n) FN.RTN TRIM$(FORMAT$("%%%%.#",n)) !formal calories for html i$=INT$(n):s$="    ":FN.RTN MID$(s$,1,6*(4-LEN(i$)))+i$ FN.END FN.DEF cleanvoice(vl) LIST.SIZE vl,n FOR i=1 TO n LIST.GET vl,i,s$ s$=REPLACE$(s$," serving size ",":") s$=REPLACE$(s$,"this morning ","") s$=REPLACE$(s$,"today ","") s$=REPLACE$(s$,"this afternoon ","") s$=REPLACE$(s$,"this evening ","") s$=REPLACE$(s$,"tonight ","") s$=REPLACE$(s$,"I ate an ","") s$=REPLACE$(s$,"I ate a ","") s$=REPLACE$(s$,"I ate ","") s$=REPLACE$(s$,"I had an ","") s$=REPLACE$(s$,"I had a ","") s$=REPLACE$(s$,"I had ","") s$=REPLACE$(s$,"for breakfast ","") s$=REPLACE$(s$,"for lunch ","") s$=REPLACE$(s$,"for dinner ","") s$=REPLACE$(s$,"for a snack ","") s$=REPLACE$(s$," for breakfast","") s$=REPLACE$(s$," for lunch","") s$=REPLACE$(s$," for dinner","") s$=REPLACE$(s$," for a snack","") s$=REPLACE$(s$," $"," ") LIST.REPLACE vl,i,s$ NEXT FN.END FN.DEF ask(f$,d$) dm("") IF d$="-99999" THEN d$="0" LIST.CREATE s,l q$=f$+" "+d$+". is that correct?" TTS.INIT TTS.SPEAK q$ STT.LISTEN q$ STT.RESULTS l LIST.GET l,1,s$ s$=LOWER$(TRIM$(s$)) IF s$="yes" FN.RTN val2(d$) ELSE TTS.SPEAK "say the correct amount" STT.LISTEN "what is the correct amount?" STT.RESULTS l LIST.GET l,1,s$ TTS.SPEAK s$ s$=REPLACE$(s$,"calories","") s$=REPLACE$(s$,"points","") FN.RTN readnumber2(TRIM$(s$)) ENDIF FN.RTN -99999 FN.END FN.DEF editdb(db$) IF !isold(db$) THEN writeln(db$,"") e$=TRIM$(grab$(db$)) e$=REPLACE$(e$,"\t",":") DO e$=REPLACE$(e$,"\n\n","\n") UNTIL !IS_IN("\n\n",e$) e$=htmledit$("edit database",e$) cleandb(&e$) writeln(db$,e$) POPUP "saved!" FN.END FN.DEF isadigit(s$) FN.RTN IS_IN(s$,"-0123456789.") FN.END FN.DEF hasdigits(s$) I=1:l=LEN(s$) DO LET found=isadigit(MID$(s$,I,1)):I++ UNTIL i>l|found FN.RTN found FN.END FN.DEF readnumber(s$) z=LEN(s$) FOR i=1 TO z LET C$=MID$(s$,I,1):IF isadigit(c$) THEN N$+=c$ NEXT IF LEN(n$)>0 THEN FN.RTN VAL(n$) FN.RTN 0 FN.END FN.DEF readnumber2(s$) !used with speech recognition to extract numbers s$=LOWER$(s$) IF hasdigits(s$) N$="":z=LEN(s$) FOR i=1 TO z C$=MID$(s$,I,1):IF isadigit(c$) THEN N$+=c$ NEXT IF LEN(n$)>0 FN.RTN VAL(n$) ELSE v=0:nn$="one,two,three,four,five,six,seven,eight,nine,ten,eleven,twelve,thirteen,fourteen,fifteen,sixteen,seventeen,eighteen,nineteen,twenty" ENDIF FOR i=1 TO 20 IF IS_IN(" "+WORD$(nn$,i,",")+" ",s$) THEN v=i :F_N.BREAK NEXT FN.RTN v ENDIF FN.RTN 0 FN.END FN.DEF stripdigits$(s$) !remove all numeric data from string z=LEN(s$) FOR i=1 TO z C$=MID$(s$,I,1) IF !isadigit(c$) THEN N$+=c$ NEXT IF LEN(n$)>0 THEN FN.RTN n$ FN.RTN "" FN.END FN.DEF Guess(f$,found) !retrieve cals/pts for food f$ ! returns 0 and !found if food not found f$=TRIM$(f$) BUNDLE.GET 1,"db",db f$=REPLACE$(f$,"'","''") w$="food = '"+f$+"'" SQL.QUERY cursor,db,"diary","calories",w$,"_id desc" SQL.NEXT done,cursor,cv1$ IF !done THEN found=1:v=val2(cv1$) FN.RTN v FN.END FN.DEF asklist2$(l,msg$,c) !2 column version r$="
":h$=" Home" h$+="" h$+="" h$+="

"+msg$+"

" LIST.SIZE l,z FOR i=1 TO z LIST.GET l,i,s$ s$=REPLACE$(s$,"'","'") but$="" h$+=but$ IF FRAC(i/2)<>0 THEN h$+="
" NEXT h$+="
" h$=REPLACE$(h$,"~","\""):dm("h"):HTML.LOAD.STRING h$ LIST.GET l,1,d$ IF rset("speak") THEN TTS.SPEAK REPLACE$(msg$,"choose cals/pts for","")+" "+d$,0 DO r$=waitclick$(0):c=val2(r$) UNTIL c>0 LIST.GET l,c,s$:FN.RTN s$ FN.END FN.DEF hgetkey$(msg$) !html numeric keypad LIST.CREATE s,l:LIST.ADD l,"1","2","3","4","5","6","7","8","9","0",".","-","<","x","E" r$="
":h$="" h$+=" Home" h$+="" h$+="

"+msg$+"

" LIST.SIZE l,z FOR i=1 TO z LIST.GET l,i,s$:s$=REPLACE$(s$,"'","'") but$="" h$+=but$:IF FRAC(i/3)=0 THEN h$+="
" NEXT h$+="
" h$=REPLACE$(h$,"~","\""):dm("h"):HTML.LOAD.STRING h$ DO r$=waitclick$(0):c=val2(r$) UNTIL c>0 LIST.GET l,c,s$ FN.RTN s$ FN.END FN.DEF askyn(p$) Dialog.message p$, "", c,"yes","no" if c=1 then fn.rtn 1 if c=2 then fn.rtn 0 fn.rtn 0 LIST.CREATE s,m LIST.ADD m,"yes","no" c=0 AskList$(m,p$,&c) LIST.CLEAR m IF c=1 THEN FN.RTN 1 FN.RTN 0 FN.END FN.DEF bkhit() BUNDLE.GET 1,"back",b$:b=(b$="1") IF b THEN BUNDLE.PUT 1,"back","0" FN.RTN b FN.END FN.DEF SaveMarks(f$,b) !save marked food list from bundle CALL SaveBundle(f$,b) BUNDLE.PUT 1,"marklist",b FN.END FN.DEF MarkFood(f$,type) !star a food f$=WORD$(f$,1,":") mdb$="marked.bun" BUNDLE.CREATE b CALL loadbundle(mdb$,&b) IF type=-1 THEN s$="-" ELSE s$="+" BUNDLE.PUT b,f$,s$ CALL SaveMarks(mdb$,b) FN.END FN.DEF ClearMark(f$) mdb$="marked.bun" BUNDLE.CREATE b CALL loadbundle(mdb$,&b) BUNDLE.REMOVE b,TRIM$(f$) CALL SaveMarks(mdb$,b) FN.END FN.DEF ParseCmd$(p$) !parse out commands in spoken string p$ p$=TRIM$(LOWER$(p$)) IF p$="show"|p$="list"|p$="recognition cancelled" THEN FN.RTN "SHOW" IF IS_IN("plus",p$)|IS_IN("Plus",p$)|IS_IN("+",P$) THEN FN.RTN "BULK" IF IS_IN("calories",P$)|IS_IN("points",P$)|IS_IN("point",P$) THEN FN.RTN "FOOD" IF p$="display"|p$="graphs" THEN FN.RTN "GRAPH" IF STARTS_WITH("measure",p$) | STARTS_WITH("#",p$) THEN FN.RTN "MEASURE" IF IS_IN("remove",p$) THEN FN.RTN "REMOVE" IF IS_IN("find",p$)|IS_IN("search",p$) THEN FN.RTN "SEARCH" IF p$="toggle start" THEN FN.RTN "START" IF IS_IN("toggle",p$) THEN FN.RTN "TOGGLE" ARRAY.LOAD cmd$[],"email","EMAIL","clear","UNMARK","speech on","SPEAK","speech off","NOSPEAK","history","ARCHIVE","quit","QUIT","notes","NOTES","remind","REMIND","auto","AUTO","analyze","ANALYZE","reset","RESET","blind mode","BLIND","mysterioso","SETTINGS","help","HELP" ARRAY.SEARCH cmd$[],p$,i IF !i THEN FN.RTN "NONE" FN.RTN cmd$[i+1] FN.END !punish user for eating too much! FN.DEF punishment() POPUP "Be careful!That's a lot of calories for one item!" ARRAY.LOAD v[],0,300,300 VIBRATE v[],-1:PAUSE 2000 FN.END FN.DEF DeleteItem() LIST.CREATE s,menu:LIST.CREATE s,idx:BUNDLE.GET 1,"db",db d$=current$() SQL.QUERY cursor,db,"diary","_id,food","date='"+d$+"'" SQL.QUERY.LENGTH n,cursor IF !n THEN FN.RTN 0 FOR i=1 TO n SQL.NEXT done,cursor,cv1$,cv2$:LIST.ADD menu,cv2$:LIST.ADD idx,cv1$ NEXT LIST.ADD menu,"cancel" c=0:del$=AskList$(menu,"delete?",&c) IF !c|del$="cancel" THEN FN.RTN 0 LIST.GET idx,c,v$:SQL.DELETE db,"diary","_id='"+v$+"'" wset("weekavg",weekavg()) FN.END FN.DEF ChangeName(p$) BUNDLE.GET 1,"db",db INPUT "new name?",n$ IF askyn("this will change ALL occurrences of "+p$+" to "+n$+". Are you sure?") SQL.UPDATE db,"diary","food",n$ :"food='"+REPLACE$(p$,"'","\\'")+"'" ENDIF FN.END FN.DEF measure(m$) m$=TRIM$(REPLACE$(m$,"measure ","#")) IF hasdigits(m$) n=readnumber(m$) ELSE n=inputfloat("enter "+m$,"",0,0) if n=-99999 then fn.rtn 0 ENDIF m$=stripdigits$(m$) date$=current$() IF date$=getdate$() t$=gettime$() ELSE t$=entertime$(m$) ENDIF LET m$=TRIM$(m$) BUNDLE.GET 1,"db",db SQL.INSERT db,"diary","food",m$,"calories",STR$(n),"date",date$,"time",t$ FN.END !Record food to todays diary FN.DEF RecordFood(f$,c) f$=TRIM$(f$) t$=gettime$() BUNDLE.GET 1,"db",db date$=current$() IF f$="" THEN POPUP "error:no food name!":FN.RTN 0 cals$=str2$(c) IF c>0 & date$=getdate$() h=atehours() IF h>0.5 & h<8 s=rset("sumhrs")+100*h wset("sumhrs",s) n=rset("nhrs")+1 wset("nhrs",n) wset("avghrs",FLOOR(s/n)) ENDIF wset("atelast",now()) ENDIF IF date$<>getdate$() t$=entertime$(f$) ENDIF SQL.INSERT db,"diary","food",TRIM$(f$),"calories",str2$(c),"date",date$,"time",t$ ! filter out portions for clipboard clp$=f$ clp$=REPLACE$(clp$,"half of a ","") clp$=REPLACE$(clp$,"some ","") CLIPBOARD.PUT TRIM$(clp$) wset("weekavg",weekavg()) !punish user if more than 300 calories are eaten ! IF c>=300 THEN Punishment() IF ismarked(f$)=1 THEN yahoo() IF ismarked(f$)=-1 THEN ohno() ! popup "Every bite is a blessing!" FN.END FN.DEF ProcessBulk(p$) LET p$=REPLACE$(p$," Plus "," plus ") LET p$=REPLACE$(p$,"+"," plus ") SPLIT foods$[],p$," plus " CALL dm("g") LET date$=current$() ARRAY.LENGTH z,foods$[] FOR i=1 TO z LET f$=TRIM$(foods$[i]) LET g=Guess(f$,&found) LET msg$="input cals/points for:" LET c=inputcals(msg$,f$,g,&cancel) IF !cancel CALL RecordFood(f$,c) ENDIF NEXT FN.END FN.DEF leave() BUNDLE.GET 1,"db",db SQL.CLOSE db EXIT FN.END FN.DEF PerformCommand(u$,lll) !PRE:u$= command keyword ! lll is list of voice data !POST:performs command u$ ! Popup u$ IF u$="SHOW" THEN FN.RTN 0 IF u$="NEXT" setcurrent(calcdate(current$())+1):FN.RTN 0 ENDIF IF u$="PREV" setcurrent(calcdate(current$())-1):FN.RTN 0 ENDIF IF IS_IN("TOGGLE",u$) THEN p$=REPLACE$(u$,"TOGGLE ",""):u$="TOGGLE" IF u$="VOICE" !find command or food LIST.SIZE lll,z i=1:found=0:cal=-99999 IF z=0 THEN FN.RTN 0 DO LIST.GET lll,i,p$ u$=ParseCmd$(p$) IF u$<>"NONE" THEN found=1 ELSE cal=Guess(p$,&found):i++ UNTIL found|i>z ENDIF LET date$=getdate$() IF u$="NONE" IF !found LIST.ADD lll,"quit":r=0:LIST.SIZE lll,z IF z=2 LIST.GET lll,1,p$ ELSE LET p$=AskList$(lll,"what did you say?",&r) ENDIF IF P$="quit" THEN FN.RTN 1 ENDIF IF !found THEN cal=0 LET m$="input cals/pts for:" LET cal=inputcals(m$,p$,cal,&cancel) IF !cancel CALL RecordFood(p$,cal) ENDIF FN.RTN 1 ENDIF IF u$="FOOD" C=readnumber2(p$):P$=stripdigits$(p$) nn$="zero,one,two,three,four,five,six,seven,eight,nine,ten,eleven,twelve,thirteen,fourteen,fifteen,sixteen,seventeen,eighteen,nineteen,twenty" FOR i=1 TO 21 p$=REPLACE$(p$," "+WORD$(nn$,i,",")+" "," ") NEXT p$=REPLACE$(p$," calories","") p$=REPLACE$(p$," points","") p$=REPLACE$(p$," point",""):p$=TRIM$(p$) RecordFood(p$,c) FN.RTN 1 ENDIF IF u$="BLIND" ToggleSetting("blind") IF rset("blind") SetFlag("speak"):SetFlag("listen") POPUP "blind mode on":POPUP "please restart":EXIT ELSE POPUP "blind mode off" ENDIF ENDIF IF STARTS_WITH("EDIT",u$) POPUP "edit" id=readnumber(u$) IF id<1 THEN POPUP "error:bad db Id":FN.RTN 0 getrecord(id,&food$,&cal$,&t$) INPUT "edit food/measurement",food$,food$,canc IF canc THEN POPUP "cancel":FN.RTN 0 INPUT "cals/pts/measure",c,val2(cal$),canc IF canc THEN POPUP "cancel":FN.RTN 0 IF askyn(food$+": change time?\n"+miltoampm$(t$)) THEN t$=entertime$(food$) updaterecord(id,food$,str2$(c),t$) FN.RTN 0 ENDIF IF u$="SETTINGS" ToggleSetting("admin") IF rset("admin") POPUP "admin on" ELSE POPUP "admin off" ENDIF FN.RTN 0 ENDIF IF u$="AUTOKEY" WSET("autokey",!RSET("autokey")) FN.RTN 0 ENDIF IF u$="TOGGLE" dt$=current$() itemtotal(dt$,p$,&nn,&tot) pr$=p$+" n="+INT$(nn)+" total:"+STR$(tot) ! p$=REPLACE$(p$,"#","'") LIST.CREATE s,mm LIST.ADD mm,"good","bad","benign","copy to today","rename","copy to clipboard","cancel" DIALOG.SELECT cc,mm,pr$ p$=TRIM$(p$):type=ismarked(p$) IF cc=7 THEN FN.RTN 0 IF cc=6 CLIPBOARD.PUT p$ POPUP p$+" copied!" FN.RTN 0 ENDIF IF cc=5 ChangeName(p$) FN.RTN 0 ENDIF IF cc=4 old$=current$() setcurrent(now()) cal=guess(p$,&found) m$="input cals/pts for:" cal=inputcals(m$,p$,cal,&cancel) IF !cancel THEN POPUP "cancelled":FN.RTN 0 recordfood(p$,cal) setcurrent(calcdate(old$)) POPUP p$+" copied" FN.RTN 0 ENDIF IF cc=1 THEN markfood(p$,1):FN.RTN 0 IF cc=2 THEN markfood(p$,-1):FN.RTN 0 IF cc=3 THEN clearmark(p$):FN.RTN 0 FN.RTN 0 ENDIF SW.BEGIN u$ SW.CASE "HELP" Help() SW.BREAK SW.CASE "MEASURE" Measure(p$) SW.BREAK SW.CASE "BULK" ProcessBulk(p$) SW.BREAK SW.CASE "QUIT" SW.BREAK SW.CASE "AUTO" ToggleSetting("auto") SW.BREAK SW.CASE "START" ToggleSetting("listen") SW.BREAK SW.CASE "ANALYZE" Analysis() SW.BREAK SW.CASE "EMAIL" sendmail() SW.BREAK SW.CASE "ARCHIVE" Viewarchive() SW.BREAK SW.CASE "TSPK" ToggleSetting("speak") IF rset("speak") THEN TTS.INIT SW.BREAK SW.CASE "SPEAK" SetFlag("speak"):TTS.INIT SW.BREAK SW.CASE "NOSPEAK" ClearFlag("speak") SW.BREAK SW.CASE "SEARCH" web(p$) SW.BREAK SW.CASE "GRAPH" GraphsMenu() SW.BREAK SW.CASE "NOTES" notes() SW.BREAK SW.CASE "TODAY" setcurrent(NOW()) SW.BREAK SW.CASE "REMOVE" DeleteItem() SW.BREAK SW.CASE "RESET" ResetAll() SW.BREAK SW.END FN.END FN.DEF hasdec(n) FN.RTN FRAC(n)<>0 FN.END !display numeric keypad and put gr object labels in pad[] array !returns graphical key hit or @ if nothing pressed !input number with onscreen keypad using prompts p$ and a$ !with default value of d !returns -99999 if user cancels input !NOTE:html must be opened and closed by calling function FN.DEF inputfloat(p$,a$,d,search) !fn.rtn slider(a$,d,0,500) DIM pad[15] n$=str2$(d) msg$=p$+"
"+a$+"
"+n$+"" n=d:khit=0 DO k$=hgetKEY$(msg$):khit=1 IF k$="E" THEN D_U.BREAK n=0:n$="0" DO IF IS_IN(k$,"0123456789.-") IF k$="-" IF ENDS_WITH(".",n$) THEN dec=1 ELSE dec=0 n$=str2$(-val2(n$)) IF dec THEN n$+="." ELSE if k$="." IF !IS_IN(".",n$) THEN n$+="." ELSE if IS_NUMBER(n$+k$) n$+=k$ n=VAL(n$+k$) ENDIF ENDIF IF k$="x" THEN D_U.BREAK IF k$="<" n$=LEFT$(n$,LEN(n$)-1) IF LEN(n$)=0 THEN n$="0" ENDIF IF STARTS_WITH("0",n$)&IS_NUMBER(MID$(n$,2,1)) n$=MID$(n$,2,LEN(n$)-1) ENDIF n=val2(n$) msg$=p$+"
"+a$+"
"+n$+"" k$=hgetKEY$(msg$) UNTIL k$="x"|k$="E" UNTIL k$="x"|k$="E" IF k$="x" THEN n=-99999 FN.RTN n FN.END FN.DEF quickcal(p$,a$,d,cancel) !quick calorie entry IF rset("blind") THEN FN.RTN ask(a$,str2$(Guess(a$,&found))) q$="quickcal.oli" dflt$="0\n25\n50\n100\n150\n200\n250\n300\n400" DO IF !isold(q$) THEN writeln(q$,dflt$) FILE.EXISTS e,q$ IF e THEN GRABFILE cl$,q$ UNDIM cc$[]:SPLIT cc$[],cl$,"\n" LIST.CREATE s,cl:LIST.ADD cl,str2$(d),"custom","search" LIST.ADD.ARRAY cl,cc$[]:LIST.ADD cl,"edit","cancel" c=0 DO x$=asklist2$(cl,"choose cals/pts for "+a$,&c) IF x$="edit" THEN cl$=htmledit$("edit default list",cl$):writeln(q$,cl$) IF x$="search" THEN web(a$) UNTIL x$<>"search" UNTIL x$ <>"edit list" IF c=0|x$="cancel" THEN cancel=1: FN.RTN -99999 IF x$="custom" v= inputfloat(p$,a$,d,1) IF v=-99999 THEN cancel=1 FN.RTN v ENDIF IF IS_NUMBER(x$) FN.RTN VAL(x$) ELSE cancel=1 FN.RTN -99999 ENDIF FN.END FN.DEF inputint(p$,a$,d) FN.RTN inputfloat(p$,a$,d,0) FN.END FN.DEF inputcals(p$,a$,d,cancel) FN.RTN quickcal(p$,a$,d,&cancel) FN.END FN.DEF grn$(s$) !highlight html text in green FN.RTN ""+s$+"" FN.END FN.DEF hear(vl) v$="say food name,command,Help or hit cancel" dm("") STT.LISTEN v$ STT.RESULTS vl cleanvoice(vl) FN.END FN.DEF GraphTimes(type$,item$) ! type="stars,frowns,exercise,all,measure" BUNDLE.GET 1,"db",db event=caskyn("count event (do not sum)?") IF type$="exercise" SQL.QUERY cursor,db,"diary","calories,time,food","calories<0" ELSE if type$="measure" SQL.QUERY cursor,db,"diary","calories,time,food","food='"+item$+"'" ELSE SQL.QUERY cursor,db,"diary","calories,time,food","" ENDIF BUNDLE.CREATE bt FOR I=0 TO 23 BUNDLE.PUT bt, INT$(I),0 NEXT DO SQL.NEXT done,cursor,s1$,s2$,s3$ IF done THEN D_U.BREAK IF type$<>"measure"&STARTS_WITH("#",s3$) THEN D_U.CONTINUE IF type$="frowns" & ismarked(s3$) <>-1 THEN D_U.CONTINUE IF type$="stars" & ismarked(s3$) <>1 THEN D_U.CONTINUE i++ IF event c=1 ELSE LET c=val2(s1$) ENDIF CALL tallybundle(bt,INT$(val2(MID$(s2$,1,2))),c) UNTIL done DIM d[24],l$[24] FOR I=0 TO 23 BUNDLE.GET bt,INT$(I),v d[I+1]=v l$[I+1]=INT$(i) NEXT err= bar(d[],l$[],"cals vs tod ("+type$+")") IF err THEN FN.RTN -1 CALL Render() DO wait() GR.TOUCH t,x,y UNTIL t FN.END FN.DEF getrecord(id,food$,cal$,t$) BUNDLE.GET 1,"db",db SQL.QUERY cursor,db,"diary","food,calories,date,time,_id","_id='"+INT$(Id)+"'" SQL.NEXT done,cursor,food$,cal$,date$,t$,i$:IF done THEN D_U.BREAK FN.END FN.DEF updaterecord(id,food$,cal$,t$) BUNDLE.GET 1,"db",db SQL.UPDATE db,"diary","food",food$,"calories",cal$,"time",t$:"_id='"+INT$(Id)+"'" FN.END FN.DEF AskList$(l,msg$,c) list.size l,n for i=1 to n list.get l,i,s$ s$=replace$(s$,"
"," ") list.replace l,i,trim$(replace$(s$,"","")) next Dialog.select c, l,msg$ if c>0 then list.get l,c,s$ fn.rtn s$ dm("h") r$="
" h$+="" h$+="

"+msg$+"

"+r$ LIST.SIZE l,z h$+="
" FOR i=1 TO z LIST.GET l,i,s$ s$=REPLACE$(s$,"'","'") s$=REPLACE$(s$,"","📊") but$="
" h$+=but$ NEXT h$+="



" h$=REPLACE$(h$,"~","\"") HTML.LOAD.STRING h$ r$=waitclick$(0) IF IS_NUMBER(r$) c=VAL(r$):LIST.GET l,c,s$ ENDIF s$=REPLACE$(s$,"","") FN.RTN s$ FN.END FN.DEF cleandb(e$) r$="\n":e$=REPLACE$(e$,":","\t"):e$=REPLACE$(e$,"\n",r$) e$=REPLACE$(e$,CHR$(13),r$) DO e$=REPLACE$(e$,r$+r$,r$) UNTIL !IS_IN(r$+r$,e$) FN.END ! ! input time on clock ! by mookiebearapps ! FN.DEF debuggettime() FN.RTN 0 FN.END FN.DEF btnTouch(b) ! usually followed by btnRelease() GR.SCREEN w,h LET sq=h/15 GR.GET.POSITION b,sx,sy GR.BOUNDED.TOUCH touched,sx-sq,sy-sq,sx+sq,sy+sq FN.RTN touched FN.END FN.DEF btnDraw(rx,ry,txt$) GR.SCREEN w,h GR.TEXT.SIZE h/18 GR.TEXT.ALIGN 2 GR.TEXT.DRAW b,rx*w,ry*h,txt$ GR.SHOW b ! GR.RENDER FN.RTN b FN.END FN.DEF btnRelease() GR.TOUCH t,x,y IF t DO PAUSE 100 GR.TOUCH t,x,y UNTIL !t ENDIF FN.END FN.DEF entertime$(s$) IF !debuggettime() dm("g") ENDIF ! returns military time hh:mm pi=3.14 GR.SCREEN ww,hh sc=hh/ww DIM h[12] DIM m[12] FOR I=1 TO 12 r=0.2 GR.COLOR 255,0,255,0 h[I]=btnDraw(sc*r*COS(2*pi*(i/12+0.75))+0.5,r*SIN(2*pi*(I/12+0.75))+0.5,INT$(I)) NEXT GR.COLOR 255,255,255,255 btnDraw(0.5,0.5,"hours?") btnDraw(0.5,0.1,s$) GR.RENDER DO FOR I=1 TO 12 IF btnTouch(h[I]) THEN h=i:found=1 NEXT PAUSE 100 UNTIL found btnRelease() GR.COLOR 255,0,255,0 GR.CLS FOR i=1 TO 12 mm=MOD(5*I,60) m[I]=btnDraw(sc*r*COS(2*pi*(0.75+mm/60))+0.5,r*SIN(2*pi*(0.75+mm/60))+0.5,INT$(mm)) NEXT GR.COLOR 255,255,255,255 btnDraw(0.5,0.5,"minutes?") btnDraw(0.5,0.1,s$) GR.RENDER DO FOR I=1 TO 12 IF btnTouch(m[I]) THEN m=MOD(i*5,60):D_U.BREAK NEXT PAUSE 100 UNTIL 0 btnRelease() GR.CLS found=0 GR.COLOR 255,255,255,255 btnDraw(0.5,0.3,"enter am/pm?") btnDraw(0.5,0.1,s$) GR.COLOR 255,0,255,0 am=btnDraw(0.5,0.5,"am") pm=btnDraw(0.5,0.7,"pm") GR.RENDER DO IF btnTouch(am) THEN found=1:pm=0 IF btnTouch(pm) THEN found=1:pm=1 PAUSE 100 UNTIL found GR.RENDER btnRelease() GR.CLS IF pm & h<>12 THEN h+=12 IF !pm & h=12 THEN h=0 mil$=TRIM$(FORMAT$("%%",h))+":"+TRIM$(FORMAT$("%%",m)) FN.RTN mil$ FN.END FN.DEF del(f$) FILE.DELETE e,f$ FN.END FN.DEF ResetAll() dm(""):DIALOG.MESSAGE ,"reset and erase entire app?",q,"yes","no" IF q<>1 THEN FN.RTN 1 DIALOG.MESSAGE ,"are you sure?",q,"yes","no" IF q<>1 THEN FN.RTN 1 del("archive.oli") del("archive1.oli") del("marked.bun") del("notes.oli") del("../databases/aCal") del("../databases/aCal-journal") POPUP "diary reset":POPUP "please restart Acal" EXIT FN.END FN.DEF analysis() showhtml(Analyze$()) FN.END FN.DEF notesold() IF !isold("notes.oli") writeln("notes.oli","notes") appendln("notes.oli","-----") appendln("notes.oli","\n") ENDIF GRABFILE n$,"notes.oli" n$=htmledit$("notes",n$) writeln("notes.oli",n$) FN.END FN.DEF notes() IF !rset("admin") THEN notesold():FN.RTN 0 INPUT "password?",p$ IF isold("notese.oli") GRABFILE n$,"notese.oli" DECRYPT p$, n$, n$ IF n$="" THEN POPUP "bad password":FN.RTN 0 ELSE n$="notes\n-----\n" ENDIF n$=htmledit$("notes",n$) ENCRYPT p$, n$,n$ writeln("notese.oli",n$) FN.END FN.DEF findmatch$(s$,exclude) IF s$="" THEN FN.RTN "" s$=REPLACE$(s$,"'","''") BUNDLE.GET 1,"db",db SQL.QUERY cursor,db,"diary","food","food LIKE'"+s$+"%'","_id desc" DO SQL.NEXT done,cursor,cv1$ LIST.SEARCH exclude,cv1$,e UNTIL !e | done IF !done THEN m$=cv1$ FN.RTN m$ FN.END FN.DEF oldfindmatch$(s$) BUNDLE.GET 1,"db",db SQL.QUERY cursor,db,"diary","food,calories","food LIKE'"+s$+"%'","_id desc" SQL.NEXT done,cursor,cv1$,cv2$ IF !done THEN m$=cv1$ FN.RTN m$ FN.END FN.DEF inky$() Inkey$ s$ FN.RTN REPLACE$(s$, "key 69","#") FN.END FN.DEF autocomplete$(msg$) LIST.CREATE s,exclude goodkeys$=" '1234567890abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTHVWXYZ#:" dm("g") GR.ORIENTATION 1:GR.SCREEN w,h:GR.TEXT.SIZE h/18:GR.TEXT.ALIGN 2 GR.COLOR 255,0,255,0,1:GR.TEXT.DRAW p,w/2,h/8,msg$ GR.COLOR 255,255,255,0,1:GR.TEXT.DRAW et,w/2,h/4,"" GR.COLOR 255,0,255,0,1:GR.TEXT.DRAW tt,w/2,h/3,"" GR.TEXT.DRAW g,w/2,h/2-h/14,"hit enter for match" GR.TEXT.DRAW g,w/2,h/2," or press . for new item":GR.RENDER ?:CLS:KB.SHOW !wait for key release DO K$=inky$() :bk=(bkhit()|BACKGROUND()) IF bk THEN D_U.BREAK wait() UNTIL k$="@" IF bk THEN FN.RTN "" DO DO K$=inky$() :wait() bk=(bkhit()|BACKGROUND()) IF bk THEN D_U.BREAK UNTIL k$<>"@" IF bk THEN D_U.BREAK IF k$="key 18" THEN k$="#" IF k$="key 75" THEN k$="'" IF k$="key 56" THEN D_U.BREAK IF k$="key 66" THEN D_U.BREAK !del key IF k$="key 67" & LEN(s$)>0 s$=MID$(s$,1,LEN(s$)-1) LIST.CLEAR exclude ENDIF IF IS_IN(k$,goodkeys$) N$=INKY$() :bk=(bkhit()|BACKGROUND()) IF bk THEN D_U.BREAK s$+=k$ ENDIF x$=findmatch$(s$,exclude) IF x$="" x$=s$ ELSE LIST.ADD exclude,x$ ENDIF GR.MODIFY et,"text",s$:m$="" IF x$<>"" THEN m$="" GR.MODIFY tt,"text",m$+x$:GR.RENDER UNTIL k$="key 66" IF bk THEN FN.RTN "" DO W$=INKY$() :wait() bk=(bkhit()|BACKGROUND()) IF bk THEN D_U.BREAK UNTIL w$="@" IF bk THEN FN.RTN "" IF k$="key 56" FN.RTN TRIM$(s$) ELSE FN.RTN TRIM$(x$) ENDIF FN.END FN.DEF oldautocomplete$(msg$) goodkeys$=" '1234567890abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTHVWXYZ#:" dm("g") GR.ORIENTATION 1:GR.SCREEN w,h:GR.TEXT.SIZE h/18:GR.TEXT.ALIGN 2 GR.COLOR 255,0,255,0,1:GR.TEXT.DRAW p,w/2,h/8,msg$ GR.COLOR 255,255,255,0,1:GR.TEXT.DRAW et,w/2,h/4,"" GR.COLOR 255,0,255,0,1:GR.TEXT.DRAW tt,w/2,h/3,"" GR.TEXT.DRAW g,w/2,h/2-h/14,"hit enter for match" GR.TEXT.DRAW g,w/2,h/2," or press . for new item":Render() ?:CLS:KB.SHOW !wait for key release DO K$=inky$() :bk=(bkhit()|BACKGROUND()) IF bk THEN D_U.BREAK wait() UNTIL k$="@" IF bk THEN FN.RTN "" DO DO K$=inky$() :wait() bk=(bkhit()|BACKGROUND()) IF bk THEN D_U.BREAK UNTIL k$<>"@" IF bk THEN D_U.BREAK IF k$="key 18" THEN k$="#" IF k$="key 75" THEN k$="'" IF k$="key 56" THEN D_U.BREAK IF k$="key 66" THEN D_U.BREAK !del key IF k$="key 67" & LEN(s$)>0 s$=MID$(s$,1,LEN(s$)-1) ENDIF IF IS_IN(k$,goodkeys$) N$=INKY$() :bk=(bkhit()|BACKGROUND()) IF bk THEN D_U.BREAK s$+=k$ ENDIF x$=findmatch$(s$) IF x$="" THEN x$=s$ GR.MODIFY et,"text",s$:m$="" IF x$<>"" THEN m$="" GR.MODIFY tt,"text",m$+x$:Render() UNTIL k$="key 66" IF bk THEN FN.RTN "" DO W$=INKY$() :wait() bk=(bkhit()|BACKGROUND()) IF bk THEN D_U.BREAK UNTIL w$="@" IF bk THEN FN.RTN "" IF k$="key 56" FN.RTN TRIM$(s$) ELSE FN.RTN TRIM$(x$) ENDIF FN.END FN.DEF cAskList$(l,msg$,c) dm("") DIALOG.SELECT c,l,msg$ IF c THEN LIST.GET l,c,c$ FN.RTN c$ FN.END !show menu from list l with prompt msg$ !returns selection and assigns c to choice number FN.DEF askperiod(p$) ARRAY.LOAD t$[],"daily","weekly","monthly" ARRAY.LOAD t[],1,7,30 DIALOG.SELECT c,t$[],p$ IF c>0 THEN FN.RTN T[C] FN.RTN 1 FN.END FN.DEF period$(p) IF p=1 FN.RTN "daily" ELSE if p=7 FN.RTN "weekly" ELSE if p=30 FN.RTN "30 day" ELSE FN.RTN "error" ENDIF FN.END FN.DEF GraphsMenu() reopendb() ClearFlag("relgraph") LIST.CREATE s,g LIST.ADD g,"help","notes","web","history","email","#measurement","#measurement x y","exercise","cals","items","food frequency","stars","frowns","stars vs frowns","vs time of day","cals histogram","items histogram","cals vs items","time-cal avg","analysis" LIST.ADD g,"done" DO c=0:c$=AskList$(g,"",&c) IF !c THEN d_u.break SW.BEGIN c$ SW.CASE "help" help():SW.BREAK SW.CASE "notes" notes():SW.BREAK SW.CASE "#measurement" graphmeasure(""):SW.BREAK SW.CASE "#measurement x y" graphmeasure2():SW.BREAK SW.CASE "stars vs frowns" graphstarsvsfrowns() SW.BREAK SW.CASE "vs time of day" UNDIM tmenu$[] ARRAY.LOAD tmenu$[],"stars","frowns","all","exercise","measure" DIALOG.SELECT c, tmenu$[],"choose food type" IF c>0 IF tmenu$[c]="measure" item$=autocomplete$("select item") KB.HIDE ENDIF GraphTimes(tmenu$[c],item$) ENDIF SW.BREAK SW.CASE "web" web(""):SW.BREAK SW.CASE "email" sendmail():SW.BREAK SW.CASE "exercise" p=askperiod("exercise") GraphExercise(p) SW.BREAK SW.CASE "items" p=askperiod("items") GraphItems(p) SW.BREAK SW.CASE "cals" p=askperiod("cals") eating=askyn("graph just food (not burn)?") GraphPeriodCals(p,eating) SW.BREAK SW.CASE "food frequency" PlotFood() SW.BREAK SW.CASE "cals histogram" Graphcals(1) SW.BREAK SW.CASE "stars" p=askperiod("STARS") GraphMarks(p,1) SW.BREAK SW.CASE "frowns" p=askperiod("FROWNS") GraphMarks(p,-1) SW.BREAK SW.CASE "items histogram" histitems() SW.BREAK SW.CASE "cals vs items" plotcalsvsitems() SW.BREAK SW.CASE "history" viewarchive() SW.BREAK SW.CASE "time-cal avg" GraphTimeCal() SW.BREAK SW.CASE "analysis" analysis() SW.BREAK !! SW.CASE "Leave Us Feedback!" BROWSE "https://play.google.com/store/apps/details?id=com.rfo.vocalpro" SW.BREAK !! SW.DEFAULT c$="done" SW.BREAK SW.END UNTIL c$="done" FN.END FN.DEF showhtml(x$) IF x$="" THEN FN.RTN 0 dq$="\"" h$=" " h$+="
" h$+="" h$+=x$:h$+="
":h$=REPLACE$(h$,"~",dq$) dm("h"):HTML.LOAD.STRING h$:PAUSE 2000:waitclick$(0) FN.END FN.DEF help() Bb$="

" dm("h"):w$="" w$+=" " w$+="
" w$+="
" w$+="
use the voice command "+grn$("HELP")+" to display this help page"+bb$ w$+="Enter food energy values using either calories or points but only use one system.
say new foods in the format:
" w$+="food ### calories/points
ex:
" w$+="\"banana 100 calories\"
or \"banana 2 points\"
" w$+="
Add new food by saying the food name,wait and key in a value for it."+bb$+"If food was already entered,don't use the keyword calories and it will recall the last value."+bb$ w$+="Record multiple foods at once by using the keyword "+grn$("PLUS")+"
" w$+="example:\"banana plus cereal plus milk\""+bb$ w$+="You can exit the main diary screen by tapping on the right hand side of the screen."+bb$+"Other commands:"+bb$ w$+="In autoquit mode app will exit automatically after being idle 6 seconds"+bb$ w$+="In autolisten mode app will listen immediately on startup"+bb$ w$+=GRN$("SEARCH")+" to look up calories on the web"+bb$ w$+=grn$("NOTES")+" to record/view notes in diary"+bb$ w$+=grn$("HISTORY")+" to view past days' food entries"+bb$ w$+=grn$("DISPLAY")+" to show graphs of weight,daily calories and other items"+bb$ w$+=grn$("ANALYZE")+" to analyze which foods in your history are associated with eating less or more daily calories"+bb$ w$+=grn$("EMAIL")+" to email archive or food database"+bb$ w$+=grn$("RESET")+" to clear entire app ***USE CAREFULLY***"+bb$ w$+="Privacy Policy"+bb$ w$+="We respect your privacy and do not collect or share your personal information with other parties."+bb$ w$+="We do not use cookies or advertising,however if you link to an outside service/webpage such as Google,YouTube,bing etc. from within our apps,they probably do."+bb$ w$+="You are able to optionally share some information (i.e. diet logs or grocery lists) with others via email functionality built into some of our apps. These require you to use your own email app to send data to third parties of your choice."+bb$ w$+="Most databases and temporary files in our apps are NOT encrypted and can be used and edited yourself using SQLITE and text editors."+bb$ w$+="Some of our applications (such as Voice Calorie Counter and Done List) use a Microphone with Google Speech Recognition which may involve sending sound samples of your voice to Google."+bb$ w$+="The privacy policy for Google can be found here:"+bb$ w$+="https://privacy.google.com/index.html"+bb$+"
" HTML.LOAD.STRING w$:PAUSE 2000:waitclick$(0) FN.END FN.DEF sortfood(ft$[],n) IF n<2 THEN FN.RTN 0 !? "sorting "+INT$(n)+" items" DIM x[n],y$[n] FOR i=1 TO n x[i]=VAL(ft$[i,2]):y$[i]=ft$[i,1] NEXT FOR i=1 TO n-1 ARRAY.MIN mn,x[i,n-i+1]:ARRAY.SEARCH x[i,n],mn,pos SWAP x[i],x[pos+i-1]:SWAP y$[i],y$[pos+i-1] NEXT FOR I=1 TO n ft$[i,2]=INT$(x[i]):ft$[i,1]=y$[i] NEXT FN.END FN.DEF showtable$(ft$[],nn) a$="":z$="
" TAB$=" ":start=0 DO start++:s$=ft$[start,2] v=0 IF s$<>"" THEN v=VAL(s$) UNTIL v<>0 a$+="undereating foods"+z$ a$+="" FOR i=start TO MIN(start+49,nn) c$=ft$[i,2]:f$=ft$[i,1] IF c$<>"0" a$+="" ENDIF NEXT a$+="
avgfood
"+c$+""+f$+"
"+z$+"overeating foods"+z$ a$+="" FOR i=MAX(1,nn-49) TO nn c$=ft$[i,2]:f$=ft$[i,1] IF c$<>"0" a$+="" ENDIF NEXT a$+="
avgfood
"+c$+" "+f$+"
" FN.RTN a$ FN.END FN.DEF analyze$() BUNDLE.GET 1,"db",db:dm(""):? "analysis..." BUNDLE.CREATE daytot:BUNDLE.CREATE foodsum:BUNDLE.CREATE foodct !calculate daily calorie totals now=FLOOR(now())-1 FOR d=now-365 TO now d$=juliantogreg$(d):n=0:s=0:DateTotal(d$,&n,&s) x=exercise(d$) tallybundle(&daytot,d$,s+x) NEXT FOR i=now-365 TO now d$=juliantogreg$(i) SQL.QUERY c,db,"diary","food","date='"+d$+"'" SQL.QUERY.LENGTH n,c FOR j=1 TO n SQL.NEXT done,c,cv$ cv$=stripdigits$(cv$) tallybundle(foodct,cv$,1) BUNDLE.GET daytot,d$,t tallybundle(foodsum,cv$,t) NEXT NEXT BUNDLE.KEYS foodsum,foodlist LIST.SIZE foodlist,nn ? "tallied" BUNDLE.CREATE foodavg !calculate out average daily calorie for each food k=0 FOR i=1 TO nn LIST.GET foodlist,i,f$:BUNDLE.GET foodsum,f$,s:BUNDLE.GET foodct,f$,n IF n>=5 THEN BUNDLE.PUT foodavg,f$+"("+INT$(n)+"x)",FLOOR(s/n):k++ NEXT IF k<10 THEN POPUP "not enough data yet!":FN.RTN "" ?INT$(k)+" averages calculated" !copy food average bundle into array ft$ BUNDLE.KEYS foodavg,keys DIM ft$[k,2] FOR i=1 TO k LIST.GET keys,i,f$:BUNDLE.GET foodavg,f$,c ft$[i,1]=f$:ft$[i,2]=INT$(c) NEXT !sort table by ascending calories IF k>=10 sortfood(&ft$[],k):? "sort done":PAUSE 2000:CLS FN.RTN showtable$(ft$[],k) ELSE FN.RTN "not enough entries yet!" ENDIF FN.END !! under construction fn.def foods() ! return list of foods eaten list.create s,foods bundle.get 1,"db",db SQL.QUERY c,db,"diary","food","food not like '#%'","GROUP BY food" SQL.QUERY.LENGTH n,c do SQL.NEXT done,c,cv$ if done then f_n.break cv$=lower$(cv$) list.add foods,cv until done fn.rtn foods fn.end fn.def analyze2$() ! figure out what cals were on days we didnt eat foods foods=foods() bundle.create cals list.size foods,n for i=1 to n ! find dates food was eaten dates=dates(food) ! calc average for all other dates next fn.end !! FN.DEF archivereport$() good$="+":bad$="-" BUNDLE.CREATE fb:LIST.CREATE s,tt z$="
" backdays=inputint("go back","how many days? ",30) CLS !? "loading... " now=FLOOR(now()):sd=now-backdays FOR d=sd TO now t=0:d$=juliantogreg$(d):diary$=grabday$(d$) IF LEN(diary$)<5 THEN F_N.CONTINUE LIST.ADD tt,d$,dow$(d$)," ":UNDIM dd$[]:SPLIT dd$[],diary$,"\n" ARRAY.LENGTH z,dd$[] Ct=0 FOR i=1 TO z r1$=WORD$(dd$[i],1,"\t"):r2$=WORD$(dd$[i],2,"\t"):r3$=WORD$(dd$[i],3,"\t"):r4$=WORD$(DD$[I],4,"\t") tallybundle(fb,r1$,1):c=val2(r2$) IF c>0 & !STARTS_WITH("#",r1$) THEN ct++ m=ismarked(r1$) IF m=1 THEN r1$+=good$ IF m=-1 THEN r1$+=bad$ IF !STARTS_WITH("#",r1$) THEN t+=c LIST.ADD tt,miltoampm$(r4$),frmcal$(c),r1$ NEXT LIST.ADD tt,"------","------","----------------" LIST.ADD tt,"total:", frmcal$(t),INT$(ct)+" items" LIST.ADD tt," "," "," " NEXT LIST.SIZE tt,z IF !z POPUP "not enough data!":FN.RTN "" ENDIF UNDIM tbl$[]:LIST.TOARRAY tt,tbl$[] x$="":ARRAY.LENGTH n,tbl$[] Sp$=" " FOR i=1 TO n-1 STEP 3 x$+=tbl$[i]+" "+tbl$[i+1]+" "+tbl$[i+2]+z$ NEXT x$+=z$+z$+"food frequency (>3)"+z$ !Get most popular foods BUNDLE.KEYS fb,keys:LIST.SIZE keys,z:DIM xx$[z,2] zz=0 FOR i=1 TO z LIST.GET keys,i,f$:BUNDLE.GET fb,f$,freq IF freq>3 THEN zz++:xx$[zz,1]=f$:xx$[zz,2]=INT$(freq) NEXT sortfood(&xx$[],zz) FOR i=zz TO 1 STEP -1 x$+=xx$[i,2]+"x "+xx$[i,1]+z$ NEXT FN.RTN x$+"
"+ss$ FN.END FN.DEF viewarchive() X$=archivereport$():Xx$=REPLACE$(x$,"
","\n"):Xx$=REPLACE$(xx$," "," ") CLIPBOARD.PUT xx$:POPUP "copied to clipboard":Showhtml(x$) FN.END FN.DEF emailarchive$() s$=archivereport$():s$=REPLACE$(s$,"
","\n"):s$=REPLACE$(s$," "," ") FN.RTN s$ FN.END FN.DEF SENDMAIL() dm("") IF Isold("email.oli") em$=readln$("email.oli") ELSE INPUT "enter default email to send data to",em$,em$,cn IF cn THEN FN.RTN 0 writeln("email.oli",em$) ENDIF TIME Year$,Month$,Day$,Hour$,Minute$,Second$,WeekDay,isDST Today$=month$+"-"+day$+"-"+year$ DO DIALOG.MESSAGE ,"email to "+em$,c,"yes","edit","no" IF c=2 INPUT "change email",em$,em$,cn IF cn THEN D_U.BREAK writeln("email.oli",em$) ENDIF UNTIL c<>2 IF emcancel THEN FN.RTN 0 IF c=3 THEN FN.RTN 0 LIST.CREATE s,gr LIST.ADD gr,"archive","cancel" DO c=0:AskList$(gr,"choose email type",&c) IF c=3 THEN D_U.BREAK IF c=1 f$=emailarchive$() IF f$<>"" THEN EMAIL.SEND em$,"archive "+today$,f$ ENDIF DO wait() UNTIL !BACKGROUND() UNTIL c=3 FN.END FN.DEF EDIT$(p$,s$) TEXT.INPUT s$,s$,p$:FN.RTN s$ FN.END FN.DEF htmledit$(p$,s$) !text.input now works better !dm("") !TEXT.INPUT s$,TRIM$(s$)+"\n" !FN.RTN TRIM$(s$) dm("h") w$=" " w$+="edit text " w$+="
" w$+="

###prompt

" w$+="
" w$+="" w$+="
" w$=REPLACE$(w$,"###prompt",p$):w$=REPLACE$(w$,"###edit",TRIM$(s$)) HTML.LOAD.STRING w$ HTML.LOAD.URL "javascript:DL(document.getElementById('id'))h r$=waitclick$(0) IF r$="QUIT" THEN FN.RTN S$ s$=DECODE$("URL","UTF-8",r$):s$=REPLACE$(s$,"SUBMIT&submit=Done&id=",""):s$=LEFT$(s$,LEN(s$)-1) FN.RTN s$ FN.END FN.DEF dbmenu(db$) LIST.CREATE s,m LIST.ADD m,"edit lookup db","erase lookup db","import food db","cancel" DO p$="select choice" c=0 c$=AskList$(m,p$,&c) IF !c THEN d_u.break IF c$="edit lookup db" THEN editdb(db$) IF c$="erase lookup db" IF askyn("are you sure???") FILE.DELETE e,db$:POPUP "deleted" ELSE POPUP "del canceled" ENDIF ENDIF IF c$="import food db" b$=choosefile$("sampledb/"):f$=grab$(b$):appendln(db$,f$):editdb(db$):POPUP "database imported!" ENDIF UNTIL c$="cancel" FN.END FN.DEF web(p$) !lookup info on web dm("h") P$=REPLACE$(p$,"find","") P$=REPLACE$(p$,"search","") m$="use web?" LIST.CREATE s,l LIST.ADD l,"USDA Foodapedia","google","CDC BMI calculator","bing "+p$,"duckduckgo "+p$,"BMR calculator","YouTube playlist","more by Mookiebearapps","Nutrition Game by RSC","wikiHow food diary","cancel" ch=0:AskList$(l,m$,&ch) IF ch>0 & ch<10 THEN POPUP "press BACK key to return to app" SW.BEGIN ch SW.CASE 1 BROWSE "https://mnew.supertracker.usda.gov/FoodTracker" SW.BREAK SW.CASE 2 dm("h") HTML.LOAD.URL "http:/www.google.com" SW.BREAK SW.CASE 3 BROWSE "http://www.cdc.gov/healthyweight/assessing/bmi/adult_bmi/english_bmi_calculator/bmi_calculator.html" SW.BREAK SW.CASE 4 dm("h") BROWSE "http://www.bing.com/?q="+p$+" calories" SW.BREAK SW.CASE 5 dm("h") BROWSE "https://duckduckgo.com/?q="+p$+"+calories&ia=nutrition" SW.BREAK SW.CASE 6 BROWSE "http://www.calculator.net/bmr-calculator.html" SW.BREAK SW.CASE 7 BROWSE "https://www.youtube.com/playlist?list=PLi6Y_PQh4vOmk9JJinwzYC-bWct_CT8sK" SW.BREAK SW.CASE 8 BROWSE "https://play.google.com/store/apps/dev?id=7736972930987439260" SW.BREAK SW.CASE 9 BROWSE "https://play.google.com/store/apps/details?id=com.texavi.nutritiongame" SW.BREAK SW.CASE 10 BROWSE "https://m.wikihow.com/Keep-a-Food-Diary" SW.BREAK SW.END DO wait() UNTIL !BACKGROUND() PAUSE 1000 FN.END FN.DEF choosefile$(path$) DO ARRAY.DELETE d1$[] FILE.DIR path$,d1$[] ARRAY.LENGTH length,d1$[] ARRAY.DELETE d2$[] DIM d2$[length+1] d2$[1]=".." FOR i=1 TO length d2$[i+1]=d1$[i] NEXT s=0 LIST.CREATE s,l ARRAY.LENGTH z,d2$[] FOR i=1 TO z LIST.ADD l,d2$[i] NEXT AskList$(l,"select file",&s) IF s>1 n=IS_IN("(d)",d2$[s]) IF n=0 D_U.BREAK FN.RTN path$+d2$[s] ENDIF dname$=LEFT$(d2$[s],n-1) path$+=dname$+"/" D_U.CONTINUE ENDIF IF path$="" path$="../" D_U.CONTINUE ENDIF ARRAY.DELETE p$[] SPLIT p$[],path$,"/" ARRAY.LENGTH length,p$[] IF p$[length]=".." path$+="../" D_U.CONTINUE ENDIF IF length=1 path$="" D_U.CONTINUE ENDIF path$="" FOR i=1 TO length-1 path$+=p$[i]+"/" NEXT UNTIL 0 FN.RTN path$+d2$[s] FN.END FN.DEF Asklistdone$(p,msg$,r) !PRE:string list p ! msg$ is prompt to display !POST:r = index of item in p chosen ! Returns string of item ! LIST.SIZE p,size IF size<1 THEN FN.RTN "done" LIST.ADD p,"done" a$=TRIM$(AskList$(p,msg$,&r)) LIST.SIZE p,size LIST.REMOVE p,size FN.RTN a$ FN.END ! ! GRAPHS ! ! ! ! ! ! GRAPHS begin here ! ! FN.DEF median(y[]) ARRAY.LENGTH n,y[] DIM x[n] ARRAY.COPY y[],x[] ARRAY.SORT x[] ARRAY.LENGTH i,x[] IF i/2<>FLOOR(i/2) M=x[FLOOR((i+1)/2)] ELSE M=(x[FLOOR((i)/2)]+x[FLOOR((i)/2)+1])/2 ENDIF UNDIM x[] FN.RTN m FN.END FN.DEF frmgraph$(n,prec) IF prec>=0 THEN FN.RTN TRIM$(FORMAT$("#######",n)) IF prec=-1 THEN FN.RTN TRIM$(FORMAT$("#######.#",n)) IF prec=-2 THEN FN.RTN TRIM$(FORMAT$("#######.##",n)) FN.RTN TRIM$(FORMAT$("#######.###",n)) FN.END ! bar graph FN.DEF bar(d[],l$[],title$) ! make bars red/green or green/red depending on type star=IS_IN("star",title$)|IS_IN("burned",title$) dm("g") GR.SCREEN w,h GR.CLS WAKELOCK 3 xo=0 :yo=-h/10 x1=w*0.1:x2=w*0.9 y1=h*0.1:y2=h*0.7 dx=ABS(x2-x1) :dy=ABS(y2-y1) :dy2=0.15*dy ARRAY.MAX max,d[] IF max=0 THEN POPUP "error: no data":FN.RTN -1 ARRAY.AVERAGE avg,d[] ARRAY.LENGTH l,d[] med=median(d[]) bw=dx/(l*4) g=50 GR.COLOR 255,g,g,g,1 GR.RECT gn,x1-xo-2,y1-yo-dy2-2,x2-xo+2,y2-yo+2 GR.COLOR 255,255,255,255,0 GR.SET.STROKE 2 GR.RECT gn,x1-xo-2,y1-yo-dy2-2,x2-xo+2,y2-yo+2 xspace=(x2-x1)/l GR.TEXT.SIZE dy/50 GR.TEXT.ALIGN 2 FOR i=1 TO l IF (d[i]>med & !star)|(star & d[i]35 | r=3 | yy < 0 ScatterPlot(x[],y[],xname$,yname$,r) FN.RTN 0 ENDIF IF z <2 THEN FN.RTN 0 DIM x$[z] FOR i=1 TO z IF r<>2 x$[i]=Juliantogreg$(x[i]) ELSE IF x[I]<10 THEN x$[I]="0" ELSE x$[I]="" x$[I]+=INT$(x[I]) ENDIF NEXT err=bar(y[],x$[],yname$) IF err=-1 THEN FN.RTN -1 CALL Render() DO wait() GR.TOUCH t,x,y UNTIL t WAKELOCK 5 DIALOG.MESSAGE yname$,stat$(y[]),c,"ok" gr.cls FN.END FN.DEF ScatterPlot(x[],y[],xname$,yname$,graphweight) !PRE:x[],y[] are scatter plot points ! xname$,yname$ are axis titles ! graphweight=0 :plot absolute values ! graphweight=1 :plot relative to maximum y value (i.e. see weight loss) dm("g2") today=calcdate(getdate$()) relmode=rset("relgraph") ARRAY.LENGTH n,x[] IF n<2 THEN POPUP "need at least 2 points to make graph":FN.RTN 0 ARRAY.MIN xmin,x[] ARRAY.MAX xmax,x[] ARRAY.MIN yymin,y[] IF graphweight=2 THEN xaxis=1 ELSE ymin=yymin ARRAY.MAX ymax,y[] ARRAY.AVERAGE xavg,x[] ARRAY.AVERAGE yavg,y[] ARRAY.STD_DEV xsd,x[] ARRAY.STD_DEV ysd,y[] xrange=xmax-xmin yrange=ymin-ymax xxbar=0 Yybar=0 xybar=0 FOR i=1 TO n xybar+=(x[i]*y[i]):xxbar+=(x[i]*x[i]):Yybar+=(y[i]*y[i]) NEXT xybar=xybar/n xxbar=xxbar/n Yybar=yybar/n IF (xxbar-xavg*xavg)<>0 slope=(xybar-xavg*yavg)/(xxbar-xavg*xavg) ELSE slope=0 ENDIF intercept=yavg-slope*xavg Rr=(xybar-xavg*yavg)/ SQR((xxbar-xavg*xavg)*(yybar-yavg*yavg)) Rr=rr*rr pxmax=xmax+FLOOR(xrange*0.1) pymax=ymax*1.02 pxmin=xmin-FLOOR(xrange*0.2) pymin=ymin*0.98 DO flip=0 GR.CLS GR.SCREEN acwidth,acheight diwidth=(pxmax-pxmin) diheight=(pymax-pymin) IF (diwidth=0|diheight=0) THEN POPUP "not enough data":D_U.BREAK Sx=acwidth/diwidth Sy=acheight/diheight GR.SET.STROKE 1 GR.COLOR 200,255,200,0,1 Ny=(pymax-(yavg-ysd))*sy GR.LINE yyy,1,ny,(pxmax-pxmin)*sx,ny Ny=(pymax-(yavg+ysd))*sy GR.LINE yyy,1,ny,(pxmax-pxmin)*sx,ny ytics=10^FLOOR(LOG10(ABS(pymax-pymin)/10)) IF (pymax-pymin)/ytics > 10 THEN ytics*=10 IF (pymax-pymin)/ytics < 5 THEN ytics=MAX(FLOOR(ytics/5),1) Yline1=FLOOR(pymin/ytics)*ytics Yline2=CEIL(pymax/ytics)*ytics GR.TEXT.SIZE 15 GR.SET.STROKE 1 GR.TEXT.ALIGN 1 py=FLOOR(LOG10(ABS(ytics))) FOR y=yline1 TO yline2 STEP ytics GR.COLOR 50,50,50,50,1 Newx=(pxmax-pxmin)*sx Newy=(pymax-y)*sy GR.LINE yyy,1,newy,newx,newy GR.COLOR 200,50,50,50,1 IF relmode GR.TEXT.DRAW txt3,1,newy-3,INT$(y-ymax) ELSE GR.TEXT.DRAW txt3,1,newy-3,frmgraph$(y,py) ENDIF NEXT xtics=10^FLOOR(LOG10(ABS(pxmax-pxmin)/10)) DO IF (pxmax-pxmin)/xtics > 7 THEN xtics*=7 UNTIL xtics=0|((pxmax-pxmin)/xtics <=10) IF (pxmax-pxmin)/xtics < 5 THEN xtics=MAX(FLOOR(xtics/5),1) xline1=FLOOR(pxmin/xtics)*xtics xline2=CEIL(pxmax/xtics)*xtics !px=FLOOR(LOG10(ABS(xtics))) GR.TEXT.ALIGN 3 FOR x=xline1 TO xline2 STEP xtics Newx=(x-pxmin)*sx Newy=(pymax-pymin)*sy*0.97 ! g$=juliantogregorian$(x) IF xaxis THEN g$=INT$(x) ELSE g$=INT$(x-today) GR.COLOR 200,0,0,0,1 GR.TEXT.DRAW txt3,newx,newy,g$ GR.COLOR 50,0,0,0,1 GR.LINE xxx,newx,1,newx,newy NEXT GR.SET.STROKE 5 Oldx=(x[1]-pxmin)*sx Oldy=(pymax-y[1])*sy GR.COLOR 200,0,0,200,1 FOR i=1 TO n Newx=(x[i]-pxmin)*sx Newy=(pymax-y[i])*sy GR.COLOR 50,0,0,200,1 !GR.CIRCLE p,newx+3,newy+3,7 GR.COLOR 200,0,0,200,1 ! GR.line lol,oldx,oldy,newx,newy ! GR.POINT p,newx,newy GR.CIRCLE p,newx,newy,7 Oldx=newx:Oldy=newy NEXT IF slope <=0 THEN GR.COLOR 80,0,255,0,1 ELSE GR.COLOR 80,255,0,0,1 GR.SET.STROKE 9 X1=pxmin Y1=slope*x1+intercept Xn=pxmax Yn=slope*xn+intercept GR.LINE fl,(x1-pxmin)*sx,sy*(pymax-y1),sx*(xn-pxmin),sy*(pymax-yn) GR.TEXT.SIZE 25 GR.COLOR 200,50,50,50,1 GR.SET.STROKE 1 GR.TEXT.ALIGN 3 IF xaxis s=slope:s$="" ELSE s=slope*7:s$="/week" ENDIF GR.TEXT.DRAW txt3,acwidth*0.9,acheight*0.1,frmgraph$(s,-2)+s$ GR.TEXT.ALIGN 2:GR.COLOR 255,0,0,0,1 GR.TEXT.DRAW txt2,acwidth*0.5,acheight*0. 93,xname$ GR.ROTATE.START -90,acwidth*0.1,acheight*0.5 GR.TEXT.DRAW txt2,acwidth*0.05,acheight*0.5,yname$ GR.ROTATE.END CALL Render() WAKELOCK 3 Cr$="\n" px=-2 py=-2 msg$=yname$+cr$ Msg$+=INT$(n)+" entries in "+INT$(xrange+1)+" days"+cr$ msg$+="Average= "+frmgraph$(yavg,py)+cr$ msg$+="Median = "+frmgraph$(median(y[]),-1)+cr$+"Standard Deviation = "+frmgraph$(ysd,py)+cr$+"Min = "+frmgraph$(yymin,py)+cr$+"Max = "+frmgraph$(ymax,py)+cr$+"range = "+frmgraph$(ymax-yymin,py)+cr$ msg$+="r*r="+frmgraph$(rr,-2)+cr$ DO wait() bk=(bkhit()|BACKGROUND()) IF bk THEN D_U.BREAK GR.TOUCH touched,xx,yy GR.SCREEN newwidth,newheight IF newwidth<>acwidth THEN flip=1:D_U.BREAK UNTIL touched IF bk THEN D_U.BREAK UNTIL !flop IF bk WAKELOCK 5 FN.RTN 0 ENDIF IF msg$<>"" THEN DIALOG.MESSAGE ,msg$ ,c,"okay" GR.CLS dm("h") WAKELOCK 5 FN.RTN 0 FN.END FN.DEF Plotxy(x,y,xname$,yname$) !PRE:x,y are scatter plot points lists ! xname$,yname$ are axis title LIST.SIZE x,xs LIST.SIZE y,ys IF xs<2 | ys <2 POPUP "not enough points" FN.RTN 0 ENDIF LIST.TOARRAY x,x[] LIST.TOARRAY y,y[] dm("g2") relmode=1:ARRAY.LENGTH n,x[] IF n<2 THEN POPUP "need at least 2 points to make graph":FN.RTN 0 ARRAY.MIN xmin,x[]:ARRAY.MAX xmax,x[]:ARRAY.MIN yymin,y[] ymin=yymin ARRAY.MAX ymax,y[]:ARRAY.AVERAGE xavg,x[]:ARRAY.AVERAGE yavg,y[] ARRAY.STD_DEV xsd,x[]:ARRAY.STD_DEV ysd,y[] xrange=xmax-xmin:yrange=ymin-ymax:xxbar=0:Yybar=0:xybar=0 FOR i=1 TO n xybar+=(x[i]*y[i]):xxbar+=(x[i]*x[i]):Yybar+=(y[i]*y[i]) NEXT xybar=xybar/n:xxbar=xxbar/n:Yybar=yybar/n IF xxbar-xavg*xavg<>0 slope=(xybar-xavg*yavg)/(xxbar-xavg*xavg) ELSE slope=0 ENDIF intercept=yavg-slope*xavg Rr=(xybar-xavg*yavg)/ SQR((xxbar-xavg*xavg)*(yybar-yavg*yavg)) Rr=rr*rr pxmax=xmax+FLOOR(xrange*0.1):pymax=ymax*1.02 pxmin=xmin-FLOOR(xrange*0.2):pymin=ymin*0.98 DO flip=0:GR.CLS:GR.SCREEN acwidth,acheight diwidth=(pxmax-pxmin):diheight=(pymax-pymin) IF (diwidth=0|diheight=0) THEN POPUP "not enough data":D_U.BREAK Sx=acwidth/diwidth:Sy=acheight/diheight GR.SET.STROKE 1:GR.COLOR 200,255,200,0,1 Ny=(pymax-(yavg-ysd))*sy GR.LINE yyy,1,ny,(pxmax-pxmin)*sx,ny Ny=(pymax-(yavg+ysd))*sy GR.LINE yyy,1,ny,(pxmax-pxmin)*sx,ny ytics=10^FLOOR(LOG10(ABS(pymax-pymin)/10)) IF (pymax-pymin)/ytics > 10 THEN ytics*=10 IF (pymax-pymin)/ytics < 5 THEN ytics=MAX(FLOOR(ytics/5),1) Yline1=FLOOR(pymin/ytics)*ytics Yline2=CEIL(pymax/ytics)*ytics GR.TEXT.SIZE 15:GR.SET.STROKE 1:GR.TEXT.ALIGN 1 py=FLOOR(LOG10(ABS(ytics))) FOR y=yline1 TO yline2 STEP ytics GR.COLOR 50,50,50,50,1 Newx=(pxmax-pxmin)*sx:Newy=(pymax-y)*sy GR.LINE yyy,1,newy,newx,newy GR.COLOR 200,50,50,50,1 GR.TEXT.DRAW txt3,1,newy-3,frmgraph$(y,py) NEXT xtics=10^FLOOR(LOG10(ABS(pxmax-pxmin)/10)) DO IF (pxmax-pxmin)/xtics > 7 THEN xtics*=7 UNTIL xtics=0|((pxmax-pxmin)/xtics <=10) IF (pxmax-pxmin)/xtics < 5 THEN xtics=MAX(FLOOR(xtics/5),1) xline1=FLOOR(pxmin/xtics)*xtics xline2=CEIL(pxmax/xtics)*xtics !px=FLOOR(LOG10(ABS(xtics))) GR.TEXT.ALIGN 3 FOR x=xline1 TO xline2 STEP xtics Newx=(x-pxmin)*sx:Newy=(pymax-pymin)*sy*0.97 g$=frmgraph$(x,-1) GR.COLOR 200,0,0,0,1:GR.TEXT.DRAW txt3,newx,newy,g$:GR.COLOR 50,0,0,0,1:GR.LINE xxx,newx,1,newx,newy NEXT GR.SET.STROKE 5 Oldx=(x[1]-pxmin)*sx:Oldy=(pymax-y[1])*sy GR.COLOR 200,0,0,200,1 FOR i=1 TO n Newx=(x[i]-pxmin)*sx:Newy=(pymax-y[i])*sy GR.COLOR 50,0,0,200,1:GR.CIRCLE p,newx+5,newy+5,5:GR.COLOR 200,0,0,200,1 ! GR.line lol,oldx,oldy,newx,newy ! GR.POINT p,newx,newy GR.CIRCLE p,newx,newy,5 ! Oldx=newx:Oldy=newy NEXT IF slope <=0 THEN GR.COLOR 80,0,255,0,1 ELSE GR.COLOR 80,255,0,0,1 GR.SET.STROKE 9 X1=pxmin:Y1=slope*x1+intercept:Xn=pxmax:Yn=slope*xn+intercept GR.LINE fl,(x1-pxmin)*sx,sy*(pymax-y1),sx*(xn-pxmin),sy*(pymax-yn) GR.TEXT.SIZE 25:GR.COLOR 200,50,50,50,1:GR.SET.STROKE 1:GR.TEXT.ALIGN 3 s=slope:s$="" GR.TEXT.DRAW txt3,acwidth*0.9,acheight*0.1,frmgraph$(s,-2)+s$ GR.TEXT.ALIGN 2:GR.COLOR 255,0,0,0,1 GR.TEXT.DRAW txt2,acwidth*0.5,acheight*0. 93,xname$ GR.ROTATE.START -90,acwidth*0.1,acheight*0.5 GR.TEXT.DRAW txt2,acwidth*0.05,acheight*0.5,yname$ GR.ROTATE.END:CALL Render() WAKELOCK 3 Cr$="\n":px=-2:py=-2 DO wait():bk=(bkhit()|BACKGROUND()) IF bk THEN D_U.BREAK GR.TOUCH touched,xx,yy:GR.SCREEN newwidth,newheight IF newwidth<>acwidth THEN flip=1:D_U.BREAK UNTIL touched IF bk THEN D_U.BREAK UNTIL !flop IF bk WAKELOCK 5 FN.RTN 0 ENDIF msg$=yname$+cr$ Msg$+=INT$(n)+" entries in "+INT$(xrange+1)+" days"+cr$ msg$+="Average= "+frmgraph$(yavg,py)+cr$ msg$+="Median = "+frmgraph$(median(y[]),-1)+cr$+"Standard Deviation = "+frmgraph$(ysd,py)+cr$+"Min = "+frmgraph$(yymin,py)+cr$+"Max = "+frmgraph$(ymax,py)+cr$+"range = "+frmgraph$(ymax-yymin,py)+cr$ msg$+="r*r="+frmgraph$(rr,-2)+cr$ IF msg$<>"" THEN DIALOG.MESSAGE ,msg$ ,c,"okay" GR.CLS dm("h") WAKELOCK 5 FN.RTN 0 FN.END !plot delimited file f$ !plot y axis relative to ymax if r is TRUE ! FN.DEF PlotFile(f$,xname$,yname$,dlm$,r) IF !iSOLD(f$)THEN FN.RTN 0 TEXT.OPEN R,FN2,f$:xfield=1:yfield=2 LIST.CREATE n,xx:LIST.CREATE n,yy DO TEXT.READLN FN2,a_line$:TEXT.EOF fn2,eof IF !eof&a_line$<>"" d$=WORD$(a_line$,xfield,dlm$):x=calcdate(&d$) IF x>0 THEN LIST.ADD xx,x:LIST.ADD yy,val2(WORD$(a_line$,yfield,dlm$)) ENDIF UNTIL eof TEXT.CLOSE FN2:UNDIM x[]:UNDIM y[]:LIST.SIZE xx,xn:LIST.SIZE yy,yn IF !xn|!yn THEN POPUP "no points":FN.RTN 0 LIST.TOARRAY xx,x[]:LIST.TOARRAY yy,y[] ScatterPlot(x[],y[],xname$,yname$,r) LIST.CLEAR xx:LIST.CLEAR yy FN.END FN.DEF PlotBundle(b,xname$,yname$,r) LIST.CREATE n,l2:LIST.CREATE n,l1 BUNDLE.KEYS b,lll:LIST.SIZE lll,z IF z<2 POPUP "need more points":FN.RTN 0 ENDIF UNDIM ll$[]:LIST.TOARRAY lll,ll$[]:ARRAY.SORT ll$[] FOR i=1 TO z K$=ll$[i]:BUNDLE.GET b,k$,v:x=VAL(k$) IF x>0 THEN LIST.ADD l1,x:LIST.ADD l2,v NEXT UNDIM x[]:UNDIM y[]:LIST.TOARRAY l1,x[]:LIST.TOARRAY l2,y[] drawgraph(x[],y[],xname$,yname$,r) UNDIM x[]:UNDIM y[]:LIST.CLEAR l1:LIST.CLEAR l2:UNDIM ll$[]:BUNDLE.CLEAR lll FN.END FN.DEF calcperiodCals(b,p,eating) BUNDLE.GET 1,"db",db now=FLOOR(now())-1 FOR d=now-365 TO now LET d$=juliantogreg$(d) LET n=0 LET t=0:CALL DateTotal(d$,&n,&t) IF n & !first THEN first=d IF !n THEN F_N.CONTINUE LET w$=INT$(FLOOR((d-first)/p)*p+first) IF eating THEN t+=exercise(d$) IF t THEN CALL tallybundle(&b,w$,t) NEXT FN.END FN.DEF GraphPeriodCals(p,eating) BUNDLE.CREATE b calcperiodcals(&b,p,eating) PlotBundle(b,period$(p),"cals/pts",0) FN.END FN.DEF plotcalsvsitems() !graph of total daily calories vs number of items eaten BUNDLE.GET 1,"db",db LIST.CREATE n,xx LIST.CREATE n,yy startd=FLOOR(now())-1 BUNDLE.CREATE b DIM x[366],y[366] FOR d=startd-365 TO startd LET n=0 LET t=0 LET d$=juliantogreg$(d) CALL DateTotal(d$,&n,&t) t+=exercise(d$) LET c=0:IF n THEN LET c=t LET j=d-startd+366 IF n THEN LIST.ADD xx,n:LIST.ADD yy,c NEXT LIST.SIZE xx,z IF z LIST.TOARRAY xx,x[] LIST.TOARRAY yy,y[] CALL ScatterPlot(x[],y[],"items","daily cals",2) ELSE POPUP "not enough data!" ENDIF BUNDLE.CLEAR b LIST.CLEAR xx LIST.CLEAR yy UNDIM x[] UNDIM y[] FN.END FN.DEF calccals(b,startd) !PRE:startd = julian date of starting date !POST:bundle is assigned date,total calories BUNDLE.GET 1,"db",db LET now=FLOOR(now())-1 FOR d=startd TO now LET d$=juliantogreg$(d):LET n=0:LET t=0:CALL DateTotal(d$,&n,&t) IF t THEN BUNDLE.PUT b,INT$(d),t NEXT FN.END FN.DEF pickmeasure$(p$) BUNDLE.GET 1,"db",db LIST.CREATE s,mmenu SQL.QUERY cursor,db,"diary","food","food like '#%' group by food" SQL.QUERY.LENGTH n,cursor IF n<1 THEN POPUP "no measurements":FN.RTN "" FOR i=1 TO n SQL.NEXT done,cursor,cv1$ cv1$=TRIM$(cv1$) IF !done LIST.SEARCH mmenu, cv1$, e IF !e LIST.ADD mmenu, cv1$ ENDIF ENDIF NEXT LIST.ADD mmenu,"cancel" m$=asklist$(mmenu,p$,c) IF m$="cancel" THEN m$="" FN.RTN m$ FN.END FN.DEF graphmeasure(m$) BUNDLE.CREATE b BUNDLE.GET 1,"db",db m$=pickmeasure$("graph measure") IF m$="" THEN FN.RTN 0 now=FLOOR(now()) FOR d=now-365 TO now d$=juliantogreg$(d) itemtotal(d$,m$,&nn,&tot) IF nn BUNDLE.PUT b, INT$(d),tot ENDIF NEXT plotbundle(b,"date",m$,3) FN.END FN.DEF graphmeasure2() BUNDLE.CREATE b BUNDLE.GET 1,"db",db mx$=pickmeasure$("x") IF mx$="" THEN FN.RTN 0 dx=askyn(mx$+":use previous day?") my$=pickmeasure$("y") IF my$="" THEN FN.RTN 0 dy=askyn(my$+":use previous day?") LIST.CREATE n,x LIST.CREATE n,y now=FLOOR(now()) FOR d=now-365 TO now LET d$=juliantogreg$(d) LET d1$=juliantogreg$(d-1) IF dx CALL itemtotal(d1$,mx$,&nx,&vx) ELSE CALL itemtotal(d$,mx$,&nx,&vx) ENDIF IF dy CALL itemtotal(d1$,my$,&ny,&vy) ELSE CALL itemtotal(d$,my$,&ny,&vy) ENDIF IF nx & ny LIST.ADD x,vx LIST.ADD y,vy ENDIF NEXT IF dx THEN mx$+="(-1)" IF dy THEN my$+="(-1)" plotxy(x,y,mx$,my$) FN.END FN.DEF GraphCals(histo) !graph daily calories or histogram if histo=1 IF histo THEN d=365 ELSE d=7 g=inputint("days to go back","",d) startd=calcdate(getdate$())-g BUNDLE.CREATE b calccals(&b,startd) IF !histo PlotBundle(b,"days ago","cals/pts",0) ELSE plothist(b,"cals") ENDIF BUNDLE.CLEAR b FN.END FN.DEF calcitems(b) !count items in bundle date,count BUNDLE.GET 1,"db",db now=FLOOR(now())-1 FOR d=now-365 TO now LET d$=juliantogreg$(d):LET n=0:LET t=0:CALL DateTotal(d$,&n,&t) IF n THEN BUNDLE.PUT b,INT$(d),n NEXT FN.END FN.DEF histitems() !make items histogram BUNDLE.CREATE b calcitems(&b) plothist(b,"items"):BUNDLE.CLEAR b FN.END FN.DEF calcperioditems(b,p) !count grouped items over daily period p BUNDLE.GET 1,"db",db now=FLOOR(now()) FOR d=now-365 TO now LET d$=juliantogreg$(d):n=0 LET t=0 CALL DateTotal(d$,&n,&t) IF n & !first THEN first=d IF !n THEN F_N.CONTINUE LET w$=INT$(FLOOR((d-first)/p)*p+first) CALL tallybundle(&b,w$,n) NEXT FN.END FN.DEF calcperiodexer(b,p) !count grouped exercise over daily period p BUNDLE.GET 1,"db",db now=FLOOR(now()) FOR d=now-365 TO now d$=juliantogreg$(d) w$=INT$(FLOOR(d/p)*p) t=exercise(d$) IF t THEN CALL tallybundle(&b,w$,t) NEXT FN.END FN.DEF GraphExercise(p) BUNDLE.CREATE b calcperiodexer(&b,p) PlotBundle(b,period$(p),"burned",0) BUNDLE.CLEAR b FN.END FN.DEF GraphTimeCal() BUNDLE.CREATE b now=FLOOR(now()) FOR d=now-365 TO now-1 LET d$=juliantogreg$(d) LET t=TimeCalAvg(d$) IF t THEN CALL tallybundle(&b,INT$(d),t) NEXT CALL PlotBundle(b,"date","avg time",0) BUNDLE.CLEAR b FN.END FN.DEF GraphItems(p) BUNDLE.CREATE b calcperioditems(&b,p) PlotBundle(b,period$(p),"item",0) BUNDLE.CLEAR b FN.END FN.DEF GraphMarks(p,type) BUNDLE.CREATE b BUNDLE.GET 1,"db",db SQL.QUERY cursor,db,"diary","date,food","" SQL.QUERY.LENGTH n,cursor FOR i=1 TO n SQL.NEXT done,cursor,cv1$,cv2$ LET d=calcdate(cv1$) IF ismarked(cv2$)=type IF !first THEN first=d LET w$=INT$(FLOOR((d-first)/p)*p+first) CALL tallybundle(&b,w$,1) ENDIF NEXT IF type=1 THEN t$="stars" ELSE t$="frowns" PlotBundle(b,"date",t$,0) BUNDLE.CLEAR b FN.END FN.DEF Graphstarsvsfrowns() BUNDLE.CREATE b FOR d=now()-365 TO now() d$=juliantogreg$(d) s=stars(d$) f=frowns(d$) IF s+f>0 r=FLOOR(100*(100*s)/(s+f))/100 tallybundle(&b,INT$(d),r) ENDIF NEXT PlotBundle(b,"date","%stars/frowns",0) BUNDLE.CLEAR b FN.END !plot weekly frequency of a single food item ! FN.DEF PlotFood() BUNDLE.CREATE b f$=autocomplete$("Enter food name:") KB.HIDE LIST.CREATE s,v BUNDLE.GET 1,"db",db SQL.QUERY cursor,db,"diary","date,food","" SQL.QUERY.LENGTH n,cursor FOR i=1 TO n SQL.NEXT done,cursor,cv1$,cv2$ d=calcdate(cv1$) w$=INT$(FLOOR(d/7)*7) IF TRIM$(cv2$)=f$ THEN tallybundle(&b,w$,1) NEXT PlotBundle(b,"week",f$,0) BUNDLE.CLEAR b FN.END FN.DEF calcbin(X,iv,minx,maxx) FN.RTN FLOOR((x-minx)/iv)+1 FN.END FN.DEF binlow(b,iv,minx,maxx) FN.RTN CEIL((b-1)*iv)+minx FN.END FN.DEF binhigh(b,iv,minx,maxx) FN.RTN CEIL((b)*iv)+minx-1 FN.END FN.DEF Histogram(x[],cutoff,n$) !el=clock() Maxbins=500 ARRAY.LENGTH i,x[]:ARRAY.AVERAGE avg,x[] ARRAY.STD_DEV sd,x[]:ARRAY.MIN Minx,x[] ARRAY.MAX Maxx,x[]:ARRAY.SORT x[] IF I < 3 THEN FN.RTN 0 IF i/2<>FLOOR(i/2) Median=x[FLOOR((i+1)/2)] ELSE Median=(x[FLOOR((i)/2)]+x[FLOOR((i)/2)+1])/2 ENDIF Nbins=min(FLOOR(POW(i,(1/3))),maxbins) iv=((maxx-minx)/nbins) IF iv<1 THEN iv=1 Cr$="\n":Ff$="#######.####" Stat$="n="+INT$(i)+cr$+"Average="+FORMAT$(ff$,avg)+cr$+"Standard Deviation="+FORMAT$(ff$,sd)+cr$+"Min="+FORMAT$(ff$,Minx)+cr$+"Max="+FORMAT$(ff$,Maxx)+cr$+"Median="+FORMAT$(ff$,median) dm("g") GR.ORIENTATION 0:GR.SCREEN w,h:GR.STATUSBAR statush,statshow IF statshow THEN h-=statush POPUP "swipe finger left/right to change interval size" DIM bins[maxbins] DO Nbins=calcbin(maxx,iv,minx,maxx) nbins=MIN(nbins,maxbins) ARRAY.FILL bins[1,nbins],0 FOR j=1 TO i ! B=calcbin(x[j],iv,minx,maxx) B=min(FLOOR((x[j]-minx)/iv)+1,maxbins):BINS[b]++ NEXT Avgbin=calcbin(avg,iv,minx,maxx) Sd1bin=calcbin(avg-sd,iv,minx,maxx) Sd2bin=calcbin(avg+sd,iv,minx,maxx) Medbin=calcbin(median,iv,minx,maxx) binmax=0 FOR k=1 TO nbins binmax=MAX(binmax,bins[k]) !ARRAY.MAX binmax,bins[1,nbins-1] NEXT Maxh=binmax:sx=w/nbins sy=h/binmax:diwidth=nbins*sx diheight=binmax*sy:Th=FLOOR(23*h/480) GR.CLS:GR.SET.STROKE 1 FOR bin=1 TO nbins !RED by default GR.COLOR 255,255,0,0,1 IF bin=sd1bin|bin=sd2bin THEN GR.COLOR 255,255,0,100,1 IF avgbin=bin THEN GR.COLOR 255,0,100,0,1 IF medbin=bin THEN GR.COLOR 255,0,0,255,1 GR.RECT lx,(bin-1)*sx,(maxh-bins[bin])*sy,bin*sx,maxh*sy IF nbins<16 F=1:GR.SET.STROKE 1 !grey text GR.COLOR 255,70,70,70,1:GR.TEXT.SIZE th:GR.TEXT.ALIGN 2 V1=binlow(bin,iv,minx,maxx):V2=binhigh(bin,iv,minx,maxx) !IF bins[bin]=binmax ! GR.TEXT.SIZE ceil(th/2) ! GR.TEXT.DRAW txt1,(bin-0.5)*sx,sy*maxh*0.05,INT$(binmax) ! ENDIF GR.TEXT.SIZE th GR.TEXT.DRAW txt1,(bin-0.5)*sx,sy*maxh*0.92,INT$(v1)+"-" GR.TEXT.DRAW txt1,(bin-0.5)*sx,sy*maxh*0.97,INT$(v2) ENDIF NEXT GR.TEXT.SIZE th*0.75:GR.COLOR 255,0,255,0,f:GR.TEXT.ALIGN 3 GR.TEXT.DRAW txt2,nbins*sx*0.95,maxh*sy*0.1,n$ GR.TEXT.DRAW txt2,nbins*sx*0.95,maxh*sy*0.15,INT$(iv)+" binsize" GR.TEXT.DRAW txt2,nbins*sx*0.95,maxh*sy*0.20,INT$(nbins)+" bins" GR.TEXT.DRAW txt2,nbins*sx*0.95,maxh*sy*0.25,INT$(binmax)+" binmax" CALL Render() tstart=CLOCK():Wait=0 DO GR.TOUCH touched,xx,yy IF wait=0&(CLOCK()>tstart+3000) Wait=1 !Draw a empty green rect fill=0:GR.SET.STROKE 2:GR.COLOR 255,0,200,0,fill l=w*0.1:t=h*0.1:r=w*0.3:b=h*0.3 GR.RECT qb1,l,t,r,b !Label it GR.TEXT.SIZE 50:GR.COLOR 255,0,255,0,1:GR.TEXT.ALIGN 2 GR.TEXT.DRAW qb2,w*0.2,h*0.2,"QUIT":CALL Render() ENDIF IF wait=1&(CLOCK()>tstart+7000) Wait=0:GR.HIDE qb1:GR.HIDE qb2:CALL Render() Tstart=CLOCK() ENDIF IF bkhit() THEN D_U.BREAK UNTIL touched IF yy>h/2&xx>3 THEN iv=FLOOR((maxx-minx)*(xx/(2*w))) IF iv<1 THEN iv=1 ENDIF IF bkhit() THEN D_U.BREAK UNTIL (yy3 Histogram(&x[],0,name$) ELSE POPUP "not enough data" ENDIF FN.END ! ! GRAPHS end here ! !end declare FN.DEF dm(m$) !PRE:m$=(h)tml (g)graphics or (g2) white background graphics or "" for console !POST:display mode is switched and recorded BUNDLE.GET 1,"mode",oldm$ IF oldm$=m$ if m$="g" | m$="g2" then gr.cls FN.RTN 0 endif BUNDLE.PUT 1,"mode",m$ IF oldm$="h" THEN HTML.CLOSE IF oldm$="g"|oldm$="g2" THEN GR.CLOSE IF m$="console"|m$="" THEN CLS:FN.RTN 0 IF m$="h" THEN HTML.OPEN 0:HTML.ORIENTATION 1:FN.RTN 0 IF m$="g" THEN GR.OPEN 255,0,0,0,0,1 IF m$="g2" THEN GR.OPEN 255,255,255,255,0,1 FN.END FN.DEF val2(s$) IF IS_NUMBER(s$) THEN FN.RTN VAL(s$) FN.RTN 0 FN.END fn.def clamp(v,min,max) fn.rtn min(max(v,min),max) fn.end fn.def entermacros(prompt$,carbs,fat,protein,cals) bundle.create m bundle.put m,"fat",fat bundle.put m,"protein",protein bundle.put m,"carbs",carbs array.load def$[],"carbs",str$(carbs),"0","50","fat",str$(fat),"0","50","protein",str$(protein),"0","50" ok=enterbundle(prompt$,&m,def$[]) if ok bundle.get m,"fat",fat bundle.get m,"carbs",carbs bundle.get m,"protein",protein cals=4*carbs+4*protein+9*fat FN.rtn m else fn.rtn 0 endif FN.end FN.DEF enterbundle(prompt$,b, def$[]) ! prompt user to change bundle values ! def$[] is a list of ! each element has: ! "name",bundle b key name ! "val",default value ! "min",min clamp if number ! "max",max clamp if number dm("") LIST.CREATE s,menu ARRAY.LENGTH nd,def$[] ! set defaults FOR i=1 TO nd STEP 4 BUNDLE.PUT b,def$[i],val2(def$[i+1]) NEXT do LIST.CLEAR menu FOR i=1 TO nd STEP 4 BUNDLE.GET b,def$[i],v LIST.ADD menu,def$[i]+":"+int$(v) NEXT LIST.ADD menu,"ok" DIALOG.SELECT c,menu,prompt$ if c<1 then fn.rtn 1 LIST.GET menu,c,s$ IF s$="ok" THEN D_U.BREAK IF IS_IN(":",s$) key$=WORD$(s$,1,":") v=val2(WORD$(s$,2,":")) ! INPUT key$,v,v,canc min=val2(def$[(c-1)*4+1+2]) max=val2(def$[(c-1)*4+1+3]) v=slider(key$,v,min,max) v=CLAMP(v,min,max) BUNDLE.PUT b,key$,v ENDIF until s$="ok" fn.rtn 1 FN.END FN.DEF slider(label$,default,min,max) dm("g") GR.SCREEN w,h ! w*=0.5:h*=0.5 GR.COLOR 200,0,0,0 GR.RECT box,0,h/2,w,h/2+h/13 GR.SHOW box GR.COLOR 255,255,0,0 v=default x=(v-min)*w/(max-min) GR.CIRCLE slider,x,h/2+h/26,h/20 GR.COLOR 255,255,255,255 GR.TEXT.SIZE h/14 GR.TEXT.ALIGN 2 GR.TEXT.DRAW lbl,w/2,0.4*h,int$(v) GR.TEXT.DRAW txt,w/2,0.3*h,label$ GR.COLOR 255,0,255,0 GR.TEXT.DRAW ok,w/2,0.8*h,"OK" GR.SHOW slider GR.RENDER DO GR.TOUCH t,x,y ! x*=0.5:y*=0.5 IF t&y<0.75*h v=(x/(w-1))*(max-min)+min ! v=FLOOR(v*10)/10 v=floor(v) GR.MODIFY slider,"x",x GR.MODIFY lbl,"text",int$(v) ENDIF GR.RENDER UNTIL t&y>3*h/4 GR.HIDE lbl GR.HIDE slider GR.HIDE txt GR.HIDE box GR.HIDE ok GR.RENDER FN.RTN v FN.END FN.DEF LoadBundle(b$,b) !Load string bundle b from file b$ BUNDLE.CLEAR b D$="\t" FILE.EXISTS e,b$ IF !e THEN FN.RTN 0 GRABFILE f$,b$ SPLIT ff$[],f$,"\n" ARRAY.LENGTH z,ff$[] FOR i=1 TO z ! SPLIT s$[],ff$[i],d$ ! ARRAY.LENGTH zz,s$[] !IF zz=2 THEN BUNDLE.PUT b,TRIM$(s$[1]),TRIM$(s$[2]) LET s$=ff$[i] LET key$=TRIM$(WORD$(s$,1,d$)) LET v$=TRIM$(WORD$(s$,2,d$)) BUNDLE.PUT b,key$,v$ NEXT FN.END FN.DEF SaveBundle(db$,b) !write string bundle TEXT.OPEN w,f,db$:BUNDLE.KEYS b,l:LIST.SIZE l,z IF z<1 THEN TEXT.WRITELN f,"":TEXT.CLOSE f:FN.RTN 0 LIST.TOARRAY l,ll$[]:ARRAY.SORT ll$[] FOR i=1 TO z K$=ll$[i]:IF k$<>"" THEN BUNDLE.GET b,k$,v$:TEXT.WRITELN f,k$+"\t"+v$ NEXT TEXT.CLOSE f FN.END FN.DEF nchr$(a$,n) FOR I=1 TO n:x$+=a$:NEXT FN.RTN x$ FN.END FN.DEF Stg$(c) FN.RTN LEFT$(STR$(c),IS_IN(".",STR$(c))-1) FN.END FN.DEF pick$(c,a$,b$) IF c FN.RTN a$ ELSE FN.RTN b$ ENDIF FN.END FN.DEF dow$(d$) LET j=calcdate(d$):sun=2451546:d=MOD(j-sun,7) FN.RTN "("+WORD$("sun,mon,tues,wed,thur,fri,sat",d+1,",")+")" FN.END FN.DEF clk$(s$) !html clickable element LET s$=REPLACE$(s$,"'","#") FN.RTN " onclick=~DL('"+s$+"')~ " FN.END FN.DEF weekavg() BUNDLE.GET 1,"db",db !calculate average calories for 7 days prior to today LET d=FLOOR(now()):j1=d-7:j2=d-1 FOR j=j1 TO j2 LET dayt=0:LET dd$=juliantogreg$(j):cc=0:DateTotal(dd$,&cc,&dayt) IF dayt THEN wktot+=dayt:dayct++ NEXT IF dayct FN.RTN FLOOR(wktot/dayct) ELSE FN.RTN 0 ENDIF FN.END FN.DEF now() !get julian date/time TIME y$,m$,d$,h$,mi$,s$ LET j=calcdate(m$+"-"+d$+"-"+y$) LET f=VAL(h$)/24+VAL(mi$)/(24*60) FN.RTN j+f FN.END FN.DEF atehours() !hours since last food IF rset("atelast") THEN e=now()-rset("atelast"):e=FLOOR(24*e*100)/100 FN.RTN FLOOR(e*10)/10 FN.END FN.DEF calcdate(s$) !return julian date or number IF IS_IN("-",s$) THEN FN.RTN date2julian(s$) IF s$="" THEN FN.RTN -1 IF IS_NUMBER(s$) THEN FN.RTN VAL(s$) FN.RTN 0 FN.END ! set current diary date FN.DEF setcurrent(j) j$=juliantogreg$(FLOOR(j)) BUNDLE.PUT 1,"current",j$ FN.END ! FN.DEF imgKeybd$() imgKeybd$="\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAADIAAAAuCAMAAABd9bpjAAAAIVBMVEVHcEz/pwD/pgD/qwD/rQD/rQD/ngD/pQD//gD/uwD/4gB7Dtm2AAAACHRSTlMABkXY4qokeUKPsecAAAF8SURBVEjHtVUBksMgCFwQQP3/gw9Nk5iOTerNHa1jtGxhYTXAralj1aqC/hlCqxAigLN9DaHu6FmWaJDWrCuA8M9phXkJf16JwLn6XrJvEfJcndFADUEfbcqjPBeTL+bVjW+MAI5qXux9/f4zI5U1oZbUvksWIQJCewPoUdl0QDAO2sdLncPWBfL1ERqiGGAEtCkGM8AGi0F9pr51gdQMzgWaE0rmtvS+1D5L9tgyEOEDxJE3SIplm8sOwQBRgYmCxaHJoApTByvHcHjMqvRIn+7pUyngqtDqKNVQKzwrUvbORxq92L5E6clL+GhPOpaNlsTyrAhd6FP/2w1S8hGlBdWqkMoo5ZnLKaS5YI4SbRVLAk4OFweLQoWhiT62smbG0ZfGZejLXfc3alv3Zd5920RFTDADiACjU+Av6c3p03Ann5DzeVDy9YBMuv8X5+XSjPfPA+QXUVYhZLPbbvCYRfHJnWqridGU/oJ1yNpLF1LgNcmCpeogLUum9AOb1RC9TVHRXAAAAABJRU5ErkJggg==\"" !FN.END !FN.DEF chart$() LET c$= "\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAGQAAABcBAMAAABq5Q2nAAAAHlBMVEVHcEz/pwD/rwD/rwD/rwD/rwD/rgD/rwD/rwD/rwBVGcEMAAAACXRSTlMACvhQuKBoH+jxKF+8AAAAfElEQVR4Xu3XsQmAQAyG0cQJjCO4hZ1u4BqWlnY6gmW2tfAwgbMIohzC/5EiBN4AobxOXTtlvUR626tCBKT1jSGiviCZ5WoKkpopDYWJ7T8iICAsvhBZ1PcZWe3CBQkICAgICAgICAgIiFiJDHZpTrKJpXfPu7ryN+EJOQB+ioXWCwHglQAAAABJRU5ErkJggg==\"" chart$="" !FN.END !FN.DEF imgGreen$() imgGreen$= "\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAFAAAABQBAMAAAB8P++eAAAAD1BMVEVHcEwA/wAA/wAA/wAA/wC2nKdNAAAABXRSTlMA+r5FetmuAAoAAAJSSURBVHhezZZbcusgDIblwALyAwuIaBcAdRYAife/pjM+IZUodZhpX6oHm4HPPxejC/0lW7fb+7bOKHNDs/f0irtC2dsxt8u59/u6Xm+8ix5xFXD3T3EGwhHXa9wOyA9Zle4ZzEqvJssAMjwNluGGj1vX7HMDtAOe9Oej4/3oJY2e2GybUuFOMuMiGv3vO3WSLIIWbtsYRY/JV0qwhvZ82qIHZR3m0TS6Rz5SzVNrVi3z3czLWd7DcAa9Aulz3xwUeGkyCqxt30bNTPkJen0oSd7HoChlR69BYi9LPAZlkTjPwAVtBTPwhNSeI2gFbFpN9xCU1WVHs6mJ/4NhDlbfXb0YYxHQxhi7S8pePA4XAU8QD8zuMX8D3Zo16Fd+gssXkJazgMuZfgjie/DcgejBx3C74cvlC8ga9E9w39aLNdpgXTu5UguBvgUJO/uIERa7nBNQH/g+hJRdIjLsDcg60gdeg/rP1RtGjHApB/W/a+guxeLJolgGXLIoKlpU3+aXuFNdoTWR5UCE1F2zBfo2GYaLkeESnYK+uOIKrWkiAMSkfKk1W4d4rlnXpAKJaCl3tQhN3uigu2AIAKdHojY3aCeubgwplgEiwJUxpPSOTdcdvFPv1vJWtoMkppQ4vARl/xlfQe47/BDNTYyAI2IgxjQME4JybUSiCOXUFWNCsuqkuAwJScRtELAWSXFDYrRu+zQuMjakYQtlRdLwkNjNpuwBtk1NS4XcBEUSZVJ8zMqZt58VSPOSa17EzctCI2XhvND8Vek6FsP3X5XXY8H+h+wfseRa+TymMs0AAAAASUVORK5CYII=\"" !FN.END FN.DEF isold(f$) FILE.EXISTS e,f$:FN.RTN e FN.END FN.DEF rset(s$) !PRE:s$ is setting name !POST:RETURNs value of setting s$ or 0 if not found BUNDLE.GET 1,"cache",sc BUNDLE.CONTAIN sc,s$,e IF e BUNDLE.GET sc,s$,v FN.RTN v ENDIF !tone 550,120 BUNDLE.GET 1,"db",db SQL.QUERY c, db, "settings","value","setting='"+s$+"'" SQL.NEXT done,c,v$ IF v$="" THEN v$="0" IF IS_NUMBER(v$) LET v=VAL(v$) BUNDLE.PUT sc,s$,v FN.RTN v ENDIF FN.RTN 0 FN.END FN.DEF wset(s$,v) BUNDLE.GET 1,"cache",sc BUNDLE.CONTAIN sc,s$,e IF e BUNDLE.GET sc,s$,v2 IF v2=v THEN FN.RTN 0 ENDIF BUNDLE.GET 1,"db",db ! tone 600,42 SQL.DELETE db,"settings","setting='"+s$+"'" SQL.INSERT db,"settings","setting",s$,"value",STR$(v) BUNDLE.PUT sc,s$,v FN.END LET st=CLOCK() FN.DEF getdate$() TIME Y$,M$,D$,H$,Mi$,S$,WkD,DST FN.RTN m$+"-"+d$+"-"+y$ FN.END FN.DEF Render() IF !BACKGROUND() THEN GR.RENDER FN.END FN.DEF avgitem() BUNDLE.GET 1,"db",db SQL.QUERY c,db,"diary","calories","food not like '#%'" DO SQL.NEXT done,c,cv1$ IF !done & IS_NUMBER(cv1$) LET v=VAL(cv1$) IF v>0 THEN nn++:tot+=v ENDIF UNTIL done IF nn THEN FN.RTN tot/nn FN.END FN.DEF DateTotal(d$,nn,tot) ! total calories and count for date d$ BUNDLE.GET 1,"db",db SQL.QUERY c,db,"diary","calories","food not like '#%' and date='"+d$+"'" DO SQL.NEXT done,c,cv1$ IF !done & IS_NUMBER(cv1$) LET v=VAL(cv1$):tot+=v IF v>0 THEN nn++ ENDIF UNTIL done FN.END FN.DEF miltodec(m$) h=val2(MID$(m$,1,2)) m=val2(MID$(m$,4,2)) FN.RTN h+m/60 FN.END FN.DEF TimeCalAvg(d$) ! avg weighted time for date d$ BUNDLE.GET 1,"db",db SQL.QUERY c,db,"diary","calories,time","food not like '#%' and date='"+d$+"'" DO SQL.NEXT done,c,cv1$,cv2$ IF !done & IS_NUMBER(cv1$) LET v=VAL(cv1$) IF v>0 t=miltodec(cv2$) tot+=v*t:ctot+=v n++ ENDIF ENDIF UNTIL done IF ctot>0 FN.RTN tot/ctot ENDIF FN.RTN 0 FN.END FN.DEF stars(d$) ! total stars for date d$ BUNDLE.GET 1,"db",db SQL.QUERY c,db,"diary","calories,food","food not like '#%' and date='"+d$+"'" DO SQL.NEXT done,c,cv1$,cv2$ IF !done & IS_NUMBER(cv1$) &(ismarked(cv2$)=1) LET v=VAL(cv1$) IF v>0 THEN nn++ ENDIF UNTIL done FN.RTN nn FN.END FN.DEF frowns(d$) ! total frowns for date d$ BUNDLE.GET 1,"db",db SQL.QUERY c,db,"diary","calories,food","food not like '#%' and date='"+d$+"'" DO SQL.NEXT done,c,cv1$,cv2$ IF !done & IS_NUMBER(cv1$) &(ismarked(cv2$)=-1) LET v=VAL(cv1$) IF v>0 THEN nn++ ENDIF UNTIL done FN.RTN nn FN.END FN.DEF ItemTotal(d$,f$,nn,tot) ! total and count for date d$ and food f$ LET nn=0: LET tot=0 f$=TRIM$(f$) BUNDLE.GET 1,"db",db SQL.QUERY c,db,"diary","sum(calories),count(_id)","food='"+f$+"' and date='"+d$+"' GROUP BY date" SQL.NEXT done,c,cv1$,cv2$ IF !done & IS_NUMBER(cv1$) &IS_NUMBER(cv2$) tot=VAL(cv1$) nn=VAL(cv2$) ENDIF FN.END FN.DEF IsMarked(f$) LET f$=TRIM$(f$) LET f$=WORD$(f$,1,":") BUNDLE.GET 1,"marklist",b:BUNDLE.CONTAIN b,f$,e IF !e THEN FN.RTN 0 BUNDLE.GET b,f$,m$ IF m$="-" THEN FN.RTN -1 ELSE FN.RTN 1 FN.END FN.DEF LOG(msg$) ! FN.RTN 0 % comment out for debugging f$="acaldebug.oli" TIME Year$,Month$,Day$,Hour$,Minute$,Second$,WeekDay,isDST Date$=month$+"-"+day$+"-"+year$+" "+hour$+":"+minute$+":"+second$ m$=date$+msg$ TEXT.OPEN a,h,f$:TEXT.WRITELN h,m$:TEXT.CLOSE h FN.END FN.DEF readln$(f$) FILE.EXISTS e,f$ IF e THEN GRABFILE a$,f$ FN.RTN TRIM$(a$) FN.END ! for debugging FN.DEF inspect(s$) TEXT.INPUT s$,s$ FN.END FN.DEF writeln(f$,msg$) TEXT.OPEN w,h,f$ TEXT.WRITELN h,msg$ TEXT.CLOSE h FN.END FN.DEF date2julian(d$) BUNDLE.GET 1,"date",od$ IF d$=od$ THEN BUNDLE.GET 1,"jd",jd:FN.RTN jd LET mm=VAL(WORD$(d$,1,"-")):LET dd=VAL(WORD$(d$,2,"-")):LET yy=VAL(WORD$(d$,3,"-")) LET a=FLOOR((14-mm)/12):y=yy+4800-a:m=mm+12*a-3 LET j=dd+FLOOR((153*m+2)/5)+365*Y+FLOOR(y/4)-FLOOR(y/100)+FLOOR(y/400)-32045 FN.RTN j FN.END FN.DEF juliantogreg$(jd) BUNDLE.GET 1,"oldjd",ojd IF ojd=jd THEN BUNDLE.GET 1,"greg",g$:FN.RTN g$ LET q=FLOOR((jd/36524.25)-51.12264) LET r=jd+q-FLOOR(q/4)+1:s=r+1524 LET t=FLOOR((s/365.25)-0.3343):u=FLOOR(t*365.25) LET v=FLOOR((s-u)/30.61):d=s-u-FLOOR(v*30.61) IF v>13.5 THEN cond=-1 ELSE cond=0 LET m=(v-1)+12*cond IF m<2.5 THEN cond=-1 ELSE cond=0 LET y=t-cond-4716:yr$=Stg$(y) WHILE LEN(yr$) < 4 LET yr$ = "0"+yr$ REPEAT LET mo$=Stg$(m) IF LEN(mo$) < 2 THEN mo$ = "0"+mo$ LET da$ = Stg$(d) IF LEN(da$) < 2 THEN da$ = "0"+da$ LET g$=mo$+"-"+da$+"-"+yr$ BUNDLE.PUT 1,"greg",g$ BUNDLE.PUT 1,"oldjd",jd FN.RTN g$ FN.END FN.DEF current$() BUNDLE.GET 1,"current",c$ FN.RTN c$ FN.END FN.DEF miltoampm$(s$) IF MID$(s$,3,1)<>":" FN.RTN "" ENDIF LET h$=MID$(s$,1,2) LET m$=MID$(s$,4,2) IF !IS_NUMBER(h$) | !IS_NUMBER(m$) THEN FN.RTN "" LET h=VAL(h$) IF h>=12 THEN LET ap$="p" ELSE LET ap$="a" IF h>12 THEN LET h-=12 IF h=0 THEN LET h=12 IF h<10 THEN LET b$="0" FN.RTN b$+INT$(h)+MID$(s$,3,3)+ap$ FN.END !globals BUNDLE.PUT g,"back","0" BUNDLE.PUT g,"version",456 BUNDLE.PUT g,"mode","h" BUNDLE.PUT g,"date","" BUNDLE.PUT g,"jd",0 BUNDLE.PUT g,"oldjd",0 BUNDLE.PUT g,"greg","" BUNDLE.PUT g,"home",0 BUNDLE.PUT g,"current","" BUNDLE.CREATE marklist BUNDLE.PUT g,"marklist",marklist FILE.EXISTS e,"../databases/aCal" SQL.OPEN db,"aCal" ! cache for read settings BUNDLE.CREATE cache BUNDLE.PUT g,"cache",cache IF !e SQL.NEW_TABLE db,"diary","food,calories,date,time" SQL.NEW_TABLE db,"settings","setting,value" SQL.EXEC db, "CREATE INDEX date_diary ON diary(date)" ENDIF BUNDLE.PUT g,"db",db ! diary html template LET ww$="
"+chart$+"
" BUNDLE.PUT 1,"www",ww$ FN.DEF caskyn(p$) p$=replace$(p$,"
","\n") DIALOG.MESSAGE "Acal",p$,c,"yes","no" FN.RTN (c=1) FN.END FN.DEF button$(width,bc$,click$,label$) IF label$="" THEN label$="---" FN.RTN "" FN.END ! see if this helps with memory issues FN.DEF reopendb() BUNDLE.GET 1,"db",db SQL.CLOSE db SQL.OPEN db,"aCal" BUNDLE.PUT 1,"db",db FN.END ! bundle ready flag so interrupts don't crash bready=1 ! list for voice results LIST.CREATE s,vl ! !Main ! BUNDLE.CREATE m CALL LoadBundle("marked.bun",&m) BUNDLE.PUT 1,"marklist",m IF rset("speak") THEN TTS.INIT LET date$=getdate$() CALL setcurrent(now()) IF isold("lastdate.oli") | rset("last") wset("last",FLOOR(now())) ENDIF !if it's user's first time running program save date IF !isold("lastdate.oli") & !rset("last") wset("last",FLOOR(now())) dflt$="0\n25\n50\n100\n150\n200\n250\n300\n400\n-50\n-100\n-200" IF caskyn("use points instead of calories?") dflt$="0\n1\n2\n3\n4\n5\n6\n7\n8\n-1\n-2" ENDIF writeln("quickcal.oli",dflt$) ENDIF FN.DEF ShowDiary() st=CLOCK() ! I=0:n=0:marks=0:frowns=0:total=0:burned=0 CALL dm("h") star$="☆":bad$="☹":dt$=current$():dispd$=dt$ sq$="'" IF dt$=getdate$() THEN LET dispd$="today" LET dl$="\n" !header LET X$=BUTTON$(20,"#006;","PREV","<") X$+=BUTTON$(55,"#006;","TODAY",dispd$+" "+dow$(dt$)) X$+=BUTTON$(20,"#006;","NEXT",">")+"
" !grab diary for date dt$ BUNDLE.GET 1,"db",db SQL.QUERY cursor,db,"diary","food,calories,date,time,_id","date='"+dt$+"' ORDER BY 4" DO SQL.NEXT done,cursor,s1$,s2$,s3$,s4$,s5$:IF done THEN D_U.BREAK IF MID$(s4$,1,4)=os4$ THEN LET s4$="" ELSE LET os4$=MID$(s4$,1,4) i++:LET m$="":LET ss=ismarked(s1$) IF ss=1 THEN LET m$=star$:marks++ IF ss=-1 THEN LET m$=bad$:frowns++ IF IS_NUMBER(s2$) & !IS_IN("#",s1$) LET T=VAL(s2$):total+=t IF t>0 THEN n++ ELSE burned+=-t ENDIF LET cb$="#00e;" IF MOD(i,2) THEN LET cb$="#009;" LET cs$=cb$ IF ss=1 THEN LET cs$="#0b0;" IF ss=-1 THEN LET cs$="#444;" x$+=button$(20,CS$,"EDIT "+s5$,miltoampm$(s4$)) x$+=button$(20,cs$,"TOGGLE "+s1$,s2$+m$) x$+=button$(55,cs$,"QUIT",MID$(S1$,1,22)) X$+="
" UNTIL done IF !n x$+=button$(40,cs$,"QUIT","-") x$+=button$(55,cs$,"QUIT","QUIT")+"
" ENDIF !switches LET auto$="autoquit " IF rset("auto") THEN auto$+="✔" LET listen$="autolisten"+pick$(rset("listen"),"✔","") LET autokey$="autokey"+pick$(rset("autokey"),"✔","") CALL wset("todaycal",total) LET brd$="

eat:"+INT$(total+burned)+" - burn:"+INT$(burned)+" = net:"+INT$(total)+"
week avg:"+INT$(rset("weekavg")) LET ah=atehours() brd$+="
you ate "+STR$(ah) brd$+=" hours ago
"+INT$(n)+" items " LET brd$+=LEFT$("☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆",marks)+" "+LEFT$("☹☹☹☹☹☹☹☹☹☹☹☹☹☹☹☹",frowns)+"


" BUNDLE.GET 1,"www",ww$ LET w$=REPLACE$(ww$,"",brd$) ! LET w$=REPLACE$(w$,"",stop$) LET w$=REPLACE$(w$,"",x$) LET w$=REPLACE$(w$,"",auto$) LET w$=REPLACE$(w$,"",autokey$) LET w$=REPLACE$(w$,"",listen$) LET w$=REPLACE$(w$,"~","\"") HTML.LOAD.STRING w$ ! call writeln("temp.html",w$) ! html.load.url "temp.html" ! popup int$(clock()-st) FN.END DO ct++ !listen on startup? IF rset("listen") & ct=1 ! gosub declare hear(&vl) r$="VOICE" ELSE if rset("autokey") & ct=1 r$="TYPE" ! GOSUB declare ELSE CALL ShowDiary() ! GOSUB declare LET r$=waitclick$(1) IF r$="VOICE" THEN CALL hear(&vl) ENDIF IF r$="QUIT" THEN D_U.BREAK IF r$<>"QUIT" & r$<>"MEASURE" THEN CALL PerformCommand(r$,vl) ! keyboard entry becomes simulated voice entry IF r$="TYPE" r$="VOICE" LET f$=autocomplete$("Enter food name:") dm("h") LIST.CLEAR vl IF f$<>"" THEN LIST.ADD vl,f$ CALL PerformCommand(r$,vl) ELSE if r$="MEASURE" r$="VOICE" ! GOSUB declare f$=pickmeasure$("measure") IF f$="" THEN D_U.CONTINUE dm("h") LIST.CLEAR vl IF f$<>"" THEN LIST.ADD vl,f$ CALL PerformCommand(r$,vl) ENDIF UNTIL 0 leave: BUNDLE.GET 1,"db",db SQL.CLOSE db EXIT Declare: IF declared THEN RETURN Declared=1 RETURN ONBACKKEY: BUNDLE.PUT 1,"back","1" BACK.RESUME ONCONSOLETOUCH: ct=1 IF bready BUNDLE.PUT 1,"ctouch",1 ENDIF CONSOLETOUCH.RESUME ONBACKGROUND: IF bready IF BACKGROUND() BUNDLE.PUT 1,"home",0 ELSE BUNDLE.PUT 1,"home",1 ENDIF ENDIF BACKGROUND.RESUME ONERROR: TEXT.INPUT s$,GETERROR$() EXIT