{*************************************************************************
 ***                       MEASURING ROUTINES                          ***
 *************************************************************************}
{$I compflgs}

unit Measures;

INTERFACE

uses
{$IFDEF Windows}
{$ELSE}
	tuiedit,
	drivers,
{$ENDIF}
	objects, setup;

const
	{Measurement unit types}
	unNone = $00;
	unInches = $01;
	unMeters = $02;
	unAuto = $03;
	unFeet = $04;
  unCentimeters = $05;
  unMillimeters = $05;

	inches2mm = 25.4;    {25mm in an inch}

  {uses valerr from minilib unit to store calculation problems}

type

	TLength = object
		Value : longint;   {10ths of inches or mm}
		Units : byte;

    procedure Clear;  {sets units to defaultunits}
    procedure SetTo(const Length : TLength);
		procedure SetToMeters(const Meters : real);
		procedure SetToMm(const mm : longint);
		procedure SetToInches(const Inches : real);
		procedure SetUnits(const NewUnits : byte);
		procedure SetToString(const S : string);
		function inMeters : real;
		function inInches : real;
		function inmm : longint;
		function Text(Un : byte; Dec : word; const Maxlen : byte) : string;

		procedure Store(var S : TStream);
		procedure Load(var S : TStream);
	end;

{$IFNDEF Windows}
	PInputLength = ^TInputLength;
	TInputLength = object(TInputELine)                        {Text input based to allow for feet & inches}
		constructor Init(Bounds : TRect; NFieldLen : integer);
		procedure Draw; virtual;
		procedure HandleEvent(var Event : TEVent); virtual;
		procedure GetData(var Rec); virtual;
		procedure SetData(var Rec); virtual;
		function DataSize : word; virtual;
		function Valid(Command: Word): Boolean; virtual;
	end;
{$ENDIF}

	TMeasuresSetup = object(TSetup)
		DefaultUnits : word;
		procedure Load; virtual;
		procedure Store; virtual;
		procedure AddSetupLines(EditBox : PEDitBox); virtual;
	end;

var
	MeasuresSetup : TMeasuresSetup;

IMPLEMENTATION

uses minilib,
			kamsetup,
			{$IFDEF Windows}
			winmsgs,
			{$ELSE}
			dialogs, {radiobuttons}
			tuimsgs,
			{$ENDIF}
			global,
			help;


procedure TMEasuresSetup.Load;
begin
	if ProgramSetup.Get(siDefaultMeasure,'METRIC') = 'IMPERIAL' then DefaultUnits := unInches
		else DefaultUnits := unMeters;
end;

procedure TMEasuresSetup.Store;
begin
	if DefaultUnits = unInches then
		ProgramSetup.Put(siDefaultMeasure, 'IMPERIAL')
	else
		ProgramSetup.Put(siDefaultMeasure, 'METRIC'); {clear}

	ProgramSetup.Store;
end;

procedure TMEasuresSetup.Addsetuplines;
var R : TRect;
begin
	with EditBox^ do begin
		InsTitledField(16,  2,12, 3, 'Default Units',
							New(PRadioButtons, init(R,  NewSItem('~N~one',  {not quite true - defaults to metric}
																					NewSItem('~I~mperial',
																					NewSITem('~M~etric',
							nil))))));
	end;
end;



{******************************************************
 ***                  A LENGTH                      ***
 ******************************************************}

procedure TLength.Clear;
begin
	Value := 0;
	Units := MeasuresSetup.DefaultUnits;
end;

procedure TLength.SetTo;
begin
	Value := Length.Value;
	Units := Length.Units;
end;


procedure TLength.SetToMeters;
begin
	Units := UnMeters;
	Value := round(Meters * 1000);  {Convert to mm}
end;

procedure TLength.SetTomm;
begin
	Units := UnMeters;
	Value := round(mm);
end;

procedure TLength.SetToInches;
begin
	Units := UnInches;
	Value := round(Inches * 10);  {Convert to 10ths of inches}
end;

procedure TLength.SetUnits;  {Sets default units and converts value}
begin
	{Convert from old to new}
	case Units of
		UnMeters : case NewUnits of
									UnInches : SetToInches(inInches);
							 end;
		UnInches : case NewUnits of
									UnMeters : SetToMeters(inMeters);
							 end;
	end;
	Units := NewUnits;
end;

procedure TLength.SetToString;
var FeetPos, InchPos, P : byte;
		Feet : longint;
		Inches, Meters : real;

begin
	Value := 0;

	{Check for feet and/or inches}
	FeetPos := Pos(#39,S); InchPos := Pos(#34,S);
	if (FeetPos >0) or (InchPos>0) then begin
		Feet := S2Num(Copy(S,1,FeetPos-1));
		Inches := S2Real(Copy(S,FeetPos+1,InchPos-FeetPos-1));
		SetToInches(Round((Feet * 12) + Inches));
	end else begin
		{Check for millimeters}
		p := Pos('MM',UCase(S));
		if p>0 then begin
			Units := UnMeters;
			Value := S2Num(Copy(S,1,p-1));
		end else begin
			{Check for cm}
			P := Pos('CM',UCASE(S));
			if P>0 then begin
				Units := UnMeters;
				Meters := S2Real(Copy(S,1,P-1)); {not really meters but cm}
				Value := round(Meters * 10);      {convert centimeters to mm}
			end else begin
				{Check for meters}
				P := Pos('M',UCASE(S));
				if P>0 then begin
					Units := UnMeters;
					Meters := S2Real(Copy(S,1,P-1));
					Value := round(Meters * 1000);
				end else begin

					{No units given, so assume whatever Units is set to}
					case Units of
						unInches : begin
							Inches := S2Real(S);
							SetToInches(Inches);
						end;
					else begin
							{Assume meters if units not set}
							Meters := S2Real(S);
							SetToMeters(Meters);
						end;
					end;

				end;
			end;
		end;
	end;
end;


{***** RETURN VARIOUS FORMS **********}
function TLength.inMeters;
begin
	inMeters := inmm/1000;
end;

function TLength.inInches;
begin
	case Units of
		UnInches : inInches := Value /10;
		UnMeters : inInches := (Value / inches2mm);
	else
		inInches := 0;
	end;
end;

function TLength.inmm;
begin
	case Units of
		UnMeters : inmm := Value;
		UnInches : inmm := round(Value * inches2mm) div 10;  {convert from 10ths inches to mm}
	else
		inmm := 0;
	end;
end;


{******* RETURN TEXT OF MEASUREMENT ********}
function TLength.Text;
var S : string;
begin
	if Dec = dcAuto then case Un of
		UnNone   : Dec := dcAll;
		UnInches : Dec := dcNone;
		unFeet   : Dec := dcNone;
		UnMeters : Dec := dcUpTo + 2;  {2 decimal places}
    UnCentimeters : Dec := dcNone;
    UnMillimeters : Dec := dcNone;
	end;

	if Value=0 then
		S := ''
	else begin
		case Un of
			unNone   : S := N2Str(Value);
			unInches : S := R2Str(inInches,Dec,Maxlen-1)+'"'; {leave room for units}
			unFeet   : begin
				S := R2Str(inInches/12,dcNone,0)+#39; if (S = '0'+#39) and (inInches <>0) then S := '';{feet - if no feet but some "}
				S := S+R2Str(inInches - int(inInches/12)*12,Dec,0)+'"'; {feet & inches}
				if Right(S,3)=#39+'12"' then S := Copy(S,1,length(S)-3); {if 11.98 feet, then will give 12" - botch fix}
				if Right(S,3)=#39+'0"' then S := Copy(S,1,length(S)-2); {chop off inches if nnn'0"}
				if Maxlen>0 then S := PadSpaceL(Copy(S,1,Maxlen),Maxlen); {set to maximum length}
			end;
{}
			unMeters : S := R2Str(inMeters,Dec,Maxlen-1)+'m'; {leave room for units}
			unCentimeters : S := R2Str(inmm/10,Dec,Maxlen-1)+'cm';
			unMillimeters : S := R2Str(inmm,Dec,Maxlen-1)+'cm';
			unAuto   : S := Text(Units, Dec, Maxlen);  {default units}
		else
			S := 'units'+N2Str(Un)+'?';
		end;
	end;

	Text := S;
end;

procedure TLength.Store;
begin
	S.Write(Units, sizeof(Units));
	S.Write(Value, sizeof(Value));
end;

procedure TLength.Load;
begin
	S.Read(Units, sizeof(Units));
	S.Read(Value, sizeof(Value));
end;

{************************************************************
 ***                    INPUT LENGTH                      ***
 ************************************************************}
constructor TInputLength.Init(Bounds : TRect; NFieldLen : integer);
begin
	inherited Init(Bounds, NFieldLen);
  HelpCtx := hcInputLength;
end;

{--- Draw, with expansion ----}
procedure TInputLength.Draw;
var Length : TLength;
begin
	inherited Draw;
	writechar(0,0, #29, 4, 1); {Draws luminous double arrow }
end;


procedure TInputLength.HandleEvent(var Event : TEvent);
var Length : TLength;
begin
	if (Event.What = evKeyBoard) then begin

		if (Event.KeyCode = kbF3) then begin
			GetData(Length);
			if Length.Units = unMeters then Length.SetUnits(unInches) else Length.SetUnits(unMeters);
			SetData(Length);
			Draw;
		end;

		if ((Event.CharCode<#48) or (Event.Charcode>#57))
			and (Event.Charcode <> #0)
			and (Event.Charcode >= #33)
			and (Event.CharCode <> 'm')							 {meters/millimeters}
			and (Event.CharCode <> 'M')
			and (Event.CharCode <> 'c') 							{centimeters}
			and (Event.CharCode <> 'C')
			and (Event.CharCode <> #46)              {Full stop}
			and (EVent.CharCode <> #39)              {pip - feet}
			and (Event.CharCode <> #34)              {quotes - inches}
			then begin
				WrongKeyBleep;
				ClearEvent(Event);
			end;
	end;

	inherited HandleEvent(Event);
end;

procedure TInputLength.GetData(var Rec);
begin
  TLength(Rec).Clear; {sets default units}
	TLength(Rec).SetToString(Data^);
end;

procedure TInputLength.SetData(var Rec);
begin
	Data^ := DelSpaceL(TLength(Rec).Text(unAuto,dcAuto,Maxlen));
end;

function TInputLength.DataSize : word;
begin DataSize := Sizeof(TLength); end;

{A useful place to re-display as correct units}
function TInputLength.Valid;
var V : boolean;
		Length : TLength;
begin
	V := inherited Valid(Command);
  if V then begin
		{convert}
  	GetData(Length);
    SetData(Length);
    Draw;
  end;
  Valid := V;
end;


begin
	MeasuresSetup.Init('Measures');
end.
