summaryrefslogtreecommitdiff
path: root/Master/texmf-dist/metapost/mpattern/mpattern.mp
blob: 2b7cd79e38b0a1e5048a684570d38aa295d182ba (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
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;