% This is
%		pkqueen.mf
%
% Copyright (C) 1989-92  by Elmar Bartel.
%
% This program is free software; you can redistribute it and/or modify
% it under the terms of the GNU General Public License as published by
% the Free Software Foundation; either version 1, or (at your option)
% any later version.
%
% This program is distributed in the hope that it will be useful,
% but WITHOUT ANY WARRANTY; without even the implied warranty of
% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
% GNU General Public License for more details.
%
% You should have received a copy of the GNU General Public License
% along with this program; if not, write to the Free Software
% Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
%

%we have to define six essential characters:
%         WoW   NoW   BoW   WoB   NoB   BoB
%Pawn       0     6    12    18    24    30
%Knight     1     7    13    19    25    31
%Bishop     2     8    14    20    26    32
%Rook       3     9    15    21    27    33
%Queen      4    10    16    22    28    34
%King       5    11    17    23    29    35

def Kegel(expr p,q) =
	begingroup
	path KPath;
	numeric Width[],x[].a,y[].a,x[].b,y[].b; 
	numeric Base,MiddlePos,BowIns,Height,LowerHeight,TopHeight;

	
	Width0      = Base = length(q-p);
	Width1      = 1.30Base;
	Width2      = 0.35Base;
	Width3      = 1.30Base; % Diameter of circle
	Height	    = 5.75Base;
	MiddlePos   = 0.25;

	BowIns = Width3/2+-+Width2/2;
	LowerHeight + TopHeight = Height - Width3 + BowIns;
	LowerHeight = MiddlePos*(LowerHeight+TopHeight);

	z0a = p;
	z0b = z0a + (Width0,0);
	forsuffixes $=1,2:
		x$a + x$b = x0a + x0b; x$b - x$a = Width$;
	endfor;
	y1a = y1b = y0a + LowerHeight;
	y2a = y2b = y1a + TopHeight;
	x3a = .5(x2b+x2a); 
	y3a = y2a + BowIns;
	%labels(0a,0b,1a,1b,2a,2b,3a);

	path LeftP,RightP,KgCircle;
	LeftP= z2a -- z1a -- z0a;
	RightP= z0b -- z1b -- z2b;
	KgCircle= halfcircle rotated 180 scaled Width3 shifted z3a;

	KPath:= RightP ..
	     subpath ((ypart((z1b -- 1.5[z1b,z2b])
	     		intersectiontimes KgCircle)),4) of KgCircle ..
	     halfcircle scaled Width3 shifted z3a ..
	     		subpath (0,ypart((z1a -- 1.5[z1a,z2a])
			intersectiontimes KgCircle)) of KgCircle ..
	     		LeftP;
	reverse (KPath rotatedaround(p, angle (q-p)))
	endgroup;
enddef;

def DefineQueenPath =
	%SetParam;
	DefineFootBows(    0,   % No Space to Bottom
			 .50qs,	% BowOneWidth
			 .28qs,	% FootHeight	
			 .40,	% BowTwoLoc
			 .13,	% WidthToHeight
			 .90,	% BowTwoLen
			1.00);	% BowThreeLen

	path KPath,LeftPath,RightPath,QueenShape;
	numeric b,s;
	% b and s define the ratio of 5 peak bases and 4 spaces.
	% if you want more or other spacing change the values
	b = 1.1s;
	5b + 4s = length(Bow3);

	pair at,bt;
	at= point 0 of Bow3;
	bt= point b of Bow3;
	KPath:= Kegel(at, bt);
	for t=b+s step b+s until length(Bow3):
		KPath:= KPath .. subpath(t-s,t) of Bow3;
		KPath:= KPath .. Kegel(point t of Bow3,
					point(t+b)of Bow3);
	endfor;
	LeftPath:= z1l .. z2l .. z3l;
	RightPath:= z3r .. z2r .. z1r;
	QueenShape:= Bow0 &
		LeftPath &
		KPath ..
		RightPath &
		cycle;
enddef;

pickup chess_pen;

def MakeWhiteQueen =
	clearit;
	pickup chess_pen;
	draw QueenShape;
	forsuffixes $=1,2,3: draw Bow$; endfor;
	WhiteMan:= currentpicture;
enddef;

def MakeBlackQueen =
	clearit;
	pickup chess_pen;
	filldraw QueenShape;
	cullit;
	undraw ShortenPath(Bow1,thin);
	undraw ShortenPath(Bow2,thin);
	undraw ShortenPath(ParallelPath(Bow3,-thin),thin);
	BlackMan:= currentpicture;
enddef;

def MakeOuterShape =
	clearit;
	pickup frame_pen;
	filldraw QueenShape;
	cullit;
	OuterShape:= currentpicture;
enddef;

DefineQueenPath;
MakeWhiteQueen;
MakeBlackQueen;
MakeNeutral(WhiteMan,BlackMan);
MakeOuterShape;

%-----------------------------------------------------------------------
beginchar(Queen+White+OnWhite, qs#, qs#, 0);
	"White queen on white field";
	currentpicture:= WhiteMan;
endchar;

beginchar(Queen+White+OnWhite+LeftTurned, qs#, qs#, 0);
	"White queen on white field rotated to the left";
	currentpicture:= TurnLeft(WhiteMan);
endchar;

beginchar(Queen+White+OnWhite+RightTurned, qs#, qs#, 0);
	"White queen on white field rotated to the right";
	currentpicture:= TurnRight(WhiteMan);
endchar;

beginchar(Queen+White+OnWhite+UpSideDown, qs#, qs#, 0);
	"White queen on white field upside down";
	currentpicture:= TurnUpSideDown(WhiteMan);
endchar;

beginchar(Queen+Black+OnWhite, qs#, qs#, 0);
	"Black queen on white field";
	currentpicture:= BlackMan;
endchar;

beginchar(Queen+Black+OnWhite+LeftTurned, qs#, qs#, 0);
	"Black queen on white field rotated to the left";
	currentpicture:= TurnLeft(BlackMan);
endchar;

beginchar(Queen+Black+OnWhite+RightTurned, qs#, qs#, 0);
	"Black queen on white field rotated to the right";
	currentpicture:= TurnRight(BlackMan);
endchar;

beginchar(Queen+Black+OnWhite+UpSideDown, qs#, qs#, 0);
	"Black queen on white field upside down";
	currentpicture:= TurnUpSideDown(BlackMan);
endchar;

beginchar(Queen+Neutral+OnWhite, qs#, qs#, 0);
	"Neutral queen on white field";
	currentpicture:= NeutralMan;
endchar;

beginchar(Queen+Neutral+OnWhite+LeftTurned, qs#, qs#, 0);
	"Neutral queen on white field rotated to the left";
	currentpicture:= TurnLeft(NeutralMan);
endchar;

beginchar(Queen+Neutral+OnWhite+RightTurned, qs#, qs#, 0);
	"Neutral queen on white field rotated to the right";
	currentpicture:= TurnRight(NeutralMan);
endchar;

beginchar(Queen+Neutral+OnWhite+UpSideDown, qs#, qs#, 0);
	"Neutral queen on white field upside down";
	currentpicture:= TurnUpSideDown(NeutralMan);
endchar;

beginchar(Queen+White+OnBlack, qs#, qs#, 0);
	"White queen on black field";
	MakeBlackField;
	currentpicture:= currentpicture - OuterShape;
	cullit;
	currentpicture:= currentpicture + WhiteMan;
endchar;

beginchar(Queen+White+OnBlack+LeftTurned, qs#, qs#, 0);
	"White queen on black field turned to the left";
	MakeBlackField;
	currentpicture:= currentpicture - TurnLeft(OuterShape);
	cullit;
	currentpicture:= currentpicture + TurnLeft(WhiteMan);
endchar;

beginchar(Queen+White+OnBlack+RightTurned, qs#, qs#, 0);
	"White queen on black field turned to the right";
	MakeBlackField;
	currentpicture:= currentpicture - TurnRight(OuterShape);
	cullit;
	currentpicture:= currentpicture + TurnRight(WhiteMan);
endchar;

beginchar(Queen+White+OnBlack+UpSideDown, qs#, qs#, 0);
	"White queen on black field upsidedown";
	MakeBlackField;
	currentpicture:= currentpicture - TurnUpSideDown(OuterShape);
	cullit;
	currentpicture:= currentpicture + TurnUpSideDown(WhiteMan);
endchar;

beginchar(Queen+Neutral+OnBlack, qs#, qs#, 0);
	"Neutral queen on black field";
	MakeBlackField;
	currentpicture:= currentpicture - OuterShape;
	cullit;
	currentpicture:= currentpicture + NeutralMan;
endchar;

beginchar(Queen+Neutral+OnBlack+LeftTurned, qs#, qs#, 0);
	"Neutral queen on black field turned to the left";
	MakeBlackField;
	currentpicture:= currentpicture - TurnLeft(OuterShape);
	cullit;
	currentpicture:= currentpicture + TurnLeft(NeutralMan);
endchar;

beginchar(Queen+Neutral+OnBlack+RightTurned, qs#, qs#, 0);
	"Neutral queen on black field turned to the right";
	MakeBlackField;
	currentpicture:= currentpicture - TurnRight(OuterShape);
	cullit;
	currentpicture:= currentpicture + TurnRight(NeutralMan);
endchar;

beginchar(Queen+Neutral+OnBlack+UpSideDown, qs#, qs#, 0);
	"Neutral queen on black field upsidedown";
	MakeBlackField;
	currentpicture:= currentpicture - TurnUpSideDown(OuterShape);
	cullit;
	currentpicture:= currentpicture + TurnUpSideDown(NeutralMan);
endchar;

beginchar(Queen+Black+OnBlack, qs#, qs#, 0);
	"Black queen on black field";
	MakeBlackField;
	currentpicture:= currentpicture - OuterShape;
	cullit;
	currentpicture:= currentpicture + BlackMan;
endchar;

beginchar(Queen+Black+OnBlack+LeftTurned, qs#, qs#, 0);
	"Black queen on black field turned to the left";
	MakeBlackField;
	currentpicture:= currentpicture - TurnLeft(OuterShape);
	cullit;
	currentpicture:= currentpicture + TurnLeft(BlackMan);
endchar;

beginchar(Queen+Black+OnBlack+RightTurned, qs#, qs#, 0);
	"Black queen on black field turned to the right";
	MakeBlackField;
	currentpicture:= currentpicture - TurnRight(OuterShape);
	cullit;
	currentpicture:= currentpicture + TurnRight(BlackMan);
endchar;

beginchar(Queen+Black+OnBlack+UpSideDown, qs#, qs#, 0);
	"Black queen on black field upsidedown";
	MakeBlackField;
	currentpicture:= currentpicture - TurnUpSideDown(OuterShape);
	cullit;
	currentpicture:= currentpicture + TurnUpSideDown(BlackMan);
endchar;
