summaryrefslogtreecommitdiff
path: root/metapost
diff options
context:
space:
mode:
Diffstat (limited to 'metapost')
-rw-r--r--metapost/context/base/mpiv/metafun.mpiv2
-rw-r--r--metapost/context/base/mpiv/mp-abck.mpiv38
-rw-r--r--metapost/context/base/mpiv/mp-mlib.mpiv71
-rw-r--r--metapost/context/base/mpiv/mp-tool.mpiv143
4 files changed, 213 insertions, 41 deletions
diff --git a/metapost/context/base/mpiv/metafun.mpiv b/metapost/context/base/mpiv/metafun.mpiv
index b1d4f32e7..ab3fa8638 100644
--- a/metapost/context/base/mpiv/metafun.mpiv
+++ b/metapost/context/base/mpiv/metafun.mpiv
@@ -35,6 +35,8 @@ input "mp-func.mpiv" ; % under construction
% "mp-char.mpiv" ; % loaded on demand
% "mp-step.mpiv" ; % loaded on demand
% "mp-chem.mpiv" ; % loaded on demand
+input "mp-apos.mpiv" ;
+input "mp-abck.mpiv" ;
string metafunversion ; metafunversion =
"metafun iv" & " " &
diff --git a/metapost/context/base/mpiv/mp-abck.mpiv b/metapost/context/base/mpiv/mp-abck.mpiv
index 68706b1d9..abd7d8848 100644
--- a/metapost/context/base/mpiv/mp-abck.mpiv
+++ b/metapost/context/base/mpiv/mp-abck.mpiv
@@ -267,41 +267,3 @@ enddef ;
def anchor_box (expr n,x,y,w,h,d) =
currentpicture := currentpicture shifted (-x,-y) ;
enddef ;
-
-vardef shaped (suffix p) =
- save l ; pair l[] ;
- save r ; pair r[] ;
- save i ; i := 1 ;
- save n ; n := 0 ;
- forever :
- exitif unknown p[i] ;
- n := n + 1 ;
- l[n] := ulcorner p[i] ;
- r[n] := urcorner p[i] ;
- n := n + 1 ;
- l[n] := llcorner p[i] ;
- r[n] := lrcorner p[i] ;
- i := i + 1 ;
- endfor ;
- for i = 3 upto n :
- if xpart r[i] < xpart r[i-1] :
- r[i] := (xpart r[i],ypart r[i-1]) ;
- elseif xpart r[i] > xpart r[i-1] :
- r[i] := (xpart r[i],ypart r[i-1]) ;
- fi ;
- if xpart l[i] < xpart l[i-1] :
- l[i] := (xpart l[i],ypart l[i-1]) ;
- elseif xpart l[i] > xpart l[i-1] :
- l[i] := (xpart l[i],ypart l[i-1]) ;
- fi ;
- endfor ;
- if n > 0 :
- simplified (
- for i = 1 upto n : r[i] -- endfor
- for i = n downto 1 : l[i] -- endfor
- cycle
- )
- else :
- origin -- cycle
- fi
-enddef ;
diff --git a/metapost/context/base/mpiv/mp-mlib.mpiv b/metapost/context/base/mpiv/mp-mlib.mpiv
index ea148d0c1..add58a43b 100644
--- a/metapost/context/base/mpiv/mp-mlib.mpiv
+++ b/metapost/context/base/mpiv/mp-mlib.mpiv
@@ -429,6 +429,75 @@ vardef onetimetextext@#(expr p) = % no draw here
thetextext@#(p,origin)
enddef ;
+% formatted text
+
+pair mfun_tt_z ;
+
+vardef rawfmttext(text t) = % todo: avoid currentpicture
+ mfun_tt_n := mfun_tt_n + 1 ;
+ mfun_tt_c := nullpicture ;
+ if mfun_trial_run :
+ mfun_tt_o := nullpicture ;
+ addto mfun_tt_o doublepath origin _op_ ; % save drawoptions
+ addto mfun_tt_c doublepath unitsquare
+ withprescript "tx_number=" & decimal mfun_tt_n
+ withprescript "tx_stage=trial"
+ withprescript "tx_color=" & colordecimals colorpart mfun_tt_o
+ % begin of fmt specific
+ withprescript "tx_type=format"
+ for s = t :
+ if string s : withpostscript "s:" & s
+ elseif numeric s : withpostscript "n:" & decimal s
+ elseif boolean s : withpostscript "b:" & if s : "true" else : "false" fi
+ elseif pair s : hide(mfun_tt_z := s ; )
+ fi
+ endfor ;
+ % end of fmt specific
+ if not mfun_onetime_textext :
+ addto mfun_tt_p also mfun_tt_c
+ withprescript "tx_global=yes" ;
+ fi ;
+ else :
+ mfun_tt_b := lua.mp.tt_dimensions(mfun_tt_n) ;
+ addto mfun_tt_c doublepath unitsquare
+ xscaled redpart mfun_tt_b
+ yscaled (greenpart mfun_tt_b + bluepart mfun_tt_b)
+ shifted (0,- bluepart mfun_tt_b)
+ withprescript "tx_number=" & decimal mfun_tt_n
+ withprescript "tx_stage=final" ;
+ % begin of fmt specific
+ for s = t :
+ if pair s : mfun_tt_z := s ; fi
+ endfor ;
+ % end of fmt specific
+ fi ;
+ mfun_onetime_textext := false ;
+ mfun_tt_c
+enddef ;
+
+vardef thefmttext@#(text t) =
+ mfun_tt_z := origin ;
+ save p ; picture p ; p := rawfmttext(t) ;
+ p
+ if (mfun_labtype@# >= 10) :
+ shifted (0,ypart center p)
+ fi
+ shifted (mfun_tt_z + textextoffset*mfun_laboff@# - (mfun_labxf@#*lrcorner p + mfun_labyf@#*ulcorner p + (1-mfun_labxf@#-mfun_labyf@#)*llcorner p))
+enddef ;
+
+vardef fmttext@#(text t) = % no draw here
+ thefmttext@#(t,origin)
+enddef ;
+
+% or just: def fmttext = thefmttext enddef ;
+
+vardef onetimefmttext@#(text t) = % no draw here
+ mfun_onetime_textext := true ;
+ thefmttext@#(t,origin)
+enddef ;
+
+% so much for formatted text
+
vardef thetexbox@#(expr category, name, z) =
save p ; picture p ; p := rawtexbox(category,name) ;
p
@@ -1584,7 +1653,7 @@ vardef formatted(expr f, x) = textext(varfmt(f, x)) enddef ;
% def varfmt = formatted enddef ; % old
-def fmttext = lua.mp.formatted enddef ;
+% def fmttext = lua.mp.formatted enddef ;
% new
diff --git a/metapost/context/base/mpiv/mp-tool.mpiv b/metapost/context/base/mpiv/mp-tool.mpiv
index 220a7b6a9..01691724f 100644
--- a/metapost/context/base/mpiv/mp-tool.mpiv
+++ b/metapost/context/base/mpiv/mp-tool.mpiv
@@ -11,8 +11,6 @@
%C therefore copyrighted by \PRAGMA. See mreadme.pdf for
%C details.
-% def loadfile(expr name) = scantokens("input " & name & ";") enddef ;
-
if known context_tool : endinput ; fi ;
boolean context_tool ; context_tool := true ;
@@ -2833,4 +2831,145 @@ fulltriangle := point 0 along fullcircle
-- point 2/3 along fullcircle
-- cycle ;
+%D Kind of special and undocumented. On Wikipedia one can find examples
+%D of quick sort routines. Here we have a variant that permits a
+%D method.
+
+vardef listsize(suffix list) =
+ numeric len ; len := 0 ;
+ forever :
+ exitif unknown list[len+1] ;
+ len := len + 1 ;
+ endfor ;
+ len
+enddef ;
+
+vardef mfun_quick_sort(suffix list)(expr _min_, _max_)(text what) =
+ numeric l ; l := _min_ ;
+ numeric r ; r := _max_ ;
+ numeric m ; m := _min_ ;
+ numeric m ; m := floor(.5[_min_,_max_]) ;
+ _mid_ := what list[m] ;
+ forever :
+ exitif l >= r ;
+ forever :
+ exitif l > _max_ ;
+ % exitif (what list[l]) >= (what list[m]) ;
+ exitif (what list[l]) >= _mid_ ;
+ l := l + 1 ;
+ endfor ;
+ forever :
+ exitif r < _min_ ;
+ % exitif (what list[m]) >= (what list[r]) ;
+ exitif _mid_ >= (what list[r]) ;
+ r := r - 1 ;
+ endfor ;
+ if l <= r :
+ temp := list[l] ;
+ list[l] := list[r] ;
+ list[r] := temp ;
+ l := l + 1 ;
+ r := r - 1 ;
+ fi ;
+ endfor ;
+ if _min_ < r :
+ mfun_quick_sort(list)(_min_,r)(what) ;
+ fi ;
+ if l < _max_ :
+ mfun_quick_sort(list)(l,_max_)(what) ;
+ fi ;
+enddef ;
+
+vardef sortlist(suffix list)(text what) =
+ save _max_ ; numeric _max_ ; _max_ := listsize(list) ;
+ save _mid_ ; numeric _mid_ ;
+ save temp ;
+ if pair list[_max_] :
+ pair temp ;
+ else :
+ numeric temp ;
+ fi ;
+ if pair what list[_max_] :
+ pair _mid_ ;
+ else :
+ numeric _mid_ ;
+ fi ;
+ if _max_ > 1 :
+ mfun_quick_sort(list)(1,_max_)(what) ;
+ fi ;
+enddef ;
+
+vardef copylist(suffix list, target) =
+ save i ; i := 1 ;
+ forever :
+ exitif unknown list[i] ;
+ target[i] := list[i] ;
+ i := i + 1 ;
+ endfor ;
+enddef ;
+
+vardef listtolines(suffix list) =
+ list[1] for i=2 upto listsize(list) : -- list[i] endfor
+enddef ;
+
+vardef listtocurves(suffix list) =
+ list[1] for i=2 upto listsize(list) : .. list[i] endfor
+enddef ;
+
+%D The sorter is used in:
+
+vardef shaped (suffix p) = % takes a list of paths
+ save l ; pair l[] ;
+ save r ; pair r[] ;
+ save i ; i := 1 ;
+ save n ; n := 0 ;
+ forever :
+ exitif unknown p[i] ;
+ n := n + 1 ;
+ l[n] := ulcorner p[i] ;
+ r[n] := urcorner p[i] ;
+ n := n + 1 ;
+ l[n] := llcorner p[i] ;
+ r[n] := lrcorner p[i] ;
+ i := i + 1 ;
+ endfor ;
+ for i = 3 upto n :
+ if xpart r[i] < xpart r[i-1] :
+ r[i] := (xpart r[i],ypart r[i-1]) ;
+ elseif xpart r[i] > xpart r[i-1] :
+ r[i-1] := (xpart r[i-1],ypart r[i]) ;
+ fi ;
+ if xpart l[i] < xpart l[i-1] :
+ l[i-1] := (xpart l[i-1],ypart l[i]) ;
+ elseif xpart l[i] > xpart l[i-1] :
+ l[i] := (xpart l[i],ypart l[i-1]) ;
+ fi ;
+ endfor ;
+ if n > 0 :
+ simplified (
+ for i = 1 upto n : r[i] -- endfor
+ for i = n downto 1 : l[i] -- endfor
+ cycle
+ )
+ else :
+ origin -- cycle
+ fi
+enddef ;
+
+%D Dumping is fake anyway but let's keep this:
+
let dump = relax ;
+
+%D Loading modules can be done with:
+
+vardef loadmodule expr name =
+ % input can't be used directly in a macro
+ if unknown scantokens("context_" & name) :
+ save s ; string s ;
+ % s := "mp-" & name & ".mpiv" ;
+ % message("loading module",s) ;
+ % s := "input " & s ;
+ s := "input " & "mp-" & name & ".mpiv" ;
+ expandafter scantokens expandafter s
+ fi ;
+enddef ;