start tok128 d64-qloXoc
10 PRINTCHR$(142)
20 REM"{cm a}{sh asterisk*31}{cm s}"
30 REM"{sh -}{space*5}* hash base 128 v2.0 *{space*4}{sh -}"
40 REM"{sh -}{space*31}{sh -}"
50 REM"{sh -}{space*2}* written & programmed by *{space*2}{sh -}"
60 REM"{sh -}{space*31}{sh -}"
70 REM"{sh -}{space*4}* steven paul burgess *{space*4}{sh -}"
80 REM"{sh -}{sh space}{space*30}{sh -}"
90 REM"{sh -}{space*7}* copyright 1989 *{space*6}{sh -}"
100 REM"{cm z}{sh asterisk*31}{cm x}"
110 PRINTCHR$(142)
120 SCNCLR
130 GOSUB5490
140 COLOR0,8:COLOR4,9:COLOR5,1
150 PRINT
160 READa:FORl=1 TO a:READa$:PRINTTAB(20-LEN(a$)/2)a$:NEXT
170 DATA19
180 DATA"O{cm y*18}P "
190 DATA"{cm h}hash base 128 v2.0{cm n}{orange}{cm +}"
200 DATA"{black} L{cm p*18}{sh @}{orange}{cm +}"
210 DATA" {orange}{cm +*20}"
220 DATA"{black}"
230 DATA"O{cm y*25}P "
240 DATA" {cm h}written by steven burgess{cm n}{orange}{cm +}"
250 DATA"{black}{space*2}L{cm p*25}{sh @}{orange}{cm +}"
260 DATA"{space*2}{orange}{cm +*27}"
270 DATA"{black}"
280 DATA
290 DATA
300 DATA"{cm a}{sh asterisk*14}{cm s}"
310 DATA"{sh -}copyright 1989{sh -}
320 DATA"{cm z}{sh asterisk*14}{cm x}"
330 DATA
340 DATA"{cm a}{sh asterisk*22}{cm s}"
350 DATA"{sh -}press any key to begin{sh -}"
360 DATA"{cm z}{sh asterisk*22}{cm x}"
370 x=20:y=23
380 GOSUB410'GETKEY
390 GOSUB500'menu
400 GOTO 390
410 REM****************
420 REM*getkey routine*
430 REM****************
440 :
450 ti$="{0*6}"
460 IF ti/5=INT(ti/5)THENCHAR1,x,y," ",1
470 IF ti/60=INT(ti/60) THEN CHAR1,x,y," ",0
480 GETke$:IFke$=""THEN 460
490 RETURN
500 REM******
510 REM*menu*
520 REM******
530 :
540 di$=""
550 x=19:y=24
560 SCNCLR
570 COLOR0,8:COLOR5,1
580 RESTORE:READa:FORl=1 TO 4:READa$:PRINTTAB(20-LEN(a$)/2)a$:NEXT
590 COLOR5,1
600 RESTORE 620
610 FORl=1 TO 10:READa$:PRINTTAB(20-LEN(a$)/2)a$:PRINT:NEXT
620 DATA1...create file,2...add records,3...amend record,4...delete record,5...view records,6...search,7...print menu,8...load/save menu,9...disk utility
630 DATA0...delete entire file
640 GOSUB410
650 IF ke$<"0"ORke$>"9"THEN 640
660 k=VAL(ke$):
670 IF fi=0 AND (k<>1 AND k<>8 AND k<>9) THEN w=2:GOSUB750:GOTO500
680 IF fi=1 AND (k=1)  THEN w=1:GOSUB750:GOTO500
690 IF k=6 THEN pr=0
700 IF k=7 THEN pr=1
710 ON k GOSUB1070,2240,2420,2930,3240,3660,4170,5520,6650
720 IF k=0 THEN GOSUB 6460
730 GOTO 500
740 END
750 REM*********
760 REM*warning*
770 REM*********
780 SCNCLR:RESTORE840
790 DO
800 READn$:IF w=VAL(n$)THEN 830
810 LOOP UNTIL VAL(n$)=-1
820 IF VAL(n$)=-1 THEN RETURN
830 FORl=1 TO 5:READa$:PRINTa$:NEXT:GOSUB410:RETURN
840 DATA1
850 DATA"{cm a}{sh asterisk*38}{cm s}"
860 DATA"{sh -}sorry, but there is already a file{space*2}{sh space*2}{sh -}"
870 DATA"{sh -}loaded into the computer. you must{space*4}{sh -}
880 DATA"{sh -}first delete this one to continue.{space*4}{sh -}"
890 DATA"{cm z}{sh asterisk*38}{cm x}"
900 DATA2
910 DATA"{cm a}{sh asterisk*38}{cm s}"
920 DATA"{sh -}sorry, but there is no file in memory{sh space}{sh -}"
930 DATA"{sh -}therefore you cannot manipulate, save {sh -}
940 DATA"{sh -}or print it. it does not exist{space*8}{sh -}"
950 DATA"{cm z}{sh asterisk*38}{cm x}"
960 DATA3
970 DATA"{cm a}{sh asterisk*38}{cm s}"
980 DATA"{sh -}sorry, but the record which you are {sh space*2}{sh -}"
990 DATA"{sh -}wishing to access does not exist. you {sh -}"
1000 DATA"{sh -}cannot therefore access it{space*12}{sh -}"
1010 DATA"{cm z}{sh asterisk*38}{cm x}"
1020 DATA4,"{cm a}{sh asterisk*38}{cm s}"
1030 DATA"{sh -}sorry, but as you have not entered a{space*2}{sh -}"
1040 DATA"{sh -}filename, it is impossible for you to {sh -}"
1050 DATA"{sh -}load or save a file. select option 4{space*2}{sh -}"
1060 DATA"{cm z}{sh asterisk*38}{cm x}",-1
1070 REM*************
1080 REM*create file*
1090 REM*************
1100 :
1110 SCNCLR
1120 COLOR0,1:COLOR4,1:COLOR5,2
1130 PRINT"{sh asterisk*14}"
1140 PRINT"create file"
1150 PRINT"{sh asterisk*14}"
1160 PRINT"please enter number of fieldsfields"
1170 PRINT:PRINT"01{space*2}02{space*2}03{space*2}04{space*2}05{space*2}06{space*2}07{space*2}08{space*2}09{space*2}10"
1180 ::::::PRINT"{dark gray}^{space*3}^{space*3}^{space*3}^{space*3}^{space*3}^{space*3}^{space*3}^{space*3}^{space*3}^"
1190 PRINT"{white}{down*4}move cursor using < and > keys"
1200 PRINT"{down*2}press return to make choice"
1210 PRINT"{home}{down*6}";:PRINTTAB(0+d)"{white}^"
1220 GOSUB410
1230 IF ke$=CHR$(13) THEN 1310
1240 IF ke$<>"."AND ke$<>","THEN 1210
1250 PRINT"{home}{down*6}";:PRINTTAB(0+d)"{dark gray}^"
1260 IF ke$="."THEN d=d+4
1270 IF ke$=","THEN d=d-4
1280 IF d<0 THEN d=0
1290 IF d>36 THEN d=36
1300 GOTO 1210
1310 SCNCLR
1320 PRINT"{sh asterisk*13}"
1330 PRINT"create file"
1340 PRINT"{sh asterisk*13}"
1350 PRINT:PRINT"number of fields=";(d+4)/4
1360 nf=(d+4)/4 :PRINT
1370 PRINT"{up}maximum possible number of records:";
1380 IF nf=10THEN nr=500
1390 IF nf=9 THEN nr=650
1400 IF nf=8 THEN nr=750
1410 IF nf=7 THEN nr=800
1420 IF nf=6 THEN nr=900
1430 IF nf=5 THEN nr=1000
1440 IF nf=4 THEN nr=1250
1450 IF nf=3 THEN nr=1500
1460 IF nf=2 THEN nr=1750
1470 IF nf=1 THEN nr=2000
1480 PRINTnr
1490 ht=nr*10/100
1500 ot=nr-ht
1510 PRINT"hash table structure:"
1520 PRINT"{-*21}"
1530 PRINT"{down}hash table:"ht" records"
1540 PRINT"{down}overflow table:"ot" records"
1550 DIMa$(nr,nf):DIMt$(nf):DIMpo(nr)
1560 GOSUB410
1570 SCNCLR
1580 CHAR1,5,5,"please wait:formatting table":FORs=1 TO 300:NEXT:FAST
1590 FORl=1 TO nr:a$(l,nf)="0":COLOR4,1:COLOR4,8:NEXT:fr=ht+1:SLOW:COLOR4,1
1600 SCNCLR
1610 FAST
1620 PRINT"{sh asterisk*30}"
1630 PRINT"create file:field name entry"
1640 PRINT"{sh asterisk*30}"
1650 FORf=0 TO (nf-1)
1660 PRINT"{home}{down*4}enter fieldname"f+1":{space*19}{left*19}";:x=20:y=4:l=15
1670 GOSUB1930'GETstring
1680 a$(0,f)=s$
1690 NEXT
1700 SCNCLR:fi=1
1710 PRINT"field names are as follows:"
1720 PRINT"{-*27}"
1730 FORf=0 TO nf-1
1740 PRINTf+1TAB(5)a$(0,f)
1750 NEXT
1760 x=20:y=24:PRINT"{down}are there any errors (y/n)?"
1770 GOSUB410
1780 IF ke$<>"y"ANDke$<>"n"THEN 1770
1790 IF ke$="n"THEN RETURN
1800 SCNCLR
1810 FORf=0 TO nf-1
1820 PRINTf+1TAB(5)a$(0,f)
1830 NEXT
1840 PRINT"{down}which field has an error (1-"nf")?"
1850 x=35:y=1+nf:l=2:GOSUB1930
1860 IF VAL(s$)<1 OR VAL(s$)>nf THEN 1800
1870 fc=VAL(s$):SCNCLR
1880 PRINT"the field chosen is:"a$(0,fc-1)
1890 PRINT"{down}input new value:":l=15:x=20:y=2:GOSUB1930
1900 a$(0,fc-1)=s$
1910 GOTO 1700
1920 END
1930 REM************
1940 REM*get string*
1950 REM************
1960 s$="":x1=x:y1=y
1970 ch$="abcdefghijklmnopqrstuvwxyz 1234567890.+-{pound}=?!#$%&'()@*^/[]{pi}"+di$
1980 SLOW
1990 GOSUB410
2000 IF ke$=CHR$(20) ANDLEN(s$)>0 THEN s$=LEFT$(s$,LEN(s$)-1):CHAR1,x,y," ":x=x-1:GOTO 1990
2010 IF ke$=CHR$(13) AND LEN(s$)>0 THEN RETURN
2020 IF INSTR(ch$,ke$)=0 THEN 1990
2030 IF LEN(s$)>=l THEN 1990
2040 s$=s$+ke$
2050 CHAR1,x1,y1,s$:x=x+1:GOTO1990
2060 REM***************
2070 REM*hash equation*
2080 REM***************
2090 :
2100 h=0
2110 FORl=1 TO LEN(t$(0)):h=h+ASC(MID$(t$(0),l,1)):NEXT
2120 h=h/LEN(t$(0))
2130 h=h/255*(ht)
2140 h=INT(h)
2150 RETURN
2160 REM*************                        rem*insert data*
2170 REM*************
2180 i=0
2190 IF a$(h,0)=""THENFORl=0 TO nf-1:a$(h,l)=t$(l):NEXT:i=1:RETURN
2200 IF a$(h,nf)="0"THEN a$(h,nf)=STR$(fr):FORl=0 TO nf-1:a$(fr,l)=t$(l):NEXT:fr=fr+1:i=1
2210 IF i<>1 THEN h=VAL(a$(h,nf)):GOTO 2190
2220 RETURN
2230 DIMpo(100)
2240 SCNCLR
2250 COLOR0,1:COLOR4,1:COLOR5,2
2260 PRINT"{sh asterisk*16}"
2270 PRINT"add records"
2280 PRINT"{sh asterisk*16}"
2290 PRINT
2300 FORf=0 TO nf-1
2310 PRINT:PRINTa$(0,f)":":x=16:y=f+5:l=23
2320 GOSUB1930
2330 t$(f)=s$
2340 NEXT
2350 GOSUB2060'hash equatiON
2360 GOSUB2160'insert DATA into table
2370 PRINT:PRINT"{down*2}another record (y/n)"
2380 x=20:y=24:GOSUB410
2390 IF ke$<>"y"AND ke$<>"n"THEN 2380
2400 IF ke$="n"THEN fi=1:RETURN
2410 GOTO 2240
2420 REM***************
2430 REM*amend records*
2440 REM***************
2450 :
2460 SCNCLR
2470 PRINT"{sh asterisk*18}"
2480 PRINT"amend records"
2490 PRINT"{sh asterisk*18}"
2500 fo=0
2510 PRINT:PRINT"enter "a$(0,0)" of record you wish to{space*21}amend"
2520 x=0:y=8:l=24:GOSUB1930:t$(0)=s$
2530 GOSUB2060
2540 IF a$(h,0)=s$ THEN fo=1
2550 IF fo=0 THEN h=VAL(a$(h,nf))
2560 IF h<>0 AND fo<>1 THEN 2540
2570 IF h=0 AND fo=0 THEN w=3:GOSUB750:RETURN
2580 PRINT"{clear}";
2590 PRINT"record found:"
2600 PRINT"{-*13}"
2610 FORl=0 TO nf-1
2620 PRINTa$(0,l)":"TAB(16)a$(h,l)
2630 NEXT
2640 PRINT"{sh asterisk*40}";
2650 PRINT"is this the record you wish to amend y/n"
2660 PRINT"{sh asterisk*40}";
2670 x=20:y=24:GOSUB410
2680 IF ke$<>"y"ANDke$<>"n"THEN 2670
2690 IF ke$="n"THENh=VAL(a$(h,nf)):fo=0:GOTO 2540
2700 IF nf>1 THEN PRINT:PRINT"{clear}{down*12}do you wish to amend the ";a$(0,0);" field?":b=2
2710 IF nf=1 THEN s$="1"GOTO 2820
2720 x=20:y=24:GOSUB410
2730 IF ke$<>"y"ANDke$<>"n"THEN2720
2740 IF ke$="y"THEN FORl=0 TO nf-1:t$(l)=a$(h,l):a$(h,l)="":NEXT:b=1:s$="1":GOTO 2820
2750 SCNCLR
2760 FORl=0 TO nf-1:PRINTl+1":"a$(0,l)":"TAB(17)a$(h,l):NEXT
2770 PRINT"{down*2}enter field to amend ("b"-"nf")"
2780 PRINT"{down*2}enter 0 to end"
2790 l=2:x=19:y=24:GOSUB1930
2800 IF s$="0"THEN RETURN
2810 IF VAL(s$)<b OR VAL(s$)>nf THEN 2790
2820 SCNCLR
2830 IF s$="1" THEN GOTO 2880
2840 r=VAL(s$):PRINT"current value:"a$(h,r-1)
2850 PRINT"{down*2}enter new value"
2860 x=5:y=10:l=24:GOSUB1930
2870 a$(h,r-1)=s$:GOTO 2750
2880 r=VAL(s$):PRINT"current value:"t$(r-1)
2890 PRINT"{down*2}enter new value"
2900 x=5:y=10:l=24:GOSUB1930
2910 t$(0)=s$:GOSUB 2060:GOSUB2160
2920 GOTO 2750
2930 SCNCLR
2940 PRINT"{sh asterisk*15}"
2950 PRINT"delete record"
2960 PRINT"{sh asterisk*15}"
2970 fo=0
2980 PRINT:PRINT"enter "a$(0,0)" of record you wish to{space*14}delete:"
2990 x=5:y=10:l=24:GOSUB1930
3000 t$(0)=s$:GOSUB2060
3010 IF a$(h,0)=s$ THEN fo=1
3020 IF fo=0 THEN h=VAL(a$(h,nf))
3030 IF h<>0 AND fo<>1 THEN 3010
3040 IF h=0 AND fo=0 THEN w=3:GOSUB750:RETURN
3050 SCNCLR
3060 FORl=0 TO nf-1
3070 PRINTa$(0,l)":"TAB(16)a$(h,l):NEXT
3080 PRINT"{sh asterisk*40}"
3090 PRINT"is this the record you wish to delete?{space*2}"
3100 PRINT"{sh asterisk*40}"
3110 x=20:y=24:GOSUB410
3120 IF ke$<>"y"AND ke$<>"n"THEN 3110
3130 IF ke$="y"THEN 3150
3140 h=VAL(a$(h,nf)):fo=0:GOTO 3010
3150 PRINT: PRINT"are you sure (y/n)?"
3160 x=20:y=24:GOSUB410
3170 IF ke$<>"y"AND ke$<>"n"THEN 3110
3180 IF ke$="n"THEN RETURN
3190 PRINT:PRINT"{down}deleting record"
3200 FORl=0 TO nf-1:a$(h,l)="":NEXT
3210 PRINT: PRINT"{down}deletion complete"
3220 PRINT:PRINT"{down}press any key"
3230 GOSUB410:RETURN
3240 SCNCLR
3250 PRINT"{sh asterisk*15}"
3260 PRINT"view records"
3270 PRINT"{sh asterisk*15}"
3280 PRINT
3290 PRINT"please note that this routine does not"
3300 PRINT"allow you to access specific records"
3310 PRINT"selectively. it simply scans through "
3320 PRINT"the entire table printing out all the"
3330 PRINT"records which contain any data. as the"
3340 PRINT"tables are usually quite large, this"
3350 PRINT"can take a considerable amount of time."
3360 PRINT"the process can only be stopped if and"
3370 PRINT"when a record is found. if no records"
3380 PRINT"have been entered and you inadvertantly"
3390 PRINT"select this option, even after reading"
3400 PRINT"this, then you could have a pretty long"
3410 PRINT"wait. for selective viewing, choose the"
3420 PRINT"search option on the menu."
3430 PRINT
3440 PRINT"are you sure you wish to proceed?"
3450 x=20:y=24:GOSUB410
3460 IF ke$<>"y"ANDke$<>"n"THEN 3450
3470 IF ke$="n"THEN RETURN
3480 SCNCLR
3490 FAST
3500 FORl=1 TO nr
3510 FAST
3520 fl=0:IF a$(l,0)<>""THEN GOSUB3570
3530 IF fl=1 THEN 3550
3540 NEXT
3550 SLOW
3560 RETURN
3570 SLOW:SCNCLR
3580 FORe=0 TO nf-1:PRINTa$(0,e)":"TAB(16)a$(l,e)
3590 NEXT
3600 PRINT
3610 PRINT"press space to abort"
3620 PRINT"press any other key to continue"
3630 x=20:y=24:GOSUB410
3640 IF ke$<>" "THEN RETURN
3650 fl=1:RETURN
3660 REM********
3670 REM*search*
3680 REM********
3690 ta=0:p=0:r=0
3700 :SCNCLR:PRINT"{sh asterisk*12}":PRINT"search":PRINT"{sh asterisk*12}":PRINT
3710 PRINT:PRINT"enter as much information as you know "
3720 PRINT"about the record. if you only know part":PRINT"of a field or aren't sure then miss it":PRINT"out. if you include the full":PRINTa$(0,0);
3730 PRINT" of the record then the"
3740 PRINT"time taken for the search to complete"
3750 PRINT"will be very very short. if, however,"
3760 PRINT"you do not know this data, the time{space*5}taken will be very long."
3770 PRINT"{down*2}press any key to begin"
3780 x=20:y=24:GOSUB410:
3790 SCNCLR
3800 FORl=0 TO nf-1:PRINTa$(0,l)":":NEXT
3810 PRINT"{down*2}if you do not wish to enter the field{space*3}type 0 and press return, otherwise enterthe information you know and try to{space*5}enter the "a$(0,0)"."
3820 x=16:y=0:l=22
3830 FORq=0 TO nf-1:y=q:GOSUB1930:t$(q)=s$:IF s$="0" THEN t$(q)=""
3840 x=16:NEXT:FAST
3850 FORl=0 TO nf-1:IF t$(l)<>""THEN ta=ta+1
3860 NEXT
3870 IFt$(0)=""THEN SLOW:PRINT"{clear}as you have not entered the":PRINTa$(0,0)" of the record it will":PRINT"take quite a while to search so you had better go and"
3880 IF t$(0)=""THEN PRINT"have a few cups of tea, i should have{space*3}finished by then, i think":FORl=1 TO 1000:NEXT:GOSUB3970::RETURN
3890 GOSUB2060:r=0:p=0:FAST
3900 FORl=0 TO nf-1
3910 IF a$(h,0)=""THEN p=-1:GOTO 3940
3920 IF a$(h,l)=t$(l) THEN p=p+1
3930 NEXT
3940 IF ta=p THEN po(r)=h:r=r+1:
3950 IF a$(h,nf)="0"THEN GOSUB4080:RETURN
3960 h=VAL(a$(h,nf)):p=0: GOTO 3900
3970 r=0:p=0:FAST
3980 FORs=1 TO nr
3990 FORl=0 TO nf-1
4000 IF a$(s,0)=""THEN p=-1:GOTO 4020
4010 IF a$(s,l)=t$(l) THEN p=p+1
4020 COLOR4,2:COLOR4,1
4030 NEXT
4040 IF ta=p THENpo(r)=s:r=r+1
4050 p=0:NEXT
4060 GOSUB4080
4070 RETURN
4080 IF pr=1 THEN RETURN
4090 IF r=0 THEN PRINT"{clear}there{cm r}"0"{cm m} {141}4080:{142}
63999 REM "Invalid BASIC input d64-qloXoc
stop tok128
(bastext 1.0)