{==============================================================

	patchTester.p

	Started by Jeff Ondich on 5/6/96
	Last modified 5/8/96

	Draws one picture at a time.  Hit return after each
	picture to get the next one.  I'm using this to test
	the student submissions for the quilt patch assignment.

==============================================================}

#include	<gpc-graphics.h>

program patch(input,output);

const	nPictures = 3;
		windowWidth = 600;
		windowHeight = 600;
		windowBottom = 100;
		windowLeft = 100;

var		pict, rectLeft, rectBottom, width, height : integer;

procedure DrawPicture( choice, left, bottom, width, height : integer );
	forward;

procedure StartGraphics;
var	boundary : polyarray;
begin
  { open a window }
 	initializegraphics;
	createwindow(windowLeft,windowBottom,windowLeft+windowWidth,windowBottom+windowHeight);
	
  { flood the window with a white background }
	setrgbcolor(1.0,1.0,1.0);
	flood; 
	flushgraphics
end;

{==============================================================
	jondichPatch
 ==============================================================}
{==============================================================
	jondichPatch
 ==============================================================}
{==============================================================
	bromanjPicture
 ==============================================================}
{ Jenn Broman 2 May, 1996
 This procedure draws four rectangles of four colors, with a colored circle inside of each one.  Thanks to Jantzl, my own personal lab as for the help!
}

procedure bromanjPicture( left, bottom, width, height : integer );

var	a, b, x, y : integer;
	rad : integer;
	
begin
	a := height div 4;
	b := width div 4;
	if a < b then 
		rad := a
	else
		rad := b;	
	x := height div 2;
	y := width div 2;	
	setrgbcolor( 0, 0, 0 );
	rectangle( left, bottom, left + width, bottom + height );
	flushgraphics;
	setrgbcolor( 1, 0, 0 );
	rectangle( left, bottom + x, left + y, bottom + height );
	circle( left + b, bottom + 3 * a, rad ); 
	flushgraphics;
	setrgbcolor( 0, 1, 0 );
	rectangle( left, bottom, left + y, bottom + x);
	circle( left + b, bottom + a, rad );
	flushgraphics;
	setrgbcolor( 0, 0, 1 );
	rectangle( left + y, bottom, left + width, bottom + x );
	circle( left + 3 * b, bottom + a, rad );
	flushgraphics;
	setrgbcolor( 1, 1, 1 );
	rectangle( left + y, bottom + x, left + width, bottom + height );
	circle( left + 3 * b, bottom + 3 * a, rad );
	flushgraphics
end;

{==============================================================
	beresdPicture
 ==============================================================}
{prcedure beresdPicture

Started 4/29/96 by Daryl L. Beres
Last modified 4/30/06

Procedure beresdPicture is given dimensions of a recantagle and draws a patch of my design within that rectangle.
}
Procedure beresdPicture(left, bottom, width, height : integer);
var	scale, radius, top, right : integer;
	i, k, x, y : integer;
	
	{Procedure happyFace is given coordinates and a radius for a circle and uses them to draw a basic
	happy face inside that circle.
	}
    	procedure happyFace (x, y, radius : integer);
	var	rad : integer;
	begin
		rad := radius div 4;
		setrgbcolor(0, 0, 0);
		setlinewidth (2);
		curve(x - rad * 3, y - rad, x + rad * 3, y - rad, x - rad, y - rad * 3, x + rad, y - rad * 3);
		circlefilled(x + rad * 3, y + rad * 3, rad);
		circlefilled(x - rad * 3, y + rad * 3, rad);
		flushgraphics
	end;
	   
begin
	right := left + width;
	top := bottom + height;
	setrgbcolor (0.95, 0.4, 0.6);
	rectanglefilled (left, bottom, right, top);
	if width < height then
		begin
			scale := width div 8;
			radius := scale div 2
		end
	else
		begin
			scale := height div 8;
			radius := scale div 2
		end;
	y := height div scale;	{y = the number of rows of circles which can be drawn within the rectangle}
	x := width div scale;  {x = the number of circles in each row which can be drawn within the rectangle}
	setrgbcolor (0.4, 0.4, 0.95);
	for i := 1 to y do
    	begin
		for k := 1 to x do
		begin
			setrgbcolor (0.4, 0.4, 0.95);
			circlefilled ((left + (scale * k) - radius), (top - (scale * i) + radius), radius);
			if ((i - 1) * x + k) mod 3 = 0 then	{this draws a happy face every third circle}
				happyFace((left + (scale * k) - radius), (top - (scale * i) + radius), radius);
			flushgraphics
		end
	end
end;

{==============================================================
	barryjPicture
 ==============================================================}
procedure barryjPicture ( left, bottom, width, height : integer );
{Hopefully this will draw a picture that looks like patch 	Jon Barry
								4-30-96}

var 	currentLeft, currentBottom, currentHeight, currentWidth, decreaseLeft, decreaseBottom, decreaseHeight, decreaseWidth : integer;
	polygon : polyarray;
	

begin
	StartGraphics;
	polygon[1].x := left;
	polygon[1].y := bottom + height;
	polygon[2].x := left + width;
	polygon[2].y := bottom + height;
	polygon[3].x := left + width;
	polygon[3].y := bottom;
	polygon[4].x := left;
	polygon[4].y := bottom;	
	setrgbcolor ( 0, 0, 1 );
	drawpolyfilled ( 4, polygon );
	setrgbcolor ( 1, 0, 0 );
	drawpoly (4, polygon );
	flushgraphics;
	currentLeft := left;
	currentBottom := bottom;
	decreaseHeight := (height div 9) div 2;
	currentHeight := height;
	decreaseWidth := (width div 9) div 2;
	currentWidth := width;
	while (currentWidth > 0) and (currentHeight > 0) and (currentBottom > 0) and (currentLeft > 0) do
		begin
			polygon[1].x := currentLeft + decreaseWidth;
			polygon[1].y := currentBottom + currentHeight - decreaseHeight;
			polygon[2].x := currentLeft + currentWidth - decreasewidth;
			polygon[2].y := currentBottom + currentHeight - decreaseHeight;
			polygon[3].x := currentLeft + currentWidth - decreaseWidth;
			polygon[3].y := currentBottom + decreaseHeight;
			polygon[4].x := currentLeft + decreaseWidth;
			polygon[4].y := currentBottom + decreaseHeight;	
			setrgbcolor ( 0, 0, 1 );
			drawpolyfilled ( 4, polygon );
			setrgbcolor ( 1, 0, 0 );
			drawpoly (4, polygon );
			flushgraphics;
			currentLeft := currentLeft + decreaseWidth;
			currentBottom := currentBottom + decreaseHeight;
			currentHeight := currentHeight - 2*decreaseHeight;
			currentWidth := currentWidth - 2*decreaseWidth;
		end;
end;
{==============================================================
	jondichPatch
 ==============================================================}
procedure jondichPatch( left, bottom, width, height : integer );
const	nRectangles = 10;
var		i, top, right, hOffset, vOffset : integer;
begin
	if (width > 0) and (height > 0) then
	begin
	 { Initialize some useful variables }
		top := bottom + height;
		right := left + width;
		hOffset := width div (2*nRectangles);
		vOffset := height div (2*nRectangles);

	 { Fill the background }
		setrgbcolor( 0, 0, 1 );
		rectanglefilled( left, bottom, right, top );
		flushgraphics;

	 { Set the new color, and draw the concentric rectangles }
		setrgbcolor( 1, 0, 0 );
		for i := 1 to nRectangles do
		begin
			rectangle( left, bottom, right, top );
			flushgraphics;
			left := left + hOffset;
			right := right - hOffset;
			bottom := bottom + vOffset;
			top := top - vOffset
		end;
	end
end;

{==============================================================
	jondichPicture
	
	Suffering artist.  This routine uses scaleaxes() and
	translateaxes() so the drawing code can assume the
	rectangle is between (0,0) and (100,100).  The axes are
	scaled and translated back home at the end of the procedure.
 ==============================================================}
procedure jondichPicture( left, bottom, width, height : integer );
begin
	translateaxes( left, bottom );
	scaleaxes( width/100, height/100 );

	setrgbcolor( 0, 0, 0 );
	rectangle( 0, 0, 100, 100 );
	flushgraphics;

  { The artist }
	circle( 80, 80, 8 ); {head}
	line( 76, 76, 75, 75 );  {mouth}
	line( 76, 76, 80, 76 );
	line( 80, 76, 82, 75 );
	line( 74, 83, 76, 85 );  {eyes}
	line( 82, 83, 80, 85 );
	line( 78, 83, 76, 78 );  {nose}
	line( 76, 78, 77, 77 );
	line( 80, 72, 80, 35 );  {body}
	line( 80, 35, 70, 10 );  {left leg}
	line( 70, 10, 65, 10 );
	line( 80, 35, 90, 10 );  {right leg}
	line( 90, 10, 85, 10 );
	line( 80, 60, 70, 65 );  {right arm}
	line( 70, 65, 62, 62 );
	line( 80, 60, 70, 45 );  {left arm}
	line( 70, 45, 66, 46 );
{	line( 88, 80, 88, 68 );  hair
	line( 86, 85, 86, 68 );
	line( 84, 74, 84, 68 );
	line( 82, 72, 82, 68 );
	line( 78, 72, 78, 68 );
	line( 76, 74, 76, 68 );}
	flushgraphics;

	line( 80, 92, 92, 80 );  {beret}
	line( 86, 86, 87, 87 );
	flushgraphics;
	
	line( 68, 68, 60, 60 );  {paint brush}
	flushgraphics;
	setrgbcolor( 1, 0, 0 );
	line( 60, 60, 58, 58 );
	flushgraphics;

	setrgbcolor( 0.8, 0.6, 0.1 );  {palette}
	circlefilled( 61, 49, 6 );
	flushgraphics;
	setrgbcolor( 1, 0, 0 );
	circlefilled( 58, 50, 1 );
	flushgraphics;
	setrgbcolor( 0, 1, 0 );
	circlefilled( 59, 47, 1 );
	flushgraphics;
	setrgbcolor( 1, 0, 1 );
	circlefilled( 62, 46, 1 );
	flushgraphics;
	setrgbcolor( 0, 0, 1 );
	circlefilled( 64, 48, 1 );
	flushgraphics;
	

  { The easel }
	setrgbcolor( 0.6, 0.25, 0.15 );
	line( 10, 10, 17, 39 );
	line( 30, 20, 30, 39 );
	line( 50, 10, 43, 39 );
	line( 5, 39, 55, 39 );
	line( 5, 81, 55, 81 );
	line( 30, 90, 27, 81 );
	line( 30, 90, 33, 81 );
	line( 30, 90, 30, 81 );
	flushgraphics;
	rectangle( 9, 39, 51, 81 );
	flushgraphics;

  { Draw someone else's picture in the easel }
	DrawPicture( random mod nPictures + 1, 10, 40, 40, 40 );

 	scaleaxes( 100/width, 100/height );
	translateaxes( -left, -bottom );
	flushgraphics;
end;


{==============================================================

	DrawPicture

	This routine draws the picture indicated by "choice"
	in the given rectangle (left, bottom, width, height) in
	the current graphics window.  If the choice is not in the
	range 1,...,nPictures, the default picture (my suffering
	artist) is drawn.
 ==============================================================}
procedure DrawPicture( choice, left, bottom, width, height : integer );
begin
	case choice of
	1: jondichPatch( left, bottom, width, height );
	2: beresdPicture( left, bottom, width, height );
	3: bromanjPicture( left, bottom, width, height );
	default: jondichPicture( left, bottom, width, height );
	end
end;

{==============================================================

   The main program

 ==============================================================}
begin
	srandom( gettime );

	rectLeft := 100;
	rectBottom := 100;
	width := 400;
	height := 250;
	
	StartGraphics;
	
	for pict := 1 to nPictures + 1 do
	begin
		cls;
		DrawPicture( pict, rectLeft, rectBottom, width, height );
		flushgraphics;
		readln
	end
end.