unit text;
{This unit contains routines for opening, saving, scrolling and editing text windows.}

interface

	uses
		Types, Memory, QuickDraw, QuickDrawText, Packages, Menus, Events, Fonts, 
		Scrap, ToolUtils, Resources, Errors, Palettes, StandardFile, Windows,
		Controls, TextEdit, Files, Dialogs, TextUtils, Finder, MixedMode,
		globals, Utilities, Graphics, File2;

	procedure UpdateScrollBars;
	procedure UpdateTextWindow (WhichWindow: WindowPtr);
	procedure ActivateTextWindow (WhichWindow: WindowPtr; Activating: boolean);
	procedure DoMouseDownInText (event: EventRecord; WhichWindow: WindowPtr);
	procedure ScrollText;
	procedure GrowTextWindow (NewSize: LongInt);
	function MakeNewTextWindow (name: str255; width, height: integer): boolean;
	function OpenTextFile (name: str255; RefNum: integer): boolean;
	procedure DoKeyDownInText (ch: char);
	procedure ChangeFontOrSize;
	procedure DoTextCopy;
	procedure DoTextPaste;
	procedure DoTextClear;
	procedure SaveText;
	procedure SaveTextAs;
	function SaveTextChanges: integer;
	procedure InsertText (str: str255; EndOfLine: boolean);
	procedure DoFind;
	procedure DecrementTextWindowNums (num: integer);
	procedure SaveTextUsingPath (name:str255);
	procedure SelectAllText;


implementation


	type
		CharArrayType = packed array[0..32767] of char;
		CharArrayPtr = ^CharArrayType;


	procedure UpdateScrollBars;
		var
			vMax, vValue, hMax, hValue: integer;
	begin
		with TextInfo^ do begin
				hlock(handle(TextTE));
				with TextTE^^, TextTE^^.viewRect do begin
						vTextPageSize := (bottom - top) div LineHeight;
						hTextPageSize := right - left;
						vMax := nLines - vTextPageSize;
						hMax := 0;
						vValue := (top - destRect.top) div LineHeight;
						hValue := left - destRect.left;
						if vMax < 0 then
							vMax := 0;
						if vValue < 0 then
							vValue := 0;
						if hMax < 0 then
							hMax := 0;
						if vValue < 0 then
							vValue := 0;
						SetControlMaximum(vTextScrollBar, vMax);
						SetControlValue(vTextScrollBar, vValue);
						SetControlMaximum(hTextScrollBar, hMax);
						SetControlValue(hTextScrollBar, hValue);
					end;
				hunlock(handle(TextTE));
			end;
{ShowMessage(concat('nListColumns= ', Long2str(nListColumns), crStr, 'hListPageSize= ', long2str(hListPageSize)));}
	end;


	procedure SetTextInfo;
  {Updates TextInfo so it points to the active text window.}
		var
			kind: integer;
	begin
		kind := CurrentWindow;
	end;


	procedure UpdateTextWindow (WhichWindow: WindowPtr);
	begin
		TextInfo := TextInfoPtr(WindowPeek(WhichWindow)^.RefCon);
		if TextInfo <> nil then
			with TextInfo^ do begin
					SetPort(TextWindowPtr);
					DrawControls(TextWindowPtr);
					DrawGrowIcon(TextWindowPtr);
					EraseRect(TextTE^^.viewRect);
					TEUpdate(TextTE^^.viewRect, TextTE);
					UpdateScrollBars;
				end; {with}
		SetTextInfo;
	end;


	procedure ActivateTextWindow (WhichWindow: WindowPtr; Activating: boolean);
	begin
		if Activating then
			UpdateTextWindow(WhichWindow);
		TextInfo := TextInfoPtr(WindowPeek(WhichWindow)^.RefCon);
		if TextInfo <> nil then
			with TextInfo^ do
				if Activating then begin
						TEActivate(TextTE);
						ShowControl(hTextScrollBar);
						ShowControl(vTextScrollBar);
						WhatToUndo := NothingToUndo;
					end
				else begin
						TEDeactivate(TextTE);
						HideControl(hTextScrollBar);
						HideControl(vTextScrollBar);
					end;
		SetTextInfo;
	end;


	procedure SetFontSize;
		var
			fInfo: FontInfo;
	begin
		with TextInfo^ do begin
				SetPort(TextWindowPtr);
				TextFont(CurrentFontID);
				TextSize(CurrentSize);
				with TextTE^^, fInfo do begin
						GetFontInfo(fInfo);
						TxSize := CurrentSize;
						LineHeight := ascent + descent + leading;
						FontAscent := ascent;
					end;
			end;
	end;


	procedure InitTextEdit;
		var
			dRect, vRect: rect;
	begin
		with TextInfo^ do begin
				SetPort(TextWindowPtr);
				SetRect(vrect, 0, 0, TextWidth - ScrollBarWidth, TextHeight - ScrollBarWidth);
				drect := vrect;
				InsetRect(drect, 4, 4);
				TextTE := TENew(drect, vrect);
				with TextTE^^ do begin
						TxFont := CurrentFontID;
						SetFontSize;
						crOnly := 1; {do word wrap}
					end;
				TESetSelect(0, 0, TextTE);
				UpdateScrollBars;
				TEAutoView(true, TextTE); {Enable auto-scrolling}
			end;
	end;


	procedure ScrollText;
		var
			value: integer;
	begin
		with TextInfo^, TextInfo^.TextTE^^ do
			TEScroll(0, (viewRect.top - destRect.top) - (GetControlValue(vTextScrollBar) * LineHeight), TextTE);
	end;


	procedure ScrollAction (theCtl: ControlHandle; partCode: integer);
		var
			bInc, pInc, delta: integer;
	begin
		if TextInfo <> nil then
			with TextInfo^ do begin
					if theCtl = vTextScrollBar then begin
							bInc := 1;
							pInc := vTextPageSize
						end
					else begin
							bInc := 4;
							pInc := hTextPageSize
						end;
					case partCode of
						kControlUpButtonPart: 
							delta := -bInc;
						kControlDownButtonPart: 
							delta := bInc;
						kControlPageUpPart: 
							delta := -pInc;
						kControlPageDownPart: 
							delta := pInc;
						otherwise
							exit(ScrollAction);
					end;
					SetControlValue(theCtl, GetControlValue(theCtl) + delta);
					ScrollText;
				end; {with}
	end;


	procedure DoMouseDownInText (event: EventRecord; WhichWindow: WindowPtr);
		var
			theCtl: ControlHandle;
			cValue: integer;
			loc: point;
	begin
		TextInfo := TextInfoPtr(WindowPeek(WhichWindow)^.RefCon);
		if TextInfo = nil then
			exit(DoMouseDownInText);
		SelectWindow(WhichWindow);
		SetPort(WhichWindow);
		loc := event.where;
		GlobalToLocal(loc);
		with TextInfo^ do
			if PtInRect(loc, TextTE^^.viewRect) then begin
					TEClick(loc, BitTst(@event.modifiers, 6), TextTE);
					UpdateScrollBars;
				end
			else
				case FindControl(loc, WhichWindow, theCtl) of
					kControlUpButtonPart, kControlDownButtonPart, kControlPageUpPart, kControlPageDownPart: 
						if TrackControl(theCtl, loc, TextScrollActionProc) <> 0 then
							;
					kControlIndicatorPart: 
						if TrackControl(theCtl, loc, nil) <> 0 then
							ScrollText;
					otherwise
				end;
	end;


	procedure GrowTextWindow (NewSize: LongInt);
	begin
		if TextInfo <> nil then
			with TextInfo^ do begin
					TextWidth := LoWrd(NewSize);
					TextHeight := HiWrd(NewSize);
					SetPort(TextWindowPtr);
					SizeWindow(TextWindowPtr, TextWidth, TextHeight, true);
					EraseRect(TextWindowPtr^.PortRect);
					MoveControl(hTextScrollBar, -1, TextHeight - ScrollBarWidth);
					MoveControl(vTextScrollBar, TextWidth - ScrollBarWidth, -1);
					SizeControl(hTextScrollBar, TextWidth - 13, ScrollBarWidth + 1);
					SizeControl(vTextScrollBar, ScrollBarWidth + 1, TextHeight - 13);
					InvalRect(TextWindowPtr^.PortRect);
					with TextTE^^ do begin
							SetRect(viewRect, 0, 0, TextWidth - ScrollBarWidth, TextHeight - ScrollBarWidth);
							viewRect.bottom := (viewRect.bottom div lineHeight) * lineHeight;
							destRect := viewRect;
							InsetRect(destRect, 4, 4);
						end;
					TECalText(TextTE);
					ScrollText;
				end; {with}
	end;


	function MakeNewTextWindow (name: str255; width, height: integer): boolean;
		var
			wrect, crect: rect;
	begin
		MakeNewTextWindow := false;
		if nTextWindows >= MaxTextWindows then begin
				PutError(concat('NIH Image cannot open more than ', long2str(MaxTextWindows), ' text windows.'));
				exit(MakeNewTextWindow);
			end;
		TextInfo := TextInfoPtr(NewPtr(SizeOf(TextInfoRec)));
		if TextInfo = nil then
			exit(MakeNewTextWindow);
		with TextInfo^ do begin
				TextWidth := width;
				TextHeight := height;
				TextLeft := PicLeft;
				TextTop := PicTop;
				PicLeft := PicLeft + hPicOffset;
				PicTop := PicTop + vPicOffset;
				if ((PicLeft + TextWidth) > ScreenWidth) or ((PicTop + TextHeight) > ScreenHeight) then begin
						PicLeft := PicLeftBase;
						PicTop := PicTopBase;
					end;
				if (TextTop + TextHeight) > ScreenHeight then
					TextHeight := ScreenHeight - TextTop - 4;
				SetRect(wrect, TextLeft, TextTop, TextLeft + TextWidth, TextTop + TextHeight);
				TextWindowPtr := NewWindow(nil, wrect, name, true, 0, pointer(-1), true, 0);
				if TextWindowPtr = nil then begin
						DisposePtr(ptr(TextInfo));
						TextInfo := nil;
						exit(MakeNewTextWindow);
					end;
				WindowPeek(TextWindowPtr)^.WindowKind := TextKind;
				WindowPeek(TextWindowPtr)^.RefCon := LongInt(TextInfo);
				SetRect(crect, TextWidth - ScrollBarWidth, -1, TextWidth + 1, TextHeight - 14);
				vTextScrollBar := NewControl(TextWindowPtr, crect, '', true, 0, 0, TextHeight - 14, ScrollBarProc, 0);
				SetRect(crect, -1, TextHeight - ScrollBarWidth, TextWidth - 14, TextHeight + 1);
				hTextScrollBar := NewControl(TextWindowPtr, crect, '', true, 0, 0, TextWidth - 14, ScrollBarProc, 0);
				InitTextEdit;
				DrawControls(TextWindowPtr);
				WhatToUndo := NothingToUndo;
				TextTitle := name;
				TextRefNum := 0;
				Changes := false;
				TooBig := false;
				InsertMenuItem(WindowsMenuH, 'Dummy', WindowsMenuItems - 1 + nTextWindows);
				SetMenuItemText(WindowsMenuH, WindowsMenuItems + nTextWindows, name);
				nTextWindows := nTextWindows + 1;
				WindowNum := nTextWindows;
				TextWindow[nTextWindows] := TextWindowPtr;
				if TextScrollActionProc=nil
					{then TextScrollActionProc:=NewControlActionProc(@ScrollAction);} {ppc-bug}
					then TextScrollActionProc:=NewRoutineDescriptor(@ScrollAction, uppControlActionProcInfo, GetCurrentISA);
				MakeNewTextWindow := true;
			end; {with}
	end;


	function OpenTextFile (name: str255; RefNum: integer): boolean;
		var
			err: OSErr;
			f, item: integer;
			TextFileSize: LongInt;
			LargerThan32K: boolean;
	begin
		OpenTextFile := false;
		if FreeMem < MinFree then begin
				PutError('Not enough memory to open this text file.');
				exit(OpenTextFile);
			end;
		LargerThan32K := false;
		err := FSOpen(name, RefNum, f);
		err := GetEof(f, TextFileSize);
		if TextFileSize > MaxTextBufSize then begin
				item := PutMessageWithCancel('This text file is larger than 32K. Would you like to to open the first 32K?');
				if item = cancel then begin
						err := fsclose(f);
						exit(OpenTextFile);
					end
				else begin
						TextFileSize := 30000;
						LargerThan32K := true;
					end;
			end;
		if not MakeNewTextWindow(name, 500, 400) then begin
				err := fsclose(f);
				exit(OpenTextFile);
			end;
		with TextInfo^ do begin
				SetHandleSize(TextTE^^.hText, TextFileSize);
				if MemError <> noErr then begin
						err := fsclose(f);
						PutError('Out of memory.');
						DisposePtr(ptr(TextInfo));
						TextInfo := nil;
						exit(OpenTextFile);
					end;
				err := SetFPos(f, fsFromStart, 0);
				ShowWatch;
				TextTE^^.teLength := TextFileSize;
				err := fsRead(f, TextFileSize, TextTE^^.hText^);
				if err <> noErr then begin
						TextTE^^.teLength := 0;
						SetHandleSize(TextTE^^.hText, 0);
						err := fsclose(f);
						exit(OpenTextFile);
					end;
				TECalText(TextTE);
				TextTitle := name;
				TextRefNum := RefNum;
				TooBig := LargerThan32K;
			end; {with}
		err := fsclose(f);
		OpenTextFile := true;
	end;


	procedure DoKeyDownInText (ch: char);
	begin
		if TextInfo <> nil then begin
				TEKey(ch, TextInfo^.TextTE);
				TextInfo^.Changes := true;
				UpdateScrollBars;
{with TextInfo^ do ShowMessage(concat(long2str(TextTE^^.teLength), '  ', long2str(GetHandleSize(TextTE^^.hText))));}
				WhatToUndo := NothingToUndo;
			end;
	end;


	procedure ChangeFontOrSize;
	begin
		if TextInfo <> nil then
			with TextInfo^ do begin
					TextTE^^.TxFont := CurrentFontID;
					SetFontSize;
					SetPort(TextWindowPtr);
					EraseRect(TextTE^^.viewRect);
					TEUpdate(TextTE^^.viewRect, TextTE);
					UpdateScrollBars;
				end; {with}
	end;


	procedure DoTextCopy;
		var
			err: OSErr;
	begin
		if TextInfo <> nil then begin
				TECopy(TextInfo^.TextTE);
				err := ZeroScrap;
				if err = NoErr then begin
						err := TEToScrap;
						WhatsOnClip := NothingOnClip; {It is on System Scrap}
					end;
			end;
	end;


	procedure DoTextPaste;
		var
			err: OSErr;
	begin
		if TextInfo <> nil then begin
				err := TEFromScrap;
				if err = NoErr then
					TEPaste(TextInfo^.TextTE);
				TextInfo^.Changes := true;
				UpdateScrollBars;
				WhatToUndo := NothingToUndo;
			end;
	end;


	procedure DoTextClear;
		var
			err: OSErr;
	begin
		if TextInfo <> nil then begin
				TEDelete(TextInfo^.TextTE);
				TextInfo^.Changes := true;
			end;
		UpdateScrollBars;
		WhatToUndo := NothingToUndo;
	end;


	procedure DoSaveText;
		var
			err, f: integer;
			TheInfo: FInfo;
			ByteCount: LongInt;
	begin
		if TextInfo <> nil then
			with TextInfo^ do begin
					hlock(handle(TextTE));
					with TextTE^^ do begin
							ByteCount := TELength;
							if ByteCount = 0 then
								exit(DoSaveText);
							err := GetFInfo(TextTitle, TextRefNum, TheInfo);
							case err of
								NoErr: 
									if TheInfo.fdType <> 'TEXT' then begin
											TypeMismatch(TextTitle);
											exit(DoSaveText)
										end;
								FNFerr:  begin
										err := create(TextTitle, TextRefNum, 'Imag', 'TEXT');
										if CheckIO(err) <> 0 then
											exit(DoSaveText);
									end;
								otherwise
									if CheckIO(err) <> 0 then
										exit(DoSaveText)
							end;
							ShowWatch;
							err := fsopen(TextTitle, TextRefNum, f);
							if CheckIO(err) <> 0 then
								exit(DoSaveText);
							err := fswrite(f, ByteCount, hText^);
							if CheckIO(err) <> 0 then
								exit(DoSaveText);
							err := SetEof(f, ByteCount);
							err := fsclose(f);
							err := FlushVol(nil, TextRefNum);
							Changes := false;
						end; {with}
					hunlock(handle(TextTE));
				end; {with}
	end;


	procedure SaveTextAs;
		var
			where: Point;
			reply: SFReply;
	begin
		if TextInfo <> nil then begin
				where.v := 60;
				where.h := 100;
				SFPutFile(where, 'Save Text as?', TextInfo^.TextTitle, nil, reply);
				if reply.good then
					with reply, TextInfo^ do begin
							TextTitle := fname;
							TextRefNum := vRefNum;
							DoSaveText;
							SetWTitle(TextWindowPtr, TextTitle);
							SetMenuItemText(WindowsMenuH, WindowsMenuItems - 1 + WindowNum, TextTitle);
						end;
			end;
	end;


	procedure SaveTextUsingPath(name:str255);
	var
		SaveTitle:str255;
	begin
		if TextInfo <> nil then with TextInfo^ do begin
			SaveTitle:=TextTitle;
			TextTitle := name;
			TextRefNum := 0;
			DoSaveText;
			TextTitle:=SaveTitle;
		end;
	end;
	
	
	procedure SaveText;
	begin
		if TextInfo <> nil then begin
				with TextInfo^ do
					if (TextRefNum = 0) or TooBig then
						SaveTextAs
					else
						DoSaveText;
			end;
	end;


	function SaveTextChanges: integer;
		const
			yesID = 1;
			NoID = 2;
			CancelID = 3;
		var
			id: integer;
			reply: SFReply;
	begin
		id := 0;
		with TextInfo^ do
			if changes and not TooBig then begin
					if macro and (MacroCommand = DisposeC) then begin
							SaveTextChanges := ok;
							exit(SaveTextChanges);
						end;
					ParamText(TextTitle, '', '', '');
					InitCursor;
					id := alert(600, nil);
					if id = yesID then
						SaveText;
				end; {if changes}
		if id = cancelID then
			SaveTextChanges := cancel
		else
			SaveTextChanges := ok;
	end;


procedure InsertText (str: str255; EndOfLine: boolean);
  var
   text: Ptr;
   len: LongInt;
 begin
  if TextInfo <> nil then
   with TextInfo^ do
    begin
     if EndOfLine then
     str := concat(str, cr);
     len := length(str);
     if (TextTE^^.TELength + len) > 32767 then begin
       AbortMacro;
       exit(InsertText);
     end;
     if len > 0 then
      begin
       TEDelete(TextTE);
       text := Ptr(Ord4(@str) + 1);
       TEInsert(text, len, TextTE);
       Changes := true;
       UpdateScrollBars;
       WhatToUndo := NothingToUndo;
      end;
    end;
 end;



	procedure GoToLine (str: str255; data: CharArrayPtr);
		var
			pos, line: integer;
			found: boolean;
			n: LongInt;
	begin
		with TextInfo^.TextTE^^ do begin
				found := false;
				delete(str, 1, 1);
				StringToNum(str, n);
				pos := 0;
				line := 1;
				if n = 1 then
					found := true
				else
					repeat
						if data^[pos] = cr then
							line := line + 1;
						pos := pos + 1;
						if line = n then begin
								found := true;
								leave;
							end;
					until (pos >= teLength);
				if found then begin
						TESetSelect(pos, pos, TextInfo^.TextTE);
						TEKey('x', TextInfo^.TextTE);
						TEKey(BackSpace, TextInfo^.TextTE);
						UpdateScrollBars;
					end
				else
					beep;
			end;
	end;


	procedure DoFind;
		const
			StringID = 3;
		var
			mylog: DialogPtr;
			item: integer;
			i, firstpos, lastpos, pos: integer;
			slength: integer;
			match: boolean;
			data: CharArrayPtr;
			c: char;
			str: str255;
	begin
		if TextInfo = nil then
			exit(DoFind);
		hlock(handle(TextInfo^.TextTE));
		with TextInfo^.TextTE^^ do begin
				if not OptionKeyWasDown then begin
						InitCursor;
						ParamText('What would you like to find?', '', '', '');
						mylog := GetNewDialog(170, nil, pointer(-1));
						SetDString(MyLog, StringID, SearchString);
						SelectdialogItemText(MyLog, StringID, 0, 32767);
						OutlineButton(MyLog, ok, 16);
						repeat
							ModalDialog(nil, item);
						until (item = ok) or (item = cancel);
						if item = cancel then begin
								DisposeDialog(mylog);
								exit(DoFind)
							end;
						SearchString := GetDString(MyLog, StringID);
						DisposeDialog(mylog);
					end;
				slength := Length(SearchString);
				if slength = 0 then
					exit(DoFind);
				str := SearchString;
				MakeLowerCase(str);
				data := CharArrayPtr(htext^);
				if (slength > 1) and (str[1] = '#') and (str[2] >= '0') and (str[2] <= '9') then begin
						GoToLine(str, data);
						hunlock(handle(TextInfo^.TextTE));
						exit(DoFind);
					end;
				match := false;
				lastpos := teLength - slength - 1;
				match := false;
				for firstpos := selEnd to lastpos do begin
						match := true;
						for i := 1 to slength do begin
								c := data^[firstpos + i - 1];
								if (c >= 'A') and (c <= 'Z') then
									c := chr(ord(c) + 32);
								if c <> str[i] then begin
										match := false;
										leave
									end;
							end;
						if match then begin
								pos := firstpos;
								leave;
							end;
					end;
				if match then begin
						TESetSelect(pos, pos, TextInfo^.TextTE);
						TEKey('x', TextInfo^.TextTE);
						TEKey(BackSpace, TextInfo^.TextTE);
						TESetSelect(pos, pos + slength, TextInfo^.TextTE);
						UpdateScrollBars;
					end
				else
					beep;
			end; {with}
		hunlock(handle(TextInfo^.TextTE));
	end;
	
	
	procedure SelectAllText;
	begin
		if TextInfo<>nil then
			TESetSelect(0, TextInfo^.TextTE^^.TELength, TextInfo^.TextTE)
	end;



end.