implementation module EdDraw;

/*	The text drawing routines.
	The performance of the editor very much depends on the performance of
	these routines, therefore strictness annotations have been added by hand.
 */

import StdClass, StdInt,StdChar,StdString,StdBool,StdArray;
import deltaPicture;

import EdTypes;
import EdConstants;

/*	DrawLines yoffset height tabwidth lines:
	Draws the lines, 1st line's baseline is on yofs.
*/

DrawLines :: !Int !Int !Int !Int !(List TLine) !Picture -> Picture;
DrawLines yofs hgt tabw right Nil pic =  pic;
DrawLines yofs hgt tabw right (line:!lines) pic
	= DrawLines (yofs + hgt) hgt tabw right lines drawline;
	where {
	drawline= DrawTLine yofs tabw right line pic;
	};

/*	Erase&DrawLines yoffset height ofs tabwidth right lines:
	Draws the lines, 1st line's baseline is on yoffset,
	erases all underneath
*/

Erase_and_DrawLines	:: !Bool !Int !Int !Int !Int !Int !(List TLine) !Picture -> Picture;
Erase_and_DrawLines erase_next yofs hgt ofs tabw right Nil pic
	| erase_next	= EraseRectangle ((LinesLeft,y),(right,y + hgt)) pic;
					= pic;
	where {
	y= yofs - ofs;
	};
Erase_and_DrawLines erase_next yofs hgt ofs tabw right (line:!lines) pic
	=  Erase_and_DrawLines erase_next (yofs + hgt) hgt ofs tabw right lines pic`;
	where {
	pic`	= DrawTLine yofs tabw right line pic1;
	pic1	= EraseRectangle ((LinesLeft,y),(right,y + hgt)) pic;
	y		= yofs - ofs;
	};


/*	Erase&DrawLine yoffset height ofs tabwidth right line:
	Draws the line, line's baseline is on yoffset,
	erases all underneath
*/

Erase_and_DrawLine :: !Int !Int !Int !Int !Int !TLine !Picture -> Picture;
Erase_and_DrawLine yofs hgt ofs tabw right line pic
	=  DrawTLine yofs tabw right line pic1;
	where {
	pic1= EraseRectangle ((LinesLeft,y),(right,y + hgt)) pic;
	y   = yofs - ofs;
	};


/*	DrawTLine yoffset tabwidth lines:
	Draws the line, line's baseline is on yofs.
*/

DrawTLine :: !Int !Int !Int !TLine !Picture -> Picture;
DrawTLine yofs tabw right line pic
	=  DrawStrings 0 tabw right line pic`;
	where {
	pic`= MovePenTo (LinesLeft,yofs) pic;
	};


/*	DrawStrings: auxiliary function, draws the strings in the TLine parameter */

DrawStrings	:: !Int !Int !Int TLine !Picture -> Picture;
DrawStrings xofs tabw right (str:!Nil) pic
	| xofs > right	=  pic;
					=  DrawString (str % (0, size str  - 2)) pic;
DrawStrings xofs tabw right (str:!rest) pic
	| xofs > right		= pic;
	| str == TabStr		= DrawStrings xofs` tabw right rest drawtab;
						= DrawStrings (xofs + strw) tabw right rest drawstr;
	where {
	xofs`		= tabw *  inc (xofs / tabw) ;
	drawtab		= MovePen (xofs` - xofs, 0) pic;
	(strw,pic1)	= PictureStringWidth str pic;
	drawstr		= DrawString str pic1;
	};
DrawStrings xofs tabw right Nil pic =  pic;


/*	ShiftStringsLeft/ShiftStringsRight: auxiliary functions, shift the TLine
	2nd arg. pixels to the left or the right. */

ShiftStringsRight :: !Int !Int !Int !Int !Int !Int !TLine !Picture -> Picture;
ShiftStringsRight xofs ofs y hght tabw right line pic
	=  ShiftRevStringsRight y hght tabw rline pic`;
	where {
	(rline,pic`)= ReverseTLine xofs ofs tabw right line Nil pic;
	};

ShiftRevStringsRight :: !Int !Int !Int !(List (!Int,!Int,!Int,!String)) !Picture -> Picture;
ShiftRevStringsRight y hght tabw Nil pic =  pic;
ShiftRevStringsRight y hght tabw ((xb,xe,ofs,string) :! rest) pic
	=  ShiftRevStringsRight y hght tabw rest scroll;
	where {
	scroll= MoveRectangle ((xb,y),(xe,y + hght)) (ofs,0) pic;
	};

ReverseTLine :: !Int !Int !Int !Int !TLine !(List (!Int,!Int,!Int,!String)) !Picture
	-> (!List (!Int,!Int,!Int,!String), !Picture);
ReverseTLine x ofs tabw right Nil rev pic =  (rev, pic);
ReverseTLine x ofs tabw right (TabStr :! rest) rev pic
	| x >= right		= (rev, pic);
	| ofs <  xtab - x 	= ReverseTLine xtab 0    tabw right rest rev pic;
						= ReverseTLine xtab tabw tabw right rest rev pic;
	where {
	xtab= tabw *  inc (x / tabw) ;
	};
ReverseTLine x ofs tabw right (string :! rest) rev pic
	| x >= right	= (rev, pic);
					= ReverseTLine x` ofs tabw right rest ((x,x`,ofs,string):!rev) pic`;
	where {
	(strw,pic`)	= PictureStringWidth string pic;
	x`			= x + strw;
	};
	
ShiftStringsLeft :: !Int !Int !Int !Int !Int !Int !Int TLine !Picture -> Picture;
ShiftStringsLeft x ofs y basey hght tabw right (TabStr:!rest) pic
	| x > right		=  pic;
	| oldxt == xtab	=  erase;
					=  ShiftStringsLeft xtab (0 - tabw) y basey hght tabw right rest erase;
	where {
	erase			= EraseRectangle ((x,y),(xtab,y + hght)) pic;
	xtab			= tabw *  inc (x / tabw) ;
	oldxt			= tabw *  inc ((x - ofs) / tabw) ;
	};
ShiftStringsLeft x ofs y basey hght tabw right line=:(str:!rest) pic
	| x > right		=  pic;
	| fromr > right =  DrawStrings x tabw right line (MovePenTo (x,basey) erase);
					=  ShiftStringsLeft (x + strw) ofs y basey hght tabw right rest move;
	where {
	erase			= EraseRectangle ((x,y),(right,y + hght)) pic`;
	move			= MoveRectangle ((froml,y),(min fromr right,y + hght)) (ofs,0) pic`;
	(strw,pic`)		= PictureStringWidth str pic;
	fromr			= froml + strw;
	froml			= x - ofs;
	};
ShiftStringsLeft x ofs y basey hght tabw right Nil pic
	=  EraseRectangle ((x,y),(right,y + hght)) pic;

	
/*	DrawShiftCurLine shifts the current line one char to the right */

DrawShiftCurLine :: !Int !Int !Int !Int !Int !Char !TLine !Picture -> Picture;
DrawShiftCurLine x y hght tabw right key line pic
	=  DrawChar key (MovePenTo (x,y + (at_new + ld)) pic`);
	where {
	pic`				= ShiftStringsRight x charw y hght tabw right line pic2; 
	(charw,pic2)		= PictureCharWidth key pic1;
	(metrics,pic1)		= PictureFontMetrics pic;
	(at_new,_,_,ld)	= metrics;
	};

/*	DrawTabCurLine draws a tab (shifts the rest of the current line one tab to the right) */

DrawTabCurLine :: !Int !Int !Int !Int !Int !Int !TLine !Picture -> Picture;
DrawTabCurLine ox nx y hght tabw right line pic
	=  ShiftStringsRight ox (nx - ox) y hght tabw right line pic;

/*	DrawRestCurLine draws a list of chars
*/

DrawRestCurLine	:: !Int !Int !Int !Int !TLine !Picture -> Picture;
DrawRestCurLine xofs y tabw right line pic
	=  DrawStrings xofs tabw right line (MovePenTo (xofs,y) pic);


/*	EraseRestCurLine erases a line from (cx,cy) */

EraseRestCurLine :: !Int !Int !Int !Int !Picture -> Picture;
EraseRestCurLine cx cy hght right pic
	=  EraseRectangle ((cx,cy),(right,cy + hght)) pic;


/*	DrawBackspCurLine shifts the rest of the current line to the left
*/

DrawBackspCurLine :: !Int !Int !Int !Int !Int !Int !TLine !Picture -> Picture;
DrawBackspCurLine xofs ofs y hght tabw right line pic
	=  ShiftStringsLeft xofs (0 - ofs) y (y + (at_new + ld)) hght tabw right line pic1;
	where {
	(metrics,pic1)		= PictureFontMetrics pic;
	(at_new,_,_,ld)	= metrics;
	};


/*	DrawCursor draws the cursor in XOR mode, arg2 is the height of the cursor */

DrawCursor :: !CursorPos !Int !Int !Picture -> Picture;
DrawCursor {vis,x,y,u_d} height lead pic
	=  SetPenMode CopyMode (LinePenTo (x,dec (y` + height)) (
		                  MovePenTo (x,y`) (SetPenMode XorMode pic)));
	where {
	y`= y + lead;
	};

/*	RemoveCursor removes the cursor, arg2 is the height */

RemoveCursor :: !CursorPos !Int !Int !Picture -> Picture;
RemoveCursor {vis,x,y,u_d} height lead pic
	| vis	=  SetPenMode CopyMode (LinePenTo (x,dec (y` + height)) (
		                  MovePenTo (x,y`) (SetPenMode XorMode pic)));
			=  pic;
	where {
	y`= y + lead;
	};

/*	DrawReHilite hilites or un-hilites the Selection passed to it, arg2 = height of a line */

DrawReHilite :: !Selection !Int !Picture -> Picture;
DrawReHilite {psel} hght pic =  DoHilite psel hght pic;

/*	DrawHilite hilites the new Selection (arg2) and un-hilites the old one (arg1)
	arg3 is the height of a line */

DrawHilite :: !Selection !Selection !Int !Picture -> Picture;
DrawHilite	{psel=osl=:{bx=obx,by=oby,ex=oex,ey=oey}}
			{psel=nsl=:{bx=nbx,by=nby,ex=nex,ey=ney}}
			hght pic
	| ((obx == nex) && (oby == ney)) || ((nbx == oex) && (nby == oey))
			=  DoHilite nsl hght (DoHilite osl hght pic);
	| (obx == nbx) && (oby == nby)
			=  ChangeHilite oex oey nex ney hght pic;
	| (oex == nex) && (oey == ney)
			=  ChangeHilite nbx nby obx oby hght pic;
			=  DoHilite nsl hght (DoHilite osl hght pic);

ChangeHilite :: !Int !Int !Int !Int !Int !Picture -> Picture;
ChangeHilite bx by ex ey hght pic
	| (ey < by) || ((ey == by) && (ex < bx))
			=  DoHilite {bx=ex,by=ey,ex=bx,ey=by} hght pic;
			=  DoHilite {bx=bx,by=by,ex=ex,ey=ey} hght pic; // IF > ey by || (= ey by && > ex bx)

/*	DrawReSelect is called by the update-functions to redraw the selection
	when it is within the rectangle */

DrawReSelect :: !Rectangle !PartPSel !Int !Picture -> Picture;
DrawReSelect area {bx,by,ex,ey} hght pic
	| by == ey		=  Repaint area bx by ex eyph pic;
	| byph == ey	=  Repaint area bx by PictureRight byph pic1;
					=  Repaint area bx by PictureRight byph pic2;
	where {
	pic1= Repaint area LinesLeft ey ex eyph pic;
	pic2= Repaint area LinesLeft byph PictureRight ey pic1;
	byph= by + hght;
	eyph= ey + hght;
	};

/*	Repaint: aux. function paints a rectangle determined by arg2-arg5 within the borders
	of the area */

Repaint :: !Rectangle !Int !Int !Int !Int !Picture -> Picture;
Repaint rect bx by ex ey pic
	=  SetPenMode CopyMode (Repaint1 rect bx by ex ey (SetPenMode HiliteMode pic));
	
Repaint1 :: !Rectangle !Int !Int !Int !Int !Picture -> Picture;
Repaint1 ((lft,top),(rgt,bot)) bx by ex ey pic
	| lft > ex || top > ey || rgt < bx || bot < by =  pic;
	=  FillRectangle ((max lft bx,max top by),(min rgt ex,min bot ey)) pic;

/*	DoHilite: aux. function, paints the area to be hilited or un-hilited */

DoHilite :: !PartPSel !Int !Picture -> Picture;
DoHilite psel hght pic =  SetPenMode CopyMode (DoHilite1 psel hght (SetPenMode HiliteMode pic));

DoHilite1 :: !PartPSel !Int !Picture -> Picture;
DoHilite1 {bx,by,ex,ey} hght pic
	| by == ey		=  FillRectangle ((bx,by),(ex,eyph)) pic;
	| byph == ey	=  FillRectangle ((bx,by),(PictureRight,byph)) pic1;
					=  FillRectangle ((bx,by),(PictureRight,byph)) pic2;
	where {
	pic1= FillRectangle ((LinesLeft,ey),(ex,eyph)) pic;
	pic2= FillRectangle ((LinesLeft,byph),(PictureRight,ey)) pic1;
	byph= by + hght;
	eyph= ey + hght;
	};