COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	begin "twin"	comment read an address file and print pairs of labels
C00009 ENDMK
C⊗;
begin "twin"	comment read an address file and print pairs of labels;

COMMENT Useful Sail macros;
require "[]<>" delimiters;	define !=[Comment];
define TAB=[(""&'11)],LF=[(""&'12)],VT=[(""&'13)],FF=[(""&'14)],CR=[(""&'15)],
    ALT=[(""&'175)],DEL=[(""&'177)],↓=[(CR&LF)],THRU=[step 1 until],
    LN=[length], SAY=[outstr],ttyuuo=['51000000000],
    EXIT=[quick_code calli '12 end], ⊂=[begin], ⊃=[end],
    INLINE=[input(inch,inlf)],INFORM=[input(inch,inff)];

define symbrk=0;		! for generating symbols;
define BREAK_TABLE(table,term,omit,modes)=[
	redefine symbrk=symbrk+1,  zzz=[break]&cvs(symbrk);
	simple procedure zzz;  setbreak(table←getbreak,term,omit,modes);
	require zzz initialization;
	];
define break(id,term,omit,modes)= [
	integer id;
	break_table(id,term,omit,modes);
	];
define scnbrk(id,term,omit,modes)= [
	redefine qqq=[tableno]&cvs(symbrk);
	integer qqq;
	define id(s)=[scan(s,]&cvms(qqq)&[,brk)];
	break_table(qqq,term,omit,modes);
	];

define blanks=["                                                               "];

define proc=[simple internal procedure];

integer inch,ouch,brk,eof,inlf,inff;	! input/output globals;

external integer array gogtab[1:300];

! now, a bunch of standard procedures;
string proc myreal(real r);	begin		! use this in PRINT;
    integer hi,lo;
    getformat(hi,lo);
    return(if lo then cvf(r) else cvs(r+0.5))
    end;

proc PREP0;  begin 				! initialize things;
    setbreak(inlf←getbreak,LF,CR,"INS");
    setbreak(inff←getbreak,FF,NULL,"INS");
    require "sys:gogtab.def" source_file;
    gogtab[$$frel]←location(myreal);		! change print(real);
    end;

string proc ask(string s);  begin outstr(s);  return(inchwl)  end;

proc OOPS(string mess); begin say(↓&mess&↓); call(0,"RESET"); exit; end;

string proc look(string file);  begin
! does an open and lookup on a text file and delivers the first line,
ignoring the TV/E directory,if any;
    string lin; boolean fl;
    open(inch←getchan,"DSK",1,19,0,400,brk,eof);
    lookup(inch,file,fl);
    if fl then begin release(inch); return(del) end;
    lin←inline;
    if equ(lin[1 to 9],"COMMENT ⊗") then begin "flush directory"
	do inform until brk=ff;
	return(inline);
	end;
    return(lin)
    end "LOOK";

string proc lookout(string file);	begin	string ss;
	if ¬equ(ss←look(file),del) then return(ss) else oops(file&" not found"&↓);
	end;

boolean proc ENT(string file);  begin
! does an OPEN and ENTER on a text file and returns TRUE if OK & MODE=0;
    boolean fl;
    open(ouch←getchan,"DSK",1,0,19,0,0,0);
    enter(ouch,file,fl);
    if fl then release(ouch);
    return(¬fl)
    end "ENT";
boolean proc entout(string file);	if ent(file) then return(true)
	else oops(file&" cannot be written");

string simple procedure left(integer w;string s);
  return(if length(s)<w then s&blanks[1 to w-length(s)] else s[1 to w]);

REQUIRE PREP0 INITIALIZATION;


! the real body begins here;
scnbrk(todot,<".[">,null,"ins");
break(tolff,lf&ff,cr&tab,"is");
scnbrk(foo," 	",null,"xr");
	
string ifile,ofile,txt;
integer col;
string array chunk[1:6];
string proc leftmax(integer maxln; string chop);
    return(if ln(chop)≤maxln then chop else chop[1 to maxln]);

		! execution;
ofile←ifile←ask("source file=");
ofile←todot(ofile)&".lpt";
txt←lookout(ifile);		! read this file;
entout(ofile);			! and print this one;
				! beginning at top of second page;
do begin "loop"
    integer testy;	! 0 = undefined, 1 = filled, 2 = need next;
    string procedure ADDRESS;  begin	! get the next line;
	string ns;
	if eof then return(null);
	case testy of begin
	    begin "find next"
		do begin ns←txt←input(inch,tolff); foo(ns) end until ln(ns) ∨ eof;
		testy←2
		end "find next";
	    return(txt);
	    begin "neednext"
		foo(<ns←txt←input(inch,tolff)>);
		if ln(ns)=0 then testy←1;
		end
	    end;
	return(txt)
	end "ADDRESS";
    integer row,col;
    
    chunk[1]←left(34,scan(txt,tolff,brk));
    testy←2;
    for row←2 thru 6 do chunk[row]←left(34,address);
    testy←0;
    for row←1 thru 6 do cprint(ouch,chunk[row],"  ",leftmax(34,address),↓);
    testy←0; address;
    end "loop" until eof;
release(inch);
release(ouch);
loded("ftp {score/csd.yolton}<4scratch>labels.lpt←"&ofile&↓);
end