CP/M

home *** CD-ROM | disk | FTP | other *** search

/ CP/M / CPM_CDROM.iso / simtel / cpmug / cpmug046.ark / CPMLABEL.BAS < prev next >

Wrap

BASIC Source File | 1984-04-29 | 17.0 KB | 457 lines

40 '********************************************************************* 50 '* THIS PROGRAM GENERATES LABELS FOR CP/M USER'S GROUP DISKS * 60 '* COPYRIGHT (C) 1980 : BY BILL BOLTON, 27/05/80 * 70 '* PUBLISHED BY 80AT, 1980 * 80 '********************************************************************* 90 ' 100 ' Keep BASCOM happy by putting DIM statements right at the start' 110 ' 120 DIM ENTRY$(200) 'MAX NUMBER OF ENTRIES 130 DIM SUB$(9) 'NUMBER OF DEN/SECT LINES 140 ' 150 GOSUB 9000 'INITIALIZE SOME VARIABLES 160 GOSUB 1100 'CLEAR THE SCREEN 170 GOSUB 2700 'DISPLAY THE HEADING 180 GOSUB 3400 'DISPLAY STANDARD LABEL 190 GOSUB 3600 'ASK IF CHANGE NEEDED 200 IF YES% THEN GOSUB 3700:GOTO 180 210 GOSUB 4300 'ASK IF BATCH RUN 220 IF BATCH% THEN GOSUB 5100 230 IF ANOTHER.RUN% THEN 150 ELSE IF QUIT% THEN 370 240 GOSUB 700 'ASK WHICH VOLUME 250 GOSUB 1800 'SET UP THE VOLUME DESCRIPTION 260 IF OUT.OF.RANGE%<>0 THEN GOSUB 2900:GOTO 240 270 GOSUB 1100 'CLEAR THE SCREEN 280 GOSUB 1400 'DISPLAY COMPLETE LABEL 290 GOSUB 800 'ASK IF CHANGE NEEDED 300 IF YES% THEN GOSUB 700:GOTO 250 310 GOSUB 2400 'LINE UP THE LABEL 320 GOSUB 2500 'PRINT THE LABEL 330 GOSUB 500 'ASK IF ANOTHER COPY 340 IF YES% THEN GOSUB 1700:GOTO 310 350 GOSUB 600 'ASK IF ANOTHER LABEL 360 IF NO%=0 GOTO 160 370 GOSUB 1100 'CLEAR THE SCREEN 380 END 390 ' 400 ' 500 '************************************************************ 510 '* ANOTHER COPY OF THE LABEL? * 520 '************************************************************ 530 PRINT 540 PRINT 550 LINE INPUT "Another copy of the lable ? (Y/N, 'Return' = N) ";REPLY$ 560 GOSUB 3200 570 RETURN 580 ' 590 ' 600 '************************************************************ 610 '* ANOTHER NEW LABEL? * 620 '************************************************************ 630 PRINT 640 PRINT 650 LINE INPUT "A new lable to print ? (Y/N, 'Return' = Y) ";REPLY$ 660 GOSUB 3300 670 RETURN 680 ' 690 ' 700 '************************************************************ 710 '* ASK WHICH VOLUME * 720 '************************************************************ 730 PRINT 740 LINE INPUT "What is the volume number ? ";VOL$ 750 RETURN 760 ' 770 ' 800 '************************************************************ 810 '* CHANGE VOLUME ? * 820 '************************************************************ 830 LINE INPUT "Do you want to change the volume? (Y/N, 'Return' = N) ";REPLY$ 840 GOSUB 3200 850 RETURN 860 ' 870 ' 900 '************************************************************ 910 '* DISPLAY THE GENERAL ERROR MESSAGE * 920 '************************************************************ 930 PRINT 940 PRINT 950 PRINT CHR$(7); 'RING THE BELL ON THE TERMINAL 960 GOSUB 1160 'SET REVERSE VIDEO 970 ' 980 PRINT "********* Answer ";FIRST%;JOIN$;LAST%;" only, please *********"; 990 ' 1000 GOSUB 1190 'CLEAR REVERSE VIDEO 1010 PRINT 1020 PRINT 1030 RETURN 1040 ' 1050 ' 1100 '*********************************************************** 1110 '* VIDEO ATTRIBUTES * 1120 '*********************************************************** 1130 PRINT CHR$(27);CHR$(42) 'CLEAR SCREEN ROUTINE 1140 RETURN 1150 ' 1160 PRINT CHR$(27);"G4"; 'SET REVERSE VIDEO ROUTINE 1170 RETURN 1180 ' 1190 PRINT CHR$(27);"G0"; 'CLEAR REVERSE VIDEO ROUTINE 1200 RETURN 1210 ' 1220 ' 1300 '*********************************************************** 1310 '* WAIT FOR RESPONSE * 1320 '*********************************************************** 1330 PRINT 1340 LINE INPUT "Hit 'Return' to continue";REPLY$ 1350 RETURN 1360 ' 1370 ' 1400 '*********************************************************** 1410 '* DISPLAY LABEL ON CONSOLE * 1420 '*********************************************************** 1430 PRINT 1440 PRINT 1450 PRINT "Your disk lable will look like this :" 1460 PRINT 1470 PRINT 1480 PRINT LINE1$;VOL$ 'DISPLAY THE FIRST LINE 1490 PRINT 1500 PRINT LINE2$ 'DISPLAY THE SECOND LINE 1510 PRINT 1520 PRINT LINE3$ 'DISPLAY THE THIRD LINE 1530 PRINT 1540 PRINT LINE4$ 'DISPLAY THE FOURTH LINE 1550 PRINT 1560 PRINT 1570 PRINT 1580 RETURN 1590 ' 1600 ' 1700 '*********************************************************** 1710 '* CLEAR SCREEN AND DISPLAY LABEL * 1720 '*********************************************************** 1730 GOSUB 1100 'CLEAR THE SCREEN 1740 GOSUB 1400 'DISPLAY THE COMPLETE LABEL 1750 RETURN 1760 ' 1770 ' 1800 '*********************************************************** 1810 '* CHECK FOR VALID ENTRY AND SET LINE 2 * 1820 '*********************************************************** 1830 LET LINE1$="CP/M User's Group Disk, Volume : " 1840 OUT.OF.RANGE%=0 1850 IF VOL$="1" THEN LINE2$="Various CP/M Utilities":RETURN 1860 IF VOL$="2" THEN LINE2$="Lawrence Livermore BASIC and Tiny BASIC":RETURN 1870 IF VOL$="3" THEN LINE2$="BASIC-E Games and Programs":RETURN 1880 IF VOL$="4" THEN LINE2$="ACTOR, ML80 and Examples of FORTRAN-80 Code":RETURN 1890 IF VOL$="5" THEN LINE2$="BASIC-E Programs and Microsoft BASIC programs":RETURN 1900 IF VOL$="6" THEN LINE2$="CACHE utilities":RETURN 1910 IF VOL$="7" THEN LINE2$="PILOT - Programmed Enquiry Learning & Teaching":RETURN 1920 IF VOL$="8" THEN LINE2$="Various CP/M Utility Programs":RETURN 1930 IF VOL$="9" THEN LINE2$="General Ledger from Interface Age Vol.2 No.10":RETURN 1940 IF VOL$="10" THEN LINE2$="Lawrence Livermore BASIC interfaced to CP/M":RETURN 1950 IF VOL$="11" THEN LINE2$="TINIBASIC and Processor Technology BASIC/5":RETURN 1960 IF VOL$="12" THEN LINE2$="PILOT Interpreters Interfaced to CP/M":RETURN 1970 IF VOL$="13" THEN LINE2$="BASIC-E/CBASIC & Microsoft BASIC Programs":RETURN 1980 IF VOL$="14" THEN LINE2$="Various CP/M Utilities - 2":RETURN 1990 IF VOL$="15" THEN LINE2$="Utilities and non-BASIC Games":RETURN 2000 IF VOL$="16" THEN LINE2$="Assemblers, Other Utilities and FOCAL":RETURN 2010 IF VOL$="17" THEN LINE2$="Utilities, Denver Tiny BASIC & non-BASIC Games":RETURN 2020 IF VOL$="18" THEN LINE2$="Maths Routines, Monitors and CASUAL":RETURN 2030 IF VOL$="19" THEN LINE2$="Various CP/M Utilities - 3":RETURN 2040 IF VOL$="20" THEN LINE2$="BASIC-E/CBASIC Programs & Pictures":RETURN 2050 IF VOL$="21" THEN LINE2$="Microsoft BASIC Games Programs":RETURN 2060 IF VOL$="22" THEN LINE2$="Monsterous StarTrek Games in BASIC":RETURN 2070 IF VOL$="23" THEN LINE2$="STOIC - Stack Oriented Interactive Compiler":RETURN 2080 IF VOL$="23B" OR VOL$="23b" THEN LINE2$="STOIC - Overflow Programs From Vol 23":RETURN 2090 IF VOL$="24" THEN LINE2$="CP/M Utilities, Macro Libraries & RATFOR":RETURN 2100 IF VOL$="25" THEN LINE2$="Various Assembler Utilites":RETURN 2110 IF VOL$="26" THEN LINE2$="Microsoft BASIC & FORTRAN Games and Utilities":RETURN 2120 IF VOL$="27" THEN LINE2$="Microsoft BASIC Games":RETURN 2130 IF VOL$="28" THEN LINE2$="BASIC-E Games & Utilities, ALGOL-M":RETURN 2140 IF VOL$="29" THEN LINE2$="Assembler Games & Utilities, BASIC-E Source":RETURN 2150 IF VOL$="30" THEN LINE2$="BASIC-E Ver 1.4 Source Code in PL/M":RETURN 2160 IF VOL$="31" THEN LINE2$="Tarbell BASIC - 1":RETURN 2170 IF VOL$="32" THEN LINE2$="Tarbell BASIC - 2":RETURN 2180 IF VOL$="33" THEN LINE2$="Search and Rescue Programs":RETURN 2190 IF VOL$="34" THEN LINE2$="SAM-76 Language":RETURN 2200 IF VOL$="35" THEN LINE2$="FELIX - Graphics Animation System":RETURN 2210 IF VOL$="36" THEN LINE2$="Assemblers, Editors and Utilities":RETURN 2220 IF VOL$="37" THEN LINE2$="CBASIC2 Game, Utility and CAI Programs":RETURN 2230 IF VOL$="38" THEN LINE2$="Speed Up and Tarbell Disk Controller Utilities":RETURN 2240 IF VOL$="39" THEN OUT.OF.RANGE%=2:RETURN 2250 IF VOL$="40" THEN LINE2$="Various Utilities, Disk Catalog System":RETURN 2260 IF VOL$="41" THEN LINE2$="Ham Radio, Chess and FORTRAN programs":RETURN 2270 IF VOL$="42" THEN LINE2$="Disassemblers, Diablo & Clock Routines":RETURN 2280 IF VOL$="CAT" OR VOL$="cat" THEN LINE2$="Complete Catalog of ALL Volumes":LINE1$="CP/M User's Group":VOL$=" ":RETURN 2290 ' 2300 OUT.OF.RANGE%=1 'SET AN ERROR FLAG 2310 RETURN 2320 ' 2330 ' 2400 '*********************************************************** 2410 '* LINE UP THE LABEL * 2420 '*********************************************************** 2430 PRINT 2440 PRINT 2450 LINE INPUT "Line up the lable in the printer and press 'Return' when ready to print";REPLY$ 2460 RETURN 2470 ' 2480 ' 2500 '*********************************************************** 2510 '* PRINT THE LABEL * 2520 '*********************************************************** 2530 LPRINT LINE1$;VOL$ 2540 LPRINT 2550 LPRINT LINE2$ 2560 LPRINT 2570 LPRINT LINE3$ 2580 LPRINT 2590 LPRINT LINE4$ 2600 LPRINT 2610 LPRINT 2620 RETURN 2630 ' 2640 ' 2700 '*********************************************************** 2710 '* DISPLAY THE HEADING * 2720 '*********************************************************** 2730 PRINT TAB(18); 2740 GOSUB 1160 'SET REVERSE VIDEO 2750 ' 2760 PRINT " CP/M USER'S GROUP DISK LABEL PRINTING PROGRAM "; 2770 ' 2780 GOSUB 1190 'CLEAR REVERSE VIDEO 2790 PRINT 2800 PRINT 2810 RETURN 2820 ' 2830 ' 2900 '*********************************************************** 2910 '* ERROR MESSAGE & PAUSE * 2920 '*********************************************************** 2930 GOSUB 3000 'DISPLAY ERROR MESSAGE 2940 GOSUB 1300 'DISPLAY CONTINUE MESSAGE 2950 RETURN 2960 ' 2970 ' 3000 '*********************************************************** 3010 '* INVALID VOLUME NUMBER MESSAGE * 3020 '*********************************************************** 3030 PRINT 3040 PRINT CHR$(7); 'RING THE BELL ON THE TERMINAL 3050 GOSUB 1160 'SET REVERSE VIDEO 3060 ' 3070 IF OUT.OF.RANGE%=1 THEN PRINT " THAT VOLUME DOES NOT EXIST ! "; ELSE PRINT " VOLUME ";VOL$;" HAS BEEN WITHDRAWN ! "; 3080 ' 3090 GOSUB 1190 'CLEAR REVERSE VIDEO 3100 PRINT 3110 PRINT 3120 RETURN 3130 ' 3140 ' 3200 '*********************************************************** 3210 '* AFFIRMATIVE REPLY CHECK ROUTINE * 3220 '*********************************************************** 3230 YES%=0 3240 IF REPLY$="Y" OR REPLY$="y" THEN YES%=1 3250 RETURN 3260 ' 3270 ' 3300 '*********************************************************** 3310 '* NEGATIVE REPLY CHECK ROUTINE * 3320 '*********************************************************** 3330 NO%=0 3340 IF REPLY$="N" OR REPLY$="n" THEN NO%=1 3350 RETURN 3360 ' 3370 ' 3400 '*********************************************************** 3410 '* DISPLAY STANDARD LABEL ROUTINE * 3420 '*********************************************************** 3430 PRINT 3440 PRINT "The Standard Lable Will Be:" 3450 VOL$="XX" 3460 LINE2$="Volume Description" 3470 GOSUB 1460 'DISPLAY THE COMPLETE LABEL 3480 RETURN 3490 ' 3500 ' 3600 '*********************************************************** 3610 '* ASK CHANGE QUESTION ROUTINE * 3620 '*********************************************************** 3630 LINE INPUT "Do you want to change the Density/Sector line ? (Y/N 'Return' = N) ";REPLY$ 3640 GOSUB 3200 'CHECK THE ANSWER 3650 RETURN 3660 ' 3670 ' 3700 '*********************************************************** 3710 '* SET UP THE NEW DEN/SECT DEFAULT LINE * 3720 '*********************************************************** 3730 GOSUB 1100 'CLEAR THE SCREEN 3740 FIRST%=1:LAST%=FIRST% 3750 SD$=" Single Density, " 3760 DD$=" Double Density, " 3770 JOIN$=" to " 3780 SECTOR$= " Byte Sectors" 3790 IBM$="IBM System 34" 3800 PRINT 3810 PRINT 3820 SUB$(LAST%)="IBM 3740"+SD$+"128 ":LAST%=LAST%+1 3830 SUB$(LAST%)=IBM$+DD$+"256 ":LAST%=LAST%+1 3840 SUB$(LAST%)=IBM$+DD$+"512 ":LAST%=LAST%+1 3850 SUB$(LAST%)=IBM$+DD$+"1024":LAST%=LAST%+1 3860 SUB$(LAST%)="North Star"+SD$+"256 ":LAST%=LAST%+1 3870 SUB$(LAST%)="North Star"+DD$+"512 ":LAST%=LAST%+1 3880 SUB$(LAST%)="Helios, 256 ":LAST%=LAST%+1 3890 SUB$(LAST%)="Micropolis, 256 ":LAST%=LAST%+1 3900 SUB$(LAST%)="User Entered Density and" 3910 ' 3920 FOR I%=FIRST% TO LAST% STEP 1 3930 SUB$(I%)=SUB$(I%)+SECTOR$ 3940 PRINT SUB$(I%);TAB(54);"-";TAB(60);I% 3950 NEXT I% 3960 PRINT 3970 PRINT 3980 INPUT "Enter Selection Number - ",SIZE% 3990 IF SIZE%<FIRST% OR SIZE%>LAST% THEN GOSUB 900:GOSUB 1300:GOTO 3730 4000 IF SIZE%=LAST% THEN GOSUB 4100 ELSE LINE4$=SUB$(SIZE%) 4010 GOSUB 1100 'CLEAR THE SCREEN 4020 RETURN 4030 ' 4040 ' 4100 '*********************************************************** 4110 '* ENTER THE NEW DEN/SECT LINE * 4120 '*********************************************************** 4130 PRINT 4140 LINE INPUT "Enter your new Density/Sector line :";LINE4$ 4150 PRINT 4160 RETURN 4170 ' 4180 ' 4300 '*********************************************************** 4310 '* ASK BATCH QUESTION * 4320 '*********************************************************** 4330 PRINT 4340 LINE INPUT "Do you want to do a batch of lables ? (Y/N 'Return' = N) ";REPLY$ 4350 GOSUB 3200 'CHECK THE ANSWER 4360 IF YES% THEN GOSUB 4400 ELSE RETURN 4370 RETURN 4380 ' 4390 ' 4400 '*********************************************************** 4410 '* VOLUME NUMBER ENTRY ROUTINE * 4420 '*********************************************************** 4430 FINISH%=0: ROW%=12 :BATCH%=0 :IN.VOLUME%=1 4440 GOSUB 1100 'CLEAR THE SCREEN 4450 EXIT%=0 4460 PRINT 4470 PRINT "Enter - The volume number (Range 1 to";MAX%;")" 4472 PRINT " - CAT for total catalogue" 4475 PRINT " - ALL for complete set (Does automatic END)" 4478 PRINT " - END to terminate enteries" 4480 PRINT 4484 PRINT " (Note that Volume 39 has been withdrawn)" 4488 PRINT 4490 WHILE IN.VOLUME% 4500 GOSUB 4800 4510 IF IN.VOLUME%=0 THEN IF FINISH%=0 THEN EXIT%=1 4520 WEND 4530 WHILE EXIT%=0 4550 GOSUB 1100 'CLEAR THE SCREEN 4560 PRINT "Lables for the following volumes will be printed :" 4570 PRINT 4580 FOR X% = 1 TO FINISH% STEP ROW% 4590 FOR Y% = 0 TO ROW%-1 STEP 1 4600 FILL%=POS(X)+(4-LEN(ENTRY$(X%+Y%))) 4610 PRINT TAB(FILL%) ENTRY$(X%+Y%);","; 4620 GOSUB 5000 4630 NEXT Y% 4640 PRINT 4650 NEXT X% 4660 WEND 4670 PRINT 4680 LINE INPUT "Do you want to add any further volumes ? (Y/N 'Return' = N) ";REPLY$ 4690 GOSUB 3200 'CHECK THE REPLY 4700 IF YES% THEN IN.VOLUME%=1:GOSUB 4450 4710 IF EXIT%=1 THEN RETURN 4720 BATCH%=1 4730 RETURN 4740 ' 4750 ' 4800 '*********************************************************** 4810 '* VOLUME INPUT ROUTINE * 4820 '*********************************************************** 4830 FINISH%=FINISH%+1 4840 LINE INPUT "Volume number : ";ENTRY$(FINISH%) 4850 IF ENTRY$(FINISH%)="END" OR ENTRY$(FINISH%)="end" THEN IN.VOLUME%=0 :FINISH%=FINISH%-1 ::RETURN ELSE VOL$=ENTRY$(FINISH%) 4860 IF ENTRY$(FINISH%)="ALL" OR ENTRY$(FINISH%)="all" THEN GOSUB 5400 :IN.VOLUME%=0 :RETURN 4870 GOSUB 1840 4880 IF OUT.OF.RANGE% THEN GOSUB 3000: FINISH%=FINISH%-1 :RETURN 4890 RETURN 4900 ' 4910 ' 5000 '*********************************************************** 5010 '* CHECK FOR LOOP END * 5020 '*********************************************************** 5030 IF X%+Y%=FINISH% THEN Y%=ROW% :X%=FINISH% :EXIT%=2 :RETURN ELSE RETURN 5040 ' 5050 ' 5100 '*********************************************************** 5110 '* BATCH PRINT ROUTINE * 5120 '*********************************************************** 5130 GOSUB 2400 'LINE UP THE LABELS 5140 PRINT 5150 PRINT 5160 PRINT "Printing a batch of";FINISH%;" lables." 5170 PRINT 5180 FOR BATCH%=1 TO FINISH% STEP 1 5190 VOL$=ENTRY$(BATCH%) 5200 GOSUB 1800 'SET UP LINE 2 5210 GOSUB 2500 'PRINT THE LABEL 5220 PRINT "*"; 5230 IF POS(X)=60 THEN PRINT 5240 NEXT BATCH% 5250 PRINT 5260 PRINT 5270 LINE INPUT "Do you want to do another run? (Y/N 'Return' = N) ";REPLY$ 5280 GOSUB 3200 5290 IF YES% THEN ANOTHER.RUN%=1 ELSE QUIT%=1 5310 RETURN 5320 ' 5330 ' 5400 '*********************************************************** 5410 '* SET UP TO PRINT ALL THE LABELS * 5420 '*********************************************************** 5430 LOOP%=0 5440 COUNT%=1 5450 WHILE COUNT%<=MAX% 5460 ENTRY$(FINISH%)=STR$(COUNT%) 5470 COUNT%=COUNT%+1 5475 IF COUNT%=39 THEN COUNT%=COUNT%+1 5480 IF COUNT%<=MAX% THEN FINISH%=FINISH%+1 5490 WEND 5500 PRINT 5510 LINE INPUT "Do you want a lable for volume 23B ? (Y/N 'Return = N) ";REPLY$ 5520 GOSUB 3200 'CHECK THE ANSWER 5530 IF YES% THEN FINISH%=FINISH%+1 :ENTRY$(FINISH%)="23B" 5540 PRINT 5550 LINE INPUT "Do you want a lable for the catalogue ? (Y/N 'Return' = N) ";REPLY$ 5560 GOSUB 3200 5570 IF YES% THEN FINISH%=FINISH%+1 :ENTRY$(FINISH%)="CAT" 5580 RETURN 5590 ' 5600 ' 9000 '*********************************************************** 9010 '* PROGRAM INITIALIZATION * 9020 '*********************************************************** 9030 LINE1$="CP/M User's Group Disk, Volume : " 9040 LINE3$="From the 80AT public domain software library" 9050 IF START.UP% THEN RETURN 9060 LINE4$="IBM 3740 Single Density, 128 Byte sectors" 9070 START.UP%=1 9080 MAX%=42 9090 RETURN