1 'DISK FILE 1.0 (2/18/19)
3 ifpeek(36)>=4thenoptionbase0endif:poke10516,0
5 uc=true 'false for upper/lower case
7 deffnctrs(s$)=(80-len(s$))/2
10 gosub200:print@12,29;"LOAD OLD FILE (Y,N,Q)?";
15 k$=inkey$:ifk$=""then15elsek$=ucase$(k$):ifinstr("YNQ",k$)=0then15elseifk$="Y"then900elseifk$="N"then20elsecls:end
20 gosub200
23 print@8,30;"1.  ADDRESSES";:print@9,30;"2.  WARRANTIES";:print@10,30;"3.  HOME INVENTORY";:print@11,30;"4.  INVESTEMENTS";:print@12,30;"5.  CAR MAINTENANCE";:print@13,30;"6.  MEDICAL HISTORY";:print@14,30;"7.  RESUME/VITA";
25 print@15,30;"8.  -YOU DEFINE-";:print@17,34;"SELECT (1-8)";
27 k$=inkey$:ifk$=""then27elseifk$<"1"ork$>"8"then30elsedb=asc(k$)-48
30 gosub200:print@11,35;"FILE NAME?";:locate13,25:wi=30:in$="":ml=false:gosub9000:na$=in$
40 ondb gosub10000,11000,12000,13000,14000,15000,16000,17000:of=1:od$="A":redimda$(15,fc)
50 cls:print@1,fnctrs(na$);na$;
60 ifrc=0thenprint@23,35;"FILE EMPTY";:goto80elseifes=0thenprint@23,30;"NO ENTRIES SELECTED";:goto80
70 print@3,fnctrs(fd$);fd$;:s$=right$("    "+str$(es),5)+" ENTRIES SELECTED":print@5,fnctrs(s$);s$;:k$=fd$(of):x=fnctrs(k$)
73 print@7,34;"FIRST ENTRY";:print@8,x;k$;:print@9,fnctrs(da$(fs,of));da$(fs,of);
75 print@11,35;"LAST ENTRY";:print@12,x;k$;:print@13,fnctrs(da$(ls,of));da$(ls,of);
80 print@24,28;"PRESS ENTER TO CONTINUE";
90 ifinkey$<>chr$(13)then90
100 cls:lock#0:fori=1tofc:print@(i-1)*2,0;chr$(i+48);".";fd$(i);:nexti
110 ifes>0thenrn=fs:gosub9800elsegosub9700
120 unlock#0
130 print@24,0;ers(80)"ADD CHG DEL SEL ORD TAP PRT END";:pm=0:mc=1:gosub9300
140 k$=inkey$:ifk$=""then140elsek$=ucase$(k$)
150 i=instr("ACDSOTPE",k$):ifi>0andi<>mc thenpm=mc:mc=i:gosub9300:goto140
160 ifk$=chr$(13)thenonmc gosub1000,2000,3000,4000,5000,6000,7000,8000:gosub9700:goto130
170 ifk$=nul$+chr$(38)then50
172 ifk$=nul$+chr$(40)thenifes>0andrn<>ls thenrn=ls:gosub9800endif:goto140
174 ifk$=nul$+chr$(37)thenifes>0andrn<>fs thenifrn>fs thengosub300:gosub9800elsern=lr:gosub9800endif:goto140
176 ifk$=nul$+chr$(39)thenifes>0thenifrn>=1andrn<ls thengosub400:gosub9800elseifrn=ls thenrn=rc+1:gosub1200:gosub9720elseifrn=0thenrn=lr:gosub9800
180 goto140
200 cls:print@6,33;"YOUR DISK FILE";:return
300 rn=rn-1:ifda$(rn,0)="S"thenreturnelse300
400 rn=rn+1:ifda$(rn,0)="S"thenreturnelse400
900 cls:print@1,35;"LOAD FILE";:print@11,35;"FILE NAME?";
905 locate13,25:wi=30:in$="":ml=false:gosub9000:f$=in$:iff$=""then905
910 fori=1tolen(f$):ifinstr(chr$(34)+"<>|:*?\/",mid$(f$,i,1))>0thenmid$(f$,i,1)=" "endif:nexti:f$=trim$(f$):iff$=""then905
915 print@21,37;"LOADING";
920 rc=0:fc=0:of=1:od$="A":onerrorgoto980:openf$+".df1"forinputas#1:lineinput#1,i$
930 lineinput#1,na$:iflen(na$)>30thenna$=left$(na$,30)elseifna$=""thenna$=f$endif:lineinput#1,td$:iflen(td$)>8thentd$=left$(td$,8)
940 lineinput#1,i$:fc=val(i$):iffc<1thenfc=1elseiffc>9thenfc=9endifendif:fori=1tofc:lineinput#1,i$:if(len(i$))>78theni$=left$(i$,78)endif:fd$(i)=i$:lineinput#1,i$:ifi$<>"A"andi$<>"N"theni$="A"endif:ft$(i)=i$:nexti
950 lineinput#1,i$:of=val(i$):ifof<1orof>fc thenof=1endif:lineinput#1,od$:ifod$<>"A"orod$<>"D"thenod$="A"endif:lineinput#1,i$:rc=val(i$):ifrc<0thenrc=0elseifrc>65535thenrc=65535endifendif:redimda$(rc,fc)
960 forr=1torc:da$(r,0)="S":forf=1tofc:lineinput#1,i$:iflen(i$)>78theni$=left$(i$,78)endif:ifft$(f)="N"thend$=i$:gosub9600:i$=v$endif:da$(r,f)=i$:ifeof(1)thenrc=r:goto970endif:nextf,r
970 close#1:mf=false:onerrorgoto0:es=rc:fs=1:ls=rc:gosub9900:goto50
980 iferr<>16theniffc=0thenfc=1endif:resume970
990 print@21,23;"FILE NOT FOUND!, TRY AGAIN (Y,N)?";
995 k$=inkey$:ifk$=""then995elsek$=ucase$(k$):ifinstr("YN",k$)=0then995elseifk$="Y"thenclr21,23,33,1:resume905elseresume10
1000 print@24,0;ers(80)"ADD NO! MOR";:pm=0:mc=1:gosub9300:goto1400
1010 k$=inkey$:ifk$=""then1010elsek$=ucase$(k$)
1020 i=instr("ANM",k$):ifi>0andi<>mc thenpm=mc:mc=i:gosub9300:goto1010
1030 ifk$=chr$(13)thenifmc=1then1100elseifmc=2then1200else1300
1040 goto1010
1100 b=ubound(da$,1):ifrc=b thenifb<65535thenredimpreserveda$(b*2+1,fc)elsegosub9750:goto1010
1110 rc=rc+1:rn=rc:fori=1tofc:da$(rn,i)=da$(0,i):nexti:da$(rn,0)="S":es=es+1:gosub1500:gosub9810:clr23,0,80,1:lr=rn:rn=0:mf=true:return
1200 if rn>=1andrn<=rc thengosub9800elsegosub9810endif:return
1300 f=1:gosub9500:pm=mc:mc=1:gosub9300:goto1010
1400 fori=1tofc:ifrn=0orrn>rc thenda$(0,i)=""elseda$(0,i)=da$(rn,i)endif:nexti:f=1:gosub9500:goto1010
1500 ifrc=1thenfs=1:ls=1:return
1510 da$(rn,0)="M":sf=of:sd$=od$:gosub9900:fs=0:ls=0:forr=1torc:ifda$(r,0)="M"thenda$(r,0)="S":rn=r endif:ifda$(r,0)="S"thenls=r:iffs=0thenfs=r endifendif:nextr:return
2000 ifes=0orrn>rc gosub9400:returnelseifrn=0thenrn=lr:gosub9800
2005 print@24,0;ers(80)"CHG NO! MOR";:pm=0:mc=1:gosub9300:goto2400
2010 k$=inkey$:ifk$=""then2010elsek$=ucase$(k$)
2020 i=instr("CNM",k$):ifi>0andi<>mc thenpm=mc:mc=i:gosub9300:goto2010
2030 ifk$=chr$(13)thenifmc=1then2100elseifmc=2then2200else2300
2040 goto2010
2100 fori=1tofc:da$(rn,i)=da$(0,i):nexti:gosub2500:gosub9800:mf=true:return
2200 gosub9800:return
2300 f=1:gosub9500:pm=mc:mc=1:gosub9300:goto1010
2400 fori=1tofc:da$(0,i)=da$(rn,i):nexti:f=1:gosub9500:goto2010
2500 gosub1500:return
3000 ifes=0orrn>rc gosub9400:returnelseifrn=0thenrn=lr:gosub9800
3005 print@24,0;ers(80)"DEL NO!";:pm=0:mc=1:gosub9300
3010 k$=inkey$:ifk$=""then3010elsek$=ucase$(k$)
3020 i=instr("DN",k$):ifi>0andi<>mc thenpm=mc:mc=i:gosub9300:goto3010
3030 ifk$=chr$(13)thenifmc=1then3100elsereturn
3040 goto3010
3100 ifrn=rc thenrc=rc-1:es=es-1:gosub3320:mf=true:goto3120
3110 forr=rn torc-1:forf=0tofc:da$(r,f)=da$(r+1,f):nextf,r:rc=rc-1:es=es-1:gosub3300:mf=true
3120 ifrn<=rc thengosub9800elsegosub9810endif:return
3300 ls=ls-1:ifda$(rn,0)="S"thenreturn
3310 rn=rn+1:ifrn<=rc thenifda$(rn,0)=""then3310
3320 fs=0:ls=0:forr=1torc:ifda$(r,0)="S"thenls=r:iffs=0thenfs=r endifendif:nextr:return
4000 ifrc=0gosub9400:returnelseifrn=0thenrn=lr:gosub9800
4005 print@24,0;ers(80)"SEL NO! FLD ALL  = # < >";:pm=0:mc=1:gosub9300:ps=0:sc=1:sl=1:so=17:gosub9310:sf=1:gosub9100:ifrn<=rc thensk$=da$(rn,sf)elsesk$=""
4010 k$=inkey$:ifk$=""then4010elsek$=ucase$(k$)
4020 i=instr("SNFA",k$):ifi>0andi<>mc thenpm=mc:mc=i:gosub9300:goto4010
4025 i=instr("=#<>",k$):ifi>0andi<>sc thenps=sc:sc=i:gosub9310:goto4010
4030 ifk$=chr$(13)thenifmc=1then4100elseifmc=2thenclr24,75,5,1:print@sf*2-1,2;ers(78)da$(rn,sf);:returnelseifmc=3then4200else4300
4040 goto4010
4100 es=0:fs=0:ls=0:forr=1torc:ifda$(r,0)=""then4190elsese$=""
4110 ifft$(sf)="A"thenfv$=da$(r,sf):ifsc=1thenifinstr(fv$,sk$)>0thense$="S"endifelseifsc=2theniffv$<>sk$thense$="S"endifelseifsc=3theniffv$<sk$thense$="S"endifelseiffv$>sk$thense$="S"
4120 ifft$(sf)="N"thenfv=val(da$(r,sf)):sk=val(sk$):ifsc=1theniffv=sk thense$="S"endifelseifsc=2theniffv<>sk thense$="S"endifelseifsc=3theniffv<sk thense$="S"endifelseiffv>sk thense$="S"
4130 da$(r,0)=se$:ifse$<>""thenes=es+1:ls=r:iffs=0thenfs=r
4190 nextr:ifes>0thenifrn>ls thenrn=rc+1elseifda$(rn,0)=""thengosub4400endifendifelsern=rc+1
4195 ifrn<=rc thengosub9800else9810endif:return
4200 gosub9200:ifrn<=rc thensk$=da$(rn,sf)elsesk$=""endif:gosub9250:sk$=in$:pm=mc:mc=1:gosub9300:goto4010
4300 forr=1torc:da$(r,0)="S":nextr:fs=1:ls=rc:es=rc:return
4400 rn=rn+1:ifrn>rc thenreturnelseifda$(rn,0)="S"thenreturnelsern=rn+1:goto4400
5000 ifrc=0gosub9400:returnelseifrn=0thenrn=lr:gosub9800
5005 print@24,0;ers(80)"ORD NO! FLD  ASC DES";:pm=0:mc=1:gosub9300:ps=0:sc=instr("AD",od$):sl=3:so=13:gosub9310:sf=of:sd$=od$:gosub9100
5010 k$=inkey$:ifk$=""then5010elsek$=ucase$(k$)
5020 i=instr("ONF",k$):ifi>0andi<>mc thenpm=mc:mc=i:gosub9300:goto5010
5025 i=instr("AD",k$):ifi>0andi<>sc thenps=sc:sc=i:gosub9310:sd$=mid$("AD",sc,1):goto5010
5030 ifk$=chr$(13)thenifmc=1then5100elseifmc=2thenclr24,75,5,1:returnelse5200
5040 goto5010
5100 ifrc>1thengosub9900:fs=0:forr=1torc:ifda$(r,0)="S"thenls=r:iffs=0thenfs=r endif:nextr:rn=fs:gosub9800endif:of=sf:od$=sd$:mf=true endif:return
5200 gosub9200:pm=mc:mc=1:gosub9300:goto5010
6000 ifreadonly(volume$)gosub9400:returnelseifrn=0thenrn=lr:gosub9800
6005 print@24,0;ers(80)"TAP NO!";:pm=0:mc=1:gosub9300
6010 k$=inkey$:ifk$=""then6010elsek$=ucase$(k$)
6020 i=instr("TN",k$):ifi>0andi<>mc thenpm=mc:mc=i:gosub9300:goto6010
6030 ifk$=chr$(13)thenifmc=1then6100elsereturn
6040 goto6010
6100 cls:print@1,35;"SAVE FILE";:print@3,28;"TODAY'S DATE (MM/DD/YY)=";:locate4,36:wi=8:in$=date$:in$=left$(in$,2)+"/"+mid$(in$,4,2)+"/"+right$(in$,2):ml=false:gosub9000:td$=in$:f$=na$
6103 iff$<>""then6110elseprint@11,35;"FILE NAME?";
6105 locate13,25:wi=30:in$="":ml=false:gosub9000:f$=in$:iff$=""then6105
6110 fori=1tolen(f$):ifinstr(chr$(34)+"<>|:*?\/",mid$(f$,i,1))>0thenmid$(f$,i,1)=" "endif:nexti:f$=trim$(f$):iff$=""then6105
6120 print@21,37;"SAVING";:t=(adjust(now,1.25)):openf$+".df1"foroutputas#1:print#1,"DF1":print#1,na$:print#1,td$
6130 print#1,str$(fc):fori=1tofc:print#1,fd$(i):print#1,ft$(i):nexti
6140 print#1,str$(of):print#1,od$:print#1,str$(rc):ifrc>0thenforr=1torc:forf=1tofc:print#1,da$(r,f):nextf,r endif:close#1
6150 ifnow<t then6150elsegoto8100
7000 ifpeek(149)and1=0orrc=0gosub9400:returnelseifrn=0thenrn=lr:gosub9800
7005 print@24,0;ers(80)"PRT NO!";:pm=0:mc=1:gosub9300
7010 k$=inkey$:ifk$=""then7010elsek$=ucase$(k$)
7020 i=instr("PN",k$):ifi>0andi<>mc thenpm=mc:mc=i:gosub9300:goto7010
7030 ifk$=chr$(13)thenifmc=1then7100elsereturn
7040 goto7010
7100 ifpeek(44638)=128thengosub9770:openprinter:print#-2,na$:print#-2:forr=1torc:ifda$(r,0)="S"thenforf=1tofc:print#-2,da$(r,f):nextf endif:print#-2:nextr:closeprinter:returnelsegosub9760:goto7010
8000 ifrc>0andrn=0thenrn=lr:gosub9800
8010 print@24,0;ers(80)"END NO!";:pm=0:ifnotmf thenmc=1elsemc=2:gosub9740endif:gosub9300
8020 k$=inkey$:ifk$=""then8020elsek$=ucase$(k$)
8030 i=instr("EN",k$):ifi>0andi<>mc thenpm=mc:mc=i:gosub9300:goto8020
8040 ifk$=chr$(13)thenifmc=1then8100elsegosub9700:return
8050 goto8020
8100 pop:eraseda$:rc=0:rn=0:mf=false:goto10
9000 x=column:y=row:n=1:iflen(in$)<wi thenin$=in$+string$(" ",wi-len(in$))
9002 print@y,x;in$;
9010 gosub9090
9020 k$=inkey$:ifk$=""then9020elseifuc thenk$=ucase$(k$)
9023 ifk$=chr$(13)thenin$=rtrim$(in$):gosub9090:returnelseifml thenifk$=nul$+chr$(38)ork$=nul$+chr$(40)thenin$=rtrim$(in$):gosub9090:return
9025 ifprint(k$)andn<=wi thenmid$(in$,n,1)=k$:print@y,x;k$;:n=n+1:x=x+1:goto9010
9027 ifk$=nul$+chr$(46)thenx=x-n+1:n=1:in$=string$(" ",wi):print@y,x;in$;:goto9010
9030 ifk$=nul$+chr$(37)ork$=chr$(8)thenifn>1gosub9090:n=n-1:x=x-1:goto9010else9085
9040 ifk$=nul$+chr$(39)thenifn<=wi gosub9090:n=n+1:x=x+1:goto9010else9085
9050 ifk$=nul$+chr$(16)+nul$+chr$(37)gosub9090:x=x-n+1:n=1:goto9010
9060 ifk$=nul$+chr$(16)+nul$+chr$(39)thenfori=n tolen(in$):mid$(in$,i,1)=" ":nexti:print@y,x;right$(in$,len(in$)-n+1);:goto9010
9070 ifk$=nul$+chr$(16)+nul$+chr$(38)thenifn<wi andmid$(in$,wi,1)=" "thenin$=left$(in$,n-1)+" "+mid$(in$,n,wi-n):print@y,x;right$(in$,wi-n+1);:goto9010else9085
9080 ifk$=nul$+chr$(16)+nul$+chr$(40)thenifn<=wi thenin$=left$(in$,n-1)+mid$(in$,n+1,wi-n)+" ":print@y,x;right$(in$,wi-n+1);:goto9010
9085 goto 9020
9090 ifn<=wi theninverty,x,1,1endif:return
9100 inverseon:print@24,75;"FLD=";:poke6023,128:printchr$(sf+48);:inverseoff:return
9200 print@23,0;ers(80)"SELECT FIELD NUMBER (1-";chr$(fc+48);"):";
9210 k$=inkey$:ifk$=""then9210elseifk$<"1"ork$>chr$(fc+48)then9210elsesf=asc(k$)-48:gosub9100:clr23,0,26,1:return
9250 locatesf*2-1,2:wi=78:in$=sk$:ml=false:gosub9000:ifft$(sf)="N"thend$=in$:gosub9600:print@(sf-1)*2+1,2;ers(78)v$;:in$=v$endif:return
9300 ifpm>0theninvert24,(pm-1)*4,3,1endif:invert24,(mc-1)*4,3,1:return
9310 ifps>0theninvert24,(ps-1)*(sl+1)+so,sl,1endif:invert24,(sc-1)*(sl+1)+so,sl,1:return
9400 clr24,0,80,1:wait400:return
9500 locate(f-1)*2+1,2:wi=78:in$=da$(0,f):ml=true:gosub9000
9510 ifft$(f)="A"thenda$(0,f)=in$elsed$=in$:gosub9600:print@(f-1)*2+1,2;ers(78)v$:da$(0,f)=v$
9520 ifk$=chr$(13)theniff<fc thenf=f+1:goto9500elsenf=false:return
9530 ifk$=nul$+chr$(38)theniff>1thenf=f-1elsef=fc endif:goto9500
9540 iff<fc thenf=f+1elsef=1endif:goto9500
9600 ifd$=""thenv$="0":returnelsev$=""
9610 fori=1tolen(d$):c$=mid$(d$,i,1):
9620 ifc$="0"theniflen(v$)>0thenv$=v$+"0"endifelseifc$>="1"andc$<="9"thenv$=v$+c$elseifc$="."thenifinstr(v$,".")=0thenv$=v$+"."
9630 nexti:ifv$=""thenv$="0":return
9640 ifleft$(v$,1)="."thenv$="0"+v$
9650 i=instr(v$,"."):ifi>0thenn=len(v$)-i:ifn<2thenv$=v$+string$("0",2-n)elseifn>2thenv$=left$(v$,i+2)
9660 return
9700 ifrc=0gosub9710elseifes=0then9715elseifrn>rc gosub9720elseifrn>0andrn<=rc gosub9730
9702 return
9710 inverseon:print@23,0;spc(35)"FILE EMPTY"spc(35):inverseoff:return
9715 inverseon:print@23,0;spc(27);"NO ENTRIES MATCH SELECTION"spc(27):inverseoff:return
9720 inverseon:print@23,0;spc(34)"END OF FILE"spc(35):inverseoff:return
9730 print@23,0;spc(61)"ENTRY NUMBER ";:printusing"#####";rn;:print" ";:return
9740 inverseon:print@23,0;spc(32)"FILE NOT SAVED!"spc(33):inverseoff:return
9750 inverseon:print@23,0;spc(33)"OUT OF SPACE!"spc(34):inverseoff:return
9760 inverseon:print@23,0;spc(29)"NO PRINTER CONNECTED!"spc(30):inverseoff:return
9770 inverseon:print@23,0;spc(36)"PRINTING"spc(36):inverseoff:return
9800 lock#0:fori=1tofc:print@(i-1)*2+1,2;ers(78)da$(rn,i);:nexti:unlock#0:gosub9730:return
9810 lock#0:fori=1tofc:clr(i-1)*2+1,2,78,1:nexti:unlock#0:return
9900 i=2
9910 ifi>rc thenreturnelseforf=0tofc:da$(0,f)=da$(i,f):nextf:j=i-1
9920 ifj>=1thengosub9940:ifcf thenk=j+1:forf=0tofc:da$(k,f)=da$(j,f):nextf:j=j-1:goto 9920
9930 k=j+1:forf=0tofc:da$(k,f)=da$(0,f):nextf:i=i+1:goto9910
9940 ifft$(sf)="A"thenifsd$="A"thencf=da$(j,sf)>da$(0,sf)elsecf=da$(j,sf)<da$(0,sf)elsevj=val(da$(j,sf)):v0=val(da$(0,sf)):ifsd$="A"thencf=vj>v0 elsecf=vj<v0
9942 return
10000 fc=7:fd$(1)="NAME":ft$(1)="A":fd$(2)="ADDRESS 1":ft$(2)="A":fd$(3)="ADDRESS 2":ft$(3)="A":fd$(4)="CITY":ft$(4)="A":fd$(5)="STATE":ft$(5)="A":fd$(6)="ZIP":ft$(6)="A":fd$(7)="CODES":ft$(7)="A":return
11000 fc=7:fd$(1)="NAME":ft$(1)="A":fd$(2)="SERIAL #":ft$(2)="A":fd$(3)="PURCH DATE":ft$(3)="A":fd$(4)="STORE NAME":ft$(4)="A":fd$(5)="PRICE":ft$(5)="N":fd$(6)="LAST FIX DATE":ft$(6)="A":fd$(7)="LAST FIX COST":ft$(7)="N":return
12000 fc=6:fd$(1)="ROOM":ft$(1)="A":fd$(2)="ITEM":ft$(2)="A":fd$(3)="PURCH DATE":ft$(3)="A":fd$(4)="PURCH PRICE":ft$(4)="N":fd$(5)="VALUE":ft$(5)="N":fd$(6)="SERIAL #":ft$(6)="A":return
13000 fc=7:fd$(1)="COMPANY":ft$(1)="A":fd$(2)="ITEM":ft$(2)="A":fd$(3)="NUMBER":ft$(3)="N":fd$(4)="PURCH DATE":ft$(4)="A":fd$(5)="PURCH PRICE":ft$(5)="N":fd$(6)="CURRENT VALUE":ft$(6)="N":fd$(7)="INTENDED SALE DATE":ft$(7)="A":return
14000 fc=7:fd$(1)="DESCRIPTION":ft$(1)="A":fd$(2)="DATE":ft$(2)="A":fd$(3)="WHERE DONE":ft$(3)="A":fd$(4)="ESTIMATE":ft$(4)="N":fd$(5)="ACTUAL COST":ft$(5)="N":fd$(6)="CODES":ft$(6)="A":fd$(7)="PREVIOUS DATE":ft$(7)="A":return
15000 fc=6:fd$(1)="DATE":ft$(1)="A":fd$(2)="ITEM":ft$(2)="A":fd$(3)="DOCTOR":ft$(3)="A":fd$(4)="DESCRIPTION":ft$(4)="A":fd$(5)="COST":ft$(5)="N":fd$(6)="INSURANCE PAID":ft$(6)="A":return
16000 fc=5:fd$(1)="ITEM":ft$(1)="A":fd$(2)="FROM DATE":ft$(2)="A":fd$(3)="TO DATE":ft$(3)="A":fd$(4)="DESCRIPTION":ft$(4)="A":fd$(5)="INCOME":ft$(5)="N":return
17000 cls:print@0,(80-len(na$))/2;na$;
17010 print@1,28;"NUMBER OF FIELDS (1-9)?";
17020 k$=inkey$:ifk$=""then17020elseifk$<"1"ork$>"9"then17020elseprintk$;:fc=asc(k$)-48
17030 fori=1tofc:print@i*2,0;"FIELD ";chr$(i+48);" ALPHABETIC (Y,N)?";
17040 k$=inkey$:ifk$=""then17040elsek$=ucase$(k$):ifinstr("YN",k$)=0then17040elseprintk$;" ";:ifk$="Y"thenft$(i)="A"elseft$(i)="N"
17050 print"NAME?";:locatei*2+1,1:wi=78:in$="":ml=false:gosub9000:fd$(i)=in$
17060 nexti:mf=true:return
60000 '
60001 'Disk File is a reproduction of the Tandy Color File program created for
60002 'the Radio Shack TRS-80 Color Computer. The original software was shipped
60003 'on a 4K ROM cartridge and when inserted into the cartridge slot of the
60004 'color computer, started on power on. It was written in 6809 assembly
60005 'language and produced by Image Producers, Inc. in 1981 and licensed to
60006 'Tandy Corporation. The program was a simple database system and stored
60007 'files on cassette tape.
60008 '
60009 'I used this program in high school on a 64K Color Computer II to keep
60010 'track of trading cards, a coin collection, model rocket flight data, and
60011 'other hobbies.
60012 '
60013 'Disk File is written in BASIC for SylvaWare NBASIC and has been upgraded
60014 'to store files on disk using NBASIC's storage system and use up to 9
60015 'fields instead of the original 7 which was limited by the screen size.
60016 'The workflow has been improved for working with multiple files more
60017 'easily. Files saved with Disk File have an extension of df1. The file
60018 'format is simple text and can be edited in Notepad. Each line is
60019 'terminated with carriage return+line feed pair of characters (&hd,&ha
60020 'hex, 13,10 decimal)
60021 '
60022 'Format:
60023 '  Header ("DF1" - Disk File Version 1.0)
60024 '  Name of file (up to 30 characters)
60025 '  Save date (mm/dd/yy)
60026 '  Number of fields (1-9, Field name and type are repeated for each field)
60027 '  Field name (up to 78 characters)
60028 '  Field type (A - alphanumeric or N - numeric))
60029 '  Sort field (1-9)
60030 '  Sort direction (A - ascending or D-descending)
60031 '  Number of records (0-65536, Field data are repeated for each record)
60032 '  Field 1 (up to 78 characters)
60033 '  ...
60034 '  Field n (up to 78 characters)
60035 '
60036 'The sort used in Disk File is an insertion sort which works well with
60037 'partially ordered data and is stable. Reversing the sort order of a
60038 'completely sorted array is the worst case runtime (O(n^2)). Even for an
60039 'interpreted language the sort will perform reasonably well on several
60040 'thousand entries. The sort supports both alphanumeric text and numeric
60041 'values. If the data is sorted, the runtime is (O(n)).
60042 '
60043 'The Color Computer in its default configuration only supported upper
60044 'case which Disk File mimics but can be changed by setting the uc
60045 'variable in line 5 to false. The CLEAR key on the Color Computer is
60046 'replaced by the DEL or DELETE key on a PC keyboard.
60047 '
60048 'Disk File was designed to run on all versions of NBASIC in addition to
60049 'the shareware versions and needs a screen size of 80 columns and 25
60050 'rows. Data is stored on the default volume of NBASIC and needs to be
60051 'writable to save files.  If printing is used version 1.2 standard or
60052 'later is required which the program will detect.
60053 '
60054 'This was a great weekend project to recreate this program, and
60055 'demonstrates a classic BASIC program. It is refreshing for its
60056 'simplicity and elegance. I miss writing software for these platforms.
60057 'Feel free to expand and enhance this program.
60058 '
61000 '
61001 'Patches and Enhancements:
61002 'uncomment the lines for each patch to add the code to the program when
61003 'loaded (the previous lines will be replaced)
61004 '
61005 'Patch #1 - show volume in TAP command
'6005 print@24,0;ers(80)"TAP NO!";:pm=0:mc=1:gosub9300:gosub9110
'9110 v$="VOL="+volume$:inverseon:poke6023,128:print@24,80-len(v$);v$;:inverseoff:return
61006 'Patch #2 - show printer in PRT command
'7005 print@24,0;ers(80)"PRT NO!";:pm=0:mc=1:gosub9300:gosub9120
'9120 p$="PRT="+printer$:iflen(p$)>60thenp$=left$(p$,57)+"..."endif:inverseon:poke6023,128:print@24,80-len(p$);p$;:inverseoff:return
61007 'Patch #3 - show volume when loading a file
'900 cls:print@1,35;"LOAD FILE";:print@11,35;"FILE NAME?";:gosub9130
'9130 v$="VOLUME IS "+volume$:print@17,fnctrs(v$);v$;:return
61008 '
62000 '01/12/19 - created Disk File program
62001 '01/16/19 - added patches 1-3
62002 '01/30/19 - fixed SEL:FLD edit
62003 '02/04/19 - updated for NBASIC 1.0 compatibility
62004 '02/18/19 - fixed ORD with 1 record
65535 'END DISK FILE