// R E A D C U (PREPRESS) // catalog number ??? // // get "ix.dfs" // outgoing procedures external [ ReadCU ] // outgoing statics //external // [ // ] //static // [ // ] // incoming procedures external [ //PREPRESS WriteIXTempFile NoFile Scream TypeChar //WINDOW PrePressWindowInit WindowRead WindowWrite WindowReadBlock WindowWriteBlock WindowCopy WindowGetPosition WindowSetPosition WindowEnd WindowClose GetPosRelative SetPosRelative //SCAN ReadCom TypeForm //UTIL FSGetX FSPut MulDiv //OS SetBlock; Zero ] // incoming statics //external // [ // ] // internal statics //static // [ // ] // File-wide structure and manifest declarations. structure STR[ length byte char↑1,255 byte ] // Procedures let ReadCU() be [ let CD=FSGetX(256*2) SetBlock(CD,-1,256*2) //-1 means no char defined let CWT=FSGetX(256*CharWidthsize) SetBlock(CWT, HNonExCode, 256*CharWidthsize) let str=vec 20 ReadCom(str) //Get file name let si=PrePressWindowInit(str,0) if si eq 0 then [ NoFile(str) return ] let scr=PrePressWindowInit(0) let height=WindowRead(si) let ww=WindowRead(si) let buf=FSGetX(height*ww) let baseline=0 let globalminx=ww*16+1 until WindowEnd(si) do [ let ch=WindowRead(si) //Character code let width=WindowRead(si) if ch ls 0 % ch gr 255 then Scream("Illegal CU file.") TypeChar(ch) for i=height-1 to 0 by -1 do WindowReadBlock(si,buf+i*ww,ww) //Now determine min,max black spots in both directions. let minx=width+1; let maxx=-1 let miny=height+1; let maxy=-1 for y=0 to height-1 do [ let black=false let adr=buf+y*ww for j=0 to ww-1 do if adr!j ne 0 then black=true if black then [ if y ls miny then miny=y if y gr maxy then maxy=y ] ] for x=0 to width-1 do [ let black=false let adr=buf+(x rshift 4) let mask=#100000 rshift (x) for j=1 to height do [ black=black%(mask&@adr) adr=adr+ww ] if black then [ if x ls minx then minx=x if x gr maxx then maxx=x ] ] let p=CWT+ch*CharWidthsize WindowGetPosition(scr, CD+ch*2) Zero(p, CharWidthsize) (lv p>>CharWidth.WX)!0=width let space=(maxx ls minx) unless space then [ p>>CharWidth.XL=minx //For now -- not right p>>CharWidth.YB=miny //Ditto p>>CharWidth.W=maxx-minx+1 p>>CharWidth.H=maxy-miny+1 ] if minx ls globalminx then globalminx=minx if ch eq $A then baseline=miny //CU convention -- kluge let oww=p>>CharWidth.W let oht=p>>CharWidth.H let a=nil a<<FHEAD.ns=oww a<<FHEAD.hw=(oht+15)/16 WindowWrite(scr,a) for i=minx to maxx do [ let imask=#100000 rshift (i) let adr=buf+(i rshift 4)+(miny*ww) let wout=0 let omask=#100000 for j=miny to maxy do [ if (@adr&imask) ne 0 then wout=wout%omask omask=omask rshift 1 if omask eq 0 then [ WindowWrite(scr,wout) wout=0 omask=#100000 ] adr=adr+ww ] unless omask eq #100000 then WindowWrite(scr, wout) ] TypeForm(0) ] WindowClose(si) //Now we must re-calculate some things. // Baseline will probably have been set up. let p=CWT for i=0 to 255 do [ p>>CharWidth.XL=p>>CharWidth.XL-globalminx p>>CharWidth.YB=p>>CharWidth.YB-baseline p=p+CharWidthsize ] //Now write the CDtemp file: let bc=256; let ec=-1 for i=0 to 255 do if CD!(i*2) ne -1 then [ if i ls bc then bc=i if i gr ec then ec=i ] let nc=ec-bc+1 if nc ls 0 then Scream("No characters recorded in CU file.") let fnx=vec IXLMax Zero(fnx, IXLMax) let fn=lv fnx>>IXN.Name for i=1 to str>>STR.length do [ let c=str>>STR.char↑i if c eq $. then break fn>>STR.length=i fn>>STR.char↑i=c ] let ix=vec IXLMax Zero(ix, IXLMax) ix>>IX.Type=IXTypeChars ix>>IX.bc=bc ix>>IX.ec=ec ix>>IX.siz=MulDiv(10,635,18) //"10 point" font let ofil=PrePressWindowInit(-1) WriteIXTempFile(ofil, fnx, ix) //Write it out once. WindowGetPosition(ofil, lv ix>>IX.sa) WindowWriteBlock(ofil, CWT, nc*CharWidthsize) let rel=vec 1 WindowGetPosition(ofil, rel) WindowWriteBlock(ofil, CD, nc*2) //Wrong now. for i=bc to ec do if CD!(i*2) ne -1 then [ let i2=i*2 WindowSetPosition(scr, CD+i2) GetPosRelative(ofil, rel, CD+i2) let a=WindowRead(scr) let nw=a<<FHEAD.ns*a<<FHEAD.hw WindowWrite(ofil, a) let dnum=vec 1 dnum!0=0; dnum!1=nw WindowCopy(scr, ofil, dnum) ] let tl=vec 1 WindowGetPosition(ofil, tl) GetPosRelative(ofil, lv ix>>IX.sa, lv ix>>IX.len) WindowSetPosition(ofil, table [ 0;0 ]) WriteIXTempFile(ofil, fnx, ix) WindowWriteBlock(ofil,CWT+bc*CharWidthsize,nc*CharWidthsize) WindowWriteBlock(ofil,CD+bc*2,nc*2) WindowClose(ofil, tl) WindowClose(scr) ]