SourceBrowser

mp-shap.mpxl /size: 10 Kb last modification: 2021-10-28 13:50
1%D \module
2%D   [       file=mp-shap.mpiv,
3%D        version=2000.05.31,
4%D          title=\CONTEXT\ \METAPOST\ graphics,
5%D       subtitle=shapes,
6%D         author=Hans Hagen,
7%D           date=\currentdate,
8%D      copyright={PRAGMA ADE \& \CONTEXT\ Development Team}]
9%C
10%C This module is part of the \CONTEXT\ macro||package and is
11%C therefore copyrighted by \PRAGMA. See licen-en.pdf for
12%C details.
13
14if known metafun_loaded_shap : endinput ; fi ;
15
16newinternal boolean metafun_loaded_shap ; metafun_loaded_shap := true ; immutable metafun_loaded_shap ;
17
18path predefined_shapes[] ;
19
20def start_predefined_shape_definition =
21
22    begingroup ;
23
24    save xradius, yradius, xxradius, yyradius ;
25    save ll, lr, ur, ul, llx, lly, lrx, lry, urx, ury, ulx, uly, llxx, llyy, lrxx, lryy, urxx, uryy, ulxx, ulyy, lc, rc, tc, bc ;
26
27    numeric xradius, yradius, xxradius, yyradius ;
28    pair ll, lr, ur, ul, llx, lly, lrx, lry, urx, ury, ulx, uly, llxx, llyy, lrxx, lryy, urxx, uryy, ulxx, ulyy, lc, rc, tc, bc ;
29
30    xradius  := .15 ;
31    yradius  := .15 ;
32    xxradius := .10 ;
33    yyradius := .10 ;
34
35    ll       := llcorner (unitsquare shifted (-.5,-.5)) ;
36    lr       := lrcorner (unitsquare shifted (-.5,-.5)) ;
37    ur       := urcorner (unitsquare shifted (-.5,-.5)) ;
38    ul       := ulcorner (unitsquare shifted (-.5,-.5)) ;
39
40    llx      := ll shifted (xradius,0)  ;
41    lly      := ll shifted (0,yradius)  ;
42
43    lrx      := lr shifted (-xradius,0) ;
44    lry      := lr shifted (0,yradius)  ;
45
46    urx      := ur shifted (-xradius,0) ;
47    ury      := ur shifted (0,-yradius) ;
48
49    ulx      := ul shifted (xradius,0)  ;
50    uly      := ul shifted (0,-yradius) ;
51
52    llxx     := ll shifted (xxradius,0)  ;
53    llyy     := ll shifted (0,yyradius)  ;
54
55    lrxx     := lr shifted (-xxradius,0) ;
56    lryy     := lr shifted (0,yyradius)  ;
57
58    urxx     := ur shifted (-xxradius,0) ;
59    uryy     := ur shifted (0,-yyradius) ;
60
61    ulxx     := ul shifted (xxradius,0)  ;
62    ulyy     := ul shifted (0,-yyradius) ;
63
64    lc       := ll shifted (0,.5) ;
65    rc       := lr shifted (0,.5) ;
66    tc       := ul shifted (.5,0) ;
67    bc       := ll shifted (.5,0) ;
68
69enddef ;
70
71def stop_predefined_shape_definition =
72
73    endgroup ;
74
75enddef ;
76
77% this can be delayed
78
79start_predefined_shape_definition ;
80
81    predefined_shapes[ 0] := (origin--cycle) ;
82    predefined_shapes[ 5] := (llx--lrx{right}...rc...{left}urx--ulx{left}...lc...{right}cycle) ;
83    predefined_shapes[ 6] := (ll--lrx{right}...rc...{left}urx--ul--cycle) ;
84    predefined_shapes[ 7] := (ll--lrx{right}...rc...{left}urx--ul--cycle) rotatedaround(origin,180) ;
85    predefined_shapes[ 8] := (lr--ury{up}...tc...{down}uly--ll--cycle) ;
86    predefined_shapes[ 9] := (lr--ury{up}...tc...{down}uly--ll--cycle) rotatedaround(origin,180) ;
87    predefined_shapes[10] := (ll--lr--ur--ul--ll--ur--ul--ll--cycle) ;
88    predefined_shapes[11] := (ll--lr--ur--ul--ll--lr--ul--ll--cycle) ;
89    predefined_shapes[12] := (ll--lrx--ur--ulx--cycle) ;
90    predefined_shapes[13] := (llx--lr--urx--ul--cycle) ;
91    predefined_shapes[14] := (lly--bc--lry--ury--tc--uly--cycle) ;
92    predefined_shapes[15] := (llx--lrx--rc--urx--ulx--lc--cycle) ;
93    predefined_shapes[16] := (ll--lrx--rc--urx--ul--cycle) ;
94    predefined_shapes[17] := (ll--lrx--rc--urx--ul--cycle) rotatedaround(origin,180) ;
95    predefined_shapes[18] := (lr--ury--tc--uly--ll--cycle) ;
96    predefined_shapes[19] := (lr--ury--tc--uly--ll--cycle) rotatedaround(origin,180) ;
97    predefined_shapes[20] := (ll--lr--ur--ul--ll--llxx--ulxx--ul--ll--lr--ur--urxx--lrxx--cycle) ;
98    predefined_shapes[21] := (ul--ll--lr--ur--ul--ulyy--uryy--ur--ul--ll--lr--lryy--llyy--cycle) ;
99    predefined_shapes[22] := (ll--lrx--lry--ur--ulx--uly--cycle) ;
100    predefined_shapes[23] := (llx--lr--ury--urx--ul--lly--cycle) ;
101    predefined_shapes[24] := (ll--lr--ur--ul--cycle) ;
102    predefined_shapes[25] := (llx--lrx--lry--ury--urx--ulx--uly--lly--cycle) ;
103    predefined_shapes[26] := (ll--lrx--lry--ur--ul--cycle) ;
104    predefined_shapes[27] := (ll--lr--ury--urx--ul--cycle) rotatedaround(origin,180) ;
105    predefined_shapes[28] := (ll--lr--ury--urx--ul--cycle) ;
106    predefined_shapes[29] := (ll--lrx--lry--ur--ul--cycle) rotatedaround(origin,180) ;
107    predefined_shapes[30] := (bc{right}...{up}rc...tc{left}...{down}lc...{right}bc & bc--tc & tc{left}..{down}lc & lc--rc & rc{up}..tc{left}...{down}lc...{right}bc & cycle) rotated 45;
108    predefined_shapes[31] := (bc{right}...{up}rc...tc{left}...{down}lc...{right}bc & bc--tc & tc{left}..{down}lc & lc--rc & rc{up}..tc{left}...{down}lc...{right}bc & cycle) ;
109    predefined_shapes[32] := (ll{right}...{right}lry--ur--ul--ll--cycle) ;
110    predefined_shapes[33] := (ll{right}...{right}lry--ur--ul--ll--cycle--ul--ulx--ulx shifted(0,yyradius)--ur shifted(yyradius,yyradius)--lry shifted(yyradius,yyradius)--lry shifted(0,yyradius)--ur--ul--cycle ) ;
111    predefined_shapes[34] := (uly..tc..ury & ury..tc shifted (0,-2yradius)..uly & uly--lly & lly..bc..lry & lry--ury & ury..tc shifted (0,-2yradius)..uly & cycle ) ;
112    predefined_shapes[35] := (bc{right}...rc{up}...tc{left}...lc{down}...cycle) ;
113    predefined_shapes[36] := (ul--tc{right}..rc{down}..{left}bc--ll & ll..(xpart llx, ypart lc)..ul & cycle) ;
114    predefined_shapes[37] := (ul--tc{right}..rc{down}..{left}bc--ll & ll..(xpart llx, ypart lc)..ul & cycle) rotatedaround(origin,180) ;
115    predefined_shapes[38] := (ll--lc{up}..tc{right}..{down}rc--lr & lr..(xpart bc, ypart lly)..ll & cycle) ;
116    predefined_shapes[39] := (ll--lc{up}..tc{right}..{down}rc--lr & lr..(xpart bc, ypart lly)..ll & cycle) rotatedaround(origin,180) ;
117    predefined_shapes[40] := (ll--lr--ur--ul--ll--ur--ul--ll--lr--ul--ll--cycle) ;
118    predefined_shapes[41] := (ll--lr--ur--ul--ll--lr--rc--lc--ll--bc--tc--ul--ll & cycle) ;
119    predefined_shapes[42] := (ll--lr--origin shifted (+epsilon,0)--ur--ul--origin shifted (-epsilon,0)--cycle) ;
120    predefined_shapes[43] := (ll--ul--origin shifted (0,+epsilon)--ur--lr--origin shifted (0,-epsilon)--cycle) ;
121    predefined_shapes[45] := (bc--rc--tc--lc--cycle) ;
122    predefined_shapes[46] := (ll--ul--rc--cycle) ;
123    predefined_shapes[47] := (ll--ul--rc--cycle) rotatedaround(origin,180) ;
124    predefined_shapes[48] := (ul--ur--bc--cycle) rotatedaround(origin,180) ;
125    predefined_shapes[49] := (ul--ur--bc--cycle) ;
126    predefined_shapes[56] := (ll--lry--ury--ul--cycle) ;
127    predefined_shapes[57] := (ll--lry--ury--ul--cycle) rotatedaround(origin,180) ;
128    predefined_shapes[58] := (ll--ulx--urx--lr--cycle) ;
129    predefined_shapes[59] := (ll--ulx--urx--lr--cycle) rotatedaround(origin,180);
130    predefined_shapes[66] := (rc--origin shifted ( epsilon,0) --cycle & rc--origin--cycle ) ;
131    predefined_shapes[67] := (lc--origin shifted (-epsilon,0) --cycle & lc--origin--cycle ) ;
132    predefined_shapes[68] := (tc--origin shifted (0, epsilon) --cycle & tc--origin--cycle ) ;
133    predefined_shapes[69] := (bc--origin shifted (0,-epsilon) --cycle & bc--origin--cycle ) ;
134    predefined_shapes[75] := (lly--lry--ury--uly--cycle) rotatedaround(origin,180) ;
135    predefined_shapes[76] := (ll--lr--ur--uly--cycle) rotatedaround(origin,180) ;
136    predefined_shapes[77] := (ll--lr--ury--ul--cycle) rotatedaround(origin,180) ;
137    predefined_shapes[78] := (lly--lr--ur--ul--cycle) rotatedaround(origin,180) ;
138    predefined_shapes[79] := (ll--lry--ur--ul--cycle) rotatedaround(origin,180) ;
139
140    numeric predefined_shapes_xradius  ; predefined_shapes_xradius  := xradius  ;
141    numeric predefined_shapes_yradius  ; predefined_shapes_yradius  := yradius  ;
142    numeric predefined_shapes_xxradius ; predefined_shapes_xxradius := xxradius ;
143    numeric predefined_shapes_yyradius ; predefined_shapes_yyradius := yyradius ;
144
145stop_predefined_shape_definition ;
146
147vardef some_shape_path (expr type) =
148    if known predefined_shapes[type] : predefined_shapes[type] else : predefined_shapes[24] fi
149enddef ;
150
151def some_shape (expr shape_type, shape_width, shape_height, shape_linewidth, shape_linecolor, shape_fillcolor) =
152    begingroup ;
153        save p ; path p ;
154        p := some_shape_path (shape_type) xscaled shape_width yscaled shape_height ;
155        pickup pencircle scaled shape_linewidth ;
156        fill p withcolor shape_fillcolor ;
157        draw p withcolor shape_linecolor ;
158    endgroup ;
159enddef ;
160
161% maybe:
162%
163%     if t>1 : % normal shape
164%         path pp ; pp := some_shape_path(t) xyscaled(bbwidth(p), bbheight(p)) ;
165%         pp := pp shifted - center pp shifted center p ;
166%         fill pp withcolor fc ;
167%         draw pp withpen pencircle scaled lw withcolor lc ;
168
169vardef drawpredefinedshape (expr t, p, lw, lc, fc) =
170    save pp ;
171    if t > 1 : % normal shape
172        path pp ;
173        pp := some_shape_path(t) xyscaled(bbwidth(p), bbheight(p)) shifted center p ;
174        fill pp withcolor fc ;
175        draw pp withpen pencircle scaled lw withcolor lc ;
176    elseif t = 1 : % background only
177        path pp ;
178        pp := fullsquare xyscaled(bbwidth(p), bbheight(p)) shifted center p ;
179        fill pp withcolor fc ;
180    else : % dimensions only
181        picture pp ; pp := nullpicture ;
182        setbounds pp to fullsquare xyscaled(bbwidth(p), bbheight(p)) shifted center p ;
183        draw pp ;
184    fi ;
185enddef ;
186
187vardef drawpredefinedline (expr t, p, lw, lc) =
188    if (t>0) and (length(p)>1) :
189        saveoptions ;
190        drawoptions(withpen pencircle scaled lw withcolor lc) ;
191        draw p ;
192        if     t =  1 :
193            draw arrowheadonpath(p,1) ;
194        elseif t =  2 :
195            draw arrowheadonpath(reverse p,1) ;
196        elseif t =  3 :
197            for $ = p,reverse p :
198                draw arrowheadonpath($,1) ;
199            endfor ;
200        elseif t = 11 :
201            draw arrowheadonpath(p,1/2) ;
202        elseif t = 12 :
203            draw arrowheadonpath(reverse p,1/2) ;
204        elseif t = 13 :
205            for $=p,reverse p :
206                draw arrowheadonpath($,1) ;
207            endfor ;
208            for $=p,reverse p :
209                draw arrowheadonpath($,3/4) ;
210            endfor ;
211        elseif t = 21 :
212            for $=1/5,1/2,4/5 :
213                draw arrowheadonpath(p,$) ;
214            endfor ;
215        elseif t = 22 :
216            for $=1/5,1/2,4/5 :
217                draw arrowheadonpath(reverse p,$) ;
218            endfor ;
219        elseif t = 23 :
220            for $=p,reverse p :
221                draw arrowheadonpath($,1/4) ;
222            endfor ;
223        fi ;
224    fi ;
225enddef ;
226
227let drawshape = drawpredefinedshape ;
228let drawline  = drawpredefinedline  ;
229
Source Browser ?
