home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.barnyard.co.uk
/
2015.02.ftp.barnyard.co.uk.tar
/
ftp.barnyard.co.uk
/
cpm
/
walnut-creek-CDROM
/
ENTERPRS
/
C64
/
GFX
/
PSUTIL.ARC
/
PSLABELER
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2000-06-30
|
3KB
|
92 lines
1 REM PRINT SHOP LABEL MAKER
2 REM BY BRIAN HEYBOER 12/1/85
3 REM THIS PROGRAM IS PUBLIC DOMAIN.
4 REM THIS PROGRAM CONTAINS BASIC AND
5 REM MACHINE LANGUAGE. EDITING OR
6 REM OTHERWISE CHANGING POINTERS MAY
7 REM AFFECT PROGRAM EXECUTION IN
8 REM UNPREDICTABLE WAYS
9 IFLC THEN SYS 4850:GOTO 510
10 PRINT"[147] [208]RINT [211]HOP [199]RAPHICS [204]ABEL [205]AKER":PRINT" [194]Y [194]RIAN [200]EYBOER
20 [153]"(null)HIS PROGRAM PRINTS STANDARD ONE INCH"
30 [153]"MAILING LABELS USING (null)RINT (null)HOP CHR$RAPHICS
40 PRINT"[145]AND TEXT OF YOUR CHOICE ON AN [197]PSON OR
50 [153]"COMPATABLE PRINTER.
60 PRINT"[212]HIS PROGRAM IS PUBLIC DOMAIN.
70 [153]"(null)RINT (null)HOP IS A TRADEMARK OF PEEKRODERBUND.
80 PRINT"[197]PSON IS A TRADEMARK OF [197]PSON [193]MERICA.
90 [153]" (null)RESS ANY KEY WHEN READY.
95 GETX$:IFX$=""THEN95
100 DIM X%(56,11),Y%(6,87),L$(6),F$(6),FS$(9)
110 E$=CHR$(27)
120 FS$(0)=E$+CHR$(69)
130 FS$(1)=FS$(0)+CHR$(14)
140 FS$(2)=CHR$(15)
150 FS$(3)=FS$(0)+E$+CHR$(83)+CHR$(0)
160 FS$(4)=FS$(0)+E$+CHR$(83)+CHR$(1)
170 FS$(5)=FS$(0)+E$+CHR$(52)
180 FS$(6)=FS$(1)+FS$(5)
190 FS$(7)=FS$(2)+E$+CHR$(52)
200 FS$(8)=FS$(3)+FS$(5)
210 FS$(9)=FS$(4)+FS$(5)
220 EL$=E$+CHR$(84)+E$+CHR$(53)+CHR$(18)+E$+CHR$(70)+CHR$(10)+CHR$(13)
230 PRINT"[147] [208]RINT [211]HOP [199]RAPHICS [204]ABEL [205]AKER":PRINT
240 PRINT"[199]RAPHIC [198]ILE [206]AME ($ FOR [196]IRECTORY)
250 LC[178]0:[133] G$:[139] G$[178]"$"[167][141]750
260 [153]"RIGHT$NPUT (null)ABEL (null)EXT. ASCOR BEST RESULTS,"
270 [153]"SKIP ALTERNATE LINES. ((null)SE 0,2,4,6 FOR
280 PRINT"FOUR LINE LABELS AND 1,3,5 FOR THREE
290 [153]"LINES. (null)INES WITH COMMAS OR COLONS MUST
300 PRINT"[145]BE IN QUOTES.
310 [153]"ATNVAILABLE ASCONTS:
320 PRINT" 0 = [206]ORMAL
330 [153]" 1 = VALXPANDED
340 PRINT" 2 = [195]ONDENSED
350 [153]" 3 = (null)UPERSCRIPT
360 PRINT" 4 = [211]UBSCRIPT
370 [153]" 5 = RIGHT$TALIC
380 PRINT" 6 = [197]XPANDED [201]TALIC
390 [153]" 7 = LENONDENSED RIGHT$TALIC
400 PRINT" 8 = [211]UPERSCRIPT [201]TALIC
410 [153]" 9 = (null)UBSCRIPT RIGHT$TALIC
420 FOR A=0TO6:L$(A)=" ":PRINT"[212]EXT FOR LINE "A;:INPUT L$(A)
430 PRINT"[198]ONT FOR LINE "A;:INPUT F$(A)
440 IFVAL(F$(A))>9THEN430
450 NEXT
460 NL$=" ":INPUT"[206]UMBER OF LABELS";NL$:NL=VAL(NL$)
470 IF NL=0THEN900
490 IFLCTHEN510
500 OPEN8,8,8,G$+",P,R":GET#8,A$:CLOSE8
501 IFSTTHENLC=0:PRINT" [193] [196]ISK [197]RROR HAS OCCURED.":GOSUB850:GOTO500
502 LC=-1:LOAD G$,8,1
510 IFFOTHEN670
650 FO=-1:OPEN5,4,8
660 OPEN4,4,5:PRINT#4,CHR$(27);CHR$(65);CHR$(8)
670 FOR E=1 TO NL
680 FOR A=0TO6:PRINT#4,CHR$(27);CHR$(76);CHR$(88);CHR$(0);:C=21760+(A*88):D=C+87
690 FOR B=CTOD:PRINT#4,CHR$(PEEK(B));:NEXT
700 PRINT#4," "FS$(VAL(F$(A)));:PRINT#5,L$(A):PRINT#4,EL$:NEXT
710 PRINT#5,CHR$(10);CHR$(10)
720 NEXT:GOTO460
750 OPEN8,8,0,"$0":N$=CHR$(0):X$=N$
760 GET#8,A$,A$,A$,A$,A$,A$
770 GET#8,A$:IF A$=""THEN790
780 X$=X$+A$:GOTO770
790 PRINT" " X$
810 GET#8,A$,A$:IF A$=""THEN CLOSE 8:GOTO850
820 GET#8,A$,B$:B$=STR$(ASC(A$+N$)+ASC(B$+N$)*256)
830 GET#8,A$:IF A$=""THEN PRINT" "B$:B$="":GOTO810
840 B$=B$+A$:GOTO830
850 CLOSE8:PRINT"[199]RAPHIC [198]ILE [206]AME ($ FOR [196]IRECTORY)"
880 INPUT G$:IF G$="$"THENGOSUB750:GOTO850
890 RETURN
900 PRINT"[193] NEW LABEL ([217]/[206])?"
910 GETA$:IFA$="Y"ORA$="[217]"THEN950
920 IF A$="N"ORA$="[206]"THEN1000
930 GOTO910
950 PRINT"[211]AME [199]RAPHIC ([217]/[206])?"
960 GETA$:IFA$="Y"ORA$="[217]"THEN260
970 IF A$="N"ORA$="[206]"THEN240
980 GOTO960
1000 IF FO THEN PRINT#4,E$;CHR$(64):CLOSE4:CLOSE5