From 722c56251cf3c197a4a8474aa7024265ba284ec0 Mon Sep 17 00:00:00 2001 From: Hans Hagen Date: Fri, 2 Jan 2004 00:00:00 +0100 Subject: stable 2004.01.02 --- metapost/context/base/mp-core.mp | 716 ++++++++++------- metapost/context/base/mp-page.mp | 486 ++++++------ metapost/context/base/mp-spec.mp | 290 +++---- metapost/context/base/mp-tool.mp | 1559 ++++++++++++++++++++------------------ 4 files changed, 1638 insertions(+), 1413 deletions(-) (limited to 'metapost') diff --git a/metapost/context/base/mp-core.mp b/metapost/context/base/mp-core.mp index 72347734f..64ac0dfff 100644 --- a/metapost/context/base/mp-core.mp +++ b/metapost/context/base/mp-core.mp @@ -39,10 +39,10 @@ def initialize_box_pos (expr pos,n,x,y,w,h,d) = pxy := llxy--lrxy--urxy--ulxy--cycle ; cxy := center pxy ; nxy := n ; - freeze_box(pos) ; + freeze_box(pos) ; enddef ; -def freeze_box (expr pos) = +def freeze_box (expr pos) = lxy[pos] := lxy ; llxy[pos] := llxy ; lrxy[pos] := lrxy ; @@ -55,7 +55,7 @@ def freeze_box (expr pos) = pxy[pos] := pxy ; cxy[pos] := cxy ; nxy[pos] := nxy ; -enddef ; +enddef ; def initialize_box (expr n,x,y,w,h,d) = @@ -88,13 +88,13 @@ def do_initialize_area (expr fpos, tpos) = enddef ; def set_par_line_height (expr ph, pd) = - par_strut_height := - if ph>0 : ph elseif StrutHeight>0 : StrutHeight else : 8pt fi ; + par_strut_height := + if ph>0 : ph elseif StrutHeight>0 : StrutHeight else : 8pt fi ; par_strut_depth := - if pd>0 : pd elseif StrutDepth >0 : StrutDepth else : 3pt fi ; - par_line_height := + if pd>0 : pd elseif StrutDepth >0 : StrutDepth else : 3pt fi ; + par_line_height := par_strut_height + par_strut_depth ; -enddef ; +enddef ; def initialize_par (expr fn,fx,fy,fw,fh,fd, tn,tx,ty,tw,th,td, @@ -109,7 +109,7 @@ def initialize_par (expr fn,fx,fy,fw,fh,fd, numeric par_strut_height, par_strut_depth, par_line_height ; - set_par_line_height (ph, pd) ; + set_par_line_height (ph, pd) ; do_initialize_area (fpos, tpos) ; do_initialize_par (fpos, tpos, mpos, ppos, rw,rl,rr,rh,ra,ri) ; @@ -126,14 +126,14 @@ def initialize_area_par (expr fn,fx,fy,fw,fh,fd, numeric par_strut_height, par_strut_depth, par_line_height ; - set_par_line_height (wh, wd) ; + set_par_line_height (wh, wd) ; numeric ffpos ; ffpos := 4 ; initialize_box_pos(ffpos,wn,wx,fy,0,wh,wd) ; numeric ttpos ; ttpos := 5 ; initialize_box_pos(ttpos,wn,wx+ww,ty,0,wh,wd) ; - do_initialize_area (ffpos, ttpos) ; + do_initialize_area (ffpos, ttpos) ; - numeric mpos ; mpos := 6 ; freeze_box(mpos) ; + numeric mpos ; mpos := 6 ; freeze_box(mpos) ; % do_initialize_area (fpos, tpos) ; do_initialize_par (fpos, tpos, mpos, ffpos, 0,0,0,0,0,0) ; @@ -142,92 +142,92 @@ enddef ; def do_initialize_par (expr fpos, tpos, mpos, ppos, rw,rl,rr,rh,ra,ri) = - pair lref, rref, pref, lhref, rhref ; + pair lref, rref, pref, lhref, rhref ; % clip the page area to the left and right skips - llxy[mpos] := llxy[mpos] shifted (+rl,0) ; - lrxy[mpos] := lrxy[mpos] shifted (-rr,0) ; - urxy[mpos] := urxy[mpos] shifted (-rr,0) ; - ulxy[mpos] := ulxy[mpos] shifted (+rl,0) ; + llxy[mpos] := llxy[mpos] shifted (+rl,0) ; + lrxy[mpos] := lrxy[mpos] shifted (-rr,0) ; + urxy[mpos] := urxy[mpos] shifted (-rr,0) ; + ulxy[mpos] := ulxy[mpos] shifted (+rl,0) ; % fixate the leftskip, rightskip and hanging indentation - - lref := (xpart llxy[mpos],ypart ulxy[ppos]) ; lhref := lref shifted (rh,0) ; - rref := (xpart lrxy[mpos],ypart urxy[ppos]) ; rhref := rref shifted (rh,0) ; - - pref := lxy[ppos] ; - - if nxy[tpos] > nxy[fpos] : - if nxy[fpos] = nxy[mpos] : - % first of multiple pages - llxy[tpos] := llxy[mpos] ; - lrxy[tpos] := lrxy[mpos] ; - urxy[tpos] := lrxy[mpos] shifted (0,par_line_height) ; - ulxy[tpos] := llxy[mpos] shifted (0,par_line_height) ; - boxgriddirection := down ; - elseif nxy[tpos] = nxy[mpos] : - % last of multiple pages - llxy[fpos] := ulxy[mpos] shifted (0,-par_line_height) ; - lrxy[fpos] := urxy[mpos] shifted (0,-par_line_height) ; - urxy[fpos] := urxy[mpos] ; - ulxy[fpos] := ulxy[mpos] ; - boxgriddirection := up ; - else : - % middle of multiple pages - llxy[fpos] := ulxy[mpos] shifted (0,-par_line_height) ; - lrxy[fpos] := urxy[mpos] shifted (0,-par_line_height) ; - urxy[fpos] := urxy[mpos] ; - ulxy[fpos] := ulxy[mpos] ; - llxy[tpos] := llxy[mpos] ; - lrxy[tpos] := lrxy[mpos] ; - urxy[tpos] := lrxy[mpos] shifted (0,par_line_height) ; - ulxy[tpos] := llxy[mpos] shifted (0,par_line_height) ; - boxgriddirection := up ; + + lref := (xpart llxy[mpos],ypart ulxy[ppos]) ; lhref := lref shifted (rh,0) ; + rref := (xpart lrxy[mpos],ypart urxy[ppos]) ; rhref := rref shifted (rh,0) ; + + pref := lxy[ppos] ; + + if nxy[tpos] > nxy[fpos] : + if nxy[fpos] = nxy[mpos] : + % first of multiple pages + llxy[tpos] := llxy[mpos] ; + lrxy[tpos] := lrxy[mpos] ; + urxy[tpos] := lrxy[mpos] shifted (0,par_line_height) ; + ulxy[tpos] := llxy[mpos] shifted (0,par_line_height) ; + boxgriddirection := down ; + elseif nxy[tpos] = nxy[mpos] : + % last of multiple pages + llxy[fpos] := ulxy[mpos] shifted (0,-par_line_height) ; + lrxy[fpos] := urxy[mpos] shifted (0,-par_line_height) ; + urxy[fpos] := urxy[mpos] ; + ulxy[fpos] := ulxy[mpos] ; + boxgriddirection := up ; + else : + % middle of multiple pages + llxy[fpos] := ulxy[mpos] shifted (0,-par_line_height) ; + lrxy[fpos] := urxy[mpos] shifted (0,-par_line_height) ; + urxy[fpos] := urxy[mpos] ; + ulxy[fpos] := ulxy[mpos] ; + llxy[tpos] := llxy[mpos] ; + lrxy[tpos] := lrxy[mpos] ; + urxy[tpos] := lrxy[mpos] shifted (0,par_line_height) ; + ulxy[tpos] := llxy[mpos] shifted (0,par_line_height) ; + boxgriddirection := up ; fi ; - else : - % just one page - boxgriddirection := up ; - fi ; + else : + % just one page + boxgriddirection := up ; + fi ; - path txy, bxy, pxy, mxy ; + path txy, bxy, pxy, mxy ; - txy := originpath ; % top - bxy := originpath ; % bottom + txy := originpath ; % top + bxy := originpath ; % bottom pxy := originpath ; % composed - boolean lefthang, righthang, somehang ; + boolean lefthang, righthang, somehang ; - % we only hang on the first of a multiple page background + % we only hang on the first of a multiple page background - if nxy[mpos] > nxy[fpos] : - lefthang := righthang := somehang := false ; - else : - lefthang := (rh>0) ; righthang := (rh<0) ; somehang := false ; - fi ; + if nxy[mpos] > nxy[fpos] : + lefthang := righthang := somehang := false ; + else : + lefthang := (rh>0) ; righthang := (rh<0) ; somehang := false ; + fi ; if lefthang : - mxy := boundingbox (lref -- lref shifted (rh,ra*par_line_height)) ; - elseif righthang : - mxy := boundingbox (rref -- rref shifted (rh,ra*par_line_height)) ; + mxy := boundingbox (lref -- lref shifted (rh,ra*par_line_height)) ; + elseif righthang : + mxy := boundingbox (rref -- rref shifted (rh,ra*par_line_height)) ; else : - mxy := originpath ; + mxy := originpath ; fi ; - if round(ypart llxy[fpos]) = round(ypart llxy[tpos]) : + if round(ypart llxy[fpos]) = round(ypart llxy[tpos]) : % We have a one-liner. Watch how er use the bottom pos for % determining the height. - llxy[fpos] := (xpart llxy[fpos], ypart llxy[tpos]) ; - ulxy[fpos] := (xpart ulxy[fpos], ypart ulxy[tpos]) ; + llxy[fpos] := (xpart llxy[fpos], ypart llxy[tpos]) ; + ulxy[fpos] := (xpart ulxy[fpos], ypart ulxy[tpos]) ; - else : + else : - % We have a multi-liner. For convenience we now correct the - % begin and end points for indentation. + % We have a multi-liner. For convenience we now correct the + % begin and end points for indentation. - if lefthang and (round(ypart llxy[tpos]) >= round(ypart lrcorner mxy)) : + if lefthang and (round(ypart llxy[tpos]) >= round(ypart lrcorner mxy)) : llxy[tpos] := (xpart lhref, ypart llxy[tpos]) ; ulxy[tpos] := (xpart lhref, ypart ulxy[tpos]) ; else : @@ -240,26 +240,26 @@ def do_initialize_par (expr fpos, tpos, mpos, ppos, rw,rl,rr,rh,ra,ri) = urxy[fpos] := (xpart rhref, ypart urxy[fpos]) ; else : lrxy[fpos] := (xpart rref, ypart lrxy[fpos]) ; - urxy[fpos] := (xpart rref, ypart urxy[fpos]) ; + urxy[fpos] := (xpart rref, ypart urxy[fpos]) ; fi ; - fi ; + fi ; - somehang := (ypart ulxy[fpos]>ypart llcorner mxy) and + somehang := (ypart ulxy[fpos]>ypart llcorner mxy) and (ypart llxy[tpos]0 : @@ -439,28 +439,28 @@ def prepare_multi_pars (expr fn,fx,fy,fw,fh,fd, numeric multiref, multirefs[] ; numeric multiloc, multilocs[] ; % 1=begin 2=between 3=end - numeric multi_par_pages ; multi_par_pages := nxy[tpos]-nxy[fpos]+1 ; + numeric multi_par_pages ; multi_par_pages := nxy[tpos]-nxy[fpos]+1 ; ii := 0 ; nn := NOfTextAreas+1 ; nofmultipars := 0 ; vardef snapped_multi_pos (expr p) = if snap_multi_par_tops : if abs(ypart p - ypart ulcorner multipar) < par_line_height : - (xpart p,ypart ulcorner multipar) - else : - p - fi + (xpart p,ypart ulcorner multipar) + else : + p + fi else : - p - fi - enddef ; + p + fi + enddef ; % def set_multipar (expr i) = % ((TextAreas[i] leftenlarged -left_skip) rightenlarged -right_skip) % enddef ; vardef set_multipar (expr i) = - ( (TextAreas[i] leftenlarged -left_skip) rightenlarged (-right_skip + ( (TextAreas[i] leftenlarged -left_skip) rightenlarged (-right_skip if auto_multi_par_hsize : + rw - bbwidth(TextAreas[i]) fi) ) enddef ; @@ -518,7 +518,7 @@ def prepare_multi_pars (expr fn,fx,fy,fw,fh,fd, 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 _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)) ; if same_area : @@ -660,11 +660,7 @@ fi ; vardef x_left_bottom_hang (expr i, t) = pair _ll_, _sa_, _pa_ ; -if t : - _sa_ := llxy[tpos] ; -else : - _sa_ := llcorner multipar ; -fi ; + _sa_ := if t : llxy[tpos] else : llcorner multipar fi ; if (par_hang_indent>0) and (ra>0) : par_hang_after := max(0,ra - estimated_multi_par_height(i,t)) ; _ll_ := ulcorner multipar ; @@ -684,11 +680,7 @@ fi ; vardef x_right_bottom_hang (expr i, t) = pair _lr_, _sa_, _pa_ ; -if t : - _sa_ := snapped_multi_pos(ulxy[tpos]) ; -else : - _sa_ := llcorner multipar ; -fi ; + _sa_ := if t : snapped_multi_pos(ulxy[tpos]) else : llcorner multipar fi ; if (par_hang_indent<0) and (ra>0) : par_hang_after := max(0,ra - estimated_multi_par_height(i, t)) ; _lr_ := urcorner multipar ; @@ -707,36 +699,37 @@ fi ; enddef ; def test_multipar = - multipar := - llcorner multipar -- - urcorner multipar -- - lrcorner multipar -- - ulcorner multipar -- - cycle ; +% multipar := +% llcorner multipar -- +% urcorner multipar -- +% lrcorner multipar -- +% ulcorner multipar -- +% cycle ; + multipar := boundingbox multipar ; enddef ; - % first loop + % first loop + + if enable_multi_par_fallback and + (nxy[fpos]=RealPageNumber) and + (nxy[tpos]=RealPageNumber) and not + (InsideSomeTextArea(lxy[fpos]) and + InsideSomeTextArea(rxy[tpos])) : - if enable_multi_par_fallback and - (nxy[fpos]=RealPageNumber) and - (nxy[tpos]=RealPageNumber) and not - (InsideSomeTextArea(lxy[fpos]) and - InsideSomeTextArea(rxy[tpos])) : + % fallback - % fallback + multipar := - multipar := - - llxy[fpos] -- - lrxy[tpos] -- - urxy[tpos] -- + llxy[fpos] -- + lrxy[tpos] -- + urxy[tpos] -- ulxy[fpos] -- cycle ; - + save_multipar (1,1,multipar) ; else : - % normal + % normal for i=1 upto NOfTextAreas : @@ -779,23 +772,23 @@ fi ; llxy[fpos] -- lrxy[tpos] -- %urxy[tpos] -- - snapped_multi_pos(urxy[tpos]) -- + snapped_multi_pos(urxy[tpos]) -- %ulxy[fpos] -- - snapped_multi_pos(ulxy[fpos]) -- + snapped_multi_pos(ulxy[fpos]) -- cycle ; save_multipar (i,1,multipar) ; - elseif (ypart llxy[fpos] = ypart ulxy[tpos]) and + elseif (ypart llxy[fpos] = ypart ulxy[tpos]) and (xpart llxy[tpos] < xpart llxy[fpos]) : - % two loners + % two loners multipar := if obey_multi_par_hang : right_bottom_hang(true) -- right_top_hang(true) -- - snapped_multi_pos(urxy[fpos]) -- + snapped_multi_pos(urxy[fpos]) -- lrxy[fpos] -- else : @@ -803,7 +796,7 @@ fi ; llxy[fpos] -- (xpart urcorner multipar, ypart llxy[fpos]) -- (xpart urcorner multipar, ypart ulxy[fpos]) -- - snapped_multi_pos(ulxy[fpos]) -- + snapped_multi_pos(ulxy[fpos]) -- fi cycle ; @@ -815,14 +808,14 @@ fi ; left_bottom_hang(true) -- llxy[tpos] -- - snapped_multi_pos(ulxy[tpos]) -- + snapped_multi_pos(ulxy[tpos]) -- left_top_hang(true) -- else : (xpart llcorner multipar, ypart llxy[tpos]) -- llxy[tpos] -- - snapped_multi_pos(ulxy[tpos]) -- + snapped_multi_pos(ulxy[tpos]) -- (xpart llcorner multipar, ypart ulxy[tpos]) -- fi cycle ; @@ -836,11 +829,11 @@ fi ; left_bottom_hang(true) -- llxy[tpos] -- %ulxy[tpos] -- - snapped_multi_pos(ulxy[tpos]) -- + snapped_multi_pos(ulxy[tpos]) -- right_bottom_hang(true) -- right_top_hang(true) -- %urxy[fpos] -- - snapped_multi_pos(urxy[fpos]) -- + snapped_multi_pos(urxy[fpos]) -- lrxy[fpos] -- left_top_hang(true) -- @@ -848,19 +841,19 @@ fi ; (xpart llcorner multipar, ypart llxy[tpos]) -- llxy[tpos] -- - %ulxy[tpos] -- - snapped_multi_pos(ulxy[tpos]) -- + %ulxy[tpos] -- + snapped_multi_pos(ulxy[tpos]) -- (xpart lrcorner multipar, ypart ulxy[tpos]) -- (xpart urcorner multipar, ypart urxy[fpos]) -- %urxy[fpos] -- - snapped_multi_pos(urxy[fpos]) -- + snapped_multi_pos(urxy[fpos]) -- lrxy[fpos] -- (xpart ulcorner multipar, ypart lrxy[fpos]) -- fi cycle ; save_multipar (i,1,multipar) ; - + fi ; else : @@ -871,7 +864,7 @@ fi ; right_bottom_hang(false) -- right_top_hang(false) -- %urxy[fpos] -- - snapped_multi_pos(urxy[fpos]) -- + snapped_multi_pos(urxy[fpos]) -- lrxy[fpos] -- left_top_hang(false) -- @@ -881,7 +874,7 @@ fi ; lrcorner multipar -- (xpart urcorner multipar, ypart urxy[fpos]) -- %urxy[fpos] -- - snapped_multi_pos(urxy[fpos]) -- + snapped_multi_pos(urxy[fpos]) -- lrxy[fpos] -- (xpart ulcorner multipar, ypart lrxy[fpos]) -- @@ -904,7 +897,7 @@ fi ; x_right_top_hang(i,true) -- x_right_bottom_hang(i,true) -- % ulxy[tpos] -- -snapped_multi_pos(ulxy[tpos]) -- +snapped_multi_pos(ulxy[tpos]) -- llxy[tpos] -- x_left_bottom_hang(i,true) -- cycle ; @@ -916,7 +909,7 @@ snapped_multi_pos(ulxy[tpos]) -- urcorner multipar -- (xpart lrcorner multipar, ypart urxy[tpos]) -- % ulxy[tpos] -- -snapped_multi_pos(ulxy[tpos]) -- +snapped_multi_pos(ulxy[tpos]) -- llxy[tpos] -- (xpart llcorner multipar, ypart llxy[tpos]) -- cycle ; @@ -925,15 +918,15 @@ snapped_multi_pos(ulxy[tpos]) -- save_multipar (i,3,multipar) ; - else : + else : + + % handled later - % handled later - fi ; endfor ; - % second loop + % second loop for i=ii+1 upto nn-1 : @@ -956,19 +949,19 @@ snapped_multi_pos(ulxy[tpos]) -- save_multipar(i,2,multipar) ; -%fi ; +%fi ; endfor ; - % end of normal/fallback + % end of normal/fallback -fi ; +fi ; if span_multi_column_pars : endgroup ; fi ; - % quick hack for gb: + % quick hack for gb: one_piece_multi_par := (nofmultipars=1) and (pn=tn) ; @@ -983,8 +976,8 @@ numeric boxfilltype ; boxfilltype := 1 ; pair boxgriddirection ; boxgriddirection := up ; numeric boxgridwidth ; boxgridwidth := 1pt ; numeric boxlinewidth ; boxlinewidth := 1pt ; -numeric boxlineradius ; boxlineradius := 0pt ; -numeric boxfilloffset ; boxfilloffset := 0pt ; +numeric boxlineradius ; boxlineradius := 0pt ; +numeric boxfilloffset ; boxfilloffset := 0pt ; numeric boxgriddistance ; boxgriddistance := .5cm ; def draw_box = @@ -992,19 +985,19 @@ def draw_box = draw lxy -- rxy withcolor boxlinecolor withpen pencircle scaled boxgridwidth ; enddef ; -def draw_par = % 1 2 3 11 12 +def draw_par = % 1 2 3 11 12 do_draw_par(pxy) ; do_draw_par(txy) ; do_draw_par(bxy) ; for i = pxy, txy, bxy : if boxgridtype= 1 : - boxgriddirection := origin ; + boxgriddirection := origin ; draw baseline_grid (i,boxgriddirection,true ) withcolor boxgridcolor ; elseif boxgridtype= 2 : - boxgriddirection := origin ; + boxgriddirection := origin ; draw baseline_grid (i,boxgriddirection,false) withcolor boxgridcolor ; elseif boxgridtype= 3 : - boxgriddirection := origin ; + boxgriddirection := origin ; draw baseline_grid (i,boxgriddirection,true ) withcolor boxgridcolor ; - draw baseline_grid (i,boxgriddirection,true ) + draw baseline_grid (i,boxgriddirection,true ) shifted (0,ExHeight) withcolor boxgridcolor ; elseif boxgridtype=11 : draw graphic_grid(i,boxgriddistance,boxgriddistance,boxgriddistance/2,boxgriddistance/2) ; @@ -1016,50 +1009,50 @@ enddef ; def do_show_par (expr p, r, c) = if length(p) > 2 : for i=0 upto length(p) : - draw fullcircle scaled r shifted point i of p + draw fullcircle scaled r shifted point i of p withpen pencircle scaled .5pt withcolor c ; endfor ; fi ; draw p withpen pencircle scaled .5pt withcolor c ; -enddef ; +enddef ; def show_par = - if length(mxy) > 2 : - draw mxy dashed evenly - withpen pencircle scaled .5pt withcolor .5white ; - fi ; + if length(mxy) > 2 : + draw mxy dashed evenly + withpen pencircle scaled .5pt withcolor .5white ; + fi ; do_show_par(txy, 4pt, .5green) ; do_show_par(bxy, 6pt, .5blue ) ; do_show_par(pxy, 8pt, .5red ) ; - draw pref withpen pencircle scaled 2pt ; + draw pref withpen pencircle scaled 2pt ; enddef ; -def sort_multi_pars = +def sort_multi_pars = if nofmultipars>1 : - begingroup ; save _p_, _n_ ; path _p_ ; numeric _n_ ; - for i := 1 upto nofmultipars : - if multilocs[i] = 3 : + begingroup ; save _p_, _n_ ; path _p_ ; numeric _n_ ; + for i := 1 upto nofmultipars : + if multilocs[i] = 3 : _p_ := multipars[nofmultipars] ; - multipars[nofmultipars] := multipars[i] ; - multipars[i] := _p_ ; + multipars[nofmultipars] := multipars[i] ; + multipars[i] := _p_ ; _n_ := multirefs[nofmultipars] ; - multirefs[nofmultipars] := multirefs[i] ; - multirefs[i] := _n_ ; + multirefs[nofmultipars] := multirefs[i] ; + multirefs[i] := _n_ ; _n_ := multilocs[nofmultipars] ; - multilocs[nofmultipars] := multilocs[i] ; - multilocs[i] := _n_ ; - fi ; + multilocs[nofmultipars] := multilocs[i] ; + multilocs[i] := _n_ ; + fi ; endfor ; - endgroup ; - fi ; -enddef ; + endgroup ; + fi ; +enddef ; -% This collapses successive areas (possibly interrupted by -% floats. First we need to sort the areas, since they are -% normally in de order start, end, inbetween. +% This collapses successive areas (possibly interrupted by +% floats. First we need to sort the areas, since they are +% normally in de order start, end, inbetween. -def collapse_multi_pars = +def collapse_multi_pars = if nofmultipars>1 : - begingroup ; save _nofmultipars_ ; numeric _nofmultipars_ ; + begingroup ; save _nofmultipars_ ; numeric _nofmultipars_ ; _nofmultipars_ := 1 ; sort_multi_pars ; % block not in order: 1, 3, 2.... for i:=1 upto nofmultipars-1 : @@ -1068,9 +1061,9 @@ def collapse_multi_pars = multilocs[_nofmultipars_] := multilocs[i+1] ; multirefs[_nofmultipars_] := multirefs[i+1] ; multipars[_nofmultipars_] := - ulcorner multipars[_nofmultipars_] -- - urcorner multipars[_nofmultipars_] -- - lrcorner multipars[i+1] -- + ulcorner multipars[_nofmultipars_] -- + urcorner multipars[_nofmultipars_] -- + lrcorner multipars[i+1] -- llcorner multipars[i+1] -- cycle ; else : _nofmultipars_ := _nofmultipars_ + 1 ; @@ -1080,83 +1073,83 @@ multirefs[_nofmultipars_] := multirefs[i+1] ; fi ; endfor ; nofmultipars := _nofmultipars_ ; - endgroup ; - fi ; + endgroup ; + fi ; enddef ; -def draw_multi_pars = - for i=1 upto nofmultipars : - do_draw_par(multipars[i]) ; +def draw_multi_pars = + for i=1 upto nofmultipars : + do_draw_par(multipars[i]) ; if boxgridtype= 1 : draw baseline_grid (multipars[i],up,true ) withcolor boxgridcolor ; elseif boxgridtype= 2 : draw baseline_grid (multipars[i],up,false) withcolor boxgridcolor ; elseif boxgridtype= 3 : draw baseline_grid (multipars[i],up,true ) withcolor boxgridcolor ; - draw baseline_grid (multipars[i],up,true ) + draw baseline_grid (multipars[i],up,true ) shifted (0,ExHeight) withcolor boxgridcolor ; elseif boxgridtype=11 : draw graphic_grid(multipars[i],boxgriddistance,boxgriddistance,boxgriddistance/2,boxgriddistance/2) ; elseif boxgridtype=12 : draw graphic_grid(multipars[i],boxgriddistance,boxgriddistance,0,0) ; fi ; - endfor ; -enddef ; + endfor ; +enddef ; -def show_multi_pars = - for i=1 upto nofmultipars : +def show_multi_pars = + for i=1 upto nofmultipars : do_show_par(multipars[i], 6pt, .5blue) ; - endfor ; -enddef ; + endfor ; +enddef ; vardef do_draw_par (expr p) = if (length p>2) and (bbwidth(p)>1) and (bbheight(p)>1) : - save pp ; path pp ; - if (boxlineradius>0) and (boxlinetype=2) : - pp := p cornered boxlineradius ; - else : - pp := p ; - fi ; + save pp ; path pp ; + if (boxlineradius>0) and (boxlinetype=2) : + pp := p cornered boxlineradius ; + else : + pp := p ; + fi ; if boxfilltype>0 : if boxfilloffset>0 : % temporary hack - begingroup ; interim linejoin := mitered ; + begingroup ; interim linejoin := mitered ; filldraw pp withcolor boxfillcolor withpen pencircle scaled (2*boxfilloffset) ; - endgroup ; -else : - fill pp withcolor boxfillcolor ; -fi ; + endgroup ; +else : + fill pp withcolor boxfillcolor ; +fi ; fi ; if boxlinetype>0 : - draw pp withcolor boxlinecolor withpen pencircle scaled boxlinewidth ; - fi ; + draw pp withcolor boxlinecolor withpen pencircle scaled boxlinewidth ; + fi ; fi ; enddef ; vardef baseline_grid (expr pxy, pdir, at_baseline) = if (par_line_height>0) and (bbheight(pxy)>1) and (bbwidth(pxy)>1) and (boxgridwidth>0) : save i, grid ; picture grid ; pair start ; - def _do_ (expr start) = - draw start -- start shifted (bbwidth(pxy),0) - withpen pencircle scaled boxgridwidth + def _do_ (expr start) = + draw start -- start shifted (bbwidth(pxy),0) + withpen pencircle scaled boxgridwidth withcolor boxgridcolor ; - enddef ; + enddef ; grid := image ( %fails with inlinespace % if pdir=up : for i = if at_baseline : par_strut_depth else : 0 fi - step par_line_height + step par_line_height until max(bbheight(pxy),par_line_height) : _do_ (llcorner pxy shifted (0,+i)) ; endfor ; else : for i = if at_baseline : par_strut_height else : 0 fi - step par_line_height + step par_line_height until bbheight(pxy) : _do_ (ulcorner pxy shifted (0,-i)) ; endfor ; - fi ; + fi ; ) ; clip grid to pxy ; grid @@ -1170,12 +1163,12 @@ vardef graphic_grid (expr pxy, dx, dy, x, y) = save grid ; picture grid ; grid := image ( for i = xpart llcorner pxy step dx until xpart lrcorner pxy : - draw (i,ypart llcorner pxy) -- (i,ypart ulcorner pxy) - withpen pencircle scaled boxgridwidth ; + draw (i,ypart llcorner pxy) -- (i,ypart ulcorner pxy) + withpen pencircle scaled boxgridwidth ; endfor ; for i = ypart llcorner pxy step dy until ypart ulcorner pxy : - draw (xpart llcorner pxy,i) -- (xpart lrcorner pxy,i) - withpen pencircle scaled boxgridwidth ; + draw (xpart llcorner pxy,i) -- (xpart lrcorner pxy,i) + withpen pencircle scaled boxgridwidth ; endfor ) shifted (x,y) ; clip grid to pxy ; grid @@ -1192,4 +1185,165 @@ let draw_area = draw_box ; let anchor_area = anchor_box ; let anchor_par = anchor_box ; -endinput ; +% new and experimental and yet undocumented + +numeric sync_n[], sync_p[][], sync_w[][], sync_h[][], sync_d[][], sync_t[][] ; +pair sync_xy[][] ; color sync_c[][] ; + +def ResetSyncTasks = + path SyncPaths[] ; numeric SyncTasks[], NOfSyncPaths, CurrentSyncClass ; + NOfSyncPaths := CurrentSyncClass := 0 ; + if unknown SyncLeftOffset : numeric SyncLeftOffset ; SyncLeftOffset := 0 ; fi ; + if unknown SyncWidth : numeric SyncWidth ; SyncWidth := 0 ; fi ; + if unknown SyncThreshold : numeric SyncThreshold ; SyncThreshold := LineHeight ; fi ; + if unknown SyncColor : color SyncColor ; SyncColor := .5white ; fi ; + if (SyncLeftOffset = 0) and (SyncWidth = 0) : + SyncWidth := if known TextWidth : TextWidth else : -1cm fi ; + fi ; +enddef ; + +ResetSyncTasks ; + +vardef SyncBox(expr n, i, leftoffset, width, topoffset, bottomoffset) = + save o ; pair o ; o := (xpart llcorner PlainTextArea,ypart sync_xy[n][i]) ; + o shifted (leftoffset,sync_h[n][i]+topoffset) -- + o shifted (width+leftoffset,sync_h[n][i]+topoffset) -- + o shifted (width+leftoffset,bottomoffset) -- + o shifted (leftoffset,bottomoffset) -- cycle +enddef ; + +def SetSyncColor(expr n, i, c) = + sync_c[n][i] := c ; +enddef ; + +def SetSyncThreshold(expr n, i, th) = + sync_th[n][i] := th ; +enddef ; + +vardef TheSyncColor(expr n, i) = + if known sync_c[n][i] : sync_c[n][i] else : SyncColor fi +enddef ; + +vardef TheSyncThreshold(expr n, i) = + if known sync_th[n][i] : sync_th[n][i] else : SyncThreshold fi +enddef ; + +vardef PrepareSyncTasks(expr n, collapse, extendtop, prestartnext) = + ResetSyncTasks ; + if known sync_n[n] : + CurrentSyncClass := n ; + save ok, l, d ; boolean ok ; ok := false ; NOfSyncPaths := l := 0 ; + for i=1 upto sync_n[n] : + if RealPageNumber > sync_p[n][i] : + l := i ; + elseif RealPageNumber = sync_p[n][i] : + NOfSyncPaths := NOfSyncPaths + 1 ; + if not ok : + if i>1 : + if sync_t[n][i-1] = sync_t[n][i] : + SyncPaths[NOfSyncPaths] := SyncBox(n, i, SyncLeftOffset, SyncWidth, PaperHeight, -PaperHeight) ; + SyncTasks[NOfSyncPaths] := i ; + else : + SyncPaths[NOfSyncPaths] := SyncBox(n, i-1, SyncLeftOffset, SyncWidth, PaperHeight, -PaperHeight) ; + SyncTasks[NOfSyncPaths] := i-1 ; + NOfSyncPaths := NOfSyncPaths + 1 ; + SyncPaths[NOfSyncPaths] := SyncBox(n, i, SyncLeftOffset, SyncWidth, 0, -PaperHeight) ; + SyncTasks[NOfSyncPaths] := i ; + fi ; + else : + SyncPaths[NOfSyncPaths] := SyncBox(n, i, SyncLeftOffset, SyncWidth, 0, -PaperHeight) ; + SyncTasks[NOfSyncPaths] := i ; + fi ; + else : + SyncPaths[NOfSyncPaths] := SyncBox(n, i, SyncLeftOffset, SyncWidth, 0, -PaperHeight) ; + SyncTasks[NOfSyncPaths] := i ; + fi ; + ok := true ; + fi ; + endfor ; + if (NOfSyncPaths = 0) and (l > 0) : + NOfSyncPaths := 1 ; + SyncPaths[NOfSyncPaths] := SyncBox(n, l, SyncLeftOffset, SyncWidth, PaperHeight, -PaperHeight) ; + SyncTasks[NOfSyncPaths] := l ; + fi ; + if NOfSyncPaths > 0 : + for i = 1 upto NOfSyncPaths-1 : + SyncPaths[i] := topboundary SyncPaths[i] -- reverse topboundary SyncPaths[i+1] -- cycle ; + endfor ; + if unknown SyncThresholdMethod : + numeric SyncThresholdMethod ; SyncThresholdMethod := 2 ; + fi ; + if extendtop : + if SyncThresholdMethod = 1 : + if NOfSyncPaths>1 : + d := ypart (ulcorner PlainTextArea - sync_xy[n][SyncTasks[2]]) ; + if (SyncTasks[2]>1) and (d > 0pt) and (d <= TheSyncThreshold(n,sync_t[n][SyncTasks[2]])) and (sync_p[n][SyncTasks[2]] = RealPageNumber) : + SyncPaths[2] := SyncPaths[2] topenlarged PaperHeight ; + fi ; + fi ; + else : + for i = 1 upto NOfSyncPaths : + d := ypart (ulcorner PlainTextArea - sync_xy[n][SyncTasks[i]]) ; + if (d > 0) and (d <= TheSyncThreshold(n,sync_t[n][SyncTasks[i]])) and (sync_p[n][SyncTasks[i]] = RealPageNumber) : + SyncPaths[i] := SyncPaths[i] topenlarged PaperHeight ; + fi ; + endfor ; + fi ; + fi ; + if prestartnext : + if NOfSyncPaths>1 : + if SyncTasks[NOfSyncPaths] < sync_n[n] : % there is a next one + d := ypart (ulcorner PlainTextArea - sync_xy[n][SyncTasks[NOfSyncPaths]+1]) ; + if (d > 0) and (d <= TheSyncThreshold(n, sync_t[n][SyncTasks[i]])) and (sync_p[n][SyncTasks[NOfSyncPaths]+1] = RealPageNumber+1) : + SyncPaths[NOfSyncPaths+1] := + (xpart ulcorner SyncPaths[NOfSyncPaths],ypart llcorner PlainTextArea) -- + (xpart urcorner SyncPaths[NOfSyncPaths],ypart llcorner PlainTextArea) -- + lrcorner SyncPaths[NOfSyncPaths] -- + llcorner SyncPaths[NOfSyncPaths] -- cycle ; + SyncTasks[NOfSyncPaths+1] := SyncTasks[NOfSyncPaths]+1 ; + NOfSyncPaths := NOfSyncPaths + 1 ; + fi ; + fi ; + fi ; + else : + if NOfSyncPaths>1 : + d := ypart (sync_xy[n][SyncTasks[NOfSyncPaths]] - llcorner PlainTextArea) ; + if (d < TheSyncThreshold(n, SyncTasks[NOfSyncPaths])) : + NOfSyncPaths := NOfSyncPaths - 1 ; + SyncPaths[NOfSyncPaths] := SyncPaths[NOfSyncPaths] bottomenlarged PaperHeight ; + fi ; + fi ; + fi ; + if (NOfSyncPaths>1) and collapse : + save j ; numeric j ; j := 1 ; + for i = 2 upto NOfSyncPaths : + if sync_t[n][SyncTasks[i]] = sync_t[n][SyncTasks[j]] : + SyncPaths[j] := boundingbox image (draw SyncPaths[i] ; draw SyncPaths[j] ; ) ; + SyncTasks[j] := SyncTasks[i] ; + else : + j := j + 1 ; + SyncPaths[j] := SyncPaths[i] ; + SyncTasks[j] := SyncTasks[i] ; + fi ; + endfor ; + NOfSyncPaths := j ; + fi ; + fi ; + fi ; +enddef ; + +def SyncTask(expr n) = + if known SyncTasks[n] : SyncTasks[n] else : 0 fi +enddef ; + +def FlushSyncTasks = + for i = 1 upto NOfSyncPaths : + ProcessSyncTask(SyncPaths[i], TheSyncColor(CurrentSyncClass,sync_t[CurrentSyncClass][SyncTasks[i]])) ; + endfor ; +enddef ; + +def ProcessSyncTask(expr p, c) = + fill p withcolor c ; +enddef ; + +endinput ; \ No newline at end of file diff --git a/metapost/context/base/mp-page.mp b/metapost/context/base/mp-page.mp index af63b921b..e3750b55b 100644 --- a/metapost/context/base/mp-page.mp +++ b/metapost/context/base/mp-page.mp @@ -8,20 +8,20 @@ %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 This module is rather preliminary and subjected to -%D changes. +%D This module is rather preliminary and subjected to +%D changes. -if unknown context_tool : input mp-tool ; fi ; -if known context_page : endinput ; fi ; +if unknown context_tool : input mp-tool ; fi ; +if known context_page : endinput ; fi ; -boolean context_page ; context_page := true ; +boolean context_page ; context_page := true ; -if unknown PageStateAvailable : - boolean PageStateAvailable ; PageStateAvailable := false ; -fi ; +if unknown PageStateAvailable : + boolean PageStateAvailable ; PageStateAvailable := false ; +fi ; if unknown OnRightPage : boolean OnRightPage ; OnRightPage := true ; @@ -36,10 +36,10 @@ if unknown InPageBody : fi ; def SaveTextAreas = - path SavedTextAreas [] ; - path SavedTextColumns[] ; - numeric NOfSavedTextAreas ; - numeric NOfSavedTextColumns ; + path SavedTextAreas [] ; + path SavedTextColumns[] ; + numeric NOfSavedTextAreas ; + numeric NOfSavedTextColumns ; for i=1 upto NOfTextAreas : SavedTextAreas[i] := TextAreas[i] ; endfor ; @@ -50,177 +50,177 @@ def SaveTextAreas = NOfSavedTextColumns := NOfTextColumns ; enddef ; -def ResetTextAreas = - path TextAreas[], TextColumns[] ; - numeric NOfTextAreas ; NOfTextAreas := 0 ; - numeric NOfTextColumns ; NOfTextColumns := 0 ; +def ResetTextAreas = + path TextAreas[], TextColumns[] ; + numeric NOfTextAreas ; NOfTextAreas := 0 ; + numeric NOfTextColumns ; NOfTextColumns := 0 ; numeric nofmultipars ; nofmultipars := 0 ; - TextAreas[0] := TextColumns[0] := origin -- cycle ; -enddef ; + TextAreas[0] := TextColumns[0] := origin -- cycle ; +enddef ; -ResetTextAreas ; SaveTextAreas ; ; +ResetTextAreas ; SaveTextAreas ; ; -def RegisterTextArea (expr x, y, w, h, d) = - begingroup ; save p ; path p ; +def RegisterTextArea (expr x, y, w, h, d) = + begingroup ; save p ; path p ; p := unitsquare xyscaled(w,h+d) shifted (x,y-d) ; - if NOfTextAreas>0 : - % if needed, concatenate areas - if (round(llcorner TextAreas[NOfTextAreas]) = round(ulcorner p)) and - (round(lrcorner TextAreas[NOfTextAreas]) = round(urcorner p)) : + if NOfTextAreas>0 : + % if needed, concatenate areas + if (round(llcorner TextAreas[NOfTextAreas]) = round(ulcorner p)) and + (round(lrcorner TextAreas[NOfTextAreas]) = round(urcorner p)) : p := ulcorner TextAreas[NOfTextAreas] -- urcorner TextAreas[NOfTextAreas] -- lrcorner p -- llcorner p -- cycle ; - else : - NOfTextAreas := NOfTextAreas + 1 ; - fi ; - else : - NOfTextAreas := NOfTextAreas + 1 ; - fi ; + else : + NOfTextAreas := NOfTextAreas + 1 ; + fi ; + else : + NOfTextAreas := NOfTextAreas + 1 ; + fi ; TextAreas[NOfTextAreas] := p ; - if NOfTextColumns>0 : - if (round(xpart llcorner TextColumns[NOfTextColumns]) = round(xpart ulcorner p)) and - (round(xpart lrcorner TextColumns[NOfTextColumns]) = round(xpart urcorner p)) : + if NOfTextColumns>0 : + if (round(xpart llcorner TextColumns[NOfTextColumns]) = round(xpart ulcorner p)) and + (round(xpart lrcorner TextColumns[NOfTextColumns]) = round(xpart urcorner p)) : p := ulcorner TextColumns[NOfTextColumns] -- urcorner TextColumns[NOfTextColumns] -- lrcorner p -- llcorner p -- cycle ; - else : - NOfTextColumns := NOfTextColumns + 1 ; - fi ; - else : - NOfTextColumns := NOfTextColumns + 1 ; - fi ; + else : + NOfTextColumns := NOfTextColumns + 1 ; + fi ; + else : + NOfTextColumns := NOfTextColumns + 1 ; + fi ; TextColumns[NOfTextColumns] := p ; - endgroup ; -enddef ; + endgroup ; +enddef ; -%D We store a local area in slot zero. +%D We store a local area in slot zero. -def RegisterLocalTextArea (expr x, y, w, h, d) = +def RegisterLocalTextArea (expr x, y, w, h, d) = TextAreas[0] := TextColumns[0] := unitsquare xyscaled(w,h+d) shifted (x,y-d) ; -enddef ; +enddef ; def ResetLocalTextArea = - TextAreas[0] := TextColumns[0] := origin -- cycle ; -enddef ; + TextAreas[0] := TextColumns[0] := origin -- cycle ; +enddef ; ResetLocalTextArea ; -vardef InsideTextArea (expr _i_, _xy_) = - ( (round(xpart _xy_) >= round(xpart llcorner TextAreas[_i_])) and - (round(xpart _xy_) <= round(xpart lrcorner TextAreas[_i_])) and - (round(ypart _xy_) >= round(ypart llcorner TextAreas[_i_])) and +vardef InsideTextArea (expr _i_, _xy_) = + ( (round(xpart _xy_) >= round(xpart llcorner TextAreas[_i_])) and + (round(xpart _xy_) <= round(xpart lrcorner TextAreas[_i_])) and + (round(ypart _xy_) >= round(ypart llcorner TextAreas[_i_])) and (round(ypart _xy_) <= round(ypart urcorner TextAreas[_i_])) ) -enddef ; +enddef ; -vardef InsideSavedTextArea (expr _i_, _xy_) = - ( (round(xpart _xy_) >= round(xpart llcorner SavedTextAreas[_i_])) and - (round(xpart _xy_) <= round(xpart lrcorner SavedTextAreas[_i_])) and - (round(ypart _xy_) >= round(ypart llcorner SavedTextAreas[_i_])) and +vardef InsideSavedTextArea (expr _i_, _xy_) = + ( (round(xpart _xy_) >= round(xpart llcorner SavedTextAreas[_i_])) and + (round(xpart _xy_) <= round(xpart lrcorner SavedTextAreas[_i_])) and + (round(ypart _xy_) >= round(ypart llcorner SavedTextAreas[_i_])) and (round(ypart _xy_) <= round(ypart urcorner SavedTextAreas[_i_])) ) -enddef ; +enddef ; -vardef InsideSomeTextArea(expr _xy_) = - save ok ; boolean ok ; ok := false ; - for i := 1 upto NOfTextAreas : - if InsideTextArea(i,_xy_) : ok := true ; fi ; - exitif ok ; +vardef InsideSomeTextArea(expr _xy_) = + save ok ; boolean ok ; ok := false ; + for i := 1 upto NOfTextAreas : + if InsideTextArea(i,_xy_) : ok := true ; fi ; + exitif ok ; endfor ; - ok + ok enddef ; -vardef InsideSomeSavedTextArea(expr _xy_) = - save ok ; boolean ok ; ok := false ; - for i := 1 upto NOfSavedTextAreas : - if InsideSavedTextArea(i,_xy_) : ok := true ; fi ; - exitif ok ; +vardef InsideSomeSavedTextArea(expr _xy_) = + save ok ; boolean ok ; ok := false ; + for i := 1 upto NOfSavedTextAreas : + if InsideSavedTextArea(i,_xy_) : ok := true ; fi ; + exitif ok ; endfor ; - ok + ok enddef ; -vardef TextAreaX (expr x) = - numeric _TextAreaX_ ; _TextAreaX_ := 0 ; - for i := 1 upto NOfTextAreas : - if (round(x) >= round(xpart llcorner TextAreas[i])) and - (round(x) <= round(xpart lrcorner TextAreas[i])) : +vardef TextAreaX (expr x) = + numeric _TextAreaX_ ; _TextAreaX_ := 0 ; + for i := 1 upto NOfTextAreas : + if (round(x) >= round(xpart llcorner TextAreas[i])) and + (round(x) <= round(xpart lrcorner TextAreas[i])) : _TextAreaX_ := xpart llcorner TextAreas[i] ; fi ; endfor ; - _TextAreaX_ -enddef ; - -vardef TextAreaY (expr y) = - numeric _TextAreaY_ ; _TextAreaY_ := 0 ; - for i := 1 upto NOfTextAreas : - if (round(y) >= round(ypart llcorner TextAreas[NOfTextAreas])) and - (round(y) <= round(ypart ulcorner TextAreas[NOfTextAreas])) : + _TextAreaX_ +enddef ; + +vardef TextAreaY (expr y) = + numeric _TextAreaY_ ; _TextAreaY_ := 0 ; + for i := 1 upto NOfTextAreas : + if (round(y) >= round(ypart llcorner TextAreas[NOfTextAreas])) and + (round(y) <= round(ypart ulcorner TextAreas[NOfTextAreas])) : _TextAreaY_ := ypart llcorner TextAreas[NOfTextAreas] ; fi ; endfor ; - _TextAreaY_ -enddef ; - -vardef TextAreaXY (expr x, y) = - pair _TextAreaXY_ ; _TextAreaXY_ := origin ; - for i := 1 upto NOfTextAreas : - if (round(x) >= round(xpart llcorner TextAreas[i])) and - (round(x) <= round(xpart lrcorner TextAreas[i])) and - (round(y) >= round(ypart llcorner TextAreas[i])) and - (round(y) <= round(ypart ulcorner TextAreas[i])) : + _TextAreaY_ +enddef ; + +vardef TextAreaXY (expr x, y) = + pair _TextAreaXY_ ; _TextAreaXY_ := origin ; + for i := 1 upto NOfTextAreas : + if (round(x) >= round(xpart llcorner TextAreas[i])) and + (round(x) <= round(xpart lrcorner TextAreas[i])) and + (round(y) >= round(ypart llcorner TextAreas[i])) and + (round(y) <= round(ypart ulcorner TextAreas[i])) : _TextAreaXY_ := llconer TextAreas[i] ; fi ; endfor ; - _TextAreaXY_ -enddef ; - -vardef TextAreaW (expr x) = - numeric _TextAreaW_ ; _TextAreaW_ := 0 ; - for i := 1 upto NOfTextAreas : - if (round(x) >= round(xpart llcorner TextAreas[i])) and - (round(x) <= round(xpart lrcorner TextAreas[i])) : + _TextAreaXY_ +enddef ; + +vardef TextAreaW (expr x) = + numeric _TextAreaW_ ; _TextAreaW_ := 0 ; + for i := 1 upto NOfTextAreas : + if (round(x) >= round(xpart llcorner TextAreas[i])) and + (round(x) <= round(xpart lrcorner TextAreas[i])) : _TextAreaW_ := bbwidth(TextAreas[i]) ; fi ; endfor ; - _TextAreaW_ -enddef ; - -vardef TextAreaH (expr y) = - numeric _TextAreaH_ ; _TextAreaH_ := 0 ; - for i := 1 upto NOfTextAreas : - if (round(y) >= round(ypart llcorner TextAreas[i])) and - (round(y) <= round(ypart ulcorner TextAreas[i])) : + _TextAreaW_ +enddef ; + +vardef TextAreaH (expr y) = + numeric _TextAreaH_ ; _TextAreaH_ := 0 ; + for i := 1 upto NOfTextAreas : + if (round(y) >= round(ypart llcorner TextAreas[i])) and + (round(y) <= round(ypart ulcorner TextAreas[i])) : _TextAreaH_ := bbheight(TextAreas[i]) ; fi ; endfor ; - _TextAreaH_ -enddef ; - -vardef TextAreaWH (expr x, y) = - pair _TextAreaWH_ ; _TextAreaWH_ := origin ; - for i := 1 upto NOfTextAreas : - if (round(x) >= round(xpart llcorner TextAreas[i])) and - (round(x) <= round(xpart lrcorner TextAreas[i])) and - (round(y) >= round(ypart llcorner TextAreas[i])) and - (round(y) <= round(ypart ulcorner TextAreas[i])) : + _TextAreaH_ +enddef ; + +vardef TextAreaWH (expr x, y) = + pair _TextAreaWH_ ; _TextAreaWH_ := origin ; + for i := 1 upto NOfTextAreas : + if (round(x) >= round(xpart llcorner TextAreas[i])) and + (round(x) <= round(xpart lrcorner TextAreas[i])) and + (round(y) >= round(ypart llcorner TextAreas[i])) and + (round(y) <= round(ypart ulcorner TextAreas[i])) : _TextAreaWH_ := (bbwidth(TextAreas[i]),bbheight(TextAreas[i])) ; fi ; endfor ; - _TextAreaWH_ -enddef ; + _TextAreaWH_ +enddef ; -PageNumber := 0 ; +PageNumber := 0 ; PaperHeight := 845.04684pt ; PaperWidth := 597.50787pt ; PrintPaperHeight := 845.04684pt ; PrintPaperWidth := 597.50787pt ; TopSpace := 71.12546pt ; -BottomSpace := 0.0pt ; +BottomSpace := 0.0pt ; BackSpace := 71.13275pt ; CutSpace := 0.0pt ; -MakeupHeight := 711.3191pt ; +MakeupHeight := 711.3191pt ; MakeupWidth := 426.78743pt ; TopHeight := 0.0pt ; TopDistance := 0.0pt ; @@ -241,60 +241,60 @@ RightMarginWidth := 75.58197pt ; RightEdgeDistance := 0.0pt ; RightEdgeWidth := 0.0pt ; -PageOffset := 0.0pt ; -PageDepth := 0.0pt ; +PageOffset := 0.0pt ; +PageDepth := 0.0pt ; LayoutColumns := 0 ; -LayoutColumnDistance:= 0.0pt ; +LayoutColumnDistance:= 0.0pt ; LayoutColumnWidth := 0.0pt ; LeftEdge := -4 ; Top := -40 ; -LeftEdgeSeparator := -3 ; TopSeparator := -30 ; -LeftMargin := -2 ; Header := -20 ; -LeftMarginSeparator := -1 ; HeaderSeparator := -10 ; +LeftEdgeSeparator := -3 ; TopSeparator := -30 ; +LeftMargin := -2 ; Header := -20 ; +LeftMarginSeparator := -1 ; HeaderSeparator := -10 ; Text := 0 ; Text := 0 ; -RightMarginSeparator := +1 ; FooterSeparator := +10 ; -RightMargin := +2 ; Footer := +20 ; -RightEdgeSeparator := +3 ; BottomSeparator := +30 ; -RightEdge := +4 ; Bottom := +40 ; - -Margin := LeftMargin ; % obsolete -Edge := LeftEdge ; % obsolete -InnerMargin := RightMargin ; % obsolete -InnerEdge := RightEdge ; % obsolete -OuterMargin := LeftMargin ; % obsolete -OuterEdge := LeftEdge ; % obsolete - -InnerMarginWidth := 0pt ; -OuterMarginWidth := 0pt ; -InnerMarginDistance := 0pt ; -OuterMarginDistance := 0pt ; - -InnerEdgeWidth := 0pt ; -OuterEdgeWidth := 0pt ; -InnerEdgeDistance := 0pt ; -OuterEdgeDistance := 0pt ; - -path Area [][] ; pair Location [][] ; path Field [][] ; path Page ; -numeric HorPos ; numeric Hstep [] ; numeric Hsize [] ; -numeric VerPos ; numeric Vstep [] ; numeric Vsize [] ; - -for VerPos=Top step 10 until Bottom: - for HorPos=LeftEdge step 1 until RightEdge: - Area[HorPos][VerPos] := origin--cycle ; +RightMarginSeparator := +1 ; FooterSeparator := +10 ; +RightMargin := +2 ; Footer := +20 ; +RightEdgeSeparator := +3 ; BottomSeparator := +30 ; +RightEdge := +4 ; Bottom := +40 ; + +Margin := LeftMargin ; % obsolete +Edge := LeftEdge ; % obsolete +InnerMargin := RightMargin ; % obsolete +InnerEdge := RightEdge ; % obsolete +OuterMargin := LeftMargin ; % obsolete +OuterEdge := LeftEdge ; % obsolete + +InnerMarginWidth := 0pt ; +OuterMarginWidth := 0pt ; +InnerMarginDistance := 0pt ; +OuterMarginDistance := 0pt ; + +InnerEdgeWidth := 0pt ; +OuterEdgeWidth := 0pt ; +InnerEdgeDistance := 0pt ; +OuterEdgeDistance := 0pt ; + +path Area [][] ; pair Location [][] ; path Field [][] ; path Page ; +numeric HorPos ; numeric Hstep [] ; numeric Hsize [] ; +numeric VerPos ; numeric Vstep [] ; numeric Vsize [] ; + +for VerPos=Top step 10 until Bottom: + for HorPos=LeftEdge step 1 until RightEdge: + Area[HorPos][VerPos] := origin--cycle ; Area[VerPos][HorPos] := Area[HorPos][VerPos] ; - Location[HorPos][VerPos] := origin ; + Location[HorPos][VerPos] := origin ; Location[VerPos][HorPos] := Location[HorPos][VerPos] ; - Field[HorPos][VerPos] := origin--cycle ; + Field[HorPos][VerPos] := origin--cycle ; Field[VerPos][HorPos] := Field[HorPos][VerPos] ; - endfor ; -endfor ; + endfor ; +endfor ; -% def LoadPageState = +% def LoadPageState = % scantokens "input mp-state.tmp" ; -% enddef ; +% enddef ; -def SwapPageState = +def SwapPageState = if not OnRightPage : BackSpace := PaperWidth-MakeupWidth-BackSpace ; CutSpace := PaperWidth-MakeupWidth-CutSpace ; @@ -311,137 +311,137 @@ def SwapPageState = LeftEdgeDistance := RightEdgeDistance ; RightEdgeDistance := i ; -% these are now available as ..Width and ..Distance - - Margin := LeftMargin ; - Edge := LeftEdge ; - InnerMargin := RightMargin ; - InnerEdge := RightEdge ; - OuterMargin := LeftMargin ; - OuterEdge := LeftEdge ; - else : - Margin := RightMargin ; - Edge := RightEdge ; - InnerMargin := LeftMargin ; - InnerEdge := LeftEdge ; - OuterMargin := RightMargin ; - OuterEdge := RightEdge ; +% these are now available as ..Width and ..Distance + + Margin := LeftMargin ; + Edge := LeftEdge ; + InnerMargin := RightMargin ; + InnerEdge := RightEdge ; + OuterMargin := LeftMargin ; + OuterEdge := LeftEdge ; + else : + Margin := RightMargin ; + Edge := RightEdge ; + InnerMargin := LeftMargin ; + InnerEdge := LeftEdge ; + OuterMargin := RightMargin ; + OuterEdge := RightEdge ; fi ; -enddef ; +enddef ; -def SetPageAreas = +def SetPageAreas = numeric Vsize[], Hsize[], Vstep[], Hstep[] ; - Vsize[Top] = TopHeight ; - Vsize[TopSeparator] = TopDistance ; - Vsize[Header] = HeaderHeight ; - Vsize[HeaderSeparator] = HeaderDistance ; - Vsize[Text] = TextHeight ; - Vsize[FooterSeparator] = FooterDistance ; - Vsize[Footer] = FooterHeight ; - Vsize[BottomSeparator] = BottomDistance ; - Vsize[Bottom] = BottomHeight ; + Vsize[Top] = TopHeight ; + Vsize[TopSeparator] = TopDistance ; + Vsize[Header] = HeaderHeight ; + Vsize[HeaderSeparator] = HeaderDistance ; + Vsize[Text] = TextHeight ; + Vsize[FooterSeparator] = FooterDistance ; + Vsize[Footer] = FooterHeight ; + Vsize[BottomSeparator] = BottomDistance ; + Vsize[Bottom] = BottomHeight ; Vstep[Top] = Vstep[TopSeparator] +Vsize[TopSeparator] ; - Vstep[TopSeparator] = PaperHeight-TopSpace ; - Vstep[Header] = Vstep[TopSeparator] -Vsize[Header] ; - Vstep[HeaderSeparator] = Vstep[Header] -Vsize[HeaderSeparator] ; - Vstep[Text] = Vstep[HeaderSeparator]-Vsize[Text] ; - Vstep[FooterSeparator] = Vstep[Text] -Vsize[FooterSeparator] ; - Vstep[Footer] = Vstep[FooterSeparator]-Vsize[Footer] ; + Vstep[TopSeparator] = PaperHeight-TopSpace ; + Vstep[Header] = Vstep[TopSeparator] -Vsize[Header] ; + Vstep[HeaderSeparator] = Vstep[Header] -Vsize[HeaderSeparator] ; + Vstep[Text] = Vstep[HeaderSeparator]-Vsize[Text] ; + Vstep[FooterSeparator] = Vstep[Text] -Vsize[FooterSeparator] ; + Vstep[Footer] = Vstep[FooterSeparator]-Vsize[Footer] ; Vstep[BottomSeparator] = Vstep[Footer] -Vsize[BottomSeparator] ; - Vstep[Bottom] = Vstep[BottomSeparator]-Vsize[Bottom] ; + Vstep[Bottom] = Vstep[BottomSeparator]-Vsize[Bottom] ; Hsize[LeftEdge] = LeftEdgeWidth ; Hsize[LeftEdgeSeparator] = LeftEdgeDistance ; Hsize[LeftMargin] = LeftMarginWidth ; Hsize[LeftMarginSeparator] = LeftMarginDistance ; - Hsize[Text] = MakeupWidth ; - Hsize[RightMarginSeparator] = RightMarginDistance ; - Hsize[RightMargin] = RightMarginWidth ; + Hsize[Text] = MakeupWidth ; + Hsize[RightMarginSeparator] = RightMarginDistance ; + Hsize[RightMargin] = RightMarginWidth ; Hsize[RightEdgeSeparator] = RightEdgeDistance ; - Hsize[RightEdge] = RightEdgeWidth ; + Hsize[RightEdge] = RightEdgeWidth ; Hstep[LeftEdge] = Hstep[LeftEdgeSeparator] -Hsize[LeftEdge] ; Hstep[LeftEdgeSeparator] = Hstep[LeftMargin] -Hsize[LeftEdgeSeparator] ; Hstep[LeftMargin] = Hstep[LeftMarginSeparator] -Hsize[LeftMargin] ; Hstep[LeftMarginSeparator] = Hstep[Text] -Hsize[LeftMarginSeparator] ; - Hstep[Text] = BackSpace ; - Hstep[RightMarginSeparator] = Hstep[Text] +Hsize[Text] ; + Hstep[Text] = BackSpace ; + Hstep[RightMarginSeparator] = Hstep[Text] +Hsize[Text] ; Hstep[RightMargin] = Hstep[RightMarginSeparator]+Hsize[RightMarginSeparator] ; Hstep[RightEdgeSeparator] = Hstep[RightMargin] +Hsize[RightMargin] ; - Hstep[RightEdge] = Hstep[RightEdgeSeparator] +Hsize[RightEdgeSeparator] ; + Hstep[RightEdge] = Hstep[RightEdgeSeparator] +Hsize[RightEdgeSeparator] ; - for VerPos=Top step 10 until Bottom: - for HorPos=LeftEdge step 1 until RightEdge: - Area[HorPos][VerPos] := unitsquare xscaled Hsize[HorPos] yscaled Vsize[VerPos] ; + for VerPos=Top step 10 until Bottom: + for HorPos=LeftEdge step 1 until RightEdge: + Area[HorPos][VerPos] := unitsquare xscaled Hsize[HorPos] yscaled Vsize[VerPos] ; Area[VerPos][HorPos] := Area[HorPos][VerPos] ; - Location[HorPos][VerPos] := (Hstep[HorPos],Vstep[VerPos]) ; + Location[HorPos][VerPos] := (Hstep[HorPos],Vstep[VerPos]) ; Location[VerPos][HorPos] := Location[HorPos][VerPos] ; Field[HorPos][VerPos] := Area[HorPos][VerPos] shifted Location[HorPos][VerPos] ; Field[VerPos][HorPos] := Field[HorPos][VerPos] ; - endfor ; - endfor ; + endfor ; + endfor ; - Page := unitsquare xscaled PaperWidth yscaled PaperHeight ; + Page := unitsquare xscaled PaperWidth yscaled PaperHeight ; -enddef ; +enddef ; def BoundPageAreas = - % pickup pencircle scaled 0pt ; + % pickup pencircle scaled 0pt ; bboxmargin := 0 ; setbounds currentpicture to Page ; -enddef ; +enddef ; def StartPage = - if PageStateAvailable : - LoadPageState ; + if PageStateAvailable : + LoadPageState ; SwapPageState ; - fi ; - + fi ; + SetPageAreas ; BoundPageAreas ; -enddef ; +enddef ; def StopPage = BoundPageAreas ; -enddef ; +enddef ; + +def OverlayBox = + (unitsquare xyscaled (OverlayWidth,OverlayHeight)) +enddef ; -def OverlayBox = - (unitsquare xyscaled (OverlayWidth,OverlayHeight)) -enddef ; +% handy -% handy +def innerenlarged = + hide(LoadPageState) + if OnRightPage : leftenlarged else : rightenlarged fi +enddef ; -def innerenlarged = - hide(LoadPageState) - if OnRightPage : leftenlarged else : rightenlarged fi -enddef ; - -def outerenlarged = +def outerenlarged = hide(LoadPageState) - if OnRightPage : rightenlarged else : leftenlarged fi -enddef ; + if OnRightPage : rightenlarged else : leftenlarged fi +enddef ; % obsolete -def llEnlarged (expr p,d) = (llcorner p shifted (-d,-d)) enddef ; -def lrEnlarged (expr p,d) = (lrcorner p shifted (+d,-d)) enddef ; -def urEnlarged (expr p,d) = (urcorner p shifted (+d,+d)) enddef ; -def ulEnlarged (expr p,d) = (ulcorner p shifted (-d,+d)) enddef ; +def llEnlarged (expr p,d) = (llcorner p shifted (-d,-d)) enddef ; +def lrEnlarged (expr p,d) = (lrcorner p shifted (+d,-d)) enddef ; +def urEnlarged (expr p,d) = (urcorner p shifted (+d,+d)) enddef ; +def ulEnlarged (expr p,d) = (ulcorner p shifted (-d,+d)) enddef ; -def Enlarged (expr p, d) = +def Enlarged (expr p, d) = (llEnlarged (p,d) -- lrEnlarged (p,d) -- urEnlarged (p,d) -- - ulEnlarged (p,d) -- cycle) -enddef ; + ulEnlarged (p,d) -- cycle) +enddef ; -endinput ; +endinput ; \ No newline at end of file diff --git a/metapost/context/base/mp-spec.mp b/metapost/context/base/mp-spec.mp index 3563e982e..b005eb381 100644 --- a/metapost/context/base/mp-spec.mp +++ b/metapost/context/base/mp-spec.mp @@ -12,13 +12,13 @@ %C details. % Spot colors are not handled by mptopdf ! - + % (r,g,b) => cmyk : r=123 g= 1 b=hash -% => spot : r=123 g= 2 b=hash +% => spot : r=123 g= 2 b=hash % => transparent rgb : r=123 g= 3 b=hash % => transparent cmyk : r=123 g= 4 b=hash % => transparent spot : r=123 g= 5 b=hash -% => rest : r=123 g=n>10 b=whatever +% => rest : r=123 g=n>10 b=whatever %D This module is rather preliminary and subjected to %D changes. Here we closely cooperates with the \METAPOST\ @@ -32,7 +32,7 @@ if known context_spec : endinput ; fi ; boolean context_spec ; context_spec := true ; numeric _special_counter_ ; _special_counter_ := 0 ; -numeric _color_counter_ ; _color_counter_ := 11 ; % < 10 reserved +numeric _color_counter_ ; _color_counter_ := 11 ; % < 10 reserved numeric _special_signal_ ; _special_signal_ := 123 ; %D When set to \type {true}, shading will be supported. Some @@ -49,7 +49,7 @@ string _global_specials_ ; _global_specials_ := "" ; string _local_specials_ ; _local_specials_ := "" ; vardef add_special_signal = % write the version number - if (length _global_specials_>0) or (length _local_specials_ >0) : + if (length _global_specials_>0) or (length _local_specials_ >0) : special ("%%MetaPostSpecials: 1.0 " & decimal _special_signal_ ) ; fi ; enddef ; @@ -60,33 +60,33 @@ vardef add_extra_specials = enddef ; vardef reset_extra_specials = - % only local ones + % only local ones _local_specials_ := "" ; enddef ; boolean insidefigure ; insidefigure := false ; -% todo: alleen als special gebruikt flush +% todo: alleen als special gebruikt flush -extra_beginfig := - " insidefigure := true ; " & - " reset_extra_specials ; " & - extra_beginfig ; +extra_beginfig := + " insidefigure := true ; " & + " reset_extra_specials ; " & + extra_beginfig ; extra_endfig := " add_special_signal ; " & extra_endfig & " add_extra_specials ; " & - " reset_extra_specials ; " & + " reset_extra_specials ; " & " insidefigure := false ; " ; -def set_extra_special (expr s) = - if insidefigure : - _local_specials_ := _local_specials_ & s ; - else : - _global_specials_ := _global_specials_ & s ; - fi -enddef ; +def set_extra_special (expr s) = + if insidefigure : + _local_specials_ := _local_specials_ & s ; + else : + _global_specials_ := _global_specials_ & s ; + fi +enddef ; def flush_special (expr typ, siz, dat) = _special_counter_ := _special_counter_ + 1 ; @@ -99,7 +99,7 @@ def flush_special (expr typ, siz, dat) = & decimal typ & " " & decimal siz & " special" - & ditto & ");" ) ; + & ditto & ");" ) ; else : set_extra_special ( "special " @@ -115,12 +115,12 @@ enddef ; %D The next hack is needed in case you use a version of %D \METAPOST\ that does not provide you the means to configure -%D the buffer size. Patrick Gundlach suggested to use arrays -%D in this case. +%D the buffer size. Patrick Gundlach suggested to use arrays +%D in this case. -boolean bufferhack ; bufferhack := false ; % true ; +boolean bufferhack ; bufferhack := false ; % true ; -if bufferhack : +if bufferhack : string _global_specials_[] ; numeric _nof_global_specials_ ; string _local_specials_[] ; numeric _nof_local_specials_ ; @@ -128,17 +128,17 @@ if bufferhack : _nof_global_specials_ := _nof_local_specials_ := 0 ; vardef add_special_signal = % write the version number - if (_nof_global_specials_>0) or (_nof_local_specials_>0) : + if (_nof_global_specials_>0) or (_nof_local_specials_>0) : special ("%%MetaPostSpecials: 1.0 " & decimal _special_signal_ ) ; fi ; enddef ; - + vardef add_extra_specials = - for i=1 upto _nof_global_specials_ : - scantokens _global_specials_[i] ; + for i=1 upto _nof_global_specials_ : + scantokens _global_specials_[i] ; endfor; - for i=1 upto _nof_local_specials_ : - scantokens _local_specials_[i] ; + for i=1 upto _nof_local_specials_ : + scantokens _local_specials_[i] ; endfor; enddef ; @@ -146,27 +146,27 @@ if bufferhack : string _local_specials_[] ; _nof_local_specials_ := 0 ; enddef ; - def set_extra_special (expr s) = - if insidefigure : - _local_specials_[incr(_nof_local_specials_)] := s ; - else : + def set_extra_special (expr s) = + if insidefigure : + _local_specials_[incr(_nof_local_specials_)] := s ; + else : _global_specials_[incr(_nof_global_specials_)] := s ; - fi - enddef ; + fi + enddef ; -fi ; +fi ; -%D So far for this hack. +%D So far for this hack. %D Shade allocation. -newinternal shadefactor ; shadefactor := 1 ; +newinternal shadefactor ; shadefactor := 1 ; -pair shadeoffset ; shadeoffset := origin ; +pair shadeoffset ; shadeoffset := origin ; vardef define_linear_shade (expr a, b, ca, cb) = flush_special(30, 15, "0 1 " & decimal shadefactor & " " & - dddecimal ca & " " & ddecimal (a shifted shadeoffset) & " " & + dddecimal ca & " " & ddecimal (a shifted shadeoffset) & " " & dddecimal cb & " " & ddecimal (b shifted shadeoffset) ) ; _special_counter_ enddef ; @@ -188,32 +188,32 @@ boolean trace_shades ; trace_shades := false ; % else : a := llcorner p ; b := lrcorner p ; % fi ; -def set_linear_vector (suffix a,b)(expr p,n) = - if (n=1) : a := llcorner p ; +def set_linear_vector (suffix a,b)(expr p,n) = + if (n=1) : a := llcorner p ; b := urcorner p ; - elseif (n=2) : a := lrcorner p ; + elseif (n=2) : a := lrcorner p ; b := ulcorner p ; - elseif (n=3) : a := urcorner p ; + elseif (n=3) : a := urcorner p ; b := llcorner p ; - elseif (n=4) : a := ulcorner p ; + elseif (n=4) : a := ulcorner p ; b := lrcorner p ; - elseif (n=5) : a := .5[ulcorner p,llcorner p] ; - b := .5[urcorner p,lrcorner p] ; - elseif (n=6) : a := .5[llcorner p,lrcorner p] ; - b := .5[ulcorner p,urcorner p] ; - elseif (n=7) : a := .5[lrcorner p,urcorner p] ; - b := .5[llcorner p,ulcorner p] ; - elseif (n=8) : a := .5[urcorner p,ulcorner p] ; - b := .5[lrcorner p,llcorner p] ; - else : a := .5[ulcorner p,llcorner p] ; - b := .5[urcorner p,lrcorner p] ; + elseif (n=5) : a := .5[ulcorner p,llcorner p] ; + b := .5[urcorner p,lrcorner p] ; + elseif (n=6) : a := .5[llcorner p,lrcorner p] ; + b := .5[ulcorner p,urcorner p] ; + elseif (n=7) : a := .5[lrcorner p,urcorner p] ; + b := .5[llcorner p,ulcorner p] ; + elseif (n=8) : a := .5[urcorner p,ulcorner p] ; + b := .5[lrcorner p,llcorner p] ; + else : a := .5[ulcorner p,llcorner p] ; + b := .5[urcorner p,lrcorner p] ; fi ; -enddef ; +enddef ; def linear_shade (expr p, n, ca, cb) = begingroup ; save a, b, sh ; pair a, b ; - set_linear_vector(a,b)(p,n) ; + set_linear_vector(a,b)(p,n) ; fill p withshade define_linear_shade (a,b,ca,cb) ; if trace_shades : drawarrow a -- b withpen pencircle scaled 1pt ; @@ -223,26 +223,26 @@ enddef ; vardef predefined_linear_shade (expr p, n, ca, cb) = save a, b, sh ; pair a, b ; - set_linear_vector(a,b)(p,n) ; + set_linear_vector(a,b)(p,n) ; set_shade_vector(a,b)(p,n) ; - define_linear_shade (a,b,ca,cb) + define_linear_shade (a,b,ca,cb) enddef ; -def set_circular_vector (suffix ab, r)(expr p,n) = +def set_circular_vector (suffix ab, r)(expr p,n) = if (n=1) : ab := llcorner p ; elseif (n=2) : ab := lrcorner p ; elseif (n=3) : ab := urcorner p ; elseif (n=4) : ab := ulcorner p ; else : ab := center p ; r := .5r ; fi ; -enddef ; +enddef ; def circular_shade (expr p, n, ca, cb) = begingroup ; save ab, r ; pair ab ; numeric r ; r := (xpart lrcorner p - xpart llcorner p) ++ (ypart urcorner p - ypart lrcorner p) ; - set_circular_vector(ab,r)(p,n) ; + set_circular_vector(ab,r)(p,n) ; fill p withshade define_circular_shade(ab,ab,0,r,ca,cb) ; if trace_shades : drawarrow ab -- ab shifted (0,r) withpen pencircle scaled 1pt ; @@ -254,14 +254,14 @@ vardef predefined_circular_shade (expr p, n, ca, cb) = save ab, r ; pair ab ; numeric r ; r := (xpart lrcorner p - xpart llcorner p) ++ (ypart urcorner p - ypart lrcorner p) ; - set_circular_vector(ab,r)(p,n) ; - define_circular_shade(ab,ab,0,r,ca,cb) + set_circular_vector(ab,r)(p,n) ; + define_circular_shade(ab,ab,0,r,ca,cb) enddef ; %D Since a \type {fill p withshade s} syntax looks better %D than some macro, we implement a new primary. -primarydef p withshade sc = % == p withcolor shadecolor(sh) +primarydef p withshade sc = % == p withcolor shadecolor(sh) hide (_color_counter_ := _color_counter_ + 1) p withcolor (_special_signal_/1000,_color_counter_/1000,sc/1000) enddef ; @@ -287,7 +287,7 @@ def doexternalfigure (expr filename) text transformation = dddecimal (yypart t, xpart t, ypart t) & " " & filename) ; addto p contour unitsquare scaled 0 ; setbounds p to unitsquare transformed t ; - _color_counter_ := _color_counter_ + 1 ; + _color_counter_ := _color_counter_ + 1 ; draw p withcolor (_special_signal_/1000,_color_counter_/1000,_special_counter_/1000) ; %draw p withcolor (_special_signal_/1000,cef/1000,_special_counter_/1000) ; endgroup ; @@ -365,27 +365,27 @@ enddef ; resetcmykcolors ; boolean cmykcolors ; cmykcolors := false ; % true -string cmykcolorpattern[] ; % needed for transparancies +string cmykcolorpattern[] ; % needed for transparancies vardef cmyk(expr c,m,y,k) = if cmykcolors : - save ok ; boolean ok ; + save ok ; boolean ok ; if unknown cmykcolorhash[c][m][y][k] : - ok := false ; % not yet defined - elseif cmykcolorhash[c][m][y][k] = -1 : - ok := false ; % locally defined and undefined - else : - ok := true ; % globally already defined - fi ; - if not ok : + ok := false ; % not yet defined + elseif cmykcolorhash[c][m][y][k] = -1 : + ok := false ; % locally defined and undefined + else : + ok := true ; % globally already defined + fi ; + if not ok : save s ; string s ; s := dddecimal (c,m,y) & " " & decimal k ; _cmyk_counter_ := _cmyk_counter_ + 1 ; - cmykcolorpattern[_cmyk_counter_/1000] := s ; + cmykcolorpattern[_cmyk_counter_/1000] := s ; cmykcolorhash[c][m][y][k] := _cmyk_counter_ ; - flush_special(1, 7, decimal _cmyk_counter_ & " " & s) ; - _local_specials_ := _local_specials_ & - " cmykcolorhash[" & decimal c & "][" & decimal m & - "][" & decimal y & "][" & decimal k & "] := -1 ; " ; + flush_special(1, 7, decimal _cmyk_counter_ & " " & s) ; + _local_specials_ := _local_specials_ & + " cmykcolorhash[" & decimal c & "][" & decimal m & + "][" & decimal y & "][" & decimal k & "] := -1 ; " ; fi ; (_special_signal_/1000,1/1000,cmykcolorhash[c][m][y][k]/1000) else : @@ -393,11 +393,11 @@ vardef cmyk(expr c,m,y,k) = fi enddef ; -% newcolor truecyan, truemagenta, trueyellow ; +% newcolor truecyan, truemagenta, trueyellow ; % -% truecyan = cmyk (1,0,0,0) ; -% truemagenta = cmyk (0,1,0,0) ; -% trueyellow = cmyk (0,0,1,0) ; +% truecyan = cmyk (1,0,0,0) ; +% truemagenta = cmyk (0,1,0,0) ; +% trueyellow = cmyk (0,0,1,0) ; %D Spot colors @@ -412,32 +412,32 @@ enddef ; resetspotcolors ; boolean spotcolors ; spotcolors := false ; % true -string spotcolorpattern[] ; % needed for transparancies +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) ; + 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 : + 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 ; + 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;" ; + 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 : @@ -445,19 +445,19 @@ vardef spotcolor(expr p, s) = fi enddef ; -%D Transparency +%D Transparency -normaltransparent := 1 ; multiplytransparent := 2 ; -screentransparent := 3 ; overlaytransparent := 4 ; -softlighttransparent := 5 ; hardlighttransparent := 6 ; -colordodgetransparent := 7 ; colorburntransparent := 8 ; -darkentransparent := 9 ; lightentransparent := 10 ; -differencetransparent := 11 ; exclusiontransparent := 12 ; +normaltransparent := 1 ; multiplytransparent := 2 ; +screentransparent := 3 ; overlaytransparent := 4 ; +softlighttransparent := 5 ; hardlighttransparent := 6 ; +colordodgetransparent := 7 ; colorburntransparent := 8 ; +darkentransparent := 9 ; lightentransparent := 10 ; +differencetransparent := 11 ; exclusiontransparent := 12 ; -% nottransparent := 0 ; -% compatibletransparent := 99 ; +% nottransparent := 0 ; +% compatibletransparent := 99 ; -% fill fullcircle scaled 10cm withcolor transparant(.8,3,color) ; +% 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 ; @@ -480,32 +480,32 @@ vardef transparent(expr n, t, c) = 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] + 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 : + 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 : + else : flush_special(3, 7, s) ; fi ; scantokens(ss) := _special_counter_ ; - _local_specials_ := _local_specials_ & - "scantokens(" & ditto & ss & ditto & ") := -1 ;" ; - fi ; + _local_specials_ := _local_specials_ & + "scantokens(" & ditto & ss & ditto & ") := -1 ;" ; + fi ; % go ahead if is_spot : (_special_signal_/1000,5/1000,scantokens(ss)/1000) @@ -518,21 +518,21 @@ enddef ; %D This function returns true of false, dependent on transparency. -vardef is_transparent(text t) = - begingroup ; save transparent ; save _c_, _b_ ; +vardef is_transparent(text t) = + begingroup ; save transparent ; save _c_, _b_ ; vardef transparent(expr nn, tt, cc) = _b_ := true ; cc enddef ; - boolean _b_ ; _b_ := false ; - color _c_ ; _c_ := t ; _b_ - endgroup + boolean _b_ ; _b_ := false ; + color _c_ ; _c_ := t ; _b_ + endgroup enddef ; -%D This function returns the not transparent color. +%D This function returns the not transparent color. -vardef not_transparent(text t) = - begingroup ; save transparent ; +vardef not_transparent(text t) = + begingroup ; save transparent ; vardef transparent(expr nn, tt, cc) = cc enddef ; - t endgroup -enddef ; + t endgroup +enddef ; %D Basic position tracking: @@ -545,19 +545,19 @@ def register (expr label, width, height, offset) = endgroup ; enddef ; -%D We cannot scale cmyk colors directly since this spoils -%D the trigger signal (such colors are no real colors). +%D We cannot scale cmyk colors directly since this spoils +%D the trigger signal (such colors are no real colors). vardef scaledcmyk(expr c,m,y,k,sf) = - cmyk(sf*c,sf*m,sf*y,sf*k) + cmyk(sf*c,sf*m,sf*y,sf*k) enddef ; vardef scaledcmykasrgb(expr c,m,y,k,sf) = - (sf*(1-c-k,1-m-k,1-y-k)) + (sf*(1-c-k,1-m-k,1-y-k)) enddef ; vardef scaledrgbascmyk(expr c,m,y,k,sf) = - scaledcmyk(1-c,1-m,1-y,0,sf) + scaledcmyk(1-c,1-m,1-y,0,sf) enddef ; vardef scaledrgb(expr r,g,b,sf) = @@ -568,6 +568,6 @@ vardef scaledgray(expr s,sf) = (sf*(s,s,s)) enddef ; -% spotcolor is already scaled +% spotcolor is already scaled -endinput ; +endinput ; \ No newline at end of file diff --git a/metapost/context/base/mp-tool.mp b/metapost/context/base/mp-tool.mp index 9f2464e64..19160ba32 100644 --- a/metapost/context/base/mp-tool.mp +++ b/metapost/context/base/mp-tool.mp @@ -28,26 +28,26 @@ warningcheck := 0 ; %D Namespace handling: -% let exclamationmark = ! ; -% let questionmark = ? ; -% -% def unprotect = -% let ! = relax ; -% let ? = relax ; +% let exclamationmark = ! ; +% let questionmark = ? ; +% +% def unprotect = +% let ! = relax ; +% let ? = relax ; % enddef ; -% -% def protect = +% +% def protect = % let ! = exclamationmark ; -% let ? = questionmark ; -% enddef ; -% -% unprotect ; -% -% mp!some!module = 10 ; show mp!some!module ; show somemodule ; -% +% let ? = questionmark ; +% enddef ; +% +% unprotect ; +% +% mp!some!module = 10 ; show mp!some!module ; show somemodule ; +% % protect ; -%D A semicolor to be used in specials: ? ? ? +%D A semicolor to be used in specials: ? ? ? string semicolor ; semicolor := char 59 ; @@ -55,12 +55,12 @@ string semicolor ; semicolor := char 59 ; %D high resolution boundingbox to the \POSTSCRIPT\ file. This %D hack is due to John Hobby himself. -% When somehow the first one gets no HiRes, then make sure -% that the format matches the mem sizes in the config file. +% When somehow the first one gets no HiRes, then make sure +% that the format matches the mem sizes in the config file. -% eerste " " er uit +% eerste " " er uit -string space ; space = char 32 ; +string space ; space = char 32 ; vardef ddecimal primary p = decimal xpart p & " " & decimal ypart p @@ -99,43 +99,43 @@ enddef ; %D Because \METAPOST\ has a hard coded limit of 4~datafiles, %D we need some trickery when we have multiple files. -if unknown collapse_data : - boolean collapse_data ; collapse_data := false ; -fi ; +if unknown collapse_data : + boolean collapse_data ; collapse_data := false ; +fi ; -boolean savingdata ; savingdata := false ; +boolean savingdata ; savingdata := false ; def savedata expr txt = - if collapse_data : + if collapse_data : write if savingdata : txt else : - "\MPdata{" & decimal charcode & "}{" & txt & "}" - fi + "\MPdata{" & decimal charcode & "}{" & txt & "}" + fi & "%" to jobname & _data_suffix_ ; - else : + else : write txt to data_file ; - fi ; + fi ; enddef ; -def startsavingdata = - savingdata := true ; - if collapse_data : - write - "\MPdata{" & decimal charcode & "}{%" - to +def startsavingdata = + savingdata := true ; + if collapse_data : + write + "\MPdata{" & decimal charcode & "}{%" + to jobname & _data_suffix_ ; - fi ; + fi ; enddef ; -def stopsavingdata = - savingdata := false ; - if collapse_data : +def stopsavingdata = + savingdata := false ; + if collapse_data : write "}%" to jobname & _data_suffix_ ; - fi ; + fi ; enddef ; -%D Instead of a keystroke eating save and allocation -%D sequence, you can use the \citeer {new} alternatives to -%D save and allocate in one command. +%D Instead of a keystroke eating save and allocation +%D sequence, you can use the \citeer {new} alternatives to +%D save and allocate in one command. def newcolor text v = forsuffixes i=v : save i ; color i ; endfor ; enddef ; def newnumeric text v = forsuffixes i=v : save i ; numeric i ; endfor ; enddef ; @@ -188,11 +188,11 @@ def pop_boundingbox text p = enddef; vardef boundingbox primary p = - if (path p) or (picture p) : - llcorner p -- lrcorner p -- urcorner p -- ulcorner p - else : - origin - fi -- cycle + if (path p) or (picture p) : + llcorner p -- lrcorner p -- urcorner p -- ulcorner p + else : + origin + fi -- cycle enddef; vardef inner_boundingbox primary p = @@ -238,10 +238,10 @@ vardef acos primary x = (asin(-x)) enddef ; vardef atan primary x = (x-(x**3)/3+(x**5)/5-(x**7)/7) enddef ; vardef tand primary x = (sind(x)/cosd(x)) enddef ; -%D Here are Taco Hoekwater's alternatives (but -%D vardef'd and primaried). +%D Here are Taco Hoekwater's alternatives (but +%D vardef'd and primaried). -pi := 3.1415926 ; radian := 180/pi ; % 2pi*radian = 360 ; +pi := 3.1415926 ; radian := 180/pi ; % 2pi*radian = 360 ; vardef tand primary x = (sind(x)/cosd(x)) enddef ; vardef cotd primary x = (cosd(x)/sind(x)) enddef ; @@ -257,8 +257,8 @@ vardef acos primary x = angle((x,1+-+x)) enddef ; vardef invsin primary x = ((asin(x))/radian) enddef ; vardef invcos primary x = ((acos(x))/radian) enddef ; -vardef acosh primary x = ln(x+(x+-+1)) enddef ; -vardef asinh primary x = ln(x+(x++1)) enddef ; +vardef acosh primary x = ln(x+(x+-+1)) enddef ; +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 ; @@ -380,12 +380,12 @@ enddef; % natural_width := xpart urcorner currentpicture - xpart llcorner currentpicture; % currentpicture := currentpicture scaled (the_width/natural_width) ; % enddef; -% +% % def yscale_currentpicture(expr the_height ) = % natural_height := ypart urcorner currentpicture - ypart llcorner currentpicture; % currentpicture := currentpicture scaled (the_height/natural_height) ; % enddef; -% +% % def xyscale_currentpicture(expr the_width, the_height) = % natural_width := xpart urcorner currentpicture - xpart llcorner currentpicture; % natural_height := ypart urcorner currentpicture - ypart llcorner currentpicture; @@ -393,40 +393,40 @@ enddef; % xscaled (the_width/natural_width) % yscaled (the_height/natural_height) ; % enddef; -% +% % def scale_currentpicture(expr the_width, the_height) = % xscale_currentpicture(the_width) ; % yscale_currentpicture(the_height) ; % enddef; -% nog eens uitbreiden zodat path en pic worden afgehandeld. +% nog eens uitbreiden zodat path en pic worden afgehandeld. % natural_width := xpart urcorner currentpicture - xpart llcorner currentpicture; % currentpicture := currentpicture scaled (the_width/natural_width) ; -% TODO TODO TODO TODO, not yet ok +% TODO TODO TODO TODO, not yet ok primarydef p xsized w = - (p if (bbwidth (p)>0) and (w>0) : scaled (w/bbwidth (p)) fi) + (p if (bbwidth (p)>0) and (w>0) : scaled (w/bbwidth (p)) fi) enddef ; primarydef p ysized h = - (p if (bbheight(p)>0) and (h>0) : scaled (h/bbheight(p)) fi) + (p if (bbheight(p)>0) and (h>0) : scaled (h/bbheight(p)) fi) enddef ; primarydef p xysized s = - begingroup ; - save wh, w, h ; pair wh ; numeric w, h ; - wh := paired (s) ; w := bbwidth(p) ; h := bbheight(p) ; - (p if (w>0) and (h>0) : - if xpart wh > 0 : xscaled (xpart wh/w) fi - if ypart wh > 0 : yscaled (ypart wh/h) fi - fi) - endgroup + begingroup ; + save wh, w, h ; pair wh ; numeric w, h ; + wh := paired (s) ; w := bbwidth(p) ; h := bbheight(p) ; + (p if (w>0) and (h>0) : + if xpart wh > 0 : xscaled (xpart wh/w) fi + if ypart wh > 0 : yscaled (ypart wh/h) fi + fi) + endgroup enddef ; primarydef p sized wh = - (p xysized wh) + (p xysized wh) enddef ; def xscale_currentpicture(expr w) = @@ -485,20 +485,20 @@ fulldiamond := unitdiamond shifted - center unitdiamond ; %D More robust: -% let normalscaled = scaled ; -% let normalxscaled = xscaled ; -% let normalyscaled = yscaled ; -% -% def scaled expr s = normalscaled (s) enddef ; -% def xscaled expr s = normalxscaled (s) enddef ; -% def yscaled expr s = normalyscaled (s) enddef ; +% let normalscaled = scaled ; +% let normalxscaled = xscaled ; +% let normalyscaled = yscaled ; +% +% def scaled expr s = normalscaled (s) enddef ; +% def xscaled expr s = normalxscaled (s) enddef ; +% def yscaled expr s = normalyscaled (s) enddef ; %D Shorter primarydef p xyscaled q = - begingroup ; save qq ; pair qq ; qq = paired(q) ; - ( p - if xpart qq<>0 : xscaled (xpart qq) fi + begingroup ; save qq ; pair qq ; qq = paired(q) ; + ( p + if xpart qq<>0 : xscaled (xpart qq) fi if ypart qq<>0 : yscaled (ypart qq) fi ) endgroup enddef ; @@ -605,7 +605,7 @@ vardef roundedsquare (expr width, height, offset) = ((offset,0)--(width-offset,0){right} .. (width,offset)--(width,height-offset){up} .. (width-offset,height)--(offset,height){left} .. - (0,height-offset)--(0,offset){down} .. cycle) + (0,height-offset)--(0,offset){down} .. cycle) enddef ; %D Some colors. @@ -622,7 +622,7 @@ def drawfill text t = enddef; %D This two step approach saves the path first, since it can -%D be a function. Attributes must not be randomized. +%D be a function. Attributes must not be randomized. def drawfill expr c = path _c_ ; _c_ := c ; @@ -684,47 +684,56 @@ primarydef p ulmoved d = ((ulcorner p) shifted (-xpart paired(d),+ypart paired(d))) enddef ; -primarydef p leftenlarged d = - ((llcorner p) shifted (-d,0) -- lrcorner p -- +primarydef p leftenlarged d = + ((llcorner p) shifted (-d,0) -- lrcorner p -- urcorner p -- (ulcorner p) shifted (-d,0) -- cycle) -enddef ; +enddef ; + +primarydef p rightenlarged d = + (llcorner p -- (lrcorner p) shifted (d,0) -- + (urcorner p) shifted (d,0) -- ulcorner p -- cycle) +enddef ; -primarydef p rightenlarged d = - (llcorner p -- (lrcorner p) shifted (d,0) -- - (urcorner p) shifted (d,0) -- ulcorner p -- cycle) -enddef ; +primarydef p topenlarged d = + (llcorner p -- lrcorner p -- + (urcorner p) shifted (0,d) -- (ulcorner p) shifted (0,d) -- cycle) +enddef ; + +primarydef p bottomenlarged d = + (llcorner p shifted (0,-d) -- lrcorner p shifted (0,-d) -- + urcorner p -- ulcorner p -- cycle) +enddef ; -primarydef p topenlarged d = - (llcorner p -- lrcorner p -- - (urcorner p) shifted (0,d) -- (ulcorner p) shifted (0,d) -- cycle) -enddef ; +%D Handy for testing/debugging: -primarydef p bottomenlarged d = - (llcorner p shifted (0,-d) -- lrcorner p shifted (0,-d) -- - urcorner p -- ulcorner p -- cycle) -enddef ; +primarydef p crossed d = + (center p shifted (-d, 0) -- llcorner p -- + center p shifted ( 0,-d) -- lrcorner p -- + center p shifted (+d, 0) -- urcorner p -- + center p shifted ( 0,+d) -- ulcorner p -- cycle) +enddef ; -%D Saves typing: +%D Saves typing: % vardef bottomboundary primary p = (llcorner p -- lrcorner p) enddef ; % vardef rightboundary primary p = (lrcorner p -- urcorner p) enddef ; % vardef topboundary primary p = (urcorner p -- ulcorner p) enddef ; % vardef leftboundary primary p = (ulcorner p -- llcorner p) enddef ; -vardef bottomboundary primary p = - if pair p : p else : (llcorner p -- lrcorner p) fi +vardef bottomboundary primary p = + if pair p : p else : (llcorner p -- lrcorner p) fi enddef ; -vardef rightboundary primary p = - if pair p : p else : (lrcorner p -- urcorner p) fi +vardef rightboundary primary p = + if pair p : p else : (lrcorner p -- urcorner p) fi enddef ; -vardef topboundary primary p = - if pair p : p else : (urcorner p -- ulcorner p) fi +vardef topboundary primary p = + if pair p : p else : (urcorner p -- ulcorner p) fi enddef ; -vardef leftboundary primary p = - if pair p : p else : (ulcorner p -- llcorner p) fi +vardef leftboundary primary p = + if pair p : p else : (ulcorner p -- llcorner p) fi enddef ; %D Nice too: @@ -742,158 +751,158 @@ primarydef p squeezed s = ((llcorner p .. .5[llcorner p,lrcorner p] shifted ( 0, ypart paired(s)) .. lrcorner p) & (lrcorner p .. .5[lrcorner p,urcorner p] shifted (-xpart paired(s), 0) .. urcorner p) & (urcorner p .. .5[urcorner p,ulcorner p] shifted ( 0,-ypart paired(s)) .. ulcorner p) & - (ulcorner p .. .5[ulcorner p,llcorner p] shifted ( xpart paired(s), 0) .. llcorner p) & cycle) + (ulcorner p .. .5[ulcorner p,llcorner p] shifted ( xpart paired(s), 0) .. llcorner p) & cycle) enddef ; -primarydef p randomshifted s = - begingroup ; save ss ; pair ss ; ss := paired(s) ; +primarydef p randomshifted s = + begingroup ; save ss ; pair ss ; ss := paired(s) ; p shifted (-.5xpart ss + uniformdeviate xpart ss, - -.5ypart ss + uniformdeviate ypart ss) - endgroup -enddef ; + -.5ypart ss + uniformdeviate ypart ss) + endgroup +enddef ; %primarydef p randomized s = -% for i=0 upto length(p)-1 : -% ((point i of p) randomshifted s) .. controls -% ((postcontrol i of p) randomshifted s) and -% ((precontrol (i+1) of p) randomshifted s) .. -% endfor cycle +% for i=0 upto length(p)-1 : +% ((point i of p) randomshifted s) .. controls +% ((postcontrol i of p) randomshifted s) and +% ((precontrol (i+1) of p) randomshifted s) .. +% endfor cycle %enddef ; primarydef p randomized s = - (if path p : + (if path p : for i=0 upto length(p)-1 : - ((point i of p) randomshifted s) .. controls - ((postcontrol i of p) randomshifted s) and - ((precontrol (i+1) of p) randomshifted s) .. - endfor - if cycle p : - cycle + ((point i of p) randomshifted s) .. controls + ((postcontrol i of p) randomshifted s) and + ((precontrol (i+1) of p) randomshifted s) .. + endfor + if cycle p : + cycle else : - ((point length(p) of p) randomshifted s) + ((point length(p) of p) randomshifted s) fi elseif pair p : - p randomshifted s + p randomshifted s elseif color p : - if color s : + if color s : (uniformdeviate redpart s * redpart p, uniformdeviate greenpart s * greenpart p, - uniformdeviate bluepart s * bluepart p) - elseif pair s : - ((xpart s + uniformdeviate (ypart s - xpart s)) * p) - else : - (uniformdeviate s * p) - fi + uniformdeviate bluepart s * bluepart p) + elseif pair s : + ((xpart s + uniformdeviate (ypart s - xpart s)) * p) + else : + (uniformdeviate s * p) + fi else : - p + uniformdeviate s - fi) -enddef ; + p + uniformdeviate s + fi) +enddef ; -%D Not perfect (alternative for interpath) +%D Not perfect (alternative for interpath) vardef interpolated(expr s, p, q) = - save m ; m := max(length(p),length(q)) ; - (if path p : + save m ; m := max(length(p),length(q)) ; + (if path p : for i=0 upto m-1 : s[point (i /m) along p, - point (i /m) along q] .. controls + point (i /m) along q] .. controls s[postcontrol (i /m) along p, - postcontrol (i /m) along q] and + postcontrol (i /m) along q] and s[precontrol ((i+1)/m) along p, - precontrol ((i+1)/m) along q] .. - endfor - if cycle p : - cycle + precontrol ((i+1)/m) along q] .. + endfor + if cycle p : + cycle else : s[point infinity of p, - point infinity of q] + point infinity of q] fi else : a[p,q] - fi) -enddef ; + fi) +enddef ; %D Interesting too: % primarydef p parallel s = -% begingroup ; save q, b ; path q ; numeric b ; -% b := xpart (lrcorner p - llcorner p) ; +% begingroup ; save q, b ; path q ; numeric b ; +% b := xpart (lrcorner p - llcorner p) ; % q := p if b>0 : scaled ((b+2s)/b) fi ; -% (q shifted (center p-center q)) -% endgroup -% enddef ; +% (q shifted (center p-center q)) +% endgroup +% enddef ; %primarydef p parallel s = -% begingroup ; save q, w,h ; path q ; numeric w, h ; -% w := bbwidth(p) ; h := bbheight(p) ; -% q := p if (w>0) and (h>0) : +% begingroup ; save q, w,h ; path q ; numeric w, h ; +% w := bbwidth(p) ; h := bbheight(p) ; +% q := p if (w>0) and (h>0) : % xyscaled ((w+2*xpart paired(s))/w,(h+2*ypart paired(s))/h) fi ; -% (q shifted (center p-center q)) -% endgroup -%enddef ; - -vardef punked primary p = - (point 0 of p for i=1 upto length(p)-1 : -- point i of p endfor - if cycle p : -- cycle else : -- point length(p) of p fi) -enddef ; - -vardef curved primary p = - (point 0 of p for i=1 upto length(p)-1 : .. point i of p endfor - if cycle p : .. cycle else : .. point length(p) of p fi) -enddef ; - -primarydef p blownup s = - begingroup - save _p_ ; path _p_ ; _p_ := p xysized +% (q shifted (center p-center q)) +% endgroup +%enddef ; + +vardef punked primary p = + (point 0 of p for i=1 upto length(p)-1 : -- point i of p endfor + if cycle p : -- cycle else : -- point length(p) of p fi) +enddef ; + +vardef curved primary p = + (point 0 of p for i=1 upto length(p)-1 : .. point i of p endfor + if cycle p : .. cycle else : .. point length(p) of p fi) +enddef ; + +primarydef p blownup s = + begingroup + save _p_ ; path _p_ ; _p_ := p xysized (bbwidth (p)+2(xpart paired(s)), - bbheight(p)+2(ypart paired(s))) ; + bbheight(p)+2(ypart paired(s))) ; (_p_ shifted (center p - center _p_)) - endgroup + endgroup enddef ; -%D Rather fundamental. +%D Rather fundamental. -% vardef rightpath expr p = -% save q, t, b ; path q ; pair t, b ; -% t := (ulcorner p -- urcorner p) intersection_point p ; -% b := (llcorner p -- lrcorner p) intersection_point p ; +% vardef rightpath expr p = +% save q, t, b ; path q ; pair t, b ; +% t := (ulcorner p -- urcorner p) intersection_point p ; +% b := (llcorner p -- lrcorner p) intersection_point p ; % if xpart directionpoint t of p < 0 : p := reverse p ; fi ; % q := p cutbefore b ; % q := q if xpart point 0 of p > 0 : & p fi cutafter t ; -% q -% enddef ; -% -% vardef leftpath expr p = -% save q, t, b ; path q ; pair t, b ; -% t := (ulcorner p -- urcorner p) intersection_point p ; -% b := (llcorner p -- lrcorner p) intersection_point p ; +% q +% enddef ; +% +% vardef leftpath expr p = +% save q, t, b ; path q ; pair t, b ; +% t := (ulcorner p -- urcorner p) intersection_point p ; +% b := (llcorner p -- lrcorner p) intersection_point p ; % if xpart directionpoint t of p < 0 : p := reverse p ; fi ; % q := p cutbefore t ; % q := q if xpart point 0 of p > 0 : & p fi cutafter b ; -% q -% enddef ; +% q +% enddef ; -def leftrightpath(expr p, l) = - save q, t, b ; path q ; pair t, b ; - t := (ulcorner p -- urcorner p) intersection_point p ; - b := (llcorner p -- lrcorner p) intersection_point p ; +def leftrightpath(expr p, l) = + save q, t, b ; path q ; pair t, b ; + t := (ulcorner p -- urcorner p) intersection_point p ; + b := (llcorner p -- lrcorner p) intersection_point p ; if xpart directionpoint t of p < 0 : p := reverse p ; fi ; q := p cutbefore if l: t else: b fi ; - q := q if xpart point 0 of p > 0 : & + q := q if xpart point 0 of p > 0 : & p fi cutafter if l: b else: t fi ; - q -enddef ; + q +enddef ; -vardef leftpath expr p = leftrightpath(p,true ) enddef ; -vardef rightpath expr p = leftrightpath(p,false) enddef ; +vardef leftpath expr p = leftrightpath(p,true ) enddef ; +vardef rightpath expr p = leftrightpath(p,false) enddef ; -%D Drawoptions +%D Drawoptions def saveoptions = - save _op_ ; def _op_ = enddef ; -enddef ; - -%D Tracing. + save _op_ ; def _op_ = enddef ; +enddef ; + +%D Tracing. let normaldraw = draw ; let normalfill = fill ; @@ -906,7 +915,7 @@ def draworiginoptions (text t) = def _ori_opt_ = t enddef ; enddef ; def drawboundoptions (text t) = def _bnd_opt_ = t enddef ; enddef ; def drawpathoptions (text t) = def _pth_opt_ = t enddef ; enddef ; -def resetdrawoptions = +def resetdrawoptions = drawlineoptions (withpen pencircle scaled 1pt withcolor .5white) ; drawpointoptions (withpen pencircle scaled 4pt withcolor black) ; drawcontroloptions(withpen pencircle scaled 2.5pt withcolor black) ; @@ -914,7 +923,7 @@ def resetdrawoptions = draworiginoptions (withpen pencircle scaled 1pt withcolor .5white) ; drawboundoptions (dashed evenly _ori_opt_) ; drawpathoptions (withpen pencircle scaled 5pt withcolor .8white) ; -enddef ; +enddef ; resetdrawoptions ; @@ -926,47 +935,47 @@ enddef ; %D Arrow. -vardef drawarrowpath expr p = - save autoarrows ; boolean autoarrows ; autoarrows := true ; - drawarrow p _pth_opt_ -enddef ; - -%def drawarrowpath expr p = -% begingroup ; -% save autoarrows ; boolean autoarrows ; autoarrows := true ; -% save arrowpath ; path arrowpath ; arrowpath := p ; -% _drawarrowpath_ -%enddef ; +vardef drawarrowpath expr p = + save autoarrows ; boolean autoarrows ; autoarrows := true ; + drawarrow p _pth_opt_ +enddef ; + +%def drawarrowpath expr p = +% begingroup ; +% save autoarrows ; boolean autoarrows ; autoarrows := true ; +% save arrowpath ; path arrowpath ; arrowpath := p ; +% _drawarrowpath_ +%enddef ; % -%def _drawarrowpath_ text t = -% drawarrow arrowpath _pth_opt_ t ; -% endgroup ; -%enddef ; +%def _drawarrowpath_ text t = +% drawarrow arrowpath _pth_opt_ t ; +% endgroup ; +%enddef ; def midarrowhead expr p = - arrowhead p cutafter - (point length(p cutafter point .5 along p)+ahlength on p) -enddef ; + arrowhead p cutafter + (point length(p cutafter point .5 along p)+ahlength on p) +enddef ; vardef arrowheadonpath (expr p, s) = save autoarrows ; boolean autoarrows ; autoarrows := true ; arrowhead p if s<1 : cutafter (point (s*arclength(p)+.5ahlength) on p) fi enddef ; - + %D Points. -def drawpoint expr c = - if string c : - string _c_ ; _c_ := "(" & c & ")" ; - dotlabel.urt(_c_, scantokens _c_) ; - drawdot scantokens _c_ - else : - dotlabel.urt("(" & decimal xpart c & "," & decimal ypart c & ")", c) ; - drawdot c - fi _pnt_opt_ -enddef ; +def drawpoint expr c = + if string c : + string _c_ ; _c_ := "(" & c & ")" ; + dotlabel.urt(_c_, scantokens _c_) ; + drawdot scantokens _c_ + else : + dotlabel.urt("(" & decimal xpart c & "," & decimal ypart c & ")", c) ; + drawdot c + fi _pnt_opt_ +enddef ; -%D PathPoints. +%D PathPoints. def drawpoints expr c = path _c_ ; _c_ := c ; do_drawpoints enddef ; def drawcontrolpoints expr c = path _c_ ; _c_ := c ; do_drawcontrolpoints enddef ; @@ -993,37 +1002,37 @@ def do_drawcontrollines text t = endfor ; enddef; -boolean swappointlabels ; swappointlabels := false ; +boolean swappointlabels ; swappointlabels := false ; def do_drawpointlabels text t = for _i_=0 upto length(_c_) : - pair _u_ ; _u_ := unitvector(direction _i_ of _c_) + pair _u_ ; _u_ := unitvector(direction _i_ of _c_) rotated if swappointlabels : - fi 90 ; pair _p_ ; _p_ := (point _i_ of _c_) ; _u_ := 12 * defaultscale * _u_ ; - normaldraw thelabel ( decimal _i_, + normaldraw thelabel ( decimal _i_, _p_ shifted if cycle _c_ and (_i_=0) : - fi _u_ ) _lab_opt_ t ; endfor ; enddef; -%D Bounding box. +%D Bounding box. def drawboundingbox expr p = normaldraw boundingbox p _bnd_opt_ enddef ; -%D Origin. +%D Origin. numeric originlength ; originlength := .5cm ; def draworigin text t = normaldraw (origin shifted (0, originlength) -- origin shifted (0,-originlength)) _ori_opt_ t ; - normaldraw (origin shifted ( originlength,0) -- + normaldraw (origin shifted ( originlength,0) -- origin shifted (-originlength,0)) _ori_opt_ t ; enddef; -%D Axis. +%D Axis. numeric tickstep ; tickstep := 5mm ; numeric ticklength ; ticklength := 2mm ; @@ -1032,9 +1041,9 @@ def drawxticks expr c = path _c_ ; _c_ := c ; do_drawxticks enddef ; def drawyticks expr c = path _c_ ; _c_ := c ; do_drawyticks enddef ; def drawticks expr c = path _c_ ; _c_ := c ; do_drawticks enddef ; -% Adding eps prevents disappearance due to rounding errors. +% Adding eps prevents disappearance due to rounding errors. -def do_drawxticks text t = +def do_drawxticks text t = for i=0 step -tickstep until xpart llcorner _c_ - eps : if (i<=xpart lrcorner _c_) : normaldraw (i,-ticklength)--(i,ticklength) _ori_opt_ t ; @@ -1081,14 +1090,14 @@ def drawwholepath expr p = drawpointlabels p ; enddef ; -%D Tracing. +%D Tracing. -def visualizeddraw expr c = - if picture c : normaldraw c else : path _c_ ; _c_ := c ; do_visualizeddraw fi +def visualizeddraw expr c = + if picture c : normaldraw c else : path _c_ ; _c_ := c ; do_visualizeddraw fi enddef ; -def visualizedfill expr c = - if picture c : normalfill c else : path _c_ ; _c_ := c ; do_visualizedfill fi +def visualizedfill expr c = + if picture c : normalfill c else : path _c_ ; _c_ := c ; do_visualizedfill fi enddef ; def do_visualizeddraw text t = @@ -1103,7 +1112,7 @@ enddef ; def do_visualizedfill text t = if cycle _c_ : normalfill _c_ t fi ; - draworigin ; + draworigin ; drawcontrollines _c_ ; drawcontrolpoints _c_ ; drawpoints _c_ ; @@ -1123,121 +1132,121 @@ enddef ; extra_endfig := extra_endfig & " naturalizepaths ; " ; -%D Normally, arrowheads don't scale well. So we provide a -%D hack. +%D Normally, arrowheads don't scale well. So we provide a +%D hack. -boolean autoarrows ; autoarrows := false ; -numeric ahfactor ; ahfactor := 2.5 ; +boolean autoarrows ; autoarrows := false ; +numeric ahfactor ; ahfactor := 2.5 ; -def set_ahlength (text t) = +def set_ahlength (text t) = ahlength := (ahfactor*pen_size(_op_ t)) ; % _op_ added -enddef ; +enddef ; -vardef pen_size (text t) = - save p ; picture p ; p := nullpicture ; - addto p doublepath (top origin -- bot origin) t ; - (ypart urcorner p - ypart lrcorner p) -enddef ; +vardef pen_size (text t) = + save p ; picture p ; p := nullpicture ; + addto p doublepath (top origin -- bot origin) t ; + (ypart urcorner p - ypart lrcorner p) +enddef ; -%D The next two macros are adapted versions of plain -%D \METAPOST\ definitions. +%D The next two macros are adapted versions of plain +%D \METAPOST\ definitions. def _finarr text t = - if autoarrows : set_ahlength (t) fi ; + if autoarrows : set_ahlength (t) fi ; draw _apth t ; filldraw arrowhead _apth t ; enddef; def _findarr text t = - if autoarrows : set_ahlength (t) fi ; + if autoarrows : set_ahlength (t) fi ; draw _apth t ; fill arrowhead _apth withpen currentpen t ; fill arrowhead reverse _apth withpen currentpen t ; enddef ; -%D Handy too ...... +%D Handy too ...... vardef pointarrow (expr pat, loc, len, off) = - save l, r, s, t ; path l, r ; numeric s ; pair t ; - t := if pair loc : loc else : point loc along pat fi ; -% draw t withpen pencircle scaled 10 withcolor .5white ; - s := len/2 - off ; if s<=0 : s := 0 elseif s>len : s := len fi ; + save l, r, s, t ; path l, r ; numeric s ; pair t ; + t := if pair loc : loc else : point loc along pat fi ; +% draw t withpen pencircle scaled 10 withcolor .5white ; + s := len/2 - off ; if s<=0 : s := 0 elseif s>len : s := len fi ; r := pat cutbefore t ; r := (r cutafter point (arctime s of r) of r) ; - s := len/2 + off ; if s<=0 : s := 0 elseif s>len : s := len fi ; + s := len/2 + off ; if s<=0 : s := 0 elseif s>len : s := len fi ; l := reverse (pat cutafter t) ; l := (reverse (l cutafter point (arctime s of l) of l)) ; - (l..r) -enddef ; + (l..r) +enddef ; -def rightarrow (expr pat,tim,len) = pointarrow(pat,tim,len,-len) enddef ; -def leftarrow (expr pat,tim,len) = pointarrow(pat,tim,len,+len) enddef ; +def rightarrow (expr pat,tim,len) = pointarrow(pat,tim,len,-len) enddef ; +def leftarrow (expr pat,tim,len) = pointarrow(pat,tim,len,+len) enddef ; def centerarrow (expr pat,tim,len) = pointarrow(pat,tim,len, 0) enddef ; -%D The \type {along} and \type {on} operators can be used -%D as follows: +%D The \type {along} and \type {on} operators can be used +%D as follows: %D %D \starttypen -%D drawdot point .5 along somepath ; -%D drawdot point 3cm on somepath ; +%D drawdot point .5 along somepath ; +%D drawdot point 3cm on somepath ; %D \stoptypen -%D -%D The number denotes a percentage (fraction). +%D +%D The number denotes a percentage (fraction). -primarydef pct along pat = % also negative - (arctime (pct * (arclength pat)) of pat) of pat -enddef ; +primarydef pct along pat = % also negative + (arctime (pct * (arclength pat)) of pat) of pat +enddef ; % primarydef len on pat = % (arctime len of pat) of pat -% enddef ; +% enddef ; primarydef len on pat = - (arctime if len>0 : len else : (arclength(pat)+len) fi of pat) of pat -enddef ; + (arctime if len>0 : len else : (arclength(pat)+len) fi of pat) of pat +enddef ; -% this cuts of a piece from both ends +% this cuts of a piece from both ends % tertiarydef pat cutends len = -% begingroup ; save tap ; path tap ; -% tap := pat cutbefore (point len on pat) ; -% (tap cutafter (point -len on tap)) -% endgroup -% enddef ; +% begingroup ; save tap ; path tap ; +% tap := pat cutbefore (point len on pat) ; +% (tap cutafter (point -len on tap)) +% endgroup +% enddef ; tertiarydef pat cutends len = - begingroup ; save tap ; path tap ; - tap := pat cutbefore (point (xpart paired(len)) on pat) ; - (tap cutafter (point -(ypart paired(len)) on tap)) - endgroup -enddef ; + begingroup ; save tap ; path tap ; + tap := pat cutbefore (point (xpart paired(len)) on pat) ; + (tap cutafter (point -(ypart paired(len)) on tap)) + endgroup +enddef ; -%D To be documented. +%D To be documented. -path freesquare ; +path freesquare ; freesquare := ((-1,0)--(-1,-1)--(0,-1)--(+1,-1)-- (+1,0)--(+1,+1)--(0,+1)--(-1,+1)--cycle) scaled .5 ; -numeric freelabeloffset ; freelabeloffset := 3pt ; -numeric freedotlabelsize ; freedotlabelsize := 3pt ; +numeric freelabeloffset ; freelabeloffset := 3pt ; +numeric freedotlabelsize ; freedotlabelsize := 3pt ; -vardef thefreelabel (expr str, loc, ori) = - save s, p, q, l ; picture s ; path p, q ; pair l ; - interim labeloffset := freelabeloffset ; +vardef thefreelabel (expr str, loc, ori) = + save s, p, q, l ; picture s ; path p, q ; pair l ; + interim labeloffset := freelabeloffset ; s := if string str : thelabel(str,loc) else : str shifted -center str shifted loc fi ; - setbounds s to boundingbox s enlarged freelabeloffset ; + setbounds s to boundingbox s enlarged freelabeloffset ; p := fullcircle scaled (2*length(loc-ori)) shifted ori ; q := freesquare xyscaled (urcorner s - llcorner s) ; % l := point (xpart (p intersectiontimes (ori--loc))) of q ; - l := point xpart (p intersectiontimes + l := point xpart (p intersectiontimes (ori--((1+eps)*arclength(ori--loc)*unitvector(loc-ori)))) of q ; - setbounds s to boundingbox s enlarged -freelabeloffset ; % new - %draw boundingbox s shifted -l withpen pencircle scaled .5pt withcolor red ; - (s shifted -l) -enddef ; + setbounds s to boundingbox s enlarged -freelabeloffset ; % new + %draw boundingbox s shifted -l withpen pencircle scaled .5pt withcolor red ; + (s shifted -l) +enddef ; -% better? +% better? vardef thefreelabel (expr str, loc, ori) = save s, p, q, l ; picture s ; path p, q ; pair l ; @@ -1252,15 +1261,15 @@ vardef thefreelabel (expr str, loc, ori) = (s shifted -l) enddef ; -vardef freelabel (expr str, loc, ori) = +vardef freelabel (expr str, loc, ori) = draw thefreelabel(str,loc,ori) ; -enddef ; +enddef ; -vardef freedotlabel (expr str, loc, ori) = +vardef freedotlabel (expr str, loc, ori) = interim linecap:=rounded ; draw loc withpen pencircle scaled freedotlabelsize ; draw thefreelabel(str,loc,ori) ; -enddef ; +enddef ; %D \starttypen %D drawarrow anglebetween(line_a,line_b,somelabel) ; @@ -1270,38 +1279,38 @@ enddef ; numeric anglelength ; anglelength := 20pt ; numeric anglemethod ; anglemethod := 1 ; -% vardef anglebetween (expr a, b, str) = % path path string +% vardef anglebetween (expr a, b, str) = % path path string % save pointa, pointb, common, middle, offset ; % pair pointa, pointb, common, middle, offset ; -% save curve ; path curve ; -% save where ; numeric where ; -% if round point 0 of a = round point 0 of b : +% save curve ; path curve ; +% save where ; numeric where ; +% if round point 0 of a = round point 0 of b : % common := point 0 of a ; % else : % common := a intersectionpoint b ; -% fi ; -% pointa := point anglelength on a ; -% pointb := point anglelength on b ; -% where := turningnumber (common--pointa--pointb--cycle) ; +% fi ; +% pointa := point anglelength on a ; +% pointb := point anglelength on b ; +% where := turningnumber (common--pointa--pointb--cycle) ; % middle := ((common--pointa) rotatedaround (pointa,-where*90)) -% intersectionpoint -% ((common--pointb) rotatedaround (pointb, where*90)) ; +% intersectionpoint +% ((common--pointb) rotatedaround (pointb, where*90)) ; % if anglemethod = 0 : -% curve := pointa{unitvector(middle-pointa)}.. pointb; -% middle := point .5 along curve ; -% curve := common ; -% elseif anglemethod = 1 : -% curve := pointa{unitvector(middle-pointa)}.. pointb; -% middle := point .5 along curve ; -% elseif anglemethod = 2 : -% middle := common rotatedaround(.5[pointa,pointb],180) ; -% curve := pointa--middle--pointb ; -% elseif anglemethod = 3 : -% curve := pointa--middle--pointb ; -% elseif anglemethod = 4 : -% curve := pointa..controls middle..pointb ; -% middle := point .5 along curve ; -% fi ; +% curve := pointa{unitvector(middle-pointa)}.. pointb; +% middle := point .5 along curve ; +% curve := common ; +% elseif anglemethod = 1 : +% curve := pointa{unitvector(middle-pointa)}.. pointb; +% middle := point .5 along curve ; +% elseif anglemethod = 2 : +% middle := common rotatedaround(.5[pointa,pointb],180) ; +% curve := pointa--middle--pointb ; +% elseif anglemethod = 3 : +% curve := pointa--middle--pointb ; +% elseif anglemethod = 4 : +% curve := pointa..controls middle..pointb ; +% middle := point .5 along curve ; +% fi ; % draw thefreelabel(str, middle, common) withcolor black ; % curve % enddef ; @@ -1349,250 +1358,269 @@ enddef ; % Stack -picture currentpicturestack[] ; -numeric currentpicturedepth ; currentpicturedepth := 0 ; +picture currentpicturestack[] ; +numeric currentpicturedepth ; currentpicturedepth := 0 ; -def pushcurrentpicture = - currentpicturedepth := currentpicturedepth + 1 ; - currentpicturestack[currentpicturedepth] := currentpicture ; - currentpicture := nullpicture ; +def pushcurrentpicture = + currentpicturedepth := currentpicturedepth + 1 ; + currentpicturestack[currentpicturedepth] := currentpicture ; + currentpicture := nullpicture ; enddef ; -def popcurrentpicture text t = % optional text - if currentpicturedepth > 0 : +def popcurrentpicture text t = % optional text + if currentpicturedepth > 0 : addto currentpicturestack[currentpicturedepth] also currentpicture t ; currentpicture := currentpicturestack[currentpicturedepth] ; - currentpicturedepth := currentpicturedepth - 1 ; + currentpicturedepth := currentpicturedepth - 1 ; fi ; enddef ; -%D colorcircle(size, red, green, blue) ; +%D colorcircle(size, red, green, blue) ; -% vardef colorcircle (expr size, red, green, blue) = +% vardef colorcircle (expr size, red, green, blue) = % save r, g, b, rr, gg, bb, cc, mm, yy ; save radius ; -% path r, g, b, rr, bb, gg, cc, mm, yy ; numeric radius ; -% -% radius := 5cm ; pickup pencircle scaled (radius/25) ; -% +% path r, g, b, rr, bb, gg, cc, mm, yy ; numeric radius ; +% +% radius := 5cm ; pickup pencircle scaled (radius/25) ; +% % r := g := b := fullcircle scaled radius shifted (0,radius/4) ; -% -% r := r rotatedaround (origin, 15) ; -% g := g rotatedaround (origin,135) ; -% b := b rotatedaround (origin,255) ; -% -% r := r rotatedaround(center r,-90) ; -% g := g rotatedaround(center g, 90) ; -% -% gg := buildcycle(buildcycle(reverse r,b),g) ; -% cc := buildcycle(buildcycle(b,reverse g),r) ; -% -% rr := gg rotatedaround(origin,120) ; -% bb := gg rotatedaround(origin,240) ; -% -% yy := cc rotatedaround(origin,120) ; -% mm := cc rotatedaround(origin,240) ; -% -% pushcurrentpicture ; -% +% +% r := r rotatedaround (origin, 15) ; +% g := g rotatedaround (origin,135) ; +% b := b rotatedaround (origin,255) ; +% +% r := r rotatedaround(center r,-90) ; +% g := g rotatedaround(center g, 90) ; +% +% gg := buildcycle(buildcycle(reverse r,b),g) ; +% cc := buildcycle(buildcycle(b,reverse g),r) ; +% +% rr := gg rotatedaround(origin,120) ; +% bb := gg rotatedaround(origin,240) ; +% +% yy := cc rotatedaround(origin,120) ; +% mm := cc rotatedaround(origin,240) ; +% +% pushcurrentpicture ; +% % fill fullcircle scaled radius withcolor white ; -% -% fill rr withcolor red ; fill cc withcolor white-red ; -% fill gg withcolor green ; fill mm withcolor white-green ; -% fill bb withcolor blue ; fill yy withcolor white-blue ; -% -% for i = rr,gg,bb,cc,mm,yy : draw i withcolor .5white ; endfor ; -% -% currentpicture := currentpicture xsized size ; -% +% +% fill rr withcolor red ; fill cc withcolor white-red ; +% fill gg withcolor green ; fill mm withcolor white-green ; +% fill bb withcolor blue ; fill yy withcolor white-blue ; +% +% for i = rr,gg,bb,cc,mm,yy : draw i withcolor .5white ; endfor ; +% +% currentpicture := currentpicture xsized size ; +% % popcurrentpicture ; -% enddef ; +% enddef ; -% vardef colorcircle (expr size, red, green, blue) = +% vardef colorcircle (expr size, red, green, blue) = % save r, g, b, rr, gg, bb, cc, mm, yy ; save radius ; -% path r, g, b, rr, bb, gg, cc, mm, yy ; numeric radius ; -% -% radius := 5cm ; pickup pencircle scaled (radius/25) ; -% -% transform t ; t := identity rotatedaround(origin,120) ; -% -% r := fullcircle scaled radius -% shifted (0,radius/4) rotatedaround(origin,15) ; -% -% g := r transformed t ; b := g transformed t ; -% -% r := r rotatedaround(center r,-90) ; -% g := g rotatedaround(center g, 90) ; -% -% gg := buildcycle(buildcycle(reverse r,b),g) ; -% cc := buildcycle(buildcycle(b,reverse g),r) ; -% -% rr := gg transformed t ; bb := rr transformed t ; -% yy := cc transformed t ; mm := yy transformed t ; -% -% pushcurrentpicture ; -% +% path r, g, b, rr, bb, gg, cc, mm, yy ; numeric radius ; +% +% radius := 5cm ; pickup pencircle scaled (radius/25) ; +% +% transform t ; t := identity rotatedaround(origin,120) ; +% +% r := fullcircle scaled radius +% shifted (0,radius/4) rotatedaround(origin,15) ; +% +% g := r transformed t ; b := g transformed t ; +% +% r := r rotatedaround(center r,-90) ; +% g := g rotatedaround(center g, 90) ; +% +% gg := buildcycle(buildcycle(reverse r,b),g) ; +% cc := buildcycle(buildcycle(b,reverse g),r) ; +% +% rr := gg transformed t ; bb := rr transformed t ; +% yy := cc transformed t ; mm := yy transformed t ; +% +% pushcurrentpicture ; +% % fill fullcircle scaled radius withcolor white ; -% -% fill rr withcolor red ; fill cc withcolor white-red ; -% fill gg withcolor green ; fill mm withcolor white-green ; -% fill bb withcolor blue ; fill yy withcolor white-blue ; -% -% for i = rr,gg,bb,cc,mm,yy : draw i withcolor .5white ; endfor ; -% -% currentpicture := currentpicture xsized size ; -% +% +% fill rr withcolor red ; fill cc withcolor white-red ; +% fill gg withcolor green ; fill mm withcolor white-green ; +% fill bb withcolor blue ; fill yy withcolor white-blue ; +% +% for i = rr,gg,bb,cc,mm,yy : draw i withcolor .5white ; endfor ; +% +% currentpicture := currentpicture xsized size ; +% % popcurrentpicture ; -% enddef ; +% enddef ; -vardef colorcircle (expr size, red, green, blue) = - save r, g, b, c, m, y, w ; save radius ; - path r, g, b, c, m, y, w ; numeric radius ; +vardef colorcircle (expr size, red, green, blue) = + save r, g, b, c, m, y, w ; save radius ; + path r, g, b, c, m, y, w ; numeric radius ; - radius := 5cm ; pickup pencircle scaled (radius/25) ; + radius := 5cm ; pickup pencircle scaled (radius/25) ; - transform t ; t := identity rotatedaround(origin,120) ; + transform t ; t := identity rotatedaround(origin,120) ; - r := fullcircle rotated 90 scaled radius - shifted (0,radius/4) rotatedaround(origin,135) ; + r := fullcircle rotated 90 scaled radius + shifted (0,radius/4) rotatedaround(origin,135) ; - b := r transformed t ; g := b transformed t ; + b := r transformed t ; g := b transformed t ; - c := buildcycle(subpath(1,7) of g,subpath(1,7) of b) ; - y := c transformed t ; m := y transformed t ; + c := buildcycle(subpath(1,7) of g,subpath(1,7) of b) ; + y := c transformed t ; m := y transformed t ; - w := buildcycle(subpath(3,5) of r, subpath(3,5) of g,subpath(3,5) of b) ; + w := buildcycle(subpath(3,5) of r, subpath(3,5) of g,subpath(3,5) of b) ; pushcurrentpicture ; - fill r withcolor red ; - fill g withcolor green ; - fill b withcolor blue ; - fill c withcolor white-red ; - fill m withcolor white-green ; - fill y withcolor white-blue ; - fill w withcolor white ; + fill r withcolor red ; + fill g withcolor green ; + fill b withcolor blue ; + fill c withcolor white-red ; + fill m withcolor white-green ; + fill y withcolor white-blue ; + fill w withcolor white ; - for i = r,g,b,c,m,y : draw i withcolor .5white ; endfor ; + for i = r,g,b,c,m,y : draw i withcolor .5white ; endfor ; - currentpicture := currentpicture xsized size ; + currentpicture := currentpicture xsized size ; popcurrentpicture ; -enddef ; +enddef ; -% penpoint (i,2) of somepath -> inner / outer point +% penpoint (i,2) of somepath -> inner / outer point -vardef penpoint expr pnt of p = - save n, d ; numeric n, d ; - (n,d) = if pair pnt : pnt else : (pnt,1) fi ; +vardef penpoint expr pnt of p = + save n, d ; numeric n, d ; + (n,d) = if pair pnt : pnt else : (pnt,1) fi ; (point n of p shifted ((penoffset direction n of p of currentpen) scaled d)) 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 ; ) -enddef ; - -vardef inverted primary p = - (p uncolored white) -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 ;) -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 ; ) -enddef ; - -% yes or no: "text" infont "cmr12" at 24pt ; +% 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 ; ) +enddef ; + +vardef inverted primary p = + (p uncolored white) +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 ;) +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 ; ) +enddef ; + +% yes or no: "text" infont "cmr12" at 24pt ; % let normalinfont = infont ; -% -% numeric lastfontsize ; lastfontsize = fontsize defaultfont ; -% -% def infont primary name = % no vardef, no expr -% hide(lastfontsize := fontsize name) % no ; -% normalinfont name -% enddef ; -% -% def scaledat expr size = -% scaled (size/lastfontsize) -% enddef ; -% -% let at = scaledat ; +% +% numeric lastfontsize ; lastfontsize = fontsize defaultfont ; +% +% def infont primary name = % no vardef, no expr +% hide(lastfontsize := fontsize name) % no ; +% normalinfont name +% enddef ; +% +% def scaledat expr size = +% scaled (size/lastfontsize) +% enddef ; +% +% let at = scaledat ; % like decimal -def condition primary b = if b : "true" else : "false" fi enddef ; +def condition primary b = if b : "true" else : "false" fi enddef ; % undocumented -primarydef p stretched s = +primarydef p stretched s = begingroup % save pp ; path pp ; pp := p scaled s ; save pp ; path pp ; pp := p xyscaled s ; - (pp shifted ((point 0 of p) - (point 0 of pp))) + (pp shifted ((point 0 of p) - (point 0 of pp))) endgroup -enddef ; +enddef ; -% yes or no, untested -) +% yes or no, untested -) -def xshifted expr dx = shifted(dx,0) enddef ; -def yshifted expr dy = shifted(0,dy) enddef ; +def xshifted expr dx = shifted(dx,0) enddef ; +def yshifted expr dy = shifted(0,dy) enddef ; -% also handy +% also handy -% right: str = readfrom ("abc" & ".def" ) ; +% right: str = readfrom ("abc" & ".def" ) ; % wrong: str = readfrom "abc" & ".def" ; -% Every 62th read fails so we need to try again! +% Every 62th read fails so we need to try again! -def readfile (expr name) = - if (readfrom (name) <> EOF) : - scantokens("input " & name & " ") ; - elseif (readfrom (name) <> EOF) : +% def readfile (expr name) = +% if (readfrom (name) <> EOF) : +% scantokens("input " & name & ";") ; +% elseif (readfrom (name) <> EOF) : +% scantokens("input " & name & ";") ; +% fi ; +% closefrom (name) ; +% enddef ; +% +% this sometimes fails on the elseif, so : +% + +def readfile (expr name) = + begingroup ; save ok ; boolean ok ; + if (readfrom (name) <> EOF) : + ok := false ; + elseif (readfrom (name) <> EOF) : + ok := false ; + else : + ok := true ; + fi ; + if not ok : scantokens("input " & name & " ") ; - fi + fi ; closefrom (name) ; -enddef ; + endgroup ; +enddef ; -% permits redefinition of end in macro +% permits redefinition of end in macro -inner end ; +inner end ; % real fun @@ -1606,12 +1634,12 @@ def normalcolors = let withcolor = normalwithcolor ; enddef ; -def resetcolormap = +def resetcolormap = color color_map[][][] ; normalcolors ; -enddef ; +enddef ; -resetcolormap ; +resetcolormap ; % color_map_resolution := 1000 ; % @@ -1638,39 +1666,39 @@ enddef ; % def refill suffix c = do_repath (1) (c) enddef ; % def redraw suffix c = do_repath (2) (c) enddef ; % def recolor suffix c = do_repath (0) (c) enddef ; -% -% color refillbackground ; refillbackground := (1,1,1) ; -% -% def do_repath (expr mode) (suffix c) text t = % can it be stroked and filled at the same time ? +% +% color refillbackground ; refillbackground := (1,1,1) ; +% +% def do_repath (expr mode) (suffix c) text t = % can it be stroked and filled at the same time ? % begingroup ; -% if mode=0 : save withcolor ; remapcolors ; fi ; -% save _c_, _cc_, _f_, _b_ ; picture _c_, _cc_ ; color _f_ ; path _b_ ; -% _c_ := c ; _b_ := boundingbox c ; c := nullpicture ; -% for i within _c_ : +% if mode=0 : save withcolor ; remapcolors ; fi ; +% save _c_, _cc_, _f_, _b_ ; picture _c_, _cc_ ; color _f_ ; path _b_ ; +% _c_ := c ; _b_ := boundingbox c ; c := nullpicture ; +% for i within _c_ : % _f_ := (redpart i, greenpart i, bluepart i) ; -% if bounded i : -% setbounds c to pathpart i ; -% elseif clipped i : -% clip c to pathpart i ; -% elseif stroked i : -% addto c doublepath pathpart i -% dashed dashpart i withpen penpart i -% withcolor _f_ % (redpart i, greenpart i, bluepart i) +% if bounded i : +% setbounds c to pathpart i ; +% elseif clipped i : +% clip c to pathpart i ; +% elseif stroked i : +% addto c doublepath pathpart i +% dashed dashpart i withpen penpart i +% withcolor _f_ % (redpart i, greenpart i, bluepart i) % if mode=2 : t fi ; -% elseif filled i : -% addto c contour pathpart i -% withcolor _f_ +% elseif filled i : +% addto c contour pathpart i +% withcolor _f_ % if (mode=1) and (_f_<>refillbackground) : t fi ; % else : % addto c also i ; % fi ; -% endfor ; -% setbounds c to _b_ ; -% endgroup ; -% enddef ; +% endfor ; +% setbounds c to _b_ ; +% endgroup ; +% enddef ; -% Thanks to Jens-Uwe Morawski for pointing out that we need -% to treat bounded and clipped components as local pictures. +% Thanks to Jens-Uwe Morawski for pointing out that we need +% to treat bounded and clipped components as local pictures. def recolor suffix p = p := repathed (0,p) enddef ; def refill suffix p = p := repathed (1,p) enddef ; @@ -1684,152 +1712,152 @@ primarydef p redrawn t = repathed(2,p) t enddef ; primarydef p retexted t = repathed(3,p) t enddef ; primarydef p untexted t = repathed(4,p) t enddef ; -color refillbackground ; refillbackground := (1,1,1) ; +color refillbackground ; refillbackground := (1,1,1) ; -vardef repathed (expr mode, p) text t = +vardef repathed (expr mode, p) text t = begingroup ; - if mode=0 : save withcolor ; remapcolors ; fi ; - save _p_, _pp_, _f_, _b_, _t_ ; - picture _p_, _pp_ ; color _f_ ; path _b_ ; transform _t_ ; - _b_ := boundingbox p ; _p_ := nullpicture ; - for i within p : + if mode=0 : save withcolor ; remapcolors ; fi ; + save _p_, _pp_, _f_, _b_, _t_ ; + picture _p_, _pp_ ; color _f_ ; path _b_ ; transform _t_ ; + _b_ := boundingbox p ; _p_ := nullpicture ; + for i within p : _f_ := (redpart i, greenpart i, bluepart i) ; - if bounded i : - _pp_ := repathed(mode,i) t ; + if bounded i : + _pp_ := repathed(mode,i) t ; setbounds _pp_ to pathpart i ; addto _p_ also _pp_ ; - elseif clipped i : - _pp_ := repathed(mode,i) t ; - clip _pp_ to pathpart i ; + elseif clipped i : + _pp_ := repathed(mode,i) t ; + clip _pp_ to pathpart i ; addto _p_ also _pp_ ; - elseif stroked i : - addto _p_ doublepath pathpart i - dashed dashpart i withpen penpart i - withcolor _f_ % (redpart i, greenpart i, bluepart i) + elseif stroked i : + addto _p_ doublepath pathpart i + dashed dashpart i withpen penpart i + withcolor _f_ % (redpart i, greenpart i, bluepart i) if mode=2 : t fi ; - elseif filled i : - addto _p_ contour pathpart i - withcolor _f_ + elseif filled i : + addto _p_ contour pathpart i + withcolor _f_ if (mode=1) and (_f_<>refillbackground) : t fi ; elseif textual i : % textpart i <> "" : - if mode <> 4 : + if mode <> 4 : % transform _t_ ; - % (xpart _t_, xxpart _t_, xypart _t_) = (xpart i, xxpart i, xypart i) ; - % (ypart _t_, yypart _t_, yxpart _t_) = (ypart i, yypart i, yxpart i) ; - % addto _p_ also + % (xpart _t_, xxpart _t_, xypart _t_) = (xpart i, xxpart i, xypart i) ; + % (ypart _t_, yypart _t_, yxpart _t_) = (ypart i, yypart i, yxpart i) ; + % addto _p_ also % textpart i infont fontpart i % todo : other font - % transformed _t_ - % withpen penpart i - % withcolor _f_ + % transformed _t_ + % withpen penpart i + % withcolor _f_ % if mode=3 : t fi ; addto _p_ also i if mode=3 : t fi ; fi ; else : addto _p_ also i ; fi ; - endfor ; - setbounds _p_ to _b_ ; - _p_ - endgroup -enddef ; + endfor ; + setbounds _p_ to _b_ ; + _p_ + endgroup +enddef ; -% After a question of Denis on how to erase a z variable, Jacko -% suggested to assign whatever to x and y. So a clearz -% variable can be defined as: +% After a question of Denis on how to erase a z variable, Jacko +% suggested to assign whatever to x and y. So a clearz +% variable can be defined as: % -% vardef clearz@# = -% x@# := whatever ; -% y@# := whatever ; -% enddef ; +% vardef clearz@# = +% x@# := whatever ; +% y@# := whatever ; +% enddef ; % -% but Jacko suggested a redefinition of clearxy: +% but Jacko suggested a redefinition of clearxy: % % def clearxy text s = -% clearxy_index_:=0; -% for $:=s: +% clearxy_index_:=0; +% for $:=s: % clearxy_index_:=clearxy_index_+1; endfor; -% if clearxy_index_=0: +% if clearxy_index_=0: % save x,y; -% else: +% else: % forsuffixes $:=s: x$:=whatever; y$:=whatever; endfor; % fi % enddef; % -% which i decided to simplify to: +% which i decided to simplify to: def clearxy text s = - if false for $ := s : or true endfor : + if false for $ := s : or true endfor : forsuffixes $ := s : x$ := whatever ; y$ := whatever ; endfor ; - else : + else : save x, y ; fi enddef ; -% so now we can say: clearxy ; as well as clearxy 1, 2, 3 ; +% so now we can say: clearxy ; as well as clearxy 1, 2, 3 ; -% show x0 ; z0 = (10,10) ; -% show x0 ; x0 := whatever ; y0 := whatever ; +% show x0 ; z0 = (10,10) ; +% show x0 ; x0 := whatever ; y0 := whatever ; % show x0 ; z0 = (20,20) ; -% show x0 ; clearxy 0 ; +% show x0 ; clearxy 0 ; % show x0 ; z0 = (30,30) ; primarydef p smoothed d = - (p llmoved (-xpart paired(d),0) -- p lrmoved (-xpart paired(d),0) {right} .. - p lrmoved (0,-ypart paired(d)) -- p urmoved (0,-ypart paired(d)) {up} .. + (p llmoved (-xpart paired(d),0) -- p lrmoved (-xpart paired(d),0) {right} .. + p lrmoved (0,-ypart paired(d)) -- p urmoved (0,-ypart paired(d)) {up} .. p urmoved (-xpart paired(d),0) -- p ulmoved (-xpart paired(d),0) {left} .. - p ulmoved (0,-ypart paired(d)) -- p llmoved (0,-ypart paired(d)) {down} .. cycle) + p ulmoved (0,-ypart paired(d)) -- p llmoved (0,-ypart paired(d)) {down} .. cycle) enddef ; -primarydef p cornered c = - ((point 0 of p) shifted (c*(unitvector(point 1 of p - point 0 of p))) -- +primarydef p cornered c = + ((point 0 of p) shifted (c*(unitvector(point 1 of p - point 0 of p))) -- for i=1 upto length(p) : - (point i-1 of p) shifted (c*(unitvector(point i of p - point i-1 of p))) -- + (point i-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) enddef ; -% cmyk color support +% cmyk color support vardef cmyk(expr c,m,y,k) = (1-c-k,1-m-k,1-y-k) enddef ; -% handy +% handy -vardef bbwidth (expr p) = - (if known p : - if path p or picture p : - xpart (lrcorner p - llcorner p) - else : 0 fi else : 0 +vardef bbwidth (expr p) = + (if known p : + if path p or picture p : + xpart (lrcorner p - llcorner p) + else : 0 fi else : 0 fi ) -enddef ; +enddef ; -vardef bbheight (expr p) = - (if known p : if path p or picture p : - ypart (urcorner p - lrcorner p) - else : 0 fi else : 0 +vardef bbheight (expr p) = + (if known p : if path p or picture p : + ypart (urcorner p - lrcorner p) + else : 0 fi else : 0 fi) -enddef ; +enddef ; -color nocolor ; numeric noline ; % both unknown signals +color nocolor ; numeric noline ; % both unknown signals def dowithpath (expr p, lw, lc, bc) = - if known p : - if known bc : + if known p : + if known bc : fill p withcolor bc ; - fi ; - if known lw and known lc : + fi ; + if known lw and known lc : draw p withpen pencircle scaled lw withcolor lc ; - elseif known lw : + elseif known lw : draw p withpen pencircle scaled lw ; - elseif known lc : + elseif known lc : draw p withcolor lc ; - fi ; - fi ; + fi ; + fi ; enddef ; % result from metafont discussion list (denisr/boguslawj) @@ -1837,122 +1865,165 @@ enddef ; def ]] = ] ] enddef ; def ]]] = ] ] ] enddef ; def [[ = [ [ enddef ; def [[[ = [ [ [ enddef ; -% not prefect, but useful since it removes redundant points. +% not perfect, but useful since it removes redundant points. + +% vardef dostraightened(expr sign, p) = +% 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 : +% if round(point i of p) <> round(point length(pp) of pp) : +% pp := pp -- point i of p ; +% fi ; +% 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 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)) : +% if ok : -- else : ok := true ; fi point i of pp +% fi +% endfor +% if ok and (cycle p) : -- cycle fi +% else : +% pp +% fi +% else : +% p +% fi +% enddef ; + +% vardef simplified expr p = +% (reverse dostraightened(+1,dostraightened(+1,reverse p))) +% enddef ; + +% vardef unspiked expr p = +% (reverse dostraightened(-1,dostraightened(-1,reverse p))) +% enddef ; -vardef dostraightened(expr sign, p) = - if length(p)>2 : % was 1, but straight lines are ok - save pp ; path pp ; +% simplified : remove same points as well as redundant points +% unspiked : remove same points as well as areas with zero distance + +vardef dostraightened(expr sign, p) = + save _p_, _q_ ; path _p_, _q_ ; + _p_ := p ; + forever : + _q_ := dodostraightened(sign, _p_) ; + exitif length(_p_) = length(_q_) ; + _p_ := _q_ ; + endfor ; + _q_ +enddef ; + +vardef dodostraightened(expr sign, p) = + 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 : - if round(point i of p) <> round(point length(pp) of pp) : + for i=1 upto length(p)-1 : + if round(point i of p) <> round(point length(pp) of pp) : pp := pp -- point i of p ; - fi ; + fi ; 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 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)) : - if ok : -- else : ok := true ; fi point i of pp - fi - - endfor - if ok and (cycle p) : -- cycle fi -else : - pp -fi - else : - p - fi -enddef ; - -% simplified : remove same points as well as redundant points -% unspiked : remove same points as well as areas with zero distance - -% vardef simplified expr p = dostraightened(+1,p) enddef ; -% vardef unspiked expr p = dostraightened(-1,p) enddef ; + 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 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)) : + if ok : -- else : ok := true ; fi point i of pp + fi + endfor + if ok and (cycle p) : -- cycle fi + else : + pp + fi + else : + p + fi +enddef ; vardef simplified expr p = - (reverse dostraightened(+1,dostraightened(+1,reverse p))) + dostraightened(+1,p) enddef ; vardef unspiked expr p = - (reverse dostraightened(-1,dostraightened(-1,reverse p))) + dostraightened(-1,p) enddef ; -% path p ; -% p := (2cm,1cm) -- (2cm,1cm) -- (2cm,1cm) -- (3cm,1cm) -- -% (4cm,1cm) -- (4cm,2cm) -- (4cm,2.5cm) -- (4cm,3cm) -- -% (3cm,3cm) -- (2cm,3cm) -- (1cm,3cm) -- (-1cm,3cm) -- -% .5[(-1cm,3cm),(1cm,1cm)] -- (1cm,1cm) -- cycle ; -% -% p := unitcircle scaled 4cm ; -% -% drawpath p ; drawpoints p ; drawpointlabels p ; -% p := p shifted (4cm,0) ; p := straightened p ; -% drawpath p ; drawpoints p ; drawpointlabels p ; -% p := p shifted (4cm,0) ; p := straightened p ; -% drawpath p ; drawpoints p ; drawpointlabels p ; +% path p ; +% p := (2cm,1cm) -- (2cm,1cm) -- (2cm,1cm) -- (3cm,1cm) -- +% (4cm,1cm) -- (4cm,2cm) -- (4cm,2.5cm) -- (4cm,3cm) -- +% (3cm,3cm) -- (2cm,3cm) -- (1cm,3cm) -- (-1cm,3cm) -- +% .5[(-1cm,3cm),(1cm,1cm)] -- (1cm,1cm) -- cycle ; +% +% p := unitcircle scaled 4cm ; +% +% drawpath p ; drawpoints p ; drawpointlabels p ; +% p := p shifted (4cm,0) ; p := straightened p ; +% drawpath p ; drawpoints p ; drawpointlabels p ; +% p := p shifted (4cm,0) ; p := straightened p ; +% drawpath p ; drawpoints p ; drawpointlabels p ; -% new +% new path originpath ; originpath := origin -- cycle ; -vardef unitvector primary z = - if abs z = abs origin : z else : z/abs z fi +vardef unitvector primary z = + if abs z = abs origin : z else : z/abs z fi enddef; -% also new +% also new -vardef anchored@#(expr p, z) = +vardef anchored@#(expr p, z) = p shifted (z + (labxf@#*lrcorner p + labyf@#*ulcorner p + (1-labxf@#-labyf@#)*llcorner p)) enddef ; % epsed(1.2345) -vardef epsed (expr e) = - e if e>0 : + eps elseif e<0 : - eps fi -enddef ; +vardef epsed (expr e) = + e if e>0 : + eps elseif e<0 : - eps fi +enddef ; -% handy +% handy -def withgray primary g = - withcolor (g,g,g) -enddef ; +def withgray primary g = + withcolor (g,g,g) +enddef ; -% for metafun +% for metafun -if unknown darkred : color darkred ; darkred := .625(1,0,0) fi ; -if unknown darkyellow : color darkyellow ; darkyellow := .625(1,1,0) fi ; -if unknown darkgray : color darkgray ; darkgray := .625(1,1,1) fi ; -if unknown lightgray : color lightgray ; lightgray := .875(1,1,1) fi ; +if unknown darkred : color darkred ; darkred := .625(1,0,0) fi ; +if unknown darkyellow : color darkyellow ; darkyellow := .625(1,1,0) fi ; +if unknown darkgray : color darkgray ; darkgray := .625(1,1,1) fi ; +if unknown lightgray : color lightgray ; lightgray := .875(1,1,1) fi ; -% an improved plain mp macro +% an improved plain mp macro -vardef center primary p = - if pair p : p else : .5[llcorner p, urcorner p] fi +vardef center primary p = + if pair p : p else : .5[llcorner p, urcorner p] fi enddef; -% new, yet undocumented - -vardef rangepath (expr p, d, a) = - (if length p>0 : - (d*unitvector(direction 0 of p) rotated a) - shifted point 0 of p - -- p -- - (d*unitvector(direction length(p) of p) rotated a) - shifted point length(p) of p - else : - p +% new, yet undocumented + +vardef rangepath (expr p, d, a) = + (if length p>0 : + (d*unitvector(direction 0 of p) rotated a) + shifted point 0 of p + -- p -- + (d*unitvector(direction length(p) of p) rotated a) + shifted point length(p) of p + else : + p fi) -enddef ; +enddef ; -% under construction +% under construction vardef straightpath(expr a, b, method) = if (method<1) or (method>6) : @@ -1994,7 +2065,7 @@ vardef straightpath(expr a, b, method) = fi enddef ; -% handy for myself +% handy for myself def addbackground text t = begingroup ; save p ; picture p ; @@ -2006,55 +2077,55 @@ enddef ; % makes a (line) into an infinite one (handy for calculating % intersection points -vardef infinite expr p = - (-infinity*unitvector(direction 0 of p) - shifted point 0 of p - -- p -- - +infinity*unitvector(direction length(p) of p) +vardef infinite expr p = + (-infinity*unitvector(direction 0 of p) + shifted point 0 of p + -- p -- + +infinity*unitvector(direction length(p) of p) shifted point length(p) of p) -enddef ; +enddef ; % obscure macros: create var from string and replace - and : % (needed for process color id's) string _clean_ascii[] ; -_clean_ascii[ASCII "-"] := "_" ; -_clean_ascii[ASCII ":"] := "_" ; -_clean_ascii[ASCII "."] := "_" ; +_clean_ascii[ASCII "-"] := "_" ; +_clean_ascii[ASCII ":"] := "_" ; +_clean_ascii[ASCII "."] := "_" ; -vardef cleanstring (expr s) = - save ss ; string ss, si ; ss = "" ; - for i=0 upto length(s) : - si := substring(i,i+1) of s ; +vardef cleanstring (expr s) = + save ss ; string ss, si ; ss = "" ; + 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 ; endfor ; - ss -enddef ; + ss +enddef ; -vardef setunstringed (expr s, v) = - scantokens(cleanstring(s)) := v ; +vardef setunstringed (expr s, v) = + scantokens(cleanstring(s)) := v ; enddef ; -vardef setunstringed (expr s, v) = - scantokens(cleanstring(s)) := v ; +vardef setunstringed (expr s, v) = + scantokens(cleanstring(s)) := v ; enddef ; -vardef getunstringed (expr s) = - scantokens(cleanstring(s)) +vardef getunstringed (expr s) = + scantokens(cleanstring(s)) enddef ; -vardef unstringed (expr s) = - expandafter known scantokens(cleanstring(s)) +vardef unstringed (expr s) = + expandafter known scantokens(cleanstring(s)) enddef ; -% new +% new -vardef colorpart(expr i) = - (redpart i, greenpart i,bluepart i) -enddef ; +vardef colorpart(expr i) = + (redpart i, greenpart i,bluepart i) +enddef ; -% done +% done endinput ; -- cgit v1.2.3