100 '----------------
110 'LABEL EDITOR AND
120 '    PRINTER
130 '----------------
140 '      by
150 '  K. M. Simons
160 'v 1.1a   12/8/89
170 '----------------
180 '---------------
190 'Set-up routines
200 '---------------
205 PRINT CHR$(27)"E"CHR$(27)"H":INPUT "Please type the length of the labels you are using in sixths of an inch:  ",label.length%
210 OPTION RUN
220 PRINT CHR$(27)"f";:ON ERROR GOTO 1150
230 MEMORY ,,,242:BUFFERS 20:PRINT CHR$(27)"E"
240 OPTION NOT TAB:WIDTH 255:WIDTH LPRINT 255
250 x$=CHR$(27):DEF FNa$(x,y)=x$+"Y"+CHR$(y+32)+CHR$(x+32):DEF FNb$=x$+"j"+x$+"Y/?"+HEX$(PEEK(64502!),2)+":"+HEX$(PEEK(64503!),2)+":"+HEX$(PEEK(64504!),2)+x$+"k"
260 DATA Mr. Keith M. Simons,"10, Orrishmere Road,","Cheadle Hulme,","Cheadle,","Cheshire.",SK8 5HP
270 FOR a=1 TO 6:READ l$(a):NEXT
280 IF FIND$("Labels.dat")="" THEN CREATE 1,"Labels.dat","Labels.inx",2,242:st1%=1: ELSE OPEN "k",1,"Labels.dat","Labels.inx",2
290 FIELD 1,40 AS l$(1),40 AS l$(2),40 AS l$(3),40 AS l$(4),40 AS l$(5),40 AS l$(6)
300 FIELD 1,40 AS ll$(1),40 AS ll$(2),40 AS ll$(3),40 AS ll$(4),40 AS ll$(5),40 AS ll$(6)
310 IF st1%=1 THEN FOR a= 1 TO 6:LSET l$(a)=STRING$(40,"*"):NEXT:st1%=0:rc%=ADDREC(1,2,7,"DUMMY"):rc%=CONSOLIDATE(1)
320 rc%=SEEKRANK(1,2,0):GET 1:GOSUB 330:GOSUB 1220:GOTO 500
330 '-------------
340 'Label display
350 '-------------
360 PRINT CHR$(27)+"Y  "CHR$(150)+STRING$(40,CHR$(154))+CHR$(156)
370 FOR a=1 TO 6:PRINT CHR$(149);l$(a);TAB(42);CHR$(149):NEXT
380 PRINT CHR$(147);STRING$(40,CHR$(154));CHR$(153)
390 PRINT CHR$(150)+STRING$(40,CHR$(154))+CHR$(156)
400 PRINT CHR$(149);:IF st1% THEN PRINT "Editing A New Label";TAB(42);CHR$(149):ELSE PRINT FETCHKEY$(1);TAB(42);CHR$(149)
410 PRINT CHR$(147);STRING$(40,CHR$(154));CHR$(153)
420 RETURN
430 '----------
440 'Show a box
450 '----------
460 PRINT x$"Y+ ";CHR$(150)+STRING$(40,CHR$(154))+CHR$(156)
470 PRINT CHR$(149);TAB(42);CHR$(149)
480 PRINT CHR$(147);STRING$(40,CHR$(154));CHR$(153);x$"Y,!";
490 RETURN
500 '-------------
510 'Label options
520 '-------------
530 z$=UPPER$(INKEY$):IF z$="" THEN IF FNb$<>tme$ THEN PRINT FNb$;:tme$=FNb$:GOTO 530 ELSE 530
540 IF z$="D" THEN IF SEEKREC(1,2)=0 AND FETCHRANK(1)=0 THEN GOSUB 940:IF y1% THEN rc%=DELKEY(1,2):rc%=CONSOLIDATE(1):rc%=SEEKRANK(1,2,0):GOSUB 630:GOSUB 1220 :ELSE PRINT x$"E":GOSUB 1220:GOSUB 630
550 IF z$="P" THEN GOSUB 630:GOSUB 1080 
560 IF z$="F" THEN PRINT x$"e";:GOSUB 1000:PRINT x$"f";:GOSUB 1220
570 IF z$="N" THEN st1%=1:PRINT x$"e";:GOSUB 870:GOSUB 1220:PRINT x$"f";:st1%=0:GOTO 530
580 IF z$=CHR$(27) THEN PRINT x$"e"x$"E"x$"HThank you.";:CLOSE 1:OPTION STOP:GOTO 25000:END
590 IF z$="E" THEN GOSUB 630:PRINT x$"e";:a%=1:p=0:GOSUB 680:FOR a=1 TO 6:LSET ll$(a)=l$(a):NEXT:PUT 1:PRINT x$"f";:GOSUB 330:GOTO 530
600 IF z$=CHR$(1) THEN IF SEEKPREV(1,2)>102 THEN rc%=SEEKRANK(1,2,0):GOSUB 630 ELSE GOSUB 630
610 IF z$=CHR$(6) THEN IF SEEKNEXT(1,2)<102 THEN GOSUB 630 ELSE IF SEEKPREV(1,2)<103 THEN GOSUB 630 ELSE rc%=SEEKRANK(1,2,0):GOSUB 630
620 GOTO 530
630 '---------
640 'Get label
650 '---------
660 GET 1:FOR a=1 TO 6:l$(a)=ll$(a):NEXT:GOSUB 340:RETURN
670 '------------
680 'Label editor
690 '------------
700 FOR a=1 TO 6:WHILE l$(a)<>"" AND RIGHT$(l$(a),1)<=" ":l$(a)=LEFT$(l$(a),LEN(l$(a))-1):WEND:NEXT
710 GOSUB 340:PRINT x$"Y!!";
720 x$=CHR$(27):WIDTH 255
730 y$=CHR$(1)+CHR$(6)+CHR$(127)+CHR$(7)
740 z$=INKEY$:IF z$="" THEN IF FNb$<>tme$ THEN PRINT FNb$;:tme$=FNb$:GOTO 740 ELSE 740
750 ON INSTR(y$,z$) GOSUB 790,800,810,820:IF INSTR(y$,z$) GOTO 740
760 IF z$=CHR$(27) THEN RETURN
770 IF z$<" " THEN GOSUB 830:GOTO 740
780 l$(a%)=LEFT$(l$(a%),p)+z$+MID$(l$(a%),p+1):PRINT x$"j"MID$(l$(a%),p+1)x$"k"x$"C";:p=p+1:GOTO 740
790 IF p>0 THEN p=p-1:PRINT x$"D";:RETURN ELSE PRINT CHR$(7);:RETURN
800 IF p<LEN(l$(a%)) THEN p=p+1:PRINT x$"C";:RETURN ELSE PRINT CHR$(7);:RETURN
810 IF p>0 THEN p=p-1:PRINT x$"D";:ELSE PRINT CHR$(7);:RETURN
820 l$(a%)=LEFT$(l$(a%),p)+MID$(l$(a%),p+2):PRINT x$"j";MID$(l$(a%),p+1)" ";x$"k";:RETURN
830 IF z$=CHR$(30) THEN IF a%<6 THEN a%=a%+1:p=MIN(p,LEN(l$(a%))):PRINT FNa$(p+1,a%);:RETURN:ELSE RETURN
840 IF z$=CHR$(31) THEN IF a%>1 THEN a%=a%-1:p=MIN(p,LEN(l$(a%))):PRINT FNa$(p+1,a%);:RETURN:ELSE RETURN
850 IF z$=CHR$(13) THEN IF a%<6 THEN a%=a%+1:p=0:PRINT FNa$(p+1,a%);:RETURN:ELSE RETURN
860 RETURN
870 '-----------
880 'New records
890 '-----------
900 FOR a=1 TO 6:l$(a)="":NEXT
910 a%=1:p=0:GOSUB 680:GOSUB 430:LINE INPUT "STORE ALPHABETICALLY AS: ",z$:FOR a=1 TO 6:LSET ll$(a)=l$(a):NEXT:rc%=ADDREC(1,2,0,UPPER$(z$))
920 PRINT x$"E";:st1%=0:rc%=CONSOLIDATE(1):GOSUB 330
930 RETURN
940 '-------------
950 'Are you sure?
960 '-------------
970 GOSUB 430:PRINT "DELETE THIS RECORD - ARE YOU SURE (Y/N)"
980 z$=UPPER$(INPUT$(1)):IF z$="Y" THEN y1%=-1:PRINT x$"E";: ELSE IF z$="N" THEN y1%=0 ELSE 980
990 z$="":RETURN
1000 '----------
1010 'Find label
1020 '----------
1030 GOSUB 430:LINE INPUT "FIND THE LABEL STORED AS: ",z$
1040 rc%=SEEKKEY(1,2,0,UPPER$(z$))
1050 IF FETCHRANK(1)<>0 THEN rc%=SEEKPREV(1,2)
1060 GET 1:PRINT x$"E";:GOSUB 630
1070 RETURN
1080 '------------
1090 'Print labels
1100 '------------
1110 LPRINT x$"c"x$"C"CHR$(label.length%);:'set up printer
1120 GOSUB 330
1130 FOR a=1 TO 6:LPRINT l$(a):NEXT:LPRINT CHR$(12);
1140 RETURN
1150 '----------------
1160 'Error processing
1170 '----------------
1180 rc%=CONSOLIDATE(1)
1190 IF ERR=63 THEN IF SEEKRANK(1,2,0)<103 THEN RESUME
1200 PRINT x$"E"x$"HError - No. "ERR" at line no. "ERL"!"
1210 ON ERROR GOTO 0
1220 '-----------
1230 'Help screen
1240 '-----------
1250 PRINT x$"Y. ";CHR$(150)+STRING$(40,CHR$(154))+CHR$(156)
1260 PRINT CHR$(149);"Time: "TAB(42);CHR$(149)
1270 PRINT CHR$(149);TAB(42);CHR$(149)
1280 PRINT CHR$(149);x$CHR$(11)"  See previous label"TAB(41);CHR$(149)
1290 PRINT CHR$(149);x$CHR$(12)"  See next label"TAB(41);CHR$(149)
1300 PRINT CHR$(149);"P  Print this label"TAB(42);CHR$(149)
1310 PRINT CHR$(149);"D  Delete this label"TAB(42);CHR$(149)
1320 PRINT CHR$(149);"E  Edit this label  [EXIT to finish]"TAB(42);CHR$(149)
1330 PRINT CHR$(149);"N  New label        [EXIT to finish]"TAB(42);CHR$(149)
1340 PRINT CHR$(149);"F  Find a label by name"TAB(42);CHR$(149)
1350 PRINT CHR$(149);"EXIT  to finish"TAB(42);CHR$(149)
1360 PRINT CHR$(147);STRING$(40,CHR$(154));CHR$(153)
1370 RETURN
25000 IF FIND$("M:$$$$$$$$.&&&")<>"" THEN OPTION STOP:PRINT "[Press any key to return to main menu or press (STOP) to stop]":z$=INPUT$(1):RUN "M:$$$$$$$$.&&&":ELSE END
OPTION STOP:PRINT "[Press any key to return to main menu or press (STOP) to stop]":z$=INPUT$(1):RUN "M:$$$$$