// F E D I T F I L E (PREPRESS)
//
//Bcpl/f FEditFile.bcpl
//
// FEDIT -- font editor for low resolution fonts.
// Filing stuff.
//
//Last modified October 1, 1980 1:07 PM by Lyle Ramshaw, PARC
// Added missing increment to "backgroundArea" in EditReadChar.
//Modified September 17, 1980 12:00 PM by Kerry LaPrade, XEOS
// Added warning for "character too big" to EditReadChar().
//Modified January 16, 1980 3:50 PM by LaPrade
// Sped up EditWriteChar
//Modified December 19, 1979 5:35 PM by LaPrade
// Moved EFileFinish, EFileStart, and MergeEdits from here to FEdit.
// Moved FindBoundingBox here from FEditUtil.
// Moved Area from here to FEditLoop.
//Modified December 5, 1979 12:54 PM by LaPrade
//Modified September 12, 1978 6:21 PM by LaPrade
//
//Comments about the format of the ACedits file. First comes
// the usual preamble stuff to an ACtemp file (i.e. read and
// written with ReadIXTempFile,...). Then comes a collection
// of characters, followed by a -1 (end of the update file).
// Each character is the CharWidth structure (containing
// width goodies) followed by the bit map (in ACtemp format,
// i.e. FHEAD is first). The CharWidth structure may have
// H=HNonExCode, in which case we are to delete the character
// from the font.
get "AuxiliaryMenuDefs.d"
get "fedit.dfs"
// outgoing procedures
external
[
// Area
// EFileStart
// EFileFinish
EditCharExists
EditFindChar
EditWriteChar
EditUnWriteChar
EditReadChar
IndexACFile
// MergeEdits
]
// outgoing statics
external
[
@DPzero //Double-precision zero.
@EbackgroundFile
@EeditFile
@EscratchFile //EFILE structures for the files.
@LastCharCodeWritten //State of the scratch file.
@LastPos //File pos where char began.
@TrailerPos //Position of -1 trailer in file.
@PreviousWPos //File pos of current char previous to this edit
@PreviousBPos
]
static
[
@DPzero //Double-precision zero.
@EbackgroundFile
@EeditFile
@EscratchFile //EFILE structures for the files.
@LastCharCodeWritten //State of the scratch file.
@LastPos //File pos where char began.
@TrailerPos //Position of -1 trailer in file.
@PreviousWPos //File pos of current char previous to this edit
@PreviousBPos
]
// incoming procedures
external
[
//FEditUtil
PaintWidthMarker
SetUpBBT
ReadCharBit
TurnGridOff
WriteCharBit
//FLOAT
FLDI; FLDDP; FSTDP; DPAD
DPCop
FML;FTR
//PREPRESSUTIL
FSGetX
ReadIXTempFile
RoundDp
Scream
//WINDOW
WindowRead
WindowReadBlock
// WindowWrite
WindowWriteBlock
WindowGetPosition
WindowSetPosition
// WindowEnd
// WindowFlush
]
// incoming statics
external
[
//FEDITLOOP
@backgroundArea //Number of 1 bits in background
@backgroundOn
@backgroundView //View parameters for background char.
@bits //bits!0=#100000
@editBox
@editBoxXSize
@editBoxYSize
@EFactorX //Enlargement factor of background
@EFactorY
@foregroundView //View parameters for foreground stuff
@WidthChanged
@WidthMarker //Vector of width information (index by border #)
]
// internal statics
static
[
@UnsampledWX //Width of background character (in Alto units).
@UnsampledWY // "
]
// Procedures
//*********************************************************
let EditWriteChar(c, delflag, prevW; numargs na) be
//*********************************************************
[
//Write the current character on the working file. Arguments are
// c (character code). If this code is equal to the one that is at
// the end of the scratch file, then just re-write it. This is like
// a "checkpoint" facility, but is (currently) essential to the way
// the words of text are re-displayed -- they use the scratch file
// copies of edited (and the current) characters.
if na ls 3 then Scream("EditWriteChar called with too few args")
let s=EscratchFile>>EFILE.window
let bc=EscratchFile>>EFILE.bc
let wpointer=EscratchFile>>EFILE.wp+(c-bc)*2
let bpointer=EscratchFile>>EFILE.bp+(c-bc)*2
test c eq LastCharCodeWritten
ifso
[
WindowSetPosition(s, LastPos) //Back to start of char
]
ifnot
[
WindowSetPosition(s, TrailerPos)
DPCop(LastPos, TrailerPos) //Remember it.
LastCharCodeWritten=c //This is the end.
DPCop(PreviousWPos, wpointer) //Previous values for this char
DPCop(PreviousBPos, bpointer)
]
let xo, yo, xw, yw = nil, nil, nil, nil
FindBoundingBox(lv xo, lv yo, lv xw, lv yw)
//Now xw,yw have max width in bits. xo,yo have offset values.
let v=vec CharWidthsize
Zero(v, CharWidthsize)
test WidthChanged
ifso
[ DPLDI(lv v>>CharWidth.WX, WidthMarker!4-WidthMarker!3)
DPLDI(lv v>>CharWidth.WY, WidthMarker!2-WidthMarker!1)
]
ifnot
[ DPCop(lv v>>CharWidth.WX, lv prevW>>CharWidth.WX)
DPCop(lv v>>CharWidth.WY, lv prevW>>CharWidth.WY)
]
v>>CharWidth.XL=xo
v>>CharWidth.YB=yo
v>>CharWidth.W=xw
v>>CharWidth.H=yw
if delflag then [ Zero(v, CharWidthsize); v>>CharWidth.H=HNonExCode ]
// WindowWrite(s,c) //Write character code.
Puts(s,c) //Write character code.
WindowGetPosition(s, wpointer)
WindowWriteBlock(s, v, CharWidthsize) //and width info
WindowGetPosition(s, bpointer)
test delflag
// ifso WindowWrite(s, 0)
ifso Puts(s, 0)
ifnot
[
let a=nil
a<<FHEAD.hw=(yw+15)/16
a<<FHEAD.ns=xw
// WindowWrite(s, a) //Write header for bit map.
Puts(s, a) //Write header for bit map.
let squareSize = foregroundView>>VIEW.dotSize
PartialFillBox(editBox, flip, squareSize * (xo + WidthMarker!3), editBoxYSize - squareSize * (yo + yw + WidthMarker!1), squareSize * xw, squareSize * yw)
for x=0 to xw-1 do
[
PartialFillBox(editBox, flip, squareSize * (xo + x + WidthMarker!3), editBoxYSize - squareSize * (yo + yw + WidthMarker!1), squareSize, squareSize * yw)
let p=vec 100
Zero(p, 100)
for y=0 to yw-1 do
if ReadCharBit(foregroundView, x+xo+WidthMarker!3,
y+yo+WidthMarker!1) then
[
let yw=y rshift 4
p!yw=p!yw% (bits!(y))
]
WindowWriteBlock(s, p, (yw+15)/16)
]
]
WindowGetPosition(s, TrailerPos)
// WindowWrite(s, -1) //Termination.
Puts(s, -1) //Termination.
// WindowFlush(s) //Make sure on disk.
CleanupDiskStream(s) //Make sure on disk.
]
and
//Cancel the last character on the end of the scratch file.
//*********************************************************
EditUnWriteChar(c) be [
//*********************************************************
if c ne LastCharCodeWritten then return
LastCharCodeWritten=-1 //So cannot back up further.
let s=EscratchFile>>EFILE.window
let bc=EscratchFile>>EFILE.bc
let wpointer=EscratchFile>>EFILE.wp+(c-bc)*2
let bpointer=EscratchFile>>EFILE.bp+(c-bc)*2
DPCop(wpointer, PreviousWPos)
DPCop(bpointer, PreviousBPos)
DPCop(LastPos, TrailerPos) //place for trailer.
// WindowWrite(s, -1)
Puts(s, -1)
// WindowFlush(s)
CleanupDiskStream(s)
]
and
//Find out where a character is. c is character code; w is vector
// to be filled with CharWidth entry; a is:
// 1 to look in scratch file
// 2 to look in original edit file
// 3 to look in background file (ACtemp)
// Returns window to use, or 0 if no such character. Also fills
// up w. Leaves window positioned at bit map. (Ready to call EditReadChar)
//*********************************************************
EditFindChar(c, w, a) = valof [
//*********************************************************
let b=EditCharExists(c, a)
if b eq 0 then resultis 0
let n=c-b>>EFILE.bc
let p=n*2+b>>EFILE.wp //Posn of width entry.
let q=n*2+b>>EFILE.bp //Posn of bit map.
let s=b>>EFILE.window
WindowSetPosition(s, p) //Read CharWidth thing.
WindowReadBlock(s, w, CharWidthsize)
WindowSetPosition(s, q) //Ready to read bit map encoding.
resultis s
]
and
//Find out whether character c exists in file a (as for EditFindChar)
// Returns 0 if character does not exist
// Else returns proper EFILE structure
//*********************************************************
EditCharExists(c, a) = valof [
//*********************************************************
let b=selecton a into
[
case 1: EscratchFile
case 2: EeditFile
case 3: EbackgroundFile
]
if b eq 0 then resultis 0
if c ls b>>EFILE.bc % c gr b>>EFILE.ec then resultis 0
let n=c-b>>EFILE.bc
let q=n*2+b>>EFILE.bp //Posn of bit map.
if q!0 eq -1 then resultis 0 //No such char.
resultis b
]
and
//Read a character from a file. S is the window on the file; it is
// positioned at the bitmap; w is the CharWidth structure for the
// character. View is the view to use when writing; if the offset
// values are missing, they are computed, and furthermore stored
// as width values.
//*********************************************************
EditReadChar(view, s, w, offx, offy; numargs n) be [
//*********************************************************
WriteCharBit(view) //Clear the bit map.
if n eq 1 then return
let ox=WidthMarker!3
let oy=WidthMarker!1
if n eq 3 then //Compute best position.
[
let expnd(x, y, v) be [
x=x*v!4
y=y*v!5
if x ls v!0 then v!0=x
if x gr v!1 then v!1=x
if y ls v!2 then v!2=y
if y gr v!3 then v!3=y
]
//Following 6 must be in order (see expnd, above):
let xl=1000
let xr=-1000
let yb=1000
let yt=-1000
let sx=view>>VIEW.dotSize
let sy=view>>VIEW.dotSize
//Figure in the black spots on the character:
let v=lv xl
let axl=w>>CharWidth.XL
let ayb=w>>CharWidth.YB
expnd(axl, ayb, v)
expnd(w>>CharWidth.W+axl-1, w>>CharWidth.H+ayb-1, v)
//And both "width" points:
let wr=RoundDp(lv w>>CharWidth.WX)
let wt=RoundDp(lv w>>CharWidth.WY)
expnd(wr, wt, v)
expnd(0, 0, v)
//xl,xr and yb,yt now have max limits.
ox=(editBoxXSize-(xr-xl+1))/2-xl
oy=(editBoxYSize-(yt-yb+1))/2-yb
ox=ox/foregroundView>>VIEW.dotSize
oy=oy/foregroundView>>VIEW.dotSize
PaintWidthMarker(3, ox)
PaintWidthMarker(1, oy)
offx=0
offy=0
]
let wx=RoundDp(lv w>>CharWidth.WX)
let wy=RoundDp(lv w>>CharWidth.WY)
// TypeForm("Read: ",10,ox,32,10,oy,0) //@
test view eq foregroundView then
[
PaintWidthMarker(2, wy+oy) //Set widths from old vals.
PaintWidthMarker(4, wx+ox)
]
or
[
backgroundArea=0
ox=ox*EFactorX
oy=oy*EFactorY
FLDI(5, backgroundView>>VIEW.dotSize)
FLDDP(1, lv w>>CharWidth.WX)
FML(1,5); UnsampledWX=FTR(1)
PaintWidthMarker(6, UnsampledWX)
FLDI(5, backgroundView>>VIEW.dotSize)
FLDDP(1, lv w>>CharWidth.WY)
FML(1,5); UnsampledWY=FTR(1)
PaintWidthMarker(5, UnsampledWY)
]
if view eq backgroundView & not backgroundOn then return
let a=WindowRead(s)
let p=vec 100
let x, hw = w>>CharWidth.XL, a<<FHEAD.hw
let y = nil
let yBitSequenceCount, itFits = 0, true
for sc = 1 to a<<FHEAD.ns do
[
WindowReadBlock(s, p, hw)
y = w>>CharWidth.YB
for pc = 0 to hw - 1 do
[
let w = p!pc
switchon w into
[
case -1:
if view eq backgroundView then
backgroundArea=backgroundArea+16
yBitSequenceCount = yBitSequenceCount + 16
endcase
case 0:
if yBitSequenceCount ne 0 then
[
unless WriteCharBit(view, x+ox+offx, y+oy+offy, 1, yBitSequenceCount) do itFits = false
y = y + yBitSequenceCount
yBitSequenceCount = 0
]
y = y + 16
endcase
default:
for i = 0 to 15 do
[
test (w𘚠) eq 0
ifso
[
if yBitSequenceCount ne 0 then
[
unless WriteCharBit(view, x+ox+offx, y+oy+offy, 1, yBitSequenceCount) do itFits = false
y = y + yBitSequenceCount
yBitSequenceCount = 0
]
y = y + 1
]
ifnot
[
if view eq backgroundView then
backgroundArea=backgroundArea+1
yBitSequenceCount = yBitSequenceCount + 1
]
w=w lshift 1
]
endcase
]
]
if yBitSequenceCount ne 0 then
[
unless WriteCharBit(view, x+ox+offx, y+oy+offy, 1, yBitSequenceCount) do itFits = false
yBitSequenceCount = 0
]
x=x+1
]
unless itFits do Wl("*nWarning: Character too big at this dot size!")
]
and
//Index a AC-like file by building an EFILE structure for it. Argument
// is window and the code (as above). If code=1 (scratch file), builds
// dummy entries to start with.
//*********************************************************
IndexACFile(s, code)= valof [
//*********************************************************
WindowSetPosition(s, DPzero)
let bc,ec=0,255
let fn=vec IXLName
let ix=vec IXLMax
if code ne 1 then
[
ReadIXTempFile(s, fn, ix)
bc=ix>>IX.bc
ec=ix>>IX.ec
]
let nc=ec-bc+1
let wc=nc*4+(size EFILE/16)
let a=FSGetX(wc)
SetBlock(a, -1, wc) //All chars undefined.
a>>EFILE.window=s
a>>EFILE.bc=bc
a>>EFILE.ec=ec
let p=a+(size EFILE/16)
a>>EFILE.wp=p
let q=p+nc*2
a>>EFILE.bp=q
// if code ne 1 & (WindowEnd(s) eq 0) then
if code ne 1 & (Endofs(s) eq 0) then
[
let t=lv ix>>IX.sa
for i=0 to nc-1 do
[
DPCop(p+i*2,t)
DPAD(t, table [ 0;CharWidthsize ] )
]
WindowSetPosition(s, t)
WindowReadBlock(s, q, nc*2) //Read AC entries
for i=0 to nc-1 do if q!(i*2) ne -1 then
DPAD(q+i*2, t)
]
resultis a
]
//*********************************************************
and DPLDI(a,b) be
//*********************************************************
[
FLDI(1, b)
FSTDP(1, a)
]
//*********************************************************
and FindBoundingBox(lvXo, lvYo, lvXw, lvYw) be
//*********************************************************
[
//Speedy bounding box determination. Edit box is examined
// to determine extent of character bitmap therein. Box
// is examined in horizontal swaths, then vertical. A
// series of parallel swaths is read from the Edit box
// and ORed into a buffer using BitBlt.
TurnGridOff()
let squareSize = foregroundView>> VIEW.dotSize
let magicXValue = (editBoxXSize + 17b) & not 17b //Round up to nearest multiple of 16
let bitBltBufferLength = Max(magicXValue, editBoxYSize)
let bitBltBuffer =
Allocate(sysZone, bitBltBufferLength, false, true)
let bitBltTable =
Allocate(sysZone, 16, false, true)
Zero(bitBltTable, 16)
//Find left and right extent of character bitmap using
// horizontal swaths.
//SetUpBBT(B, sourceType, operation, dbca, dbmr, dlx, dty, dw, dh, sbca, sbmr, slx, sty, g0, g1; numargs na)
SetUpBBT(bitBltTable, sBitMapAndGrayBlock, opPaint, bitBltBuffer, magicXValue / 16, 0, 0, editBoxXSize, 16, bitBltBuffer, magicXValue / 16, 0, true, 052525b, 125252b)
Zero(bitBltBuffer, bitBltBufferLength)
for sty = 0 to editBoxYSize - 1 by 16 do
[
bitBltTable>> BBT.sty = sty
BoxBitBlt(bitBltTable, 0, editBox)
]
//Examine buffer the hard way. Count bits until encountering
// a nonzero bit.
//SetUpBBT(B, sourceType, operation, dbca, dbmr, dlx, dty, dw, dh, sbca, sbmr, slx, sty, g0, g1; numargs na)
SetUpBBT(bitBltTable, sBitMap, opPaint, bitBltBuffer, magicXValue / 16, 0, 0, editBoxXSize, 1, bitBltBuffer, magicXValue / 16, 0)
for sty = 1 to 15 do
[
bitBltTable>> BBT.sty = sty
BitBlt(bitBltTable)
]
let xLeft, xRight = foregroundView>> VIEW.nDotsX + 1, -1 //Start with absurd values.
for I = 0 to magicXValue / 16 - 1 do
if bitBltBuffer!I ne 0 then
[
for J = 1 to 16 do
if ((bitBltBuffer!I) rshift J) eq 0 then
[
xLeft = ((I + 1) * 16 - J) / squareSize
break
]
break
]
for I = magicXValue / 16 - 1 to 0 by -1 do
if bitBltBuffer!I ne 0 then
[
for J = 1 to 16 do
if ((bitBltBuffer!I) lshift J) eq 0 then
[
xRight = (I * 16 + J - 1) / squareSize
break
]
break
]
if xRight ls 0 then //Blank character.
[
Free(sysZone, bitBltBuffer)
Free(sysZone, bitBltTable)
@lvXo, @lvYo, @lvXw, @lvYw = 0, 0, 0, 0
return
]
//Find top and bottom of character bitmap using vertical swaths.
//SetUpBBT(B, sourceType, operation, dbca, dbmr, dlx, dty, dw, dh, sbca, sbmr, slx, sty, g0, g1; numargs na)
SetUpBBT(bitBltTable, sBitMapAndGrayBlock, opPaint, bitBltBuffer, 1, 0, 0, 16, editBoxYSize, true, true, true, 0, 052525b, 125252b)
Zero(bitBltBuffer, bitBltBufferLength)
for slx = ((xLeft * squareSize) & (not 1)) to xRight * squareSize by 16 do //Make sure to start on even so gray block is aligned.
[
bitBltTable>> BBT.slx = slx
BoxBitBlt(bitBltTable, 0, editBox)
]
//Examine buffer the easy (no bit shifting) way, but remember,
// y is upside down with respect to the way BitBlt works. Count
// words until encountering a non-zero word.
let yBottom, yTop = foregroundView>> VIEW.nDotsX + 1, -1 //Start with absurd values.
let stopI = editBoxYSize - 1
for I = 0 to stopI do
if bitBltBuffer!I ne 0 then
[
yTop = ((editBoxYSize - 1 - I) / squareSize)
stopI = I
break
]
for I = editBoxYSize - 1 to stopI by -1 do
if bitBltBuffer!I ne 0 then
[
yBottom = ((editBoxYSize - 1 - I) / squareSize)
break
]
Free(sysZone, bitBltBuffer)
Free(sysZone, bitBltTable)
@lvXw, @lvYw = xRight - xLeft + 1, yTop - yBottom + 1
@lvXo, @lvYo = xLeft - WidthMarker!3, yBottom - WidthMarker!1
]