// 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&#17))
			]
		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&#100000) 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
   ]