// F E D I T F I L E  (PREPRESS)
// catalog number ???
//
// FEDIT -- font editor for low resolution fonts.
//		Filing stuff.
//
//Comments about the format of the CDedits file.  First comes the usual preamble
// stuff to a CDtemp 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 CDtemp 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 "ix.dfs"
get "fedit.dfs"

// outgoing procedures
external
	[
	EFileStart
	EFileFinish
	EditFindChar
	IndexCDFile
	MergeEdits
	EditWriteChar
	EditUnWriteChar
	EditReadChar
	]

// outgoing statics
//external
//	[
//	]
//static
//	[
//	]

// incoming procedures
external
	[
	ReadCharBit
	WriteCharBit
	PaintRectangle
	PaintWidthMarker

//UTIL
	FSGetX
	FSPut
	Zero; SetBlock; MoveBlock

//PREPRESS
	IllCommand
	PrePressWindowInit
	ReadIXTempFile
	WriteIXTempFile
	SetPosRelative
	GetPosRelative

//WINDOW
	WindowRead
	WindowReadBlock
	WindowWrite
	WindowWriteBlock
	WindowGetPosition
	WindowSetPosition
	WindowEnd
	WindowCopy
	WindowFlush
	WindowClose

	DeleteFile

//FLOAT
	FLDI; FLDDP; FSTDP; DPAD
	DPCop
	FML;FAD;FDV;FTR

//SCAN
	StrEq
	TypeForm
	CompareIX
	]

// incoming statics
external
	[
	ViewForeground	//View parameters for foreground stuff
	ViewBackground	//View parameters for background char.
	DisAdr		//Address of display buffer start
	WidthMarker	//Vector of width information (index by border #)
	bits		//bits!0=#100000
	UnsampledWX	//Width of background character (in Alto units).
	UnsampledWY	//   "
	EFactorX		//Enlargement factor of background
	EFactorY
	BackgroundArea	//Number of 1 bits in background

	bigfilename	//Edit file name string left by command scanner.
	]

// internal statics
static
	[
	EscratchFile	//EFILE structures for the files.
	EbackgroundFile
	EeditFile

	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

	DPzero		//Double-precision zero.
	]

// File-wide structure and manifest declarations.

structure STR:
 [
	length byte
	char^1,255 byte
 ]


// Procedures

let

//Start up all file aspects of the edit.
// NoBackground is true if we are not to use background.
// There are three files involved:
//	xxxx/B		Edit file.
//	CDedits		File of changes, deleted at end normally.
//	CDtemp		Background file.
// Returns reduction factor for background (0 if no background).

EFileStart(NoBackground) = valof [
	DPzero=table [ 0;0 ]

//Set up edit file.
	if bigfilename!0 eq 0 then IllCommand()
//CROCK CROCK having to do with window stuff -- need better opening control
//Open read-only to be sure it exists:
	let s=PrePressWindowInit(2, false)
	WindowClose(s)
//Now open read-write:
	s=PrePressWindowInit(2)
	let fn=vec IXLName
	let ix=vec IXLMax
	ReadIXTempFile(s, fn, ix)		//Get info.
	EeditFile=IndexCDFile(s, 3)

//Set up scratch file.
	let sc=nil
	[
		sc=PrePressWindowInit("CDedits", true)
		if WindowEnd(sc) then break	//No previous version!
		let str=vec 10
		TypeForm("Edits recorded during the last use of the EDIT command appear not to",0)
		TypeForm("have been merged into the edit file.  Do you wish to merge them?",1,str)
		if str>>STR.length gr 0 & (str>>STR.char^1 eq $n %
		  str>>STR.char^1 eq $N) then break
		WindowClose(sc)
		MergeEdits()			//Assumes editfile indexed.
		FSPut(EeditFile)		//No longer indexed
		EeditFile=IndexCDFile(s, 2)	// so redo it
		TypeForm("Merge finished.*N")
	] repeat
	EscratchFile=IndexCDFile(sc,1)		//Index it.
	LastPos=table [ 0;0 ]	
	TrailerPos=table [ 0;0 ]
	PreviousWPos=table [ 0;0 ]
	PreviousBPos=table [ 0;0 ]
	LastCharCodeWritten=-1
	WriteIXTempFile(sc, fn, ix)		//Write header.
	WindowGetPosition(sc, TrailerPos)
	WindowWrite(sc,-1)		//Write trailer.
	WindowFlush(sc)			// and make sure on disk.
	
//Set up CDtemp (background) file.
	EbackgroundFile=0
	let factor=0
	unless NoBackground then
		[
		let cd=PrePressWindowInit(-1)		//CDtemp.
		let fnb=vec IXLName
		let ixb=vec IXLMax
		ReadIXTempFile(cd, fnb, ixb)
		test ix>>IX.resolutionx eq ixb>>IX.resolutionx &
		       ix>>IX.resolutiony eq ixb>>IX.resolutiony &
		       StrEq(lv fn>>IXN.Name, lv fnb>>IXN.Name) then
			[
			factor=(ixb>>IX.siz+1)/ix>>IX.siz
			]
		or
			[
			TypeForm("Illegal background file*N")
			factor=1
			]
		EbackgroundFile=IndexCDFile(cd, 2)	//Index it.
		]
	resultis factor
]

and

EFileFinish() be [
	WindowClose(EscratchFile>>EFILE.window)
	MergeEdits()
	let s=EeditFile>>EFILE.window
	WindowSetPosition(s, DPzero)
	let fn=vec IXLName
	let ix=vec IXLMax
	ReadIXTempFile(s, fn, ix)
	DPAD(lv ix>>IX.sa, lv ix>>IX.len)
	WindowClose(s, lv ix>>IX.sa)
	]

and

//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.


EditWriteChar(c, delflag; numargs na) be [
	if na eq 1 then delflag=0
	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=1000		//Minimum values.
	let yo=1000
	let xmax=-1000		//Maximum values.
	let ymax=-1000
//Find out max dimensions of character
	for x=0 to ViewForeground>>VIEW.Xnum-1 do
	for y=0 to ViewForeground>>VIEW.Ynum-1 do
	 if ReadCharBit(ViewForeground, x, y) then
		[
		let x1,y1=x-WidthMarker!3,y-WidthMarker!1	//Relocate
		if x1 ls xo then xo=x1
		if x1 gr xmax then xmax=x1
		if y1 ls yo then yo=y1
		if y1 gr ymax then ymax=y1
		]
	let xw=xmax-xo+1
	let yw=ymax-yo+1
	if xo eq 1000 then [ xo=0; yo=0; xw=0; yw=0 ]	//For space!!

//Now xw,yw have max width in bits. xo,yo have offset values.
	let v=vec CharWidthsize
	Zero(v, CharWidthsize)
	DPLDI(lv v>>CharWidth.WX, WidthMarker!4-WidthMarker!3)
	DPLDI(lv v>>CharWidth.WY, WidthMarker!2-WidthMarker!1)
	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.
	WindowGetPosition(s, wpointer)
	WindowWriteBlock(s, v, CharWidthsize) //and width info
	WindowGetPosition(s, bpointer)
	test delflag then WindowWrite(s, 0) or
	[
	let a=nil
	a<<FHEAD.hw=(yw+15)/16
	a<<FHEAD.ns=xw
	WindowWrite(s, a)		//Write header for bit map.
	for x=0 to xw-1 do
		[
		let p=vec 100
		Zero(p, 100)
		for y=0 to yw-1 do
		if ReadCharBit(ViewForeground, 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.
	WindowFlush(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)
	WindowFlush(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 (CDtemp)
// 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.Xunit
		let sy=view>>VIEW.Yunit

//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=DpRound(lv w>>CharWidth.WX)
		let wt=DpRound(lv w>>CharWidth.WY)
		expnd(wr, wt, v)
		expnd(0, 0, v)
//xl,xr and yb,yt now have max limits.
		ox=(BoxXSiz-(xr-xl+1))/2-xl
		oy=(BoxYSiz-(yt-yb+1))/2-yb
		ox=ox/ViewForeground>>VIEW.Xunit
		oy=oy/ViewForeground>>VIEW.Yunit
		PaintWidthMarker(3, ox)
		PaintWidthMarker(1, oy)
		offx=0
		offy=0
		]

	let wx=DpRound(lv w>>CharWidth.WX)
	let wy=DpRound(lv w>>CharWidth.WY)
//	TypeForm("Read: ",10,ox,32,10,oy,0)	//@
	test view eq ViewForeground 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, ViewBackground>>VIEW.Xunit)
		FLDDP(1, lv w>>CharWidth.WX)
		FML(1,5); UnsampledWX=FTR(1)
		PaintWidthMarker(6, UnsampledWX)
		FLDI(5, ViewBackground>>VIEW.Yunit)
		FLDDP(1, lv w>>CharWidth.WY)
		FML(1,5); UnsampledWY=FTR(1)
		PaintWidthMarker(5, UnsampledWY)
		]


	let a=WindowRead(s)
	let p=vec 100

	let x=w>>CharWidth.XL
	for sc=1 to a<<FHEAD.ns do
		[
		let hw=a<<FHEAD.hw
		WindowReadBlock(s, p, hw)
		let y=w>>CharWidth.YB
		for pc=0 to hw-1 do
			[
			let w=p!pc
			for i=0 to 15 do
			[
			if (w&#100000) ne 0 then
			   [
			   if view eq ViewBackground then
				BackgroundArea=BackgroundArea+1
			   WriteCharBit(view, x+ox+offx, y+oy+offy, -1)
			   ]
			y=y+1
			w=w lshift 1
			]
			]
		x=x+1
		]
]

and

//Index a CD-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.

IndexCDFile(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
		[
		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 CD entries
		for i=0 to nc-1 do if q!(i*2) ne -1 then
			DPAD(q+i*2, t)
		]
	resultis a
]

and

//MergeEdits -- merge the edited characters recorded in the scratch (CDedits) file
// with the original version in the edit file.  Save the results on a
// new edit file; delete the CDedits file.
// Assumes edit file is open and indexed. Leaves edit file open,
// but index will have been destroyed.


MergeEdits() be [
	let exists=vec 256
	Zero(exists, 256)	//0 => not mentioned
	let scd=EeditFile>>EFILE.window
	WindowSetPosition(scd, DPzero)
	let fn=vec IXLName
	let ix=vec IXLMax
	ReadIXTempFile(scd, fn, ix)

	let scr=PrePressWindowInit("CDedits", false)
	if scr eq 0 then return
//Build an index for the CDedits file.
	let a=IndexCDFile(scr, 1)		//Just get dummy entries.
	let fne=vec IXLName
	let ixe=vec IXLMax
	ReadIXTempFile(scr, fne, ixe)		//Read header.
	unless StrEq(lv fn>>IXN.Name, lv fne>>IXN.Name) &
		CompareIX(ix, ixe) then
		[
		TypeForm("CDedits and ",bigfilename," do not match! Update aborted.*N")
		finish
		]

	let edited=false
		[
		let c=WindowRead(scr)		//Char code.
		if c eq -1 then break
		edited=true
		let n=c-a>>EFILE.bc
		WindowGetPosition(scr, n*2+a>>EFILE.wp) //Width pos.
		let w=vec CharWidthsize
		WindowReadBlock(scr, w, CharWidthsize)
		exists!c=(w>>CharWidth.H eq HNonExCode)? -1,1
		WindowGetPosition(scr, n*2+a>>EFILE.bp)
		let b=WindowRead(scr)
		let d=vec 1; d!0=0; d!1=b<<FHEAD.ns*b<<FHEAD.hw+1
		SetPosRelative(scr, d, n*2+a>>EFILE.bp)
		] repeat
	EscratchFile=a

if edited then [			//Some edited chars!
	let bc,ec=255,-1
	for c=0 to 255 do
		[
		if (exists!c eq 0 & EditCharExists(c, 2)) %
			exists!c eq 1 then
		   [
		   if c ls bc then bc=c
		   if c gr ec then ec=c
		   ]
		]
	ixe>>IX.bc=bc		//Update char ranges.
	ixe>>IX.ec=ec
	
//Now build new edit file.
	let nc=ec-bc+1
	let CD=FSGetX(nc*2)
	SetBlock(CD, -1, nc*2)
	let WD=FSGetX(nc*CharWidthsize)
	Zero(WD, nc*CharWidthsize)
	let p=WD
	for i=1 to nc do [ p>>CharWidth.H=HNonExCode; p=p+CharWidthsize ]

	let sout=PrePressWindowInit(0)	//Scratch file!
	WriteIXTempFile(sout, fne, ixe)
	WindowGetPosition(sout, lv ixe>>IX.sa)
	WindowWriteBlock(sout, WD, nc*CharWidthsize)	//dummy
	let off=vec 1
	WindowGetPosition(sout, off)		//Offset
	WindowWriteBlock(sout, CD, nc*2)

	for c=bc to ec do
		[
		let w=vec CharWidthsize
		let a=EditFindChar(c, w, 1)		//Look on scratch file.
		if a eq 0 then
			a=EditFindChar(c, w, 2)	//Look on original CDtemp file.
		if a then
			[			//Write it out!
			MoveBlock(WD+(c-bc)*CharWidthsize,w,CharWidthsize)
			if w>>CharWidth.H ne HNonExCode then
			[
			GetPosRelative(sout, off, CD+(c-bc)*2)
			let b=WindowRead(a) //FHEAD
			WindowWrite(sout, b)
			let d=vec 1; d!0=0; d!1=b<<FHEAD.ns*b<<FHEAD.hw
			WindowCopy(a, sout, d)	//Copy encoding.
			]
			]
		]

	WindowClose(scr)		//CDedits.
	FSPut(EscratchFile)

	let tl=vec 1
	WindowGetPosition(sout, tl)		//Total length
	GetPosRelative(sout, lv ixe>>IX.sa, lv ixe>>IX.len) //get length
	WindowSetPosition(sout, DPzero)
	WriteIXTempFile(sout, fne, ixe)
	WindowWriteBlock(sout, WD, nc*CharWidthsize)
	WindowWriteBlock(sout, CD, nc*2)
	FSPut(CD); FSPut(WD)
	WindowSetPosition(sout, DPzero)
	WindowSetPosition(scd, DPzero)
//Critical section:::::
	WindowCopy(sout, scd, tl)		//Copy entire scratch
					// file to new edit file.
]					//Some edited chars.
	DeleteFile("CDedits")
//Done :::::

]

and

DpRound(a)= valof [
	let b=vec 1
	DPCop(b, a)
	DPAD(b, table [ 0;#100000 ])
	resultis b!0
]

and

DPLDI(a,b) be [
	FLDI(1, b)
	FSTDP(1, a)
]