// R E A D A L  (PREPRESS)
//
// ReadAl -- font editor for low resolution fonts.
//
//Bcpl/f ReadAl.bcpl
//
//Last modified February 7, 1980  11:41 AM by Kerry A. LaPrade, XEOS
//
// Reads a *.AL file, and produces a Chars file with the same bits.  Claimed
// to be a one-sided inverse to MakeAL, in the sense that ReadAL followed
// by MakeAL should be the identity.  Since *.AL format doesn't include
// as much information as *.AC, some guesses and approximations have to be
// made in the *.AC output.

get "ix.dfs"

// outgoing procedures
external
	[
	ReadAL
	GuessData
	]


// incoming procedures
external
	[
//PREPRESSWINDOW
	WindowRead
	WindowReadBlock
	WindowWrite
	WindowWriteBlock
	WindowGetPosition
	WindowSetPosition
	WindowCopy
	WindowClose

//PREPRESS
	PrePressWindowInit

//PRESSML
	MulDiv
//SCAN
	ReadCom
	TypeForm
	StrCop

//PREPRESSUTIL
	FSGetX
	FSPut
	TypeChar
	DPCop
	DblShift
	GetPosRelative
	WriteIXTempFile
	Scream
	NoFile

//MICROFLOAT
	DPSB
	DPSHR

//OS
	Noop
	DoubleAdd
	Zero
	SetBlock
	MoveBlock
	Usc
	Allocate
	FileLength
	]

// incoming statics
external
	[
	@prePressZone
	]

// internal statics
static
	[
	@SmallAL
	@ALf
	@ALBuf
	@ALBufpos
	@DPzero
	@DPone
	@DPtemp
	]

// File-wide structure and manifest declarations.

structure str: [
	len byte
	char↑1,255 byte
	]

structure ALH: [	//the two header words of an AL file
	Height word
	proportional bit
	baseline bit 7
	maxWidth bit 8
	]

structure XHdataH: [	//the two words of header for each char in an AL file
	XW word
	HD byte
	XH byte
	]

manifest [
	FHEADLen= 1
	ALHLen=size ALH/16 //which is 2
	XHdataHLen=size XHdataH/16 //another name for 2
	]

let ReadAL(inputName,outputName;numargs na) be
[ReadAL
	DPzero=table [ 0;0 ]
	DPone=table [ 0;1 ]
	DPtemp=table [ 0;0 ]

	let tempStr = vec 20
	if na eq 0 then
		[
		ReadCom(tempStr)
		inputName=tempStr
		outputName="ACtemp"
		]
	let scrf=PrePressWindowInit(0)
	ALWindowInit(inputName)

//read the AL file header
	ALWindowSetPosition(DPzero)
	let inhead= vec ALHLen
	ALWindowReadBlock(inhead,ALHLen) 
	let inh=inhead>>ALH.Height
	let inbase=inhead>>ALH.baseline
	let inxmax=inhead>>ALH.maxWidth
//set font bounding box params, except for FBBdx (can't tell that one yet)
	let FBBdy=inh
	let FBBoy=inbase-FBBdy
	let FBBox=0
//now, figure out what beginning and ending character in .AL are
	let ch=0
	while DummyChar(ch) do ch=ch+1
	let bc=ch
	ch=255
	while DummyChar(ch) do ch=ch-1
	let ec=ch
	if ec ls bc then Scream("empty Alto font")
	let nc=ec-bc+1

//OK, time to write the output file header
	let CharsIX = vec IXLChars
	let NameIX = vec IXLName
	Zero(CharsIX, IXLChars)
	Zero(NameIX, IXLName)
	CharsIX>>IX.Type=IXTypeChars
	CharsIX>>IX.Length=IXLChars
	CharsIX>>IX.bc=bc
	CharsIX>>IX.ec=ec
	CharsIX>>IX.resolutionx=720
	CharsIX>>IX.resolutiony=720
	CharsIX>>IX.fam=1
	NameIX>>IXN.Type=IXTypeName
	NameIX>>IXN.Length=IXLName
	NameIX>>IXN.Code=1
//now, guess the font data from the .AL file name
	let famguess=vec 20
	let faceguess= 0
	let sizeguess= 0
	GuessData(inputName, lv famguess, lv faceguess, lv sizeguess)
	StrCop(famguess, lv NameIX>>IXN.Name)
	CharsIX>>IX.face=faceguess
	CharsIX>>IX.siz=sizeguess

//now, all the IX data is set except for .sa and .len 
	WriteIXTempFile(scrf,NameIX,CharsIX)
//and that took care of .sa as well; must handle .len later on
//scratch stream is left at beginning of CharacterSegment

	let CharWidths=FSGetX(nc*CharWidthsize)
	let CharPtrs=FSGetX(nc*2)
//and we will write the rasters right into the file
	let WidthsPos=vec 1
	WindowGetPosition(scrf, WidthsPos)
	let PtrsPos=vec 1
	PtrsPos!0=0;  PtrsPos!1=nc*CharWidthsize
	DoubleAdd(PtrsPos, WidthsPos)
	let RastersPos=vec 1
	RastersPos!0=0;  RastersPos!1=nc*2
	DoubleAdd(RastersPos, PtrsPos)
	WindowSetPosition(scrf, RastersPos)

//one character at a time now, putting rasters into scrf 

for chrel=0 to nc-1 do
   [nextchar
   ch=chrel+bc
   test DummyChar(ch) 
    ifso
	[
	let thisWidth= CharWidths+chrel*CharWidthsize
	Zero(thisWidth,CharWidthsize)
	thisWidth>>CharWidth.H=HNonExCode
	let thisPtr= CharPtrs+chrel*2
	thisPtr!0=-1;  thisPtr!1=-1
	//and no rasters to output, so we're done
	]
    ifnot
	[
	TypeChar(ch)

//Our first task will be to get the character plus all of its extensions
//into an array in Alto display order.
	let xmaxW= (inxmax+16)/16
  //(Note that bits can overhang the nominal character width
  // by up to one full word, corresponding to XW=1.)
	let ALbits=FSGetX(inh*xmaxW)
	Zero(ALbits, inh*xmaxW)
	let BBdx, chwidth, BBox=0,0,0
	let chblanktop, chblankbot = 1000, 1000
 	let ptrpos, hdrpos, datapos=vec 1, vec 1, vec 1
	ptrpos!0=0;  ptrpos!1=ch+ALHLen
//now that we have pointer to first XHdata block, enter a loop

  for col=0 to xmaxW-1 do
	[ //nextext
	ALWindowSetPosition(ptrpos)
	hdrpos!0=0;  hdrpos!1=ALWindowRead()
	DoubleAdd(hdrpos, ptrpos)  //pointer is self-relative
	ALWindowSetPosition(hdrpos)
	let hdr=vec XHdataHLen
	ALWindowReadBlock(hdr, XHdataHLen)
	let numlines=hdr>>XHdataH.XH
	let blanklines=hdr>>XHdataH.HD
	let xw=hdr>>XHdataH.XW

	if blanklines ls chblanktop then chblanktop=blanklines
	if (inh-blanklines-numlines) ls chblankbot then
			chblankbot=(inh-blanklines-numlines)

	DPtemp!0=0;  DPtemp!1=numlines
	DPCop(datapos, hdrpos)
	DPSB(datapos, DPtemp)
	ALWindowSetPosition(datapos)
	for i=blanklines to blanklines+numlines-1 do
		[
		ALbits!(i*xmaxW + col)=ALWindowRead()
		]

	BBdx=BBdx+16
	test (xw&1) eq 0 
	  ifso [ ptrpos!1=(xw rshift 1)+ALHLen; chwidth=chwidth+16; loop ]
	  ifnot [ chwidth=chwidth+(xw rshift 1);  break ] 
	] //nextext	

//the ALbits array now holds the character in Alto format
//The values of BBdx and BBox are generous estimates, which we will
// update later.  But we can now determine the BBoy and BBdy values.

	let BBoy=FBBoy+chblankbot
	let BBdy=inh-chblanktop-chblankbot

//Take the ALbits array, and rotate it into the Charbits array

	let BBdyW=(BBdy+15)/16
	let Chardata=FSGetX(BBdx*BBdyW+FHEADLen)
	Zero(Chardata, BBdx*BBdyW+FHEADLen)
	let Charbits=Chardata+FHEADLen
	let BitsSeen=false
	let FirstNonEmptyScanLine=nil
	let LastNonEmptyScanLine= -1

	for i=0 to BBdx-1 do
		[ //nextscanline
		let empty = true
		for j=0 to BBdy-1 do
		  [ //nextdatabit
		  if GetBit(ALbits+(inbase-BBoy-j-1)*xmaxW+(i rshift 4), i&15)
			then [
				empty = false
				SetBit(Charbits+i*BBdyW+(j rshift 4), j&15)
			     ]
		  ] //nextdatabit
		unless BitsSeen % empty do
			[
			FirstNonEmptyScanLine=i
			BitsSeen=true
			]
		unless empty do LastNonEmptyScanLine=i
		] //nextscanline
	FSPut(ALbits)

//Now, we can compute the real BBdx and BBox

	test BitsSeen
	  ifso	[
		BBdx=LastNonEmptyScanLine-FirstNonEmptyScanLine+1
		BBox=FirstNonEmptyScanLine
		]
	  ifnot	[
		BBdx=0
		BBox=0
		BBdy=0;  BBdyW=0
		]

//If BBox is now non-zero, we must shift the bits backward to wipe out
//the early all-zero scan lines

	if BBox ne 0 then MoveBlock(Charbits, Charbits+BBox*BBdyW, BBdx*BBdyW)

//Lets fill in the width data

	Chardata>>FHEAD.hw=BBdyW
	Chardata>>FHEAD.ns=BBdx
	let thisWidth = CharWidths+chrel*CharWidthsize
	thisWidth!0=chwidth;  thisWidth!1=0  //set the x width fraction
	thisWidth!2=0;  thisWidth!3=0  //set the y width fraction
	thisWidth>>CharWidth.XL=BBox
	thisWidth>>CharWidth.YB=BBoy
	thisWidth>>CharWidth.W=BBdx
	thisWidth>>CharWidth.H=BBdy

//And the relative position of the rasters

	let thisPtr = CharPtrs+chrel*2
	WindowGetPosition(scrf, thisPtr)
	DPSB(thisPtr, PtrsPos) //pointer is relative to beginning of Ptrs

//and then store the resulting rasters	

	WindowWriteBlock(scrf, Chardata, BBdx*BBdyW+FHEADLen)
	FSPut(Chardata)
	TypeForm(0)
	]
  ]nextchar

//clean up at the end
	ALWindowClose()
	let tlen=vec 1
	WindowGetPosition(scrf, tlen)
	GetPosRelative(scrf, lv CharsIX>>IX.sa, lv CharsIX>>IX.len)
	WindowSetPosition(scrf, DPzero)
	WriteIXTempFile(scrf, NameIX, CharsIX)
	WindowWriteBlock(scrf, CharWidths, nc*CharWidthsize)
	FSPut(CharWidths)
	WindowWriteBlock(scrf, CharPtrs, nc*2)
	FSPut(CharPtrs)

//copy scratch file to real output file
	let ACf=PrePressWindowInit(outputName)
	WindowSetPosition(scrf,DPzero)
	WindowSetPosition(ACf,DPzero)
	WindowCopy(scrf,ACf,tlen)
	WindowClose(ACf,-1)
	WindowClose(scrf)

	TypeForm(4, tlen, " is length (words) of Chars output file.")
]ReadAL


and SetBit(lvword, bitnum) be
	[
	@lvword=(@lvword)%(1 lshift (15-bitnum))
	]

and GetBit(lvword, bitnum) = 
	((@lvword) rshift (15-bitnum))&1

and DummyChar(ch,ALf) = valof
	[
	let ptrpos, datapos=vec 1, vec 1
	ptrpos!0=0;  ptrpos!1=ch+ALHLen
	ALWindowSetPosition(ptrpos)
	datapos!0=0
	datapos!1=ALWindowRead()
	DoubleAdd(datapos, ptrpos)
	ALWindowSetPosition(datapos)
	let x=vec XHdataHLen
	ALWindowReadBlock(x, XHdataHLen)
	if x>>XHdataH.XW ne 1 then resultis(false)
	if x>>XHdataH.XH ne 0 then resultis(false)
	if x>>XHdataH.HD ne 0 then resultis(false)
	resultis(true) 
	]


and GuessData(inputName, lvfam, lvfac, lvsiz) be
	[
//set up defaults, in case the .AL name doesn't parse
	StrCop("UNKNOWN", @lvfam)
	@lvsiz=0
	@lvfac=0

	let ucinputName=vec 20
	StrCop(inputName, ucinputName)
	UpperCaseify(ucinputName)

//guess the family name
	let fam=vec 20
	fam>>str.len=0
	let i=-1
	for ip=1 to ucinputName>>str.len do
		[
		test ucLetter(ucinputName>>str.char↑ip) 
			ifso Putstr(ucinputName>>str.char↑ip, fam)
			ifnot [ i=ip; break ]
		]
	test fam>>str.len eq 0 ifso return ifnot StrCop(fam, @lvfam)
	if i eq -1 then return

//now, guess the point size
	let ptsiz=0
	for ip=i to ucinputName>>str.len do
		[
		test Digit(ucinputName>>str.char↑ip)
			ifso ptsiz=10*ptsiz+(ucinputName>>str.char↑ip - $0)
			ifnot [ i=ip; break ]
		]
	if (ptsiz le 0) % (ptsiz ge 301) then return
	@lvsiz=MulDiv(ptsiz, 2540, 72) //compute size in micas

//now, guess the face
	let fac=0
	if ucinputName>>str.char↑i eq $B then 
		[
		fac=fac+2
		i=i+1
		]
	if ucinputName>>str.char↑i eq $I then 
		[
		fac=fac+1
		i=i+1
		]
	@lvfac=fac

//hopefully, the remaining characters of the ucinputName are ".AL", but
//why bother checking?

	]  //of GuessData


and UpperCaseify(string) be
	for i=1 to string>>str.len do
		[
		let char=string>>str.char↑i
		if (char ge $a) & (char le $z) then
			string>>str.char↑i=char+$A-$a
		]



and ucLetter(char)=
	(char ge $A) & (char le $Z)

and Digit(char)=
	(char ge $0) & (char le $9)

and Putstr(char, string) be
	[
	let l=string>>str.len
	string>>str.len=l+1
	string>>str.char↑(l+1)=char
	]

//The ALWindow package that follows implements the following conventions.
//ALWindowInit checks the size of the AL file, and, if it is less than half
//of available storage, sets the SmallAL flag, and reads the entire file into
//core beginning at ALBuf.  Then, ALBufpos is used as a stream pointer to 
//that buffer region.  If the AL file is large, then all operations really
//go to the file (and ReadAL runs like molasses in January...) 

and ALWindowInit(name)  be
	[
	ALf=PrePressWindowInit(name)
	if ALf eq 0 then [ NoFile(name); Scream("  Giving up..."); abort ]
	let len=vec 1
	FileLength(ALf, len)
	WindowSetPosition(ALf, DPzero)
	DblShift(len,1)  //change units from bytes to words
	let freespace=nil
	Allocate(prePressZone, 77777b, lv freespace)
	test len!0 eq 0
	  ifnot	[ SmallAL=false ]
	  ifso	[
		let comp=Usc(len!1,freespace/2)
		test comp eq 1 
			ifso [ SmallAL=false ]
			ifnot [ SmallAL=true ]
		]
	test SmallAL
	 ifso	[
		ALBuf=FSGetX(len!1+1)
		WindowReadBlock(ALf, ALBuf, len!1+1)
		WindowClose(ALf)
		ALBufpos=ALBuf
		TypeForm("AL was small; freespace was: ", 10, freespace,0)
		TypeForm("and AL len was: ", 4, len, 0)
		]
	 ifnot	[
		TypeForm("AL was large; freespace was: ", 10, freespace,0)
		TypeForm("and AL len was: ", 4, len, 0)
		] 
	]

and ALWindowClose() be
  test SmallAL
   ifso
	[
	FSPut(ALBuf)
	]
   ifnot
	[
	WindowClose(ALf)
	]

and ALWindowGetPosition(pos)  be
  test SmallAL
    ifso
	[
	pos!0=0
	pos!1=ALBufpos
	]
    ifnot
	[
	WindowGetPosition(ALf, pos)
	]

and ALWindowSetPosition(pos)  be
  test SmallAL
    ifso
	[
	if pos!0 ne 0
		 then Scream("Attempt to set position beyond end of AL file")
	ALBufpos=ALBuf+pos!1
	]
    ifnot
	[
	WindowSetPosition(ALf, pos)
	]

and ALWindowRead() = valof
[ test SmallAL
    ifso
	[
	let temp=ALBufpos!0
	ALBufpos=ALBufpos+1
	resultis(temp)
	]
    ifnot
	[
	resultis(WindowRead(ALf))
	]
]

and ALWindowReadBlock(data, len)  be
  test SmallAL
    ifso
	[
	MoveBlock(data,ALBufpos,len)
	ALBufpos=ALBufpos+len
	]
    ifnot
	[
	WindowReadBlock(ALf, data, len)
	]

and ALWindowWrite(data)  be
  test SmallAL
    ifso
	[
	ALBufpos!0=data
	ALBufpos=ALBufpos+1
	]
    ifnot
	[
	WindowWrite(ALf, data)
	]


and ALWindowWriteBlock(data, len)  be
  test SmallAL
    ifso
	[
	MoveBlock(ALBufpos,data,len)
	ALBufpos=ALBufpos+len
	]
    ifnot
	[
	WindowWriteBlock(ALf, data, len)
	]