start tok64 d64-aM3P7q
8 REM *** jacket lister ***
9 REM *** compute sep-86 ***
10 REM ***** program set up *****
20 DIMtb$(144):DIMab$(144)
30 PRINT"{clear}{light blue}":POKE53280,14:POKE53281,6
40 PRINT"{down*4}{right*9}{reverse on}{white} what is today's date: ":PRINT:
50 PRINT"{right*5}{reverse on}{white} enter yr/dy/mo then <return> {reverse off}"
60 PRINT"{down*2}";SPC(11);:INPUTdt$
70 PRINT"{clear}{down*4}{right*9}{reverse on}{cyan} upper and lower case ? ":PRINT:
80 PRINT"{right*10}{reverse on}{cyan} {white}y{cyan} or {white}n{cyan} then <return> {reverse off}"
90 PRINT"{down*2}";SPC(11);:INPUTcc$
100 IFcc$="y"THENcm$=CHR$(17):REM lower case
110 IFcc$<>"y"THENcm$=CHR$(145):REM upper case
120 PRINT"{clear}{light blue}":POKE53280,14:POKE53281,6
130 PRINT"{down*4}{right}{yellow}which disk drive do you want to list?"
140 PRINT"{down*2}";SPC(11);:INPUTdi
150 REM ***** read disk menu *****
160 PRINT"{clear}{cyan}":POKE53280,2:POKE53281,0
170 PRINT"{down*6}{right*3}{reverse on}{space*2}reading{space*2}data : please standby{space*2}"
180 GOSUB1630
190 OPEN8,di,0,"$0":FORc=1TO8:GET#8,a$:NEXT:c=1:dn$="":FORc=1TO16
200 GET#8,a$:dn$=dn$+a$:NEXT:GET#8,a$:GET#8,a$:dn$=dn$+"{space*2}":GET#8,a$
210 dn$=dn$+a$:GET#8,a$:dn$=dn$+a$:GET#8,a$:GET#8,a$
220 GET#8,a$:GET#8,a$:c=1
230 FORa=1TO4:GET#8,a$:NEXT:pn$="":ty$=""
240 GET#8,a$:IFst<>0THEN310
250 IFa$=""THEN310
260 IFASC(a$)<>34THEN240
270 GET#8,a$:IFASC(a$)<>34THENpn$=pn$+a$:GOTO270
280 GET#8,a$:IFASC(a$)=32THEN280
290 ty$=ty$+a$:GET#8,a$:IFa$<>""THEN290
300 tb$(c)=pn$:c=c+1:IFst=0THEN230
310 CLOSE8
320 IFc>88THENGOSUB1310
330 REM *** alphabetize listing ***
340 PRINT"{clear}{cyan}":POKE53280,4:POKE53281,0
350 PRINT"{down*6}{right*3}{reverse on}{space*2}sorting{space*2}data : please standby{space*2}"
360 GOSUB1570
370 z$="{Z*16}":e=1
380 FORa=1TOc-1:c$=z$:FORb=1TOc-1:IFc$<tb$(b)THEN400
390 c$=tb$(b):d=b
400 NEXT:ab$(e)=c$:e=e+1:tb$(d)=z$:NEXT
410 REM  **** jacket name = ns$ ***
420 ns$="*****{space*3}reference{space*3}*****"
430 REM ***** print alpha list  *****
440 PRINT"{clear}":POKE53280,5:POKE53281,0
450 PRINT"{down*6}{right*2}{reverse on}{space*2}printing jacket : please standby{space*2}"
460 GOSUB1510
470 dd=0:cd=INT(c/2):OPEN1,4
480 FORcr=1TO2
490 PRINT#1,CHR$(10):REM linefeed
500 NEXTcr
510 tl$="{cm d}"
520 PRINT#1,TAB(2);:FORtl=1TO72:PRINT#1,tl$;:NEXTtl:PRINT#1," cut"
530 GOSUB1130:GOSUB1140
540 GOSUB1130
550 PRINT#1,CHR$(14);ns$;CHR$(15);:REM 14 double width 15 single
560 GOSUB1140
570 FORle=1TO2
580 GOSUB1130:GOSUB1140
590 NEXTle
600 GOSUB1130
610 PRINT#1,TAB(15);cm$;dn$;SPC(5);dt$;:GOSUB1140:GOSUB1160
620 IFc>32THEN790
630 REM ** print : < 32 programs **
640 FORdd=1TOcd:GOSUB1130
650 PRINT#1,CHR$(16);CHR$(50);CHR$(48);cm$;ab$(dd);:REM print head position
660 PRINT#1,CHR$(16);CHR$(52);CHR$(53);cm$;ab$(cd+dd);:GOSUB1140
670 REM print head position
680 NEXTdd
690 GOSUB1130:GOSUB1140:dd=dd+1
700 IFdd>17THEN720
710 GOTO690
720 GOSUB1220
730 FORsl=1TO29
740 GOSUB1200:GOSUB1210
750 NEXTsl
760 GOSUB1240
770 GOSUB1260
780 REM ** print : > 32 programs **
790 FORdd=1TO16:GOSUB1130
800 PRINT#1,CHR$(16);CHR$(50);CHR$(48);cm$;ab$(dd);:REM print head position
810 PRINT#1,CHR$(16);CHR$(52);CHR$(53);cm$;ab$(dd+16);:GOSUB1140
830 NEXTdd
840 GOSUB1130:GOSUB1140
850 GOSUB1220
860 GOSUB1200:GOSUB1210
870 cx=(c-33)/2:cz=cx+32
880 FORdd=33TOcz:GOSUB1200
890 PRINT#1,CHR$(16);CHR$(50);CHR$(48);cm$;ab$(dd);:REM print head position
900 PRINT#1,CHR$(16);CHR$(52);CHR$(48);cm$;ab$(dd+cx);:GOSUB1210
920 NEXTdd
930 GOSUB1200:GOSUB1210:dd=dd+1
940 IFdd>60THEN960
950 GOTO930
960 GOSUB1240:GOSUB1260
970 re *** cloSINg REMarks ***
980 PRINT"{clear}{cyan}":POKE53280,9:POKE53281,0
990 PRINT"{down*6}{right*2}{reverse on}{space*2}alphabetized disk cover complete{space*2}"
1000 GOSUB1460
1010 PRINT"{down*5}{right*2}{space*2}do you want another disk cover :"
1020 INPUT"{right*6}'y' or 'n' then <return>";ag$
1030 FORdd=0TO144:ab$(dd)="":NEXTdd
1040 IFag$<>"y"THEN1070
1050 PRINT"{clear}{light blue}":POKE53280,14:POKE53281,6:GOTO70
1060 REM ** terminate program **
1070 PRINT"{clear}{cyan}":POKE53280,7:POKE53281,11
1080 PRINT"{down*8}{right*8}{white}{reverse on}{space*2}program terminated !{space*2}"
1090 GOSUB1410
1100 FORwt=1TO1000:NEXTwt
1110 PRINT"{clear}{light blue}":POKE53280,14:POKE53281,6:END
1120 REM *** disk jacket outline ***
1130 PRINT#1,"{space*2}{cm j}{space*7}{cm g}*";:RETURN
1140 PRINT#1,CHR$(16);CHR$(54);CHR$(52);"*{cm m}{space*7}{cm l}":RETURN
1150 REM print head position
1160 PRINT#1,"{space*2}{cm j}{space*7}{cm g}*";
1170 PRINT#1,TAB(15);"{cm u*20}";:
1180 PRINT#1,CHR$(16);CHR$(54);CHR$(52);"*{cm m}{space*7}{cm l}":RETURN
1190 REM print head position
1200 PRINT#1,"{space*10}{cm j}";:RETURN:
1210 PRINT#1,CHR$(16);CHR$(54);CHR$(53);"{cm l}":RETURN:REM print head position
1220 cl$="C"
1230 PRINT#1,TAB(2);:FORcl=1TO72:PRINT#1,cl$;:NEXTcl:PRINT#1," fold":RETURN
1240 ll$="{cm u}"
1250 PRINT#1,TAB(10);:FORll=1TO56:PRINT#1,ll$;:NEXTll:PRINT#1," cut":RETURN
1260 PRINT#1:FORcr=1TO3
1270 PRINT#1,CHR$(10)
1280 NEXTcr:CLOSE1:GOTO980
1290 REM ** menu too long to list **
1300 REM ** can only list 88 pgms **
1310 PRINT"{clear}{cyan}":POKE53280,1:POKE53281,7
1320 PRINT"{down*5}";SPC(10);"{cyan}too{space*2}many{space*2}programs"
1330 PRINTSPC(10);"{cyan} to list on jacket"
1340 GOSUB1460
1350 PRINT"{down*3}";SPC(8);"{red}print{space*2}those{space*2}that{space*2}fit?"
1360 PRINTSPC(9);"({reverse on}y{reverse off} or {reverse on}n{reverse off} then <return>)
1370 PRINT"{down*2}";SPC(15);:INPUTaw$
1380 IFaw$<>"y"THEN1070
1390 c=88:RETURN
1400 REM  **** sound subroutines ***
1410 REM  ##### buzzer #####
1420 POKEs,240
1430 h=54273:s=54278:w=54276:v=54296
1440 POKEv,15:POKEh,5:POKEw,33:FORt=0TO500:NEXT
1450 FORt=h-1TOv:POKEt,0:NEXT:RETURN
1460 REM  ##### dong #####
1470 h=54273:s=54278:w=54276:v=54296
1480 POKEs-1,9:POKEh,36:POKEs+9,16:POKEv,15:FORu=1TO4:POKEw,21:FORt=0TO500
1490 NEXT:POKEw,20:NEXT
1500 FORt=h-1TOv:POKEt,0:NEXT:RETURN
1510 REM  ##### ding #####
1520 h=54273:s=54278:w=54276:v=54296
1530 FORaa=1TO3
1540 POKEv,15:POKEh,40:POKEs-1,9:POKEw,17:FORt=1TO500:NEXTt
1550 FORt=h-1TOv:POKEt,0:NEXT
1560 NEXTaa:RETURN
1570 REM  ##### bing-bong #####
1580 h=54273:s=54278:w=54276:v=54296
1590 POKEv,15:POKEs-1,88:POKEs,89:POKEw-1,1:FORu=1TO6:POKEw,65
1600 POKEh,20:FORt=0TO120:NEXT
1610 POKEw,64:POKEh,50:POKEw,65:FORt=0TO120:NEXT:POKEw,64:NEXT
1620 FORt=h-1TOv:POKEt,0:NEXT:RETURN
1630 REM  ##### bells #####
1640 v=54296:w=54276:POKEw+1,96
1650 POKEw+1,9
1660 POKEv,15:FORl=1TO5:POKEw,21
1670 POKEw-3,99*RND(1):POKEw+11,99*RND(1)
1680 FORt=1TO600:NEXT:POKEw,20:NEXT
1690 FORi=w-4TOv:POKEi,0:NEXT:RETURN
stop tok64
(bastext 1.0)