MULTIFILE+

Gallery

Source Code

    1 REM THIS PROGRAM WAS                DONATED BY TORONTO              TIMEX SINCLAIR USER'S           GROUP
    2 REM MODIFIED AND COPIED BY          ALGIS E. GEDRIS                 DECEMBER 20, 1986
  100 REM MULTIFILE+
  110 GO TO 1180
  120 LET free=~-1000: LET save=0: CLS 
  130 INPUT "How many string headings ?"'s
  140 LET t=0: LET g=1180
  150 LET x$="\:'\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\':"
  160 LET v$="\:.\..\..\..\..\..\..\..\..\..\..\..\..\..\..\..\..\..\..\..\..\..\..\..\..\..\..\..\..\..\..\.:"
  170 LET w$="\:                               \ :"
  180 IF save THEN RETURN 
  190 IF s<1 THEN GO TO 220
  200 DIM n$(s,12)
  210 DIM n(s)
  220 DIM l(20): DIM h(20)
  230 CLS 
  240 FOR z=1 TO s
  250 INPUT ("Name of string heading ";z)' LINE n$(z)
  260 INPUT "Maximum number of characters ?"'n(z)
  270 CLS 
  280 LET t=t+n(z): LET n(z)=t
  290 NEXT z
  300 LET tot=t: LET x=INT (free/tot): LET w=x
  310 PRINT #1;"There is room for ";x'"records."
  320 PAUSE 120
  330 IF s>0 THEN DIM a$(1,x,t)
  340 REM titling
  350 LET y$="          ": FOR z=1 TO LEN y$: POKE 26715+z-1,CODE y$(z): NEXT z
  360 POKE 23658,8: INPUT "Title ? (Max: 10 characters)"' LINE y$: POKE 23658,0
  370 FOR z=1 TO LEN y$: POKE 26715+z-1,CODE y$(z): NEXT z
  380 IF save THEN RETURN 
  390 LET d$="": LET n=0
  400 GO TO 1180
  410 CLS 
  420 LET n=n+1: LET x=n
  430 IF n>w THEN GO TO 1520
  440 IF mo THEN PRINT ;"Enter new data for each heading or press ENTER to leave as is.  "
  450 FOR z=1 TO s
  460 PRINT INVERSE 1;n$(z);"?  "
  470 IF mo AND z=1 THEN PRINT a$(z,x, TO n(1))
  480 IF mo AND z>1 THEN PRINT a$(1,x,n(z-1)+1 TO n(z))
  490 INPUT LINE z$
  500 IF z$="" THEN GO TO 550
  510 IF LEN z$>n(z) THEN LET z$=z$( TO n(z))
  520 IF z=1 THEN LET a$(z,x, TO n(1))=z$
  530 IF z>1 THEN LET a$(1,x,n(z-1)+1 TO n(z))=z$
  540 PRINT PAPER 2;"Changed to " AND mo;z$
  550 NEXT z
  560 PRINT #0;AT 0,0;"Record # ";x
  570 IF mo THEN PAUSE 120: RETURN 
  580 PRINT #0;AT 1,0; FLASH 1;" Another record ? Y/N"
  590 PAUSE 0
  600 IF INKEY$="" THEN GO TO 600
  610 IF INKEY$="y" THEN GO TO 410
  620 IF INKEY$<>"y" THEN GO TO 1180
  630 GO TO 590
  640 CLS 
  650 INPUT "Starting from what record # ?"'x
  660 CLS 
  670 IF chan THEN OPEN #2,"p"
  680 FOR z=1 TO s
  690 IF x=n+1 THEN CLS : PRINT AT 10,10;"Nothing found": PAUSE 120: GO TO 1180
  700 PRINT INVERSE 1;n$(z)
  710 IF z=1 THEN PRINT a$(1,x, TO n(1))
  720 IF z>1 THEN PRINT a$(1,x,n(z-1)+1 TO n(z))
  730 NEXT z
  740 PRINT #0;AT 0,0;"Record # ";x
  750 CLOSE #2
  760 IF mo THEN RETURN 
  770 PRINT #1;AT 1,0;"1=Continue; 2=Menu"
  780 LET u$=INKEY$
  790 IF u$="2" THEN GO TO 1180
  800 IF u$="1" AND j=1 THEN GO TO 860
  810 IF u$="1" THEN GO TO 830
  820 GO TO 780
  830 LET x=x+1
  840 IF x>w THEN GO TO 1180
  850 GO TO 660
  860 RETURN 
  870 CLS 
  880 LET j=1
  890 LET h$="Enter heading."
  900 LET e$="Enter search item."
  910 PRINT "Headings:"'': FOR z=1 TO s: PRINT TAB 3;n$(z): PRINT : NEXT z
  920 INPUT (h$)' LINE z$
  930 IF z$="" THEN GO TO 1180
  940 IF chan THEN OPEN #2,"p"
  950 LET y=1
  960 IF z$=n$(y, TO LEN z$) THEN GO TO 1030
  970 IF y=s THEN GO TO 1000
  980 LET y=y+1
  990 GO TO 960
 1000 PRINT #0;AT 0,5; FLASH 1;i$
 1010 PAUSE 120
 1020 GO TO 920
 1030 INPUT (e$)' LINE g$
 1040 LET g1=LEN g$
 1050 IF y=1 THEN GO TO 1460
 1060 LET x=1
 1070 IF g$=a$(1,x,n(y-1)+1 TO n(y-1)+g1) THEN GO SUB 660
 1080 IF x=n THEN CLS : PRINT AT 10,10;"Nothing found": PAUSE 120: GO TO 1180
 1090 IF x=w THEN GO TO 1180
 1100 LET x=x+1
 1110 GO TO 1070
 1120 CLS : REM change
 1130 INPUT "Enter record # to be changed"'x
 1140 LET mo=1
 1150 GO SUB 440
 1160 PRINT #0;AT 0,0; FLASH 1;" Changes complete "
 1170 PAUSE 120
 1180 LET chan=0: CLOSE #2: BORDER 0: PAPER 0: INK 9: CLS : LET g=1180
 1190 LET i$=" INVALID HEADING ! "
 1200 LET mo=0
 1210 POKE 23658,0
 1220 PRINT AT 1,12; INVERSE 1;y$
 1230 PRINT 'x$;w$;AT 4,13;" MENU "'w$;w$;AT 6,1;"Press...";AT 6,18; INVERSE 1;"Status";TAB 31
 1240 PRINT AT 8,0;" 1>> Initialize"'AT 9,0;" 2>> Create";AT 9,18; INVERSE 1;n;"/";w;TAB 31; INVERSE 0;AT 10,0;" 3>> Change";AT 11,0;" 4>> Search"
 1250 PRINT AT 12,0;" 5>> Step";AT 13,0;" 6>> Sort";AT 13,18; INVERSE 1;p$;TAB 31; INVERSE 0;AT 14,0;" 7>> Delete";AT 15,0;" 8>> Date/Save";AT 15,18; INVERSE 1;d$;TAB 31
 1260 PRINT " 9>> Print-out";AT 16,18; INVERSE 0; PAPER 2;"ON " AND chan=1; PAPER 4;"OFF" AND NOT chan
 1270 FOR i=7 TO 17: PRINT AT i,0;"\: ";AT i,31;"\ :": NEXT i: PRINT v$
 1280 PRINT 
 1290 LET j=0
 1300 PAUSE 0
 1310 IF INKEY$<"1" OR INKEY$>"9" THEN GO TO 1300
 1320 IF INKEY$="1" THEN GO TO 120
 1330 IF INKEY$="9" THEN LET chan=1: GO TO 1220
 1340 IF INKEY$="2" THEN GO TO 410
 1350 IF INKEY$="5" THEN GO TO 640
 1360 IF INKEY$="7" THEN GO TO 1600
 1370 IF INKEY$="4" THEN GO TO 870
 1380 IF INKEY$="6" THEN GO TO 1820
 1390 IF INKEY$="8" THEN GO TO 1420
 1400 IF INKEY$="3" THEN GO TO 1120
 1410 GO TO 1320
 1420 CLS 
 1430 DIM d$(6)
 1440 INPUT "Enter date (YYMMDD)"; LINE d$
 1450 GO TO 1550
 1460 LET x=1
 1470 IF g$=a$(1,x, TO g1) THEN GO SUB 660
 1480 IF x=n THEN CLS : PRINT AT 10,10;"Nothing found": PAUSE 120: GO TO 1180
 1490 IF x=w THEN GO TO 1180
 1500 LET x=x+1
 1510 GO TO 1470
 1520 CLS 
 1530 PRINT AT 10,10;"No room left !"
 1540 PAUSE 120
 1550 SAVE y$ LINE 1180: PRINT FLASH 1;"rewind for verify": VERIFY ""
 1560 GO TO 1180
 1570 CLEAR : LET p$="unsorted": LET save=1: GO SUB 150: GO SUB 350: LET g=1180: LET w=0: LET n=0: LET d$="": SAVE y$ LINE 1180: VERIFY "": LIST 
 1580 FOR z=1 TO LEN y$: POKE 26715+z-1,CODE y$(z): NEXT z: RETURN 
 1590 REM delete
 1600 CLS 
 1610 LET mo=1
 1620 INPUT "Record # ? (0=menu)"'x
 1630 IF x=0 THEN GO TO 1180
 1640 IF x>n THEN PRINT #0;" Invalid input ": PAUSE 60: GO TO 1620
 1650 PRINT "Record # ";x;" is:"''
 1660 GO SUB 680
 1670 PRINT #0;AT 0,0;"1=delete;2=menu"
 1680 PAUSE 0
 1690 IF INKEY$="" THEN GO TO 1690
 1700 IF INKEY$<>"1" THEN GO TO 1180
 1710 IF INKEY$="1" THEN PRINT #0;AT 0,0;"Deleting: Stand by....": GO TO 1730
 1720 GO TO 1680
 1730 IF x>n-1 THEN LET a$(1,x)="": GO TO 1745
 1740 FOR i=x TO n-1: LET a$(1,i)=a$(1,i+1): NEXT i
 1745 LET n=n-1
 1750 PAUSE 120
 1760 CLS : PRINT #1;"Record # ";x;" has been deleted": PRINT #0;"1=more deletions;2=menu"
 1770 PAUSE 0
 1780 IF INKEY$="" THEN GO TO 1780
 1790 IF INKEY$<>"1" THEN GO TO 1180
 1800 IF INKEY$="1" THEN GO TO 1600
 1810 GO TO 1770
 1820 CLS : FOR i=1 TO s: PRINT i,n$(i): NEXT i: INPUT ("choose sort type"'"not " AND p$<>"unsorted";p$ AND p$<>"unsorted")'st
 1830 IF st>s THEN CLS : PRINT "invalid input": PAUSE 60: CLS : GO TO 1820
 1840 IF st=1 THEN LET a=1: LET b=n(st)
 1850 IF st>1 THEN LET a=1+n(st-1): LET b=n(st)
 1860 CLS : PRINT FLASH 1;"Sorting..."'"by ";n$(st): LET p$=n$(st): GO SUB 1880
 1870 GO TO 1180
 1880 REM quicksort
 1890 LET l(1)=1
 1900 LET h(1)=n
 1910 LET ii=2
 1920 IF ii<=1 THEN RETURN 
 1930 IF l(ii)>=h(ii) THEN LET ii=ii-1
 1940 IF l(ii)>=h(ii) THEN GO TO 1920
 1950 LET i=l(ii)-1
 1960 LET j=h(ii)
 1970 LET il=j
 1980 IF i>=j THEN GO TO 2070
 1990 LET i=i+1
 2000 IF a$(1,i,a TO b)<a$(1,il,a TO b) THEN GO TO 1990
 2010 LET j=j-1
 2020 IF j>1 THEN IF a$(1,j,a TO b)>a$(1,il,a TO b) THEN GO TO 2010
 2030 IF i<j THEN LET k$=a$(1,i)
 2040 IF i<j THEN LET a$(1,i)=a$(1,j)
 2050 IF i<j THEN LET a$(1,j)=k$
 2060 GO TO 1980
 2070 LET j=h(ii): LET k$=a$(1,i): LET a$(1,i)=a$(1,j): LET a$(1,j)=k$
 2080 IF i-l(ii)<h(ii)-1 THEN LET l(ii+1)=l(ii): LET h(ii+1)=i-1: LET l(ii)=i+1: GO TO 2120
 2090 LET l(ii+1)=i+1
 2100 LET h(ii+1)=h(ii)
 2110 LET h(ii)=i-1
 2120 LET ii=ii+1
 2130 GO TO 1920
 2140 FOR i=1 TO n: PRINT a$(1,i): NEXT i
 2150 REM This program is based       on the original MULTIFILE       written for the ZX81 and        marketed by BUG-BYTE. It        has been modified to deal       only with strings and has       been enhanced to provide        additional routines:-           Delete, Sort, Printout.
 9998 SAVE "MULTIFILE" LINE 1