rem 12/13/86, Lee R. Bradley, incorporated terminal parameter file common today$,warm$,trmtyp$,clear$,bell$,clreol$ common escape$,poscmd$,posofs%,rowcol$ rem - program HANDYSYS.BAS rem - menu program for personal time management system rem - Copyright 1982, by Peter C. Hawxhurst rem - revised 11/11/1982 rem - revised for KAYPRO 03/02/84 rem - variable tabulation ************************* rem appoint$ = appointment descriptions rem cmnd$ = menu number selection rem cdate$ = appointment dates rem i% = for/next loop counter rem item$ = to do list item rem month$ = month for today's date rem page% = output page counter rem prog$ = program to be chained to rem q1$ = prior date output question rem q2$ = date verification rem thing$ = same as item$ rem ctime$ = appointment times rem today$ = today,s date rem - program structure *************************** if warm$="YES" then 05 warm$="YES" gosub 20000 : rem - get terminal characteristics gosub 100 : rem - logo gosub 200 : rem - today gosub 300 : rem - update 05 rem gosub 400 : rem - menu gosub 500 : rem - selection if cmnd$="0" then 10 goto 20 10 print clear$ stop 20 for i%=1 to val(cmnd$) read prog$ next i% %chain 100,10000,50,500 chain prog$ data "AGGENDAS","DO-TODAY","REMINDER" data "PLANNING","CALENDAR","NOTEBOOK" data "ACTIONPL","FONEBOOK","DECISION" 100 rem - logo subroutine ************************ print clear$ ypos%=7:xpos%=6:gosub 15000:rem - cursor print "HANDY SYSTEM" ypos%=9:xpos%=6:gosub 15000:rem - cursor print "Version 2.01" ypos%=11:xpos%=5:gosub 15000:rem - cursor print "Copyright 1982" ypos%=12:xpos%=11:gosub 15000:rem - cursor print "by" ypos%=14:xpos%=3:gosub 15000:rem - cursor print "Peter C. Hawxhurst" ypos%=16:xpos%=12-len(trmtyp$)/2:gosub 15000:rem - cursor print trmtyp$ return 200 rem - today subroutine *********************** 210 ypos%=20:xpos%=1:gosub 15000:rem - cursor print bell$; input "Enter today's date as MM/DD/YYYY >";line today$ if today$="" then 215 cdate$=today$ gosub 10000 : rem - date check if e1=0 then 220 215 print bell$; gosub 14000 : rem - rubout goto 210 220 gosub 19000 : rem - day if val(p1$)=1 then month$="January" if val(p1$)=2 then month$="February" if val(p1$)=3 then month$="March" if val(p1$)=4 then month$="April" if val(p1$)=5 then month$="May" if val(p1$)=6 then month$="June" if val(p1$)=7 then month$="July" if val(p1$)=8 then month$="August" if val(p1$)=9 then month$="September" if val(p1$)=10 then month$="October" if val(p1$)=11 then month$="November" if val(p1$)=12 then month$="December" gosub 14000 : rem - rubout gosub 15000 : rem - cursor print bell$; print "Please verify today is..." 230 print " "+day$;", ";month$;val(mid$(today$,4,2));"- ";right$(today$,4); print " (y/n) > "; while not constat%:wend:q2$=ucase$(chr$(conchar%)) if q2$="" then 235 if q2$="Y" then 240 if q2$="N" then 240 235 print bell$; ypos%=21:xpos%=1:gosub 14000:rem - rubout gosub 15000: rem - cursor goto 230 240 ypos%=21:xpos%=1:gosub 14000:rem - rubout ypos%=20:xpos%=1:gosub 14000:rem - rubout if q2$="N" then 210 return 300 rem - update subroutine ********************** if end #1 then 310 open "APPOINTS.DAT" as 1 read #1;cdate$,ctime$,appoint$ if cdate$=today$ then 395 goto 320 310 create "APPOINTS.DAT" as 1 create "DOTHINGS.DAT" as 2 print #1;today$,"0:00","Today's date" close 1 close 2 goto 300 320 ypos%=20:xpos%=1:gosub 14000:rem - rubout gosub 15000 : rem - cursor print bell$;:print gosub 15000 print "Do you wish to print prior dates data (y/n) > "; while not constat%:wend:q1$=ucase$(chr$(conchar%)) if q1$="" then print bell$;:goto 320 if q1$<>"Y" and q1$<>"N" then print bell$ if q1$<>"Y" and q1$<>"N" then 320 if q1$="Y" then gosub 700 gosub 14000 : rem - rubout print gosub 15000 : rem - cursor print "Processing records - please wait..." create "TRANS" as 2 print #2;today$,"0:00","Today's date" 330 if end #1 then 350 read #1;cdate$,ctime$,appoint$ if val(right$(cdate$,4))>val(right$(today$,4)) then 340 if val(right$(cdate$,4))val(left$(today$,2)) then 340 if val(left$(cdate$,2))val(right$(today$,4)) then 380 if val(right$(cdate$,4))val(left$(today$,2)) then 380 if val(left$(cdate$,2)) "; while not constat%:wend:cmnd$=ucase$(chr$(conchar%)) if cmnd$="" then 520 if cmnd$>"0" then 515 print clear$:goto 540 515 x$=cmnd$:gosub 11000:rem - numeric check if e1=0 then 530 520 print bell$ ypos%=21:xpos%=1:gosub 14000:rem - rubout xpos%=7:gosub 15000:rem - cursor goto 510 530 if val(cmnd$)<>int(val(cmnd$)) then 520 if val(cmnd$)<1 then 520 if val(cmnd$)>9 then 520 540 return 700 rem - printout subroutine ******************** ypos%=20:xpos%=1:gosub 14000:rem - rubout print gosub 15000 : rem - cursor input "Ready printer and press - RETURN >";line q$ lprinter 705 page%=page%+1 print print print tab(5);"PRIOR APPOINTMENTS" print print tab(8);"DATE";tab(21);"TIME";tab(30);"PERSON/REASON" print l=l+6 710 if end #1 then 740 read #1;cdate$,ctime$,appoint$ if val(left$(cdate$,2))val(left$(today$,2)) then 710 if val(right$(cdate$,4))val(right$(today$,4)) then 710 if val(mid$(cdate$,4,2))=60 then 730 goto 710 730 print:print:print tab(40);page%:print:print:print l=0 goto 705 740 close 1 open "DOTHINGS.DAT" as 1 if l>=52 then 780 750 print:print print tab(5);"PRIOR TO DO ITEMS" print print tab(8);"DATE";tab(20);"ITEM" print l=l+6 760 if end #1 then 790 read #1;cdate$,item$ if val(left$(cdate$,2))val(left$(today$,2)) then 760 if val(right$(cdate$,4))val(right$(today$,4)) then 760 if val(mid$(cdate$,4,2))=60 then 785 goto 760 780 print if l>=60 then 785 goto 780 785 print:print:print tab(40);page%:print:print:print l=0 page%=page%+1 goto 750 790 console close 1 open "APPOINTS.DAT" as 1 read #1;cdate$,ctime$,appoint$ return 10000 rem - date check subroutine ****************** 10010 rem 10020 rem - variables to check 10030 rem cdate$ = date being checked 10040 rem e1 = error switch 10050 rem i% = for/next loop counter 10060 rem p$ = substitute for date to be checked 10070 rem p1$ = month 10080 rem p2$ = day 10090 rem p3$ = year 10100 rem x = numeric counter 10110 rem 10120 e1=0 10130 p$=cdate$ 10140 if len(p$)>10 then 10340 10150 x=0 10160 for i%=1 to 10:x=x+match("#",p$,i%):next i% 10170 if x<>57 then 10340 10180 p1$=left$(p$,2):p2$=mid$(p$,4,2):p3$=right$(p$,4) 10190 if val(p1$)<1 then 10340 10200 if val(p1$)>12 then 10340 10210 if val(p2$)<1 then 10340 10220 if val(p3$)<1 then 10340 10230 if val(p1$)<>int(val(p1$)) then 10340 10240 if val(p2$)<>int(val(p2$)) then 10340 10250 if val(p3$)<>int(val(p3$)) then 10340 10260 if val(p1$)=9 and val(p2$)>30 then 10340 10270 if val(p1$)=4 and val(p2$)>30 then 10340 10280 if val(p1$)=6 and val(p2$)>30 then 10340 10290 if val(p1$)=11 and val(p2$)>30 then 10340 10300 if val(p1$)=2 and val(p2$)>29 then 10340 10310 if val(p3$)/4=int(val(p3$)/4) then 10350 10320 if val(p1$)=2 and val(p2$)>28 then 10340 10330 goto 10350 10340 let e1=1 10350 return 11000 rem - numeric check subroutine *************** 11010 rem 11020 rem - variables to check 11030 rem e1 = error switch 11040 rem i% = for/next loop counter 11050 rem x = numeric position counter 11060 rem y = decimal point locator 11070 rem z = numeric position match counter 11080 rem 11090 e1=0:x=0:y=0:z=0:y=match(".",x$,1) 11100 for i%=1 to len(x$):z=z+i%:next i% 11110 if y=0 then 11130 11120 z=z+1 11130 for i%=1 to len(x$):x=x+match("#",x$,i%):next i% 11140 if x=z then 11160 11150 e1=1 11160 return 14000 rem - rubout subroutine ******************** 14010 gosub 15000 14020 print clreol$;:gosub 15000 14030 return 15000 rem - cursor subroutine ******************** 15005 rem 15010 rem - if column (ypos%) precedes line (xpos%) 15015 rem rowcol$ should = "C" ( = 43 HEX ) 15017 rem 15020 rem - variables to check 15030 rem xpos% = horizontal cursor position (1-52, L to R) 15040 rem ypos% = vertical cursor position (1-24, T to B) 15050 rem 15060 if rowcol$ = chr$(01) then 15100 15070 if rowcol$ = chr$(00) then 15080 15075 print "Error; HANDYTRM.PRM file has illegal rowcol$ value." : return 15080 print poscmd$+chr$(xpos%+posofs%-1)+chr$(ypos%+posofs%-1); 15090 go to 15110 15100 print poscmd$+chr$(ypos%+posofs%-1)+chr$(xpos%+posofs%-1); 15110 return 19000 rem - day subroutine ************************ 19010 rem 19020 rem - variables to check 19030 rem d = number relation to day of week 19040 rem cdate$ = date from which to determine day 19050 rem day$ = arrived at day of week 19060 rem f = factor to determine d 19070 rem p1 = month of date 19080 rem p2 = day of date 19090 rem p3 = year of date 19100 rem 19110 p1$=left$(cdate$,2):p2$=mid$(cdate$,4,2) 19120 p3$=right$(cdate$,4) 19130 p1=val(p1$):p2=val(p2$):p3=val(p3$) 19140 if p1>2 then 19170 19150 f=365*p3+p2+31*(p1-1)+int((p3-1)/4)-int(.75*int((p3-1)/100)+1) 19160 goto 19180 19170 f=365*p3+p2+31*(p1-1)-int(.4*p1+2.3)+int(p3/4)-int(.75*(int(p3/100)+1)) 19180 d=f-(int(f/7)*7) 19190 if d=0 then let day$="Saturday" 19200 if d=1 then let day$="Sunday" 19210 if d=2 then let day$="Monday" 19220 if d=3 then let day$="Tuesday" 19230 if d=4 then let day$="Wednesday" 19240 if d=5 then let day$="Thursday" 19250 if d=6 then let day$="Friday" 19260 return 20000 rem - get terminal characteristics ******************* open "HANDYTRM.PRM" as 1 read #1;trmtyp$ 20005 rem - loop entry point read #1;count% : w$="" for i%=1 to count% read #1;hexcode$ gosub 21000 : rem - convert hex string to decimal value w$=w$+chr$(decval%) next i% read #1;varnam$ if varnam$="EOF$" then close 1 : return if varnam$="CLEAR$" then clear$=w$ : go to 20010 if varnam$="BELL$" then bell$=w$ : go to 20010 if varnam$="CLREOL$" then clreol$=w$ : go to 20010 if varnam$="ESCAPE$" then escape$=w$ : go to 20010 if varnam$="POSCMD$" then poscmd$=w$ : go to 20010 if varnam$="POSOFS%" then posofs%=asc(w$) : go to 20010 if varnam$="ROWCOL$" then rowcol$=w$ : go to 20010 print "Error; "+varnam$+" is an illegal HANDYTRM.PRM variable name." 20010 read #1;comment$ go to 20005 : rem - loop back 21000 rem - convert hexcode$ value in 00..7F range to decval% *********** w1$=mid$(hexcode$,1,1) w2$=mid$(hexcode$,2,1) if w2$>="A" then dec2%=asc(w2$)-55 if w2$<"A" then dec2%=asc(w2$)-48 decval%=16*(asc(w1$)-48)+dec2% return