o< TK-LABELS.BCKm~  TK-LABELS.BCKBACKUP/NOASSIST TK-LABELS.COB;0,TK-LABELS.MAR;0,TK-LABELS.COM;0,TK-LABELS.RNO;0,TK-LABELS.LABS;0,AAAREADME.TXT;0 TK-LABELS.BCK/SAVE/GROUP=0/BLOCK=2048 HARVEY @ 9|V5.4 _TOP::  _$4$DUA1: V5.4 #*[USER.HARVEY.LABELS]TK-LABELS.COB;1+,H1./@ 4L-A 0123KPWO56`{|ڔ7`G{|ڔ89 V G@HJIDENTIFICATION DIVISION.PROGRAM-ID. TK-Labels.L***************************************************************************** F* A program to format labels to fit the label window of a TK50/70 tape * cartridge.* :* Digital Equipment Computer Users Society (DECUS)L* This program may be freely distributed or modified by any party, including3* but not limited to DECUS and anyone within DECUS.+* USE AT YOUR OWN RISKJ* DECUS, DECUServe and the author make NO warranties whatsoever, includingL* without limitation, all implied warranties of merchantability and fitness.*7* Author: Jack Harvey August 25, 19911* GWA Information Systems'* (617)890-1838*L**************************************************************************** ENVIRONMENT DIVISION.input-output section. file-control.!select inp assign to "input_file" status is file-status.$select outp assign to "output_5f TK-LABELS.BCKH1A #[USER.HARVEY.LABELS]TK-LABELS.COB;1L: file".DATA DIVISION. file section.fd inp: record varying from 1 to 512 depending on input-rec-size.01 input-rec pic x(512).fd outp; record varying from 1 to 512 depending on output-rec-size.01 output-rec pic x(512).working-storage section."01 file-status pic xx value "00".!88 end-file value "10" "13" "16".88 end-job value "EE".01 input-count pic 99999.01 records-read pic 99999.01 output-count pic 99999."01 input-rec-size pic 99999 comp.#01 output-rec-size pic 99999 comp.D* Note: x and y are the LN03 page coordinates, with the origin (0,0)F* being the upper left corner. Increasing x moves the position to theG* right. Increasing y moves the position down the page. The units are1* decipoints. There are 720 decipoints per inch.* The following are constants.@* x0 and y0 are the upper left corner of first label on sheet. !01 x0 pic 99999 comp value 669.!01 y0 pic 99999 comp value 826.1* height and width are the size of a label box. %01 height pic 99999 comp value 585.%01 width pic 99999 comp value 1600.* normal spacing is ,01 normal-spacing pic 99999 comp value 100.?* margin is the minimum top and bottom margins for text in box.$01 margin pic 99999 comp value 50.9* These are variables, applying to the current label box.<* xbox and ybox are the coordinates of the upper left cornerA* of the current label box. current-spacing is text line spacing* in this box.01 xbox pic 99999 comp.01 ybox pic 99999 comp.#010x TK-LABELS.BCKH1A #[USER.HARVEY.LABELS]TK-LABELS.COB;1L current-spacing pic 99999 comp. 01 form-feed value x"0C" pic x.01 escape value x"1B" pic x.>* "~" in the following becomes ASCII escape character: escape.A* setup is used to initialize the LN03 printer. This sets origin?* to upper left, position units, decipoint and the type font to * Courier 6.7 point, 13.6 pitch.101 setup pic x(21) value "~[?52h~[11h~[2 |~[15m".<* vector is used by horizontal-bar and vertical-bar to draw >* a label box line. bar-x, bar-y and bar-length determine theA* starting x,y position and length of the line. vector-direction;* is set by them to determine direction line goes from x,y. 01 vector. 02 filler value "~[" pic xx. 02 vector-direction pic x. 02 filler value ";" pic x. 02 bar-x pic 9999. 02 filler value ";" pic x. 02 bar-y pic 9999. 02 filler value ";" pic x. 02 bar-length pic 9999.! 02 filler value ";1!|" pic xxxx.H* text-line is used to position and print a line of text in a label box.H* text-x and text-y are the position of the first character of the line. 01 text-line. 02 filler value "~[" pic xx. 02 text-x pic 9999. 02 filler value "`~[" pic xxx. 02 text-y pic 9999. 02 filler value "d" pic x. 02 txt-line pic x(30).@* This is used to store a complete label text prior to printing.A* line-pointer is the current line. line-count is to total lines* in this label. 01 line-pointer pic 99999 comp.01 line-count pic 99999 comp.01 line-buffer. 02 line-x occurs 10 times.?* DW TK-LABELS.BCKH1A #[USER.HARVEY.LABELS]TK-LABELS.COB;1Lq line-size is length of a single line text. 04 line-size pic 9(4) comp. 04 line-t pic x(30).  PROCEDURE DIVISION.initialization. open input inp output outp6* Setup escape sequences with ASCII escape character.. inspect setup converting "~" to escape/ inspect vector converting "~" to escape2 inspect text-line converting "~" to escape% move x0 to xbox move y0 to ybox' move normal-spacing to current-spacing* Initialize the LN03 printer. move 21 to output-rec-size write output-rec from setup8* Read the first label text into the line-buffer array. perform load-label* This is the main loop. ! perform make-label until end-job * Wind up.% display "label count: " output-count stop run. @* This loads a complete label text into the line-buffer array. @* If a different format data file is to be used, (for example, =* single record per label, with a field for each line) this B* routine would be modified to shuffle the fields into the array. load-label. move 0 to line-count!* Read first line of label text. perform read-inputA* Note that if the first line size is zero, the following skips.$ perform until input-rec-size = zero if input-rec-size > 30' display "Line too long, truncated: " input-rec (1:30) move 30 to input-rec-size end-if if line-count < 10 add 1 to line-count0 move input-rec-size to line-size (line-count)( move input-rec to line-t (line-counx# TK-LABELS.BCKH1A #[USER.HARVEY.LABELS]TK-LABELS.COB;1L t) else& display "Too many lines, dropped: " input-rec (1:input-rec-size) end-if9* Read another line of text for this label. perform read-input=* If the input record size is zero, this exits. end-perform. A* Label text is in the line-buffer array. Now create the box and * send it all to the print file. make-label.&* First, see if we have filled a page.! if ybox > ( y0 + (height * 10 ))7* if so, kick out the page and start new. move 1 to output-rec-size! write output-rec from form-feed# move x0 to xbox move y0 to ybox end-if if y0 = ybox/* We are at the top of a page, make top of box. move xbox to bar-x move ybox to bar-y perform horizontal-bar end-if if x0 = xbox4* We are at left side of page, make left end of box. move xbox to bar-x move ybox to bar-y perform vertical-bar end-if perform insert-label-text>* Make right end of box, which is left end next box to right. add width xbox giving bar-x move ybox to bar-y perform vertical-bar>* Make bottom of box, which is top of next box down the page. move xbox to bar-x add height ybox giving bar-y perform horizontal-barB* A label is complete. Now advance to the next position on page. add 1 to output-count;* Labels advance left to right across page, and then down. add width to xbox if xbox > 6000 - width@* Another label won't fit across this page, start 0* a new se\>l TK-LABELS.BCKH1A #[USER.HARVEY.LABELS]TK-LABELS.COB;1LHt of labels across page. move x0 to xbox add height to ybox end-if if not end-file+* Read in another label text. perform load-label else move "EE" to file-status end-if. insert-label-text.9* First figure out what the line spacing is going to be. if line-count < 5( move normal-spacing to current-spacing else@ compute current-spacing = (height - (2 * margin)) / line-count end-if9* Now calculate the vertical position of the first line. compute text-y = ybox + 9 ((height - ((line-count - 1) * current-spacing))/2) + 25(* Initialize to first line of the text. move 1 to line-pointerK* This is the loop which will insert each line of text into the label box.=* Note that if line-count is zero, it will exit immediately.) perform until line-pointer > line-countA* Calculate horizontal position to center the text. compute text-x = ; xbox + ((width - (line-size(line-pointer) * 53))/2) + 3G* Insert the text and write the control sequence to file. move line-t (line-pointer) + to txt-line (1:line-size (line-pointer))8 add line-size (line-pointer) 14 giving output-rec-size5 write output-rec from text-line (1:output-rec-size)8* advance vertical position down the page. add current-spacing to text-y add 1 to line-pointer end-perform. read-input. read inp ! at end move "10" to file-status move zero to input-rec-size% display "end input at " in—W TK-LABELS.BCKH1A #[USER.HARVEY.LABELS]TK-LABELS.COB;1Lsput-count end-read if not end-file add 1 to input-count  end-if.horizontal-bar.* Line goes from left to right, move "0" to vector-direction&* with a length equal to width of box. move width to bar-length move 22 to output-rec-size write output-rec from vector. vertical-bar.#* Line goes down from bar-x, bar-y, move "1" to vector-direction'* with a length equal to height of box. move height to bar-length move 22 to output-rec-size write output-rec from vector.ƻ TK-LABELS.BCK3A #[USER.HARVEY.LABELS]TK-LABELS.MAR;4P#*[USER.HARVEY.LABELS]TK-LABELS.MAR;4+,3./ 4P-A 0123KPWO56[.!7.!89j9G@HJ .Title TK_LABELS ;tk-labels.mar .ident "V1.0"; M;****************************************************************************;* G;* A program to format labels to fit the label window of a TK50/70 tape ;* cartridge.;* ;;* Digital Equipment Computer Users Society (DECUS)M;* This program may be freely distributed or modified by any party, including4;* but not limited to DECUS and anyone within DECUS.,;* USE AT YOUR OWN RISKK;* DECUS, DECUServe and the author make NO warranties whatsoever, includingM;* without limitation, all implied warranties of merchantability and fitness.;*;;* Author: Jack Harvey September 21, 19912;* GWA Information Systems(;* (617)890-1838;*M;****************************************************************************;  $fabdef ;define the offsets $rabdef1 .psect tk_labels_data,pic,con,wrt,noexe,shr,longH; input_file is a logical pointi !h TK-LABELS.BCK3A #[USER.HARVEY.LABELS]TK-LABELS.MAR;4Pcng to a file containing the label texts.';select input_file assign to input_file=input_file:$fab fnm = ,- ;defined by command file+ dnm = ;default if broken'input_file_rab: $rab fab = input_file,-( ubf = input_rec,- ;input/output buffer usz = 512input_rec: .blkb 512Ninput_rec_size = input_file_rab+rab$w_rsz ;equates to ease the code referencesrecord_size = input_rec_size!status = input_file_rab+rab$l_stsG; output_file logical is the formated text to send to the LN03 printer.Goutput_file:$fab fnm = ,- ;logical defined by command file. dnm = ,- ;default if broken fac = put,-# rat = cr ;so it will TYPE nicely'output_file_rab: $rab fab = output_filePoutput_rec_size = output_file_rab+rab$w_rsz ;equates to ease the code references&output_rec = output_file_rab+rab$l_rbfinput_count: .long 0records_read: .long 0output_count: .long 0 *work1: .quad 0 ;used for error reporting ctrstr: .ascid/label count: !ZL/outlen:outbuf: .word 80,0 .address 1$ 1$: .blkb 80;; Macro to convert long to four ascii digits, leading zeros .macro adigit4 src,dst% movl src,digit4l ;get the long value bsbw digit4 ;convert to ascii0 movc3 #4,digit4a,dst ;move ascii to destination .end adigit4*digit4l: .long 0 ;binary value placed here@digit4d:.ascid / / ;binary to ascii four digit result to here8digit4a = digit4d +8 ;address of four digit ascii stringD; Note: x and y are the LN03 page coordina ; TK-LABELS.BCK3A #[USER.HARVEY.LABELS]TK-LABELS.MAR;4P`tes, with the origin (0,0)F; being the upper left corner. Increasing x moves the position to theG; right. Increasing y moves the position down the page. The units are1; decipoints. There are 720 decipoints per inch.; The following are constants.@; x0 and y0 are the upper left corner of first label on sheet. x0: .long 669 y0: .long 8261; height and width are the size of a label box. height: .long 585width: .long 1600+normal_spacing: .long 100 ; normal spacing ?; margin is the minimum top and bottom margins for text in box.margin: .long 509; These are variables, applying to the current label box.<; xbox and ybox are the coordinates of the upper left cornerA; of the current label box. current_spacing is text line spacing; in this box.xbox: .long 0ybox: .long 0current_spacing: .long 0 form_feed: .byte ^X0C esc = ^X1B escape: .byte esc;; in the following is ASCII escape character: escape.A; setup is used to initialize the LN03 printer. This sets origin?; to upper left, position units, decipoint and the type font to ; Courier 6.7 point, 13.6 pitch.;setup: .ascii "[?52h""[11h""[2 |""[15m"<; vector is used by horizontal-bar and vertical-bar to draw >; a label box line. bar-x, bar-y and bar-length determine theA; starting x,y position and length of the line. vector-direction;; is set by them to determine direction line goes from x,y.vector: .ascii "[" vector_direction: .byte 0 .ascii  KB TK-LABELS.BCK3A #[USER.HARVEY.LABELS]TK-LABELS.MAR;4PZ ";" bar_x: .blkb 4 ;pic 9999 .ascii ";" bar_y: .blkb 4 ;pic 9999. .ascii ";" bar_length: .blkb 4 ;pic 9999. .ascii ";1!|"H; text_line is used to position and print a line of text in a label box.H; text_x and text_y are the position of the first character of the line.text_line: .ascii "[" text_x: .blkb 4 ;pic 9999. .ascii "`""[" text_y: .blkb 4 ;pic 9999. .ascii "d" txt_line: .blkb 304text_yl: .long 0 ;binary value for text_y saved here@; This is used to store a complete label text prior to printing.A; line_pointer is the current line. line_count is to total lines; in this label.line_pointer: .long 0line_count: .long 0line_current: .long 0line_buffer: .blkb 320 - .psect tk_labels_code,exe,nowrt,pic,shr,long(.entry tk_labels ^M<> ;main entry point(10$: $open fab = input_file ;label input movzbl input_file+fab$b_fns,R9 movl input_file+fab$l_fna,R83 bsbw check_status ;report if not normal successful $connect rab = input_file_rab3 bsbw check_status ;report if not normal successful1 $create fab = output_file ;formated label output movzbl output_file+fab$b_fns,R9 movl output_file+fab$l_fna,R83 bsbw check_status ;report if not normal successful $connect rab = output_file_rab3 bsbw check_status ;report if not normal successful$; Initialization, setup LN03 printer movl x0,xbox movl y0,ybox$ movl normal_spacing,current_spacing9 movw #21,output_rec_size ;setup to initialize% moval setup {[| TK-LABELS.BCK3A #[USER.HARVEY.LABELS]TK-LABELS.MAR;4P ,output_rec ;the printer $put rab = output_file_rab $ bsbw load_label ;get first label -90$: cmpl status,#33 ; main loop - end job? beql windup ;br if end bsbw make_label! brb 90$ ;main loop of protram1windup: $faol_s ctrstr,outlen,outbuf,output_count bsbw print_outbuf $exit_s ;stop run load_label: clrl line_count bsbw read_input820$: tstw input_rec_size ;loop until record size is zero bneq 25$ brw 100$,25$: cmpw input_rec_size,#30 ;line too long? blequ 30$0 $faol_s 110$,outlen,outbuf,120$;yes, display it bsbw print_outbuf+ movw #30,input_rec_size ;and truncate it230$: cmpl line_count,#9 ;check current line count bgtru 50$ ;br if too many mull3 line_count,#32,R0+ moval line_buffer,R8;point to label buffer addl2 R0,R8, movw input_rec_size,(R8) ;store line length4 movc3 input_rec_size,input_rec,2(R8);store the line incl line_count brb 60$;50$: movzwl input_rec_size,work1 ;build a record descriptor moval input_rec,work1+40 $faol_s 130$,outlen,outbuf,work1;format message bsbw print_outbuf ;display it60$: bsbw read_input brw 20$ 100$: rsb+110$:.ascid /Line too long, truncated: !AD/120$: .long 30 .address input_rec )130$:.ascid /Too man lines, dropped: !AD/print_outbuf:pushal outbuf/ calls #1,G^lib$put_output ;print $FAO message& movw #80,outlen ;reset buffer length rsb A; Label text is in the line-buffer array. Now create the box and ; send it all to the print file. make_label:&;  3L TK-LABELS.BCK3A #[USER.HARVEY.LABELS]TK-LABELS.MAR;4PlFirst, see if we have filled a page. mull3 #10,height,R0' addl y0,R0 ;calculate length of page cmpl ybox,R0 bleq 10$ ;br if not full movw #1,output_rec_size. moval form_feed,output_rec ;kick out the page $put rab = output_file_rab* movl x0,xbox ;reset to top of next page movl y0,ybox10$: cmpl y0,ybox! bneq 20$ ;br if not top of box% adigit4 xbox,bar_x ;make xbox ascii adigit4 ybox,bar_y bsbw horizontal_bar20$: cmpl x0,xbox& bneq 30$ ;br if not left end of box adigit4 xbox,bar_x adigit4 ybox,bar_y bsbw vertical_bar30$: bsbw insert_label_text?;make right end of box, which is left end of next box to right. addl3 width,xbox,R0 adigit4 R0,bar_x adigit4 ybox,bar_y bsbw vertical_bar<;make bottom of box, which is top of next box down the page. adigit4 xbox,bar_x addl3 height,ybox,R0 adigit4 R0,bar_y bsbw horizontal_bar@;a label is complete. Now advance to the next position on page. incl output_count9;Labels advance left to right across page, and then down. addl width,xbox subl3 width,#6000,R0 cmpl xbox,R0 blequ 40$4; Another label won't fit across this page, start a!; new set of labels across page. movl x0,xbox addl height,ybox40$:$ cmpl #rms$_eof,status ;end of file? beql 50$ ;br if end1 bsbw load_label ;no, read in another label text rsb ;end of make_label,50$: movl #33,status ;set end-job flag rsb ;End of job Linsert_label_text: ;first figure out what the line spacing i"m TK-LABELS.BCK3A #[USER.HARVEY.LABELS]TK-LABELS.MAR;4Ps going to be. cmpl line_count,#5 bgequ 10$$ movl normal_spacing,current_spacing brb 20$<10$: ;current_spacing = (height - (2 * margin)) / line_count mull3 #2,margin,R0 subl3 R0,height,R0$ divl3 line_count,R0,current_spacing@20$: ; Now calculate the vertical position of the first line.H; text_y = ybox + ((height - ((line_count - 1) * current_spacing))/2)+25 subl3 #1,line_count,R0 mull2 current_spacing,R0 subl3 R0,height,R0 divl2 #2,R0 addl2 #25,R0 addl3 R0,ybox,text_yl< adigit4 text_yl,text_y ;text_y calculated and ascii-ed: clrl line_pointer ;Initialize to first line of the text I;This is the loop which will insert each line of text into the label box.;;Note that if line_count is zero, it will exit immediately.!30$: cmpl line_pointer,line_count! bneq 40$ ;br if non-blank label* rsb ;label done, exit insert_label_textB; text_x = xbox + ((width - (line-size(line-pointer) * 53))/2) + 340$: mull3 line_pointer,#32,R0& moval line_buffer,R8 ;point to buffer addl2 R0,R8 ;point to line movzwl (R8),R7 ;line-size mull3 #53,R7,R0 subl3 R0,width,R0 divl2 #2,R0 addl2 #3,R0 addl3 R0,xbox,R0 adigit4 R0,text_x9; Insert the text and write the control sequence to file.# movc5 R7,2(R8),#^A/ /,#30,txt_line addl3 R7,#14,output_rec_size moval text_line,output_rec $put rab = output_file_rab*; Advance vertical position down the page. addl current_spacing,text_yl adigit4 text_yl,text_y incl line_pointer brw 30$Ndigit4::|xGN TK-LABELS.BCK3A #[USER.HARVEY.LABELS]TK-LABELS.MAR;4P(pushl #4 ;convert digit4l to four digits in digit4a: .ascii /1234/, pushal digit4d ;descriptor of output string( pushal digit4l ;binary value to convert1 calls #3,G^ots$cvt_l_tu ;convert binary to ascii rsb Bread_input: ;read an input record, return with R8 pointer, R9=size $get rab = input_file_rab" cmpl R0,#rms$_eof ;end of file?$ beql 50$ ;no status check if eof/ bsbw check_status ;exit with message if error incl input_count rsb&50$: clrw input_rec_size ;end flag& $faol_s 70$,outlen,outbuf,input_count bsbw print_outbuf rsb70$: .ascid "end input at !ZL"horizontal_bar:; Line goes from left to right, movb #^A/0/,vector_direction%; with a length equal to width of box movl width,digit4l bsbw digit4 movc3 #4,digit4a,bar_length movw #22,output_rec_size moval vector,output_rec $put rab = output_file_rab rsb vertical_bar:"; Line goes down from bar_x, bar_y movb #^A/1/,vector_direction&; with a length equal to height of box movl height,digit4l bsbw digit4 movc3 #4,digit4a,bar_length movw #22,output_rec_size moval vector,output_rec $put rab = output_file_rab rsb:check_status: ;report the RMS status message to sys$output2 cmpl R0,#RMS$_SUC ;normal successful completion? beql 50$ ;just exit if normal( movl #1,work1 ;setup for error display movl R0,work1+49 $putmsg_s msgvec = work1 ;display error text to terminal, movzbl R9,work1 ;build a descriptor of the movl R8,work1+4 ;filespec text( pushal work1 :R TK-LABELS.BCK3A #[USER.HARVEY.LABELS]TK-LABELS.MAR;4P ;point to the descriptor8 calls #1,G^lib$put_output ;output file name to terminal $exit_s ;abort job50$: rsb .end tk_labelsV TK-LABELS.BCK1 A #[USER.HARVEY.LABELS]TK-LABELS.COM;5B*#*[USER.HARVEY.LABELS]TK-LABELS.COM;5+,1 ./ 4B4-A 0123KPWO56`h7_h89j9G@HJ6$ !tk-labels.com - generate TK50/TK70 cartridge labels$ $ say :== write sys$output#$ if p1 .nes. "" then goto try_file$ say "No input file given"$ exit $try_file:$ pp1 = f$search(p1)#$ if pp1 .nes. "" then goto file_ok'$ say "Input text file ''p1' not found"$ exit $file_ok: &$ if p2 .eqs. "" then goto make_output8$ if f$parse(p2,,,"name") .eqs. "" then goto make_output-$ if f$parse(p2) .nes. "" then goto output_ok $make_output:4$ name=f$parse(pp1,,,"node")+f$parse(pp1,,,"device")B$ p2=name+f$parse(pp1,,,"directory")+f$parse(pp1,,,"name")+".ln03" $output_ok:$ say " Input is ''pp1'"$ say "Output is ''p2'"%$ DEFINE/nolog/user input_file 'pp1'$$ DEFINE/nolog/user output_file 'p2'$ run tk_labels:tk-labels6$ print 'p2' !alter this to go to your LN03 printer.$ exit  TK-LABELS.BCK/A $[USER.HARVEY.LABELS]TK-LABELS.RNO;10O$*[USER.HARVEY.LABELS]TK-LABELS.RNO;10+,/./ 4O-A 0123KPWO5617Z189G@HJ .no justify.no autojustify.lm +6.c;TK50 LABEL PRINTER.c;Version 1.1 .c;For LN03.b.c;27-Sep-1991.b.c;Jack Harvey.c;GWA Information Systems.b.c;(617)890-1838.TITLE TK50 Label Printer.B2 .paragraph 0.AP .HL1 SummaryAThis is a guide to TK-LABELS, a program to format labels fitting>the TK50/TK70 tape cartridge. The printer used must be an LN03@(or compatible) but needs ^&no\& advanced features, such as PostScript.:The input to the program is a simple text file that can be?prepared with an editor, the CREATE function or from DCL. EachAline in the file is a line on a label. An empty line signals theend of a label. For instance:.lm +10.literal$ CREATE TK50.LABSBackup of DUB0:before upgrade11/15/91Backup of DUB0: after upgrade11/16/91^ Z .end literal.lm -10AThe file TK50.LABS produced by the CREATE above will be converted<to two labels. Each line is centered left to right, and the<group of lines is centered vertically indז TK-LABELS.BCK/A $[USER.HARVEY.LABELS]TK-LABELS.RNO;10OhH the label box. The@small Courier 6.7 point font of the basic LN03 is used. This isIthe font customarily used for landscape printing of 66 line by 132 column listings.=The automatic line centering, when used with Upper/lower case3text, produces a very professional appearing label.@The labels are printed in "three-up" style, portrait mode. ThatAis, they are printed in rows of three across the page. A grid is2printed also as a paper cutting guide. By cutting=on the grid lines, slips of paper are obtained that just fit'into the label window of the cartridge..page.HL1 Installation and Use@The software in this kit uses no special VMS features and can be>located in any directory. This documentation assumes you haveBdefined a logical name, TK50__LABELS, that points to the directory<where you have placed the kit. To use, put the following (or#equivilent) in your login.com file:$$ labels :== @TK50__LABELS:TK-LABELSLThe command file TK-LABELS expects the logical name TK50__LABELS to point toHthe directory containing the files TK-LABELS.COM and TK-LABELS.EXE. Toinvoke,$ labels [];where is the file containing the text to be put in the labels. NThe formated text for printing on the LN03 is placed in . The outputLfile is optional. If it is omitted, a temporary output file will be createdMand printed. (Modify TK-LABELS.COM to direct the file to the LN03 print queueof your choice.)2The input file may also be TT:, so TK-LABELS.BCK/A $[USER.HARVEY.LABELS]TK-LABELS.RNO;10OD that a one time'set of labels may be created simply by: $ labels TT:9In this mode, a CTRL Z terminates the set of labels being)typed, and prints the result on the LN03..hl 1 Input Text File Details3The input file format was chosen to make producing 5attractive labels as simple as possible. The default:is to produce a label with text centered both horizontally9and vertically. However, as explained below, the default:can be overruled or modified by inserting space characters in the text.EThe input text file record is variable length. Each input record is aAline on a label. A record with a length of zero is the indicator@that the previous non-zero length records, called a label group,=is complete. A label is formatted and the zero length record;discarded. End-of-file is also treated as an indicator of acomplete label group..page.hl 2 Maximum line lengthMThe maximum line length is 30 characters. Any lines longer than that will beOtruncated and the error reported to the terminal or batch log file during label formatting..hl 2 Lines per Label<For attractive, easily readable labels, do not use more than@seven lines. The maximum number of lines per label is ten. If a<group of lines is greater than ten, the additional lines are?omitted and reported to the terminal during label formatting. 7Extra zero length records between label groups, or zerolength records after the!final group produce blank labels.7The spacing between lines is reduced if moreN TK-LABELS.BCK/A $[USER.HARVEY.LABELS]TK-LABELS.RNO;10O# than three;lines are in the group. While the formatter will attempt to=squeeze ten lines onto a label, the lines overlap seriously. ".hl 2 Horizontal Centering Control:If an input line record length is less than 30 characters,;the record is centered within the label. Note that leading<and trailing spaces are ^¬\& stripped and are included in8the record size used for the text centering calculation.;This means that leading spaces in the record will shift the;text right, and trailing spaces will shift it left from the;centered position. If exact control is wanted, simply make;each record exactly 30 characters long. The text will then:appear in the label determined entirely by the leading andtrailing spaces. .hl 2 Vertical Centering Control0A record of zero length is the label terminator.:However, blank lines containing one or more spaces are not;zero length and may be used to adjust the vertical position7of the label text. Such lines are significant when the7vertical position calculation is done. For example, to;print a single line at the top of a label, simply follow it.with five lines containing at least one space..page.hl 1 Label Stock@The normal paper stock in the LN03 can be used for TK50 labels. AHowever, it is too light weight for permanent labels unless glued=in place. Good bond, such as is common for stationary secondsheets performs well.=A better permanent (but removable) label can be made by using?heavy stock in the LN03. A handy source fXEas TK-LABELS.BCK/A $[USER.HARVEY.LABELS]TK-LABELS.RNO;10O7 or heavy stock is the?common buff colored manila file folder. This can be trimmed to78.5x11 on a paper cutter and will pass through the LN03satisfactorily..hl 1 Files and LinkingThe files in this kit are:.list4.le;AAAREADME.TXT - The standard DECUS introduction.E.le;TK-LABELS.MAR - the source for the formatter program in MACRO-32.K.le;TK-LABELS.COB - an alternate source for the formatter program in COBOL.CThis module and TK-LABELS.MAR are interchangeable and have the sameOperformance. Only one module is needed. Choose TK-LABELS.MAR or TK-LABELS.COB to suit your site.:.le;TK-LABELS.RNO - the source of this documentation file.>.le;TK-LABELS.COM - the command file which controls execution.K.le;TK-LABELS.LABS - an instructive example of input data showing how labelGformatting works. Run this through the program and compare it with thelabels produced.J.le;TK-LABELS.BCK - a BACKUP format file containing the six files above. NThis file is suitable for transfer via Kermit using the procedure described inthe following section.,.le;TK-LABELS.DOC - this documentation file. .end list.page$.hl1 Transferring files with kermitGIf you want to download this kit using KERMIT, this section describes aOprocedure that will transfer the TK-LABELS.BCK saveset containing all the basicfiles.:KERMIT is limited in the kinds of files it can handle, and<does not transfer VMS specific file header information, such;as dates and ownership. One way to transfer any type of VMS:fiy^ TK-LABELS.BCK/A $[USER.HARVEY.LABELS]TK-LABELS.RNO;10Ole, .EXE, .OBJ, indexed, etc., with complete file header:information is to encapsulate it in a BACKUP saveset. The:saveset can then be transferred error free with KERMIT and:unpacked at the receive end. This is also a convenient way4to send a group of files with mixed characteristics.!There are three steps to do this:.list?.le;Prepare a proper BACKUP saveset file - a little more than aAsimple BACKUP operation. This has already been done for this kit.0.le;Transfer the single saveset file via KERMIT.<.le;Get the transferred saveset file back into correct form. .end list .hl 2 Proper BACKUP Saveset File9BACKUP was used to create the TK-LABELS.BCK saveset file:.lm +2.literalC$ BACKUP TK-LABELS.MAC,TK-LABELS.COB,TK-LABELS.COM,TK-LABELS.RNO, -' TK-LABELS.LABS,AAAREADME.TXT -. TK-LABELS.BCK/SAVE/GROUP=0/BLOCK=2048 .end literal.lm -2@This is already done for you; TK-LABELS.BCK is ready for KERMIT.MTransferring the saveset file is done as follows. This assumes you have usedGKERMIT on your system as a terminal emulator to connect to and log into DECUServe..list).le;On DECUServe at the DCL prompt, type: .list " " .le;$ KERMIT".le;KERMIT-32> SET FILE TYPE FIXED.le;KERMIT-32> SET PARITY SPACE.LE;KERMIT-32> SERVE .END LIST.page(.le;Issue your KERMIT escape sequence to1regain control of KERMIT at your end. Then type: .list " ".le;KERMIT> SET FILE TYPE FIXED.le;KERMIT> SET PARITY SPACE .le;KERMIT> GET TK-LABELS.BCK. .le;KERMIT 7 TK-LABELS.BCK/A $[USER.HARVEY.LABELS]TK-LABELS.RNO;10O+.> FINI.le;KERMIT> EXIT .end list .end list#.hl 2 Correcting _the Received File<Create a ^&dummy\& BACKUP saveset using any convenient smallfile as input:7_$ BACKUP LOGIN.COM CORRECT.BCK/GROUP=0/BLOCK=2048/SAVE)_$ COPY/OVERLAY TK-LABELS.BCK CORRECT.BCK@The file CORRECT.BCK will now contain the saveset data and be in;a correct form for BACKUP to unpack. To unpack all of thefiles:_$ BACKUP CORRECT.BCK/SAVE []EIf you want to produce a printable version of this documentation, do:_$ RUNOFF TK-LABELS4The resulting TK-LABELS.MEM file is LN03 compatible..page".hl2 Transferring ASCII files onlyMIf KERMIT is not available, or you have problems with the procedure describedJabove, you may want to transfer only the necessary ASCII files and compileJand link at your site. Transferring ordinary ASCII text files is somewhatLeasier with KERMIT. You can also use the basic VMS command SET HOST/DTE/LOG"to capture the needed ASCII files.KThe minimum necessary is TK-LABELS.MAR or TK-LABELS.COB. If you don't haveJa COBOL compiler, choose TK-LABELS.MAR, as all VMS sites should be able tocompile this module.LIt is also strongly recommended that you transfer TK-LABELS.COM, which is anJexample showing how to use the program. In addition, TK-LABELS.LABS is anFexample label input file and demonstrates many of the label formattingFfeatures. Finally, TK-LABELS.RNO is the source for this documentation.*.hl2 Compiling _and Linking Source ModulesEThe COBOL and MACRDL TK-LABELS.BCK/A $[USER.HARVEY.LABELS]TK-LABELS.RNO;10OO-32 versions are intentionally coded to perform asLnearly alike as possible. There are trivial differences in errors messages.>The output files formatted for the LN03 printer are identical.NBecause of the optimization feature of the VAX COBOL compiler, speed should beMessentially the same also. However, the MACRO-32 version produces a smallerMexecutable file. Choosing between the two versions will probably depend onlyon personal taste.3The MACRO-32 source file is compiled and linked by:$ MACRO TK-LABELS$ LINK TK-LABELSNIf you have COBOL installed on your system, the COBOL source file is compiledand linked by:$ COBOL TK-LABELS$ LINK TK-LABELSEDefine the logical name TK_LABELS to point to the directory where youMhave stored TK-LABELS.COM and TK-LABELS.EXE from one of the link steps above.DRefer to the Installation and Use section above for further details.~7^ TK-LABELS.BCKL1A $[USER.HARVEY.LABELS]TK-LABELS.LABS;1$*[USER.HARVEY.LABELS]TK-LABELS.LABS;1+,L1./@ 4~-A 0123KPWO56 @|ڔ7s|ڔ89 V G@HJOne Line CenteredTwo Line LabelCenteredNote that Odd orEven Numbers of LinesRemain Truly Centered----Five Line Label----eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeLine Five of Five LinesStandalone Backup for VMS Version 5.1-B11/15/89 AQ-MM11A-BEULTRIX WS V2.0 (RISC) SUPPORTEDThis will be six linesand is about as far as onecan go while remaining easily readable. Note thatthe spacing is reduced.This label will be followed with three nulllines to create two blank labels. eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeHere we will force eight linesinto the label. The textnearly touches and becomesfairly difficult to read. However, if you need to forcethis much text into the label,it will not be attractive butit can be done.The extreme case occurs whenthe text is ten lines long. Inthis case, the lettersactually overlap slightly andthe readability of the text isWNĆ TK-LABELS.BCKL1A $[USER.HARVEY.LABELS]TK-LABELS.LABS;1j greatly reduced. If you usemore than ten lines per label,the formatting program willdrop the lines in excess ofthis and warn the user.These lines are all 30 characters long with trailing spaces. So the text is left justified. Here we shift right by using leading spaces Or we can insert space.The following line has a space at the beginning, resulting in a blank line on the label.     The above lines contain spaces to force this down.Left Top Right Top     Left Bottom Right Bottom70b TK-LABELS.BCKY1A #[USER.HARVEY.LABELS]AAAREADME.TXT;5O2#*[USER.HARVEY.LABELS]AAAREADME.TXT;5+,Y1./@ 4O-A 0123KPWO56`+:7 :89G@HJ6Submission Title: TK-LABELS Version 1.1 28-Sep-1991Submitter/Author: Jack Harvey GWA Information Systems (617)890-1838 Abstract:HTK-LABELS converts a simple editor text file into an LN03 print file to Kproduce a sheet of labels for the TK50/TK70 cartridge. It prints a grid ofIfine lines to guide cutting the sheet into individual slips that will fitNthe cartridge label window. The text, which is variable length and may containKup to eight lines, is attractively centered in the window. There are up to533 labels per sheet, printed on ordinary stock paper.IThe printer used must be an LN03 (or compatible) but does not require any'advanced features, such as Post Script.%Computer and O/S Version Information: VAX/VMS, any version from V4.7IThe identical program has been coded in both COBOL and MACRO-32. The kitLincludes both and the user is free to choose either, depending on taste. TheNkit also includes seven pages of documentation and an example label text ft TK-LABELS.BCKY1A #[USER.HARVEY.LABELS]AAAREADME.TXT;5Ogile.ONote: this version of TK-LABELS has the same functionality as the release datedNAugust, 1991. The COBOL version in the September, 1991 release is unchanged. EThis version adds the MACRO-32 version and updates the documentation.