summaryrefslogtreecommitdiff
path: root/metapost
diff options
context:
space:
mode:
Diffstat (limited to 'metapost')
-rw-r--r--metapost/context/metafun.mp3
-rw-r--r--metapost/context/mp-char.mp6
-rw-r--r--metapost/context/mp-grph.mp241
-rw-r--r--metapost/context/mp-spec.mp83
-rw-r--r--metapost/context/mp-tool.mp306
5 files changed, 606 insertions, 33 deletions
diff --git a/metapost/context/metafun.mp b/metapost/context/metafun.mp
index 802264351..e8fd1a762 100644
--- a/metapost/context/metafun.mp
+++ b/metapost/context/metafun.mp
@@ -20,7 +20,7 @@
%D \type {context} (the \TEX\ one) could lead to lost strings
%D (and as a result in buggy boundingbox and special
%D handling). By using the name \type {metatex} we make sure
-%D %D that we use (unless overloaded) the settings of \type
+%D that we use (unless overloaded) the settings of \type
%D {mpost}.
if unknown ahangle :
@@ -37,5 +37,6 @@ input mp-text.mp ;
input mp-shap.mp ;
input mp-butt.mp ;
input mp-char.mp ;
+input mp-grph.mp ;
dump ; endinput .
diff --git a/metapost/context/mp-char.mp b/metapost/context/mp-char.mp
index 8c0d53f75..373200fc2 100644
--- a/metapost/context/mp-char.mp
+++ b/metapost/context/mp-char.mp
@@ -331,7 +331,7 @@ def collapse_points =
fi ;
enddef ;
-vardef smoothed (expr a,b) =
+vardef smooth_connection (expr a,b) =
sx := connection_smooth_size/grid_width ;
sy := connection_smooth_size/grid_height ;
if ypart a = ypart b :
@@ -377,9 +377,9 @@ vardef connection_path =
if reverse_connection : reverse fi (xypoints[1]--
for i=2 upto xypoint-1 :
if smooth :
- smoothed(xypoints[i],xypoints[i-1]) ..
+ smooth_connection(xypoints[i],xypoints[i-1]) ..
controls xypoints[i] and xypoints[i] ..
- smoothed(xypoints[i],xypoints[i+1]) --
+ smooth_connection(xypoints[i],xypoints[i+1]) --
else :
xypoints[i]--
fi
diff --git a/metapost/context/mp-grph.mp b/metapost/context/mp-grph.mp
new file mode 100644
index 000000000..26202d61a
--- /dev/null
+++ b/metapost/context/mp-grph.mp
@@ -0,0 +1,241 @@
+%D \module
+%D [ file=mp-grph.mp,
+%D version=2000.12.14,
+%D title=\CONTEXT\ \METAPOST\ graphics,
+%D subtitle=graphic text support,
+%D author=Hans Hagen,
+%D date=\currentdate,
+%D copyright={PRAGMA / Hans Hagen \& Ton Otten}]
+%C
+%C This module is part of the \CONTEXT\ macro||package and is
+%C therefore copyrighted by \PRAGMA. See licen-en.pdf for
+%C details.
+
+%D Under construction.
+
+if unknown context_tool : input mp-tool ; fi ;
+if known context_grph : endinput ; fi ;
+
+boolean context_grph ; context_grph := true ;
+
+string CRLF ; CRLF := char 10 & char 13 ;
+
+picture _currentpicture_ ;
+
+def protectgraphicmacros =
+ save showtext ;
+ save beginfig ; let beginfig = begingraphictextfig ;
+ save endfig ; let endfig = endgraphictextfig ;
+ save end ; let end = relax ;
+ interim prologues := prologues ;
+ interim linecap := butt ;
+ interim linejoin := mitered ;
+enddef ;
+
+numeric currentgraphictext ; currentgraphictext := 0 ;
+string graphictextformat ; graphictextformat := "plain" ;
+string graphictextstring ; graphictextstring := "" ;
+string graphictextfile ; graphictextfile := "dummy.mpo" ;
+
+def savegraphictext (expr str) =
+ graphictextfile := jobname & ".mpo" ;
+ if (graphictextstring<>"") :
+ write graphictextstring to graphictextfile ;
+ graphictextstring := "" ;
+ fi ;
+ write str to graphictextfile ;
+ let erasegraphictextfile = relax ;
+enddef ;
+
+def erasegraphictextfile =
+ graphictextfile := jobname & ".mpo" ;
+ write EOF to graphictextfile ;
+ let erasegraphictextfile = relax ;
+enddef ;
+
+extra_beginfig := extra_beginfig & "erasegraphictextfile ;" ;
+
+def begingraphictextfig (expr n) =
+ foundpicture := n ; scratchpicture := nullpicture ;
+enddef ;
+
+def endgraphictextfig =
+ if foundpicture = currentgraphictext :
+ expandafter endinput
+ else :
+ scratchpicture := nullpicture ;
+ fi ;
+enddef ;
+
+% def loadfigure (expr filename, n) =
+% begingroup ;
+% protectgraphicmacros ; % also save linewidth, color, options etc ?
+% save sp ; picture sp ; sp := currentpicture ;
+% save ok ; boolean ok ; ok := false ;
+% def beginfig (expr m) =
+% if n=m :
+% currentpicture := sp ; ok := true ;
+% def endfig = endinput ; enddef ;
+% else :
+% currentpicture := nullpicture ;
+% fi ;
+% enddef ;
+% let endfig = relax ;
+% readfile(filename) ;
+% if not ok : currentpicture := sp ; fi ;
+% endgroup ;
+% enddef ;
+
+def loadfigure primary filename =
+ doloadfigure (filename)
+enddef ;
+
+def doloadfigure (expr filename) text figureattributes =
+ begingroup ;
+ save figurenumber, figurepicture, number ;
+ numeric figurenumber ; figurenumber := 1 ;
+ picture figurepicture ; figurepicture := currentpicture ;
+ def number primary n = hide(figurenumber := n) enddef ;
+ protectgraphicmacros ;
+ currentpicture := nullpicture ;
+ def beginfig (expr n) =
+ currentpicture := nullpicture ;
+ if figurenumber=n : let endfig = endinput ; fi ;
+ enddef ;
+ let endfig = relax ;
+ readfile(filename) ;
+ currentpicture := currentpicture shifted -llcorner currentpicture ;
+ addto figurepicture also currentpicture figureattributes ;
+ currentpicture := figurepicture ;
+ endgroup ;
+enddef ;
+
+def graphictext primary t =
+ dographictext(t)
+enddef ;
+
+def dographictext (expr t) text x_op_x =
+ begingroup ;
+ protectgraphicmacros ;
+ if graphictextformat<>"" :
+ graphictextstring :=
+ "% format=" & graphictextformat & CRLF & graphictextstring ;
+ graphictextformat := "" ;
+ fi ;
+ let normalwithshade = withshade ;
+ save foundpicture, scratchpicture, str ;
+ save fill, draw, withshade, reversefill, outlinefill ;
+ numeric foundpicture ; picture scratchpicture ; string str ;
+ currentgraphictext := currentgraphictext + 1 ;
+ savegraphictext ("\startTEXpage[scale=10000]" & t & "\stopTEXpage") ;
+ def draw expr p =
+ addto scratchpicture doublepath p withpen currentpen ;
+ enddef ;
+ def fill expr p =
+ addto scratchpicture contour p withpen currentpen ;
+ enddef ;
+ def f_op_f = enddef ; boolean f_color ; f_color := false ;
+ def d_op_d = enddef ; boolean d_color ; d_color := false ;
+ def s_op_s = enddef ; boolean s_color ; s_color := false ;
+ boolean reverse_fill ; reverse_fill := false ;
+ boolean outline_fill ; outline_fill := false ;
+ def reversefill =
+ hide(reverse_fill := true )
+ enddef ;
+ def outlinefill =
+ hide(outline_fill := true )
+ enddef ;
+ def withshade primary c =
+ hide(def s_op_s = normalwithshade c enddef ; s_color := true )
+ enddef ;
+ def withfillcolor primary c =
+ hide(def f_op_f = withcolor c enddef ; f_color := true )
+ enddef ;
+ def withdrawcolor primary c =
+ hide(def d_op_d = withcolor c enddef ; d_color := true )
+ enddef ;
+ scratchpicture := nullpicture ;
+ addto scratchpicture doublepath origin x_op_x ; % pre-roll
+ for i within scratchpicture : % Below here is a dirty tricky test!
+ if (urcorner dashpart i) = origin : outline_fill := false ; fi ;
+ endfor ;
+ scratchpicture := nullpicture ;
+ readfile(jobname & ".mpy") ;
+ scratchpicture := (scratchpicture shifted -llcorner scratchpicture) scaled (1/10) ;
+ if not d_color and not f_color : d_color := true ; fi
+ if s_color : d_color := false ; f_color := false ; fi ;
+ if d_color and not reverse_fill :
+ for i within scratchpicture :
+ if f_color and outline_fill :
+ addto currentpicture doublepath pathpart i _op_ x_op_x f_op_f
+ dashed nullpicture ;
+ fi ;
+ if filled i :
+ addto currentpicture doublepath pathpart i _op_ x_op_x d_op_d ;
+ fi ;
+ endfor ;
+ fi ;
+ if f_color :
+ for i within scratchpicture :
+ if filled i :
+ addto currentpicture contour pathpart i _op_ x_op_x f_op_f
+ withpen pencircle scaled 0 ;
+ fi ;
+ endfor ;
+ fi ;
+ if d_color and reverse_fill :
+ for i within scratchpicture :
+ if filled i :
+ addto currentpicture doublepath pathpart i _op_ x_op_x d_op_d ;
+ fi ;
+ endfor ;
+ fi ;
+ if s_color :
+ for i within scratchpicture :
+ if filled i :
+ addto currentpicture contour pathpart i _op_ x_op_x s_op_s ;
+ fi ;
+ endfor ;
+ else :
+ for i within scratchpicture :
+ if stroked i :
+ addto currentpicture doublepath pathpart i _op_ x_op_x d_op_d ;
+ fi ;
+ endfor ;
+ fi ;
+ endgroup ;
+enddef ;
+
+def resetgraphictextdirective =
+ graphictextstring := "" ;
+enddef ;
+
+def graphictextdirective text t =
+ graphictextstring := graphictextstring & t & CRLF ;
+enddef ;
+
+endinput
+
+% example
+
+input mp-grph ;
+
+ graphictextformat := "context" ;
+% graphictextformat := "plain" ;
+% graphictextformat := "latex" ; graphictextdirective "\documentclass[]{article}" ;
+
+beginfig (1) ;
+ graphictext
+ "\vbox{\hsize10cm \input tufte }"
+ scaled 8
+ withdrawcolor blue
+ withfillcolor red
+ withpen pencircle scaled 2pt ;
+endfig ;
+
+beginfig(1) ;
+ loadfigure "gracht.mp" rotated 20 ;
+ loadfigure "koe.mp" number 1 scaled 2 ;
+endfig ;
+
+end
diff --git a/metapost/context/mp-spec.mp b/metapost/context/mp-spec.mp
index 7fa743cbc..b23164c14 100644
--- a/metapost/context/mp-spec.mp
+++ b/metapost/context/mp-spec.mp
@@ -144,4 +144,87 @@ primarydef p withshade sc =
p withcolor (_special_signal_/1000,_color_counter_/1000,sc/1000)
enddef ;
+%D Figure inclusion.
+
+numeric cef ; cef := 0 ;
+
+def externalfigure primary filename =
+ doexternalfigure (filename)
+enddef ;
+
+def doexternalfigure (expr filename) text transformation =
+ begingroup ; save p, t ; picture p ; transform t ;
+ p := nullpicture ; t := identity transformation ;
+ flush_special(10, 9,
+ dddecimal (xxpart t, yxpart t, xypart t) & " " &
+ dddecimal (yypart t, xpart t, ypart t) & " " & filename) ;
+ addto p contour unitsquare scaled 0 ;
+ setbounds p to unitsquare transformed t ;
+ _color_counter_ := _color_counter_ + 1 ; cef := cef + 1 ;
+ draw p withcolor (_special_signal_/1000,_color_counter_/1000,cef/1000) ;
+ endgroup ;
+enddef ;
+
+%D Experimental:
+
+numeric currenthyperlink ; currenthyperlink := 0 ;
+
+def hyperlink primary t = dohyperlink(t) enddef ;
+def hyperpath primary t = dohyperpath(t) enddef ;
+
+def dohyperlink (expr destination) text transformation =
+ begingroup ; save somepath ; path somepath ;
+ somepath := fullsquare transformation ;
+ dohyperpath(destination) somepath ;
+ endgroup ;
+enddef ;
+
+def dohyperpath (expr destination) expr somepath =
+ begingroup ;
+ flush_special(20, 7,
+ ddecimal (xpart llcorner somepath, ypart llcorner somepath) & " " &
+ ddecimal (xpart urcorner somepath, ypart urcorner somepath) & " " & destination) ;
+ _color_counter_ := _color_counter_ + 1 ;
+ currenthyperlink := currenthyperlink + 1 ;
+ fill boundingbox unitsquare scaled 0
+ withcolor
+ (_special_signal_/1000,_color_counter_/1000,currenthyperlink/1000) ;
+ endgroup ;
+enddef ;
+
+% \setupinteraction[state=start]
+% \setupcolors [state=start]
+%
+% Hello There! \blank
+%
+% \startMPcode
+% pickup pencircle scaled 5 ;
+% draw fullcircle scaled 4cm withcolor red ;
+% hyperpath "nextpage" boundingbox currentpicture ;
+% draw origin withcolor blue ;
+% \stopMPcode
+%
+% \blank Does it work or not?
+%
+% \startMPcode
+% pickup pencircle scaled 5 ;
+% draw fullcircle scaled 4cm withcolor red ;
+% hyperpath "nextpage" fullcircle scaled 4cm ;
+% draw origin withcolor blue ;
+% draw fullcircle scaled 4cm shifted (1cm,1cm);
+% \stopMPcode
+%
+% \blank Does it work or not? \page Hello There! \blank
+%
+% \startMPcode
+% pickup pencircle scaled 5 ;
+% draw fullcircle scaled 2cm shifted (-2cm,-1cm) ;
+% draw fullcircle scaled 3cm shifted (2cm,1cm) withcolor red ;
+% draw fullcircle scaled 1cm ;
+% hyperlink "previouspage" scaled 3cm shifted (2cm,1cm) ;
+% draw origin withcolor blue ;
+% \stopMPcode
+%
+% \blank Does it work or not?
+
endinput ;
diff --git a/metapost/context/mp-tool.mp b/metapost/context/mp-tool.mp
index a3ad4927e..958cc3903 100644
--- a/metapost/context/mp-tool.mp
+++ b/metapost/context/mp-tool.mp
@@ -107,7 +107,7 @@ def stopsavingdata =
enddef ;
%D Instead of a keystroke eating save and allocation
-%D sequence, you can use the \quote {new} alternatives to
+%D sequence, you can use the \citeer {new} alternatives to
%D save and allocate in one command.
def newcolor text v = forsuffixes i=v : save i ; color i ; endfor ; enddef ;
@@ -527,6 +527,13 @@ enddef ;
% (-width/2,+height/2)..(-width/2-offset,0)..(-width/2,-height/2)..cycle)
%enddef ;
+vardef roundedsquare (expr width, height, offset) =
+ ((offset,0)--(width-offset,0){right} ..
+ (width,offset)--(width,height-offset){up} ..
+ (width-offset,height)--(offset,height){left} ..
+ (0,height-offset)--(0,offset){down} .. cycle)
+enddef ;
+
%D Some colors.
color cyan ; cyan = (0,1,1) ;
@@ -635,13 +642,32 @@ primarydef p randomshifted s =
endgroup
enddef ;
+%primarydef p randomized s =
+% for i=0 upto length(p)-1 :
+% ((point i of p) randomshifted s) .. controls
+% ((postcontrol i of p) randomshifted s) and
+% ((precontrol (i+1) of p) randomshifted s) ..
+% endfor cycle
+%enddef ;
+
primarydef p randomized s =
- for i=0 upto length(p)-1 :
- ((point i of p) randomshifted s) .. controls
- ((postcontrol i of p) randomshifted s) and
- ((precontrol (i+1) of p) randomshifted s) ..
- endfor cycle
-enddef ;
+ (if path p :
+ for i=0 upto length(p)-1 :
+ ((point i of p) randomshifted s) .. controls
+ ((postcontrol i of p) randomshifted s) and
+ ((precontrol (i+1) of p) randomshifted s) ..
+ endfor
+ if cycle p :
+ cycle
+ else :
+ ((point length(p) of p) randomshifted s)
+ fi
+ elseif pair p :
+ p randomshifted s
+ else :
+ p + uniformdeviate s
+ fi)
+enddef ;
%D Rather fundamental.
@@ -982,12 +1008,31 @@ vardef thefreelabel (expr str, loc, ori) =
setbounds s to boundingbox s enlarged freelabeloffset ;
p := fullcircle scaled (2*length(loc-ori)) shifted ori ;
q := freesquare xyscaled (urcorner s - llcorner s) ;
- l := point (xpart (p intersectiontimes (ori--loc))) of q ;
-setbounds s to boundingbox s enlarged -freelabeloffset ; % new
+% l := point (xpart (p intersectiontimes (ori--loc))) of q ;
+ l := point xpart (p intersectiontimes
+ (ori--((1+eps)*arclength(ori--loc)*unitvector(loc-ori)))) of q ;
+ setbounds s to boundingbox s enlarged -freelabeloffset ; % new
%draw boundingbox s shifted -l withpen pencircle scaled .5pt withcolor red ;
(s shifted -l)
enddef ;
+% better?
+
+vardef thefreelabel (expr str, loc, ori) =
+ save s, p, q, l ; picture s ; path p, q ; pair l ;
+ interim labeloffset := freelabeloffset ;
+ s := if string str : thelabel(str,loc) else : str shifted -center str shifted loc fi ;
+ setbounds s to boundingbox s enlarged freelabeloffset ;
+ p := fullcircle scaled (2*length(loc-ori)) shifted ori ;
+ q := freesquare xyscaled (urcorner s - llcorner s) ;
+ l := point xpart (p intersectiontimes (ori--loc shifted (loc-ori))) of q ;
+ setbounds s to boundingbox s enlarged -freelabeloffset ; % new
+ draw boundingbox s shifted -l withpen pencircle scaled .5pt withcolor red ;
+ (s shifted -l)
+enddef ;
+
+
+
vardef freelabel (expr str, loc, ori) =
draw thefreelabel(str,loc,ori) ;
enddef ;
@@ -1006,35 +1051,85 @@ enddef ;
numeric anglelength ; anglelength := 20pt ;
numeric anglemethod ; anglemethod := 1 ;
-vardef anglebetween (expr a, b, str) = % path path string
+% vardef anglebetween (expr a, b, str) = % path path string
+% save pointa, pointb, common, middle, offset ;
+% pair pointa, pointb, common, middle, offset ;
+% save curve ; path curve ;
+% save where ; numeric where ;
+% if round point 0 of a = round point 0 of b :
+% common := point 0 of a ;
+% else :
+% common := a intersectionpoint b ;
+% fi ;
+% pointa := point anglelength on a ;
+% pointb := point anglelength on b ;
+% where := turningnumber (common--pointa--pointb--cycle) ;
+% middle := ((common--pointa) rotatedaround (pointa,-where*90))
+% intersectionpoint
+% ((common--pointb) rotatedaround (pointb, where*90)) ;
+% if anglemethod = 0 :
+% curve := pointa{unitvector(middle-pointa)}.. pointb;
+% middle := point .5 along curve ;
+% curve := common ;
+% elseif anglemethod = 1 :
+% curve := pointa{unitvector(middle-pointa)}.. pointb;
+% middle := point .5 along curve ;
+% elseif anglemethod = 2 :
+% middle := common rotatedaround(.5[pointa,pointb],180) ;
+% curve := pointa--middle--pointb ;
+% elseif anglemethod = 3 :
+% curve := pointa--middle--pointb ;
+% elseif anglemethod = 4 :
+% curve := pointa..controls middle..pointb ;
+% middle := point .5 along curve ;
+% fi ;
+% draw thefreelabel(str, middle, common) withcolor black ;
+% curve
+% enddef ;
+
+vardef anglebetween (expr a, b, str) = % path path string
save pointa, pointb, common, middle, offset ;
pair pointa, pointb, common, middle, offset ;
- save curve ; path curve ;
- save where ; numeric where ;
- if round point 0 of a = round point 0 of b :
+ save curve ; path curve ;
+ save where ; numeric where ;
+ if round point 0 of a = round point 0 of b :
common := point 0 of a ;
else :
common := a intersectionpoint b ;
- fi ;
- pointa := point anglelength on a ;
- pointb := point anglelength on b ;
- where := turningnumber (common--pointa--pointb--cycle) ;
- if anglemethod = 1 :
- curve := pointa{pointa rotated (where*90)} .. pointb ;
- middle := point .5 along curve ;
- elseif anglemethod = 2 :
- middle := common rotatedaround(.5[pointa,pointb],180) ;
- curve := pointa--middle--pointb ;
- elseif anglemethod = 3 :
- middle := ((common--pointa) rotatedaround (pointa,-where*90))
- intersectionpoint
- ((common--pointb) rotatedaround (pointb, where*90)) ;
- curve := pointa--middle--pointb ;
- fi ;
+ fi ;
+ pointa := point anglelength on a ;
+ pointb := point anglelength on b ;
+ where := turningnumber (common--pointa--pointb--cycle) ;
+ middle := (reverse(common--pointa) rotatedaround (pointa,-where*90))
+ intersection_point
+ (reverse(common--pointb) rotatedaround (pointb, where*90)) ;
+ if not intersection_found :
+ middle := point .5 along
+ ((reverse(common--pointa) rotatedaround (pointa,-where*90)) --
+ ( (common--pointb) rotatedaround (pointb, where*90))) ;
+ fi ;
+ if anglemethod = 0 :
+ curve := pointa{unitvector(middle-pointa)}.. pointb;
+ middle := point .5 along curve ;
+ curve := common ;
+ elseif anglemethod = 1 :
+ curve := pointa{unitvector(middle-pointa)}.. pointb;
+ middle := point .5 along curve ;
+ elseif anglemethod = 2 :
+ middle := common rotatedaround(.5[pointa,pointb],180) ;
+ curve := pointa--middle--pointb ;
+ elseif anglemethod = 3 :
+ curve := pointa--middle--pointb ;
+ elseif anglemethod = 4 :
+ curve := pointa..controls middle..pointb ;
+ middle := point .5 along curve ;
+ fi ;
draw thefreelabel(str, middle, common) withcolor black ;
curve
enddef ;
+
+
% Stack
picture currentpicturestack[] ;
@@ -1213,4 +1308,157 @@ enddef ;
def condition primary b = if b : "true" else : "false" fi enddef ;
+% undocumented
+
+primarydef p stretched s =
+ begingroup
+ save pp ; path pp ; pp := p scaled s ;
+ (pp shifted ((point 0 of p) - (point 0 of pp)))
+ endgroup
+enddef ;
+
+% yes or no, untested -)
+
+def xshifted expr dx = shifted(dx,0) enddef ;
+def yshifted expr dy = shifted(0,dy) enddef ;
+
+% also handy
+
+% right: str = readfrom ("abc" & ".def" ) ;
+% wrong: str = readfrom "abc" & ".def" ;
+
+def readfile (expr name) =
+ if (readfrom (name) <> EOF) :
+ scantokens("input " & name & " ")
+ fi
+enddef ;
+
+% permits redefinition of end in macro
+
+inner end ;
+
+% real fun
+
+color color_map[][][] ;
+
+%color_map_resolution := 1000 ;
+%
+%def r_color primary c = round(color_map_resolution*redpart c) enddef ;
+%def g_color primary c = round(color_map_resolution*greenpart c) enddef ;
+%def b_color primary c = round(color_map_resolution*bluepart c) enddef ;
+
+def r_color primary c = redpart c enddef ;
+def g_color primary c = greenpart c enddef ;
+def b_color primary c = bluepart c enddef ;
+
+def remapcolor(expr old, new) =
+ color_map[r_color old][g_color old][b_color old] := new ;
+enddef ;
+
+def remappedcolor(expr c) =
+ if known color_map[r_color c][g_color c][b_color c] :
+ color_map[r_color c][g_color c][b_color c]
+ else :
+ c
+ fi
+enddef ;
+
+let normalwithcolor = withcolor ;
+
+def remapcolors =
+ def withcolor primary c = normalwithcolor remappedcolor(c) enddef ;
+enddef ;
+
+def normalcolors =
+ let withcolor = normalwithcolor ;
+enddef ;
+
+def refill suffix c = do_repath (1) (c) enddef ;
+def redraw suffix c = do_repath (2) (c) enddef ;
+def recolor suffix c = do_repath (0) (c) enddef ;
+
+def do_repath (expr mode) (suffix c) text t =
+ begingroup ;
+ if mode=0 : save withcolor ; remapcolors ; fi ;
+ save _c_, _f_, _b_ ; picture _c_ ; color _f_ ; path _b_ ;
+ _c_ := c ; _b_ := boundingbox c ; c := nullpicture ;
+ for i within _c_ :
+ _f_ := (redpart i, greenpart i, bluepart i) ;
+ if bounded i :
+ setbounds c to pathpart i ;
+ elseif clipped i :
+ clip c to pathpart i ;
+ elseif stroked i :
+ addto c doublepath pathpart i
+ dashed dashpart i withpen penpart i
+ withcolor (redpart i, greenpart i, bluepart i)
+ if mode=2 : t fi ;
+ elseif filled i :
+ addto c contour pathpart i
+ withcolor (redpart i, greenpart i, bluepart i)
+ if mode=1 : t if _f_ = background : withcolor background fi fi ;
+ fi ;
+ endfor ;
+ setbounds c to _b_ ;
+ endgroup ;
+enddef ;
+
+% After a question of Denis on how to erase a z variable, Jacko
+% suggested to assign whatever to x and y. So a clearz
+% variable can be defined as:
+%
+% vardef clearz@# =
+% x@# := whatever ;
+% y@# := whatever ;
+% enddef ;
+%
+% but Jacko suggested a redefinition of clearxy:
+%
+% def clearxy text s =
+% clearxy_index_:=0;
+% for $:=s:
+% clearxy_index_:=clearxy_index_+1; endfor;
+% if clearxy_index_=0:
+% save x,y;
+% else:
+% forsuffixes $:=s: x$:=whatever; y$:=whatever; endfor;
+% fi
+% enddef;
+%
+% which i decided to simplify to:
+
+def clearxy text s =
+ if false for $ := s : or true endfor :
+ forsuffixes $ := s : x$ := whatever ; y$ := whatever ; endfor ;
+ else :
+ save x, y ;
+ fi
+enddef ;
+
+% so now we can say: clearxy ; as well as clearxy 1, 2, 3 ;
+
+% show x0 ; z0 = (10,10) ;
+% show x0 ; x0 := whatever ; y0 := whatever ;
+% show x0 ; z0 = (20,20) ;
+% show x0 ; clearxy 0 ;
+% show x0 ; z0 = (30,30) ;
+
+primarydef p smoothed d =
+ (p llmoved (-xpart paired(d),0) -- p lrmoved (-xpart paired(d),0) {right} ..
+ p lrmoved (0,-ypart paired(d)) -- p urmoved (0,-ypart paired(d)) {up} ..
+ p urmoved (-xpart paired(d),0) -- p ulmoved (-xpart paired(d),0) {left} ..
+ p ulmoved (0,-ypart paired(d)) -- p llmoved (0,-ypart paired(d)) {down} .. cycle)
+enddef ;
+
+primarydef p cornered c =
+ ((point 0 of p) shifted (c*(unitvector(point 1 of p - point 0 of p))) --
+ for i=1 upto length(p) :
+ (point i-1 of p) shifted (c*(unitvector(point i of p - point i-1 of p))) --
+ (point i of p) shifted (c*(unitvector(point i-1 of p - point i of p))) ..
+ controls point i of p ..
+ endfor cycle)
+enddef ;
+
+% done
+
endinput ;