rem - program DO-TODAY.bas
rem - To do list
rem - copyright 1982, by Peter C. Hawxhurst
rem - revised 09/18/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   date$   = 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   today$  = 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%   = veritcle 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
stop
100 rem - housekeeping subroutine ****************
dim thing$(255)
dim alt$(255)
dim l(9)
dim al(9)
dim p(9)
dim ap(9)
gosub 16000 : rem - tone on
110 ypos%=51:xpos%=33:gosub 15000 : rem - cursor
input "Enter today's date as MM/DD/YYYY >";date$
gosub 10000 : rem - date check
if e1=0 then 120
gosub 14000 : rem - rubout
print chr$(7);
goto 110
120 gosub 18000 : rem - tone off
if end #1 then 130
open "B:DOTHINGS.DAT" as 1
goto 135
130 create "B:DOTHINGS.DAT" as 1
goto 140
135 gosub 500 : rem - update
140 if end #1 then 160
read #1;d$,t$
if d$=date$ 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%=36+i%:xpos%=45:gosub 15000 : rem - cursor
print mid$(thing$,p(i%),l(i%))
next i%
170 return
200 rem - process subroutine *********************
s2=0
210 ypos%=50:xpos%=78:gosub 15000 : rem - cursor
input ">";cmnd$
cmnd$=ucase$(cmnd$)
gosub 14000 : rem - rubout
if cmnd$="A" then gosub 600 : rem - add
if cmnd$="A" then let s2=1
if cmnd$="D" then gosub 700 : rem - delete
if cmnd$="D" then let s2=1
if cmnd$="E" then let s1=1
if cmnd$="E" then goto 220
if cmnd$="F" then gosub 800 : rem - future
if cmnd$="F" then let s2=1
if cmnd$="P" then gosub 900 : rem - print
if cmnd$="P" then let s2=1
if cmnd$="R" then gosub 1000 : rem - rank
if cmnd$="R" then let s2=1
if s2>0 then 220
print chr$(7);
goto 210
220 return
300 rem - end of job subroutine ******************
close 1
print chr$(26)
return
400 rem - screen subroutine **********************
gosub 19000 : rem - day of week
today$=day$+", "+month$+" "+str$(p2)+", "+str$(p3)
print chr$(26)
gosub 16000 : rem - tone on
print tab(17);"THINGS TO DO TODAY"
print tab(24-(len(today$)/2));today$
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
500 rem - update subroutine **********************
gosub 16000 : rem - tone on
510 ypos%=51:xpos%=33:gosub 14000: Rem - rubout
gosub 15000 : rem - cursor
input "Do you wish to print prior dates data (y/n) >";q1$
q1$=ucase$(q1$)
if q1$<>"Y" and q1$<>"N" then 520
goto 530
520 print chr$(7);
gosub 14000 : rem - rubout
goto 510
530 gosub 18000 : rem - tone off
if q1$="N" then 540
gosub 14000 : rem - rubout
gosub 15000 : rem - cursor
input "Ready printer and press - RETURN >";line q$
lprinter
print
print
print tab(10);"DATE";tab(30);"ITEM"
print
let l=l+4
540 create "B:TRANS" as 2
550 if end #1 then 570
read #1;d$,t$
if val(left$(d$,2))>val(left$(date$,2)) then 560
if val(left$(d$,2))=val(left$(date$,2)) and val(mid$(d$,4,2))>=val(mid$(date$,4    ,2)) then 560
if q1$="N" then 550
print tab(7);d$;tab(25);t$
print
let l=l+2
if l<60 then 550
for i%=1 to 66-l:print:next i%
print:print
print tab(10);"DATE";tab(30);"ITEM"
print
l=4
goto 550
560 print #2;d$,t$
goto 550
570 if q1$="N" then 580
console
580 delete 1
close 2
ok%=rename("B:DOTHINGS.DAT","B:TRANS")
open "B:DOTHINGS.DAT" as 1
return
600 rem - add subroutine *************************
610 ypos%=52:xpos%=33:gosub 15000 : rem - cursor
input "Item description >";q3$
if len(q3$)<29 then 620
gosub 16000 : rem - tone on
print chr$(7);
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;date$,q3$
close 1
open "B:DOTHINGS.DAT" as 1
gosub 14000 : rem - rubout
things%=things%+1
ypos%=36+things%:xpos%=45
gosub 15000 : rem - cursor
print q3$
p(things%)=len(thing$)+1
l(things%)=len(q3$)
thing$=thing$+q3$
return
700 rem - delete subroutine **********************
alt%=0
alt$=""
for i%=1 to 9
ap(i%)=0
al(i%)=0
next i%
710 ypos%=52:xpos%=33:gosub 15000 : rem - cursor
input "Item number to delete >";q2$
x$=q2$
gosub 11000 : rem - numeric check
if e1=0 then 720
715 print chr$(7);
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 "B:DOTHINGS.DAT" as 1
create "B:TRANS" as 2
730 if end #1 then 750
read #1;d$,t$
if d$=date$ then 740
735 print #2;d$,t$
goto 730
740 if t$=delete$ then 730
goto 735
750 delete 1
close 2
ok%=rename("B:DOTHINGS.DAT","B:TRANS")
open "B: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%=36+i%:xpos%=45: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%=36+i%:xpos%=45:gosub 15000 : rem - cursor
print mid$(thing$,p(i%),l(i%))
next i%
ypos%=52:xpos%=33:gosub 14000 : rem - cursor
return
800 rem - future subroutine ************************
810 ypos%=52:xpos%=33:gosub 15000 : rem - cursor
input "Enter future date as MM/DD/YYYY >";date$
gosub 10000 : rem - date check
if e1=0 then 820
print chr$(7);
gosub 14000 : rem - rubout
goto 810
820 close 1
open "B: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
ypos%=52:xpos%=33:gosub 14000 : rem - rubout
return
900 rem - print subroutine ***********************
910 ypos%=52:xpos%=33:gosub 15000 : rem - cursor
input "Ready printer and press - RETURN >";line q$
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
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%=52:xpos%=33:gosub 14000:gosub 15000
print "Enter number of priority ";r%;
input " >";q4$
x$=q4$
gosub 11000 : rem - numeric check
if e1=0 then 1020
print chr$(7);
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 "B:DOTHINGS.DAT" as 1
create "B:TRANS" as 2
1030 if end #1 then 1040
read #1;d$,t$
if d$=date$ then 1030
print #2;d$,t$
goto 1030
1040 for i%=1 to things%
print #2;date$,mid$(thing$,p(i%),l(i%))
next i%
delete 1
close 2
ok%=rename("B:DOTHINGS.DAT","B:TRANS")
open "B:DOTHINGS.DAT" as 1
for i%=1 to things%
ypos%=i%+36:xpos%=45:gosub 14000:gosub 15000
print mid$(thing$,p(i%),l(i%))
next i%
ypos%=52:xpos%=33:gosub 14000
return
10000 rem - date check subroutine ******************
10010 rem
10020 rem - variables to check
10030 rem   date$ = 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$=date$ 
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 chr$(27)+"T";
14030 return
15000 rem - cursor subroutine ********************
15010 rem
15020 rem - varibles to check
15030 rem   xpos% = horizontal cursor position (1-52, L to R)
15040 rem   ypos% = verticl cursor position (1-24, T to B)
15050 rem
15060 print chr$(27)+"="+chr$(ypos%)+chr$(xpos%);
15070 return
16000 rem - tone on subroutine *******************
16010 print chr$(27)+")";
16020 return
18000 rem - tone off subroutine ******************
18010 print chr$(27)+"(";
18020 return
19000 rem - day subroutine ************************
rem
rem - variables to check
rem   d     = number relation to day of week
rem   date$ = 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$(date$,2):p2$=mid$(date$,4,2)
p3$=right$(date$,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
