diff options
Diffstat (limited to 'Master/texmf-dist/metapost/mpattern/mpattern.mp')
| -rw-r--r-- | Master/texmf-dist/metapost/mpattern/mpattern.mp | 287 |
1 files changed, 287 insertions, 0 deletions
diff --git a/Master/texmf-dist/metapost/mpattern/mpattern.mp b/Master/texmf-dist/metapost/mpattern/mpattern.mp new file mode 100644 index 00000000000..2b7cd79e38b --- /dev/null +++ b/Master/texmf-dist/metapost/mpattern/mpattern.mp @@ -0,0 +1,287 @@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% This file is part of the MPATTERN package +% +% mpattern.mp: MetaPost macros for pattern defining and filling +% +% Author: Piotr Bolek +% version 0.5: (Jun 25, 2001) +% +% $Id: mpattern.mp,v 1.3 2001/06/25 07:28:14 piotrek Exp $ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +boolean P_dict_; +boolean P_used_already_; +% Record all numbers (charcode) of pictures +extra_beginfig := extra_beginfig + & "numeric Pwritten_[]; Pcharcode_[charcode]=1; P_used_already_:=false; P_dict_:=false;"; + +% Working variables to store fragments of Pattern definition +string PBBox_, PHead_, PTail_, PPaintProc_, Pname_, Pdefs_; +string Pmatrix_; + +PHead_="<< /PaintType 1 /PatternType 1 /TilingType 1 "; +% 11.08.98 PPaintProc_="/PaintProc { begin "; +PPaintProc_="/PaintProc { pop "; +% 11.08.98 PTail_=" end } >>"; % matrix makepattern"; +PTail_=" } >>"; % matrix makepattern"; +Pdefs_=""; + +% New line string +string Pnl_; Pnl_=char 13; + +% Number of defined patterns +numeric Pnum_; Pnum_=0; + +% Split string defining pattern on new line chars +% and use each piece as argument to special +vardef Psplit_and_write_(expr s)= + save Pfirst_, Plast_; + Pfirst_:=0; Plast_:=0; + for i=0 upto length(s): + if ( substring (i,i+1) of s = Pnl_ ): + Plast_:=i; + special substring (Pfirst_,Plast_) of s; + Pfirst_:=i+1; + fi; + endfor; +enddef; + +% Find maximum charcode not used for picture yet +vardef Pmax_charcode_= + save Pn_; + for i=999 downto 1: + Pn_:=i; + exitif unknown Pcharcode_[i]; + endfor; + Pn_ +enddef; + +def PmakeBB_= + PBBox_ := "/BBox [" & decimal Plft_ & " " & decimal Plow_ & " " + & decimal Prt_ & " " & decimal Pup_ & "]" & Pnl_; +enddef; + +def Psteps_= + PBBox_ := PBBox_ & "/XStep " & decimal + if unknown PXStep_: (Prt_-Plft_) else: PXStep_ fi & Pnl_ + & "/YStep " & decimal + if unknown PYStep_: (Pup_-Plow_) else: PYStep_ fi; +enddef; + +vardef Pfindbounds_= +% save Plow_, Plft_, Pup_, Prt_; +% numeric Plow_, Plft_, Pup_, Prt_; + + Plow_ = ypart (llcorner currentpicture); + Plft_ = xpart (llcorner currentpicture); + Pup_ = ypart (urcorner currentpicture); + Prt_ = xpart (urcorner currentpicture); + + PmakeBB_; +enddef; + +% Read file in which the body of patterns PaintProc is stored +vardef PReadFile_= + save Pfile_, Pline_, Pall_; + string Pfile_, Pline_, Pall_; + Pline_=Pall_=""; + Pfile_:=jobname & "." & decimal charcode; + forever: + Pline_ := readfrom Pfile_; + exitif Pline_ = EOF; + if (substring(length Pline_-3,length Pline_) of Pline_ = "def") + and (substring (0,6) of Pline_ <> "/fshow"): + Pdefs_ := Pdefs_ & Pline_ & Pnl_; + else: + if (substring (0,2) of Pline_ = "%%") + or (substring (0,8) of Pline_ = "showpage") + or (substring (0,4) of Pline_ = "%!PS") + or (substring (0,6) of Pline_ = "/fshow"): + else: + Pall_:=Pall_ & Pline_ & Pnl_; + fi; + fi; + endfor; + Pall_ +enddef; + +% Join all parts of pattern definition +vardef PmakePattern_(expr name)= + save Pread_; + string Pread_; + + Pread_ = PReadFile_; + + % Write string used later to identify pattern +% batchmode; +% message "Defining pattern " & name & "->" & decimal (Pnum_*epsilon); +% errorstopmode; + "% Pattern:" & + if (not known PColor_): + decimal (Pnum_*epsilon) + else: + decimal (PColor_) + fi + & ":" & name & Pnl_ + & PHead_ & Pnl_ + & PBBox_ & Pnl_ + & Pdefs_ + & PPaintProc_ & Pnl_ + & Pread_ + & PTail_ & Pnl_ + & Pmatrix_ & " makepattern" & Pnl_ + & "/" & name & " exch def" & Pnl_ + & "MPP " & + if (not known PColor_): + decimal (Pnum_*epsilon) + else: + decimal (PColor_) + fi + & " " & name & " put" & Pnl_ +enddef; + +% find PatternColor -- color which will be replaced by pattern +vardef Pfindcolor_(expr s)= + save Pfirst_, Plast_; + numeric Pfirst_, Plast_; + Pfirst_=Plast_=0; + for i=0 upto 255: + if substring(i,i+1) of s=":": + if Pfirst_=0: + Pfirst_:=i+1; + else: + Plast_:=i; + fi; + fi; + exitif Plast_<>0; + endfor; + scantokens (substring (Pfirst_,Plast_) of s) +enddef; + +%%%%%%%%%%%%%% User interface macros + +% Define BoundingBox of pattern +vardef patternbbox(expr a)(text b)= +% save Plft_, Plow_, Prt_, Pup_, Pi_, Pz_; +% numeric Plft_, Plow_, Prt_, Pup_, Pi_, Pz_[]; + save Pi_, Pz_; + numeric Pi_, Pz_[]; + if pair a: + Plft_:=min(xpart(a),xpart(b)); Plow_:=min(ypart(a),ypart(b)); + Prt_:=max(xpart(a),xpart(b)); Pup_:=max(ypart(a),ypart(b)); + else: + Pi_=1; + for t=b: + Pz_[Pi_]=t; + Pi_:=Pi_+1; + endfor; + Plft_:=min(a,Pz_2); Plow_:=min(Pz_1,Pz_3); + Prt_:=max(a,Pz_2); Pup_:=max(Pz_1,Pz_3); + fi; + + PmakeBB_; +enddef; + +def beginpattern(suffix name)= + numeric PXStep_, PYStep_; + numeric Plow_, Plft_, Pup_, Prt_; + numeric PColor_; + Pmatrix_:=" matrix "; + + % Declare variable in which the pattern definition will be stored + string name; + Pname_:=str name; + + Pnum_:=Pnum_+1; + + % Use the largest available picture number (charcode) + % for storing the body od patten PaintProc + beginfig(Pmax_charcode_); +enddef; + +def endpattern= + if unknown PBBox_: + Pfindbounds_; + fi; + endfig; + Psteps_; + + begingroup; + save Punknown_, Ppattern_; + string Punknown_, Ppattern_; + + Ppattern_=PmakePattern_(Pname_); + % free used charcode + Pcharcode_[charcode]:=whatever; + PBBox_:=Punknown_; + Pdefs_:=""; + % Assign pattern to string variable + scantokens(Pname_ & "=Ppattern_;"); + endgroup; +enddef; + +primarydef p withpattern s= + hide( + if not P_dict_: + special "/MPP 100 dict def"; + special "/MPPshow {exch findfont exch scalefont setfont show}bind def"; + special "/fill { MPP currentgray known " & char 10 + & " { MPP currentgray get setpattern fill } { fill } " & char 10 + & " ifelse } bind def"; + special "/fshow { MPP currentgray known " & char 10 + & " { MPP currentgray get setpattern MPPshow } { MPPshow } " & char 10 + & " ifelse } bind def"; + P_dict_:=true; + fi; + Pc_:=Pfindcolor_(s); + % write definition of pattern used in picture + % but not yet written to output file; + if unknown Pwritten_[Pc_]: + Psplit_and_write_(s); + Pwritten_[Pc_]:=1; + fi; + if not P_used_already_: + batchmode; + message "Pattern:" & decimal charcode; + errorstopmode; + P_used_already_:=true; + fi; + %show p; + ) + p withcolor Pc_*white +enddef; + +def patterntransform expr t= + Pmatrix_ := "[ " & decimal xxpart t + & " " & decimal yxpart t + & " " & decimal xypart t + & " " & decimal yypart t + & " " & decimal xpart t + & " " & decimal ypart t & " ]"; +% show Pmatrix_; +enddef; + +def patternxstep expr t= + show t; + PXStep_ = t; +enddef; + +def patternystep expr t= + show t; + PYStep_ = t; +enddef; + +def patternstep text t= + show t; + if pair t: + PXStep_ = xpart t; + PYStep_ = ypart t; + else: + (PXStep_,PYStep_)=t; + fi; +enddef; + +def patterncolor expr t= + show t; + PColor_ = t; +enddef; |