%====================================================================== % This is % queen.mf % % Copyright (C) 1989-93 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. %====================================================================== def OneCurl (expr a,da, b,db, above, pangle) = begingroup save dx, dy, p; pair dx; dx= b-a; pair dy; dy= dx rotated 90; pair p; p= (a+.5dx+above*dy); a{da} .. {dx rotated pangle}p & p{dx rotated -pangle} .. {db}b endgroup enddef; def SplitPath(suffix $) % the first suffix of z (expr p, % the path n, % how often shdelta % the shift multiplier % it's used to 'drift' the points % away from the center ) = % This makro takes a path, and defines n eqhal spaced % good points on the path. If shdelta is a small amount % greater zero, the pieces are smaller at the end of the % path. begingroup pair dl[]; pair dr[]; numeric i,l,r,delta; i= 0; l= 0; r= length(p); delta= length(p)/n; forever: if i = n-i: z$l[i] = z$r[i] = point .5length(p) of p; dl[i] = dr[i] = direction .5length(p) of p; else: numeric shift; if i=0: shift = 0 else: shift = (n-i)*shdelta*delta fi; z$l[i] = good.lft (point (l-shift) of p); dl[i] = direction (l-shift) of p; z$r[i] = good.rt (point (r+shift) of p); dr[i] = direction (r+shift) of p; fi l:= l+delta; r:= r-delta; exitif r-l < 0; i:= incr i; endfor; for i:= incr i step 1 until n: z$l[i] = z$r[n-i]; z$r[i] = z$l[n-i]; dl[i] = dr[n-i]; dr[i] = dl[n-i]; endfor; endgroup enddef; def CurlPath(suffix $) (expr p, % the path n, % how often above, % the peak above the path pangle, % the direction at the peak shdelta % the shift multiplier % it's used to 'drift' the points % away from the center ) = begingroup save dl, dr; save i,l,r,delta,shift; SplitPath($, p, n, shdelta); OneCurl(z$l0, dl0, z$l1, dl1, above, pangle) for i:= 2 step 1 until n: & OneCurl(z$l[i-1], dl[i-1], z4l[i], dl[i], above, pangle) endfor endgroup enddef; def SplitPoints(suffix $) % The same definition as SplitPath (expr p, % the path n, % how often shdelta % the shift multiplier % it's used to 'drift' the points % away from the center ) = begingroup save dl, dr; save i,l,r,delta,shift; SplitPath($, p, n, shdelta); endgroup enddef; 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; path KPath; 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 cCircle (expr bl, br, t, r) = % draw a circle with diameter r clockweise(!) at top % of triangle bl,br,t (reverse (halfcircle & halfcircle rotated 180)) scaled r shifted (left*.5r) rotated angle(.5[bl,br]-t) shifted t enddef; def DefineQueenPath(expr n) = %SetParam; DefineFootBows(-.034qs, % No Space to Bottom .72qs, % BowOneWidth .26qs, % FootHeight .40, % BowTwoLoc .15, % WidthToHeight .66, % BowTwoLen 0.66); % BowThreeLen % This is not needed for the fs-Type of queen. % path KPath, % 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; % Some correction of the lower bows, to make % the corners more round Bow0:= ShortenPath(Bow0, 5thin); Bow1:= ShortenPath(Bow1, 5thin); x1l:= lft(x1l + 2.5thin); x1r:= rt(x1r - 2.5thin); Bow0:= z1r{down} .. Bow0 .. {up}z1l; Bow1:= z1l{up} .. Bow1 .. {down}z1r; Bow4:= Lengthen(ParallelPath(Bow3, .10qs), .05qs); z4l = good.lft (point 0 of Bow4); z4 = point .5length(Bow4) of Bow4; z4r = good.rt point infinity of Bow4; Bow4:= z4l {direction 0 of Bow4} .. z4 {right} .. z4r {direction infinity of Bow4}; Bow4:= CurlPath(4, Bow4, n, .15, 35, .04); z5l = good.lft (SideSpace, .72qs); z5r = good.rt (qs-SideSpace, .72qs); show z5l, z5r; z5 = (.5qs, .83qs); Bow5 = z5l .. z5 .. z5r; SplitPoints(5, Bow5, n-1, .01); path cPath; cPath = z4l0 for i=0 step 1 until n-1: & z4l[i] -- z5l[i] & cCircle(z4l[i],z4l[i+1],z5l[i],.09qs) -- z4l[i+1] endfor; path LeftPath,RightPath,QueenShape; LeftPath:= z1l -- z2l -- z3l -- z4l; RightPath:= z4r -- z3r -- z2r -- z1r; QueenShape:= Bow0 & LeftPath & cPath & RightPath & cycle; enddef; pickup chess_pen; def MakeWhiteQueen = clearit; pickup chess_pen; draw QueenShape; %forsuffixes $=0,1,2,3,4,5: undraw z4r$; endfor; %forsuffixes $=0,1,2,3,4,5: draw z4l$; endfor; %forsuffixes $=0,1,2,3,4: draw z5l$; endfor; forsuffixes $=1,2,3,4: draw Bow$; endfor; WhiteMan:= currentpicture; enddef; def MakeBlackQueen = clearit; pickup chess_pen scaled 1.1; filldraw QueenShape; cullit; forsuffixes $=1,2,3: undraw ShortenPath(Bow$, thin); endfor; BlackMan:= currentpicture; enddef; def MakeOuterShape = clearit; pickup frame_pen; filldraw QueenShape; cullit; OuterShape:= currentpicture; enddef; DefineQueenPath(5); MakeWhiteQueen; MakeBlackQueen; MakeNeutral(WhiteMan,BlackMan); MakeOuterShape; %=========================================================== % this one for testing %beginchar(Queen+White+OnBlack, qs#, qs#, 0); % "White queen on black field"; % MakeBlackField; % currentpicture:= currentpicture - OuterShape; % cullit; % currentpicture:= currentpicture + WhiteMan; %endchar; %endinput %=========================================================== 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;