diff options
Diffstat (limited to 'metapost')
20 files changed, 2338 insertions, 558 deletions
diff --git a/metapost/context/base/mpii/mp-core.mpii b/metapost/context/base/mpii/mp-core.mpii index 33e9b386e..79b5d2ab7 100644 --- a/metapost/context/base/mpii/mp-core.mpii +++ b/metapost/context/base/mpii/mp-core.mpii @@ -897,7 +897,7 @@ enddef ; save_multipar (i,3,multipar) ; - elseif multi_column_first_page_hack and ((nxy[fpos]=RealPageNumber) and (nxy[tpos]>=RealPageNumber) : % and (NOfTextColumns>1)) : + elseif multi_column_first_page_hack and ((nxy[fpos]=RealPageNumber) and (nxy[tpos]>=RealPageNumber)) : % and (NOfTextColumns>1)) : save_multipar (i,2,multipar) ; diff --git a/metapost/context/base/mpii/mp-symb.mpii b/metapost/context/base/mpii/mp-symb.mpii new file mode 100644 index 000000000..40681adf1 --- /dev/null +++ b/metapost/context/base/mpii/mp-symb.mpii @@ -0,0 +1,351 @@ +%D \module +%D [ file=mp-symb.mp, +%D version=very old, +%D title=\CONTEXT\ \METAPOST\ graphics, +%D subtitle=navigation symbol macros, +%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 mreadme.pdf for +%C details. + +%D Instead of these symbols, you can use the \type {contnav} +%D font by Taco Hoekwater that is derived form this file. + +u := 3; +h := 5u; +wt := 5u; +wb := .25wt; +o := .1u; +pw := .5u; + +drawoptions (withpen pencircle scaled pw); + +path lefttriangle, righttriangle, sublefttriangle, subrighttriangle; + +pair s ; s = (2wb,0) ; + +x1t = x2t = 0; +x3t = wt; +y3t = .5h; +z1t-z2t = (z3t-z2t) rotated 60; + +z4t = (z2t--z3t) intersectionpoint ((z1t--z2t) shifted s) ; +z5t = (z3t--z1t) intersectionpoint ((z1t--z2t) shifted s) ; + +righttriangle = z1t--z2t--z3t--cycle; +lefttriangle = righttriangle rotatedaround((0,.5h), 180) shifted (wt,0); + +subrighttriangle = z4t--((z2t--z3t--z1t) shifted s)--z5t ; +sublefttriangle = subrighttriangle rotatedaround((0,.5h), 180) shifted (wt,0); + +path sidebar; + +x1b = x4b = 0; +x2b = x3b = wb; +y1b = y2b = y1t; +y3b = y4b = y2t; + +sidebar = z1b--z2b--z3b--z4b--cycle; + +path midbar, onebar, twobar; + +hh = abs(y1t-y2t); + +%midbar := unitsquare scaled 2hh/3; +midbar := unitsquare scaled hh; +onebar := unitsquare xscaled (hh/3) yscaled hh; +twobar := onebar; + +def prepareglyph = + drawoptions (withpen pencircle scaled .5u); +enddef; + +def finishglyph = + set_outer_boundingbox currentpicture; + bboxmargin := o; + setbounds currentpicture to bbox currentpicture; +% draw boundingbox currentpicture withcolor red withpen pencircle scaled 1; +enddef; + +beginfig (1); + prepareglyph; + fill lefttriangle; + draw lefttriangle; % draw gets the bbox right, filldraw doesn't + finishglyph; +endfig; + +beginfig (2); + prepareglyph; + fill righttriangle; + draw righttriangle; + finishglyph; +endfig; + +beginfig (3); + prepareglyph; + fill sidebar; + draw sidebar; + fill lefttriangle shifted (.5s); + draw lefttriangle shifted (.5s); + finishglyph; +endfig; + +beginfig (4); + prepareglyph; + fill righttriangle; + draw righttriangle; + fill sidebar shifted (wt,0); + draw sidebar shifted (wt,0); + finishglyph; +endfig; + +beginfig (5); + prepareglyph; + fill lefttriangle; + draw lefttriangle; + fill lefttriangle shifted s; + draw lefttriangle shifted s; + finishglyph; +endfig; + +beginfig (6); + prepareglyph; + fill righttriangle; + draw righttriangle; + fill righttriangle shifted s; + draw righttriangle shifted s; + finishglyph; +endfig; + +beginfig (7); + prepareglyph; + fill midbar; + draw midbar; + finishglyph; +endfig; + +beginfig (8); + prepareglyph; + fill onebar; + draw onebar; + finishglyph; +endfig; + +beginfig (9); + prepareglyph; + fill twobar; + draw twobar; + fill twobar shifted (pw+hh/2,0); + draw twobar shifted (pw+hh/2,0); + finishglyph; +endfig; + +beginfig(101); + prepareglyph; + draw lefttriangle; + finishglyph; +endfig; + +beginfig(102); + prepareglyph; + draw righttriangle; + finishglyph; +endfig; + +beginfig(103); + prepareglyph; + draw sidebar; + draw lefttriangle shifted (.5s); + finishglyph; +endfig; + +beginfig(104); + prepareglyph; + draw righttriangle; + draw sidebar shifted (wt,0); + finishglyph; +endfig; + +beginfig(105); + prepareglyph; + draw lefttriangle; + draw lefttriangle shifted s; + finishglyph; +endfig; + +beginfig(106); + prepareglyph; + draw righttriangle; + draw righttriangle shifted s; + finishglyph; +endfig; + +beginfig(107); + prepareglyph; + draw midbar; + finishglyph; +endfig; + +beginfig(108); + prepareglyph; + draw onebar; + finishglyph; +endfig; + +beginfig(109); + prepareglyph; + draw twobar; + draw twobar shifted (pw+hh/2,0); + finishglyph; +endfig; + +beginfig(201); + prepareglyph; + draw lefttriangle; + finishglyph; +endfig; + +beginfig(202); + prepareglyph; + draw righttriangle; + finishglyph; +endfig; + +beginfig(203); + prepareglyph; + draw sidebar; + draw lefttriangle shifted (.5s); + finishglyph; +endfig; + +beginfig(204); + prepareglyph; + draw righttriangle; + draw sidebar shifted (wt,0); + finishglyph; +endfig; + +beginfig(205); + prepareglyph; + draw sublefttriangle shifted s; + draw lefttriangle shifted s; + finishglyph; +endfig; + +beginfig(206); + prepareglyph; + draw subrighttriangle; + draw righttriangle; + finishglyph; +endfig; + +beginfig(207); + prepareglyph; + draw midbar; + finishglyph; +endfig; + +beginfig(208); + prepareglyph; + draw onebar; + finishglyph; +endfig; + +beginfig(209); + prepareglyph; + draw twobar; + draw twobar shifted (pw+hh/2,0); + finishglyph; +endfig; + + +beginfig(999); + +picture collection [] ; + +prepareglyph ; +draw lefttriangle ; +finishglyph ; +collection[201] := currentpicture ; +currentpicture := nullpicture ; + +prepareglyph ; +draw righttriangle ; +finishglyph ; +collection[202] := currentpicture ; +currentpicture := nullpicture ; + +prepareglyph ; +draw sidebar ; +draw lefttriangle shifted (.5s) ; +finishglyph ; +collection[203] := currentpicture ; +currentpicture := nullpicture ; + +prepareglyph ; +draw righttriangle ; +draw sidebar shifted (wt,0) ; +finishglyph ; +collection[204] := currentpicture ; +currentpicture := nullpicture ; + +prepareglyph ; +draw sublefttriangle shifted s ; +draw lefttriangle shifted s ; +finishglyph ; +collection[205] := currentpicture ; +currentpicture := nullpicture ; + +prepareglyph ; +draw subrighttriangle ; +draw righttriangle ; +finishglyph ; +collection[206] := currentpicture ; +currentpicture := nullpicture ; + +prepareglyph ; +draw midbar ; +finishglyph ; +collection[207] := currentpicture ; +currentpicture := nullpicture ; + +prepareglyph ; +draw onebar ; +finishglyph ; +collection[208] := currentpicture ; +currentpicture := nullpicture ; + +prepareglyph ; +draw twobar ; +draw twobar shifted (pw+hh/2,0) ; +finishglyph ; +collection[209] := currentpicture ; +currentpicture := nullpicture ; + +for i=201 upto 209 : + collection[i] := collection[i] shifted - center collection[i] ; +endfor ; + +addto currentpicture also collection[205] shifted ( 0, 0) + withcolor (.3,.4,.5) ; +addto currentpicture also collection[202] shifted ( 0,1.5h) + withcolor (.5,.6,.7) ; +addto currentpicture also collection[201] shifted (1.5h, 0) + withcolor (.6,.7,.8) ; +addto currentpicture also collection[206] shifted (1.5h,1.5h) + withcolor (.4,.5,.6) ; + +collection[210] := currentpicture ; +currentpicture := nullpicture ; + +bboxmargin := .25u; + +fill bbox collection[210] withcolor .95(1,1,0); +addto currentpicture also collection[210] ; + +endfig ; + +end diff --git a/metapost/context/base/mpii/mp-tool.mpii b/metapost/context/base/mpii/mp-tool.mpii index f476361c7..a3300f5bb 100644 --- a/metapost/context/base/mpii/mp-tool.mpii +++ b/metapost/context/base/mpii/mp-tool.mpii @@ -28,7 +28,9 @@ let @## = @# ; if not known mpversion : string mpversion ; mpversion := "0.641" ; fi ; -newinternal metapostversion ; metapostversion := scantokens(mpversion) ; +% newinternal metapostversion ; metapostversion := scantokens(mpversion) ; + +newinternal metapostversion ; metapostversion := 2.0 ; % vardef mpversiongt(expr s) = % scantokens (mpversion & " > " & if numeric s : decimal s else : s fi) @@ -2661,41 +2663,41 @@ vardef undecorated (text imagedata) text decoration = enddef ; -if metapostversion < 1.770 : - - vardef decorated (text imagedata) text decoration = - save mfun_decorated_path, currentpicture ; - picture mfun_decorated_path, currentpicture ; - currentpicture := nullpicture ; - imagedata ; - mfun_decorated_path := currentpicture ; - currentpicture := nullpicture ; - for i within mfun_decorated_path : - addto currentpicture - if stroked i : - doublepath pathpart i - dashed dashpart i - withpen penpart i - withcolor colorpart i - decoration - elseif filled i : - contour pathpart i - withpen penpart i - withcolor colorpart i - decoration - elseif textual i : - also i - withcolor colorpart i - decoration - else : - also i - fi - ; - endfor ; - currentpicture - enddef ; - -else: +% if metapostversion < 1.770 : +% +% vardef decorated (text imagedata) text decoration = +% save mfun_decorated_path, currentpicture ; +% picture mfun_decorated_path, currentpicture ; +% currentpicture := nullpicture ; +% imagedata ; +% mfun_decorated_path := currentpicture ; +% currentpicture := nullpicture ; +% for i within mfun_decorated_path : +% addto currentpicture +% if stroked i : +% doublepath pathpart i +% dashed dashpart i +% withpen penpart i +% withcolor colorpart i +% decoration +% elseif filled i : +% contour pathpart i +% withpen penpart i +% withcolor colorpart i +% decoration +% elseif textual i : +% also i +% withcolor colorpart i +% decoration +% else : +% also i +% fi +% ; +% endfor ; +% currentpicture +% enddef ; +% +% else: vardef decorated (text imagedata) text decoration = save mfun_decorated_path, currentpicture ; @@ -2735,7 +2737,7 @@ else: currentpicture enddef ; -fi ; +% fi ; vardef redecorated (text imagedata) text decoration = save mfun_decorated_path, currentpicture ; diff --git a/metapost/context/base/mpiv/metafun.mpiv b/metapost/context/base/mpiv/metafun.mpiv index b1d4f32e7..ab3fa8638 100644 --- a/metapost/context/base/mpiv/metafun.mpiv +++ b/metapost/context/base/mpiv/metafun.mpiv @@ -35,6 +35,8 @@ input "mp-func.mpiv" ; % under construction % "mp-char.mpiv" ; % loaded on demand % "mp-step.mpiv" ; % loaded on demand % "mp-chem.mpiv" ; % loaded on demand +input "mp-apos.mpiv" ; +input "mp-abck.mpiv" ; string metafunversion ; metafunversion = "metafun iv" & " " & diff --git a/metapost/context/base/mpiv/mp-abck.mpiv b/metapost/context/base/mpiv/mp-abck.mpiv index abd7d8848..57c8f226b 100644 --- a/metapost/context/base/mpiv/mp-abck.mpiv +++ b/metapost/context/base/mpiv/mp-abck.mpiv @@ -50,17 +50,6 @@ numeric boxfilloffset ; boxfilloffset := 0 ; numeric boxgriddistance ; boxgriddistance := .5cm ; numeric boxgridshift ; boxgridshift := 0 ; -def abck_show_path(expr p, r, c) = - draw p withpen pencircle scaled .5pt withcolor c ; - if length(p) > 2 : - begingroup ; save _c_ ; path _c_ ; _c_ := fullcircle scaled r ; - for i=0 upto length(p) if cycle p : -1 fi : - fill _c_ shifted point i of p withcolor white ; - draw _c_ shifted point i of p withpen pencircle scaled .5pt withcolor c ; - endfor ; - fi ; -enddef ; - vardef abck_draw_path(expr p) = if (length p > 2) and (bbwidth(p) > 1) and (bbheight(p) > 1) : save pp ; path pp ; @@ -160,7 +149,7 @@ enddef ; def show_multi_pars = for i=1 upto nofmultipars : - abck_show_path(multipars[i], 6pt, .5blue) ; + drawpathwithpoints multipars[i] withcolor .5blue ; endfor ; enddef ; @@ -267,3 +256,43 @@ enddef ; def anchor_box (expr n,x,y,w,h,d) = currentpicture := currentpicture shifted (-x,-y) ; enddef ; + +def draw_box = % for old times sake + draw pxy boxlineoptions withpen pencircle scaled boxlinewidth ; + draw lxy -- rxy boxlineoptions withpen pencircle scaled boxgridwidth ; +enddef ; + +def draw_free_region(expr width, height, depth, loffset, roffset, toffset, boffset) = + + begingroup ; save b, o, l ; path b, o, l[] ; save d ; + + b := fullsquare + xysized(width,height+depth) ; + o := b + topenlarged toffset + bottomenlarged boffset + leftenlarged loffset + rightenlarged roffset ; + d := max(PaperWidth,PaperHeight) ; + + fill o withcolor .5white ; + fill b withcolor .7white ; + + interim linecap := butt ; + + l[1] := topboundary (topboundary o leftenlarged d rightenlarged d) ; + l[2] := bottomboundary (bottomboundary o leftenlarged d rightenlarged d) ; + l[3] := leftboundary (leftboundary o topenlarged d bottomenlarged d) ; + l[4] := rightboundary (rightboundary o topenlarged d bottomenlarged d) ; + + for i=1 upto 4 : + draw l[i] withpen pencircle scaled 1bp withcolor white ; + draw l[i] withpen pencircle scaled 1bp dashed (evenly scaled 1bp) withcolor black ; + endfor ; + + setbounds currentpicture to b ; + + endgroup ; + +enddef ; + diff --git a/metapost/context/base/mpiv/mp-asnc.mpiv b/metapost/context/base/mpiv/mp-asnc.mpiv index 2626e4d58..fba182a64 100644 --- a/metapost/context/base/mpiv/mp-asnc.mpiv +++ b/metapost/context/base/mpiv/mp-asnc.mpiv @@ -13,7 +13,7 @@ if known context_asnc : endinput ; fi ; -boolean context_av ; context_asnc := true ; +boolean context_asnc ; context_asnc := true ; % will be replaced diff --git a/metapost/context/base/mpiv/mp-base.mpiv b/metapost/context/base/mpiv/mp-base.mpiv index 28eb57fb8..0cc209302 100644 --- a/metapost/context/base/mpiv/mp-base.mpiv +++ b/metapost/context/base/mpiv/mp-base.mpiv @@ -66,8 +66,8 @@ def stop expr s = gobble readstring enddef ; -warningcheck :=1 ; -tracinglostchars :=1 ; +warningcheck := 1 ; +tracinglostchars := 1 ; def interact = % sets up to make "show" commands stop hide ( @@ -458,8 +458,8 @@ enddef ; % special operators -vardef incr suffix $ = $:=$+1; $ enddef ; -vardef decr suffix $ = $:=$-1; $ enddef ; +vardef incr suffix $ = $ := $ + 1 ; $ enddef ; +vardef decr suffix $ = $ := $ - 1 ; $ enddef ; def reflectedabout(expr w,z) = % reflects about the line w..z transformed diff --git a/metapost/context/base/mpiv/mp-char.mpiv b/metapost/context/base/mpiv/mp-char.mpiv index f604accd8..e878c2d16 100644 --- a/metapost/context/base/mpiv/mp-char.mpiv +++ b/metapost/context/base/mpiv/mp-char.mpiv @@ -678,14 +678,14 @@ vardef flow_valid_connection (expr xfrom, yfrom, xto, yto) = flow_xypoints[flow_xypoint] := flow_xylast ; for i=1 upto flow_max_x : for j=1 upto flow_max_y : % was bug: xfrom,yto - if not ( ( (i,j)=(xfrom,yfrom) ) or ( (i,j)=(xto,yto) ) ) : +% if not ( ( (i,j)=(xfrom,yfrom) ) or ( (i,j)=(xto,yto) ) ) : if not flow_xyfree[i][j] : vc := pp intersection_point flow_xypath[i][j] ; if intersection_found : ok := false fi ; fi ; - fi ; +% fi ; endfor ; endfor ; % if not ok: message("crossing") ; fi ; @@ -944,20 +944,27 @@ def flow_connect_bottom_right (expr n) (expr xfrom,yfrom,zfrom) (expr xto,yto,zt enddef ; def flow_draw_test_shape(expr x, y) = - flow_draw_shape(x,y,fullcircle, .7, .7) ; + flow_draw_shape(x,y,fullcircle,flow_shape_width/flow_grid_width,flow_shape_height/flow_grid_height) ; enddef ; def flow_draw_test_shapes = + flow_draw_test_area ; for i=1 upto flow_max_x : for j=1 upto flow_max_y : flow_draw_test_shape(i,j) ; + flow_chart_draw_label(i,j,"",textext("\ttx(" & decimal i & "," & decimal j & ")")) endfor ; endfor ; enddef; def flow_draw_test_area = pickup pencircle scaled .5flow_shape_line_width ; - draw (unitsquare xscaled flow_max_x yscaled flow_max_y shifted (1,1)) flow_scaled_to_grid withcolor blue ; + for i=1 upto flow_max_x + 1 : + draw ((i,1) -- (i,flow_max_y+1)) flow_scaled_to_grid withcolor white/2 ; + endfor ; + for i=1 upto flow_max_y + 1 : + draw ((1,i) -- (flow_max_x+1,i)) flow_scaled_to_grid withcolor white/2 ; + endfor ; enddef ; def flow_show_connection(expr n, m) = diff --git a/metapost/context/base/mpiv/mp-chem.mpiv b/metapost/context/base/mpiv/mp-chem.mpiv index b861d3f12..4ed9eaa8f 100644 --- a/metapost/context/base/mpiv/mp-chem.mpiv +++ b/metapost/context/base/mpiv/mp-chem.mpiv @@ -48,26 +48,34 @@ path pair chem_origin, chem_mirror, chem_pair[], % scratch - chem_sb_pair, chem_sb_pair.m, chem_sb_pair.p, chem_sb_pair.b ; + chem_sb_pair, chem_sb_pair.m, chem_sb_pair.mm, chem_sb_pair.p, chem_sb_pair.pp, chem_sb_pair.b ; picture - chem_pic, % scratch + chem_pic; % scratch % The use of dashpattern is found to dot the starting point with chem_sb_dash.m... %chem_sb_dash, chem_sb_dash.m, chem_sb_dash.p, chem_sb_dash.b, + +% nice hack but now redone +% +% picture chem_axis_color ; +% +% chem_axis_color := image(draw origin withcolor axiscolor) ; % so we handle all color models +% +% withpen pencircle scaled chem_axis_rulethickness withcolor colorpart(chem_axis_color) ; + +string chem_axis_color ; transform chem_t ; % scratch -color lightblue ; lightblue := (173/255,216/255,230/255) ; - % debugging boolean chem_trace_nesting ; chem_trace_nesting := false ; boolean chem_trace_text ; chem_trace_text := false ; boolean chem_trace_boundingbox ; chem_trace_boundingbox := false ; -chem_axis_color := image(draw origin withcolor lightblue) ; +chem_axis_color := "lightblue" ; chem_setting_axis := false ; chem_axis_rulethickness := 1pt ; chem_emwidth := 10pt ; % EmWidth or \the\emwidth does not work... @@ -81,7 +89,9 @@ chem_text_max := 1.25 ; chem_dot_factor := 2 ; % *linewidth chem_sb_pair := (0.25,0.75) ; %chem_sb_dash := dashpattern(off 0.25 on 0.5 off 0.25) ; chem_sb_pair.m := (0.25,1 ) ; %chem_sb_dash.m := dashpattern(off 0.25 on 0.75) ; +chem_sb_pair.mm := (0.50,1 ) ; %chem_sb_dash.m := dashpattern(off 0.25 on 0.75) ; chem_sb_pair.p := (0 ,0.75) ; %chem_sb_dash.p := dashpattern(on 0.75 off 0.25) ; +chem_sb_pair.pp := (0 ,0.50) ; %chem_sb_dash.p := dashpattern(on 0.75 off 0.25) ; chem_sb_pair.b := (0 ,1 ) ; %chem_sb_dash.b := dashpattern(on 1) ; chem_bd_wedge := true ; % according to IUPAC 2005 @@ -333,7 +343,7 @@ def chem_start_structure(expr i, l, r, t, b, rotation, unit, bond, scale, offset chem_setting_offset := offset ; chem_setting_axis := if boolean axis : axis else : (axis<>0) fi ; chem_axis_rulethickness := .75*(rulethickness) ; % axis 50% thinner than frame and bonds. - chem_axis_color := image(draw origin withcolor axiscolor) ; % so we handle all color models + chem_axis_color := axiscolor ; chem_reset ; enddef ; @@ -367,24 +377,24 @@ vardef chem_stop_structure = % draw the axes to the bounding box of the entire structure, % not necessarily the bounding box of the final figure draw (l,0) -- (r,0) - withpen pencircle scaled chem_axis_rulethickness withcolor colorpart(chem_axis_color) ; + withpen pencircle scaled chem_axis_rulethickness withcolor chem_axis_color ; draw (0,b) -- (0,t) - withpen pencircle scaled chem_axis_rulethickness withcolor colorpart(chem_axis_color) ; + withpen pencircle scaled chem_axis_rulethickness withcolor chem_axis_color ; for i = 0 step chem_num0 until r : draw (i,-chem_num1) -- (i,chem_num1) - withpen pencircle scaled chem_axis_rulethickness withcolor colorpart(chem_axis_color) ; + withpen pencircle scaled chem_axis_rulethickness withcolor chem_axis_color ; endfor for i = 0 step -chem_num0 until l : draw (i,-chem_num1) -- (i,chem_num1) - withpen pencircle scaled chem_axis_rulethickness withcolor colorpart(chem_axis_color) ; + withpen pencircle scaled chem_axis_rulethickness withcolor chem_axis_color ; endfor for i = 0 step chem_num0 until t : draw (-chem_num1,i) -- (chem_num1,i) - withpen pencircle scaled chem_axis_rulethickness withcolor colorpart(chem_axis_color) ; + withpen pencircle scaled chem_axis_rulethickness withcolor chem_axis_color ; endfor for i = 0 step -chem_num0 until b : draw (-chem_num1,i) -- (chem_num1,i) - withpen pencircle scaled chem_axis_rulethickness withcolor colorpart(chem_axis_color) ; + withpen pencircle scaled chem_axis_rulethickness withcolor chem_axis_color ; endfor addto currentpicture also chem_pic ; fi ; @@ -406,9 +416,8 @@ vardef chem_stop_component = enddef ; vardef chem_pb = % PB : if chem_trace_nesting : - draw boundingbox currentpicture - withpen pencircle scaled 1mm withcolor colorpart(chem_axis_color) ; - draw origin withpen pencircle scaled 2mm withcolor colorpart(chem_axis_color) ; + draw boundingbox currentpicture withpen pencircle scaled 1mm withcolor chem_axis_color ; + draw origin withpen pencircle scaled 2mm withcolor chem_axis_color ; fi ; chem_doing_pb := true ; enddef ; @@ -507,21 +516,21 @@ enddef ; vardef chem_draw (expr what, r, c) (text extra) = draw what withpen pencircle scaled r - withcolor c %\MPcolor{c} + withcolor c extra ; enddef ; vardef chem_fill (expr what, r, c) (text extra) = fill what withpen pencircle scaled r - withcolor c %\MPcolor{c} + withcolor c extra ; enddef ; vardef chem_drawarrow (expr what, r, c) (text extra) = drawarrow what withpen pencircle scaled r - withcolor c %\MPcolor{c} + withcolor c extra ; enddef ; @@ -1372,7 +1381,7 @@ vardef chem_bw@# (suffix $) (expr f, t, r, c) = % BW enddef ; vardef chem_bd@# (suffix $) (expr f, t, r, c) = % BD - if chem_star[$] : chem_rbd#@($,f,t,r,c) ; fi + if chem_star[$] : chem_rbd@#($,f,t,r,c) ; fi enddef ; vardef chem_rbd@# (suffix $) (expr f, t, r, c) = % RBD @@ -1691,14 +1700,14 @@ vardef chem_line (suffix $) (expr f, t, r, c) = % LINE draw if f=t : origin else : chem_marked(f) fi -- chem_marked(t) % no chem_transformed withpen pencircle scaled r - withcolor c %\MPcolor{c} + withcolor c enddef ; vardef chem_dash (suffix $) (expr f, t, r, c) = % DASH draw if f=t : origin else : chem_marked(f) fi -- chem_marked(t) % no chem_transformed withpen pencircle scaled r - withcolor c %\MPcolor{c} + withcolor c dashed evenly ; enddef ; @@ -1706,7 +1715,7 @@ vardef chem_arrow (suffix $) (expr f, t, r, c) = % ARROW drawarrow if f=t : origin else : chem_marked(f) fi -- chem_marked(t) % no chem_transformed withpen pencircle scaled r - withcolor c %\MPcolor{c} + withcolor c enddef ; diff --git a/metapost/context/base/mpiv/mp-core.mpiv b/metapost/context/base/mpiv/mp-core.mpiv index 9b7182908..0ef24e57e 100644 --- a/metapost/context/base/mpiv/mp-core.mpiv +++ b/metapost/context/base/mpiv/mp-core.mpiv @@ -513,9 +513,6 @@ def do_initialize_par (expr fpos, tpos, mpos, ppos, rw,rl,rr,rh,ra,ri) = enddef ; -TopSkip := 0 ; % will move -StrutHeight := 0 ; % will move - pair last_multi_par_shift ; last_multi_par_shift := origin ; def relocate_multipars (expr xy) = @@ -1187,10 +1184,10 @@ numeric boxfilloffset ; boxfilloffset := 0pt ; numeric boxgriddistance ; boxgriddistance := .5cm ; numeric boxgridshift ; boxgridshift := 0pt ; -def draw_box = - draw pxy boxlineoptions withpen pencircle scaled boxlinewidth ; - draw lxy -- rxy boxlineoptions withpen pencircle scaled boxgridwidth ; -enddef ; +% def draw_box = +% draw pxy boxlineoptions withpen pencircle scaled boxlinewidth ; +% draw lxy -- rxy boxlineoptions withpen pencircle scaled boxgridwidth ; +% enddef ; def draw_par = % 1 2 3 11 12 do_draw_par(pxy) ; do_draw_par(txy) ; do_draw_par(bxy) ; diff --git a/metapost/context/base/mpiv/mp-grap.mpiv b/metapost/context/base/mpiv/mp-grap.mpiv index 4fd8ee5bd..3a1d7742a 100644 --- a/metapost/context/base/mpiv/mp-grap.mpiv +++ b/metapost/context/base/mpiv/mp-grap.mpiv @@ -17,9 +17,8 @@ boolean context_grap ; context_grap := true ; % Below is a modified graph.mp -show numbersystem, numberprecision ; +message ("using number system " & numbersystem & " with precision " & decimal numberprecision) ; -%if epsilon/4 = 0 : if numbersystem <> "double" : errmessage "The graph macros require the double precision number system." ; endinput ; @@ -161,7 +160,6 @@ enddef ; % New : save graph_background ; color graph_background ; % if defined, fill the frame. -save graph_close_file ; boolean graph_close_file ; graph_close_file = false ; def begingraph(expr w, h) = begingroup @@ -475,9 +473,9 @@ enddef ; % String manipulation routines for MetaPost % It is harmless to input this file more than once. -vardef isdigit primary d = - ("0"<=d)and(d<="9") -enddef ; +% vardef isdigit primary d = +% ("0"<=d)and(d<="9") +% enddef ; % Number of initial characters of string s where `c <character>' is true @@ -527,15 +525,18 @@ enddef ; % line with no data. Commands c can use line number i and tokens $1, $2, ... % and j is the number of fields. +% def gdata(expr f)(suffix $)(text c) = +% for i=1 upto largestmantissa : +% exitunless graph_read_line$(f) ; +% c +% endfor ; +% enddef ; + def gdata(expr f)(suffix $)(text c) = - %boolean flag ; % not used? for i=1 upto largestmantissa : exitunless graph_read_line$(f) ; c endfor - if graph_close_file : - closefrom f ; - fi enddef ; % Read a path from file f. The path is terminated by blank line or EOF. @@ -1259,7 +1260,6 @@ def plotsymbol(expr n, f) text t = fg := if known graph_foreground : graph_foreground else : black fi ; save p ; path p ; p = graph_shape[n] scaled graph_shapesize ; draw p withcolor bg withpen currentpen scaled 2 ; % halo - currentpen := currentpen scaled .5 ; if cycle p : fill p withcolor if known f : diff --git a/metapost/context/base/mpiv/mp-idea.mpiv b/metapost/context/base/mpiv/mp-idea.mpiv index 462d97553..d417ab51f 100644 --- a/metapost/context/base/mpiv/mp-idea.mpiv +++ b/metapost/context/base/mpiv/mp-idea.mpiv @@ -28,3 +28,17 @@ vardef somecolor = (1,1,0,0) enddef ; fill OverlayBox withcolor (rcomponent somecolor,gcomponent somecolor,bcomponent somecolor) ; fill OverlayBox withcolor (ccomponent somecolor,mcomponent somecolor,ycomponent somecolor,bcomponent somecolor) ; + +% def newcolor text v = forsuffixes i=v : save i ; color i ; endfor ; enddef ; +% def newnumeric text v = forsuffixes i=v : save i ; numeric i ; endfor ; enddef ; +% def newboolean text v = forsuffixes i=v : save i ; boolean i ; endfor ; enddef ; +% def newtransform text v = forsuffixes i=v : save i ; transform i ; endfor ; enddef ; +% def newpath text v = forsuffixes i=v : save i ; path i ; endfor ; enddef ; +% def newpicture text v = forsuffixes i=v : save i ; picture i ; endfor ; enddef ; +% def newstring text v = forsuffixes i=v : save i ; string i ; endfor ; enddef ; + +% width := 10 ; +% beginfig(1) ; +% newpath width, height ; width := origin -- cycle ; +% endfig ; +% width := 10 ; diff --git a/metapost/context/base/mpiv/mp-luas.mpiv b/metapost/context/base/mpiv/mp-luas.mpiv index c30798247..76d28f7f9 100644 --- a/metapost/context/base/mpiv/mp-luas.mpiv +++ b/metapost/context/base/mpiv/mp-luas.mpiv @@ -57,6 +57,8 @@ vardef mlib_luas_luacall(text t) = & decimal s elseif boolean s : & if s : "true" else : "false" fi + else : + & ditto & tostring(s) & ditto fi endfor ) enddef ; @@ -75,6 +77,8 @@ vardef mlib_luas_lualist(expr c)(text t) = & decimal s elseif boolean s : & if s : "true" else : "false" fi + else : + & ditto & tostring(s) & ditto fi endfor & ")" ) enddef ; @@ -97,3 +101,65 @@ enddef ; vardef MP@#(text t) = mlib_luas_lualist("MP." & str @#,t) enddef ; + +def message expr t = + if t <> "" : lua.mp.report(t) fi ; +enddef ; + +% a few helpers + +% A few helpers: + +vardef isarray suffix a = + lua.mp.isarray(str a) +enddef ; + +vardef prefix suffix a = + lua.mp.prefix(str a) +enddef ; + +vardef dimensions suffix a = + lua.mp.dimensions(str a) +enddef ; + +% More access + +def getdimen(expr k) = lua.mp._get_dimen_(k) enddef ; +def getcount(expr k) = lua.mp._get_count_(k) enddef ; +def gettoks (expr k) = lua.mp._get_toks_ (k) enddef ; +def setdimen(expr k, v) = lua.mp._set_dimen_(k,v) enddef ; +def setcount(expr k, v) = lua.mp._set_count_(k,v) enddef ; +def settoks (expr k, v) = lua.mp._set_toks_ (k,v) enddef ; + +% vardef getdimen(expr k) = save getdimen ; lua.mp.getdimen(k) enddef ; +% vardef getcount(expr k) = save getcount ; lua.mp.getcount(k) enddef ; +% vardef gettoks (expr k) = save gettoks ; lua.mp.gettoks (k) enddef ; +% vardef setdimen(expr k,v) = save setdimen ; lua.mp.setdimen(k,v) enddef ; +% vardef setcount(expr k,v) = save setcount ; lua.mp.setcount(k,v) enddef ; +% vardef settoks (expr k,v) = save settoks ; lua.mp.settoks (k,v) enddef ; + +vardef positionpath (expr name) = lua.mp.positionpath (name) enddef ; +vardef positioncurve (expr name) = lua.mp.positioncurve (name) enddef ; +vardef positionxy (expr name) = lua.mp.positionxy (name) enddef ; +vardef positionpxy (expr name) = lua.mp.positionpxy (name) enddef ; +vardef positionwhd (expr name) = lua.mp.positionwhd (name) enddef ; +vardef positionpage (expr name) = lua.mp.positionpage (name) enddef ; +vardef positionregion(expr name) = lua.mp.positionregion(name) enddef ; +vardef positionbox (expr name) = lua.mp.positionbox (name) enddef ; +vardef positionanchor = lua.mp.positionanchor() enddef ; + +let wdpart = redpart ; +let htpart = greenpart ; +let dppart = bluepart ; + +vardef positioninregion = + currentpicture := currentpicture shifted - positionxy(positionanchor) ; +enddef ; + +vardef positionatanchor(expr name) = + currentpicture := currentpicture shifted - positionxy(name) ; +enddef ; + + +vardef texvar(expr name) = lua.mp.texvar(name) enddef ; +vardef texstr(expr name) = lua.mp.texstr(name) enddef ; diff --git a/metapost/context/base/mpiv/mp-mlib.mpiv b/metapost/context/base/mpiv/mp-mlib.mpiv index 326342b70..0638ee3e1 100644 --- a/metapost/context/base/mpiv/mp-mlib.mpiv +++ b/metapost/context/base/mpiv/mp-mlib.mpiv @@ -54,8 +54,8 @@ vardef transparency_alternative_to_number(expr name) = fi enddef ; -def namedcolor (expr n) = - 1 +def namedcolor expr n = + (1) withprescript "sp_type=named" withprescript "sp_name=" & n enddef ; @@ -76,22 +76,22 @@ enddef ; % withprescript "sp_value=" & value % enddef ; -def spotcolor(expr n, v) = - 1 +def spotcolor(expr name, v) = + (1) withprescript "sp_type=spot" - withprescript "sp_name=" & n + withprescript "sp_name=" & name withprescript "sp_value=" & colordecimals v enddef ; def multitonecolor(expr name)(text t) = - 1 + (1) withprescript "sp_type=multitone" withprescript "sp_name=" & name withprescript "sp_value=" & colordecimalslist(t) enddef ; def transparent(expr a, t)(text c) = % use withtransparency instead - 1 % this permits withcolor x intoshade y + (1) % this permits withcolor x intoshade y withprescript "tr_alternative=" & decimal transparency_alternative_to_number(a) withprescript "tr_transparency=" & decimal t withcolor c @@ -240,6 +240,32 @@ vardef rawtextext(expr s) = % todo: avoid currentpicture fi enddef ; +vardef validtexbox(expr category, name) = + if category == "" : + false + elseif string name : + name <> "" + elseif numeric name : + name > 0 + else : + true + fi +enddef ; + +vardef rawtexbox(expr category, name) = + mfun_tt_c := nullpicture ; + if validtexbox(category,name) : + mfun_tt_b := lua.mp.tb_dimensions(category, name) ; + addto mfun_tt_c doublepath unitsquare + xscaled redpart mfun_tt_b + yscaled (greenpart mfun_tt_b + bluepart mfun_tt_b) + shifted (0,- bluepart mfun_tt_b) + withprescript "bx_category=" & if numeric category : decimal fi category + withprescript "bx_name=" & if numeric name : decimal fi name ; + fi + mfun_tt_c +enddef ; + % More text defaultfont := "Mono" ; @@ -403,6 +429,88 @@ vardef onetimetextext@#(expr p) = % no draw here thetextext@#(p,origin) enddef ; +% formatted text + +pair mfun_tt_z ; + +vardef rawfmttext(text t) = % todo: avoid currentpicture + mfun_tt_n := mfun_tt_n + 1 ; + mfun_tt_c := nullpicture ; + if mfun_trial_run : + mfun_tt_o := nullpicture ; + addto mfun_tt_o doublepath origin _op_ ; % save drawoptions + addto mfun_tt_c doublepath unitsquare + withprescript "tx_number=" & decimal mfun_tt_n + withprescript "tx_stage=trial" + withprescript "tx_color=" & colordecimals colorpart mfun_tt_o + % begin of fmt specific + withprescript "tx_type=format" + for s = t : + if string s : withpostscript "s:" & s + elseif numeric s : withpostscript "n:" & decimal s + elseif boolean s : withpostscript "b:" & if s : "true" else : "false" fi + elseif pair s : hide(mfun_tt_z := s ; ) + fi + endfor ; + % end of fmt specific + if not mfun_onetime_textext : + addto mfun_tt_p also mfun_tt_c + withprescript "tx_global=yes" ; + fi ; + else : + mfun_tt_b := lua.mp.tt_dimensions(mfun_tt_n) ; + addto mfun_tt_c doublepath unitsquare + xscaled redpart mfun_tt_b + yscaled (greenpart mfun_tt_b + bluepart mfun_tt_b) + shifted (0,- bluepart mfun_tt_b) + withprescript "tx_number=" & decimal mfun_tt_n + withprescript "tx_stage=final" ; + % begin of fmt specific + for s = t : + if pair s : mfun_tt_z := s ; fi + endfor ; + % end of fmt specific + fi ; + mfun_onetime_textext := false ; + mfun_tt_c +enddef ; + +vardef thefmttext@#(text t) = + mfun_tt_z := origin ; + save p ; picture p ; p := rawfmttext(t) ; + p + if (mfun_labtype@# >= 10) : + shifted (0,ypart center p) + fi + shifted (mfun_tt_z + textextoffset*mfun_laboff@# - (mfun_labxf@#*lrcorner p + mfun_labyf@#*ulcorner p + (1-mfun_labxf@#-mfun_labyf@#)*llcorner p)) +enddef ; + +vardef fmttext@#(text t) = % no draw here + thefmttext@#(t,origin) +enddef ; + +% or just: def fmttext = thefmttext enddef ; + +vardef onetimefmttext@#(text t) = % no draw here + mfun_onetime_textext := true ; + thefmttext@#(t,origin) +enddef ; + +% so much for formatted text + +vardef thetexbox@#(expr category, name, z) = + save p ; picture p ; p := rawtexbox(category,name) ; + p + if (mfun_labtype@# >= 10) : + shifted (0,ypart center p) + fi + shifted (z + textextoffset*mfun_laboff@# - (mfun_labxf@#*lrcorner p + mfun_labyf@#*ulcorner p + (1-mfun_labxf@#-mfun_labyf@#)*llcorner p)) +enddef ; + +vardef texbox@#(expr category, name) = % no draw here + thetexbox@#(category,name,origin) +enddef ; + vardef thelabel@#(expr p,z) = if string p : thelabel@#(rawtextext("\definedfont[" & defaultfont & "]" & p) scaled defaultscale,z) @@ -507,16 +615,52 @@ def mfun_withshadestep (text t) = t enddef ; +numeric mfun_shade_fx, mfun_shade_fy ; +numeric mfun_shade_lx, mfun_shade_ly ; +numeric mfun_shade_nx, mfun_shade_ny ; +numeric mfun_shade_dx, mfun_shade_dy ; +numeric mfun_shade_tx, mfun_shade_ty ; + +% first + +def mfun_with_shade_method_analyze(expr p) = + mfun_shade_path := p ; + mfun_shade_step := 1 ; + mfun_shade_fx := xpart point 0 of p ; + mfun_shade_fy := ypart point 0 of p ; + mfun_shade_lx := mfun_shade_fx ; + mfun_shade_ly := mfun_shade_fy ; + mfun_shade_nx := 0 ; + mfun_shade_ny := 0 ; + mfun_shade_dx := abs(mfun_shade_fx - mfun_shade_lx) ; + mfun_shade_dy := abs(mfun_shade_fy - mfun_shade_ly) ; + for i=1 upto length(p) : + mfun_shade_tx := abs(mfun_shade_fx - xpart point i of p) ; + mfun_shade_ty := abs(mfun_shade_fy - ypart point i of p) ; + if mfun_shade_tx > mfun_shade_dx : + mfun_shade_nx := i + 1 ; + mfun_shade_lx := xpart point i of p ; + mfun_shade_dx := mfun_shade_tx ; + fi ; + if mfun_shade_ty > mfun_shade_dy : + mfun_shade_ny := i + 1 ; + mfun_shade_ly := ypart point i of p ; + mfun_shade_dy := mfun_shade_ty ; + fi ; + endfor ; +enddef ; + primarydef p withshademethod m = - hide( - mfun_shade_path := p ; - mfun_shade_step := 1 ; - ) + hide(mfun_with_shade_method_analyze(p)) p withprescript "sh_domain=0 1" + withprescript "sh_transform=yes" withprescript "sh_color=into" withprescript "sh_color_a=" & colordecimals white withprescript "sh_color_b=" & colordecimals black + withprescript "sh_first=" & ddecimal point 0 of p % used for support scaling + withprescript "sh_set_x=" & ddecimal (mfun_shade_nx,mfun_shade_lx) % + withprescript "sh_set_y=" & ddecimal (mfun_shade_ny,mfun_shade_ly) % if m = "linear" : withprescript "sh_type=linear" withprescript "sh_factor=1" @@ -537,6 +681,16 @@ primarydef p withshademethod m = fi enddef ; +def withshaderadius expr a = + withprescript "sh_radius_a=" & decimal (xpart a) + withprescript "sh_radius_b=" & decimal (ypart a) +enddef ; + +def withshadeorigin expr a = + withprescript "sh_center_a=" & ddecimal a + withprescript "sh_center_b=" & ddecimal a +enddef ; + def withshadevector expr a = withprescript "sh_center_a=" & ddecimal (point xpart a of mfun_shade_path) withprescript "sh_center_b=" & ddecimal (point ypart a of mfun_shade_path) @@ -547,6 +701,10 @@ def withshadedirection expr a = withprescript "sh_center_b=" & ddecimal (point ypart a of boundingbox(mfun_shade_path)) enddef ; +def withshadetransform expr a = % yes | no + withprescript "sh_transform=" & a +enddef ; + pair shadedup ; shadedup := (0.5,2.5) ; pair shadeddown ; shadeddown := (2.5,0.5) ; pair shadedleft ; shadedleft := (1.5,3.5) ; @@ -616,10 +774,47 @@ def shaded text s = s enddef ; +% For me. + +primarydef p shownshadevector v = + image ( + drawarrow (point xpart v of p) -- (point ypart v of p) ; + fill fullcircle scaled 2 shifted point xpart v of p ; + setbounds currentpicture to center currentpicture -- cycle ; + ) +enddef ; + +primarydef p shownshadedirection v = + image ( + drawarrow (point xpart v of boundingbox p) -- (point ypart v of boundingbox p) ; + fill fullcircle scaled 2 shifted (point xpart v of boundingbox p) ; + setbounds currentpicture to center currentpicture -- cycle ; + ) +enddef ; + +primarydef p shownshadecenter v = + image ( + fill fullcircle scaled 2 + shifted center p shifted ( + xpart v * bbwidth (p)/2, + ypart v * bbheight(p)/2 + ) ; + setbounds currentpicture to center currentpicture -- cycle ; + ) +enddef ; + +primarydef p shownshadeorigin v = + image ( + fill fullcircle scaled 2 shifted v ; + setbounds currentpicture to center currentpicture -- cycle ; + ) +enddef ; + % Old macros: def withcircularshade (expr a, b, ra, rb, ca, cb) = withprescript "sh_type=circular" + withprescript "sh_transform=yes" withprescript "sh_domain=0 1" withprescript "sh_factor=1" withprescript "sh_color_a=" & colordecimals ca @@ -632,6 +827,7 @@ enddef ; def withlinearshade (expr a, b, ca, cb) = withprescript "sh_type=linear" + withprescript "sh_transform=yes" withprescript "sh_domain=0 1" withprescript "sh_factor=1" withprescript "sh_color_a=" & colordecimals ca @@ -830,11 +1026,17 @@ vardef mfun_do_outline_text_flush (expr kind, n, x, y) (text t) = mfun_do_outline_text_r (n, x, y) (t) elseif kind = "p" : mfun_do_outline_text_p (n, x, y) (t) + elseif kind = "u" : + mfun_do_outline_text_u (n, x, y) (t) else : mfun_do_outline_text_n (n, x, y) (t) fi ; enddef ; +vardef mfun_do_outline_rule_flush (expr kind, x, y, w, h) = + mfun_do_outline_text_flush (kind, 1, x, y) (fullsquare xyscaled(w,h)) +enddef ; + numeric mfun_do_outline_n ; mfun_do_outline_n := 0 ; vardef mfun_do_outline_text_f (expr n, x, y) (text t) = @@ -842,7 +1044,19 @@ vardef mfun_do_outline_text_f (expr n, x, y) (text t) = for i=t : mfun_do_outline_n := mfun_do_outline_n + 1 ; if mfun_do_outline_n = n : - fill i shifted(x,y) mfun_do_outline_options_f + fill i shifted(x,y) mfun_do_outline_options_f withpen pencircle scaled 0 + else : + nofill i shifted(x,y) + fi ; + endfor ; +enddef ; + +vardef mfun_do_outline_text_u (expr n, x, y) (text t) = + mfun_do_outline_n := 0 ; + for i=t : + mfun_do_outline_n := mfun_do_outline_n + 1 ; + if mfun_do_outline_n = n : + fillup i shifted(x,y) mfun_do_outline_options_f else : nofill i shifted(x,y) fi ; @@ -935,6 +1149,9 @@ def mfun_do_outline_options_r = enddef ; vardef outlinetext@# (expr t) text rest = save kind ; string kind ; kind := str @# ; currentoutlinetext := currentoutlinetext + 1 ; + def mfun_do_outline_options_d = enddef ; + def mfun_do_outline_options_f = enddef ; + def mfun_do_outline_options_r = enddef ; image ( normaldraw image ( if mfun_trial_run : % lua.mp.report("set outline text",currentoutlinetext); @@ -951,6 +1168,8 @@ vardef outlinetext@# (expr t) text rest = mfun_do_outline_text_set_d rest ; elseif kind = "b" : mfun_do_outline_text_set_b rest ; + elseif kind = "u" : + mfun_do_outline_text_set_f rest ; elseif kind = "r" : mfun_do_outline_text_set_r rest ; elseif kind = "p" : @@ -1026,19 +1245,19 @@ vardef properties(text t) = image(draw unitcircle t) enddef ; -if metapostversion < 1.770 : - - def withproperties expr p = - if colormodel p = 3 : - withcolor greypart p - elseif colormodel p = 5 : - withcolor (redpart p,greenpart p,bluepart p) - elseif colormodel p = 7 : - withcolor (cyanpart p,magentapart p,yellowpart p,blackpart p) - fi - enddef ; - -else : +% if metapostversion < 1.770 : +% +% def withproperties expr p = +% if colormodel p = 3 : +% withcolor greypart p +% elseif colormodel p = 5 : +% withcolor (redpart p,greenpart p,bluepart p) +% elseif colormodel p = 7 : +% withcolor (cyanpart p,magentapart p,yellowpart p,blackpart p) +% fi +% enddef ; +% +% else : def withproperties expr p = if colormodel p = 3 : @@ -1052,7 +1271,7 @@ else : withpostscript postscriptpart p enddef ; -fi ; +% fi ; % Experimental: @@ -1065,11 +1284,7 @@ primarydef t asgroup s = % s = isolated|knockout wrappedpicture:= nullpicture ; addto wrappedpicture contour groupbounds withprescript "gr_state=start" - withprescript "gr_type=" & s - withprescript "gr_llx=" & decimal xpart llcorner groupbounds - withprescript "gr_lly=" & decimal ypart llcorner groupbounds - withprescript "gr_urx=" & decimal xpart urcorner groupbounds - withprescript "gr_ury=" & decimal ypart urcorner groupbounds ; + withprescript "gr_type=" & s ; addto wrappedpicture also grouppicture ; addto wrappedpicture contour groupbounds withprescript "gr_state=stop" ; @@ -1166,32 +1381,31 @@ vardef mfun_boolean_to_string(expr b) = if b : "true" else : "false" fi enddef ; -% def passvariable(expr key, value) = -% special -% if numeric value : "1:" & key & "=" & mfun_numeric_to_string(value) -% elseif pair value : "4:" & key & "=" & mfun_pair_to_string(value) -% elseif rgbcolor value : "5:" & key & "=" & mfun_rgbcolor_to_string(value) -% elseif cmykcolor value : "6:" & key & "=" & mfun_cmykcolor_to_string(value) -% elseif boolean value : "3:" & key & "=" & mfun_boolean_to_string(value) -% elseif path value : "7:" & key & "=" & mfun_path_to_string(value) -% elseif transform value : "8:" & key & "=" & mfun_transform_to_string(value) -% else : "2:" & key & "=" & value -% fi ; -% enddef ; - -vardef tostring(expr value) = - if numeric value : mfun_numeric_to_string(value) - elseif pair value : mfun_pair_to_string(value) - elseif rgbcolor value : mfun_rgbcolor_to_string(value) - elseif cmykcolor value : mfun_cmykcolor_to_string(value) - elseif greycolor value : mfun_greycolor_to_string(value) - elseif boolean value : mfun_boolean_to_string(value) - elseif path value : mfun_path_to_string(value) - elseif transform value : mfun_transform_to_string(value) - else : value +vardef tostring primary v = + if numeric v : mfun_numeric_to_string(v) + elseif pair v : mfun_pair_to_string(v) + elseif rgbcolor v : mfun_rgbcolor_to_string(v) + elseif cmykcolor v : mfun_cmykcolor_to_string(v) + elseif greycolor v : mfun_greycolor_to_string(v) + elseif boolean v : mfun_boolean_to_string(v) + elseif path v : mfun_path_to_string(v) + elseif transform v : mfun_transform_to_string(v) + else : v fi enddef ; +vardef topair primary p = + if pair p : "(" & decimal xpart p & "," & decimal ypart p & ")" + elseif numeric p : "(" & decimal p & "," & decimal p & ")" + else : "" fi +enddef ; + +string dq ; dq := char 92 & char 34 ; +string sq ; sq := char 92 & char 39 ; + +vardef quote primary s = sq & tostring(s) & sq enddef; +vardef quotation primary s = dq & tostring(s) & dq enddef; + vardef mfun_tagged_string(expr value) = if numeric value : "1:" & mfun_numeric_to_string(value) elseif pair value : "4:" & mfun_pair_to_string(value) @@ -1204,178 +1418,106 @@ vardef mfun_tagged_string(expr value) = fi enddef ; -% amore flexible variant for passing data to context +% A more flexible variant for passing data to context. We used to construct strings +% but running lua is fast enough so we can gain on string construction in metapost +% which is also not that efficient. -vardef mfun_point_to_lua(expr p,i) = - "{" & - decimal xpart (point i of p) & "," & - decimal ypart (point i of p) & "," & - decimal xpart (precontrol i of p) & "," & - decimal ypart (precontrol i of p) & "," & - decimal xpart (postcontrol i of p) & "," & - decimal ypart (postcontrol i of p) - & "}" +vardef mfun_key_to_lua(expr k) = + if numeric k : decimal k else : "'" & k & "'" fi enddef ; -vardef mfun_transform_to_lua(expr t) = - "{" & - decimal xxpart t & "," & % rx - decimal xypart t & "," & % sx - decimal yxpart t & "," & % sy - decimal yypart t & "," & % ry - decimal xpart t & "," & % tx - decimal ypart t % ty - & "}" +vardef mfun_point_to_lua(expr k,p,i) = + runscript( "metapost.setvariable(" & mfun_key_to_lua(k) & ",{" & + decimal xpart (point i of p) & "," & + decimal ypart (point i of p) & "," & + decimal xpart (precontrol i of p) & "," & + decimal ypart (precontrol i of p) & "," & + decimal xpart (postcontrol i of p) & "," & + decimal ypart (postcontrol i of p) + & "})" ) ; enddef ; -vardef mfun_numeric_to_lua(expr n) = - decimal n +vardef mfun_transform_to_lua(expr k,t) = + runscript( "metapost.setvariable(" & mfun_key_to_lua(k) & ",{" & + decimal xxpart t & "," & % rx + decimal xypart t & "," & % sx + decimal yxpart t & "," & % sy + decimal yypart t & "," & % ry + decimal xpart t & "," & % tx + decimal ypart t % ty + & "})" ) ; enddef ; -vardef mfun_pair_to_lua(expr p) = - "{" & - decimal xpart p & "," & - decimal ypart p - & "}" +vardef mfun_numeric_to_lua(expr k,n) = + runscript( "metapost.setvariable(" & mfun_key_to_lua(k) & "," & decimal n & ")" ) ; enddef ; -vardef mfun_rgbcolor_to_lua(expr c) = - "{" & - decimal redpart c & "," & - decimal greenpart c & "," & - decimal bluepart c - & "}" +vardef mfun_pair_to_lua(expr k,p) = + runscript( "metapost.setvariable(" & mfun_key_to_lua(k) & ",{" & + decimal xpart p & "," & + decimal ypart p + & "})" ) ; enddef ; -vardef mfun_cmykcolor_to_lua(expr c) = - "{" & - decimal cyanpart c & "," & - decimal magentapart c & "," & - decimal yellowpart c & "," & - decimal blackpart c - & "}" +vardef mfun_rgbcolor_to_lua(expr k,c) = + runscript( "metapost.setvariable(" & mfun_key_to_lua(k) & ",{" & + decimal redpart c & "," & + decimal greenpart c & "," & + decimal bluepart c + & "})" ) ; enddef ; -vardef mfun_path_to_lua(expr p) = - "{" & - mfun_point_to_lua(p,0) for i=1 upto length(p) : & "," & mfun_point_to_lua(p,i) endfor - & "}" +vardef mfun_cmykcolor_to_lua(expr k,c) = + runscript( "metapost.setvariable(" & mfun_key_to_lua(k) & ",{" & + decimal cyanpart c & "," & + decimal magentapart c & "," & + decimal yellowpart c & "," & + decimal blackpart c + & "})" ) ; enddef ; -vardef mfun_boolean_to_lua(expr b) = - if b : "true" else : "false" fi -enddef ; - -vardef mfun_string_to_lua(expr s) = - "[==[" & s & "]==]" +vardef mfun_path_to_lua(expr k,p) = + runscript("metapost.pushvariable(" & mfun_key_to_lua(k) & ")") ; + for i=0 upto length(p) : + mfun_point_to_lua(i+1,p,i) ; + endfor ; + runscript("metapost.popvariable()") ; enddef ; -def mfun_to_lua(expr key)(expr value)(text t) = - special "metapost.variables['" & key & "']=" & t(value) ; +vardef mfun_boolean_to_lua(expr k,b) = + runscript( "metapost.setvariable(" & mfun_key_to_lua(k) & if b : ",true)" else : ",false)" fi ) ; enddef ; -def mfun_array_to_lua(expr key)(suffix value)(expr first, last, stp)(text t) = - special - "metapost.variables['" & key & "']={" - for i=first step stp until last : - & "[" & decimal i & "]=" & t(value[i]) & "," - endfor - & "}" ; +vardef mfun_string_to_lua(expr k,s) = + runscript( "metapost.setvariable(" & mfun_key_to_lua(k) & ",[==[" & s & "]==])" ) ; enddef ; def passvariable(expr key, value) = - if numeric value : mfun_to_lua(key,value,mfun_numeric_to_lua) - elseif pair value : mfun_to_lua(key,value,mfun_pair_to_lua) - elseif string value : mfun_to_lua(key,value,mfun_string_to_lua) - elseif boolean value : mfun_to_lua(key,value,mfun_boolean_to_lua) - elseif path value : mfun_to_lua(key,value,mfun_path_to_lua) - elseif rgbcolor value : mfun_to_lua(key,value,mfun_rgbcolor_to_lua) - elseif cmykcolor value : mfun_to_lua(key,value,mfun_cmykcolor_to_lua) - elseif transform value : mfun_to_lua(key,value,mfun_transform_to_lua) + if numeric value : mfun_numeric_to_lua (key,value) ; + elseif pair value : mfun_pair_to_lua (key,value) ; + elseif string value : mfun_string_to_lua (key,value) ; + elseif boolean value : mfun_boolean_to_lua (key,value) ; + elseif path value : mfun_path_to_lua (key,value) ; + elseif rgbcolor value : mfun_rgbcolor_to_lua (key,value) ; + elseif cmykcolor value : mfun_cmykcolor_to_lua(key,value) ; + elseif transform value : mfun_transform_to_lua(key,value) ; fi ; enddef ; def passarrayvariable(expr key)(suffix values)(expr first, last, stp) = - if numeric values[first] : mfun_array_to_lua(key,values,first,last,stp,mfun_numeric_to_lua) - elseif pair values[first] : mfun_array_to_lua(key,values,first,last,stp,mfun_pair_to_lua) - elseif string values[first] : mfun_array_to_lua(key,values,first,last,stp,mfun_string_to_lua) - elseif boolean values[first] : mfun_array_to_lua(key,values,first,last,stp,mfun_boolean_to_lua) - elseif path values[first] : mfun_array_to_lua(key,values,first,last,stp,mfun_path_to_lua) - elseif rgbcolor values[first] : mfun_array_to_lua(key,values,first,last,stp,mfun_rgbcolor_to_lua) - elseif cmykcolor values[first] : mfun_array_to_lua(key,values,first,last,stp,mfun_cmykcolor_to_lua) - elseif transform values[first] : mfun_array_to_lua(key,values,first,last,stp,mfun_transform_to_lua) - fi ; + runscript("metapost.pushvariable(" & mfun_key_to_lua(key) & ")") ; + for i=first step stp until last : + passvariable(i, values[i]) ; + endfor + runscript("metapost.popvariable()") ; enddef ; def startpassingvariable(expr k) = - begingroup ; - save stoppassingvariable, startarray, stoparray, starthash, stophash, index, key, value, slot, entry ; - let stoppassingvariable = mfun_stop_lua_variable ; - let startarray = mfun_start_lua_array ; - let stoparray = mfun_stop_lua_array ; - let starthash = mfun_start_lua_hash ; - let stophash = mfun_stop_lua_hash ; - let index = mfun_lua_index ; - let key = mfun_lua_key ; - let value = mfun_lua_value ; - let slot = mfun_lua_slot ; - let entry = mfun_lua_entry ; - save s ; string s ; - s := "metapost.variables['" & k & "']=" -enddef ; - -def mfun_stop_lua_variable = - ; - special substring(0,length(s)-1) of s ; - endgroup ; + runscript("metapost.pushvariable(" & mfun_key_to_lua(k) & ")") ; enddef ; -% currently there is no difference between array and hash - -def mfun_start_lua_array = - & "{" -enddef ; - -def mfun_stop_lua_array = - & "}," -enddef ; - -def mfun_start_lua_hash = - & "{" -enddef ; - -def mfun_stop_lua_hash = - & "}," -enddef ; - -def mfun_lua_key(expr k) = - & "['" & k & "']=" -enddef ; - -def mfun_lua_index(expr k) = - & "[" & decimal k & "]=" -enddef ; - -def mfun_lua_value(expr v) = - if numeric v : & mfun_numeric_to_lua(v) & "," - elseif pair v : & mfun_pair_to_lua(v) & "," - elseif string v : & mfun_string_to_lua(v) & "," - elseif boolean v : & mfun_boolean_to_lua(v) & "," - elseif path v : & mfun_path_to_lua(v) & "," - elseif rgbcolor v : & mfun_rgbcolor_to_lua(v) & "," - elseif cmykcolor v : & mfun_cmykcolor_to_lua(v) & "," - elseif transform v : & mfun_transform_to_lua(v) & "," - fi -enddef ; - -def mfun_lua_entry(expr k, v) = - mfun_lua_key(k) - mfun_lua_value(v) -enddef ; - -def mfun_lua_slot(expr k, v) = - mfun_lua_index(k) - mfun_lua_value(v) +def stoppassingvariable = + runscript("metapost.popvariable()") ; enddef ; % moved here from mp-grap.mpiv @@ -1449,6 +1591,9 @@ vardef formatted(expr f, x) = textext(varfmt(f, x)) enddef ; % def strfmt = format enddef ; % old % def varfmt = formatted enddef ; % old + +% def fmttext = lua.mp.formatted enddef ; + % new def fillup text t = draw t withpostscript "both" enddef ; % we use draw because we need the proper boundingbox @@ -1460,3 +1605,52 @@ def nofill text t = fill t withpostscript "collect" enddef ; % def withrule expr r = % if (t = "even-odd") or (t = "evenodd") : withpostscript "evenodd" fi % enddef ; + +% so we can do: withcolor "red" + +vardef resolvedcolor primary s = + % lua.mp.namedcolor(s) % conflicts with macro namedcolor + % lua.mp.NamedColor(s) % okay but, can also be + % lua.mp("NamedColor",s) % which gives expansion mess + if string s : + runscript("mp.NamedColor('" & s & "')") % faster anyway + else : + s + fi +enddef ; + +% A comment will end up on top of the graphic in the output. This can be handy for +% locating a graphic: comment("test graphic"). + +def comment expr str = + special "metapost.comment[[" & str & "]]" ; +enddef ; + +% This overloads a dummy: + +vardef uniquelist(suffix list) = + % this can be optimized by passing all values at once and returning + % a result but for now this is ok .. we need an undef foo + save i, j, h ; + if known lis[0] : + i := 0 ; + j := -1 ; + else : + i := 1 ; + j := 0 ; + fi ; + h := lua.mp.newhash() ; + forever : + exitif unknown list[i] ; + if not lua.mp.inhash(h,list[i]) : + j := j + 1 ; + list[j] := list[i] ; + lua.mp.tohash(h,list[i]) ; + fi ; + i := i + 1 ; + endfor ; + for n = j+1 step 1 until i-1 : + dispose(list[n]) + endfor ; + lua.mp.disposehash(h) ; +enddef ; diff --git a/metapost/context/base/mpiv/mp-node.mpiv b/metapost/context/base/mpiv/mp-node.mpiv new file mode 100644 index 000000000..fdd308ad1 --- /dev/null +++ b/metapost/context/base/mpiv/mp-node.mpiv @@ -0,0 +1,182 @@ +%D \module +%D [ file=mp-node.mpiv, +%D version=1998.02.15, +%D title=\CONTEXT\ \METAPOST\ graphics, +%D subtitle=Node Based Graphics, +%D author=Alan Braslau, +%D date=\currentdate, +%D copyright={Alan Braslau & \CONTEXT\ Development Team}] +%C +%C This module is part of the \CONTEXT\ macro||package and is +%C therefore copyrighted by \PRAGMA. See mreadme.pdf for +%C details. + +%D Ths crossing macros were written as part of this module but as they +%D can be of use elsewhere they are defined in mp-tool. + +if known context_node : endinput ; fi ; + +boolean context_node ; context_node := true ; + +% returns a pair suffix if the path is unknown + +vardef makenode@#(suffix p)(text t) = + save i, b ; numeric i ; string b ; + for a = t : + if unknown i : % first argument is the index + i = a ; + if isarray p : + % + % note that one needs to declare "path p[] ; picture p[]pic[] ;" + % before calling node() if one is to use a pseudo-array for p + % because "picture p1.pic[] ;" is not a valid syntax! + % + % The following works, but is a bit awkward... + % + b := prefix p ; + if not picture p.pic[i] : scantokens("picture " & b & "[]pic[] ;") ; fi + if not pair p.pos[i] : scantokens("pair " & b & "[]pos[] ;") ; fi + else : + if not picture p.pic[i] : picture p.pic[] ; fi + if not pair p.pos[i] : pair p.pos[] ; fi + fi + else : + if known p.pic[i] : + addto p.pic[i] also + else : + p.pic[i] := + fi + if picture a : a + elseif string a : textext@#(a) + elseif numeric a : textext@#(decimal a) + elseif ((boolean a) and a) : image(draw origin) + else : nullpicture + fi ; + fi + endfor + p.pos[i] if known p : := point i of p ; fi +enddef ; + +% returns a picture + +vardef node@#(suffix p)(text t) = + if pair makenode@#(p)(t) : + % nop: gobble the function return. + fi + for a = t : + if (unknown p) and (known p.pos[a]) : + makenodepath(p) ; + fi + if known p.pic[a] : + p.pic[a] if known p : shifted point a of p fi + else : + nullpicture + fi + exitif true ; + endfor +enddef ; + +% returns a path + +vardef fromto@#(expr d)(suffix p)(expr f)(suffix q)(text s) = + save r, t, l ; + path r[] ; numeric t ; picture l ; + for a = s : + if unknown t : + t = a ; + if (unknown p) and (known p.pos[f]) : + makenodepath(p) ; + fi + if (unknown q) and (known q.pos[t]) : + makenodepath(q) ; + fi + r0 = if ((not numeric d) and + (point f of p = point f of q) and + (point t of p = point t of q)) : + subpath (f,t) of p + else : + point f of p -- point t of q + fi ; + save deviation ; numeric deviation ; + deviation := if numeric d: d else: 0 fi ; + r1 = if deviation=0 : r0 + else : + point 0 of r0 .. + unitvector direction .5length r0 of r0 rotated 90 + scaled deviation * arclength r0 + shifted point .5length r0 of r0 .. + point length r0 of r0 + fi ; + else : + if known l : + addto l also + else : + l := + fi + if picture a : a + elseif string a : textext@#(a) + elseif numeric a : textext@#(decimal a) + elseif ((boolean a) and a) : image(draw origin withpen currentpen scaled 4) + else : nullpicture + fi ; + fi + endfor + r2 = r1 + if known p.pic[f if cycle p: mod length p fi] : + cutbefore boundingbox (p.pic[f if cycle p: mod length p fi] shifted point f of p) + fi + if known q.pic[t if cycle q: mod length q fi] : + cutafter boundingbox (q.pic[t if cycle q: mod length q fi] shifted point t of q) + fi + ; + if known l : + l := l shifted point .5length r2 of r2 ; + draw l ; + (r2 if str @# = "" : crossingunder l fi) + else : + r2 + fi +enddef ; + +% returns pair: bounding point of the node picture + +vardef nodeboundingpoint@#(suffix p)(expr i) = + if known p.pic[i] : + boundingpoint@#(p.pic[i]) + else : + origin + fi +enddef ; + +% returns pair: scaled laboff direction + +vardef relative@#(expr s) = + (mfun_laboff@# scaled s) +enddef ; + +% returns pair: vector between nodes (+ optional scale) + +vardef betweennodes@#(suffix p)(expr f)(suffix q)(text s) = + save t ; numeric t ; + for a = s : + if unknown t : + t = a ; + nodeboundingpoint@#(q,t) + nodeboundingpoint@#(p,f) + else : + + relative@#(a) + fi + endfor +enddef ; + +% build a path from the node positions. +% Must be continuous in index starting at 0. + +vardef makenodepath(suffix p) = + if unknown p : + save i ; i = -1 ; + p = forever : exitif unknown p.pos[incr i] ; + p.pos[i] -- + endfor cycle ; + fi +enddef ; + diff --git a/metapost/context/base/mpiv/mp-page.mpiv b/metapost/context/base/mpiv/mp-page.mpiv index 2e4a2b437..f32990677 100644 --- a/metapost/context/base/mpiv/mp-page.mpiv +++ b/metapost/context/base/mpiv/mp-page.mpiv @@ -290,16 +290,24 @@ vardef CutSpace = if mfun_swapped and not OnRightPage : PaperWidth - vardef OuterMarginWidth = if not OnRightPage : lua.mp.LeftMarginWidth () else : lua.mp.RightMarginWidth () fi enddef ; vardef InnerMarginWidth = if not OnRightPage : lua.mp.RightMarginWidth () else : lua.mp.LeftMarginWidth () fi enddef ; vardef OuterMarginDistance = if not OnRightPage : lua.mp.LeftMarginDistance () else : lua.mp.RightMarginDistance() fi enddef ; -vardef InnerMarginDistance = if not OnRightPage : lua.mp.RightMarginDistance() else : lua.mp.leftMarginDistance () fi enddef ; +vardef InnerMarginDistance = if not OnRightPage : lua.mp.RightMarginDistance() else : lua.mp.LeftMarginDistance () fi enddef ; vardef OuterEdgeWidth = if not OnRightPage : lua.mp.LeftEdgeWidth () else : lua.mp.RightEdgeWidth () fi enddef ; vardef InnerEdgeWidth = if not OnRightPage : lua.mp.RightEdgeWidth () else : lua.mp.LeftEdgeWidth () fi enddef ; vardef OuterEdgeDistance = if not OnRightPage : lua.mp.LeftEdgeDistance () else : lua.mp.RightEdgeDistance () fi enddef ; -vardef InnerEdgeDistance = if not OnRightPage : lua.mp.RightEdgeDistance () else : lua.mp.leftEdgeDistance () fi enddef ; +vardef InnerEdgeDistance = if not OnRightPage : lua.mp.RightEdgeDistance () else : lua.mp.LeftEdgeDistance () fi enddef ; vardef OuterSpaceWidth = if not OnRightPage : lua.mp.BackSpace () else : lua.mp.CutSpace () fi enddef ; vardef InnerSpaceWidth = if not OnRightPage : lua.mp.CutSpace () else : lua.mp.BackSpace () fi enddef ; +% indices + +vardef OuterMargin = if not OnRightPage : LeftMargin else : RightMargin fi enddef ; +vardef InnerMargin = if not OnRightPage : RightMargin else : LeftMargin fi enddef ; + +vardef OuterEdge = if not OnRightPage : LeftEdge else : RightEdge fi enddef ; +vardef InnerEdge = if not OnRightPage : Rightedge else : LeftEdge fi enddef ; + % vardef CurrentLayout = lua.mp.CurrentLayout () enddef ; vardef OverlayWidth = lua.mp.OverlayWidth () enddef ; @@ -670,6 +678,8 @@ string RuleOption ; RuleOption := "" ; numeric RuleWidth ; RuleWidth := 0 ; numeric RuleHeight ; RuleHeight := 0 ; numeric RuleDepth ; RuleDepth := 0 ; +numeric RuleH ; RuleH := 0 ; +numeric RuleV ; RuleV := 0 ; numeric RuleThickness ; RuleThickness := 0 ; numeric RuleFactor ; RuleFactor := 0 ; numeric RuleOffset ; RuleOffset := 0 ; diff --git a/metapost/context/base/mpiv/mp-shap.mpiv b/metapost/context/base/mpiv/mp-shap.mpiv index 713656510..a511ef375 100644 --- a/metapost/context/base/mpiv/mp-shap.mpiv +++ b/metapost/context/base/mpiv/mp-shap.mpiv @@ -74,6 +74,8 @@ def stop_predefined_shape_definition = enddef ; +% this can be delayed + start_predefined_shape_definition ; predefined_shapes[ 0] := (origin--cycle) ; @@ -143,7 +145,7 @@ start_predefined_shape_definition ; stop_predefined_shape_definition ; vardef some_shape_path (expr type) = - if known predefined_shapes[type] : predefined_shapes[type] else : predefined_shapes[0] fi + if known predefined_shapes[type] : predefined_shapes[type] else : predefined_shapes[24] fi enddef ; def some_shape (expr shape_type, shape_width, shape_height, shape_linewidth, shape_linecolor, shape_fillcolor) = @@ -156,14 +158,22 @@ def some_shape (expr shape_type, shape_width, shape_height, shape_linewidth, sha endgroup ; enddef ; +% maybe: +% +% if t>1 : % normal shape +% path pp ; pp := some_shape_path(t) xyscaled(bbwidth(p), bbheight(p)) ; +% pp := pp shifted - center pp shifted center p ; +% fill pp withcolor fc ; +% draw pp withpen pencircle scaled lw withcolor lc ; + vardef drawpredefinedshape (expr t, p, lw, lc, fc) = save pp ; - if t>1 : % normal shape + if t > 1 : % normal shape path pp ; pp := some_shape_path(t) xyscaled(bbwidth(p), bbheight(p)) shifted center p ; fill pp withcolor fc ; draw pp withpen pencircle scaled lw withcolor lc ; - elseif t=1 : % background only + elseif t = 1 : % background only path pp ; pp := fullsquare xyscaled(bbwidth(p), bbheight(p)) shifted center p ; fill pp withcolor fc ; diff --git a/metapost/context/base/mpiv/mp-step.mpiv b/metapost/context/base/mpiv/mp-step.mpiv index f7a7ba5de..16d6be3a7 100644 --- a/metapost/context/base/mpiv/mp-step.mpiv +++ b/metapost/context/base/mpiv/mp-step.mpiv @@ -11,11 +11,12 @@ %C therefore copyrighted by \PRAGMA. See licen-en.pdf for %C details. -% step prefixes .. no save needed +% maybe todo: step prefixes .. no save needed +% not todo : make it unreadable by lots of suffix compaction -if known context_cell : endinput ; fi ; +if known context_step : endinput ; fi ; -boolean context_cell ; context_cell := true ; +boolean context_step ; context_step := true ; def initialize_step_variables = save @@ -23,14 +24,16 @@ def initialize_step_variables = cell_fill_color, cell_line_color, cell_line_width, cell_offset, line_line_color, line_line_width, line_alternative, line_distance, cell_distance_y, cell_distance_x, - nofcells, chart_vertical ; + nofcells, chart_vertical, chart_align, chart_category ; - color text_line_color ; text_line_color := red ; - color cell_line_color ; cell_line_color := blue ; - color line_line_color ; line_line_color := green ; + string chart_category ; chart_category := "" ; - color text_fill_color ; text_fill_color := white ; - color cell_fill_color ; cell_fill_color := white ; + string text_line_color ; text_line_color := "red" ; + string cell_line_color ; cell_line_color := "blue" ; + string line_line_color ; line_line_color := "green" ; + + string text_fill_color ; text_fill_color := "white" ; + string cell_fill_color ; cell_fill_color := "white" ; numeric text_line_width ; text_line_width := 2pt ; numeric cell_line_width ; cell_line_width := 2pt ; @@ -49,6 +52,7 @@ def initialize_step_variables = numeric text_distance_set ; text_distance_set := 4pt ; boolean chart_vertical ; chart_vertical := false ; + boolean chart_align ; chart_align := false ; numeric nofcells ; nofcells := 0 ; @@ -56,17 +60,17 @@ enddef ; def step_cells (expr t, b) = nofcells := nofcells + 1 ; - cells_t[nofcells] := textext.d(t) ; - cells_b[nofcells] := textext.d(b) ; + cells_t[nofcells] := texbox.d(chart_category,t) ; + cells_b[nofcells] := texbox.d(chart_category,b) ; texts_t[nofcells] := nullpicture ; texts_m[nofcells] := nullpicture ; texts_b[nofcells] := nullpicture ; enddef ; -def step_texts (expr t, b) = - texts_t[nofcells] := textext.d(t) ; - texts_m[nofcells] := textext.d(m) ; - texts_b[nofcells] := textext.d(b) ; +def step_texts (expr t, m, b) = + texts_t[nofcells] := texbox.d(chart_category,t) ; + texts_m[nofcells] := texbox.d(chart_category,m) ; + texts_b[nofcells] := texbox.d(chart_category,b) ; enddef ; def step_begin_cell = @@ -81,11 +85,66 @@ enddef ; def step_end_cell = enddef ; -def step_cell_top (expr t) = cells_t[nofcells] := textext.d(t) ; enddef ; -def step_cell_bot (expr b) = cells_b[nofcells] := textext.d(b) ; enddef ; -def step_text_top (expr t) = texts_t[nofcells] := textext.d(t) ; enddef ; -def step_text_mid (expr m) = texts_m[nofcells] := textext.d(m) ; enddef ; -def step_text_bot (expr b) = texts_b[nofcells] := textext.d(b) ; enddef ; +% maybe: texbox.d + +def step_cell_top (expr t, c, f, l, s) = + cells_t[nofcells] := texbox.d(chart_category,t) ; + cell_top_colors[nofcells] := c ; + cell_top_fills [nofcells] := f ; + cell_top_lines [nofcells] := l ; + cell_top_shapes[nofcells] := s ; +enddef ; + +def step_cell_bot (expr b, c, f, l, s) = + cells_b[nofcells] := texbox.d(chart_category,b) ; + cell_bot_colors[nofcells] := c ; + cell_bot_fills [nofcells] := f ; + cell_bot_lines [nofcells] := l ; + cell_bot_shapes[nofcells] := s ; +enddef ; + +def step_cell_ali (expr ca, cb, cc, c, f, l, s) = + cells_a[nofcells][1] := texbox.d(chart_category,ca) ; + cells_a[nofcells][2] := texbox.d(chart_category,cb) ; + cells_a[nofcells][3] := texbox.d(chart_category,cc) ; + cell_top_colors[nofcells] := c ; + cell_top_fills [nofcells] := f ; + cell_top_lines [nofcells] := l ; + cell_top_shapes[nofcells] := s ; +enddef ; + +def step_text_top (expr t, tc, tf, tl, ts, lc, ll, ls) = + texts_t[nofcells] := texbox.d(chart_category,t) ; + text_top_colors[nofcells] := tc ; + text_top_fills [nofcells] := tf ; + text_top_lines [nofcells] := tl ; + text_top_shapes[nofcells] := ts ; + line_top_colors[nofcells] := lc ; + line_top_lines [nofcells] := ll ; + line_top_shapes[nofcells] := ls ; +enddef ; + +def step_text_mid (expr m, tc, tf, tl, ts, lc, ll, ls) = + texts_m[nofcells] := texbox.d(chart_category,m) ; + text_mid_colors[nofcells] := tc ; + text_mid_fills [nofcells] := tf ; + text_mid_lines [nofcells] := tl ; + text_mid_shapes[nofcells] := ts ; + line_mid_colors[nofcells] := lc ; + line_mid_lines [nofcells] := ll ; + line_mid_shapes[nofcells] := ls ; +enddef ; + +def step_text_bot (expr b, tc, tf, tl, ts, lc, ll, ls) = + texts_b[nofcells] := texbox.d(chart_category,b) ; + text_bot_colors[nofcells] := tc ; + text_bot_fills [nofcells] := tf ; + text_bot_lines [nofcells] := tl ; + text_bot_shapes[nofcells] := ts ; + line_bot_colors[nofcells] := lc ; + line_bot_lines [nofcells] := ll ; + line_bot_shapes[nofcells] := ls ; +enddef ; def step_begin_chart = begingroup ; @@ -93,6 +152,44 @@ def step_begin_chart = save nofcells ; numeric nofcells ; nofcells := 0 ; save cells_t, cells_m, cells_b ; picture cells_t[], cells_m[], cells_b[] ; save texts_t, texts_m, texts_b ; picture texts_t[], texts_m[], texts_b[] ; + save start_t, start_m, start_b ; numeric start_t[], start_m[], start_b[] ; + save cells_a ; picture cells_a[][] ; + + save cell_top_colors ; string cell_top_colors[] ; + save cell_bot_colors ; string cell_bot_colors[] ; + save text_top_colors ; string text_top_colors[] ; + save text_mid_colors ; string text_mid_colors[] ; + save text_bot_colors ; string text_bot_colors[] ; + + save cell_top_fills ; string cell_top_fills[] ; + save cell_bot_fills ; string cell_bot_fills[] ; + save text_top_fills ; string text_top_fills[] ; + save text_mid_fills ; string text_mid_fills[] ; + save text_bot_fills ; string text_bot_fills[] ; + + save cell_top_lines ; numeric cell_top_lines[] ; + save cell_bot_lines ; numeric cell_bot_lines[] ; + save text_top_lines ; numeric text_top_lines[] ; + save text_mid_lines ; numeric text_mid_lines[] ; + save text_bot_lines ; numeric text_bot_lines[] ; + + save cell_top_shapes ; numeric cell_top_shapes[] ; + save cell_bot_shapes ; numeric cell_bot_shapes[] ; + save text_top_shapes ; numeric text_top_shapes[] ; + save text_mid_shapes ; numeric text_mid_shapes[] ; + save text_bot_shapes ; numeric text_bot_shapes[] ; + + save line_top_lines ; numeric line_top_lines[] ; + save line_mid_lines ; numeric line_mid_lines[] ; + save line_bot_lines ; numeric line_bot_lines[] ; + + save line_top_colors ; string line_top_colors[] ; + save line_mid_colors ; string line_mid_colors[] ; + save line_bot_colors ; string line_bot_colors[] ; + + save line_top_shapes ; numeric line_top_shapes[] ; + save line_mid_shapes ; numeric line_mid_shapes[] ; + save line_bot_shapes ; numeric line_bot_shapes[] ; enddef ; def step_end_chart = @@ -106,6 +203,7 @@ def step_end_chart = save height_t, width_t, max_height_t, max_width_t ; numeric height_t, width_t, max_height_t, max_width_t ; save height_m, width_m, max_height_m, max_width_m ; numeric height_m, width_m, max_height_m, max_width_m ; save height_b, width_b, max_height_b, max_width_b ; numeric height_b, width_b, max_height_b, max_width_b ; + save alternative ; numeric alternative ; % check rows one_row_only := true ; for i=1 upto nofcells : @@ -113,18 +211,43 @@ def step_end_chart = one_row_only := false ; fi ; endfor ; + % + if chart_align : + save size, delta, width ; numeric size[], delta[], width[] ; + for i=1 upto 3: + size[i] = 0 ; + for c=1 upto nofcells : + size[i] := max(size[i],bbwidth(cells_a[c][i])) ; + endfor ; + endfor ; + for c=1 upto nofcells : + cells_t[c] := image ( + for i=1 upto 3: + width[i] := bbwidth(cells_a[c][i]); + delta[i] := size[i] - width[i] ; + endfor; + setbounds cells_a[c][1] to boundingbox(cells_a[c][1]) leftenlarged (delta[1]) ; + setbounds cells_a[c][2] to boundingbox(cells_a[c][2]) leftenlarged (delta[2]/2) + rightenlarged(delta[2]/2) ; + setbounds cells_a[c][3] to boundingbox(cells_a[c][3]) rightenlarged(delta[3]) ; + cells_a[c][1] := cells_a[c][1] shifted (- width[1]/2 - size[2]/2 - text_distance_set,0) ; + cells_a[c][3] := cells_a[c][3] shifted ( width[3]/2 + size[2]/2 + text_distance_set,0) ; + for i=1 upto 3: + draw cells_a[c][i] ; + % draw boundingbox cells_a[c][i] ; + endfor ; + ) ; + endfor ; + fi ; % swap and rotate if chart_vertical : if one_row_only : % deal with mid_texts max_width_t := max_width_m := max_width_b := 0 ; for i=1 upto nofcells : - width_t := bbwidth(texts_t[i]) ; - width_m := bbwidth(texts_m[i]) ; - width_b := bbwidth(texts_b[i]) ; - if width_t > max_width_t : max_width_t := width_t fi ; - if width_m > max_width_m : max_width_m := width_m fi ; - if width_b > max_width_b : max_width_b := width_b fi ; + max_width_t := max(max_width_t,bbwidth(texts_t[i])); + max_width_m := max(max_width_m,bbwidth(texts_m[i])); + max_width_b := max(max_width_b,bbwidth(texts_b[i])); endfor ; if max_width_m > 0 : for i=1 upto nofcells : @@ -132,14 +255,17 @@ def step_end_chart = text_m := texts_m[i] ; width_m := bbwidth(text_m) ; text_b := texts_b[i] ; width_b := bbwidth(text_b) ; if width_t < max_width_t : - setbounds text_t to boundingbox text_t leftenlarged (max_width_t - width_t) ; + setbounds text_t to boundingbox text_t + leftenlarged (max_width_t - width_t) ; fi ; if width_m < max_width_m : - setbounds text_m to boundingbox text_m leftenlarged ((max_width_m - width_m)/2) ; - setbounds text_m to boundingbox text_m rightenlarged ((max_width_m - width_m)/2) ; + setbounds text_m to boundingbox text_m + leftenlarged ((max_width_m - width_m)/2) + rightenlarged ((max_width_m - width_m)/2) ; fi ; if width_b < max_width_b : - setbounds text_b to boundingbox text_b rightenlarged (max_width_b - width_b) ; + setbounds text_b to boundingbox text_b + rightenlarged (max_width_b - width_b) ; fi ; text_t := text_t shifted (- xpart llcorner text_t, 0) ; text_m := text_m shifted (- xpart llcorner text_m, 0) ; @@ -161,6 +287,7 @@ def step_end_chart = fi ; else : for i=1 upto nofcells : + % swaps so we need a scratch variable cell_t := cells_t[i] ; cell_b := cells_b[i] ; cells_t[i] := cell_b rotated 90 ; @@ -174,39 +301,31 @@ def step_end_chart = fi ; % align horizontal for i=1 upto nofcells : - cell_t := cells_t[i] ; - cell_b := cells_b[i] ; - width_t := bbwidth(cell_t) ; - width_b := bbwidth(cell_b) ; + width_t := bbwidth(cells_t[i]) ; + width_b := bbwidth(cells_b[i]) ; if (width_t = 0) and (width_b = 0) : % skip elseif (width_t > 0) and (width_t < width_b) : delta := (width_b-width_t)/2 ; - setbounds cell_t to boundingbox cell_t leftenlarged delta rightenlarged delta ; - cells_t[i] := cell_t ; + setbounds cells_t[i] to boundingbox cells_t[i] leftenlarged delta rightenlarged delta ; elseif (width_b > 0) and (width_t > width_b) : delta := (width_t-width_b)/2 ; - setbounds cell_b to boundingbox cell_b leftenlarged delta rightenlarged delta ; - cells_b[i] := cell_b ; + setbounds cells_b[i] to boundingbox cells_b[i] leftenlarged delta rightenlarged delta ; fi ; endfor ; % analyze vertical max_height_t := 0 ; max_height_b := 0 ; for i=1 upto nofcells : - cell_t := cells_t[i] ; - cell_b := cells_b[i] ; - height_t := bbheight(cell_t) ; - height_b := bbheight(cell_b) ; + height_t := bbheight(cells_t[i]) ; + height_b := bbheight(cells_b[i]) ; if height_t > 0 : - setbounds cell_t to boundingbox cell_t enlarged cell_offset ; + setbounds cells_t[i] to boundingbox cells_t[i] enlarged cell_offset ; height_t := height_t + 2 * cell_offset ; - cells_t[i] := cell_t ; fi ; if height_b > 0 : - setbounds cell_b to boundingbox cell_b enlarged cell_offset ; + setbounds cells_b[i] to boundingbox cells_b[i] enlarged cell_offset ; height_b := height_b + 2 * cell_offset ; - cells_b[i] := cell_b ; fi ; if height_t > max_height_t : max_height_t := height_t ; @@ -217,34 +336,24 @@ def step_end_chart = endfor ; % align vertical for i=1 upto nofcells : - cell_t := cells_t[i] ; - cell_b := cells_b[i] ; - height_t := bbheight(cell_t) ; - height_b := bbheight(cell_b) ; + height_t := bbheight(cells_t[i]) ; + height_b := bbheight(cells_b[i]) ; if height_t > 0 : delta := (max_height_t-height_t)/2 ; - setbounds cell_t to boundingbox cell_t topenlarged delta bottomenlarged delta ; + setbounds cells_t[i] to boundingbox cells_t[i] topenlarged delta bottomenlarged delta ; fi ; if height_b > 0 : delta := (max_height_b-height_b)/2 ; - setbounds cell_b to boundingbox cell_b topenlarged delta bottomenlarged delta ; + setbounds cells_b[i] to boundingbox cells_b[i] topenlarged delta bottomenlarged delta ; fi ; - cells_t[i] := cell_t ; - cells_b[i] := cell_b ; endfor ; % position dx := 0 ; for i=1 upto nofcells : - cell_t := cells_t[i] ; - cell_b := cells_b[i] ; - cell_t := cell_t shifted -llcorner cell_t ; - cell_b := cell_b shifted -llcorner cell_b ; - cell_t := cell_t shifted (dx, 0) ; - cell_b := cell_b shifted (dx,-cell_distance_y-max_height_b) ; - cells_t[i] := cell_t ; - cells_b[i] := cell_b ; - width_t := bbwidth(cell_t) ; - width_b := bbwidth(cell_b) ; + cells_t[i] := cells_t[i] shifted -llcorner cells_t[i] shifted (dx, 0) ; + cells_b[i] := cells_b[i] shifted -llcorner cells_b[i] shifted (dx,-cell_distance_y-max_height_b) ; + width_t := bbwidth(cells_t[i]) ; + width_b := bbwidth(cells_b[i]) ; if width_t > 0 : dx := dx + cell_distance_x + width_t ; elseif width_b > 0 : @@ -253,19 +362,27 @@ def step_end_chart = endfor ; % flush for i=1 upto nofcells : - cell_t := cells_t[i] ; - cell_b := cells_b[i] ; - width_t := bbwidth(cell_t) ; - width_b := bbwidth(cell_b) ; + width_t := bbwidth(cells_t[i]) ; + width_b := bbwidth(cells_b[i]) ; if width_t > 0 : - fill boundingbox cell_t withcolor cell_fill_color ; - draw boundingbox cell_t withpen pencircle scaled cell_line_width withcolor cell_line_color ; - draw cell_t ; + drawpredefinedshape ( + if known cell_top_shapes[i] : cell_top_shapes[i] else : 24 fi, + cells_t[i], + if known cell_top_lines [i] : cell_top_lines [i] else : cell_line_width fi, + if known cell_top_colors[i] : cell_top_colors[i] else : cell_line_color fi, + if known cell_top_fills [i] : cell_top_fills [i] else : cell_fill_color fi + ) ; + draw cells_t[i] ; fi ; if width_b > 0 : - fill boundingbox cell_b withcolor cell_fill_color ; - draw boundingbox cell_b withpen pencircle scaled cell_line_width withcolor cell_line_color ; - draw cell_b ; + drawpredefinedshape ( + if known cell_bot_shapes[i] : cell_bot_shapes[i] else : 24 fi, + cells_b[i], + if known cell_bot_lines [i] : cell_bot_lines [i] else : cell_line_width fi, + if known cell_bot_colors[i] : cell_bot_colors[i] else : cell_line_color fi, + if known cell_bot_fills [i] : cell_bot_fills [i] else : cell_fill_color fi + ) ; + draw cells_b[i] ; fi ; endfor ; % @@ -273,55 +390,71 @@ def step_end_chart = def midbottomboundary expr p = 0.5[llcorner boundingbox p, lrcorner boundingbox p] enddef ; % draw top and bottom text boxes for i=1 upto nofcells-1 : - text_t := texts_t[i] ; - text_b := texts_b[i] ; - if bbwidth(text_t) > 0 : - setbounds text_t to boundingbox text_t enlarged text_offset ; - texts_t[i] := text_t ; + if bbwidth(texts_t[i]) > 0 : + setbounds texts_t[i] to boundingbox texts_t[i] enlarged text_offset ; fi ; - if bbwidth(text_b) > 0 : - setbounds text_b to boundingbox text_b enlarged text_offset ; - texts_b[i] := text_b ; + if bbwidth(texts_b[i]) > 0 : + setbounds texts_b[i] to boundingbox texts_b[i] enlarged text_offset ; fi ; endfor ; % arrows for i=1 upto nofcells-1 : - cell_t := cells_t[i] ; - cell_b := cells_b[i] ; - next_t := cells_t[i+1] ; - next_b := cells_b[i+1] ; pair t_a, t_b, t_c, b_a, b_b, b_c ; - t_a := midtopboundary cell_t ; - t_b := midtopboundary next_t ; - t_c := (xpart 0.5[t_a,t_b], ypart t_a+line_height+line_distance) ; + t_a := midtopboundary cells_t[i] ; + t_b := midtopboundary cells_t[i+1] ; if one_row_only : - b_a := midbottomboundary cell_t ; - b_b := midbottomboundary next_t ; + b_a := midbottomboundary cells_t[i] ; + b_b := midbottomboundary cells_t[i+1] ; else : - b_a := midbottomboundary cell_b ; - b_b := midbottomboundary next_b ; + b_a := midbottomboundary cells_b[i] ; + b_b := midbottomboundary cells_b[i+1] ; fi ; + t_c := (xpart 0.5[t_a,t_b], ypart t_a+line_height+line_distance) ; b_c := (xpart 0.5[b_a,b_b], ypart b_a-line_height-line_distance) ; texts_t[i] := thelabel.top(texts_t[i],t_c) ; texts_b[i] := thelabel.bot(texts_b[i],b_c) ; endfor ; % for i=1 upto nofcells-1 : % todo arrows when empty text - cell_t := cells_t[i] ; - cell_b := cells_b[i] ; - next_t := cells_t[i+1] ; - next_b := cells_b[i+1] ; text_t := texts_t[i] ; text_b := texts_b[i] ; + cell_t := cells_t[start_t[i]] ; + cell_b := cells_b[start_b[i]] ; + next_t := cells_t[i+1] ; + next_b := cells_b[i+1] ; if bbwidth(text_t) > 0 : if bbwidth(cell_t) > 0 : - drawarrow midtopboundary cell_t - shifted (if i > 1 : line_offset else : 0 fi, cell_line_width) {up} .. - midbottomboundary text_t shifted (0,-line_distance) .. - {down} midtopboundary next_t shifted(if i < nofcells - 1 : -line_offset else : 0 fi,cell_line_width) - withpen pencircle scaled line_line_width - withcolor line_line_color ; - else : + alternative := if known line_top_shapes[i] : line_top_shapes[i] else : 1 fi ; + if alternative <> 0 : + if (alternative = 1) or (alternative = 2) or (alternative = 5) or (alternative = 6) : + drawarrow + elseif (alternative = 3) or (alternative = 7): + drawdblarrow + else : + draw + fi + if (alternative = 2) or (alternative = 6) : + reverse + fi + ( + midtopboundary cell_t + shifted (if i > 1 : line_offset else : 0 fi, cell_line_width) {up} .. + midbottomboundary text_t + shifted (0,-line_distance) .. + {down} midtopboundary next_t + shifted (if i < nofcells - 1 : -line_offset else : 0 fi,cell_line_width) + ) + withpen pencircle scaled + if known line_top_lines [i] : line_top_lines [i] else : line_line_width fi + withcolor + if known line_top_colors[i] : line_top_colors[i] else : line_line_color fi + if (alternative >= 5) and (alternative <= 8) : + dashed evenly scaled ( + if known line_top_lines [i] : line_top_lines [i] else : line_line_width fi + ) + fi + ; + fi ; fi ; fi ; if bbwidth(text_b) > 0 : @@ -330,29 +463,61 @@ def step_end_chart = next_b := next_t ; fi ; if bbwidth(cell_b) > 0 : - drawarrow midbottomboundary cell_b - shifted (if i > 1 : line_offset else : 0 fi, -cell_line_width) {down} .. - midtopboundary text_b shifted (0, line_distance) .. - {up} midbottomboundary next_b shifted (if i < nofcells - 1 : -line_offset else : 0 fi,-cell_line_width) - withpen pencircle scaled line_line_width - withcolor line_line_color ; - else : + alternative := if known line_bot_shapes[i] : line_bot_shapes[i] else : 1 fi ; + if alternative <> 0 : + if (alternative = 1) or (alternative = 2) or (alternative = 5) or (alternative = 6) : + drawarrow + elseif (alternative = 3) or (alternative = 7): + drawdblarrow + else : + draw + fi + if (alternative = 2) or (alternative = 6) : + reverse + fi + ( + midbottomboundary cell_b + shifted (if i > 1 : line_offset else : 0 fi, -cell_line_width) {down} .. + midtopboundary text_b + shifted (0, line_distance) .. + {up} midbottomboundary next_b + shifted (if i < nofcells - 1 : -line_offset else : 0 fi,-cell_line_width) + ) + withpen pencircle scaled + if known line_bot_lines [i] : line_bot_lines [i] else : line_line_width fi + withcolor + if known line_bot_colors[i] : line_bot_colors[i] else : line_line_color fi + if (alternative >= 5) and (alternative <= 8) : + dashed evenly scaled ( + if known line_top_lines [i] : line_top_lines [i] else : line_line_width fi + ) + fi + ; + fi ; fi ; fi ; endfor ; % draw top and bottom text boxes for i=1 upto nofcells-1 : - text_t := texts_t[i] ; - text_b := texts_b[i] ; - if bbwidth(text_t) > 0 : - fill boundingbox text_t withcolor text_fill_color ; - draw boundingbox text_t withpen pencircle scaled text_line_width withcolor text_line_color ; - draw text_t ; + if bbwidth(texts_t[i]) > 0 : + drawpredefinedshape ( + if known text_top_shapes[i] : text_top_shapes[i] else : 24 fi, + texts_t[i], + if known text_top_lines [i] : text_top_lines [i] else : text_line_width fi, + if known text_top_colors[i] : text_top_colors[i] else : text_line_color fi, + if known text_top_fills [i] : text_top_fills [i] else : text_fill_color fi + ) ; + draw texts_t[i] ; fi ; - if bbwidth(text_b) > 0 : - fill boundingbox text_b withcolor text_fill_color ; - draw boundingbox text_b withpen pencircle scaled text_line_width withcolor text_line_color ; - draw text_b ; + if bbwidth(texts_b[i]) > 0 : + drawpredefinedshape ( + if known text_bot_shapes[i] : text_bot_shapes[i] else : 24 fi, + texts_b[i], + if known text_bot_lines [i] : text_bot_lines [i] else : text_line_width fi, + if known text_bot_colors[i] : text_bot_colors[i] else : text_line_color fi, + if known text_bot_fills [i] : text_bot_fills [i] else : text_fill_color fi + ) ; + draw texts_b[i] ; fi ; endfor ; if chart_vertical : @@ -362,6 +527,8 @@ def step_end_chart = endgroup ; enddef ; +% no longer working .. will do someday +% % start_begin_step ; % step_cells ("\strut test 0", "\strut test 0") ; % step_cells ("\strut test 1", "\vbox{\hsize3cm \strut oeps 1\crlf oeps 1}") ; diff --git a/metapost/context/base/mpiv/mp-symb.mpiv b/metapost/context/base/mpiv/mp-symb.mpiv index a84c84e82..40681adf1 100644 --- a/metapost/context/base/mpiv/mp-symb.mpiv +++ b/metapost/context/base/mpiv/mp-symb.mpiv @@ -12,7 +12,7 @@ %C details. %D Instead of these symbols, you can use the \type {contnav} -%D font by Taco Hoekwater that is derived form this file. +%D font by Taco Hoekwater that is derived form this file. u := 3; h := 5u; @@ -264,88 +264,88 @@ endfig; beginfig(999); -picture collection [] ; +picture collection [] ; -prepareglyph ; -draw lefttriangle ; +prepareglyph ; +draw lefttriangle ; finishglyph ; -collection[201] := currentpicture ; -currentpicture := nullpicture ; +collection[201] := currentpicture ; +currentpicture := nullpicture ; -prepareglyph ; -draw righttriangle ; +prepareglyph ; +draw righttriangle ; finishglyph ; -collection[202] := currentpicture ; -currentpicture := nullpicture ; +collection[202] := currentpicture ; +currentpicture := nullpicture ; -prepareglyph ; -draw sidebar ; +prepareglyph ; +draw sidebar ; draw lefttriangle shifted (.5s) ; finishglyph ; -collection[203] := currentpicture ; -currentpicture := nullpicture ; +collection[203] := currentpicture ; +currentpicture := nullpicture ; -prepareglyph ; -draw righttriangle ; -draw sidebar shifted (wt,0) ; +prepareglyph ; +draw righttriangle ; +draw sidebar shifted (wt,0) ; finishglyph ; -collection[204] := currentpicture ; -currentpicture := nullpicture ; +collection[204] := currentpicture ; +currentpicture := nullpicture ; -prepareglyph ; -draw sublefttriangle shifted s ; +prepareglyph ; +draw sublefttriangle shifted s ; draw lefttriangle shifted s ; finishglyph ; -collection[205] := currentpicture ; -currentpicture := nullpicture ; +collection[205] := currentpicture ; +currentpicture := nullpicture ; prepareglyph ; draw subrighttriangle ; draw righttriangle ; finishglyph ; -collection[206] := currentpicture ; -currentpicture := nullpicture ; +collection[206] := currentpicture ; +currentpicture := nullpicture ; prepareglyph ; draw midbar ; finishglyph ; -collection[207] := currentpicture ; -currentpicture := nullpicture ; +collection[207] := currentpicture ; +currentpicture := nullpicture ; prepareglyph ; draw onebar ; finishglyph ; -collection[208] := currentpicture ; -currentpicture := nullpicture ; +collection[208] := currentpicture ; +currentpicture := nullpicture ; prepareglyph ; draw twobar ; draw twobar shifted (pw+hh/2,0) ; finishglyph ; -collection[209] := currentpicture ; -currentpicture := nullpicture ; +collection[209] := currentpicture ; +currentpicture := nullpicture ; -for i=201 upto 209 : +for i=201 upto 209 : collection[i] := collection[i] shifted - center collection[i] ; -endfor ; +endfor ; -addto currentpicture also collection[205] shifted ( 0, 0) +addto currentpicture also collection[205] shifted ( 0, 0) withcolor (.3,.4,.5) ; -addto currentpicture also collection[202] shifted ( 0,1.5h) +addto currentpicture also collection[202] shifted ( 0,1.5h) withcolor (.5,.6,.7) ; -addto currentpicture also collection[201] shifted (1.5h, 0) +addto currentpicture also collection[201] shifted (1.5h, 0) withcolor (.6,.7,.8) ; -addto currentpicture also collection[206] shifted (1.5h,1.5h) +addto currentpicture also collection[206] shifted (1.5h,1.5h) withcolor (.4,.5,.6) ; -collection[210] := currentpicture ; -currentpicture := nullpicture ; +collection[210] := currentpicture ; +currentpicture := nullpicture ; -bboxmargin := .25u; +bboxmargin := .25u; fill bbox collection[210] withcolor .95(1,1,0); -addto currentpicture also collection[210] ; +addto currentpicture also collection[210] ; -endfig ; +endfig ; end diff --git a/metapost/context/base/mpiv/mp-tool.mpiv b/metapost/context/base/mpiv/mp-tool.mpiv index 76459d25c..cd04b8dcb 100644 --- a/metapost/context/base/mpiv/mp-tool.mpiv +++ b/metapost/context/base/mpiv/mp-tool.mpiv @@ -11,8 +11,6 @@ %C therefore copyrighted by \PRAGMA. See mreadme.pdf for %C details. -% def loadfile(expr name) = scantokens("input " & name & ";") enddef ; - if known context_tool : endinput ; fi ; boolean context_tool ; context_tool := true ; @@ -28,7 +26,9 @@ let @## = @# ; if not known mpversion : string mpversion ; mpversion := "0.641" ; fi ; -newinternal metapostversion ; metapostversion := scantokens(mpversion) ; +% newinternal metapostversion ; metapostversion := scantokens(mpversion) ; + +newinternal metapostversion ; metapostversion := 2.0 ; %D We always want \EPS\ conforming output, so we say: @@ -36,6 +36,10 @@ prologues := 1 ; warningcheck := 0 ; mpprocset := 1 ; +%D Handy: + +def nothing = enddef ; + %D Namespace handling: % let exclamationmark = ! ; @@ -89,6 +93,47 @@ enddef ; let triplet = rgbcolor ; let quadruplet = cmykcolor ; +%D Image redefined, for Alan: + +vardef image@#(text t) = + save currentpicture ; + picture currentpicture ; + currentpicture := nullpicture ; + t ; + currentpicture + if str @# <> "" : + shifted ( + mfun_labxf@# * lrcorner p + + mfun_labyf@# * ulcorner p + + (1-mfun_labxf@#-mfun_labyf@#) * llcorner p + ) + fi +enddef ; + +%D Variables + +def dispose suffix s = + if known s : + begingroup ; + save ss ; + if numeric s : numeric ss + elseif boolean s : boolean ss + elseif pair s : pair ss + elseif path s : path ss + elseif picture s : picture ss + elseif string s : string ss + elseif transform s : transform ss + elseif color s : color ss + elseif rgbcolor s : rgbcolor ss + elseif cmykcolor s : cmykcolor ss + elseif pen s : pen ss + else s : numeric ss + fi ; + s := ss ; + endgroup ; + fi ; +enddef ; + %D Colors: newinternal nocolormodel ; nocolormodel := 1 ; @@ -143,6 +188,8 @@ vardef colordecimals primary c = decimal cyanpart c & ":" & decimal magentapart c & ":" & decimal yellowpart c & ":" & decimal blackpart c elseif rgbcolor c : decimal redpart c & ":" & decimal greenpart c & ":" & decimal bluepart c + elseif string c: + colordecimals resolvedcolor(c) else : decimal c fi @@ -335,6 +382,42 @@ enddef; % mfun_a_b % enddef ; +%D Here are some special ones, cooked up in the process of Alan's mp-node +%D module: + +vardef boundingradius primary p = + if picture p : + max( + abs((llcorner p) shifted -center p), + abs((lrcorner p) shifted -center p), + abs((urcorner p) shifted -center p), + abs((ulcorner p) shifted -center p) + ) + elseif pen p : + boundingradius image(draw makepath p ;) + elseif path p : + boundingradius image(draw p ;) + fi +enddef ; + +vardef boundingcircle primary p = + fullcircle scaled 2boundingradius p shifted center p +enddef ; + +vardef boundingpoint@#(expr p) = + if picture p : % pen? + ( mfun_labxf@# *ulcorner p + + mfun_labyf@# *lrcorner p + +(1-mfun_labxf@#-mfun_labyf@#)*urcorner p) + elseif path p : + boundingpoint@#(image(draw p ;)) + %elseif pair p : + % p + %else : + % origin + fi +enddef ; + %D Some missing functions can be implemented rather straightforward (thanks to %D Taco and others): @@ -373,6 +456,7 @@ vardef asinh primary x = ln(x+(x++1)) enddef ; vardef sinh primary x = save xx ; xx = exp x ; (xx-1/xx)/2 enddef ; vardef cosh primary x = save xx ; xx = exp x ; (xx+1/xx)/2 enddef ; +vardef tanh primary x = save xx ; xx = exp x ; (xx-1/xx)/(xx+1/xx) enddef ; %D Like mod, but useful for anglesl it returns (-.5d,+.5d] and is used %D in for instance mp-chem. @@ -715,7 +799,7 @@ primarydef p xyscaled q = % secundarydef does not work out well endgroup enddef ; -%D Some personal code that might move to another module +%D Some personal code that might move to another module (todo: save). def set_grid(expr w, h, nx, ny) = boolean grid[][] ; boolean grid_full ; @@ -789,7 +873,7 @@ secondarydef p intersection_point q = begingroup save x_, y_ ; (x_,y_) = p intersectiontimes q ; - if x_<0 : + if x_< 0 : intersection_found := false ; center p % origin else : @@ -817,36 +901,59 @@ enddef ; %D Some colors. -def colortype(expr c) = - if cmykcolor c : cmykcolor elseif rgbcolor c : rgbcolor else : grayscale fi +def resolvedcolor(expr s) = + .5white +enddef ; + +let normalwithcolor = withcolor ; + +def withcolor expr c = + normalwithcolor if string c : resolvedcolor(c) else : c fi enddef ; -vardef whitecolor(expr c) = - if cmykcolor c : (0,0,0,0) elseif rgbcolor c : (1,1,1) else : 1 fi +vardef colortype expr c = + if cmykcolor c : cmykcolor + elseif rgbcolor c : rgbcolor + elseif numeric c : grayscale + fi +enddef ; + +vardef whitecolor expr c = + if cmykcolor c : (0,0,0,0) + elseif rgbcolor c : (1,1,1) + elseif numeric c : 1 + elseif string c : whitecolor resolvedcolor(c) + fi enddef ; vardef blackcolor expr c = - if cmykcolor c : (0,0,0,1) elseif rgbcolor c : (0,0,0) else : 0 fi + if cmykcolor c : (0,0,0,1) + elseif rgbcolor c : (0,0,0) + elseif numeric c : 0 + elseif string c : blackcolor resolvedcolor(c) + fi enddef ; -vardef complementary expr c = ( - if cmykcolor c : (1,1,1,1) - - elseif rgbcolor c : (1,1,1) - - elseif pair c : (1,1) - - elseif numeric c : 1 - - fi c -) enddef ; +vardef complementary expr c = + if cmykcolor c : (1,1,1,1) - c + elseif rgbcolor c : (1,1,1) - c + elseif pair c : (1,1) - c + elseif numeric c : 1 - c + elseif string c : complementary resolvedcolor(c) + fi +enddef ; vardef complemented expr c = save m ; if cmykcolor c : m := max(cyanpart c, magentapart c, yellowpart c, blackpart c) ; - ( (m,m,m,m) - + (m,m,m,m) - c elseif rgbcolor c : m := max(redpart c, greenpart c, bluepart c) ; - ( (m,m,m) - + (m,m,m) - c elseif pair c : m := max(xpart c, ypart c) ; - ( (m,m) - - elseif numeric c : ( m - - fi c ) + (m,m) - c + elseif numeric c : m - c + elseif string c : complemented resolvedcolor(c) + fi enddef ; %D Well, this is the dangerous and naive version: @@ -971,6 +1078,56 @@ primarydef p randomshifted s = endgroup enddef ; +vardef mfun_randomized_path(expr p,s) = + for i=0 upto length(p)-1 : + (point i of p) .. 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) + fi +enddef; + +vardef mfun_randomized_picture(expr p,s)(text rnd) = + save currentpicture ; + picture currentpicture ; + currentpicture := nullpicture ; + for i within p : + addto currentpicture + if stroked i : + doublepath pathpart i rnd s + dashed dashpart i + withpen penpart i + withcolor colorpart i + withprescript prescriptpart i + withpostscript postscriptpart i + elseif filled i : + contour pathpart i rnd s + withpen penpart i + withcolor colorpart i + withprescript prescriptpart i + withpostscript postscriptpart i + else : + also i + fi + ; + endfor ; + currentpicture +enddef ; + +primarydef p randomizedcontrols s = ( + if path p : + mfun_randomized_path(p,s) + elseif picture p : + mfun_randomized_picture(p,s)(randomizedcontrols) + else : + p randomized s + fi +) enddef ; + primarydef p randomized s = ( if path p : for i=0 upto length(p)-1 : @@ -1014,7 +1171,12 @@ primarydef p randomized s = ( else : ((uniformdeviate s) * p) fi + elseif string p : + (resolvedcolor(p)) randomized s + elseif picture p : + mfun_randomized_picture(p,s)(randomized) else : + % p - s/2 + uniformdeviate s % would have been better but we want to be positive p + uniformdeviate s fi ) enddef ; @@ -1165,6 +1327,15 @@ vardef arrowheadonpath (expr p, s) = arrowhead p if s < 1 : cutafter (point (s*arclength(p) + (ahlength/2)) on p) fi enddef ; +def resetarrows = + hide ( + ahlength := 4 ; + ahangle := 45 ; + ahvariant := 0 ; + ahdimple := 1/5 ; + ) +enddef ; + %D Points. def drawpoint expr c = @@ -1384,13 +1555,12 @@ extra_beginfig := extra_beginfig & " miterlimit := 10 ; " ; % restores extra_beginfig := extra_beginfig & " linejoin := rounded ; " ; % restores extra_beginfig := extra_beginfig & " linecap := rounded ; " ; % restores -%D Normally, arrowheads don't scale well. So we provide a -%D hack. +%D Normally, arrowheads don't scale well. So we provide a hack. boolean autoarrows ; autoarrows := false ; numeric ahfactor ; ahfactor := 2.5 ; -def set_ahlength (text t) = +def set_ahlength (text t) = % called to often % ahlength := (ahfactor*pen_size(_op_ t)) ; % _op_ added % problem: _op_ can contain color so a no-go, we could apply the transform % but i need to figure out the best way (fakepicture and take components). @@ -1413,31 +1583,158 @@ vardef arrowpath expr p = % patch by Peter Rolf: supports squared pen and shifti )) enddef; -% def _finarr text t = -% if autoarrows : set_ahlength (t) fi ; -% draw arrowpath _apth t ; % arrowpath added -% filldraw arrowhead _apth t ; -% enddef; +% New experimental extension: also handling pictures: +% +% drawarrow fullsquare scaled 2cm withcolor green ; +% drawarrow fullcircle scaled 3cm withcolor green ; +% drawarrow image ( +% draw fullsquare scaled 4cm withcolor red ; +% draw fullcircle scaled 5cm withcolor blue ; +% ) ; +% currentpicture := currentpicture shifted (-bbwidth(currentpicture)-1cm,0) ; +% drawdblarrow fullsquare scaled 2cm withcolor green ; +% drawdblarrow fullcircle scaled 3cm withcolor green ; +% drawdblarrow image ( +% draw fullsquare scaled 4cm withcolor red ; +% draw fullcircle scaled 5cm withcolor blue ; +% ) ; + +vardef stroked_paths(expr p) = + save n ; numeric n ; n := 0 ; + for i within p : + if stroked i : + n := n + 1 ; + fi + endfor ; + n +enddef ; -% def _finarr text t = -% if autoarrows : set_ahlength (t) fi ; -% draw arrowpath _apth t ; % arrowpath added -% fill arrowhead _apth t ; -% draw arrowhead _apth t ; -% enddef; +def mfun_decoration_i expr i = + withpen penpart i + withcolor colorpart i + withprescript prescriptpart i + withpostscript postscriptpart i +enddef ; -% def _finarr text t = -% if autoarrows : set_ahlength (t) fi ; -% draw arrowpath _apth t ; % arrowpath added -% fill arrowhead _apth t ; -% draw arrowhead _apth t undashed ; -% enddef; +% We could collapse all in one helper but in context we nowaways don't want +% the added obscurity. Tokens come cheap. -def _finarr text t = - if autoarrows : set_ahlength (t) fi ; - draw arrowpath _apth t ; % arrowpath added - fillup arrowhead _apth t ; -enddef; +numeric mfun_arrow_snippets ; +numeric mfun_arrow_count ; + +def drawarrow expr p = + begingroup ; + save mfun_arrow_path ; + path mfun_arrow_path ; + if path p : + mfun_arrow_path := p ; + expandafter mfun_draw_arrow_path + elseif picture p : + save mfun_arrow_picture ; + picture mfun_arrow_picture ; + mfun_arrow_picture := p ; + expandafter mfun_draw_arrow_picture + else : + expandafter mfun_draw_arrow_nothing + fi +enddef ; + +def drawdblarrow expr p = + begingroup ; + save mfun_arrow_path ; + path mfun_arrow_path ; + if path p : + mfun_arrow_path := p ; + expandafter mfun_draw_arrow_path_double + elseif picture p : + save mfun_arrow_picture ; + picture mfun_arrow_picture ; + mfun_arrow_picture := p ; + expandafter mfun_draw_arrow_picture_double + else : + expandafter mfun_draw_arrow_nothing + fi +enddef ; + +def mfun_draw_arrow_nothing text t = +enddef ; + +% The path is shortened so that the arrow head extends it to the original +% length. In case of a double arrow the path gets shortened twice. + +def mfun_draw_arrow_path text t = + if autoarrows : + set_ahlength(t) ; + fi + draw arrowpath mfun_arrow_path t ; + fillup arrowhead mfun_arrow_path t ; + endgroup ; +enddef ; + +def mfun_draw_arrow_path_double text t = + if autoarrows : + set_ahlength(t) ; + fi + draw arrowpath (reverse arrowpath mfun_arrow_path) t ; + fillup arrowhead mfun_arrow_path t ; + fillup arrowhead reverse mfun_arrow_path t ; + endgroup ; +enddef ; + +% The picture variant is not treating each path but only the first and +% last path. This can be somewhat counterintuitive but is needed for Alan's +% macros. So here the last and in case of a double path first paths in a +% picture get the shortening. + +def mfun_with_arrow_picture (text t) = + mfun_arrow_count := 0 ; + mfun_arrow_snippets := stroked_paths(mfun_arrow_picture) ; + for i within mfun_arrow_picture : + if stroked i : + mfun_arrow_count := mfun_arrow_count + 1 ; + mfun_arrow_path := pathpart i ; + t + fi ; + endfor ; +enddef ; + +def mfun_draw_arrow_picture text t = + if autoarrows : + set_ahlength(t) ; + fi + mfun_with_arrow_picture ( + if mfun_arrow_count = mfun_arrow_snippets : + draw arrowpath mfun_arrow_path mfun_decoration_i i t ; + fillup arrowhead mfun_arrow_path mfun_decoration_i i t ; + else : + draw mfun_arrow_path mfun_decoration_i i t ; + fi ; + ) + endgroup ; +enddef ; + +def mfun_draw_arrow_picture_double text t = + if autoarrows : + set_ahlength(t) ; + fi + mfun_with_arrow_picture ( + draw + if mfun_arrow_count = 1 : + arrowpath reverse + fi + if mfun_arrow_count = mfun_arrow_snippets : + arrowpath + fi + mfun_arrow_path mfun_decoration_i i t ; + if mfun_arrow_count = 1 : + fillup arrowhead reverse mfun_arrow_path mfun_decoration_i i t ; + fi + if mfun_arrow_count = mfun_arrow_snippets : + fillup arrowhead mfun_arrow_path mfun_decoration_i i t ; + fi + ) + endgroup ; +enddef ; %D Handy too ...... @@ -1487,9 +1784,7 @@ enddef ; %D To be documented. -path freesquare ; - -freesquare := ( +path freesquare ; freesquare := ( (-1,0) -- (-1,-1) -- (0,-1) -- (+1,-1) -- (+1,0) -- (+1,+1) -- (0,+1) -- (-1,+1) -- cycle ) scaled .5 ; @@ -1637,7 +1932,7 @@ enddef ; % nice: currentpicture := inverted currentpicture ; -primarydef p uncolored c = +primarydef p uncolored c = % not complete ... needs text and scripts and ... if color p : c - p else : @@ -1699,6 +1994,8 @@ vardef grayed primary p = tripled(.30*(1-cyanpart i)+.59*(1-magentapart i)+.11*(1-yellowpart i)+blackpart i) elseif greycolor p : p + elseif string p : + grayed resolvedcolor(p) elseif picture p : image ( for i within p : @@ -1854,14 +2151,16 @@ inner end ; % this will be redone (when needed) using scripts and backend handling -let normalwithcolor = withcolor ; +let mfun_remap_colors_normalwithcolor = normalwithcolor ; def remapcolors = - def withcolor primary c = normalwithcolor remappedcolor(c) enddef ; + def normalwithcolor primary c = + mfun_remap_colors_normalwithcolor remappedcolor(c) + enddef ; enddef ; def normalcolors = - let withcolor = normalwithcolor ; + let normalwithcolor = mfun_remap_colors_normalwithcolor ; enddef ; def resetcolormap = @@ -1912,7 +2211,7 @@ def reprocess suffix p = p := repathed (22,p) enddef ; % no attributes vardef repathed (expr mode, p) text t = begingroup ; if mode = 0 : - save withcolor ; + save normalwithcolor ; remapcolors ; fi ; save _p_, _pp_, _ppp_, _f_, _b_, _t_ ; @@ -2138,8 +2437,22 @@ vardef mfun_straightened(expr sign, p) = _q_ enddef ; +% vardef mfun_straightened(expr sign, p) = +% save lp, lq, q ; path q ; q := p ; +% lp := length(p) ; +% forever : +% q := mfun_do_straightened(sign,q) ; +% lq := length(q) ; +% exitif lp = lq ; +% lp := lq ; +% endfor ; +% q +% enddef ; + +% can be optimized: + vardef mfun_do_straightened(expr sign, p) = - if length(p)>2 : % was 1, but straight lines are ok + if length(p) > 2 : % was 1, but straight lines are ok save pp ; path pp ; pp := point 0 of p ; for i=1 upto length(p)-1 : @@ -2149,10 +2462,10 @@ vardef mfun_do_straightened(expr sign, p) = endfor ; save n, ok ; numeric n ; boolean ok ; n := length(pp) ; ok := false ; - if n>2 : - for i=0 upto n : % evt hier ook round + if n > 2 : + for i=0 upto n : if unitvector(round(point i of pp - point if i=0 : n else : i-1 fi of pp)) <> - sign * unitvector(round(point if i=n : 0 else : i+1 fi of pp - point i of pp)) : + sign * unitvector(round(point if i=n : 0 else : i+1 fi of pp - point i of pp)) : if ok : -- else : @@ -2198,7 +2511,7 @@ vardef unspiked expr p = ( path originpath ; originpath := origin -- cycle ; vardef unitvector primary z = - if abs z = abs origin : z else : z/abs z fi + if abs z = abs origin : z else : z/abs z fi % hm, abs origin is just origin enddef; % also new @@ -2523,41 +2836,41 @@ vardef undecorated (text imagedata) text decoration = currentpicture enddef ; -if metapostversion < 1.770 : - - vardef decorated (text imagedata) text decoration = - save mfun_decorated_path, currentpicture ; - picture mfun_decorated_path, currentpicture ; - currentpicture := nullpicture ; - imagedata ; - mfun_decorated_path := currentpicture ; - currentpicture := nullpicture ; - for i within mfun_decorated_path : - addto currentpicture - if stroked i : - doublepath pathpart i - dashed dashpart i - withpen penpart i - withcolor colorpart i - decoration - elseif filled i : - contour pathpart i - withpen penpart i - withcolor colorpart i - decoration - elseif textual i : - also i - withcolor colorpart i - decoration - else : - also i - fi - ; - endfor ; - currentpicture - enddef ; - -else: +% if metapostversion < 1.770 : +% +% vardef decorated (text imagedata) text decoration = +% save mfun_decorated_path, currentpicture ; +% picture mfun_decorated_path, currentpicture ; +% currentpicture := nullpicture ; +% imagedata ; +% mfun_decorated_path := currentpicture ; +% currentpicture := nullpicture ; +% for i within mfun_decorated_path : +% addto currentpicture +% if stroked i : +% doublepath pathpart i +% dashed dashpart i +% withpen penpart i +% withcolor colorpart i +% decoration +% elseif filled i : +% contour pathpart i +% withpen penpart i +% withcolor colorpart i +% decoration +% elseif textual i : +% also i +% withcolor colorpart i +% decoration +% else : +% also i +% fi +% ; +% endfor ; +% currentpicture +% enddef ; +% +% else: vardef decorated (text imagedata) text decoration = save mfun_decorated_path, currentpicture ; @@ -2597,7 +2910,7 @@ else: currentpicture enddef ; -fi ; +% fi ; vardef redecorated (text imagedata) text decoration = save mfun_decorated_path, currentpicture ; @@ -2726,4 +3039,431 @@ enddef; extra_endfig := extra_endfig & "mfun_apply_max_dimensions ;" ; +%D Bonus shapes (need along): + +path unittriangle, fulltriangle ; % not really units but circle based + +unittriangle := point 0 along unitcircle + -- point 1/3 along unitcircle + -- point 2/3 along unitcircle + -- cycle ; +fulltriangle := point 0 along fullcircle + -- point 1/3 along fullcircle + -- point 2/3 along fullcircle + -- cycle ; + +%D Kind of special and undocumented. On Wikipedia one can find examples +%D of quick sort routines. Here we have a variant that permits a +%D method. + +% vardef listsize(suffix list) = +% numeric len ; len := 0 ; +% forever : +% exitif unknown list[len+1] ; +% len := len + 1 ; +% endfor ; +% len +% enddef ; + +vardef listsize(suffix list) = + numeric len ; len := 1 ; + forever : + exitif unknown list[len] ; + len := len + 1 ; + endfor ; + len if unknown list[0] : - 1 fi +enddef ; + +vardef listlast(suffix list) = + numeric len ; len := if known list[0] : 0 else : 1 fi ; + forever : + len := len + 1 ; + exitif unknown list[len] ; + endfor ; + len - 1 +enddef ; + +vardef mfun_quick_sort(suffix list)(expr _min_, _max_)(text what) = + save l, r, m ; + numeric l ; l := _min_ ; + numeric r ; r := _max_ ; + numeric m ; m := floor(.5[_min_,_max_]) ; + _mid_ := what list[m] ; + forever : + exitif l >= r ; + forever : + exitif l > _max_ ; + % exitif (what list[l]) >= (what list[m]) ; + exitif (what list[l]) >= _mid_ ; + l := l + 1 ; + endfor ; + forever : + exitif r < _min_ ; + % exitif (what list[m]) >= (what list[r]) ; + exitif _mid_ >= (what list[r]) ; + r := r - 1 ; + endfor ; + if l <= r : + temp := list[l] ; + list[l] := list[r] ; + list[r] := temp ; + l := l + 1 ; + r := r - 1 ; + fi ; + endfor ; + if _min_ < r : + mfun_quick_sort(list)(_min_,r)(what) ; + fi ; + if l < _max_ : + mfun_quick_sort(list)(l,_max_)(what) ; + fi ; +enddef ; + +vardef sortlist(suffix list)(text what) = + save _max_ ; numeric _max_ ; + save _mid_ ; numeric _mid_ ; + save temp ; + % _max_ := listsize(list) ; + _max_ := listlast(list) ; + if pair list[_max_] : + pair temp ; + else : + numeric temp ; + fi ; + if pair what list[_max_] : + pair _mid_ ; + else : + numeric _mid_ ; + fi ; + if _max_ > 1 : + % mfun_quick_sort(list)(1,_max_)(what) ; + mfun_quick_sort(list)(if known list[0] : 0 else : 1 fi,_max_)(what) ; + fi ; +enddef ; + +vardef uniquelist(suffix list) = + % this one will be defined later +enddef ; + +vardef copylist(suffix list, target) = + save i ; i := 1 ; + forever : + exitif unknown list[i] ; + target[i] := list[i] ; + i := i + 1 ; + endfor ; +enddef ; + +vardef listtolines(suffix list) = + list[1] for i=2 upto listsize(list) : -- list[i] endfor +enddef ; + +vardef listtocurves(suffix list) = + list[1] for i=2 upto listsize(list) : .. list[i] endfor +enddef ; + +%D The sorter is used in: + +% not yet ok + +vardef shapedlist(suffix p) = % takes a list of paths + save l ; pair l[] ; + save r ; pair r[] ; + save i ; i := 1 ; + save n ; n := 0 ; + forever : + exitif unknown p[i] ; + n := n + 1 ; + l[n] := ulcorner p[i] ; + r[n] := urcorner p[i] ; + n := n + 1 ; + l[n] := llcorner p[i] ; + r[n] := lrcorner p[i] ; + i := i + 1 ; + endfor ; + for i = 3 upto n : + if xpart r[i] < xpart r[i-1] : + r[i] := (xpart r[i],ypart r[i-1]) ; + elseif xpart r[i] > xpart r[i-1] : + r[i-1] := (xpart r[i-1],ypart r[i]) ; + fi ; + if xpart l[i] < xpart l[i-1] : + l[i-1] := (xpart l[i-1],ypart l[i]) ; + elseif xpart l[i] > xpart l[i-1] : + l[i] := (xpart l[i],ypart l[i-1]) ; + fi ; + endfor ; + if n > 0 : + simplified ( + for i = 1 upto n : r[i] -- endfor + for i = n downto 1 : l[i] -- endfor + cycle + ) + else : + origin -- cycle + fi +enddef ; + +%D Dumping is fake anyway but let's keep this: + let dump = relax ; + +%D Loading modules can be done with: + +def loadmodule expr name = % no vardef + % input can't be used directly in a macro + if unknown scantokens("context_" & name) : + save s ; string s ; + % s := "mp-" & name & ".mpiv" ; + % message("loading module",s) ; + % s := "input " & s ; + s := "input " & "mp-" & name & ".mpiv" ; + expandafter scantokens expandafter s + fi ; +enddef ; + +%D Handy for backgrounds: + +def drawpathwithpoints expr p = + do_drawpathwithpoints(p) +enddef ; + +def do_drawpathwithpoints(expr p) text t = + draw p t ; + if length(p) > 2 : + begingroup ; + save _c_ ; path _c_ ; + save _p_; picture _p_ ; + _p_ := image ( + _c_ := if cycle p : fullsquare else : fullcircle fi scaled 6pt ; + for i=0 upto length(p) if cycle p : -1 fi : + fill _c_ shifted point i of p withcolor white ; + draw _c_ shifted point i of p withcolor white/2 withpen pencircle scaled .5pt ; + if (i = 0) and cycle p : + _c_ := fullcircle scaled 6pt ; + fi ; + endfor ; + for i=0 upto length(p) if cycle p : -1 fi : + draw textext("\infofont " & decimal i) ysized 2pt shifted point i of p ; + endfor ; + ) ; + setbounds _p_ to boundingbox p ; + draw _p_ ; + fi ; +enddef ; + +%D These new helpers are by Alan and are used in for instance the mp-node +%D module. + +newinternal crossingdebug ; crossingdebug := 0 ; +newinternal crossingscale ; crossingscale := 10 ; +newinternal crossingnumbermax ; crossingnumbermax := 1000 ; + +% primary, secondary or tertiary? always hard to decide but primary makes sense + +vardef infotext@#(expr txt, ysize) = + textext@#("\infofont " & if numeric txt : decimal fi txt) ysized ysize +enddef ; + +primarydef p crossingunder q = + begingroup + save pic ; picture pic ; pic := nullpicture ; + if picture p : + for i within p : + if stroked i : + addto pic also image(draw pathpart i crossingunder q) ; + fi + endfor + elseif path p : + save n, t, a, b, c, r, bcuttings, hold ; + numeric n, t[], hold ; + path a, b, c, r, bcuttings, hold[] ; + c := makepath(currentpen scaled crossingscale) ; + r := if picture q : boundingbox fi q ; + t[0] := n := hold := 0 ; + a := p ; + % The cutbefore/cutafter using c below prevents endless loops! + %forever : % find all intersections + for i=1 upto crossingnumbermax : % safeguard + clearxy ; z = a intersectiontimes r ; + if x < 0 : + exitif hold < 1 ; + a := hold[hold] ; hold := hold - 1 ; + clearxy ; z = a intersectiontimes r ; + fi + (t[incr n], whatever) = p intersectiontimes point x of a ; + if x = 0 : + a := a cutbefore c shifted point x of a ; + elseif x = length a : + a := a cutafter c shifted point x of a ; + else : % before or after? + b := subpath (0,x) of a cutafter c shifted point x of a ; + bcuttings := cuttings ; + a := subpath (x,length a) of a cutbefore c shifted point x of a ; + clearxy ; z = a intersectiontimes r ; + if x < 0 : + a := b ; + cuttings := bcuttings ; + else : + if length bcuttings > 0 : + clearxy ; z = b intersectiontimes r ; + if x >= 0 : + hold[incr hold] := b ; + fi + fi + fi + fi + if length cuttings = 0 : % a single point: nothing cut + exitif hold < 1 ; + a := hold[hold] ; hold := hold - 1 ; + fi + if i = crossingnumbermax : + message("crossingunder reached maximum " & decimal i & + " intersections."); + fi + endfor + + if n = 0 : % No crossings, we return the PATH + save pic ; path pic ; pic := p ; + else : % n>0 + sortlist(t,) ; + % we add too much, maybe a test is needed + t[incr n] = length p if cycle p : + t[1] fi ; +% save tt[] ; numeric tt[] ; uniquelist(t,tt) ; t := tt ; + % Now, n>1 ! + % t[0] is the first point of the path and t[n] is the last point + % (or the first intersection beyond the length if cyclic) + save m ; m := 0 ; + for i=if cycle p: 2 else: 1 fi upto n : + % skip the first segment if cyclic + % as it gets repeated (fully) at the end. + if crossingdebug > 0 : + if crossingdebug = 1 : + addto pic doublepath c shifted point t[i] of p + withpen currentpen withtransparency(1,.5) ; + elseif crossingdebug = 2 : + addto pic also + infotext (incr m,crossingscale/5) + shifted point t[i] of p ; + fi + fi + a := subpath (t[i-1],t[i]) of p + if i > 1 : + cutbefore (c shifted point t[i-1] of p) + fi + if (i < n) or (cycle p) : + cutafter (c shifted point t[i] of p) + fi ; + if (not picture q) or (a outsideof q) : + addto pic doublepath a withpen currentpen ; + fi + endfor + fi + fi + pic + endgroup +enddef ; + +primarydef p insideof q = + begingroup + save pth, pic, t ; + path pth ; picture pic ; + pic := if path q : image(draw q;) else : q fi ; + pth := p -- center pic ; + (t, whatever) = pth intersectiontimes boundingbox pic ; + t < 0 + endgroup +enddef ; + +% primarydef p insideof q = +% if (path q or picture q) : +% if (path p or picture p) : +% (xpart llcorner p > xpart llcorner q) and +% (xpart urcorner p < xpart urcorner q) and +% (ypart llcorner p > ypart llcorner q) and +% (ypart urcorner p < ypart urcorner q) +% elseif pair p : +% (xpart p > xpart llcorner q) and +% (xpart p < xpart urcorner q) and +% (ypart p > ypart llcorner q) and +% (ypart p < ypart urcorner q) +% fi +% elseif (numeric p and pair q) : +% % range check +% (p >= xpart q) and (p <= ypart q) +% else : % maybe triplets and such +% false +% fi +% enddef ; + +primarydef p outsideof q = + not (p insideof q) +enddef ; + +%D Also handy: + +vardef circularpath primary n = + reverse (for i=0 step 2/n until 8-2/n+2eps: point i of fullcircle .. endfor cycle) rotated 90 +enddef ; + +vardef squarepath primary n = + for i=0 step 1/n until 4-1/n + 2eps: point i of fullsquare -- endfor cycle +enddef ; + +vardef linearpath primary n = + origin for i=1/n step 1/n until 1-1/n + 2eps: -- point i of (origin--(1,0)) endfor +enddef ; + +%D A nice tracing helper: + +color pensilcolor ; pensilcolor := .5red ; +newinternal pensilstep ; pensilstep := 1/25 ; + +vardef pensilled(expr p, q) = + image ( + draw p withcolor pensilcolor withpen q ; + for i = 0 step pensilstep until length(p) + eps: + draw point i of p withcolor white withtransparency (1,.5) withpen q ; + endfor ; + ) +enddef ; + +%D Easy to forget but handy for manuals: + +vardef tolist(suffix l)(text t) = + save n ; n := 1 ; + for p = t : + if numeric p : + n := p ; + dispose(l[n]) + elseif pair p : + l[n] := p ; + n := n + 1 ; + elseif path p : + for i=0 step 1 until length(p) : + l[n] := point i of p ; + n := n + 1 ; + endfor ; + else : + % ignore + fi ; + endfor ; + forever : + exitif unknown l[n] ; + dispose(l[n]) + n := n + 1 ; + endfor ; +enddef ; + +vardef topath(suffix p)(text t) = + save i ; i := if known p[1] : 2 ; p[1] elseif known p[0] : 1 ; p[0] else : 0 ; origin fi + forever : + exitif unknown p[i] ; + t p[i] + hide(i := i + 1) + endfor +enddef ; + +vardef tocycle(suffix p)(text t) = + topath(p,t) t cycle +enddef ; |