rem 12/13/86 common used for terminal characteristics 
common today$,warm$,trmtyp$,clear$,bell$,clreol$
common escape$,poscmd$,posofs%,rowcol$
rem - program DO-TODAY.BAS
rem - To do list
rem - copyright 1982, by Peter C. Hawxhurst
rem - revised 11/14/1982
rem - variable tabulation ************************
rem   alt%    = temporary things string
rem   al(x)   = temporary string length
rem   ap(x)   = temporary string position
rem   cmnd$   = transaction command
rem   d$      = date in dothings file
rem   datex$   = date for current transactions
rem   day$    = (see subroutine 19000)
rem   delete$ = string to delete
rem   e1      = error switch
rem   i%      = for next loop counter
rem   l(x)    = length of a todo item
rem   ok%      = file rename value
rem   p(x)     = position in thing$ of todo item
rem   q1$      = print out prior dates data
rem   q2$      = item number to delete
rem   q3$      = add item description
rem   q4$      = rank input
rem   r%       = ranking loop counter
rem   s1       = end switch
rem   s2       = complete transaction subroutine
rem   t$       = item in dothings file
rem   thisday$ = description of transaction day
rem   things%  = todo list counter
rem   thing$   = todo items
rem   x$       = (see subroutine 11000)
rem   xpos%    = horizontal cursor positioning
rem   ypos%    = veritcal cursor positioning
rem - program structure **************************
gosub 100 : rem - housekeeping
10 if s1=1 then 20
gosub 200 : rem - process
goto 10
20 gosub 300 : rem - end of job
%chain 100,10000,50,500
print clear$
chain "HANDYSYS.COM"
100 rem - housekeeping subroutine ****************
dim thingx$(255)
dim altx$(255)
dim l(9)
dim al(9)
dim p(9)
dim ap(9)
datex$=today$
open "DOTHINGS.DAT" as 1
140 if end #1 then 160
read #1;d$,t$
if d$=datex$ then 150 
goto 140
150 things%=things%+1
p(things%)=len(thing$)+1
thing$=thing$+t$
l(things%)=len(t$)
goto 140
160 gosub 400 : rem - screen
if things%=0 then 170
for i%=1 to things%
ypos%=5+i%:xpos%=14:gosub 15000 : rem - cursor
print mid$(thing$,p(i%),l(i%))
next i%
170 return
200 rem - process subroutine *********************
cmnd%=0:s2=0
210 ypos%=19:xpos%=46:gosub 14000 : rem - rubout
gosub 15000:print bell$;
print "> ";
while not constat%:wend:cmnd$=ucase$(chr$(conchar%))
if cmnd$="" then 210
cmnd$=ucase$(cmnd$)
gosub 14000 : rem - rubout
if cmnd$="A" then cmnd%=1
if cmnd$="D" then cmnd%=2
if cmnd$="E" then let s1=1
if cmnd$="E" then goto 220
if cmnd$="F" then cmnd%=3
if cmnd$="P" then cmnd%=4
if cmnd$="R" then cmnd%=5
if cmnd%=0 then 210
on cmnd% gosub 600,700,800,900,1000
220 return
300 rem - end of job subroutine ******************
close 1
print clear$
return
400 rem - screen subroutine **********************
gosub 19000 : rem - day of week
thisday$=day$+", "+month$+" "+str$(p2)+", "+str$(p3)
print clear$
gosub 16000 : rem - tone on
print tab(17);"THINGS TO DO TODAY"
print tab(24-(len(thisday$)/2));thisday$
print
print
for i%=1 to 9:print tab(11);i%:next i%
print
print
for i%=1 to 50:print "-";:next i%:print
print "A total of 9, 28 character items may be displayed."
print "(A)dd (D)elete (E)xit (F)uture (P)rint (R)ank"
gosub 18000 : rem - tone off
return
600 rem - add subroutine *************************
610 ypos%=20:xpos%=1:gosub 15000 : rem - cursor
input "Item description >";line q3$
if q3$="" then gosub 14000
if q3$="" then 610
if q3$=escape$ then gosub 14000
if q3$=escape$ then 640
if len(q3$)<29 then 620
gosub 16000 : rem - tone on
print bell$;
gosub 14000 : rem - rubout
gosub 15000 : rem - cursor
input "28 characters maximum - press RETURN >";line q$
gosub 18000 : rem - tone off
gosub 14000 : rem rubout
goto 610
620 if end #1 then 630
read #1;d$,t$
goto 620
630 print #1;datex$,q3$
close 1
open "DOTHINGS.DAT" as 1
gosub 14000 : rem - rubout
things%=things%+1
ypos%=5+things%:xpos%=14
gosub 15000 : rem - cursor
print q3$
p(things%)=len(thing$)+1
l(things%)=len(q3$)
thing$=thing$+q3$
640 return
700 rem - delete subroutine **********************
alt%=0
alt$=""
for i%=1 to 9
ap(i%)=0
al(i%)=0
next i%
710 ypos%=20:xpos%=1:gosub 15000 : rem - cursor
input "Item number to delete >";line q2$
if q2$="" then gosub 14000
if q2$="" then 710
if q2$=escape$ then 780
x$=q2$
gosub 11000 : rem - numeric check
if e1=0 then 720
715 print bell$;
gosub 14000 : rem - rubout
goto 710
720 if val(q2$)>things% then 715
delete$=mid$(thing$,p(val(q2$)),l(val(q2$)))
close 1
open "DOTHINGS.DAT" as 1
create "TRANS" as 2
730 if end #1 then 750
read #1;d$,t$
if d$=datex$ then 740
735 print #2;d$,t$
goto 730
740 if t$=delete$ then 730
goto 735
750 delete 1
close 2
ok%=rename("DOTHINGS.DAT","TRANS")
open "DOTHINGS.DAT" as 1
for i%=1 to things%
if delete$=mid$(thing$,p(i%),l(i%)) then 770
alt%=alt%+1
ap(alt%)=len(alt$)+1
alt$=alt$+mid$(thing$,p(i%),l(i%))
al(alt%)=l(i%)
770 next i%
for i%=1 to things%
ypos%=5+i%:xpos%=14:gosub 14000 : rem - rubout
next i%
thing$=""
things%=0
for i%=1 to 9
p(i%)=0
l(i%)=0
next i%
for i%=1 to alt%
things%=things%+1
p(things%)=len(thing$)+1
thing$=thing$+mid$(alt$,ap(i%),al(i%))
l(things%)=al(i%)
next i%
for i%=1 to things%
ypos%=5+i%:xpos%=14:gosub 15000 : rem - cursor
print mid$(thing$,p(i%),l(i%))
next i%
780 ypos%=20:xpos%=1:gosub 14000 : rem - cursor
return
800 rem - future subroutine ************************
810 ypos%=20:xpos%=1:gosub 15000 : rem - cursor
input "Enter future date as MM/DD/YYYY >";line datex$
if datex$="" then gosub 14000
if datex$="" then 810
if datex$=escape$ then 830
gosub 10000 : rem - date check
if e1=0 then 820
print bell$;
gosub 14000 : rem - rubout
goto 810
820 close 1
open "DOTHINGS.DAT" as 1
things%=0
things$=""
for i%=1 to 9
p(i%)=0
l(i%)=0
next i%
gosub 140 : rem - sub-housekeeping
830 ypos%=20:xpos%=1:gosub 14000 : rem - rubout
return
900 rem - print subroutine ***********************
910 ypos%=20:xpos%=1:gosub 15000 : rem - cursor
input "Ready printer and press - RETURN >";line q$
if q$=escape$ then 920
lprinter
print
print
print tab(10);"ITEM NO.";tab(25);"DESCRIPTION"
print
for i%=1 to things%
print tab(4);i%;tab(25);mid$(thing$,p(i%),l(i%))
print
next i%
console
920 gosub 14000 : rem - rubout
return
1000 rem - rank subroutine ***********************
alt%=0
alt$=""
for i%=1 to 9:al(i%)=0:ap(i%)=0:next i%
for r%=1 to things%
1010 ypos%=20:xpos%=1:gosub 14000:gosub 15000
print "Enter number of priority ";r%;
print " > ";
while not constat%:wend:q4$=ucase$(chr$(conchar%))
if q4$="" then gosub 14000
if q4$="" then 1010
x$=q4$
gosub 11000 : rem - numeric check
if e1=0 then 1020
print bell$;
gosub 14000 : rem - rubout
goto 1010
1020 ap(r%)=len(alt$)+1
alt$=alt$+mid$(thing$,p(val(q4$)),l(val(q4$)))
al(r%)=l(val(q4$))
next r%
thing$=alt$
for i%=1 to things%
p(i%)=ap(i%)
l(i%)=al(i%)
next i%
close 1
open "DOTHINGS.DAT" as 1
create "TRANS" as 2
1030 if end #1 then 1040
read #1;d$,t$
if d$=datex$ then 1030
print #2;d$,t$
goto 1030
1040 for i%=1 to things%
print #2;datex$,mid$(thing$,p(i%),l(i%))
next i%
delete 1
close 2
ok%=rename("DOTHINGS.DAT","TRANS")
open "DOTHINGS.DAT" as 1
for i%=1 to things%
ypos%=i%+5:xpos%=14:gosub 14000:gosub 15000
print mid$(thing$,p(i%),l(i%))
next i%
ypos%=20:xpos%=1:gosub 14000
return
10000 rem - date check subroutine ******************
10010 rem
10020 rem - variables to check
10030 rem   datex$ = 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$=datex$ 
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 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$;
14030 return
15000 rem - cursor subroutine ********************
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)
15060 if rowcol$=chr$(01) then 15090
15070 print poscmd$+chr$(xpos%+posofs%-1)+chr$(ypos%+posofs%-1);
15080 go to 15100
15090 print poscmd$+chr$(ypos%+posofs%-1)+chr$(xpos%+posofs%-1);
15100 return
16000 rem - tone on subroutine *******************
16020 return
18000 rem - tone off subroutine ******************
18020 return
19000 rem - day subroutine ************************
rem
rem - variables to check
rem   d     = number relation to day of week
rem   datex$ = date from which to determine day
rem   day$  = arrived at day of week
rem   f     = factor to determine d
rem   month$= literal month of year
rem   p1    = month of date
rem   p2    = day of date
rem   p3    = year of date
rem
p1$=left$(datex$,2):p2$=mid$(datex$,4,2)
p3$=right$(datex$,4)
p1=val(p1$):p2=val(p2$):p3=val(p3$)
if p1>2 then 19010
f=365*p3+p2+31*(p1-1)+int((p3-1)/4)-int(.75*int((p3-1)/100)+1)
goto 19020
19010 f=365*p3+p2+31*(p1-1)-int(.4*p1+2.3)+int(p3/4)-int(.75*(int(p3/100)+1))
19020 d=f-(int(f/7)*7)
if d=0 then let day$="Saturday"
if d=1 then let day$="Sunday"
if d=2 then let day$="Monday"
if d=3 then let day$="Tuesday"
if d=4 then let day$="Wednesday"
if d=5 then let day$="Thursday"
if d=6 then let day$="Friday"
if p1=1 then month$="January"
if p1=2 then month$="February"
if p1=3 then month$="March"
if p1=4 then month$="April"
if p1=5 then month$="May"
if p1=6 then month$="June"
if p1=7 then month$="July"
if p1=8 then month$="August"
if p1=9 then month$="September"
if p1=10 then month$="October"
if p1=11 then month$="November"
if p1=12 then month$="December"
return