// F E D I T U T I L  (PREPRESS)
// catalog number ???
//
//

get "ix.dfs"
get "fedit.dfs"

// outgoing procedures
external
	[
	GetButtonPress
	GetCharCoord
	PaintRectangle
	ConvertString

	PaintString
	MakeSamples
	FetchSample
	]

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

// incoming procedures
external
	[
	PaintWidthMarker
	WriteCharBit

//FEDITFILE
	EditFindChar

	WindowRead
	WindowReadBlock
	FLDI
	FAD
	FTR
	FDV
	TypeForm
	]

// incoming statics
external
	[
	ViewForeground
	ViewBackground
	DisAdr
	bits

	SampleXof
	SampleYof
	WidthMarker
	EFactorX
	EFactorY

	sysFont
	]

// internal statics
static
	[
	SampleM1		//Value of WidthMarker 1 when sampling done.
	SampleM3		//    		     3
	]

// File-wide structure and manifest declarations.

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

// Procedures

let

//Paint a rectangular area.  Op is OpOn,OpOff or OpToggle.  Pat is the
// bit pattern to use.

PaintRectangle(x,y,wid,height,op,pat,patxor; numargs n) = valof [
	if n eq 6 then patxor=0
	let yh=y+height-1
	if ((yh&1) ne 0) then pat=pat xor patxor
	let a=(DisYTop-yh)*DisWid+DisAdr	//First word of sl
	let xr=x+wid
	let lw=x rshift 4; let lb=x&#17
	let rw=xr rshift 4; let rb=xr&#17
	let lmsk=    (bits!(lb-1)-1)
	let rmsk=not (bits!(rb-1)-1)
	let lw1=lw+1; let rw1=rw-1

test op eq OpRead then		//Just check at first non-zero pattern
	[
	if pat eq 0 then
		[
		pat=pat xor patxor
		a=a+DisWid
		]
	let lmskp=lmsk&pat
	let rmskp=rmsk&pat
	let IsItOn= (a!lw & lmskp)
	test lw eq rw then
		IsItOn=IsItOn & rmskp
		or
		[
		for i=lw1 to rw1 do IsItOn=IsItOn % (a!i & pat)
		IsItOn=IsItOn % (a!rw & rmskp)
		]
	resultis (IsItOn ne 0)
	]
or
	[
	for i=1 to height do
		[
		test lw eq rw
		ifso
		[
		let w=lmsk&rmsk&pat
		a!lw=selecton op into
				[
		case OpToggle:	a!lw xor w
		case OpOn:	a!lw % w
		case OpOff:	a!lw &(not w)
				]
		]
		ifnot
		[
		let lmskp=lmsk&pat
		let rmskp=rmsk&pat
		switchon op into	[
		case OpToggle:	a!lw=a!lw xor lmskp
				for i=lw1 to rw1 do a!i=a!i xor pat
				a!rw=a!rw xor rmskp
				endcase
		case OpOn:	a!lw=a!lw % lmskp
				for i=lw1 to rw1 do a!i=a!i % pat
				a!rw=a!rw % rmskp
				endcase
		case OpOff:	a!lw=a!lw & not lmskp
				for i=lw1 to rw1 do a!i=a!i & not pat
				a!rw=a!rw & not rmskp
				endcase
				]
		]
		pat=pat xor patxor
		a=a+DisWid
		]
	]
]

and

//Use normal convert instruction to paint a line of text on the screen.
// x,y are coordinates; str is the string.  Returns right-most x value.

ConvertString(x,y,str) = valof [
	let convrt=table [		//convrt(ac0,ac2,ac3)
		#55001;//sta 3,1,2
		#50411;//sta 2,.+11
		#35003;//lda 3,3,2
		#131000;//mov 1,2
		#67000;//convrt
		#161001;//mov 3,0,skp  requires extension
		#161000;//mov 3,0       char width in ac3
		#30403;//lda 2,.+3
		#35001;//lda 3,1,2
		#1401;//jmp 1,3
		0;	//place to store ac 2
	]

	let fontbase=sysFont		//Font!
	let xoff,yoff=0,fontbase!-2
	let yadr=(DisYTop-y-yoff)*DisWid+DisAdr
	let tab=vec 2
	tab!0=DisWid

	for i=1 to str>>STR.len do
		[
		let dwa=yadr+((x+xoff) rshift 4)-DisWid
		tab!1=15-((x+xoff)&#17)
		x=x+convrt(dwa,tab,fontbase+str>>STR.char^i)
		]
	resultis x
]

and

//Paint a string on the display, using the edited character font
// as a source of characters: x,y are coordinates; str is string
// to paint; up (optional) is a 2-word vector that gets updated x,y.

PaintString(x,y,str,up; numargs n) be [
	for i=1 to str>>STR.len do
	[
	let c=str>>STR.char^i
	let w=vec CharWidthsize
	let s=EditFindChar(c,w,1)	//Look on scratch
	if s eq 0 then s=EditFindChar(c,w,2)
	if s then
		[
		let xl=x+w>>CharWidth.XL
		let yb=y+w>>CharWidth.YB
		let adr=(DisYTop-yb)*DisWid+DisAdr+(xl/16)
		xl=xl rem 16
		let b=WindowRead(s)	//FHEAD
		let p=vec 100
		let hw=b<<FHEAD.hw	//Words high.
		let ns=b<<FHEAD.ns	//Number of scan lines.
		for i=1 to ns do
		    [
		    let dp=adr
		    WindowReadBlock(s,p,hw)
		    for pc=0 to hw-1 do for j=0 to 15 do
			[
			if ((p!pc)&(bits!j)) ne 0 then
				@dp=@dp%(bits!xl)
			dp=dp-DisWid
			]
		    xl=xl+1
		    if xl eq 16 then
			[
			xl=0
			adr=adr+1
			]
		    ]
		x=x+@(lv w>>CharWidth.WX)
		y=y+@(lv w>>CharWidth.WY)
		]
	]
	if n eq 4 then
		[
		up!0=x; up!1=y
		]
]

and

//Get a mouse button depression.

GetButtonPress(lvx,lvy,WaitForButtonOff) = valof [
	if WaitForButtonOff then
		while ((@butloc)&butall) ne butall do [ let a=2 ]
	let b=nil
		[
		b=@butloc
		@lvx=curloc!0
		@lvy=DisYTop-curloc!1
		if (b&butall) ne butall then break
		] repeat
	if (b&but1) eq 0 then resultis 1
	if (b&but2) eq 0 then resultis 2
	if (b&but3) eq 0 then resultis 3
]

and

//Given an x,y coordinate, compute which area of the screen the thing
// lies in.  Returns:
//	0	Edit area, on a Foreground character spot
//	1	Left border area
//	2	Right border area
//	3	Bottom border
//	4	Top border
//
//	5	In edit areas, but not near enough to active point
//	-1	Out of the area entirely.

GetCharCoord(x,y,lvx,lvy) = valof [
	let GCC(oc,lvc,lvcode,scales,siz) = valof
	[
		//Coordinate c; scales!0=units; scales!1=max value.
		// Store in lvc the truncated unit.
		// Store in lvcode:
		//    0 if in edit area
		//    1 if in border at min end
		//    2 if in border at max end
		//   -1 otherwise
		// Return 0 if on active spot; 1 if between
		let unit=scales!0
		let c=oc+100*unit	//Avoid negative rounding problems
		let i=c/unit-100
		let frac=c rem unit
		let u4=unit rshift 4
		let res=0
		if frac le u4 then res=1
		if (unit-frac) le u4 then [ i=i+1; res=1 ]
		@lvc=i
		@lvcode=(oc ls -FrameW-BorderW)? -1,
			(i ls 0)? 1,
			(i ls scales!1)? 0,
			(oc ge siz & oc ls siz+FrameW+BorderW)? 2,-1
		resultis res
	]

	let codex,codey=nil,nil
	let ax=GCC(x-BoxX,lvx,lv codex,lv ViewForeground>>VIEW.Xunit,BoxXSiz)
	let ay=GCC(y-BoxY,lvy,lv codey,lv ViewForeground>>VIEW.Yunit,BoxYSiz)

	if codex eq 0 & codey eq 0 then
		[
		if ax eq 0 & ay eq 0 then resultis 0
		resultis 5
		]
	if (codex%codey) eq -1 then resultis -1
	if codex ne 0 then
		[
		if ay ne 0 then resultis codex
		resultis 5
		]
	if codey ne 0 then
		[
		if ax ne 0 then resultis codey+2
		resultis 5
		]
]

and

//Stuff for sampling....

//Accomplish the sample function! -- very simple for now

MakeSamples() = valof [
//Save current 0,0 point so it can be put back when user selects a char
// from the sampling set.
	SampleM1=WidthMarker!1
	SampleM3=WidthMarker!3
//Zero the sampling area
	PaintRectangle(SamXLeft,SamYBot,SamW*SamRowCount,SamYTop-SamYBot+1,OpOff,-1)
	let xs=EFactorX
	let ys=EFactorY
	let xs2=xs/2
	let ys2=ys/2
	let xn=ViewForeground>>VIEW.Xnum
	let yn=ViewForeground>>VIEW.Ynum
	let xnb=ViewBackground>>VIEW.Xnum
	let ynb=ViewBackground>>VIEW.Ynum
	let area=xs*ys
	let samno=0
	let bestsamno=0		//Best sample number
	let bestabserror=10000	//Best absolute value of error
	let besterror=nil		//Best signed error
	let chararea=nil

	for xoff=-xs2 to xs-xs2-1 do	//For all offsets
	for yoff=-ys2 to ys-ys2-1 do
	[
	let cumabserror=0		//Cumulative absolute value of error
	let cumerror=0		//Cumulative signed error
	chararea=0		//Total character area

	SampleXof!samno=xoff
	SampleYof!samno=yoff

//Decide for each foreground bit.
	for x=0 to xn-1 do
	for y=0 to yn-1 do
		[
//Count 1 bits at this spot
		let xxs=x*xs
		let yys=y*ys
		let cnt=0
		for xb=0 to xs-1 do
		for yb=0 to ys-1 do
		[
		let xxb=xoff+xb+xxs
		let yyb=yoff+yb+yys
//Following is equivalent to
//		if ReadCharBit(ViewBackground,xxb,yyb)
//			then cnt=cnt+1
		if ( valof [
			if xxb ls 0 % xxb ge xnb %
			   yyb ls 0 % yyb ge ynb then resultis 0
			let adr=xxb*ynb+yyb	//Bit address
			let w=adr rshift 4		//See BitMap
			let b=bits!(adr&#17)
			resultis (((lv ViewBackground>>VIEW.BM)!w)&b) ne 0
			] ) then cnt=cnt+1
//End of equivalent
		]

//Majority vote
		chararea=chararea+cnt
		let val=(cnt gr (4*area)/8)
		let error=(val? area,0)-cnt
		let abserror=(error ls 0)? -error,error
		cumerror=cumerror+error
		cumabserror=cumabserror+abserror

		if val then WriteSampledBit(samno,x,y,val)
		]
	if cumabserror ls bestabserror then
		[
		bestsamno=samno
		bestabserror=cumabserror
		besterror=cumerror
		]
	samno=samno+1
	]

//Highlight best sampling
	for i=0 to xn-1 do
		WriteSampledBit(bestsamno,i,-1,-1)

	FLDI(1,area)
	FLDI(2,besterror); FLDI(3,bestabserror); FLDI(4,chararea)
	FDV(2,1); FDV(3,1); FDV(4,1)
	TypeForm("Best error: ",2,2)
	TypeForm("; |error| ",2,3)
	TypeForm("; Total area ",2,4,0)
	resultis bestsamno

]

and

//Fetch a sample from the sample area into the working area.

FetchSample(x,y,lvofx,lvofy) be [
	let samrow=(SamYTop-y)/SamH
	let samcol=(x-SamXLeft)/SamW
	let samno=samrow*SamRowCount+samcol
//Return offsets
	@lvofx=SampleXof!samno
	@lvofy=SampleYof!samno
//Restore 0,0 point before reading in background
	PaintWidthMarker(1,SampleM1)
	PaintWidthMarker(3,SampleM3)
//Now read sampled char selected, transfer it to working area.
	for x=0 to ViewForeground>>VIEW.Xnum-1 do
	for y=0 to ViewForeground>>VIEW.Ynum-1 do
		WriteCharBit(ViewForeground,x,y,
			WriteSampledBit(samno,x,y))
]

and

//Paint a sampled bit into the "view" area for sampled chars.
// Samno indexes the sample number; x and y are the bit posn,
// val is the value.

WriteSampledBit(samno,x,y,val; numargs n) = valof [
	let samrow=samno/SamRowCount
	let samcol=samno rem SamRowCount
	let yb=SamYTop-SamH-SamH*samrow+y
	let xl=SamXLeft+samcol*SamW+x
	let a=(DisYTop-yb)*DisWid+DisAdr+(xl rshift 4)
	let b=bits!(xl&#17)
	if n eq 3 then resultis ((@a)&b) ne 0
	@a=(@a & not b)%(val & b)
]