diff options
author | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
---|---|---|
committer | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
commit | e0c6872cf40896c7be36b11dcc744620f10adf1d (patch) | |
tree | 60335e10d2f4354b0674ec22d7b53f0f8abee672 /fonts/bartel-chess-fonts/elch-queen.mf |
Initial commit
Diffstat (limited to 'fonts/bartel-chess-fonts/elch-queen.mf')
-rw-r--r-- | fonts/bartel-chess-fonts/elch-queen.mf | 441 |
1 files changed, 441 insertions, 0 deletions
diff --git a/fonts/bartel-chess-fonts/elch-queen.mf b/fonts/bartel-chess-fonts/elch-queen.mf new file mode 100644 index 0000000000..52b5ac371f --- /dev/null +++ b/fonts/bartel-chess-fonts/elch-queen.mf @@ -0,0 +1,441 @@ +%====================================================================== +% 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; |