{*************************************************************************
***                                                                    ***
***                      LABEL PRINTS, ETC                             ***
***                                                                    ***
*************************************************************************}
{$I compdirs}

unit LABELS;

INTERFACE

uses devices;

type
 TLabelData = array[0..MaxLabelLines] of string[80];


procedure OpenDeferredLabels(var LabelFile : PDeviceStream);
procedure PrintDeferredLabels;
procedure PrintLabels(FileName : string);
function GetNumDeferredLabels(FileName : string) : word; {returns number of deferred labels to print}

procedure DoLabelNow(LabelData : TLabelData);
procedure ClearLabel(var LabelData : TLabelData);
procedure CentreLabel(var LabelData : TLabelData; Length : byte);


type
	TPrintDetails = record
		Col, Row : byte;
		Quantity : byte;
		LabelsFName : string[8];
		Target : word;
	end;


IMPLEMENTATION

uses
{$IFDEF WINDOWS}
 	wui,	{windows}
{$ELSE}
	tui,	views, {text}
{$ENDIF}
		objects, tuiedit, drivers,
		global, kamsetup,
		minilib,
		inpfname, {for label type}
		app,
		dos,
{$IFDEF kwplink}
		kwplink,  {for getting label paper/wp form}
{$ENDIF}
		help,
		dialogs, {for psitem}
		tasks,
		messtext,
		printers,
		tuimsgs;

var LastIOResult : integer;


{***********************************
 ***       DO A SIMPLE LABEL     ***
 ***********************************}

procedure DoLabelNow;
var	I : byte;
		LabelFile : text;

begin
	assign(LabelFile, dataPath + 'LABEL.NOW');
	rewrite(LabelFile);

	for I := 0 to MaxLabelLines do system.writeln(LabelFile, LabelData[I]);
	close(LabelFile);

	PrintLabels(datapath + 'LABEL.NOW');
end;

{*************************
 **     CLEAR LABEL     **
 *************************}
procedure ClearLabel;
var I : byte;
begin
	for I := 0 to MaxLabelLines do LabelData[I] := '';
end;

{*************************
 **    CENTRE LABEL     **
 *************************}

procedure CentreLabel;
var LineNo,Lines,ShuffleLine : integer;

begin
	{Really snazzy - centralise label a bit}
	{No lines at bottom}
 	Lines := 0;
	if Length > MaxLabelLines then Length := MaxLabelLines; {JIC}

	for LineNo := Length downto 1 do
		if LabelData[LineNo] = '' then Lines := Lines +1;

	Lines := (Lines div 2)-1;  {lines to shuffle - half each side but bias towards top}

	if Lines>0 then begin
		for ShuffleLine := Length downto Lines do
			LabelData[ShuffleLine] := LabelData[ShuffleLine -Lines];
		for ShuffleLine := 0 to Lines-1 do LabelData[ShuffleLine] := '  '; {clear beginning}
	end;
end;





{*************************************************
 ***         ASK FOR LABEL POSITION            ***
 *************************************************}
function EnterPrintDetails(var PrintDetails : TPrintDetails) : word;
var R : TRect;
		LabelBox : PEditBox;
		edTypeLine, FormLine : PView;
		FormedTypeLinker : PFormEdTypeLinker;
		SItem : PSItem;
		L : byte;

begin
	R.Assign(0, 0, 28,14); {Size of box}

	PrintDEtails.Col := 1;
	PrintDetails.Row := 1;
	PrintDEtails.Quantity := 1;
{  if delspaceR(PrintDetails.LabelsFName) = '' then} PrintDetails.LabelsFName := Printer^.DefLabels;
	ProgramSetup.SetGroup('Word Perfect');
	if ProgramSetup.GetBoolean('WP LABELS', False) then
		PrintDetails.Target := edWP51
	else
		PrintDetails.Target := edInternal;
	ProgramSetup.SetGroup('');

	New(LabelBox, init(R, 'Label Start Pos',nil));
	LabelBox^.HelpCtx := hcLabelPosDlg;

	with LabelBox^ do begin
		 Options := Options or ofCenterX or ofCenterY;

		 {--- Set up box interior ---}
{		 R.Assign(3,4,13,5);
		 Insert(New(PStaticText, init(R,L2str(GetNumDeferredLabels(''))+' labels')));

		 { X, Y, Boxlen,  FieldLen,     Title}
		 InsTitledField( 6, 2, 3, 1, '~C~ol', New(PInputByte, init(R,3)));
		 InsTitledField(17, 2, 3, 1, '~R~ow', New(PInputByte, init(R,3)));

		 InsTitledField( 6, 4, 3, 1, '~Q~ty', New(PInputByte, init(R, 3)));

		 FormLine := InsTitledField(17, 4, 8, 1, '~L~bl',
													New(PinputFName, Init(R, 8, LabelPaperExt, PrintersPath, True, EditPaper)));
		 PInputELine(FormLine)^.MustInputToClose := True;

		{Editor to be used}
		edTypeLine := InsTitledField( 6, 6, 15, 2, '', New(PERadioButtons, init(R,
																		NewSITem('~S~tandard',
																		NewSItem('~W~ordPerfect', nil)))));

		{$IFNDEF kwplink} PCluster(Current)^.EnableMask := PCLuster(Current)^.EnableMask and not Exp2(edWP51); {$ENDIF}

		New(FormedTypeLinker, init(edTypeLine, FormLine, LabelBox));

		{-- Buttons --}
		Insert(New(POurButton, init(14, 9, '~P~rint', cmOK, bfDefault+bfGetData, @PrintDetails)));
		POurButton(Current)^.kbType := kbF10;
		InsCancelButton(4,11);
		Insert(New(POurButton, init(14,11, '~K~eep',  cmStore,  bfNormal+bfGetData+bfClose, @PrintDetails)));

		SelectNext(False);

		SetData(PrintDetails);
	end;

	EnterPrintDetails := Desktop^.ExecView(LabelBox);

	dispose(LabelBox, done);
end;


{****************************************************************
 ***            DEFERRED LABELS FILE                          ***
 ****************************************************************}
{open as a stream for compatibility with most label producing methods}
procedure OpenDeferredLabels(var LabelFile : PDeviceStream);
begin
	New(LabelFIle, init('Deferred Labels File',''));

	{open with append}
	LabelFile^.AppendOpen;
end;


{****************************************************************
 ***            No. DEFERRED LABELS                           ***
 ****************************************************************}
 {used by print below to tell user how many labels expected}

function GetNumDeferredLabels(FileName : string) : word; {returns number of deferred labels to print}
var LabelFile : text;
		Line : string;
		NoLabels : word;

begin
	GetNumDeferredLabels := 0; {none found so far...}

	Assign(LabelFile, FileName);
{$I-}
	reset(LabelFile);
	LastIOResult := IOResult;

	{Empty/missing file}
	if (LastIOResult<>0) or eof(LabelFile) then begin
		if LastIOResult=0 then Close(LabelFile);
		exit;
	end;
{$I+}

	NoLabels := 0; {SHOULD always be a FF at the END of every label}

	while not eof(LabelFile) do begin
		Readln(LabelFile, Line);
		if pos(#12, Line)>0 then NoLabels := NoLabels + 1; {ff = new label}
	end;

	GetNumDeferredLabels := NoLabels;

	close(LabelFile);
end;




{************************************************************************
 ***              PRINT DEFERRED LABELS                               ***
 ************************************************************************}
{The labels are stored one after the other in an ASCII file, separated by
 new page (character 12) markers}
procedure PrintDeferredLabels;
begin PrintLabels(DataPath + 'LABELS.DFR'); end;


var Row, Col : word;
		RowOfLabels : array[1..4] of TLabelData;

procedure AddLabelToRow(LabelData : TLabelData; LabelPaper : PLabelPaper); forward;


procedure PrintLabels(FileName : string);
var LabelFile : text;
{		Col, Row : word;{}
		LabelData : TLabelData;
		LineNo : integer;
		ReadLine,Line : string;
		PrintDetails : TPrintDetails;
		NoLabels : word;
		Control : word;
		QuantityLoop : word;
		LabelPaper : PLabelPaper;

begin
	ThinkingOff;

	NoLabels := GetNumDeferredLabels(FileName);
	if NoLabels = 0 then begin
		{$IFDEF Development}
			if (LastIOResult <>0) then Line := #13#10+'('+FileName+' '+IOError(LastIOResult)+')' else Line := '';
		{$ELSE}
			Line := '';
		{$ENDIF}
		PauseMessage('Labels','No Labels ready'+Line,hcNoLabelsMsg);
		exit;
	end;

	{======== ASK WHERE TO START ====================}
	TitledThinkingOn('LABELS',N2Str(NoLabels)+' ready');  {display how many to go}
	Control := EnterPrintDetails(PrintDetails);
	ThinkingOff;

	if Control = cmStore then exit; {just quit without deleting, so can print again}

	if Control <> cmOK then begin
		{Delete & leave - cancel or close icon}
		Assign(LabelFile, FileName);
		rewrite(LabelFile);
		close(LabelFile);
		exit;
	end;

	{check for illegal column given}
	if (PrintDetails.Col<1) or (PrintDEtails.Row<1) or (PrintDetails.Quantity<1) then begin
		InputWarning('Values 1 or greater please!', hcIWRangeMsg);
		PrintLabels(FileName); {go round again}
		exit;
	end;

{remove check just now as it would require getting labelpaper def depending on
Lbls field entered}
{	if PrintDetails.Col>PrinterSetup.Labels^.Columns then begin
		InputWarning(L2Str(PrintDetails.Col)+' columns input','Only '+L2Str(PrinterSetup.Labels^.Columns)+' available');
		PrintLabels(FileName); {go round again}
{		exit;
	end;{}

	{====== WHAT ABOUT WINDOW BOXES?/WORDPERFECT LABELS ====================}
{$IFDEF kwplink}
	if PrintDetails.Target = edWP51 then begin
		PrintDeferredWPLabels(FileName, PrintDetails);
		PrintLabels(FileName);  {go round again, until cancel or delete pressed}
		exit;
	end;
{$ENDIF}


	{===== READ & OUTPUT LABELS ===========================================}
	ThinkingOn('Printing...');

	{--- set paper to labels defined ----}
	Printer^.SetPaperTo(PrintersPath+PrintDetails.LabelsFName+'.'+LabelPaperExt);
	LabelPaper := PLabelPaper(Printer^.Paper); {shortcut}

	{Just in case checks}
	if LabelPaper^.Columns <1 then LabelPaper^.Columns := 1; {stops endless looping}
	if LabelPaper^.Columns>4 then LabelPaper^.Columns := 4; {stops out of range error for RowOfLabels}

	{--- Move to start of label sheet -----}
	Printer^.StartPrint('','');  {Set Ypos, etc to top of page, reset control, etc but don't actually print anything}

	{--- Move to start of first label row}
	for LineNo := 1 to (PrintDetails.Row-1) * (LabelPaper^.Length + LabelPaper^.RowGap) do
			Printer^.writeln(''); {Move to right label}
	Row := PrintDetails.Row;  {set "global" row pos}

	{--- Clear labels up to first label col}
	ClearLabel(LabelData);
	Col := 1; while Col<PrintDetails.Col do	AddLabelToRow(LabelData, LabelPaper); {col changed in addlabeltorow proc}

	{--- Set working row & col to current pos as if printed up to there}
	ReadLine := ''; LastIOResult := 0;

	Assign(LabelFile, FileName);
	reset(LabelFile);

	{---- Read labels in one by one, printing as they come -----}
	while not eof(LabelFile) do begin

		{------ Set up label --------}
		ClearLabel(LabelData);

		{--- Read a label in from file ----}
		LineNo := -1;
		while (Pos(#12, ReadLine)=0) and (LastIOResult=0) and not eof(LabelFile) and (LineNo<MaxLabelLines) do begin
{$I-}	 {Want to ignore end of file warnings}
			if ReadLine='' then Readln(LabelFile, ReadLine); {Don't read if data left over from previous read
																													which had a #12 at the end of it}
			LastIOResult := IOResult; {Clear IOResult}
			if (LastIOResult<>0) then ProgramWarning(	'Attempting to print Labels'#13#10+
																								' I/O Result='+N2Str(LastIOResult)+' '+IOError(LastIOResult),
																								hcIOErrorMsg);
{$I+}
			if (Pos(#12, ReadLine)=0) and (LastIOResult=0) and not eof(LabelFile) then begin
				LineNo := LineNo +1;
				if LineNo>MaxLabelLines then
					ProgramWarning('Too many lines in label'#13#10'Maximum = '+N2Str(MaxLabelLines),hcInternalErrorMsg)
				else
					LabelData[LineNo] := ReadLine;
				ReadLine := '';
			end;
		end;

		{--- Centre it ------}
		CentreLabel(LabelData, LabelPaper^.Length - LabelPaper^.LabelTopMargin);

		{--- Collate & print ----}
		for QuantityLoop := 1 to PrintDetails.Quantity do
				AddLabelToRow(LabelData, LabelPaper);

		{if FF exists in line, rest of line is real data, belonging to next label}
		if Pos(#12, ReadLine)>0 then ReadLine := Copy(ReadLine, Pos(#12, ReadLine)+1, length(ReadLine));

	end;

	{--- Print last row ---}
	ClearLabel(LabelData);
	while Col <> 1 do AddLabelToRow(LabelData, LabelPaper); {force it to print by adding more blanks until Col resets to 1}

	Close(LabelFile);

	{don't really want to do a FF at the end of last page if no rows/page defined
	in label definition - ie tractor fed...}
	if LabelPaper^.Rows = 0 then Printer^.Status := stAbandoned; {prevents printing but allows stream close, etc}
	Printer^.EndPrint; {output last page & tidy up}

	ThinkingOff;

	{Now go round again - ie continue until cancel or delete is pressed}
	PrintLabels(FileName);
end;


{========= COLLATE & PRINT OUT LABELS ==========================}
procedure AddLabelToRow(LabelData : TLabelData; LabelPaper : PLabelPaper);
var LineNo : integer;
		Line : string;
begin
	{add to row}
	RowofLabels[Col] := LabelData;
	Col := Col +1;

	{--- If reached end of row, print row & clear ---}
	if Col>LabelPaper^.Columns then begin
		{---------Print row of labels--------}

		{--- Check for next page BEFORE printing the labels due to appear on the NEXT page---}
		{This means that a new page is thrown only if needed}
		if (LabelPaper^.Rows>0) and (Row>LabelPaper^.Rows) then begin
			Printer^.NewPage;  {Finishes last page and starts new one}
			Row := 1;
		end;

		{Do num blank lines of label's top margin}
		for LineNo := 1 to LabelPaper^.LabelTopMargin do Printer^.writeln(''); {Clear top margin of label}

		{print each line of label, allowing for a top margin on each label, and starting from line 0}
		for LineNo := 0 to LabelPaper^.Length-1-LabelPaper^.LabelTopMargin do begin  {print a line of label data}

			{Build up a line of label data}
			Line := ''; {output stream automatically puts in left margin (space(LabelPaper^.LeftMargin);}
			for Col := 1 to LabelPaper^.Columns do
				Line := Line+setlength(space(LabelPaper^.LabelLeftMargin)+RowOfLabels[Col,LineNo], LabelPaper^.Width);

      Line := delspaceR(Line);

			{Last row sometimes overflows page, so after halfway through label,
			 don't print blank lines....}
			if (Row<LabelPaper^.Rows) or (LabelPaper^.Rows=0) or
				 (LineNo<5) or (Line<>'') then begin
							Printer^.Writeln(Line);
			end;

		end;

    {create gap between labels (if not last row)}
		if (Row<LabelPaper^.Rows) or (LabelPaper^.Rows=0) then
			for LineNo := 1 to LabelPaper^.RowGap do
				Printer^.Writeln('');

		Row := Row +1;

		Col := 1;  {ready for next line}

	end; {print bit}
end;


{****************************
 *** INITIALISATION       ***
 ****************************}
begin
	RegisterTask(DesktopTasks, cmDeferredLabels, @PrintDeferredLabels);
end.

