{+doc
+NOMBRE:traxp
+CREACION:1.1.90
+AUTORES:rch
+REGISTRO:
+TIPO: Unidad Pascal.
+PROPOSITO:Graficador tipo osciloscopio con multiples ventanas
+PROYECTO:rchlib

+REVISION:
+AUTOR:
+DESCRIPCION:
-doc}

{$DEFINE TRX_AREATEXTO}
{$UNDEF RchFonts}


{$IFDEF WINDOWS}
ESTA NO ES LA VESIÓN PARA WINDOWS.
USAR TRAXPW EN LUGAR DE TRAXP.
{$ENDIF}
{$O+}
unit traxp;

interface


uses
	xMatDefs,Graph,Crt,
	{$IFDEF RCHFonts}
	RCHFonts,
	{$ENDIF}
	Autoesca, PathDrvs;

const
	Estado:boolean = false;
	gridx:integer = 10;
	gridy:integer = 8;
	quita:integer = 12;
	ERF:NReal=0;
	NCanalesMax = 54;

const

	 { Colores: }
	 Negro        = 0;
	 Azul         = 1;
	 Verde        = 2;
	 Celeste      = 3;
	 Rojo         = 4;
	 Violeta      = 5;
	 Marron       = 6;
	 GrisClaro    = 7;
	 GrisOscuro   = 8;
	 AzulClaro    = 9;
	 VerdeClaro   = 10;
	 CeleteClaro  = 11;
	 RojoClaro    = 12;
	 VioletaClaro = 13;
	 Amarillo     = 14;
	 Blanco       = 15;

const
	ce_Solido = 0;
	ce_Punteado = 1;

var
	t,tinicial,tfinal:NReal;

{ Los siguientes identificadores para las mismas variables son para usar
en lugar de traxp.t o traxp.tInicial pues el prefijo variar  seg£n estemos
en WINDOWS o no }
	traxp_t:NReal absolute t;
	traxp_tInicial: NReal absolute tinicial;
	traxp_tfinal: NReal absolute tfinal;
	traxp_GridX: integer absolute GridX;
	traxp_GridY: integer absolute GridY;

procedure DefinaY(c:integer;y0,dy:NReal);
procedure DefinaX(c:integer;X0,dX:NReal);
procedure SubPlot(kx,ky:integer);
procedure Superponga(c1,c2:integer);
procedure ActiveCanal(k:integer);
procedure DefinaCanal(dh,ph,dv,pv:integer;x0,dx,y0,dy:NReal;tinta:word);
procedure Borde;
procedure Linea0;
procedure Titulo(x:string);
procedure XLabel(x:string);
procedure YLabel(x:string);
procedure DefinaColor(xcanal,xcolor:integer);
procedure DefinaColorAux(xcolor:integer);
procedure DefinaColorDefTrazos(xcolor:integer);
procedure DefinaColorDefFondo(xcolor:integer);

procedure InicieGr;
procedure TermineGr;
procedure grid;
procedure Desligue(n:integer);

procedure trazo(n:integer;y:NReal);
procedure trazoXY(n:integer;x,y:NReal);
procedure trazoXYColorEstilo(
			kanal:integer;
			x,y: NREal;
			xcolor, xestilo:integer);
procedure Barra(n:integer; y:NReal);
procedure BarraXY(n:integer; x,y:NReal);

procedure BorreTitulo;
procedure BorreCanal(kanal,ColorFondo:integer);
procedure GetXPYP(kanal:integer;var x1,y1,x2,y2:integer);
procedure LabelXY(Kanal:integer;x,y:NReal;texto:string);
procedure HoldOn(kanal:integer);
procedure HoldOff(kanal:integer);
function ChanelHoldStatus(Kanal:integer):boolean;
procedure PlotRealVect(kanal, NP:integer; var y);

{ sevicios de posicion de cursores }
type
	TipoDeAreaDeCuadro =(
		AreaDelTitulo, AreaDeXLabel, AreaDeYLabel, AreaDeTrazos );

function SiguienteAreaTocadaPorPunto(
	var kanal: integer; 
	var AreaId: TipoDeAreaDeCuadro;
	x, y: integer
	): boolean;

{
	+Entradas:
		(kanal) es el canal para iniciar la busqueda.
			si es <= 0 se considera 0. El primer canal testeado ser  kanal+1.
		 (xp, yp) es el punto en pixeles absolutos.
	+Salidas:
		(kanal) retorna el primer kanal tocado a partir de la busqueda.

	+ValorFuncion:
		El valor devuelto por la funcion ser  TRUE si el resultado en kanal
		es realmente v lido. Si es false, es que el punto no toca ningun
		canal desde donde se inicio la busqueda.
	+Aplicacion: para obtener todos los canales que sean tocados se deber 
	primero llamar la funcion con kanal=0 y luego llamar sucesivamente la
	funcion pasando cada vez en kanal, el valor devuelto en esta variable
	en la llamada anterior.

	}


procedure CoordenadasEnElCanal(
	kanal: integer; { canal }
	xpxa, ypxa: integer; {punto en pixeles absolutos}
	var x, y: NReal); {coordenadas en el canal}


procedure CoordenadasAbsolutas(
	var xpxa, ypxa: integer;
	kanal: integer;
	x, y: NReal);

function PuntoDentroRectangulo(
	x,y: integer; {el punto}
	x1, y1, x2, y2: integer { vetices opuestos del rectangulo }
	): boolean;


implementation



type

cuadro = record
	xp1,xp2,yp1,yp2:integer;
	xfp1,xfp2,yfp1,yfp2:integer; {pixeles absolutos del frame}
	x1,x2,y1,y2:NReal;
	xp,yp:integer;
	color,fondo:word;
	inicializado:boolean;
	HoldStatus:boolean;
end;

(*
cuadro = record
	gridX, gridY:integer;
	xp1,xp2,yp1,yp2:integer; {pixeles absolutos del area de trazos}
	x1,x2,y1,y2:NReal;
	xp,yp:integer;
	color,fondo:word;
	LapizDown: boolean;
	inicializado:boolean;
	HoldStatus:boolean;

	vph, vpv, vdh, vdv: integer;

	Linea0Status: boolean;
	GridStatus: boolean;
	tituloStr: string;
	xlabelStr: string;
	ylabelStr: string;
	Puntos: PCollection;

end;

*)


var
	canal:array[0..NCanalesMax]of cuadro;
	activo:integer;
	colorAuxiliar, ColorDefFondo, ColorDefTrazo:integer;


procedure CoordenadasEnElCanal(
	kanal: integer; { canal }
	xpxa, ypxa: integer; {punto en pixeles absolutos}
	var x, y: NReal); {coordenadas en el canal}

begin
	with canal[kanal] do
	begin
		y:= y2-(ypxa-yp1)/(yp2-yp1)*(y2-y1);
		x:= x1+(xpxa-xp1)/(xp2-xp1)*(x2-x1);
	end;
end;

function PuntoDentroRectangulo(
	x,y: integer; {el punto}
	x1, y1, x2, y2: integer { vetices opuestos del rectangulo }
	): boolean;
begin
	PuntoDentroRectangulo:= (x1<=x)and(x<=x2)and
		(y1<=y)and(y<=y2);
end;


procedure CoordenadasAbsolutas(
		var xpxa, ypxa: integer;
		kanal: integer;
		x, y: NReal);
begin
	with canal[kanal] do
	begin
		ypxa:=trunc(yp1-(y- y2)*(yp2-yp1)/(y2-y1));
		xpxa:=trunc(xp1+(x-x1)*(xp2-xp1)/(x2-x1));
	end;
end;



function SiguienteAreaTocadaPorPunto(
	var kanal: integer; 
	var AreaId: TipoDeAreaDeCuadro;
	x, y: integer
	): boolean;
var
	buscando: boolean;
begin
	if kanal<-1 then kanal:=-1;
	inc(kanal);
	buscando:= true;
	with canal[kanal] do
	while buscando do
	begin
		if PuntoDentroRectangulo(x, y, xfp1, yfp1, xfp2, yfp2) then
		begin
			buscando:= false;
			SiguienteAreaTocadaPorPunto:= true;
			if PuntoDentroRectangulo(x, y, xp1, yp1, xp2, yp2) then
				AreaId:=AreaDeTrazos
			else if x<xp1 then
				AreaId:= AreaDeYlabel
			else	if y<yp1 then
				AreaId:= AreaDelTitulo
			else {if y>yp2 then}
				AreaId:= AreaDeXlabel;
		end
		else
		begin
			inc(kanal);
			if kanal > NCanalesMax then
			begin
				buscando:= false;
				SiguienteAreaTocadaPorPunto:= false;
			end;
		end;
	end;
end;






procedure DefinaColorAux(xcolor:integer);
begin
	ColorAuxiliar:=xcolor;
end;

procedure DefinaColorDefTrazos(xcolor:integer);
begin
	ColorDefTrazo:=xcolor;
end;

procedure DefinaColorDefFondo(xcolor:integer);
begin
	ColorDefFondo:= xcolor;
end;

procedure GetXPYP(kanal:integer;var x1,y1,x2,y2:integer);
begin
	x1:=canal[kanal].xp1;
	x2:=canal[kanal].xp2;
	y1:=canal[kanal].yp1;
	y2:=canal[kanal].yp2;
end;



procedure LabelXY(Kanal:integer;x,y:NReal;texto:string);
var
	tempX,tempY:NReal;
begin
	SetColor(ColorAuxiliar);
	with canal[activo] do
	begin
		tempY:=(yp2-yp1)*(y2-y)/(y2-y1)+yp1;
		tempX:=(xp2-xp1)*(x-x1)/(x2-x1)+xp1;
		OutTextXY(trunc(tempX),Trunc(TempY),texto);
	end;
end;



procedure PlotRealVect(kanal, NP:integer; var y);
type
	VR = array[1..6000] of NReal;
var
	ma,mi,m:NReal;
	k:integer;
	st:string;
begin

	if ChanelHoldStatus(kanal) = FALSE then
	begin
		ma:=VR(y)[1];
		mi:=ma;
		for k:= 2 to NP do
		begin
			m:= VR(y)[k];
			if m<mi then mi:=m;
			if m>ma then ma:=m;
		end;
		if ma = mi then exit;
		gridy:=8;
		Escala125N(mi,ma,m,gridy,1);
		DefinaX(kanal,1,(NP-1)/gridx);
		DefinaY(kanal,mi,m);
		grid;
		str(m:8:-4,st);
		st:=st+'/DIV';
		ylabel(st);
	end;


	desligue(kanal);
	for k:= 1 to  NP do
		trazoXY(kanal,k,VR(y)[k]);
end;



procedure HoldOn(kanal:integer);
begin
	canal[kanal].HoldStatus:=true
end;


procedure HoldOff(kanal:integer);
begin
	canal[kanal].HoldStatus:=false
end;

function ChanelHoldStatus(Kanal:integer):boolean;
begin
	ChanelHoldStatus:=canal[kanal].HoldStatus
end;


procedure InicieCanales;
var k:word;
begin
for k:=0 to NCanalesMax do
	begin
		canal[k].inicializado:=false;
		canal[k].HoldStatus:=false
	end;
end;

procedure BorreCanal;
(*
  const
	 pat : FillPatternType = ($FF, $FF, $FF,
		$FF, $FF, $FF, $FF, $FF);
var
	vp:ViewPortType;
	bkc:integer;
	pol:array[1..4] of pointType;
begin
	activeCanal(kanal);
	with canal[kanal] do
	begin
		SetFillStyle(SolidFill,ColorFondo);
		bar(xp1,yp1,xp2,yp2);{FillPoly(4,pol);}
	end;
end;*)
var
 vp:ViewPortType;
begin
     activeCanal(kanal);
  GetViewSettings(vp);
  with canal[activo] do
      SetViewPort(xp1,yp1,xp2,yp2,true);
  ClearViewPort;
  with vp do
      SetViewPort(x1,y1,x2,y2,Clip);
end;




procedure DefinaCanal(dh,ph,dv,pv:integer;x0,dx,y0,dy:NReal;tinta:word);
begin
	with canal[activo] do
	begin
		{$IFNDEF TRX_AREATEXTO}
		xfp1:=trunc(GetMaxX/dh);
		{$ELSE}
		xfp1:=trunc(GetMaxY/dh);
		{$ENDIF}
		xfp2:=ph*xfp1;
		xfp1:=xfp2-xfp1;

		xp1:= xfp1+4*quita;
		xp2:= xfp2;

		yfp1:=trunc(GetMaxY/dv);
		yfp2:=pv*yfp1;
		yfp1:=yfp2-yfp1;

		yp2:=yfp2-2*quita;
		yp1:=yfp1+4*quita;

		color:=tinta;
		x1:=x0;y1:=y0;
		x2:=x0+gridx*dx;
		y2:=y0+gridy*dy;
   end
end;

procedure DefinaColor(xcanal,xcolor:integer);
begin
canal[xcanal].color:=xcolor;
end;

procedure ActiveCanal(k:integer);
begin
 activo:=k;
end;

procedure borde;
begin
setColor(colorAuxiliar);
with canal[activo] do
   rectangle(xp1,yp1,xp2,yp2);
end;

procedure titulo(x:string);
var
	t:TextSettingsType;
begin
	GetTextSettings(t);
	SetTextJustify(LeftText,BottomText);
	with canal[activo] do
		OutTextXY(xp1+2,yp1-2,x);
	SetTextJustify(t.Horiz,t.Vert);
end;

procedure xlabel(x:string);
var
	t:TextSettingsType;
begin
	GetTextSettings(t);
	SetTextJustify(LeftText,TopText);
	with canal[activo] do
		OutTextXY(xp1+2,yp2+2,x);
	SetTextJustify(t.Horiz,t.Vert);
end;

procedure ylabel(x:string);
var
   t:TextSettingsType;
   vp:ViewPortType;

begin

  GetViewSettings(vp);
  with canal[activo] do
      SetViewPort( xp1-QUITA, yp1, xp1-1, yp2, true);
  ClearViewPort;
  with vp do
      SetViewPort(x1,y1,x2,y2,Clip);

   GetTextSettings(t);
   SetTextStyle(t.font,VertDir,t.CharSize);
   SetTextJustify(RightText,BottomText);
   with canal[activo] do
	   OutTextXY(xp1-2,yp2-2,x);
   SetTextStyle(t.font,t.Direction,t.CharSize);
   SetTextJustify(t.Horiz,t.Vert);
end;

procedure BorreTitulo;
var
 vp:ViewPortType;
begin
  GetViewSettings(vp);
  with canal[activo] do
      SetViewPort(xp1,yp1-2*quita+1,xp2,yp1-1,true);
  ClearViewPort;
  with vp do
      SetViewPort(x1,y1,x2,y2,Clip);
end;


function tpix:integer; forward;

(*-----------------------------------*)
procedure InicieGr;
var
  Xasp, Yasp : Word;
  Gd, Gm : integer;
  gres: integer;
begin
	if Not Estado then
	begin
		Gd := Detect;
		InitGraph(Gd, Gm, PathToBGI);
		gres:= GraphResult;
		if gres <> grOk then
		  Halt(1);
		GetAspectRatio(Xasp, Yasp);
		ERF:=xasp/yasp;

		SetBkColor(ColorDefFondo);
		SetColor(ColorDefTrazo);
		{$IFDEF RCHFonts}
		SetColorPapel(ColorDefFondo);
		SetColorTinta(ColorAuxiliar);
{		SetTextStyle(StandardFont,HorizDIr,1); }
		SetTextStyle(SmallFont,HorizDIr,1);
		{$ELSE}
		SetBkColor(ColorDefFondo);
		SetColor(ColorDefTrazo);
{		SetTextStyle(DefaultFont, HorizDir,1);}
		SetTextStyle(SmallFont, HorizDir, 4);
{		SetUserCharSize(1, 2, 1, 2); }
		{$ENDIF}
		Estado:=true;
		SetWriteMode(0);
		ClearViewPort;
		end;
end;
(*------------------------------------*)
procedure TermineGr;
begin
	if estado then
	begin
		CloseGraph;
		Estado:=false;
	end;
end;
(*------------------------------------*)


procedure Lin(x1,y1,x2,y2:integer;pattern,grueso:word);
var
ls:linesettingstype;
begin
   getlinesettings(ls);
   setlinestyle(4,pattern,grueso);
   Line(x1,y1,x2,y2);
   setlinestyle(ls.LineStyle,ls.Pattern,ls.Thickness);
end;


procedure grid;
var

k,j:integer;
dx,dy:NReal;

begin
with canal[activo] do
 begin

   dx:=(xp2-xp1)/gridx;
   dy:=(yp2-yp1)/gridy;
	setColor(COlorAuxiliar);
	for k:=1 to gridx-1 do
				  lin(xp1+trunc(dx*k),yp1,xp1+trunc(dx*k),yp2,$2222,1);
	for k:=1 to gridy-1 do
				  lin(xp1,yp1+trunc(dy*k),xp2,yp1+trunc(dy*k),$2222,1);

 end;
end; (* Grid *)

(*------------------------------------------------*)



(******************************************************)

procedure Desligue(n:integer);
begin
	activo:=n;
	canal[activo].inicializado:=false;
end;


procedure trazo(n:integer;y:NReal);
begin
	trazoXY(n,t,y); { 26.07.92.rch }
end;



procedure Barra(n:integer; y:NReal);
var
	temp:NReal;
	xpt,ypt:integer;
begin
	activo:=n;
	with canal[activo] do
	begin
		if y2<>y1 then
			temp:=(yp2-yp1)*(y2-y)/(y2-y1)+yp1
		else temp:=2*yp2;
		if (temp>yp2) or (temp<yp1) then
			inicializado:=false
		else
			begin
			SetFillStyle(4, Blanco);
			xpt:=tpix;
			ypt:=trunc(temp);
			if not(inicializado) then
				begin
				xp:=xpt;yp:=ypt;
				inicializado:=true
				end;
			Bar3d(xp,ypt,xpt,yp2,5,true);
			xp:=xpt;
			yp:=ypt;
			end;
	end;
end;



(****************************************** 4/7/90 **)
procedure trazoXY(n:integer;x,y:NReal);
var
	tempX,tempY:NReal;
	xpt,ypt:integer;
	OldVP: ViewPortType;
	{$IFDEF DEB_traxp}
	fdeb:text;
	{$ENDIF}

begin
	{$IFDEF DEB_traxp}
	assign(fdeb, 'logfile.log');
	{$I-}
	append(fdeb);
	{$I+}
	if ioresult <> 0 then rewrite(fdeb);
	writeln(fdeb, 'trazoXY(',n,',',x,',',y,');');
	close(fdeb);
	{$ENDIF}



	activo:=n;

	GetViewSettings(OldVP);

	with canal[activo] do
	begin
		SetViewPort(xp1,yp1,xp2,yp2,true);
		tempY:=(yp2-yp1)*(y2-y)/(y2-y1);
		tempX:=(xp2-xp1)*(x-x1)/(x2-x1);

		xpt:=trunc(tempX);
		ypt:=trunc(tempY);

		if not(inicializado) then
		begin
			xp:=xpt;
			yp:=ypt;
			inicializado:=true;
		end;
		SetColor(Color);
		Line(xp,yp,xpt,ypt);
		xp:=xpt;yp:=ypt;
	end;
	with OldVP do
		SetViewPort(x1,y1,x2,y2,Clip);
end;
procedure trazoXYColorEstilo(
			kanal:integer;
			x,y: NREal;
			xcolor, xestilo:integer);
var
	tempX,tempY:NReal;
	xpt,ypt:integer;
	OldVP: ViewPortType;

begin
	activo:=kanal;

	GetViewSettings(OldVP);

	with canal[activo] do
	begin
		SetViewPort(xp1,yp1,xp2,yp2,true);
		tempY:=(yp2-yp1)*(y2-y)/(y2-y1);
		tempX:=(xp2-xp1)*(x-x1)/(x2-x1);
		xpt:=trunc(tempX);
		ypt:=trunc(tempY);

		if not(inicializado) then
		begin
			xp:=xpt;
			yp:=ypt;
			inicializado:=true;
		end;
		SetLineStyle(xEstilo,0,NormWidth);
		SetColor(xColor);
		Line(xp,yp,xpt,ypt);
		SetLineStyle(ce_Solido,0,NormWidth);
		xp:=xpt;yp:=ypt;
	end;
	with OldVP do
		SetViewPort(x1,y1,x2,y2,Clip);
end;
procedure BarraXY(n:integer;x,y:NReal);
var
	tempX,tempY:NReal;
	xpt,ypt:integer;
	OldVP: ViewPortType;

begin
	activo:=n;

	GetViewSettings(OldVP);

	with canal[activo] do
	begin
		SetViewPort(xp1,yp1,xp2,yp2,true);
		tempY:=(yp2-yp1)*(y2-y)/(y2-y1);
		tempX:=(xp2-xp1)*(x-x1)/(x2-x1);
		xpt:=trunc(tempX);
		ypt:=trunc(tempY);

		SetFillStyle(4, Blanco);

		if not(inicializado) then
		begin
			xp:=xpt;
			yp:=ypt;
			inicializado:=true;
		end;
		SetColor(Color);
		Bar3d(xp,ypt,xpt,yp2,5,true);
		xp:=xpt;yp:=ypt;
	end;
	with OldVP do
		SetViewPort(x1,y1,x2,y2,Clip);
end;



procedure Linea0;
var
temp:NReal;
dpix:NReal;
k:integer;
begin
with canal[activo] do
 begin
 dpix:=(xp2-xp1)/50;
 temp:=(yp2-yp1)*y2/(y2-y1)+yp1;
 if (temp>yp2) or (temp<yp1) then
	  else
	  for k:=1 to 49 do
		line(trunc(xp1+dpix*k),trunc(temp)+2,trunc(xp1+dpix*k),trunc(temp)-2);
 end
end;



(* determina el tiempo en pixels correspondiente al tiempo externo *)
function tpix:integer;
begin
with canal[activo] do
	if abs(x2-x1)>1e-15 then tpix:=trunc((t-x1)/(x2-x1)*(xp2-xp1)+xp1)
   else tpix:=0
end;

procedure SubPlot(kx,ky:integer);
var
 k,j,nc:integer;
begin
nc:=0;
for k:=1 to kx do
    for j:=1 to ky do
     begin
      activo:=nc;nc:=nc+1;
		DefinaCanal(kx,k,ky,j,tinicial,(tfinal-tinicial)/gridx,0,1,ColorDefTrazo);
		Borde;
		end
end;

procedure Superponga(c1,c2:integer);
begin
	canal[c1]:=canal[c2]
end;


procedure DefinaY(c:integer;y0,dy:NReal);
begin
activo:=c;
with canal[activo] do
     begin
       y1:=y0;
       y2:=y0+dy*gridy;
     end
end;

procedure DefinaX(c:integer;X0,dX:NReal);
begin
activo:=c;
with canal[activo] do
	begin
	x1:=x0;
	x2:=x0+dx*gridx;
	end
end;

var
	OldExitProc: pointer;

procedure AlFinal; far;
begin
	ExitProc:= OldExitProc;
	TermineGr;
end;


begin
Estado:= False;
OldExitProc:= ExitProc;
ExitProc:= @AlFinal;
ColorAuxiliar:= 1;
ColorDefFondo:= 15;
ColorDefTrazo:= 1;
tinicial:= 0;
tfinal:= 100;

InicieCanales;
end.
