unit ThreeDPlot;

{}

interface


	uses
		QuickDraw, Palettes, PrintTraps, globals, Utilities, Graphics, File1, Analysis, Camera;

	procedure DoBlowUp;
	procedure DoPlot (flag: boolean);
	procedure DoAddScales;
	var
		ThreeDHeightFactor: extended;

implementation

	const
		ScaleBarWidth = 20;
		ScaleLeftMargin = 100;
		ScaleBottomMargin = 50;

	procedure DoBlowUp;
		var
			OldInfo, NewInfo: InfoPtr;
			name: str255;
			width, height, oldwidth, oldheight, i, j: integer;
			OldLine1, OldLine2, NewLine: LineType;
	begin
		if nPics < 1 then
			PutMessage('You need a Picture to run DoBlowUp!')
		else begin
				OldInfo := Info;
				ShowWatch;

				with Info^ do begin
						GetWTitle(wptr, name);
						oldheight := nlines;
						height := 2 * oldheight;
						oldwidth := PixelsPerLine;
						width := 2 * oldwidth;
					end;
				name := concat('Giant ', name);

				if NewPicWindow(name, width, height) then begin
						NewInfo := Info;
						with NewInfo^ do begin
								x_range := OldInfo^.x_range / 2;
								y_range := OldInfo^.y_range / 2;
								z_range := OldInfo^.z_range;
							end;

						for i := 0 to oldheight - 1 do begin
								Info := OldInfo;
								GetLine(0, i, oldwidth, OldLine1);
								for j := 0 to oldwidth - 1 do begin
										NewLine[2 * j] := OldLine1[j];
										NewLine[2 * j + 1] := (OldLine1[j] + OldLine1[j + 1]) div 2;
									end;
								Info := NewInfo;
								PutLine(0, 2 * i, width, NewLine);

								Info := OldInfo;
								GetLine(0, i + 1, oldwidth, OldLine2);
								for j := 0 to oldwidth - 1 do begin
										NewLine[2 * j] := (OldLine1[j] + OldLine2[j + 1]) div 2;
										NewLine[2 * j + 1] := (OldLine1[j] + OldLine1[j + 1] + OldLine2[j] + OldLine2[j + 1]) div 4;
									end;
								Info := NewInfo;
								PutLine(0, 2 * i + 1, width, NewLine);
							end;
					end;
			end;
	end;

	procedure DoAddScales;
		var
			OldInfo, NewInfo: InfoPtr;
			name: str255;
			width, height, oldwidth, oldheight, i: integer;
			src, dst: ptr;
	begin
		if nPics < 1 then
			PutMessage('You need a Picture to run DoAddScales!')
		else begin
				OldInfo := Info;
				ShowWatch;

				with Info^ do begin
						GetWTitle(wptr, name);
						oldheight := nlines;
						height := oldheight + ScaleBottomMargin;
						oldwidth := PixelsPerLine;
						width := oldwidth + ScaleLeftMargin;
					end;
				name := concat('Scaled ', name);

				if NewPicWindow(name, width, height) then begin
						with OldInfo^ do begin
								src := PicBaseAddr;
								dst := Info^.PicBaseAddr;
								for i := 0 to oldheight - 1 do begin
										BlockMove(src, dst, oldwidth);
										src := ptr(ord4(src) + BytesPerRow);
										dst := ptr(ord4(dst) + width);
									end;
							end;
						UpdatePicWindow;
						with Info^ do begin
								x_range := OldInfo^.x_range;
								y_range := OldInfo^.y_range;
								z_range := OldInfo^.z_range;

								SetPort(GrafPtr(osPort));
								with osPort^ do begin
										for i := 0 to 255 do begin
												fgColor := i;
												MoveTo(oldwidth + 5, i);
												LineTo(oldwidth + 25, i)
											end;
										fgcolor := BlackIndex;
									end;
								TextSize(12);
								MoveTo(oldwidth + 30, 0);
								LineTo(oldwidth + 35, 0);
								MoveTo(oldwidth + 40, 15);
								DrawReal(z_range * 255, 5, 2);
								MoveTo(oldwidth + 30, 0);
								LineTo(oldwidth + 30, 255);
								LineTo(oldwidth + 35, 255);
								MoveTo(oldwidth + 40, 255);
								DrawReal(0.0, 5, 2);

								TextFace([bold]);
								MoveTo(10, oldheight + 15);
								DrawString('Area : ');
								TextFace([]);
								MoveTo(70, oldheight + 15);
								DrawReal(x_range * oldwidth, 8, 0);
								MoveTo(150, oldheight + 15);
								DrawString('x');
								MoveTo(170, oldheight + 15);
								DrawReal(y_range * oldheight, 8, 0);
								UpdatePicWindow;
							end;
					end;
			end;
	end;

	procedure ShadeLine (hloc, v0Loc, vloc: integer; value: integer);
		var
			i, pixels, color: integer;
			r_color, inc: real;
			p: ptr;
			offset, delta: Longint;
	begin
		with info^ do begin
				if hloc < 0 then
					hloc := 0
				else if hloc >= BytesPerRow then
					hloc := BytesPerRow - 1;
				if vloc < 0 then
					vloc := 0
				else if vloc >= nlines then
					vloc := nlines - 1;
				if v0loc < 0 then
					v0loc := 0
				else if v0loc >= nlines then
					v0loc := nlines - 1;

				pixels := abs(vloc - v0loc);
				if pixels = 0 then
					inc := 1
				else
					inc := (255 - value) / pixels;

				offset := Longint(v0loc) * BytesPerRow + hloc;
				delta := BytesPerRow;
				p := ptr(ord4(PicBaseAddr) + offset);
			end;

		if vloc > v0loc then begin
				r_color := (255 - pixels) * inc;
				for i := 0 to pixels - 1 do begin
						color := round(r_color);
						p^ := color;
						p := ptr(ord4(p) + delta);
						r_color := r_color + inc;
					end;
			end
		else begin
				r_color := 255;
				for i := 0 to pixels - 1 do begin
						color := round(r_color);
						p^ := color;
						p := ptr(ord4(p) - delta);
						r_color := r_color - inc;
					end;
			end;
	end;

	procedure DoPlot;
		var
			OldInfo, NewInfo: InfoPtr;
			name: str255;
			oldwidth, oldheight, width, height, i, value: integer;
			src, dst: ptr;
			vscale: extended;
			ScaleTable: array[0..255] of integer;
			ColorScaleTable: array[0..255] of integer;
			aLine, Line: LineType;
			hbase, vbase, vloc, v0loc, j, MinScale, MaxScale: integer;
			imin, imax: integer;
			hstart, vstart, hmax, hmin, vmax, vmin, nxpix, nypix, nx, nz: integer;
			MaskRect: rect;
	begin
		OldInfo := Info;
		ShowWatch;

		with Info^ do begin
				GetWTitle(wptr, name);
				oldheight := nlines;
				height := 3 * nlines div 2 + 10;
				oldwidth := PixelsPerLine;
				width := 2 * PixelsPerLine + 10;
			end;
		StopDigitizing;
		DisableDensitySlice;
		SelectAll(true);
		if info^.calibrated then
			info^.calibrated := false;
		Measure;
		UndoLastMeasurement(false);
		with results do begin
				MinValue := round(mMin^[mCount2]);
				MaxValue := round(mMax^[mCount2]);
			end;
		with info^ do begin
				nxpix := PixelsPerLine;
				nypix := nlines;
			end;
		nx := nxpix - 1;
		nz := nypix - 1;
		MaxValue := 0;
		MinValue := 255;
		for i := 0 to nz do begin
				GetLine(0, i, nxpix, Line);
				for j := 0 to nx do begin
						if line[j] > maxValue then
							maxValue := line[j];
						if line[j] < MinValue then
							minValue := Line[j];
					end;
			end;

		SelectAll(false);
		name := concat('3d ', name);

		if NewPicWindow(name, width, height) then begin
				NewInfo := Info;

				with Info^ do begin
						x_range := OldInfo^.x_range;
						y_range := OldInfo^.y_range;
						z_range := OldInfo^.z_range;
						vscale := ThreeDHeightFactor * 2 * z_range / (x_range + y_range);
					end;
				imin := round(MinValue);
				imax := round(MaxValue);
				MinScale := round(vscale * MinValue);
				MaxScale := round(vscale * MaxValue);
				if flag then begin
						for i := 0 to 255 do
							ScaleTable[i] := round(vscale * (255 - (i - MinValue)));
						for i := 0 to imin do
							ColorScaleTable[i] := 0;
						for i := imin to imax do
							ColorScaleTable[i] := round(256 * (i - MinValue) / (MaxValue - MinValue));
						for i := imax to 255 do
							ColorScaleTable[i] := 255;
					end
				else begin
						for i := 0 to 255 do
							ScaleTable[i] := round(vscale * (255 - (MaxValue - i)));
						for i := 0 to imin do
							ColorScaleTable[i] := 255;
						for i := imin to imax do
							ColorScaleTable[i] := round(256 * (MaxValue - i) / (MaxValue - MinValue));
						for i := imax to 255 do
							ColorScaleTable[i] := 0;
					end;

				with Info^ do begin
						hstart := 5;
						vstart := ScaleTable[0] + oldwidth div 2;
					end;

				for j := 0 to oldheight - 1 do begin
						info := OldInfo;
						GetLine(0, j, oldwidth, aLine);
						vbase := vstart;
						hbase := hstart;
						hmax := 0;
						vmin := 9999;
						Info := NewInfo;
						for i := 0 to oldwidth - 1 do begin
								v0loc := vbase - MinScale;
								value := aLine[i];
								vloc := vbase - ScaleTable[value];
								ShadeLine(hbase, v0loc, vloc, ColorScaleTable[value]);
								hbase := hbase + 1;
								if (i mod 2) = 1 then
									vbase := vbase - 1;
								if hbase > hmax then
									hmax := hbase;
								if vloc < vmin then
									vmin := vloc;
							end;
						hmin := hstart;
						vmax := vstart;
						SetRect(MaskRect, hmin, vmin, hmax, vmax);
						OffScreenToScreenRect(MaskRect);
						hstart := hstart + 1;
						if (j mod 2) = 1 then
							vstart := vstart + 1;
						if CommandPeriod then begin
								beep;
								exit(DoPlot);
							end;
						UpdatePicWindow;
					end;
			end;
	end;

end.