// 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(inputFile,outputFile;numargs na) be
[
let AC=FSGetX(256*2)
SetBlock(AC,-1,256*2) //-1 means no char defined
let CWT=FSGetX(256*CharWidthsize)
SetBlock(CWT, HNonExCode, 256*CharWidthsize)
let str=vec 20
if na eq 0 then
[ ReadCom(str) //Get file name
inputFile=str
outputFile="ACtemp"
]
let si=PrePressWindowInit(inputFile,0)
if si eq 0 then [ NoFile(str);return]
let scr=PrePressWindowInit(0) //Scratch file
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, AC+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) //<cr><lf>
]
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 output file:
let bc=256; let ec=-1
for i=0 to 255 do if AC!(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 inputFile>>STR.length do
[
let c=inputFile>>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(outputFile)
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, AC, nc*2) //Wrong now.
for i=bc to ec do if AC!(i*2) ne -1 then
[
let i2=i*2
WindowSetPosition(scr, AC+i2)
GetPosRelative(ofil, rel, AC+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,AC+bc*2,nc*2)
WindowClose(ofil, tl)
WindowClose(scr)
]