diff options
Diffstat (limited to 'metapost')
| -rw-r--r-- | metapost/context/base/metafun.mp | 55 | ||||
| -rw-r--r-- | metapost/context/base/mp-char.mp | 224 | ||||
| -rw-r--r-- | metapost/context/base/mp-core.mp | 11 | ||||
| -rw-r--r-- | metapost/context/base/mp-figs.mp | 50 | ||||
| -rw-r--r-- | metapost/context/base/mp-spec.mp | 158 | ||||
| -rw-r--r-- | metapost/context/base/mp-text.mp | 321 | ||||
| -rw-r--r-- | metapost/context/base/mp-tool.mp | 152 |
7 files changed, 619 insertions, 352 deletions
diff --git a/metapost/context/base/metafun.mp b/metapost/context/base/metafun.mp index f8cab41bf..5071013c5 100644 --- a/metapost/context/base/metafun.mp +++ b/metapost/context/base/metafun.mp @@ -1,15 +1,15 @@ %D \module %D [ file=metafun.mp, %D version=2000.07.15, -%D title=\CONTEXT\ \METAPOST\ graphics, -%D subtitle=format generation file, +%D title=\CONTEXT\ \METAPOST\ graphics, +%D subtitle=format generation file, %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. +%C therefore copyrighted by \PRAGMA. See mreadme.pdf for +%C details. %D When generating many graphics at runtime, it can save run %D time to use a format file. We could have named this file @@ -21,28 +21,29 @@ %D (and as a result in buggy boundingbox and special %D handling). By using the name \type {metatex} we make sure %D that we use (unless overloaded) the settings of \type -%D {mpost}. - -if unknown ahangle : - input plain.mp ; % John Hobby's file -else : - let dump = relax ; -fi ; - -input mp-tool.mp ; -input mp-spec.mp ; -input mp-core.mp ; -input mp-page.mp ; -input mp-text.mp ; -input mp-shap.mp ; -input mp-butt.mp ; -input mp-char.mp ; -input mp-step.mp ; -input mp-grph.mp ; - -% mp-form.mp ; -input mp-grid.mp ; -input mp-func.mp ; +%D {mpost}. + +if unknown ahangle : + input plain.mp ; % John Hobby's file +else : + let dump = relax ; +fi ; + +input mp-tool.mp ; +input mp-spec.mp ; +input mp-core.mp ; +input mp-page.mp ; +input mp-text.mp ; +input mp-shap.mp ; +input mp-butt.mp ; +input mp-char.mp ; +input mp-step.mp ; +input mp-grph.mp ; +input mp-figs.mp ; + +% mp-form.mp ; +input mp-grid.mp ; +input mp-func.mp ; string metafunversion ; @@ -56,7 +57,7 @@ metafunversion = "metafun" & " " & let normalend = end ; def end = - message "" ; message metafunversion ; message "" ; normalend ; + ; message "" ; message metafunversion ; message "" ; normalend ; enddef ; dump ; endinput . diff --git a/metapost/context/base/mp-char.mp b/metapost/context/base/mp-char.mp index 9416b1349..cd774d509 100644 --- a/metapost/context/base/mp-char.mp +++ b/metapost/context/base/mp-char.mp @@ -10,16 +10,16 @@ %D copyright={PRAGMA / Hans Hagen \& Ton Otten}] %C %C This module is part of the \CONTEXT\ macro||package and is -%C therefore copyrighted by \PRAGMA. See licen-en.pdf for -%C details. +%C therefore copyrighted by \PRAGMA. See licen-en.pdf for +%C details. -if unknown context_tool : input mp-tool ; fi ; -if unknown context_shap : input mp-shap ; fi ; -if known context_char : endinput ; fi ; +if unknown context_tool : input mp-tool ; fi ; +if unknown context_shap : input mp-shap ; fi ; +if known context_char : endinput ; fi ; -boolean context_char ; context_char := true ; +boolean context_char ; context_char := true ; -% kan naar elders +% kan naar elders current_position := 0 ; @@ -38,7 +38,7 @@ shape_width := 45pt ; shape_height := 30pt ; chart_offset := 2pt ; -color chart_background_color ; chart_background_color := white ; +color chart_background_color ; chart_background_color := white ; %D test mode @@ -70,12 +70,12 @@ shape_left := 67 ; shape_up := 68 ; shape_down := 69 ; -% vardef some_shape_path (expr type) == imported from mp-shap +% vardef some_shape_path (expr type) == imported from mp-shap def show_shapes (expr n) = begin_chart(n,8,10) ; - show_con_points := true ; + show_con_points := true ; for i=0 upto 7 : for j=0 upto 9 : new_shape(i+1,j+1,i*10+j); @@ -83,9 +83,9 @@ def show_shapes (expr n) = endfor ; end_chart ; -enddef ; +enddef ; -%D connections +%D connections def new_chart = @@ -96,14 +96,14 @@ def new_chart = connection_smooth_size := 5pt ; connection_arrow_size := 4pt ; connection_dash_size := 3pt ; - + max_x := 6 ; max_y := 4 ; - + numeric xypoint ; xypoint := 0 ; - + pair xypoints [] ; - + boolean xyfree [][] ; path xypath [][] ; numeric xysx [][] ; @@ -112,38 +112,38 @@ def new_chart = color xydraw [][] ; numeric xyline [][] ; boolean xypeep [][] ; - - numeric cpath ; cpath := 0 ; - path cpaths [] ; + + numeric cpath ; cpath := 0 ; + path cpaths [] ; numeric cline [] ; color ccolor [] ; boolean carrow [] ; boolean cdash [] ; - boolean ccross [] ; - + boolean ccross [] ; + boolean smooth ; smooth := true ; boolean peepshape ; peepshape := false ; boolean arrowtip ; arrowtip := true ; boolean dashline ; dashline := false ; boolean forcevalid ; forcevalid := false ; - boolean touchshape ; touchshape := false ; - boolean showcrossing ; showcrossing := false ; - + boolean touchshape ; touchshape := false ; + boolean showcrossing ; showcrossing := false ; + picture dash_pattern ; - + boolean reverse_y ; reverse_y := true ; - -enddef ; -new_chart ; +enddef ; + +new_chart ; def y_pos (expr y) = if reverse_y : max_y + 1 - y else : y fi enddef ; - + def initialize_grid (expr maxx, maxy) = - begingroup ; - save i, j ; + begingroup ; + save i, j ; max_x := maxx ; max_y := maxy ; dsp_x := 0 ; @@ -201,19 +201,19 @@ vardef i_point (expr x, y, p, t) = enddef ; vardef trimmed (expr x, y, z, t) = - if touchshape and t : xyline[x][y]/z else : epsilon fi + if touchshape and t : xyline[x][y]/z else : epsilon fi enddef ; zfactor := 1/3 ; vardef xy_bottom (expr x, y, z, t) = i_point (x, y, ((0,0)--(0,-2)) shifted (zfactor*z*xysx[x][y],0), "bottom") - shifted(0,-trimmed(x,y,grid_height,t)) + shifted(0,-trimmed(x,y,grid_height,t)) enddef ; vardef xy_top (expr x, y, z, t) = i_point (x, y, ((0,0)--(0,2)) shifted (zfactor*z*xysx[x][y],0), "top") - shifted(0,trimmed(x,y,grid_height,t)) + shifted(0,trimmed(x,y,grid_height,t)) enddef ; vardef xy_left (expr x, y, z, t) = @@ -248,10 +248,10 @@ def flush_shape (expr x, yy) = y := y_pos(yy) ; if not xyfree[x][y] : pickup pencircle scaled xyline[x][y] ; - if xypeep[x][y] : - fill (xypath[x][y] peepholed (unitsquare shifted (x,y))) + if xypeep[x][y] : + fill (xypath[x][y] peepholed (unitsquare shifted (x,y))) scaled_to_grid withpen pencircle scaled 0 - withcolor chart_background_color ; + withcolor chart_background_color ; else : fill xypath[x][y] scaled_to_grid withcolor xyfill[x][y] ; fi ; @@ -276,7 +276,7 @@ vardef points_initialized (expr xfrom, yfrom, xto, yto, n) = fi enddef ; -def collapse_points = % this is now an mp-tool macro +def collapse_points = % this is now an mp-tool macro % remove redundant points n := 1 ; for i=2 upto xypoint: @@ -293,36 +293,36 @@ def collapse_points = % this is now an mp-tool macro fi ; enddef ; -vardef smooth_connection (expr a,b) = +vardef smooth_connection (expr a,b) = sx := connection_smooth_size/grid_width ; sy := connection_smooth_size/grid_height ; if ypart a = ypart b : a shifted (if xpart a >= xpart b : - fi sx,0) -% a shifted (sx*xpart unitvector(b-a),0) +% a shifted (sx*xpart unitvector(b-a),0) else : a shifted (0,if ypart a >= ypart b : - fi sy) -% a shifted (0,sy*ypart unitvector(b-a)) +% a shifted (0,sy*ypart unitvector(b-a)) fi enddef ; -vardef trim_points = +vardef trim_points = begingroup - save p, a, b, d, i ; path p ; pair d ; - p := for i=1 upto xypoint-1 : xypoints[i]-- endfor xypoints[xypoint] ; - if touchshape : + save p, a, b, d, i ; path p ; pair d ; + p := for i=1 upto xypoint-1 : xypoints[i]-- endfor xypoints[xypoint] ; + if touchshape : a := shape_line_width/grid_width ; b := shape_line_width/grid_height ; else : - a := epsilon ; + a := epsilon ; b := epsilon ; - fi ; + fi ; d := direction infinity of p ; xypoints[xypoint] := xypoints[xypoint] shifted if xpart d < 0 : (+a,0) ; elseif xpart d > 0 : (-a,0) ; elseif ypart d < 0 : (0,+b) ; elseif ypart d > 0 : (0,-b) ; - else : origin ; + else : origin ; fi ; d := direction 0 of p ; xypoints[1] := xypoints[1] shifted @@ -330,12 +330,12 @@ vardef trim_points = elseif xpart d > 0 : (+a,0) ; elseif ypart d < 0 : (0,-b) ; elseif ypart d > 0 : (0,+b) ; - else : origin ; + else : origin ; fi ; endgroup -enddef ; +enddef ; -vardef trim_points = enddef ; +vardef trim_points = enddef ; vardef connection_path = if reverse_connection : reverse fi (xypoints[1]-- @@ -354,35 +354,35 @@ enddef ; % vardef connection_path = % sx := connection_smooth_size/grid_width ; % sy := connection_smooth_size/grid_height ; -% if reverse_connection : reverse fi -% (for i=1 upto xypoint-1 : xypoints[i] -- endfor xypoints[xypoint]) -% if smooth : cornered max(sx,sy) fi +% if reverse_connection : reverse fi +% (for i=1 upto xypoint-1 : xypoints[i] -- endfor xypoints[xypoint]) +% if smooth : cornered max(sx,sy) fi % enddef ; -% -% primarydef p cornered c = -% if cycle p : -% ((point 0 of p) shifted (c*(unitvector(point 1 of p - point 0 of p))) -- +% +% primarydef p cornered c = +% if cycle p : +% ((point 0 of p) shifted (c*(unitvector(point 1 of p - point 0 of p))) -- % for i=1 upto length(p) : -% (point i-1 of p) shifted (c*(unitvector(point i of p - point i-1 of p))) -- +% (point i-1 of p) shifted (c*(unitvector(point i of p - point i-1 of p))) -- % (point i of p) shifted (c*(unitvector(point i-1 of p - point i of p))) .. -% controls point i of p .. -% endfor cycle) +% controls point i of p .. +% endfor cycle) % else : -% ((point 0 of p) -- +% ((point 0 of p) -- % for i=1 upto length(p)-1 : -% (point i-1 of p) shifted (c*(unitvector(point i of p - point i-1 of p))) -- +% (point i-1 of p) shifted (c*(unitvector(point i of p - point i-1 of p))) -- % (point i of p) shifted (c*(unitvector(point i-1 of p - point i of p))) .. -% controls point i of p .. +% controls point i of p .. % endfor % (point length(p) of p)) -% fi +% fi % enddef ; def draw_connection = if xypoint>0 : collapse_points ; - trim_points ; - cpath := cpath + 1 ; + trim_points ; + cpath := cpath + 1 ; cpaths[cpath] := connection_path scaled_to_grid ; cline[cpath] := connection_line_width ; ccolor[cpath] := connection_line_color ; @@ -396,30 +396,30 @@ def draw_connection = enddef ; def flush_connections = - pair ip ; - boolean crossing ; + pair ip ; + boolean crossing ; ahlength := connection_arrow_size ; dash_pattern := dashpattern(on connection_dash_size off connection_dash_size ) ; - for i=1 upto cpath : + for i=1 upto cpath : if ccross[i] : crossing := false ; for j=1 upto i : - %if not ((point infinity of cpaths[i] = point infinity of cpaths[j]) or + %if not ((point infinity of cpaths[i] = point infinity of cpaths[j]) or % (point 0 of cpaths[i] = point 0 of cpaths[j])) : if not (point infinity of cpaths[i] = point infinity of cpaths[j]) : ip := cpaths[i] intersection_point cpaths[j] ; if intersection_found : crossing := true fi ; - fi ; - endfor ; - if crossing : + fi ; + endfor ; + if crossing : pickup pencircle scaled 2cline[i] ; %draw cpaths[i] withcolor chart_background_color ; - path cp ; cp := cpaths[i] ; - cp := cp cutbefore point .05 length cp of cp ; - cp := cp cutafter point .95 length cp of cp ; + path cp ; cp := cpaths[i] ; + cp := cp cutbefore point .05 length cp of cp ; + cp := cp cutafter point .95 length cp of cp ; draw cp withcolor chart_background_color ; - fi ; - fi ; + fi ; + fi ; pickup pencircle scaled cline[i] ; if carrow[i] : if cdash[i] : @@ -513,9 +513,9 @@ vardef right_to_grid (expr a,b) = ypart xypoints[a]) enddef ; -% vardef boundingboxfraction(expr p, f) = +% vardef boundingboxfraction(expr p, f) = % ((boundingbox p) enlarged (-f*bbwidth(p),-f*bbheight(p))) -% enddef ; +% enddef ; vardef valid_connection (expr xfrom, yfrom, xto, yto) = begingroup ; @@ -534,30 +534,30 @@ vardef valid_connection (expr xfrom, yfrom, xto, yto) = elseif forcevalid : %message("force"); true - elseif (xfrom=xto) and (yfrom=yto) : + elseif (xfrom=xto) and (yfrom=yto) : %message("self"); - false + false else : % check for crossing shapes pair vc ; path pp ; - pair xyfirst, xylast ; - xyfirst := xypoints[1] ; + pair xyfirst, xylast ; + xyfirst := xypoints[1] ; xylast := xypoints[xypoint] ; - trim_points ; + trim_points ; pp := for i=1 upto xypoint-1 : xypoints[i]-- endfor xypoints[xypoint] ; - xypoints[1] := xyfirst ; + xypoints[1] := xyfirst ; xypoints[xypoint] := xylast ; for i=1 upto max_x : for j=1 upto max_y : % was bug: xfrom,yto - if not ( ( (i,j)=(xfrom,yfrom) ) or ( (i,j)=(xto,yto) ) ) : - if not xyfree[i][j] : + if not ( ( (i,j)=(xfrom,yfrom) ) or ( (i,j)=(xto,yto) ) ) : + if not xyfree[i][j] : vc := pp intersection_point xypath[i][j] ; if intersection_found : ok := false fi ; fi ; - fi ; + fi ; endfor ; endfor ; %if not ok: message("crossing") ; fi ; @@ -588,8 +588,8 @@ def connect_top_bottom (expr xfrom,yyfrom,zfrom) (expr xto,yyto,zto) = elseif dsp_y<0 : xypoints[4] := xypoints[4] shifted (0,dsp_y) ; xypoints[5] := xypoints[5] shifted (0,dsp_y) ; - fi - %%%% end experiment + fi + %%%% end experiment draw_connection ; fi ; enddef ; @@ -676,8 +676,8 @@ def connect_right_bottom (expr xfrom,yyfrom,zfrom) (expr xto,yyto,zto) = elseif dsp_y<0 : xypoints[3] := xypoints[3] shifted (0,dsp_y) ; xypoints[4] := xypoints[4] shifted (0,dsp_y) ; - fi - %%%% end experiment + fi + %%%% end experiment draw_connection ; fi ; enddef ; @@ -748,15 +748,15 @@ def connect_bottom_bottom (expr xfrom,yyfrom,zfrom) (expr xto,yyto,zto) = fi ; %%%% begin experiment xypoints[3] := xypoints[3] shifted (dsp_x,0) ; - xypoints[4] := xypoints[4] shifted (dsp_x) ; + xypoints[4] := xypoints[4] shifted (dsp_x,0) ; if dsp_y<0 : xypoints[2] := xypoints[2] shifted (0,-dsp_y) ; xypoints[3] := xypoints[3] shifted (0,-dsp_y) ; elseif dsp_y>0 : xypoints[4] := xypoints[4] shifted (0,dsp_y) ; xypoints[5] := xypoints[5] shifted (0,dsp_y) ; - fi - %%%% end experiment + fi + %%%% end experiment draw_connection ; fi ; enddef ; @@ -891,39 +891,39 @@ enddef ; def clip_chart (expr minx, miny, maxx, maxy) = cmin_x := minx ; cmax_x := maxx ; - cmin_y := miny ; - cmax_y := maxy ; + cmin_y := miny ; + cmax_y := maxy ; enddef ; def begin_chart (expr n, maxx, maxy) = new_chart ; chart_figure := n ; - chart_scale := 1 ; + chart_scale := 1 ; if chart_figure>0: beginfig(chart_figure) ; fi ; initialize_grid (maxx, maxy) ; bboxmargin := 0 ; - cmin_x := 1 ; + cmin_x := 1 ; cmax_x := maxx ; - cmin_y := 1 ; - cmax_y := maxy ; + cmin_y := 1 ; + cmax_y := maxy ; enddef ; def end_chart = flush_shapes ; - flush_connections ; - cmin_x := cmin_x ; - cmax_x := cmin_x+cmax_x ; - cmin_y := cmin_y-1 ; - cmax_y := cmin_y+cmax_y ; - if reverse_y : + flush_connections ; + cmin_x := cmin_x ; + cmax_x := cmin_x+cmax_x ; + cmin_y := cmin_y-1 ; + cmax_y := cmin_y+cmax_y ; + if reverse_y : cmin_y := y_pos(cmin_y) ; - cmax_y := y_pos(cmax_y) ; - fi ; + cmax_y := y_pos(cmax_y) ; + fi ; path p ; p := (((cmin_x,cmin_y)--(cmax_x,cmin_y)-- (cmax_x,cmax_y)--(cmin_x,cmax_y)--cycle)) scaled_to_grid ; - %draw p withcolor red ; + %draw p withcolor red ; p := p enlarged chart_offset ; clip currentpicture to p ; setbounds currentpicture to p ; diff --git a/metapost/context/base/mp-core.mp b/metapost/context/base/mp-core.mp index 51d2d0025..eb038163e 100644 --- a/metapost/context/base/mp-core.mp +++ b/metapost/context/base/mp-core.mp @@ -520,11 +520,12 @@ par_hang_after := ra + estimated_par_lines(py-fy) ; if (par_hang_indent>0) and (par_hang_after<0) and obey_multi_par_hang : pair _ul_ ; _ul_ := (xpart ulcorner multipar, ypart snapped_multi_pos(ulxy[fpos])); pair _pa_ ; _pa_ := _ul_ shifted (0,par_hang_after*par_line_height) ; - _pa_ := (xpart _pa_,max(ypart _pa_,ypart llcorner multipar)) ; +% _pa_ := (xpart _pa_,max(ypart _pa_,ypart llcorner multipar)) ; + _pa_ := (xpart _pa_,max(ypart _pa_ -TopSkipCorrection,ypart llcorner multipar)) ; if same_area : - _pa_ := (xpart _pa_,max(ypart _pa_,ypart llxy[tpos])) ; +% _pa_ := (xpart _pa_,max(ypart _pa_,ypart llxy[tpos])) ; + _pa_ := (xpart _pa_,max(ypart _pa_ -TopSkipCorrection,ypart llxy[tpos])) ; fi ; -% vervalt: if obey_multi_par_more and (round(par_line_height)>0) : par_hang_after := min(0,round(par_hang_after + (ypart urxy[fpos]-ypart _pa_)/par_line_height)) ; @@ -539,7 +540,8 @@ par_hang_after := ra + estimated_par_lines(py-fy) ; vardef right_top_hang (expr same_area) = -par_hang_after := ra - estimated_par_lines(py-fy) ; +% par_hang_after := ra - estimated_par_lines(py-fy) ; +par_hang_after := ra + estimated_par_lines(py-fy) ; if (par_hang_indent<0) and (par_hang_after<0) and obey_multi_par_hang : pair _ur_ ; _ur_ := (xpart urcorner multipar, ypart snapped_multi_pos(urxy[fpos])) ; @@ -1240,6 +1242,7 @@ vardef PrepareSyncTasks(expr n, collapse, extendtop, prestartnext) = NOfSyncPaths := NOfSyncPaths + 1 ; if not ok : if i>1 : +% not yet correct when two of the same follow each other if sync_t[n][i-1] = sync_t[n][i] : SyncPaths[NOfSyncPaths] := SyncBox(n, i, SyncLeftOffset, SyncWidth, PaperHeight, -PaperHeight) ; SyncTasks[NOfSyncPaths] := i ; diff --git a/metapost/context/base/mp-figs.mp b/metapost/context/base/mp-figs.mp new file mode 100644 index 000000000..aa6bc0399 --- /dev/null +++ b/metapost/context/base/mp-figs.mp @@ -0,0 +1,50 @@ +%D \module +%D [ file=mp-tool.mp, +%D version=2003.01.15, +%D title=\CONTEXT\ \METAPOST\ graphics, +%D subtitle=figures, +%D author=Hans Hagen, +%D date=\currentdate, +%D copyright={PRAGMA / Hans Hagen \& Ton Otten}] +%C +%C This module is part of the \CONTEXT\ macro||package and is +%C therefore copyrighted by \PRAGMA. See licen-en.pdf for +%C details. + +if unknown context_tool : input mp-tool ; fi ; +if known context_figs : endinput ; fi ; + +boolean context_figs ; context_figs := true ; + +% todo: check defined + +def registerfigure(expr name,width,height) = + begingroup ; + save s ; string s ; s := cleanstring(name) ; + scantokens( s & "_width := " & decimal(width)) ; + scantokens( s & "_height := " & decimal(width)) ; + endgroup ; +enddef ; + +vardef figuresize(expr name) = + save s ; string s ; s := cleanstring(name) ; + save p ; pair p ; + scantokens( "p := " & "(" & s & "_width" & "," & s & "_height" & ")" ) ; + p +enddef ; + +vardef figurewidth(expr name) = + xpart figuresize(name) +enddef ; + +vardef figureheight(expr name) = + ypart figuresize(name) +enddef ; + +def figuredimensions = figuresize enddef ; % for old times sake + +def naturalfigure(expr name) = + externalfigure name xyscaled(figuresize(name)) +enddef ; + +endinput diff --git a/metapost/context/base/mp-spec.mp b/metapost/context/base/mp-spec.mp index b005eb381..bef6cd2fa 100644 --- a/metapost/context/base/mp-spec.mp +++ b/metapost/context/base/mp-spec.mp @@ -414,34 +414,106 @@ resetspotcolors ; boolean spotcolors ; spotcolors := false ; % true string spotcolorpattern[] ; % needed for transparancies +% vardef spotcolor(expr p, s) = +% if spotcolors : +% save ok, pc_tag ; boolean ok ; string pc_tag ; +% pc_tag := "_pct_"&p ; +% if not unstringed(pc_tag) : +% _spotcolor_number_ := _spotcolor_number_ + 1 ; +% setunstringed(pc_tag,_spotcolor_number_) ; +% fi ; +% pp := getunstringed(pc_tag) ; +% if unknown spotcolorhash[pp][s] : +% ok := false ; % not yet defined +% elseif spotcolorhash[pp][s] = -1 : +% ok := false ; % locally defined and undefined +% else : +% ok := true ; % globally already defined +% fi ; +% if not ok : +% save ss ; string ss ; ss := p & " " & decimal s ; +% _spotcolor_counter_ := _spotcolor_counter_ + 1 ; +% spotcolorpattern[_spotcolor_counter_/1000] := ss ; +% spotcolorhash[pp][s] := _spotcolor_counter_ ; +% flush_special(2, 5, decimal _spotcolor_counter_ & " " & ss) ; +% _local_specials_ := _local_specials_ & +% "spotcolorhash["&decimal pp&"]["&decimal s&"]:=-1;" ; +% fi ; +% (_special_signal_/1000,2/1000,spotcolorhash[pp][s]/1000) +% else : +% (1-s,1-s,1-s) +% fi +% enddef ; + +% vardef spotcolor(expr p, s) = +% if spotcolors : +% save ok, pc_tag ; boolean ok ; string pc_tag ; +% pc_tag := "_pct_"&p ; +% if not unstringed(pc_tag) : +% _spotcolor_number_ := _spotcolor_number_ + 1 ; +% setunstringed(pc_tag,_spotcolor_number_) ; +% fi ; +% pp := getunstringed(pc_tag) ; +% if unknown spotcolorhash[pp][s] : +% ok := false ; % not yet defined +% elseif spotcolorhash[pp][s] = -1 : +% ok := false ; % locally defined and undefined +% else : +% ok := true ; % globally already defined +% fi ; +% if not ok : +% save ss ; string ss ; ss := p & " " & decimal s ; +% _spotcolor_counter_ := _spotcolor_counter_ + 1 ; +% spotcolorpattern[_spotcolor_counter_/1000] := ss ; +% spotcolorhash[pp][s] := _spotcolor_counter_ ; +% flush_special(2, 5, decimal _spotcolor_counter_ & " " & ss) ; +% _local_specials_ := _local_specials_ & +% "spotcolorhash["&decimal pp&"]["&decimal s&"]:=-1;" ; +% fi ; +% (_special_signal_/1000,2/1000,spotcolorhash[pp][s]/1000) +% else : +% (1-s,1-s,1-s) +% fi +% enddef ; + vardef spotcolor(expr p, s) = + multitonecolor(p, 1, "", decimal s) +enddef ; + +vardef multitonecolor(expr n, f, d, p) = % name fractions names factors if spotcolors : save ok, pc_tag ; boolean ok ; string pc_tag ; - pc_tag := "_pct_"&p ; + pc_tag := "_pct_" & n ; if not unstringed(pc_tag) : _spotcolor_number_ := _spotcolor_number_ + 1 ; setunstringed(pc_tag,_spotcolor_number_) ; fi ; pp := getunstringed(pc_tag) ; - if unknown spotcolorhash[pp][s] : + pc_tag := "_pct_"& decimal f & "_" & if d = "" : n else : d fi & "_" & p ; % check for d empty + if not unstringed(pc_tag) : + _spotcolor_number_ := _spotcolor_number_ + 1 ; + setunstringed(pc_tag,_spotcolor_number_) ; + fi ; + ps := getunstringed(pc_tag) ; + if unknown spotcolorhash[pp][ps] : ok := false ; % not yet defined - elseif spotcolorhash[pp][s] = -1 : + elseif spotcolorhash[pp][ps] = -1 : ok := false ; % locally defined and undefined else : ok := true ; % globally already defined fi ; if not ok : - save ss ; string ss ; ss := p & " " & decimal s ; + save ss ; string ss ; ss := n & " " & decimal f & " " & if d = "" : n else : d fi & " " & p ; _spotcolor_counter_ := _spotcolor_counter_ + 1 ; spotcolorpattern[_spotcolor_counter_/1000] := ss ; - spotcolorhash[pp][s] := _spotcolor_counter_ ; - flush_special(2, 5, decimal _spotcolor_counter_ & " " & ss) ; + spotcolorhash[pp][ps] := _spotcolor_counter_ ; + flush_special(2, 7, decimal _spotcolor_counter_ & " " & ss) ; _local_specials_ := _local_specials_ & - "spotcolorhash["&decimal pp&"]["&decimal s&"]:=-1;" ; + "spotcolorhash["&decimal pp&"]["&decimal ps&"]:=-1;" ; fi ; - (_special_signal_/1000,2/1000,spotcolorhash[pp][s]/1000) + (_special_signal_/1000,2/1000,spotcolorhash[pp][ps]/1000) else : - (1-s,1-s,1-s) + .5white fi enddef ; @@ -459,6 +531,63 @@ differencetransparent := 11 ; exclusiontransparent := 12 ; % fill fullcircle scaled 10cm withcolor transparant(.8,3,color) ; +% vardef transparent(expr n, t, c) = +% save s, ss, nn, cc, is_cmyk, is_spot, ok ; +% string s, ss ; numeric nn ; color cc ; boolean is_cmyk, is_spot, ok ; +% % transparancy type +% if string n : +% if expandafter known scantokens(n&"transparent") : +% nn := scantokens(n&"transparent") ; +% else : +% nn := 0 ; +% fi +% else : % nn := min(n,13) +% nn := if n<13 : n else : nn := 0 fi ; +% fi ; +% % we need to expand the color (can be cmyk(..) or predefined) +% cc := c ; % expand color +% % check for cmyk special +% is_cmyk := (redpart cc = _special_signal_/1000) +% and (greenpart cc = 1/1000) ; +% is_spot := (redpart cc = _special_signal_/1000) +% and (greenpart cc = 2/1000) ; +% % build special string, fetch cmyk components +% s := decimal nn & " " & decimal t & " " & +% if is_cmyk : cmykcolorpattern[bluepart cc] +% elseif is_spot : spotcolorpattern[bluepart cc] +% else : dddecimal cc fi ; +% % check if this one is already used +% ss := "tr_" & s ; +% % efficiency hack +% if expandafter unknown scantokens(ss) : +% ok := false ; % not yet defined +% elseif scantokens(ss) < 0 : +% ok := false ; % locally defined and undefined +% else : +% ok := true ; % globally already defined +% fi ; +% if not ok : +% if is_spot : +% flush_special(5, 6, s) ; +% elseif is_cmyk : +% flush_special(4, 8, s) ; +% else : +% flush_special(3, 7, s) ; +% fi ; +% scantokens(ss) := _special_counter_ ; +% _local_specials_ := _local_specials_ & +% "scantokens(" & ditto & ss & ditto & ") := -1 ;" ; +% fi ; +% % go ahead +% if is_spot : +% (_special_signal_/1000,5/1000,scantokens(ss)/1000) +% elseif is_cmyk : +% (_special_signal_/1000,4/1000,scantokens(ss)/1000) +% else : +% (_special_signal_/1000,3/1000,scantokens(ss)/1000) +% fi +% enddef ; + vardef transparent(expr n, t, c) = save s, ss, nn, cc, is_cmyk, is_spot, ok ; string s, ss ; numeric nn ; color cc ; boolean is_cmyk, is_spot, ok ; @@ -485,7 +614,12 @@ vardef transparent(expr n, t, c) = elseif is_spot : spotcolorpattern[bluepart cc] else : dddecimal cc fi ; % check if this one is already used - ss := "tr_" & s ; + ss := cleanstring("tr_" & s) ; + % we now have rather unique names, i.e. a color spec of .234 becomes + % tr..._234.... and metapost gives a number overflow (parse error) + % for variables like tr_12345678 which may result from many decimal + % positions (imo mp bug) + ss := asciistring(ss) ; % efficiency hack if expandafter unknown scantokens(ss) : ok := false ; % not yet defined @@ -496,7 +630,7 @@ vardef transparent(expr n, t, c) = fi ; if not ok : if is_spot : - flush_special(5, 6, s) ; + flush_special(5, 8, s) ; elseif is_cmyk : flush_special(4, 8, s) ; else : @@ -570,4 +704,4 @@ enddef ; % spotcolor is already scaled -endinput ;
\ No newline at end of file +endinput ; diff --git a/metapost/context/base/mp-text.mp b/metapost/context/base/mp-text.mp index cb6bb3895..2e061df09 100644 --- a/metapost/context/base/mp-text.mp +++ b/metapost/context/base/mp-text.mp @@ -2,165 +2,182 @@ %D [ file=mp-text.mp, %D version=2000.07.10, %D title=\CONTEXT\ \METAPOST\ graphics, -%D subtitle=text support, +%D subtitle=text support, %D author=Hans Hagen, %D date=\currentdate, %D copyright={PRAGMA / Hans Hagen \& Ton Otten}] %C %C This module is part of the \CONTEXT\ macro||package and is -%C therefore copyrighted by \PRAGMA. See licen-en.pdf for -%C details. +%C therefore copyrighted by \PRAGMA. See licen-en.pdf for +%C details. %D Under construction. -if unknown context_tool : input mp-tool ; fi ; -if known context_text : endinput ; fi ; +if unknown context_tool : input mp-tool ; fi ; +if known context_text : endinput ; fi ; -boolean context_text ; context_text := true ; +boolean context_text ; context_text := true ; -if unknown noftexpictures : - numeric noftexpictures ; noftexpictures := 0 ; -fi ; +if unknown noftexpictures : + numeric noftexpictures ; noftexpictures := 0 ; +fi ; -if unknown texpictures[1] : - picture texpictures[] ; -fi ; +if unknown texpictures[1] : + picture texpictures[] ; +fi ; -numeric textextoffset ; textextoffset := 0 ; +numeric textextoffset ; textextoffset := 0 ; -% vardef textext@#(expr txt) = -% interim labeloffset := textextoffset ; -% noftexpictures := noftexpictures + 1 ; -% if string txt : -% write "% figure " & decimal charcode & " : " & -% "texpictures[" & decimal noftexpictures & "] := btex " & -% txt & " etex ;" to jobname & ".mpt" ; -% if unknown texpictures[noftexpictures] : -% thelabel@#("unknown",origin) +% vardef textext@#(expr txt) = +% interim labeloffset := textextoffset ; +% noftexpictures := noftexpictures + 1 ; +% if string txt : +% write "% figure " & decimal charcode & " : " & +% "texpictures[" & decimal noftexpictures & "] := btex " & +% txt & " etex ;" to jobname & ".mpt" ; +% if unknown texpictures[noftexpictures] : +% thelabel@#("unknown",origin) % else : -% thelabel@#(texpictures[noftexpictures],origin) -% fi +% thelabel@#(texpictures[noftexpictures],origin) +% fi % else : -% thelabel@#(txt,origin) -% fi -% enddef ; - -boolean hobbiestextext ; hobbiestextext := false ; - -vardef textext@#(expr txt) = - interim labeloffset := textextoffset ; - noftexpictures := noftexpictures + 1 ; - if string txt : +% thelabel@#(txt,origin) +% fi +% enddef ; + +boolean hobbiestextext ; hobbiestextext := false ; +% string textextstring ; textextstring := "" ; + +% def resettextextdirective = +% textextstring := "" ; +% enddef ; + +% def textextdirective text t = +% textextstring := textextstring & t ; +% enddef ; + +vardef textext@#(expr txt) = + save _s_ ; string _s_ ; + interim labeloffset := textextoffset ; + noftexpictures := noftexpictures + 1 ; + if string txt : +% if textextstring <> "" : +% _s_ := "verbatimtex " & textextstring & " etex ;" ; +% else : +% _s_ := "" ; +% fi ; if hobbiestextext : % the tex.mp method as fallback (see tex.mp) - write "btex " & txt & " etex" to "mptextmp.mp" ; +% write _s_ to "mptextmp.mp" ; + write _s_ & "btex " & txt & " etex" to "mptextmp.mp" ; write EOF to "mptextmp.mp" ; scantokens "input mptextmp" else : - write "% figure " & decimal charcode & " : " & - "texpictures[" & decimal noftexpictures & "] := btex " & - txt & " etex ;" to jobname & ".mpt" ; - if unknown texpictures[noftexpictures] : - thelabel@#("unknown",origin) +% write "% setup : " & _s_ to jobname & ".mpt" ; + write "% figure " & decimal charcode & " : " & + "texpictures[" & decimal noftexpictures & "] := btex " & + txt & " etex ;" to jobname & ".mpt" ; + if unknown texpictures[noftexpictures] : + thelabel@#("unknown",origin) else : - thelabel@#(texpictures[noftexpictures],origin) + thelabel@#(texpictures[noftexpictures],origin) fi - fi + fi else : - thelabel@#(txt,origin) - fi -enddef ; - -string laboff_ ; laboff_ := "" ; -string laboff_c ; laboff_c := "" ; -string laboff_l ; laboff_l := ".lft" ; -string laboff_r ; laboff_r := ".rt" ; -string laboff_b ; laboff_b := ".bot" ; -string laboff_t ; laboff_t := ".top" ; -string laboff_lt ; laboff_lt := ".ulft" ; -string laboff_rt ; laboff_rt := ".urt" ; -string laboff_lb ; laboff_lb := ".llft" ; -string laboff_rb ; laboff_rb := ".lrt" ; -string laboff_tl ; laboff_tl := ".ulft" ; -string laboff_tr ; laboff_tr := ".urt" ; -string laboff_bl ; laboff_bl := ".llft" ; -string laboff_br ; laboff_br := ".lrt" ; - -vardef textextstr(expr s, a) = - save ss ; string ss ; - ss := "laboff_" & a ; - ss := scantokens ss ; + thelabel@#(txt,origin) + fi +enddef ; + +string laboff_ ; laboff_ := "" ; +string laboff_c ; laboff_c := "" ; +string laboff_l ; laboff_l := ".lft" ; +string laboff_r ; laboff_r := ".rt" ; +string laboff_b ; laboff_b := ".bot" ; +string laboff_t ; laboff_t := ".top" ; +string laboff_lt ; laboff_lt := ".ulft" ; +string laboff_rt ; laboff_rt := ".urt" ; +string laboff_lb ; laboff_lb := ".llft" ; +string laboff_rb ; laboff_rb := ".lrt" ; +string laboff_tl ; laboff_tl := ".ulft" ; +string laboff_tr ; laboff_tr := ".urt" ; +string laboff_bl ; laboff_bl := ".llft" ; +string laboff_br ; laboff_br := ".lrt" ; + +vardef textextstr(expr s, a) = + save ss ; string ss ; + ss := "laboff_" & a ; + ss := scantokens ss ; ss := "textext" & ss & "(" & ditto & s & ditto & ")" ; - scantokens ss -enddef ; + scantokens ss +enddef ; -pair laboff.origin ; laboff.origin = (infinity,infinity) ; -pair laboff.raw ; laboff.raw = (infinity,infinity) ; +pair laboff.origin ; laboff.origin = (infinity,infinity) ; +pair laboff.raw ; laboff.raw = (infinity,infinity) ; -vardef thelabel@#(expr s, z) = +vardef thelabel@#(expr s, z) = save p ; picture p ; p = s if not picture s : infont defaultfont scaled defaultscale fi ; - if laboff@#<>laboff.origin : - (p shifted (z + labeloffset*laboff@# - (labxf@#*lrcorner p + + if laboff@#<>laboff.origin : + (p shifted (z + labeloffset*laboff@# - (labxf@#*lrcorner p + labyf@#*ulcorner p + (1-labxf@#-labyf@#)*llcorner p))) else : (p shifted z) fi enddef; -def build_parshape (expr p, offset_or_path, dx, dy, +def build_parshape (expr p, offset_or_path, dx, dy, baselineskip, strutheight, strutdepth, topskip) = - - if unknown trace_parshape : - boolean trace_parshape ; trace_parshape := false ; + + if unknown trace_parshape : + boolean trace_parshape ; trace_parshape := false ; fi ; begingroup ; - save q, l, r, line, tt, bb, - n, hsize, vsize, vvsize, voffset, hoffset, width, indent, - ll, lll, rr, rrr, cp, cq, t, b ; + save q, l, r, line, tt, bb, + n, hsize, vsize, vvsize, voffset, hoffset, width, indent, + ll, lll, rr, rrr, cp, cq, t, b ; - path q, l, r, line, tt, bb ; + path q, l, r, line, tt, bb ; numeric n, hsize, vsize, vvsize, voffset, hoffset, width[], indent[] ; - pair ll, lll, rr, rrr, cp, cq, t, b ; + pair ll, lll, rr, rrr, cp, cq, t, b ; - n := 0 ; cp := center p ; + n := 0 ; cp := center p ; - if path offset_or_path : - q := offset_or_path ; cq := center q ; - voffset := dy ; - hoffset := dx ; - else : - q := p ; cq := center q ; + if path offset_or_path : + q := offset_or_path ; cq := center q ; + voffset := dy ; + hoffset := dx ; + else : + q := p ; cq := center q ; hoffset := offset_or_path + dx ; - voffset := offset_or_path + dy ; - fi ; + voffset := offset_or_path + dy ; + fi ; - hsize := xpart lrcorner q - xpart llcorner q ; - vsize := ypart urcorner q - ypart lrcorner q ; + hsize := xpart lrcorner q - xpart llcorner q ; + vsize := ypart urcorner q - ypart lrcorner q ; - q := p shifted - cp ; + q := p shifted - cp ; - startsavingdata ; + startsavingdata ; - savedata "\global\parvoffset " & decimal voffset&"bp " ; - savedata "\global\parhoffset " & decimal hoffset&"bp " ; - savedata "\global\parwidth " & decimal hsize&"bp " ; - savedata "\global\parheight " & decimal vsize&"bp " ; + savedata "\global\parvoffset " & decimal voffset&"bp " ; + savedata "\global\parhoffset " & decimal hoffset&"bp " ; + savedata "\global\parwidth " & decimal hsize&"bp " ; + savedata "\global\parheight " & decimal vsize&"bp " ; - if not path offset_or_path : - q := q xscaled ((hsize-2hoffset)/hsize) - yscaled ((vsize-2voffset)/vsize) ; - fi ; + if not path offset_or_path : + q := q xscaled ((hsize-2hoffset)/hsize) + yscaled ((vsize-2voffset)/vsize) ; + fi ; - hsize := xpart lrcorner q - xpart llcorner q ; - vsize := ypart urcorner q - ypart lrcorner q ; + hsize := xpart lrcorner q - xpart llcorner q ; + vsize := ypart urcorner q - ypart lrcorner q ; - t := (ulcorner q -- urcorner q) intersection_point q ; - b := (llcorner q -- lrcorner q) intersection_point q ; + t := (ulcorner q -- urcorner q) intersection_point q ; + b := (llcorner q -- lrcorner q) intersection_point q ; - if xpart directionpoint t of q < 0 : - q := reverse q ; + if xpart directionpoint t of q < 0 : + q := reverse q ; fi ; l := q cutbefore t ; @@ -169,82 +186,82 @@ def build_parshape (expr p, offset_or_path, dx, dy, r := q cutbefore b ; r := r if xpart point 0 of q > 0 : & q fi cutafter t ; -% tt := (ulcorner q -- urcorner q) shifted (0,-topskip) ; -% bb := (llcorner q -- lrcorner q) shifted (0,strutdepth) ; +% tt := (ulcorner q -- urcorner q) shifted (0,-topskip) ; +% bb := (llcorner q -- lrcorner q) shifted (0,strutdepth) ; % -% l := l cutbefore (l intersection_point tt) ; -% l := l cutafter (l intersection_point bb) ; -% r := r cutbefore (r intersection_point bb) ; -% r := r cutafter (r intersection_point tt) ; +% l := l cutbefore (l intersection_point tt) ; +% l := l cutafter (l intersection_point bb) ; +% r := r cutbefore (r intersection_point bb) ; +% r := r cutafter (r intersection_point tt) ; - if trace_parshape : + if trace_parshape : drawarrow p withpen pencircle scaled 2pt withcolor red ; drawarrow l shifted cp withpen pencircle scaled 1pt withcolor green ; drawarrow r shifted cp withpen pencircle scaled 1pt withcolor blue ; - fi ; + fi ; - vardef found_point (expr lin, pat, sig) = + vardef found_point (expr lin, pat, sig) = pair a, b ; a := pat intersection_point (lin shifted (0,strutheight)) ; - if intersection_found : + if intersection_found : a := a shifted (0,-strutheight) ; else : a := pat intersection_point lin ; fi ; b := pat intersection_point (lin shifted (0,-strutdepth)) ; - if intersection_found : - if sig : - if xpart b > xpart a : a := b shifted (0,strutdepth) fi ; - else : - if xpart b < xpart a : a := b shifted (0,strutdepth) fi ; - fi ; - fi ; - a + if intersection_found : + if sig : + if xpart b > xpart a : a := b shifted (0,strutdepth) fi ; + else : + if xpart b < xpart a : a := b shifted (0,strutdepth) fi ; + fi ; + fi ; + a enddef ; - if (strutheight+strutdepth<baselineskip) : - vvsize := vsize ; - else : - vvsize := (vsize div baselineskip) * baselineskip ; - fi ; + if (strutheight+strutdepth<baselineskip) : + vvsize := vsize ; + else : + vvsize := (vsize div baselineskip) * baselineskip ; + fi ; - for i=topskip step baselineskip until vvsize : + for i=topskip step baselineskip until vvsize : - line := (ulcorner q -- urcorner q) shifted (0,-i-eps) ; + line := (ulcorner q -- urcorner q) shifted (0,-i-eps) ; ll := found_point(line,l,true ) ; rr := found_point(line,r,false) ; - if trace_parshape : - fill (ll--rr--rr shifted (0,strutheight)--ll + if trace_parshape : + fill (ll--rr--rr shifted (0,strutheight)--ll shifted (0,strutheight)--cycle) shifted cp withcolor .5white ; - fill (ll--rr--rr shifted (0,-strutdepth)--ll + fill (ll--rr--rr shifted (0,-strutdepth)--ll shifted (0,-strutdepth)--cycle) shifted cp withcolor .7white ; - draw ll shifted cp withpen pencircle scaled 2pt ; - draw rr shifted cp withpen pencircle scaled 2pt ; + draw ll shifted cp withpen pencircle scaled 2pt ; + draw rr shifted cp withpen pencircle scaled 2pt ; draw (ll--rr) shifted cp withpen pencircle scaled .5pt ; - fi ; + fi ; - n := n + 1 ; + n := n + 1 ; indent[n] := abs(xpart ll - xpart llcorner q) ; width[n] := abs(xpart rr - xpart ll) ; - if (i=strutheight) and (width[n]<baselineskip) : - n := n - 1 ; - savedata "\global\chardef\parfirst=1 " ; + if (i=strutheight) and (width[n]<baselineskip) : + n := n - 1 ; + savedata "\global\chardef\parfirst=1 " ; fi ; - endfor ; + endfor ; - savedata "\global\parlines " & decimal n ; - savedata "\global\partoks{ " ; - for i=1 upto n: - savedata decimal indent[i]&"bp " & decimal width[i]&"bp " ; - endfor ; + savedata "\global\parlines " & decimal n ; + savedata "\global\partoks{ " ; + for i=1 upto n: + savedata decimal indent[i]&"bp " & decimal width[i]&"bp " ; + endfor ; savedata "}" ; - - stopsavingdata ; + + stopsavingdata ; endgroup ; -enddef ; +enddef ; diff --git a/metapost/context/base/mp-tool.mp b/metapost/context/base/mp-tool.mp index d78ee43ea..1f299807a 100644 --- a/metapost/context/base/mp-tool.mp +++ b/metapost/context/base/mp-tool.mp @@ -1499,52 +1499,89 @@ enddef ; % nice: currentpicture := inverted currentpicture ; primarydef p uncolored c = - image - (for i within p : - addto currentpicture - if stroked i or filled i : - if filled i : contour else : doublepath fi pathpart i - dashed dashpart i withpen penpart i - else : - also i - fi - withcolor c-(redpart i, greenpart i, bluepart i) ; - endfor ; ) + if color p : + c - p + else : + image + (for i within p : + addto currentpicture + if stroked i or filled i : + if filled i : contour else : doublepath fi pathpart i + dashed dashpart i withpen penpart i + else : + also i + fi + withcolor c-(redpart i, greenpart i, bluepart i) ; + endfor ; ) + fi enddef ; vardef inverted primary p = (p uncolored white) enddef ; +% primarydef p softened c = +% if color p : +% tripled(c) * p +% else : +% image +% (save cc ; color cc ; cc := tripled(c) ; +% for i within p : +% addto currentpicture +% if stroked i or filled i : +% if filled i : contour else : doublepath fi pathpart i +% dashed dashpart i withpen penpart i +% else : +% also i +% fi +% withcolor (redpart cc * redpart i, +% greenpart cc * greenpart i, +% bluepart cc * bluepart i) ; +% endfor ;) +% fi +% enddef ; + primarydef p softened c = - image - (save cc ; color cc ; cc := tripled(c) ; - for i within p : - addto currentpicture - if stroked i or filled i : - if filled i : contour else : doublepath fi pathpart i - dashed dashpart i withpen penpart i - else : - also i - fi - withcolor (redpart cc * redpart i, - greenpart cc * greenpart i, - bluepart cc * bluepart i) ; - endfor ;) + begingroup + save cc ; color cc ; cc := tripled(c) ; + if color p : + (redpart cc * redpart p, + greenpart cc * greenpart p, + bluepart cc * bluepart p) + else : + image + (for i within p : + addto currentpicture + if stroked i or filled i : + if filled i : contour else : doublepath fi pathpart i + dashed dashpart i withpen penpart i + else : + also i + fi + withcolor (redpart cc * redpart i, + greenpart cc * greenpart i, + bluepart cc * bluepart i) ; + endfor ;) + fi + endgroup enddef ; vardef grayed primary p = - image - (for i within p : - addto currentpicture - if stroked i or filled i : - if filled i : contour else : doublepath fi pathpart i - dashed dashpart i withpen penpart i - else : - also i - fi - withcolor tripled(.30redpart i+.59greenpart i+.11bluepart i) ; - endfor ; ) + if color p : + tripled(.30redpart p+.59greenpart p+.11bluepart p) + else : + image + (for i within p : + addto currentpicture + if stroked i or filled i : + if filled i : contour else : doublepath fi pathpart i + dashed dashpart i withpen penpart i + else : + also i + fi + withcolor tripled(.30redpart i+.59greenpart i+.11bluepart i) ; + endfor ; ) + fi enddef ; % yes or no: "text" infont "cmr12" at 24pt ; @@ -1944,12 +1981,20 @@ vardef dodostraightened(expr sign, p) = fi enddef ; +% vardef simplified expr p = +% dostraightened(+1,p) +% enddef ; + +% vardef unspiked expr p = +% dostraightened(-1,p) +% enddef ; + vardef simplified expr p = - dostraightened(+1,p) + (reverse dostraightened(+1,dostraightened(+1,reverse p))) enddef ; vardef unspiked expr p = - dostraightened(-1,p) + (reverse dostraightened(-1,dostraightened(-1,reverse p))) enddef ; % path p ; @@ -2085,17 +2130,34 @@ enddef ; % obscure macros: create var from string and replace - and : % (needed for process color id's) -string _clean_ascii[] ; +string _clean_ascii_[] ; + +def register_dirty_chars(expr str) = + for i = 0 upto length(str)-1 : + _clean_ascii_[ASCII substring(i,i+1) of str] := "_" ; + endfor ; +enddef ; -_clean_ascii[ASCII "-"] := "_" ; -_clean_ascii[ASCII ":"] := "_" ; -_clean_ascii[ASCII "."] := "_" ; +register_dirty_chars("+-*/:;., ") ; vardef cleanstring (expr s) = - save ss ; string ss, si ; ss = "" ; + save ss ; string ss, si ; ss = "" ; save i ; for i=0 upto length(s) : si := substring(i,i+1) of s ; - ss := ss & if known _clean_ascii[ASCII si] : _clean_ascii[ASCII si] else : si fi ; + ss := ss & if known _clean_ascii_[ASCII si] : _clean_ascii_[ASCII si] else : si fi ; + endfor ; + ss +enddef ; + +vardef asciistring (expr s) = + save ss ; string ss, si ; ss = "" ; save i ; + for i=0 upto length(s) : + si := substring(i,i+1) of s ; + if (ASCII si >= ASCII "0") and (ASCII si <= ASCII "9") : + ss := ss & char(scantokens(si) + ASCII "A") ; + else : + ss := ss & si ; + fi ; endfor ; ss enddef ; @@ -2195,4 +2257,4 @@ enddef ; % done -endinput ;
\ No newline at end of file +endinput ; |