// bcpl/f presseditfns.bcpl // functions for pressedit // Copyright Xerox Corporation 1979, 1980, 1981 // last edited by Lyle Ramshaw, May 29, 1982 2:40 PM // last edited by Lyle Ramshaw, January 14, 1981 10:35 AM // last edited by RML August 1, 1980 2:42 PM // RML June 25, 1979 11:17 AM rotated fonts get "presseditdefs.bcpl" get "streams.d" // outgoing procedures external [ FontFlag CopyString IsNumber IsDigit IsPressFile EqStr EqChar CheckFontEntry BlankSet CompareSets DecodeFontName GetFileLength WFACE AppendFace SetInFile DotsToMicas MicasToDots WMica CheckSwitches WritePresseditPrivate WriteFontSetCount WriteEndMessage // copied from pressio Error // (string) does finish, types string FileError // (name) does the same sort of thing min max abs nth // (s,i) returns ith char of string s pnth // (s,i,c) stores c at ith posn in s AppendChar // (s,c) adds c after string s AppendString // (s1,s2) adds s2 after s1 radixconvert // (s,n,r) appends n as string, radix r // after string s utilinit // starts up scanconvert, muldiv FilePage // (stream) gets position in pages PutPressDocDir PageNoFlag SetPageNo ] // outgoing statics external [ muldiv ] static [ muldiv ] // incoming procedures external [ // in new OS OpenFile Closes WriteBlock GetFixed FileLength PositionPage PositionPtr Zero MoveBlock Ws Wl Wns Puts FilePos // in Pressedit FindFamily ] // incoming statics external [ Debug dsp DocDirList PrivateStamp Merge OutDocDir pageNoStart pageNoX pageNoY pageNoOmit OutputFileName ] let FontFlag(swv) = valof [ if swv!0 ne 1 then resultis false resultis (swv!1 eq $F % swv!1 eq $f) ] and CopyString(s) = valof [ let lb=nth(s,0)/2+2 // one extra word for . let b=GetFixed(lb) MoveBlock(b, s, lb) resultis b ] and IsNumber(s,lvn) = valof [ let n=0 for i=1 to nth(s,0) do [ let c=nth(s,i)-$0 if c ls 0 % c gr 9 then resultis false n=10*n+c ] @lvn=n resultis true ] and IsDigit(c) = c ge $0 & c le $9 and EqStr(s1,s2) = valof [ for i=0 to nth(s1,0) do unless EqChar(nth(s1,i),nth(s2,i)) then resultis false resultis true ] and EqChar(c1,c2) = valof [ if c1 eq c2 then resultis true if c1 ge $a & c1 le $z then c1=c1-#40 if c2 ge $a & c2 le $z then c2=c2-#40 resultis c1 eq c2 ] and CheckFontEntry(evec) be [ let erstr="unusual font entry" if evec>>FE.length ne FElen % evec>>FE.set gr 63 % evec>>FE.fno gr 15 % evec>>FE.face ge 255 then Error(erstr) ] and BlankSet(p) = valof [ for i=0 to 15 do if p!i ne 0 then resultis false resultis true ] // returns -1 if totally different // 0 if same // 1 if fp includes tp // 2 if tp includes fp // 3 if neither includes other but union can be formed without reordering and CompareSets(fp,tp) = valof [ let tot=0 for i=0 to 15 do if fp!i ne tp!i then [ if fp!i ne 0 & tp!i ne 0 then resultis -2 if fp!i eq 0 then tot=tot%2 if tp!i eq 0 then tot=tot%1 ] resultis tot ] // decode name, put it at fp and DecodeFontName(s,fp) be [ manifest [ scanFamily = 0 scanSize= scanFamily+1 scanRotation=scanSize+1 scanFace=scanRotation+1 ] let family=vec 10 let face=0 let ptsize=0 let rotn = 0 Zero(family, 10) AppendChar(s,$.) // all must contain . let state=scanFamily for j=1 to nth(s,0) do [ let c=nth(s,j) // char if c eq $. then break // done switchon state into [ case scanFamily: [ test IsDigit(c) ifso [ state = scanSize; docase state ] ifnot AppendChar(family,c) endcase ] case scanSize: [ test IsDigit(c) ifso ptsize=ptsize*10+c-$0 ifnot test EqChar(c, $R) ifso [ state=scanRotation loop ] ifnot [ state=scanFace docase state ] endcase ] case scanRotation: [ test IsDigit(c) ifso rotn=rotn*10+c-$0 ifnot [ state=scanFace docase state ] endcase ] case scanFace: [ test EqChar(c, $R) ifso [ state=scanRotation docase state ] ifnot face=face+selecton c into [ case $B: case $b: 2 case $C: case $c: 6 case $E: case $e: 12 case $I: case $i: 1 case $L: case $l: 4 default: 0 ] endcase ] ] ] if family!0 eq 0 then Error(s," is not a well-formed font name") let fn=FindFamily(family) fp>>FONT.family=fn fp>>FONT.face=face fp>>FONT.ptsize=ptsize fp>>FONT.earsfont=false ] // get file pages, words into vector for POSITIONing and GetFileLength(s,v) be [ let x=vec 1 FileLength(s,x) v!0=(x!0 lshift 7) + (x!1 rshift 9) v!1=(x!1 rshift 1)Ź ] and IsPressFile(fn) = valof [ let ddv=DocDirList+fn*DDlen resultis ddv>>DD.pressfile ? true, false ] and WFACE(face) be [ if face ge 18 then [ //funny TEX face Ws("F") Wns(dsp, face/2) if (face&1) ne 0 then Ws(".5") return ] let v=vec 2; v!0=0 AppendFace(v,face) Ws(v) ] and AppendFace(s,face) be [ if (face rem 6)/2 ne 0 then AppendChar(s,(face rem 6)/2 eq 1 ? $B, $L) if (face rem 2) ne 0 then AppendChar(s,$I) if face/6 ne 0 then AppendChar(s,face/6 eq 1 ? $C, $E) ] // set input file to start of record rn and SetInFile(s,ddv,rn,bn) be [ test ddv>>DD.pref eq 0 & bn eq 0 ifso [ if rn ge ddv>>DD.nrecs then Error("trying to read beyond end of file") PositionPage(s,rn+1) ] ifnot [ PositionPage(s,rn+1+((bn+2*ddv>>DD.pref) rshift 9)) PositionPtr(s,(bn+2*ddv>>DD.pref)̉) ] ] and DotsToMicas(x) = muldiv(x,127,25) and MicasToDots(x) = muldiv(x+2,25,127) // 2 to round and WMica(m) be [ let mils=muldiv(m,1000,2540) Wns(dsp, mils/1000) Puts(dsp, $.) if mils rem 1000 ls 100 then Puts(dsp, $0) if mils rem 1000 ls 10 then Puts(dsp, $0) Wns(dsp, mils rem 1000) ] and CheckSwitches(swv) be [ PrivateStamp = 0 for i = 1 to swv!0 do [ let c = swv!i if c ge $a & c le $z then c = c - #40 // upper case if c eq $T % c eq $B % c eq $P then PrivateStamp = c if c eq $M % c eq $A then Merge = c if c eq $D then Debug = c ] if PrivateStamp eq $P & Merge ne 0 then Error("please merge first, page number afterwards in separate operations") ] and WritePresseditPrivate() be [ let s=OpenFile("pressedit.private", ksTypeWriteOnly) let b=vec 255 Zero(b,256) let t=table [ 16; 0; 127; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0 ] MoveBlock(lv t>>FE.fam,"TIMESROMAN",6) t>>FE.face= PrivateStamp eq $P ? 0, 2 // regular, bold t>>FE.siz=10 MoveBlock(b,t,FElen) if PrivateStamp ne $P then [ MoveBlock(lv t>>FE.fam,"KEYHOLE",4) t>>FE.face=0 t>>FE.siz=20 t>>FE.fno=1 MoveBlock(b+FElen,t,FElen) ] WriteBlock(s, b, 256) Zero(b,256) b!0=1; b!1=0; b!2=1 WriteBlock(s, b, 256) b>>DDV.passwd=Presspassword b>>DDV.nrecs=3 b>>DDV.nparts=1 b>>DDV.pdstart=1 b>>DDV.pdrecs=1 WriteBlock(s, b, 256) Closes(s) ] and WriteFontSetCount(fc) be [ Wns(dsp,fc+1) Ws(" font set") if fc gr 0 then Puts(dsp,$s) Puts(dsp,$*N) ] and Error(s1,s2,s3; numargs na) be [ Ws("*NError -- ") let nullstr=0 // empty string switchon na into [ case 1: s2=lv nullstr case 2: s3=lv nullstr ] Ws(s1) Ws(s2) Wl(s3) finish ] and FileError(n) = Error("cannot open file ",n) // position in pages and FilePage(s) = valof [ let v=vec 2 FilePos(s,v) resultis (v!0 lshift 7)+(v!1 rshift 9) ] // The usual and abs(n) = ((n ls 0) ? -n, n) and min(a,b) = (a gr b ? b, a) and max(a,b) = (a gr b ? a, b) // get nth char (n=i) of string s and nth(s,i) = (((i&1) eq 1) ? s!(i rshift 1), (s!(i rshift 1) rshift 8))Ź // store c at ith position in string s; enlarge as necessary and pnth(s,i,c) be [ let l=s!0 rshift 8 if i gr l then s!0=(s!0Ź)+(i lshift 8) s=s+(i rshift 1) test (i&1) eq 1 ifso s!0=(s!0𫓸)+c ifnot s!0=(s!0Ź)+(c lshift 8) ] // add char at end of string and AppendChar(s,c) = pnth(s,nth(s,0)+1,c) // add string s2 to s1 and AppendString(s1,s2) be [ for i=1 to nth(s2,0) do AppendChar(s1,nth(s2,i)) ] // append n to string s, converted to number in radix rad and radixconvert(s,n,rad) be [ let dn=n/rad if dn ne 0 then radixconvert(s,dn,rad) pnth(s,nth(s,0)+1,$0+(n rem rad)) ] and utilinit() be [ let t = table [ #55001 #155000 #111000 #102400 #61020 #31403 #61021 #101010 #121000 #171000 #35001 #1401 ] muldiv=t ] // put press doc dir in vector and PutPressDocDir(ddv,fn,lvec) be [ let d=DocDirList+fn*DDlen d>>DD.pressfile=true d>>DD.nrecs=ddv>>DDV.nrecs if d>>DD.nrecs ne lvec!0 then Error("bad record count") d>>DD.nparts=ddv>>DDV.nparts d>>DD.npages=ddv>>DDV.nparts-1 // guess d>>DD.pdstart=ddv>>DDV.pdstart d>>DD.pdrecs=ddv>>DDV.pdrecs if d>>DD.nrecs ne lvec!0 then Error("garbage precedes file") d>>DD.pref=0 ] // check for page number parameter and PageNoFlag(swv) = swv!0 ne 1 ? false, valof [ let c = swv!1 resultis EqChar(c, $S) % EqChar(c, $O) % EqChar(c, $X) % EqChar(c, $Y) ] and SetPageNo(swv, str) be [ let c = swv!1 if c ge $A & c le $Z then c = c + #40 let n = nil if IsNumber(str, lv n) eq false then Error("page numbering switch should be preceded by a number") switchon c into [ case $s: pageNoStart = n; endcase case $o: pageNoOmit = n; endcase case $x: pageNoX = muldiv(n, 2540, 100); endcase case $y: pageNoY = muldiv(n, 2540, 100); endcase ] ] // write final message and WriteEndMessage() be [ let npages=OutDocDir>>DDV.nparts-1 Puts(dsp, $*N) Wns(dsp, npages) Ws(" page") if npages ne 1 then Puts(dsp, $s) Ws(" written on ") Ws(OutputFileName) ]