// F E D I T   (PREPRESS)
// catalog number ???
//
// FEDIT -- font editor for low resolution fonts.
//

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

// outgoing procedures
external
	[
	FEdit

	ReadCharBit
	WriteCharBit
	PaintWidthMarker
	]

// outgoing statics
external
	[
	ViewForeground
	ViewBackground
	DisAdr
	WidthMarker
	bits
	UnsampledWX
	UnsampledWY
	EFactorX
	EFactorY
	SampleXof
	SampleYof
	BackgroundArea
	]
static
	[
	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
	SampleXof	//This!sample# = x offset of background
	SampleYof	// similar
	BackgroundArea	//Area of background char in its units.
	]

// incoming procedures
external
	[
//FEDITFILE
	EFileStart
	EFileFinish
	EditFindChar
	EditReadChar
	EditWriteChar
	EditUnWriteChar
//FEDITUTIL
	PaintRectangle
	ConvertString
	GetButtonPress
	GetCharCoord
	FetchSample
	MakeSamples
	PaintString

	WindowRead
	WindowReadBlock

	FSGetX
	FSPut

	FLDI
	FDV
	Zero; SetBlock; MoveBlock
	DpRound
	ReadNumber
	TypeForm
	Scream
	]

// incoming statics
external
	[
	rotation
	params
	resolutionx
	]

// internal statics
static
	[
	WordString
	CurBackOfx	//Current background offset in x.
	CurBackOfy	//	ditto for y
	Changes		//True if current character is changed.
	]

// File-wide structure and manifest declarations.

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

// Procedures

let

FEdit(NoBackground) be [

	bits=( table [ 0;
		#100000; #40000; #20000; #10000;
		#4000; #2000; #1000; #400; #200; #100;
		#40; #20; #10; #4; #2; #1; 0 ] )+1
//Set cursor
//	MoveBlock( #431, table [
//		#100000; #140000; #160000; #170000;
//		#174000; #176000; #177000; #170000;
//		#154000; #114000; #006000; #006000;
//		#003000; #003000; #001400; #001400 ] , 16)
//Initialize files.
	let factor=EFileStart(NoBackground)
//Initialize view parameters.
	EFactorX=factor
	EFactorY=factor
	let u=StdUnit
	if (params&gotresolution) ne 0 then u=resolutionx
	let proto=table [ #125252; -1 ]

for i=0 to 1 do [

//ForeGround (i=0); Background (i=1)
	let xn=BoxXSiz/u
	let yn=BoxYSiz/u
	let vsiz=((xn*yn) rshift 4)+(size VIEW/16 +2)
	let v=FSGetX(vsiz)
	Zero(v,vsiz)
	v>>VIEW.Pattern=proto!0
	v>>VIEW.PatXor=proto!1
	v>>VIEW.Xnum=xn
	v>>VIEW.Ynum=yn
	v>>VIEW.Xunit=u
	v>>VIEW.Yunit=u
	test i eq 0 then
		[
		ViewForeground=v
		test factor eq 0
		ifso factor=10000
		ifnot [
		if (u rem factor) ne 0 then
		Scream("Background enlargement does not divide cell size.")

		u=u/factor
		     ]
		proto=table [ #052525; #052525 ]
		] or
		[
		ViewBackground=v
		break
		]
	]

//Misc.
	WidthMarker= table [ 0; 2;2;2;2;0;0 ]
	let q=vec 100
	q!0=0
	WordString=q
	let q1=vec 49
	SampleXof=q1
	let q2=vec 49
	SampleYof=q2

//Set up display things.
	DisAdr=(FSGetX((DisYTop-DisYBot+1)*DisWid+1)+1)&(-2)
	Zero(DisAdr,(DisYTop-DisYBot+1)*DisWid)
	let db=(FSGetX(5)+1)&(-2)
		db!0=@#420
		db!1=DisWid
		db!2=DisAdr
		db!3=(DisYTop-DisYBot+1)/2
	@#420=db		//Link it in.

//Set up edit area
	PaintRectangle(BoxX-FrameW,BoxY-FrameW,FrameW,BoxYSiz+FrameW*2,OpOn,-1)
	PaintRectangle(BoxX+BoxXSiz,BoxY-FrameW,FrameW,BoxYSiz+FrameW*2,OpOn,-1)
	PaintRectangle(BoxX,BoxY-FrameW,BoxXSiz,FrameW,OpOn,-1)
	PaintRectangle(BoxX,BoxY+BoxYSiz,BoxXSiz,FrameW,OpOn,-1)

//Set up menu buttons.
//Menu items for manipulating characters
	SetButton(MenuChar,"New Character")
	SetButton(MenuCancel,"Cancel modifications")
	SetButton(MenuDelete,"Delete this char")
	SetButton(MenuBShift,"Shift Background")
	SetButton(MenuSample,"Sample")
	SetButton(MenuArea,"Area")
	SetButton(MenuGrid,"Grid")
	SetButton(MenuQuit,"Quit")
//Menu items for showing samples of characters
	SetButton(MenuStrikeUC,"Show ABCD...")
	SetButton(MenuStrikeLC,"Show abcd...")
	SetButton(MenuStrikeSyms,"Show !@#$")
	SetButton(MenuNewWords,"Show new words")
	SetButton(MenuWords,"Show words")

	EditLoop()
]

and

//Main loop of editor

EditLoop() be [

	Changes=false		//Char has been edited.
	let CharCode=-1		//Current char code
	let WaitUp=true		//True if must wait for button to come up
	let GridOn=false

//Now for the edit loop.
[ml
//	TypeForm("!")	//@
	let x,y=nil,nil
	let button=GetButtonPress(lv x,lv y,WaitUp)
	WaitUp=false		//Normally, can "draw"
	
	let xc,yc=nil,nil
	let a=GetCharCoord(x,y,lv xc,lv yc)

switchon a into [
case 0:	[
	let val=(button eq 1)
	if button eq 2 then
		[
		val=not ReadCharBit(ViewForeground,xc,yc)
		WaitUp=true	//Else will just flash...
		]
	WriteCharBit(ViewForeground,xc,yc,val)
	Changes=true
	]
	endcase
case 1: case 2:
	PaintWidthMarker(a,yc)
	Changes=true
	endcase
case 3: case 4:
	PaintWidthMarker(a,xc)
	Changes=true
	endcase
case -1:	//Check for menu area.
	[
	let w=vec CharWidthsize
	let str=vec 10
	if x ge MenuX then
	[geMenuX

//Selecting a sampled character prototype.
	if y le SamYTop & y ge SamYBot then
	[
		let ofx,ofy=nil,nil
		FetchSample(x,y,lv ofx,lv ofy)
		GetBackground(CharCode,-ofx,-ofy)

//Set widths appropriately.
		let ux=ViewForeground>>VIEW.Xunit
		let uy=ViewForeground>>VIEW.Yunit
		let nx=WidthMarker!3+(UnsampledWX+ux/2)/ux
		let ny=WidthMarker!1+(UnsampledWY+uy/2)/uy
		PaintWidthMarker(4,nx)
		PaintWidthMarker(2,ny)

		Changes=true
	]

//Selecting a menu item
	if y le (MenuY+MenuH*MenuMax) & y ge MenuY then
	[
		let mi=(y-MenuY)/MenuH
		let yr=y-MenuY-mi*MenuH
		if yr le 10 then
		[bu			//Button hit
		WaitUp=true		//Must wait for release
		PaintRectangle(MenuX-10,mi*MenuH+MenuY-2,
		    MenuW+10,MenuH,OpToggle,-1)
	switchon mi into	[sw
//Cancel, quit, new character all have similar code.
	case MenuCancel:
			[
			EditUnWriteChar(CharCode)
			Changes=false
			]			//Fall into Char:
	case MenuDelete:
	case MenuQuit:
	case MenuChar:
			[
			if (mi eq MenuDelete % Changes ne 0)
				& CharCode ne -1 then
				EditWriteChar(CharCode, mi eq MenuDelete)
			Changes=false
			if mi eq MenuDelete then
				[
				CharCode=-1
				endcase
				]
			if mi eq MenuQuit then break

			if mi eq MenuChar then
			   [
			   TypeForm("Next character (or octal code): ",1,str)
			   let sl=str>>STR.len
			   test sl eq 1
			     then CharCode=str>>STR.char^1
			     or	[
				sl=sl+1
				str>>STR.char^sl=$Q
				str>>STR.len=sl
				CharCode=ReadNumber(str)	//Make octal
				]
			   ]

			WriteCharBit(ViewForeground)	//Clear it.
			let a=EditFindChar(CharCode,w,1)	//Scratch
			if a eq 0 then a=EditFindChar(CharCode,w,2)
			if a then EditReadChar(ViewForeground,a,w)
			if GridOn then ShowGrid(true)
			GetBackground(CharCode,0,0)	//Background
			]
			endcase
//New words, words, strikes all display strings of current characters.
	case MenuNewWords:
			TypeForm("New words: ",1,WordString)
	case MenuWords:
			[
			PutStrings(CharCode,WordString)
			]
			endcase
	case MenuStrikeUC: case MenuStrikeLC: case MenuStrikeSyms:
			[
			let a=selecton mi into [
			case MenuStrikeUC: "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
			case MenuStrikeLC: "abcdefghijklmnopqrstuvwxyz"
			case MenuStrikeSyms: "1234567890!@#$%~&**()-=+|\{}[]^_:;*"'<>,./?"
			]
			PutStrings(CharCode,a)
			]
			endcase
//Area -- compute area of character currently on screen.
	case MenuArea:
			[		//Compute area of char on screen
			let ar=0
			for x=0 to ViewForeground>>VIEW.Xnum-1 do
			for y=0 to ViewForeground>>VIEW.Ynum-1 do
			if ReadCharBit(ViewForeground,x,y) then ar=ar+1
			TypeForm("Area: ",10,ar,".  Background area: ")
			FLDI(1,BackgroundArea)
			FLDI(2,EFactorX); FLDI(3,EFactorY)
			FDV(1,2); FDV(1,3)
			TypeForm(2,1,0)
			]
			endcase
//Grid -- toggle the grid status
	case MenuGrid:
			[
			GridOn=not GridOn
			ShowGrid(GridOn)
			]
			endcase
//Shift background -- read it in again at a new spot.
	case MenuBShift:
			[
			let x1,y1=nil,nil
			GetButtonPress(lv x1,lv y1,true)
			let x2,y2=nil,nil
			GetButtonPress(lv x2,lv y2,true)
			let xu=ViewBackground>>VIEW.Xunit
			let yu=ViewBackground>>VIEW.Yunit
			GetBackground(CharCode,(x2-x1)/xu+CurBackOfx,
				(y2-y1)/yu+CurBackOfy)
			]
			endcase
//Sample -- just call the sample subroutine.
	case MenuSample:
			MakeSamples()
			endcase
			]sw
		PaintRectangle(MenuX-10,mi*MenuH+MenuY-2,
		   MenuW+10,MenuH,OpToggle,-1)
		]bu
	]
	]geMenuX
	]
	endcase
default:	endcase
  	  ]


]ml  repeat

	EFileFinish()			//Go finish off files.
]


and

//Utilities....

SetButton(code,str) be [
	let p=vec 2
	ConvertString(MenuX,MenuY+code*MenuH,str,p)
]

and

//Show grid?

ShowGrid(GridOn) be [
	for x=0 to ViewForeground>>VIEW.Xnum-1 do
	for y=0 to ViewForeground>>VIEW.Ynum-1 do
	   PaintRectangle(x*ViewForeground>>VIEW.Xunit+BoxX,
	  y*ViewForeground>>VIEW.Yunit+BoxY,1,1,
	  (GridOn? OpOn,OpOff),-1)
]

and

//Put up visible strings of the characters you are working on.

PutStrings(CharCode,str) be [
	if Changes ne 0 & CharCode ne -1 then
		EditWriteChar(CharCode)
	Changes=false

	PaintRectangle(WordX,WordY,WordWid,WordHig,
		OpOff,-1)	//Clear area
	let p=vec 2
	let s=#400+CharCode
	p!0=WordX; p!1=String2Y
	for i=1 to 5 do PaintString(p!0,p!1,lv s,p)
	PaintString(WordX,String1Y,str)
]

and

GetBackground(char,xof,yof) be [
	CurBackOfx=xof			//Save for motions.
	CurBackOfy=yof
	let w=vec CharWidthsize
	WriteCharBit(ViewBackground)	//Clear it.
	let a=EditFindChar(char,w,3)	//Background
	if a then EditReadChar(ViewBackground,a,w,xof,yof)
]

and

//Write a "bit" of a character, according to the view given.

WriteCharBit(view,x,y,val; numargs n) be [

	let xn=view>>VIEW.Xnum
	let yn=view>>VIEW.Ynum
	if n eq 1 then
		[
		PaintRectangle(BoxX,BoxY,BoxXSiz,BoxYSiz,OpOff,
			view>>VIEW.Pattern,view>>VIEW.PatXor)
		Zero(lv view>>VIEW.BM,((xn*yn+15) rshift 4))
		return
		]
	if x ls 0 % x ge xn %
	   y ls 0 % y ge yn then return

	BitMap(lv view>>VIEW.BM,x*yn+y,val)
	let xs=x*view>>VIEW.Xunit+BoxX
	let ys=y*view>>VIEW.Yunit+BoxY
	PaintRectangle(xs,ys,view>>VIEW.Xunit,view>>VIEW.Yunit,
	     (val? OpOn,OpOff),view>>VIEW.Pattern,view>>VIEW.PatXor)
]

and

//Read a "bit" of a character, according to the view given.

ReadCharBit(view,x,y) = valof [
	let xn=view>>VIEW.Xnum
	let yn=view>>VIEW.Ynum
	if x ls 0 % x ge xn %
	   y ls 0 % y ge yn then resultis 0
	resultis BitMap(lv view>>VIEW.BM,x*yn+y)
]

and

// Set width markers in the margins of the edit area.  First argument is
// border number to deal with (for description of border numbers, see
// GetCharCoord comments).  Second argument is value of marker.
// For borders 5 & 6, these are the markers that mark the point of the
//	unsampled widths; in this case, value is in Alto units.

PaintWidthMarker(border,val; numargs n) be [
	if border eq 0 then return
	let op=nil
	let p=WidthMarker+border
	test n eq 2 then
		[
		PaintWidthMarker(border)	//erase old one.
		let otherborder=(border eq 1)? 5,(border eq 3)? 6,0
		PaintWidthMarker(otherborder)	//erase it.
		op=OpOn			//Write
		@p=val			//Save new value
		PaintWidthMarker(otherborder,WidthMarker!otherborder)
		] or [
		op=OpOff
		val=@p			//Turn off old value.
		]
	let Altoval=selecton border into [
	case 1: case 2:
		val*ViewForeground>>VIEW.Yunit
	case 3: case 4:
		val*ViewForeground>>VIEW.Xunit
	case 5:	val+(WidthMarker!1*ViewForeground>>VIEW.Yunit)
	case 6:	val+(WidthMarker!3*ViewForeground>>VIEW.Xunit)
	]
	let w=(table [ 0;BorderW;BorderW;1;1 ])!border
	let h=BorderW+1-w			//Width,height of marker
	if border ge 5 then
		[
		if ViewBackground eq 0 then return
		h=2; w=2
		]
	let fixed=(table [ 0; BoxX-FrameW-BorderW;
			    BoxX+BoxXSiz+FrameW;
			    BoxY-FrameW-BorderW;
			    BoxY+BoxYSiz+FrameW;
			    BoxX+BoxXSiz+FrameW;
			    BoxY+BoxYSiz+FrameW ] )!border
	let x,y=nil,nil
	let onScreen = valof [
	if Altoval ls 0 then resultis false
	test (table [ 0;-1;-1;0;0;-1;0 ] )!border
	then	[
		if Altoval ge BoxYSiz then resultis false
		x=fixed; y=Altoval+BoxY
		]
	or	[
		if Altoval ge BoxXSiz then resultis false
		y=fixed; x=Altoval+BoxX
		]
	resultis true
	]
	test onScreen then PaintRectangle(x,y,w,h,op,-1)
	 or TypeForm("Warning: tick mark for displaying widths lies off screen!*n")
]

and

//Shift a character.  View tells which part of char; dir is
// -1 if button push is to determine direction.
// else
// dir=1 at left border, 2 at right, 3 top, 0 bot
// amt is amount to shift (>0 only, please!)
//
//ShiftChar(view,dir,amt) be [
//	if dir ls 0 then
//		[
//		let x,y=nil,nil
//		GetButtonPress(lv x,lv y,true)	//Get border.
//		let dx=x-BoxX
//		dir=0
//		if y gr BoxY+BoxYSiz-dx then dir=2
//		if y gr BoxY+dx then dir=dir+1
//		]
//	let xn=view>>VIEW.Xnum
//	let yn=view>>VIEW.Ynum
//	if dir eq 0 % dir eq 1 then
//		[
//		for x=0 to xn-1 do
//		for y=0 to yn-1 do
//		WriteCharBit(view,x,y,
//		ReadCharBit(view,
//			((dir eq 0)? x,x+amt),
//			((dir eq 0)? y+amt,y)  ))
//		]
//	if dir eq 3 % dir eq 2 then
//		[
//		for x=xn-1 to 0 by -1 do
//		for y=yn-1 to 0 by -1 do
//		WriteCharBit(view,x,y,
//		ReadCharBit(view,
//			((dir eq 3)? x,x-amt),
//			((dir eq 3)? y-amt,y)  ))
//		]
//]
//
//and

//Operate on a bit map with base address buf, 'adr' is the bit number.
// Val (optional) is the value to set the bit to (must be 0 or -1)

BitMap(buf,adr,val; numargs n) = valof [
	let w=adr rshift 4
	let b=bits!(adr &#17)
	test n eq 2 then 
		resultis ((buf!w)&b) ne 0
	or	buf!w=(buf!w & not b)%(val & b)
]