GET "FED.DEFS"

STATIC
[
GAP = 1	//GAP BETWEEN BOXES IN FEDIT
EXTENSIONCOUNT
FCWIDTH
FCHEIGHT
LOCKXPOINT
LOCKYPOINT
FARRAY
CLMARGIN = LWMARGIN*16	//MUST BE ON A WORD BOUNDARY TO OUTPUT CU FORMAT
CTOPMARGIN = 50
]








LET FEDIT() BE
[
	DCB!3= OLINES/2; DCB!0 = S420;
	BSTORE(DISPLAYAREA,0,NWRDS*LINES)
	FARRAY = DISPLAYAREA+OLINES*NWRDS  

//SET UP A SEPARATE DCB FOR FARRAY

	LET SDCB = VEC 6
	IF (SDCB & 1) NE 0 THEN SDCB = SDCB+1
	SDCB!0 = S420	//SYSTEM DISPLAY AREA
	SDCB!1 = 1400B + FWMAX //TAB 3
	SDCB!2 = FARRAY
	SDCB!3 = FHMAX/2

	DCB!3 = (OLINES-FHMAX)/2
	DCB!0 = SDCB		//HOOK UP BIG AREA,FARRAY,SYS ARRAY

//DRAW BOUNDARIES
	CLMARGIN = CLMARGIN - BOXSIZE	//TEMPORARILY OFFSET ORIGIN
	CTOPMARGIN = CTOPMARGIN - BOXSIZE
	FOR I = 0 TO (FWMAX*16)+1 DO
	[
		SETBOX(I,0,TRUE)	//TOP AND BOTTOM
		SETBOX(I,FHMAX+1,TRUE)
	]


	FOR I = 0 TO FHMAX+1 DO
	[
		SETBOX(0,I,TRUE)
		SETBOX ((FWMAX*16)+1,I,TRUE)  //SIDES
	]
	CLMARGIN = CLMARGIN+BOXSIZE
	CTOPMARGIN = CTOPMARGIN+BOXSIZE

	WS("*NFONT 3*N!");CURRENTFONT = 3;
	FONT = FONTVEC!CURRENTFONT
	[ //TRACK MOUSE AND ADD OR DELETE BITS
		IF RV 424B GR NWRDS*16 THEN RV 424B = NWRDS*16
		IF RV 424B LS 0 THEN RV 424B = 0
		IF RV 425B GR OLINES THEN RV 425B = OLINES
		IF RV 425B LS 0 THEN RV 425B = 0

		RV 426B = RV 424B
		RV 427B = RV 425B

		LET X = (RV 424B)-CLMARGIN+2
		LET Y = (RV 425B)-CTOPMARGIN+2
	
		X = X LS 0? 0,X/BOXSIZE
		Y = Y LS 0? 0,Y/BOXSIZE

		X = X LS (FWMAX*16)? X,(FWMAX*16)-1
		Y = Y LS FHMAX? Y, FHMAX -1

		SWITCHON ((RV 177030B) & 7) INTO
		[
			CASE 0:
			CASE 1:
			CASE 2:
			CASE 3: SETBOX(X,Y,TRUE);SETARRAY(FARRAY,X,Y,TRUE); ENDCASE
                        CASE 5: TRANSLATECHAR(X, Y); ENDCASE
			CASE 6:	SETBOX(X,Y,FALSE);SETARRAY(FARRAY,X,Y,FALSE);ENDCASE
		]

		IF ENDOFS(KEYS) THEN LOOP

		LET CHAR = GETCHAR()
		SWITCHON CHAR INTO
		[
			CASE 33B:		
				WS("*NCONFIRM WITH CR TO QUIT");
				IF GETCHAR() EQ $*N THEN
				[ RV MOUSELINK = TRUE; FINISH ] 
				ENDCASE;
			CASE 3:		CUOUT();ENDCASE //.CU FORMAT OUTPUT
			CASE 20B:	//CONTROL P- PUTBACK IN FONT
				PUTITBACK();ENDCASE
			CASE 6:	//CONTROL F. CHANGE FONT
				CURRENTFONT = GETCHAR()&3
				WS("FONT ");PUTS(DSP,60B+CURRENTFONT)
				FONT = FONTVEC!CURRENTFONT
				ENDCASE;
			CASE 11B:	//CONTROL I. INPUTFONT
				READFONT();ENDCASE
			CASE 17B:	//CONTROL O. OUTPUTFONT
				WRITEFONT();ENDCASE
			CASE 23B:	//CONTROL S - SHOW CHARACTER
				SHOWCHAR(GETCHAR())
				ENDCASE
                        CASE 27B:       //CONTROL W - SETCHARWIDTH
                                SETCHARWIDTH()
                                ENDCASE
			CASE 4:	//CONTROL D- DISPLAY ALL CHARACTERS
				FOR I = 0 TO 377B DO
				[
					SHOWCHAR(I); IF GETCHAR() NE $*S THEN BREAK
				]
				ENDCASE
			DEFAULT:		ENDCASE
		]

		WS("*N!")
	] REPEAT

]


AND SHOWCHAR(CHAR) BE
[
	EXTENSIONCOUNT = 0
	BSTORE(FARRAY,0,FWMAX*FHMAX)
	FCHEIGHT = 0
	FCWIDTH = COPYCH(CHAR,FARRAY)
	BUILDCHAR()
        SETTICK(FCWIDTH,TRUE)
	WS(FORMATN("*NCHARACTER IS <C> (<B>),TOTAL WIDTH = <D>, HEIGHT = <D>, <D> EXTENSIONS",CHAR,CHAR,FCWIDTH,FCHEIGHT,EXTENSIONCOUNT -1))
]


AND SETTICK(X,SC) BE
[ 
  LET V = VEC 6
  V>>ITEM.XMIN = CLMARGIN + BOXSIZE*X - GAP
  V>>ITEM.YMIN = CTOPMARGIN-1
  V>>ITEM.XMAX = CLMARGIN + BOXSIZE*X - GAP + 1
  V>>ITEM.YMAX = CTOPMARGIN + FHMAX*BOXSIZE
  TEST SC IFSO SETBLOCK(V,0,0) IFNOT CLEARBLOCK(V)
]


AND SETBOX(X,Y,SC) BE
[
	LET V = VEC 6
	V>>ITEM.XMIN = CLMARGIN + (BOXSIZE*X)
	V>>ITEM.YMIN = CTOPMARGIN + (BOXSIZE*Y)
	V>>ITEM.XMAX = CLMARGIN + (BOXSIZE*(X+1)) -GAP
	V>>ITEM.YMAX = CTOPMARGIN + (BOXSIZE*(Y+1)) -GAP
	TEST SC IFSO SETBLOCK(V,0,0) IFNOT CLEARBLOCK(V)
]


AND SETARRAY(ARRAY,X,Y,SC) BE
[
	LET INDEX = (FWMAX*Y) + (X/16)
	LET XBIT = 100000B RSHIFT (X REM 16)
	TEST SC	IFSO ARRAY!INDEX = (ARRAY!INDEX) % XBIT
	IFNOT ARRAY!INDEX = (ARRAY!INDEX) & (NOT XBIT)
]



//COPY A CHARACTER FROM THE CURRENT FONT INTO FARRAY.
//RETURN THE WIDTH IN BITS

AND COPYCH(CHAR,ARRAY) = VALOF
[
	LET P = FONT + CHAR
	P = P + RV P
	LET HD = ((RV (P+1)) RSHIFT 8 )
	LET XH = (RV (P+1)) & 177B
	EXTENSIONCOUNT = EXTENSIONCOUNT + 1
	FCHEIGHT = (HD+XH) GR FCHEIGHT? (HD+XH),FCHEIGHT

	FOR I = 0 TO XH+HD-1 DO RV(ARRAY+(FWMAX*I)) = (I GE HD)? RV(P-XH+I-HD),0

	TEST ((RV P) &1) NE 0
	IFSO RESULTIS ((RV P) RSHIFT 1) //NO EXTENSION

	IFNOT RESULTIS (16+ COPYCH((RV P) RSHIFT 1,ARRAY+1))
]


//BUILD A CHARACTER IN THE DISPLAY AREA FROM FARRAY
AND BUILDCHAR() BE
[
	LET V = VEC 6
	V>>ITEM.XMIN = CLMARGIN
	V>>ITEM.YMIN = CTOPMARGIN-1
	V>>ITEM.XMAX = CLMARGIN + BOXSIZE*FWMAX*16
	V>>ITEM.YMAX = CTOPMARGIN+ BOXSIZE*FHMAX
	CLEARBLOCK(V)
	FOR I = 0 TO FWMAX-1 DO
	[
		FOR J = 0 TO FHMAX - 1 DO
		[
			LET X = RV(FARRAY+(FWMAX*J)+I)
			IF X EQ 0 THEN LOOP
			LET K = 0
			UNTIL X EQ 0 DO
			[
				IF X LS 0 THEN SETBOX(16*I + K,J,TRUE)
				X = X LSHIFT 1
				K = K+1
			]
		]
	]
]



AND PUTITBACK() BE
[
//FIRST INTERPRET FARRAY, AND VERIFY THAT ALL IS WELL WITH
//THE USER

	LET FDVEC = VEC (3*FWMAX)
        LET WTMP = NIL

	LET EXTCOUNT = 0
	FOR I = 0 TO FWMAX-1 DO
	[
		LET P = FARRAY+I
		LET W = 0
		LET D = 0
		LET FIRST = 0
		LET LAST = 0
		FOR J = 0 TO FHMAX-1 DO
		[
			IF (RV P) NE 0 THEN [
			  EXTCOUNT = I
			  D = (D % (RV P))
			  IF FIRST EQ 0 THEN FIRST = P
			  LAST = P]
			P = P+FWMAX
		]
		FDVEC!(3*I) = FIRST EQ 0?0,(FIRST-FARRAY-I)/FWMAX //HD
		FDVEC!((3*I)+1) = FIRST EQ 0?0,1+(LAST-FIRST)/FWMAX //XH
		UNTIL D EQ 0 DO [ D=D LSHIFT 1; W=W+1 ] 
                IF I*16 LS FCWIDTH-1 THEN [
                  EXTCOUNT = I
                  IF FIRST EQ 0 THEN WTMP=16
                  IF (I+1)*16 GE FCWIDTH-1 THEN WTMP=(FCWIDTH-1)REM 16
                  ]
		FDVEC!((3*I)+2) = W GR WTMP? W, WTMP //WIDTH OF INK
	]



//DO THE JOB
	WS("*NTYPE CHARACTER TO BE REPLACED")
	LET CHAR = GETCHAR()
	LET GOTBACK = COMPACTFONT(CHAR)
//FIND THE LAST POINTER (INCLUDING EXTENSIONS)
	LET LASTE = BIGGESTCHAR()


//MOVE THE BITMAP SPACE UP BY THE NUMBER OF EXTENSIONS REQUIRED
	LET EFONT = GETLAST() //RETURNS END OF FONT + 1
	FOR I = (EFONT-1) BY -1 TO (FONT+LASTE+1) DO RV(I+EXTCOUNT)=RV I
//MOVE THE POINTERS UP
	FOR I = FONT TO (FONT+LASTE) DO RV I = (RV I) + EXTCOUNT
//MOVE EFONT UP
	EFONT = EFONT+EXTCOUNT
//COPY FROM FARRAY INTO THE FONT
	FOR I = 0 TO EXTCOUNT DO
	[
		LET HD = FDVEC!(3*I)
		LET XH = FDVEC!((3*I) + 1)
		LET WIDTH =  I EQ EXTCOUNT? 1+2*(FDVEC!(3*I+2)), 2*(LASTE+1+I)


//COPY FROM FARRAY
		IF (HD+XH) GR 0 DO FOR K = 0 TO XH-1 DO
		[
			RV EFONT = RV(FARRAY+I+((HD+K)*FWMAX))
			EFONT = EFONT+1
		]
		RV EFONT = WIDTH
		RV (EFONT+1) = (HD LSHIFT 8) % XH
//SET UP A POINTER TO EFONT IN THE RIGHT PLACE IN THE POINTER
//AREA.  IF I=0, THE RIGHT PLACE IS FONT!CHAR, OTHERWISE IT
//IS AT LASTE
		LET PXX = I EQ 0? CHAR,LASTE+I
		PXX = FONT+PXX
		RV PXX = EFONT - PXX
		EFONT  = EFONT+2
	]

	
]


AND CHASE(X) = VALOF
[
	IF FONT!X EQ 0 THEN RESULTIS X
	LET Q = RV(FONT + X + (FONT!X))
	IF (Q&1) NE 0 THEN RESULTIS X
	LET T = Q RSHIFT 1
	LET R = CHASE(T)
	RESULTIS X GR R? X,R
]


AND GETLAST() = VALOF  //FIND THE FIRST WORD BEYOND THE FONT
[
	LET LASTX = 0
	FOR I = 0 TO 377B DO
	[
		LET T = GETBIGGEST(I)
		IF T GR LASTX THEN LASTX = T
	]
	RESULTIS LASTX +2
]


AND GETBIGGEST(CHAR) = VALOF
[
	IF FONT!CHAR EQ 0 THEN RESULTIS 0
	LET T = FONT + CHAR + (FONT!CHAR)
	LET EXT = RV T
	IF (EXT & 1) NE 0 THEN RESULTIS T
	LET U = GETBIGGEST( EXT RSHIFT 1)
	RESULTIS U GR T? U,T
]


//COMPACT FONT BY REMOVING CHAR.  RETURNS NUMBER OF WORDS RECOVERED

AND COMPACTFONT(CHAR) = VALOF
[

	LET ENDOFFONT = GETLAST()
	LET GETBACK = 0
	LET EXTCHAR = RV(FONT+CHAR+(FONT!CHAR))
	IF (EXTCHAR & 1) EQ 0 THEN GETBACK = COMPACTFONT( EXTCHAR RSHIFT 1)
	LET P = FONT+CHAR + (FONT!CHAR)

	LET OURVAL = CHAR+ (FONT!CHAR)
	FONT!CHAR = 0	//ZAP THE CHARACTER
	LET ELAST = BIGGESTCHAR()	//LAST POINTER
	ENDOFFONT = ENDOFFONT - GETBACK
//DETERMINE THE AMOUNT OF SPACE WE WILL GET BACK FROM THE BITMAP
//AREA
	LET XH = (RV(P+1))&177B
	XH = XH EQ 0? 0,XH+2	//DON'T ZAP 0 WIDTH CHARACTERS

	IF ENDOFFONT GR P THEN //DO THE FOLLOWING ONLY IF THE DELETED CHARACTER IS NOT THE LAST ONE IN THE BITMAP AREA

	[
//MOVE THE BITMAP DOWN BY XH WORDS
	FOR I = P+2 TO ENDOFFONT-1 DO RV(I-XH) = RV I

//DECREMENT POINTERS  BY THE AMOUNT OF SPACE REMOVED
	FOR I = 0 TO ELAST DO IF (I+(FONT!I)) GR OURVAL THEN FONT!I = (FONT!I)-XH
	ENDOFFONT = ENDOFFONT-XH	//BECAUSE WE MOVED IT DOWN

	]
	IF CHAR LS 400B THEN RESULTIS GETBACK+XH

//THE CHARACTER IS AN EXTENSION. WE MUST REMOVE ITS PLACE
//IN THE EXTENSION TABLE (PAINFULLY).
	FOR I = 0 TO 377B DO TANDD(I,CHAR)	//DECREMENT PSEUDO
//CHARACTERS IN THE BITMAP AREA WHICH POINT TO THINGS BEYOND CHAR
	FOR I = FONT+CHAR TO ENDOFFONT-1 DO RV I = RV (I+1) //MOVE
//FONT DOWN

	FOR I = 0 TO CHAR-1 DO FONT!I = (FONT!I) -1 //DECREMENT

	RESULTIS GETBACK+XH+1

]




AND TANDD(I,CHAR) BE
[
	IF FONT!I EQ 0 THEN RETURN
	LET P = FONT+I+(FONT!I)
	LET Q = RV P
	IF (Q & 1) EQ 0 THEN
	[
		IF (Q RSHIFT 1) GR CHAR THEN RV P = Q-2 //DECREMENT
//IF PSEUDO-CHARACTER IS GREATER THAN OURS

		TANDD(Q RSHIFT 1, CHAR) //FOLLOW THE POINTER
	]
]

AND BIGGESTCHAR() = VALOF
[
	LET LASTE = 0
	FOR I = 0 TO 377B DO
	[
		LET T = CHASE(I)
		LASTE = LASTE GR T? LASTE,T
	]
	RESULTIS LASTE
]