// I M P O S E W I D T H S (PREPRESS) // catalog number ??? // // Read the WDtemp file for a list of widths, and "impose" them // on the SDtemp or ACtemp file, selon the argument to ImposeWidths // Used for making fonts that "match" photo typesetter fonts. get "ix.dfs" // outgoing procedures external [ ImposeWidths ] // outgoing statics //external // [ // ] //static // [ // ] // incoming procedures external [ //WINDOW WindowRead WindowReadBlock WindowWriteBlock WindowGetPosition WindowSetPosition WindowClose //PREPRESS ReadIXTempFile PrePressWindowInit //UTIL Scream IllCommand FSGetX FSPut //OS SetBlock //FLOAT FLDI; FDV; FML; FTR; FST; FSTDP; FLD ] // incoming statics //external // [ // ] // internal statics //static // [ // ] // File-wide structure and manifest declarations. // Procedures // fType=1 for ACtemp (characters already scan-converted) // fType=2 for SDtemp (splines) let ImposeWidths(fType,widthFile,outFile;numargs na) be [ if na eq 1 then [ widthFile=-3 //WDtemp outFile=-fType //SDTemp or ACTemp ] //Get widths file: let sw=PrePressWindowInit(widthFile) let fnw=vec IXLName let ixw=vec IXLMax ReadIXTempFile(sw, fnw, ixw) let ncw=ixw>>IX.ec-ixw>>IX.bc+1 let bbw=vec size WTB/16 WindowReadBlock(sw, bbw, size WTB/16) let xWidthVec=vec 256 let yWidthVec=vec 256 for i=0 to 1 do [ let p=(i eq 0)? xWidthVec,yWidthVec test ((i eq 0)? bbw>>WTB.XWidthFixed, bbw>>WTB.YWidthFixed) ifso SetBlock(p, WindowRead(sw), ncw) ifnot WindowReadBlock(sw, p, ncw) ] WindowClose(sw) //Get ACtemp or SDtemp let si=PrePressWindowInit(outFile) let fn=vec IXLName let ix=vec IXLMax ReadIXTempFile(si, fn, ix) unless na eq 1 do //find out the type fType=selecton ix>>IXH.Type into [ case IXTypeChars: case IXTypeOrbitChars: 1 case IXTypeSplines: 2 default: Scream("Illegal input type (must be chars or splines)") ] //Now compute scale factors: x in 3, y in 4 test fType eq 2 then //Imposing on spline widths [ FLDI(3, 1); FLDI(4, 1000); FDV(3, 4); FLD(4, 3) // 1/1000 if ixw>>IX.siz ne 0 then Scream("Cannot impose absolute widths on splines") ] or test fType eq 1 then [ // Here's how the calculations go. The ABSOLUTE width of a // character is (let w be the 16-bit number recorded for this // character in the widths file): // If the font size recorded in the widths file is non-zero: // (w/2540)*(resolution/10) // ...remember, w is in micas // ...the /10 is just because resolution figures in the // ...files are given times 10 // Else if font the size recorded in the widths file is zero: // (CharFontSize/2540)*(w/1000)*(resolution/10) FLDI(3,ix>>IX.resolutionx) FLDI(4,ix>>IX.resolutiony) FLDI(2,25400); FDV(3,2); FDV(4,2) test ixw>>IX.siz eq 0 then [ FLDI(2,ix>>IX.siz) FLDI(1,1000); FDV(2,1) FML(3,2); FML(4,2) ] or if ixw>>IX.siz ne ix>>IX.siz then Scream("Warning: WDtemp font size does not equal ACtemp size") ] or Scream("Destination file not splines or chars") let fp=vec 1 WindowGetPosition(si, fp) //Remember for re-writing let nc=ix>>IX.ec-ix>>IX.bc+1 let wSiz=((fType eq 1)? CharWidthsize, SplineWidthsize) let tl=nc*wSiz let WD=FSGetX(tl) WindowReadBlock(si, WD, tl) for c=ix>>IX.bc to ix>>IX.ec do [ let p=(c-ix>>IX.bc)*wSiz+WD let charAbsent=nil test fType eq 1 then charAbsent=(p>>CharWidth.H eq HNonExCode) or charAbsent=(p!0 eq 0)&(p!1 eq -1) unless charAbsent then [ let xWidth=#100000 let yWidth=#100000 let relC=c-ixw>>IX.bc if relC ge 0 & relC ls ncw then xWidth,yWidth=xWidthVec!relC, yWidthVec!relC if xWidth ne #100000 & yWidth ne #100000 then [ FLDI(1, xWidth); FML(1, 3) FLDI(2, yWidth); FML(2, 4) test fType eq 2 ifso [ FST(1, lv p>>SplineWidth.WX) FST(2, lv p>>SplineWidth.WY) ] ifnot [ FSTDP(1, lv p>>CharWidth.WX) FSTDP(2, lv p>>CharWidth.WY) ] ] ] ] //Now put the updated widths back out on the file. WindowSetPosition(si, fp) WindowWriteBlock(si, WD, tl) WindowClose(si) FSPut(WD) ]