diff options
Diffstat (limited to 'Master')
21 files changed, 8109 insertions, 0 deletions
diff --git a/Master/texmf-dist/metafont/base/expr.mf b/Master/texmf-dist/metafont/base/expr.mf new file mode 100644 index 00000000000..fe05a01322f --- /dev/null +++ b/Master/texmf-dist/metafont/base/expr.mf @@ -0,0 +1,5 @@ +string s[]; s1="abra"; +path p[]; p1=(0,0)..(3,3); p2=(0,0)..(3,3)..cycle; +tracingonline:=1; scrollmode; +forever: message "gimme an expr: "; s0:=readstring; +show scantokens s0; endfor diff --git a/Master/texmf-dist/metafont/base/io.mf b/Master/texmf-dist/metafont/base/io.mf new file mode 100644 index 00000000000..58a8be68db2 --- /dev/null +++ b/Master/texmf-dist/metafont/base/io.mf @@ -0,0 +1,23 @@ +mode_setup; + em#:=10pt#; cap#:=7pt#; + thin#:=1/3pt#; thick#:=5/6pt#; + o#:=1/5pt#; +define_pixels(em,cap); +define_blacker_pixels(thin,thick); +define_corrected_pixels(o); + curve_sidebar=round 1/18em; +beginchar("O",0.8em#,cap#,0); "The letter O"; + penpos1(thick,10); penpos2(.1[thin,thick],90-10); + penpos3(thick,180+10); penpos4(thin,270-10); + x1l=w-x3l=curve_sidebar; x2=x4=.5w; + y1=.49h; y2l=-o; y3=.51h; y4l=h+o; + penstroke z1e{down}..z2e{right} + ..z3e{up}..z4e{left}..cycle; + penlabels(1,2,3,4); endchar; +def test_I(expr code,trial_stem,trial_width) = + stem#:=trial_stem*pt#; define_blacker_pixels(stem); + beginchar(code,trial_width*em#,cap#,0); "The letter I"; + penpos1(stem,15); penpos2(.9stem,12); penpos3(stem,10); + x1=x2=x3=.5w; y1=h; y2=.55h; y3=0; x2l:=1/6[x2l,x2]; + penstroke z1e..z2e{down}..z3e; + penlabels(1,2,3); endchar; enddef; diff --git a/Master/texmf-dist/metafont/base/mf.mf b/Master/texmf-dist/metafont/base/mf.mf new file mode 100644 index 00000000000..a5e6afb70a9 --- /dev/null +++ b/Master/texmf-dist/metafont/base/mf.mf @@ -0,0 +1,3 @@ +\input plain +\input modes +\dump diff --git a/Master/texmf-dist/metafont/base/null.mf b/Master/texmf-dist/metafont/base/null.mf new file mode 100644 index 00000000000..9828fbb16f7 --- /dev/null +++ b/Master/texmf-dist/metafont/base/null.mf @@ -0,0 +1,3 @@ +% This is an empty METAFONT source file. Why do you want it? Because if +% mf says `Please type another input file name:' and if you don't have one +% in mind, you can just say `null' and METAFONT will get out of its loop. diff --git a/Master/texmf-dist/metafont/base/plain.mf b/Master/texmf-dist/metafont/base/plain.mf new file mode 100644 index 00000000000..0a3369afc9e --- /dev/null +++ b/Master/texmf-dist/metafont/base/plain.mf @@ -0,0 +1,595 @@ +% This is the plain METAFONT base that's described in The METAFONTbook. +% N.B.: Please change "base_version" whenever this file is modified! +% And don't modify the file unless you change its name: +% Everybody's "plain.mf" file should be the same, worldwide. + +% Unlimited copying and redistribution of this file are permitted as long +% as this file is not modified. Modifications are permitted, but only if +% the resulting file is not named plain.mf. + +string base_name, base_version; base_name="plain"; base_version="2.71"; + +message "Preloading the plain base, version "&base_version&": preliminaries,"; + +delimiters (); % this makes parentheses behave like parentheses +def upto = step 1 until enddef; % syntactic sugar +def downto = step -1 until enddef; +def exitunless expr c = exitif not c enddef; +let relax = \; % ignore the word `relax', as in TeX +let \\ = \; % double relaxation is like single +def ]] = ] ] enddef; % right brackets should be loners +def -- = {curl 1}..{curl 1} enddef; +def --- = .. tension infinity .. enddef; +def ... = .. tension atleast 1 .. enddef; + +def gobble primary g = enddef; def killtext text t = enddef; +primarydef g gobbled gg = enddef; +def hide(text t) = exitif numeric begingroup t;endgroup; enddef; +def ??? = hide(interim showstopping:=1; showdependencies) enddef; +def stop expr s = message s; gobble readstring enddef; + +smoothing:=1; autorounding:=2; % this adjusts curves to the raster +turningcheck:=2; % this will warn about a "strange path" +granularity:=1; % this says that pixels are pixels + +def interact = % sets up to make "show" commands stop + hide(showstopping:=1; tracingonline:=1) enddef; + +def loggingall = % puts tracing info into the log + tracingcommands:=3; tracingedges:=2; tracingtitles:=1; tracingequations:=1; + tracingcapsules:=1; tracingspecs:=1; tracingpens:=1; tracingchoices:=1; + tracingstats:=1; tracingoutput:=1; tracingmacros:=1; tracingrestores:=1; + enddef; + +def tracingall = % turns on every form of tracing + tracingonline:=1; showstopping:=1; loggingall enddef; + +def tracingnone = % turns off every form of tracing + tracingcommands:=0; tracingonline:=0; showstopping:=0; + tracingedges:=0; tracingtitles:=0; tracingequations:=0; + tracingcapsules:=0; tracingspecs:=0; tracingpens:=0; tracingchoices:=0; + tracingstats:=0; tracingoutput:=0; tracingmacros:=0; tracingrestores:=0; + enddef; + +message " basic constants and mathematical macros,"; + +% numeric constants +newinternal eps,epsilon,infinity,_; +eps := .00049; % this is a pretty small positive number +epsilon := 1/256/256; % but this is the smallest +infinity := 4095.99998; % and this is the largest +_ := -1; % internal constant to make macros unreadable but shorter + +% pair constants +pair right,left,up,down,origin; +origin=(0,0); up=-down=(0,1); right=-left=(1,0); + +% path constants +path quartercircle,halfcircle,fullcircle,unitsquare; +quartercircle=(right{up}..(right+up)/sqrt2..up{left}) scaled .5; +halfcircle=quartercircle & quartercircle rotated 90; +fullcircle=halfcircle & halfcircle rotated 180 & cycle; +unitsquare=(0,0)--(1,0)--(1,1)--(0,1)--cycle; + +% transform constants +transform identity; +for z=origin,right,up: z transformed identity = z; endfor + +% picture constants +picture blankpicture,unitpixel; +blankpicture=nullpicture; % `display blankpicture...' +unitpixel=nullpicture; addto unitpixel contour unitsquare; + +% string constants +string ditto; ditto = char 34; % ASCII double-quote mark + +% pen constants +def capsule_def(suffix s) primary u = def s = u enddef enddef; +capsule_def(pensquare) makepen(unitsquare shifted -(.5,.5)); +capsule_def(penrazor) makepen((-.5,0)--(.5,0)--cycle); +pen penspeck; penspeck=pensquare scaled eps; + +% nullary operators +vardef whatever = save ?; ? enddef; + +% unary operators +let abs = length; + +vardef round primary u = + if numeric u: floor(u+.5) + elseif pair u: (hround xpart u, vround ypart u) + else: u fi enddef; + +vardef hround primary x = floor(x+.5) enddef; +vardef vround primary y = floor(y.o_+.5)_o_ enddef; + +vardef ceiling primary x = -floor(-x) enddef; + +vardef byte primary s = + if string s: ASCII fi s enddef; + +vardef dir primary d = right rotated d enddef; + +vardef unitvector primary z = z/abs z enddef; + +vardef inverse primary T = + transform T_; T_ transformed T = identity; T_ enddef; + +vardef counterclockwise primary c = + if turningcheck>0: + interim autorounding:=0; + if turningnumber c <= 0: reverse fi fi c enddef; + +vardef tensepath expr r = + for k=0 upto length r - 1: point k of r --- endfor + if cycle r: cycle else: point infinity of r fi enddef; + +% binary operators + +primarydef x mod y = (x-y*floor(x/y)) enddef; +primarydef x div y = floor(x/y) enddef; +primarydef w dotprod z = (xpart w * xpart z + ypart w * ypart z) enddef; + +primarydef x**y = if y=2: x*x else: takepower y of x fi enddef; +def takepower expr y of x = + if x>0: mexp(y*mlog x) + elseif (x=0) and (y>0): 0 + else: 1 + if y=floor y: + if y>=0: for n=1 upto y: *x endfor + else: for n=_ downto y: /x endfor + fi + else: hide(errmessage "Undefined power: " & decimal x&"**"&decimal y) + fi fi enddef; + +vardef direction expr t of p = + postcontrol t of p - precontrol t of p enddef; + +vardef directionpoint expr z of p = + a_:=directiontime z of p; + if a_<0: errmessage("The direction doesn't occur"); fi + point a_ of p enddef; + +secondarydef p intersectionpoint q = + begingroup save x_,y_; (x_,y_)=p intersectiontimes q; + if x_<0: errmessage("The paths don't intersect"); origin + else: .5[point x_ of p, point y_ of q] fi endgroup +enddef; + +tertiarydef p softjoin q = + begingroup c_:=fullcircle scaled 2join_radius shifted point 0 of q; + a_:=ypart(c_ intersectiontimes p); b_:=ypart(c_ intersectiontimes q); + if a_<0:point 0 of p{direction 0 of p} else: subpath(0,a_) of p fi + ... if b_<0:{direction infinity of q}point infinity of q + else: subpath(b_,infinity) of q fi endgroup enddef; +newinternal join_radius,a_,b_; path c_; + +% special operators +vardef incr suffix $ = $:=$+1; $ enddef; +vardef decr suffix $ = $:=$-1; $ enddef; + +def reflectedabout(expr w,z) = % reflects about the line w..z + transformed + begingroup transform T_; + w transformed T_ = w; z transformed T_ = z; + xxpart T_ = -yypart T_; xypart T_ = yxpart T_; % T_ is a reflection + T_ endgroup enddef; + +def rotatedaround(expr z, d) = % rotates d degrees around z + shifted -z rotated d shifted z enddef; +let rotatedabout = rotatedaround; % for roundabout people + +vardef min(expr u)(text t) = % t is a list of numerics, pairs, or strings + save u_; setu_ u; for uu = t: if uu<u_: u_:=uu; fi endfor + u_ enddef; + +vardef max(expr u)(text t) = % t is a list of numerics, pairs, or strings + save u_; setu_ u; for uu = t: if uu>u_: u_:=uu; fi endfor + u_ enddef; + +def setu_ primary u = + if pair u: pair u_ elseif string u: string u_ fi; + u_=u enddef; + +def flex(text t) = % t is a list of pairs + hide(n_:=0; for z=t: z_[incr n_]:=z; endfor + dz_:=z_[n_]-z_1) + z_1 for k=2 upto n_-1: ...z_[k]{dz_} endfor ...z_[n_] enddef; +newinternal n_; pair z_[],dz_; + +def superellipse(expr r,t,l,b,s)= + r{up}...(s[xpart t,xpart r],s[ypart r,ypart t]){t-r}... + t{left}...(s[xpart t,xpart l],s[ypart l,ypart t]){l-t}... + l{down}...(s[xpart b,xpart l],s[ypart l,ypart b]){b-l}... + b{right}...(s[xpart b,xpart r],s[ypart r,ypart b]){r-b}...cycle enddef; + +vardef interpath(expr a,p,q) = + for t=0 upto length p-1: a[point t of p, point t of q] + ..controls a[postcontrol t of p, postcontrol t of q] + and a[precontrol t+1 of p, precontrol t+1 of q] .. endfor + if cycle p: cycle + else: a[point infinity of p, point infinity of q] fi enddef; + +vardef solve@#(expr true_x,false_x)= % @#(true_x)=true, @#(false_x)=false + tx_:=true_x; fx_:=false_x; + forever: x_:=.5[tx_,fx_]; exitif abs(tx_-fx_)<=tolerance; + if @#(x_): tx_ else: fx_ fi :=x_; endfor + x_ enddef; % now x_ is near where @# changes from true to false +newinternal tolerance, tx_,fx_,x_; tolerance:=.1; + +message " macros for converting from device-independent units to pixels,"; + +def fix_units = % define the conversion factors, given pixels_per_inch + mm:=pixels_per_inch/25.4; cm:=pixels_per_inch/2.54; + pt:=pixels_per_inch/72.27; pc:=pixels_per_inch/6.0225; + dd:=1238/1157pt; cc:=12dd; + bp:=pixels_per_inch/72; in:=pixels_per_inch; + hppp:=pt; % horizontal pixels per point + vppp:=aspect_ratio*hppp; % vertical pixels per point + enddef; + +mm#=2.84528; pt#=1; dd#=1.07001; bp#=1.00375; +cm#=28.45276; pc#=12; cc#=12.84010; in#=72.27; + +newinternal pixels_per_inch; % the given resolution +newinternal blacker, o_correction; % device-oriented corrections + +def define_pixels(text t) = + forsuffixes $=t: $:=$.#*hppp; endfor enddef; +def define_whole_pixels(text t) = + forsuffixes $=t: $:=hround($.#*hppp); endfor enddef; +def define_whole_vertical_pixels(text t) = + forsuffixes $=t: $:=vround($.#*hppp); endfor enddef; +def define_good_x_pixels(text t) = + forsuffixes $=t: $:=good.x($.#*hppp); endfor enddef; +def define_good_y_pixels(text t) = + forsuffixes $=t: $:=good.y($.#*hppp); endfor enddef; +def define_blacker_pixels(text t) = + forsuffixes $=t: $:=$.#*hppp+blacker; endfor enddef; +def define_whole_blacker_pixels(text t) = + forsuffixes $=t: $:=hround($.#*hppp+blacker); + if $<=0: $:=1; fi endfor enddef; +def define_whole_vertical_blacker_pixels(text t) = + forsuffixes $=t: $:=vround($.#*hppp+blacker); + if $<=0: $:=1_o_; fi endfor enddef; +def define_corrected_pixels(text t) = + forsuffixes $=t: $:=vround($.#*hppp*o_correction)+eps; endfor enddef; +def define_horizontal_corrected_pixels(text t) = + forsuffixes $=t: $:=hround($.#*hppp*o_correction)+eps; endfor enddef; + +def lowres_fix(text t) expr ratio = + begingroup save min,max,first; + forsuffixes $=t: if unknown min: min=max=first=$; min#=max#=$.#; + elseif $.#<min#: min:=$; min#:=$.#; + elseif $.#>max#: max:=$; max#:=$.#; fi endfor + if max/min>ratio*max#/min#: forsuffixes $=t: $:=first; endfor fi + endgroup enddef; + +message " macros and tables for various modes of operation,"; + +def mode_setup = + warningcheck:=0; + if unknown mode: mode=proof; fi + numeric aspect_ratio; transform currenttransform; + scantokens if string mode:("input "&mode) else: mode_name[mode] fi; + if unknown mag: mag=1; fi + if unknown aspect_ratio: aspect_ratio=1; fi + displaying:=proofing; + pixels_per_inch:=pixels_per_inch*mag; + if aspect_ratio=1: let o_=\; let _o_=\ + else: def o_=*aspect_ratio enddef; def _o_=/aspect_ratio enddef fi; + fix_units; + scantokens extra_setup; % the user's special last-minute adjustments + currenttransform:= + if unknown currenttransform: identity else: currenttransform fi + yscaled aspect_ratio; + clearit; + pickup pencircle scaled (.4pt+blacker); + warningcheck:=1; enddef; +def smode = string mode; mode enddef; +string extra_setup, mode_name[]; +extra_setup=""; % usually there's nothing special to do +newinternal displaying; % if positive, endchar will `showit' + +vardef magstep primary m = mexp(46.67432m) enddef; + +def mode_def suffix $ = + $:=incr number_of_modes; + mode_name[$]:=str$ & "_"; + expandafter quote def scantokens mode_name[$] enddef; +newinternal number_of_modes; + +% proof mode: for initial design of characters +mode_def proof = + proofing:=2; % yes, we're making full proofs + fontmaking:=0; % no, we're not making a font + tracingtitles:=1; % yes, show titles online + pixels_per_inch:=2601.72; % that's 36 pixels per pt + blacker:=0; % no additional blackness + fillin:=0; % no compensation for fillin + o_correction:=1; % no reduction in overshoot + enddef; + +% smoke mode: for label-free proofs to mount on the wall +mode_def smoke = + proof_; % same as proof mode, except: + proofing:=1; % yes, we're making unlabeled proofs + extra_setup:=extra_setup&"grayfont black"; % with solid black pixels + let makebox=maketicks; % make the boxes less obtrusive + enddef; + +% lowres mode: for certain devices that print 200 pixels per inch +mode_def lowres = + proofing:=0; % no, we're not making proofs + fontmaking:=1; % yes, we are making a font + tracingtitles:=0; % no, don't show titles at all + pixels_per_inch:=200; % that's the meaning of lowres + blacker:=.65; % make pens a bit blacker + fillin:=.2; % compensate for diagonal fillin + o_correction:=.4; % but don't overshoot as much + enddef; + +localfont:=lowres; % the mode most commonly used to make fonts + +% It is customary to input another file to supplement the PLAIN base. +% This supplementary file adds analogous modes, corresponding to +% local output devices, and it redefines `localfont' as appropriate. +% The values of screen_rows and screen_cols should also be updated. +% The auxiliary file should set base_version:=base_version&"/localname". +% Remember that the present file PLAIN.MF should not be changed; +% all local changes should be confined to a separate file. + +message " macros for drawing and filling,"; + +pen currentpen; +path currentpen_path; +picture currentpicture; +transform currenttransform; +def t_ = transformed currenttransform enddef; + +def fill expr c = addto_currentpicture contour c.t_ enddef; +def addto_currentpicture = addto currentpicture enddef; +def draw expr p = + addto_currentpicture doublepath p.t_ withpen currentpen enddef; +def filldraw expr c = fill counterclockwise c withpen currentpen enddef; +def drawdot expr z = if unknown currentpen_path: def_pen_path_ fi + addto_currentpicture contour + currentpen_path shifted (z.t_) withpen penspeck enddef; +def def_pen_path_ = + hide(currentpen_path=tensepath makepath currentpen) enddef; + +def unfill expr c = fill c withweight _ enddef; +def undraw expr p = draw p withweight _ enddef; +def unfilldraw expr c = filldraw c withweight _ enddef; +def undrawdot expr z = drawdot z withweight _ enddef; +def erase text t = begingroup interim default_wt_:=_; + cullit; t withweight _; cullit; endgroup enddef; +newinternal default_wt_; default_wt_:=1; + +def cutdraw expr p = % caution: you may need autorounding=0 + cutoff(point 0 of p, 180+angle direction 0 of p); + cutoff(point infinity of p, angle direction infinity of p); + culldraw p enddef; +def culldraw expr p = addto pic_ doublepath p.t_ withpen currentpen; + cull pic_ dropping(-infinity,0) withweight default_wt_; + addto_currentpicture also pic_; pic_:=nullpicture; killtext enddef; +vardef cutoff(expr z,theta) = + interim autorounding := 0; interim smoothing := 0; + addto pic_ doublepath z.t_ withpen currentpen; + addto pic_ contour + (cut_ scaled (1+max(-pen_lft,pen_rt,pen_top,-pen_bot)) + rotated theta shifted z)t_; + cull pic_ keeping (2,2) withweight -default_wt_; + addto currentpicture also pic_; + pic_:=nullpicture enddef; +picture pic_; pic_:=nullpicture; +path cut_; cut_ = ((0,_)--(1,_)--(1,1)--(0,1)--cycle) scaled 1.42; + +def pickup secondary q = + if numeric q: numeric_pickup_ else: pen_pickup_ fi q enddef; +def numeric_pickup_ primary q = + if unknown pen_[q]: errmessage "Unknown pen"; clearpen + else: currentpen:=pen_[q]; + pen_lft:=pen_lft_[q]; + pen_rt:=pen_rt_[q]; + pen_top:=pen_top_[q]; + pen_bot:=pen_bot_[q]; + currentpen_path:=pen_path_[q] fi; enddef; +def pen_pickup_ primary q = + currentpen:=q yscaled aspect_ratio; + pen_lft:=xpart penoffset down of currentpen; + pen_rt:=xpart penoffset up of currentpen; + pen_top:=(ypart penoffset left of currentpen)_o_; + pen_bot:=(ypart penoffset right of currentpen)_o_; + path currentpen_path; enddef; +newinternal pen_lft,pen_rt,pen_top,pen_bot,pen_count_; + +vardef savepen = pen_[incr pen_count_]=currentpen; + pen_lft_[pen_count_]=pen_lft; + pen_rt_[pen_count_]=pen_rt; + pen_top_[pen_count_]=pen_top; + pen_bot_[pen_count_]=pen_bot; + pen_path_[pen_count_]=currentpen_path; + pen_count_ enddef; + +def clearpen = currentpen:=nullpen; + pen_lft:=pen_rt:=pen_top:=pen_bot:=0; + path currentpen_path; + enddef; +def clear_pen_memory = + pen_count_:=0; + numeric pen_lft_[],pen_rt_[],pen_top_[],pen_bot_[]; + pen currentpen,pen_[]; + path currentpen_path, pen_path_[]; + enddef; + +vardef lft primary x = x + if pair x: (pen_lft,0) else: pen_lft fi enddef; +vardef rt primary x = x + if pair x: (pen_rt,0) else: pen_rt fi enddef; +vardef top primary y = y + if pair y: (0,pen_top) else: pen_top fi enddef; +vardef bot primary y = y + if pair y: (0,pen_bot) else: pen_bot fi enddef; +vardef good.x primary x = hround(x+pen_lft)-pen_lft enddef; +vardef good.y primary y = vround(y+pen_top)-pen_top enddef; +vardef good.lft primary z = save z_; pair z_; + (z_+(pen_lft,0))t_=round((z+(pen_lft,0))t_); z_ enddef; +vardef good.rt primary z = save z_; pair z_; + (z_+(pen_rt,0))t_=round((z+(pen_rt,0))t_); z_ enddef; +vardef good.top primary z = save z_; pair z_; + (z_+(0,pen_top))t_=round((z+(0,pen_top))t_); z_ enddef; +vardef good.bot primary z = save z_; pair z_; + (z_+(0,pen_bot))t_=round((z+(0,pen_bot))t_); z_ enddef; + +vardef penpos@#(expr b,d) = + (x@#r-x@#l,y@#r-y@#l)=(b,0) rotated d; + x@#=.5(x@#l+x@#r); y@#=.5(y@#l+y@#r) enddef; + +def penstroke text t = + forsuffixes e = l,r: path_.e:=t; endfor + if cycle path_.l: cyclestroke_ + else: fill path_.l -- reverse path_.r -- cycle fi enddef; +def cyclestroke_ = + begingroup interim turningcheck:=0; + addto pic_ contour path_.l.t_ withweight 1; + addto pic_ contour path_.r.t_ withweight _; + cull pic_ dropping origin withweight default_wt_; + addto_currentpicture also pic_; + pic_:=nullpicture endgroup enddef; +path path_.l,path_.r; + +message " macros for proof labels and rules,"; + +vardef makelabel@#(expr s,z) = % puts string s at point z + if known z: special lcode_@# & s; + numspecial xpart(z.t_); numspecial ypart(z.t_) fi enddef; +string lcode_,lcode_.top,lcode_.lft,lcode_.rt,lcode_.bot, + lcode_.top.nodot,lcode_.lft.nodot,lcode_.rt.nodot,lcode_.bot.nodot; +lcode_.top=" 1"; lcode_.lft=" 2"; lcode_.rt=" 3"; lcode_.bot=" 4"; +lcode_=" 0"; % change to " /" to avoid listing in overflow column +lcode_.top.nodot=" 5"; lcode_.lft.nodot=" 6"; +lcode_.rt.nodot=" 7"; lcode_.bot.nodot=" 8"; + +vardef labels@#(text t) = + if proofing>1: forsuffixes $=t: + makelabel@#(str$,z$); endfor + fi enddef; +vardef penlabels@#(text t) = + if proofing>1: forsuffixes $$=l,,r: forsuffixes $=t: + makelabel@#(str$.$$,z$.$$); endfor endfor + fi enddef; + +def range expr x = numtok[x] enddef; +def numtok suffix x=x enddef; +tertiarydef m thru n = + m for x=m+1 step 1 until n: , numtok[x] endfor enddef; + +def proofrule(expr w,z) = + special "rule"; numspecial xpart w; numspecial ypart w; + numspecial xpart z; numspecial ypart z enddef; +def screenrule(expr w,z) = + addto currentpicture doublepath w--z withpen rulepen enddef; +pen rulepen; rulepen = pensquare scaled 2; + +def makegrid(text xlist,ylist) = + xmin_ := min(xlist); xmax_ := max(xlist); + ymin_ := min(ylist); ymax_ := max(ylist); + for x=xlist: proofrule((x,ymin_), (x,ymax_)); endfor + for y=ylist: proofrule((xmin_,y), (xmax_,y)); endfor + enddef; + +vardef titlefont suffix $ = special "titlefont "&str$ enddef; +vardef labelfont suffix $ = special "labelfont "&str$ enddef; +vardef grayfont suffix $ = special "grayfont "&str$ enddef; +vardef slantfont suffix $ = special "slantfont "&str$ enddef; +def proofoffset primary z = % shifts proof output by z + special "offset"; numspecial xpart z; numspecial ypart z enddef; +vardef proofrulethickness expr x = + special "rulethickness"; numspecial x enddef; + +message " macros for character and font administration,"; + +def beginchar(expr c,w_sharp,h_sharp,d_sharp) = + begingroup + charcode:=if known c: byte c else: 0 fi; + charwd:=w_sharp; charht:=h_sharp; chardp:=d_sharp; + w:=hround(charwd*hppp); h:=vround(charht*hppp); d:=vround(chardp*hppp); + charic:=0; clearxy; clearit; clearpen; scantokens extra_beginchar; + enddef; + +def italcorr expr x_sharp = if x_sharp>0: charic:=x_sharp fi enddef; + +def change_width = + w:=w if w>charwd*hppp:- else:+ fi 1 enddef; + +def endchar = + scantokens extra_endchar; + if proofing>0: makebox(proofrule); fi + chardx:=w; % desired width of the character in pixels + shipit; + if displaying>0: makebox(screenrule); showit; fi + endgroup enddef; + +string extra_beginchar, extra_endchar; +extra_beginchar=extra_endchar=""; + +def makebox(text r) = + for y=0,h.o_,-d.o_: r((0,y),(w,y)); endfor % horizontals + for x=0,w: r((x,-d.o_),(x,h.o_)); endfor % verticals + if charic<>0: r((w+charic*hppp,h.o_),(w+charic*hppp,.5h.o_)); fi + enddef; + +def maketicks(text r) = + for y=0,h.o_,-d.o_: r((0,y),(10,y)); r((w-10,y),(w,y)); endfor + for x=0,w: r((x,10-d.o_),(x,-d.o_)); r((x,h.o_-10),(x,h.o_)); endfor + if charic<>0: r((w+charic*hppp,h.o_-10),(w+charic*hppp,h.o_)); fi + enddef; + +def font_size expr x = designsize:=x enddef; +def font_slant expr x = fontdimen 1: x enddef; +def font_normal_space expr x = fontdimen 2: x enddef; +def font_normal_stretch expr x = fontdimen 3: x enddef; +def font_normal_shrink expr x = fontdimen 4: x enddef; +def font_x_height expr x = fontdimen 5: x enddef; +def font_quad expr x = fontdimen 6: x enddef; +def font_extra_space expr x = fontdimen 7: x enddef; + +def font_identifier expr x = font_identifier_:=x enddef; +def font_coding_scheme expr x = font_coding_scheme_:=x enddef; +string font_identifier_, font_coding_scheme_; +font_identifier_=font_coding_scheme_="UNSPECIFIED"; + +message "and a few last-minute items."; + +vardef z@#=(x@#,y@#) enddef; + +newinternal screen_rows, screen_cols, currentwindow; +screen_rows:=400; % these values should be corrected, +screen_cols:=500; % by reading in a separate file after PLAIN.MF + +def openit = openwindow currentwindow + from origin to (screen_rows,screen_cols) at (-50,300) enddef; +def showit = openit; let showit=showit_; showit enddef; % first time only +def showit_ = display currentpicture inwindow currentwindow enddef; + +def clearxy = save x,y enddef; +def clearit = currentpicture:=nullpicture enddef; +def shipit = shipout currentpicture enddef; +def cullit = cull currentpicture dropping (-infinity,0) enddef; + +def screenchars = % endchar should `showit' + extra_endchar:=extra_endchar&"showit;" enddef; +def screenstrokes = % every stroke should `showit' + def addto_currentpicture text t= + addto currentpicture t; showit enddef; enddef; +def imagerules = % a box should be part of the character image + extra_beginchar:=extra_beginchar & "makebox(screenrule);" enddef; +def gfcorners = % `maketicks' should send rules to the GF file + extra_setup:=extra_setup & "let makebox=maketicks;proofing:=1;" enddef; +def nodisplays = % endchar shouldn't `showit' + extra_setup:=extra_setup & "displaying:=0;" enddef; +def notransforms = % currenttransform should not be used + let t_ = \ enddef; + +let bye = end; outer end,bye; + +clear_pen_memory; % initialize the `savepen' mechanism +mode_setup; % establish proof mode as the default +numeric mode,mag; % but leave mode and mag undefined diff --git a/Master/texmf-dist/metafont/config/cmmf.ini b/Master/texmf-dist/metafont/config/cmmf.ini new file mode 100644 index 00000000000..0e697dd1627 --- /dev/null +++ b/Master/texmf-dist/metafont/config/cmmf.ini @@ -0,0 +1,6 @@ +% Thomas Esser, 1998. public domain. +\input plain +\input modes +\input cmbase +\dump +\endinput diff --git a/Master/texmf-dist/metafont/config/mf.ini b/Master/texmf-dist/metafont/config/mf.ini new file mode 100644 index 00000000000..8496d4c8b1e --- /dev/null +++ b/Master/texmf-dist/metafont/config/mf.ini @@ -0,0 +1,5 @@ +% Thomas Esser, 1998. public domain. +\input plain +\input modes +\dump +\endinput diff --git a/Master/texmf-dist/metafont/feynmf/feynmf.mf b/Master/texmf-dist/metafont/feynmf/feynmf.mf new file mode 100644 index 00000000000..ef6ade4fe69 --- /dev/null +++ b/Master/texmf-dist/metafont/feynmf/feynmf.mf @@ -0,0 +1,1981 @@ +%% +%% This is file `feynmf.mf', +%% generated with the docstrip utility. +%% +%% The original source files were: +%% +%% feynmf.dtx (with options: `base') +%% +%% Copyright (C) 1989, 1990, 1992-1995 by Thorsten.Ohl@Physik.TH-Darmstadt.de +%% +%% This file is NOT the source for feynmf, because almost all comments +%% have been stripped from it. It is NOT the preferred form of feynmf +%% for making modifications to it. +%% +%% Therefore you can NOT redistribute and/or modify THIS file. You can +%% however redistribute the complete source (feynmf.dtx and feynmf.ins) +%% and/or modify it under the terms of the GNU General Public License as +%% published by the Free Software Foundation; either version 2, or (at +%% your option) any later version. +%% +%% As a special exception, you can redistribute parts of this file for +%% the electronic distribution of scientific papers, provided that you +%% include a short note pointing to the complete source. +%% +%% Feynmf is distributed in the hope that it will be useful, but +%% WITHOUT ANY WARRANTY; without even the implied warranty of +%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +%% GNU General Public License for more details. +%% +%% You should have received a copy of the GNU General Public License +%% along with this program; if not, write to the Free Software +%% Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% \CheckSum{924} +%% \CharacterTable +%% {Upper-case \A\B\C\D\E\F\G\H\I\J\K\L\M\N\O\P\Q\R\S\T\U\V\W\X\Y\Z +%% Lower-case \a\b\c\d\e\f\g\h\i\j\k\l\m\n\o\p\q\r\s\t\u\v\w\x\y\z +%% Digits \0\1\2\3\4\5\6\7\8\9 +%% Exclamation \! Double quote \" Hash (number) \# +%% Dollar \$ Percent \% Ampersand \& +%% Acute accent \' Left paren \( Right paren \) +%% Asterisk \* Plus \+ Comma \, +%% Minus \- Point \. Solidus \/ +%% Colon \: Semicolon \; Less than \< +%% Equals \= Greater than \> Question mark \? +%% Commercial at \@ Left bracket \[ Backslash \\ +%% Right bracket \] Circumflex \^ Underscore \_ +%% Grave accent \` Left brace \{ Vertical bar \| +%% Right brace \} Tilde \~} +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +def subgraph (expr x, y, wd, ht) = + begingroup + save c, ne, nw, sw, se; + pair c, ne, nw, sw, se; + sw = (x,y); + se = sw + (wd,0); + nw = sw + (0,ht); + ne = sw + (wd,ht); + c = .5[sw,ne]; +enddef; +def endsubgraph = + endgroup +enddef; +if known cmbase: + errhelp + "feynmf will only work with plain Metafont, as described in the book."; + errmessage "feynmf: CMBASE detected. Please use the PLAIN base."; + forever: + errmessage "No use in trying! You'd better eXit now ..."; + errorstopmode; + endfor +fi +vardef parse_RCS (suffix RCS) (expr s) = + save n, c; + numeric n, RCS[]; + string c; + RCS[0] := 0; + for n = 1 upto length (s): + c := substring (n-1,n) of s; + exitif ((RCS[0] > 0) and (c = " ")); + if ((c = "0") or (c = "1") or (c = "2") + or (c = "3") or (c = "4") or (c = "5") + or (c = "6") or (c = "7") or (c = "8") + or (c = "9")): + if RCS[0] = 0: + RCS[0] := 1; + RCS[RCS[0]] := 0; + fi + RCS[RCS[0]] := 10 * RCS[RCS[0]] + scantokens (c); + elseif c = ".": + RCS[0] := RCS[0] + 1; + RCS[RCS[0]] := 0; + else: + fi + endfor +enddef; +vardef require_RCS_revision expr s = + save n, TeX_rev, mf_rev; + numeric n; + parse_RCS (TeX_rev, s); + parse_RCS (mf_rev, "$Revision: 1.30 $"); + for n = 1 upto min (2, TeX_rev[0], mf_rev[0]): + if TeX_rev[n] > mf_rev[n]: + errhelp + "Your version of `feynmf.sty' is higher that of your `feynmf.mf'."; + errmessage "feynmf: Metafont macros out of date"; + elseif TeX_rev[n] < mf_rev[n]: + errhelp + "Your version of `feynmf.mf' is higher that of your `feynmf.sty'."; + errmessage "feynmf: LaTeX style out of date"; + fi + exitif (TeX_rev[n] <> mf_rev[n]); + endfor +enddef; +mode_setup; +boolean feynmfwizard; +feynmfwizard := false; +thin# := 1pt#; % dimension of the lines +thick# := 2thin#; +arrow_len# := 4mm#; +arrow_ang := 15; +curly_len# := 3mm#; +dash_len# := 3mm#; % 'photon' lines +dot_len# := 2mm#; % 'photon' lines +wiggly_len# := 4mm#; % 'photon' lines +wiggly_slope := 60; +zigzag_len# := 2mm#; +zigzag_width# := 2thick#; +decor_size# := 5mm#; +dot_size# := 2thick#; +define_blacker_pixels (thick, thin, + dash_len, dot_len, wiggly_len, curly_len, + zigzag_len, zigzag_width, arrow_len, decor_size, dot_size); +def shrink expr s = + begingroup + if shrinkables <> "": + save tmp_; + forsuffixes $ = scantokens shrinkables: + if known $.#: + tmp_ := $.#; + save $; + $.# := s * tmp_; + define_blacker_pixels ($); + else: + tmp_ := $; + save $; + $ := s * tmp_; + fi + endfor + fi +enddef; +def endshrink = + endgroup +enddef; +string shrinkables; +shrinkables := ""; +vardef addto_shrinkables (text l) = + forsuffixes $ = l: + shrinkables := shrinkables & "," & str $; + endfor +enddef; +shrinkables := "thick,thin"; +addto_shrinkables (dash_len, dot_len); +addto_shrinkables (wiggly_len, curly_len); +addto_shrinkables (zigzag_len, zigzag_width); +addto_shrinkables (arrow_len); +addto_shrinkables (decor_size, dot_size); +LaTeX_unitlength := mm; +vardef count (text list) = + forsuffixes $ = list: + 1 endfor +enddef; +vardef getopt (suffix opt) (expr s) = + save n, argp, escape, anchor, skip; + numeric opt.first, opt.last, n, anchor; + string opt[], opt[]arg; + boolean opt[]tainted, argp, escape, skip; + opt.first := 0; + opt.last := 0; + opt[opt.last] := ""; + argp := false; + escape := false; + anchor := 0; + skip := true; + for n = 1 upto length (s): + if skip and (substring (n-1, n) of s = " "): + anchor := anchor + 1; + else: + skip := false; + if not escape and (substring (n-1, n) of s = ","): + if substring (n, n+1) of s = ",": + escape := true; + opt[opt.last]tainted := true; + else: + if argp: + opt[opt.last]arg := substring (anchor, n-1) of s; + else: + opt[opt.last] := substring (anchor, n-1) of s; + fi + anchor := n; + argp := false; + skip := true; + opt.last := opt.last + 1; + fi + elseif not argp and (substring (n-1, n) of s = "="): + opt[opt.last] := substring (anchor, n-1) of s; + anchor := n; + argp := true; + skip := true; + elseif argp or (substring (n-1, n) of s <> " "): + escape := false; + fi + fi + endfor + if argp: + opt[opt.last]arg := substring (anchor, length s) of s; + else: + opt[opt.last] := substring (anchor, length s) of s; + fi + for n = opt.first upto opt.last: + if known opt[n]tainted: + if opt[n]tainted: + opt[n]arg := untaint_string opt[n]arg; + fi + fi + endfor +enddef; +vardef untaint_string suffix s = + save n, anchor; + numeric n, anchor; + anchor := 0; + for n = 1 upto length (s) - 1: + if substring (n-1,n+1) of s = ",,": + substring (anchor, n-1) of s & + hide (anchor := n) + fi + endfor + substring (anchor, length s) of s +enddef; +vardef split_string (suffix comp) (expr s) = + save n, anchor; + numeric comp.first, comp.last, n, anchor; + string comp[]; + comp.first := 0; + comp.last := 0; + comp[comp.last] := ""; + anchor := 0; + for n = 1 upto length (s): + if substring (n-1,n) of s = ".": + comp[comp.last] := substring (anchor, n-1) of s; + comp.last := comp.last + 1; + anchor := n; + fi + endfor + comp[comp.last] := substring (anchor, length s) of s; +enddef; +vardef match_prefix (expr prefix, s) = + (prefix = substring (0, length prefix) of s) +enddef; +vardef match_option (expr s, option) = + save sc, optionc, n, i; + numeric sc.first, sc.last, optionc.first, optionc.last; + string sc[], optionc[]; + numeric n, i; + split_string (sc, s); + split_string (optionc, option); + n := sc.last - sc.first; + if n <> (optionc.last - optionc.first): + false + else: + true + for i = 0 upto n: + and match_prefix (sc[sc.first+i], + optionc[optionc.first+i]) + endfor + fi +enddef; +def save_picture text t = + save t; picture t; forsuffixes p=t: p:=nullpicture; endfor +enddef; +def begin_sketch = + begingroup save_picture currentpicture; + sketchlevel := sketchlevel+1; +enddef; +def end_sketch = + sketchlevel := sketchlevel-1; + sketchpad[sketchlevel] := currentpicture; + endgroup +enddef; +picture sketchpad[]; +sketchlevel := 1; +vardef use_sketch text t = + addto currentpicture also (sketchpad[sketchlevel] t) +enddef; +vardef cdraw expr p = + draw p +enddef; +vardef cfill expr p = + fill p +enddef; +vardef cfilldraw expr p = + filldraw p +enddef; +vardef ccutdraw expr p = + interim autorounding := 0; + cutdraw p +enddef; +vardef cdrawdot expr p = + drawdot p +enddef; +vardef isdigit expr s = + save n; + (s = "0") + for n = 1 upto 9: + or (s = decimal n) + endfor +enddef; +vardef digits_index (expr s, start) = + save n, m, from, to; + for n = start upto (length s)-1: + if isdigit (substring (n,n+1) of s): + from := n; + for m = n upto length s: + if not isdigit (substring (m,m+1) of s): + to := m; + fi + exitif known to; + endfor + fi + exitif known from; + endfor + (from, if known to: to else: infinity fi) +enddef; +vardef digits_to_brackets suffix suf = + save s, idx; + string s; + pair idx; + s = str suf; + idx = (0,0); + forever: + idx := digits_index (s, xpart idx); + exitif unknown xpart idx; + s := substring (0,xpart idx) of s + & "[]" & substring (ypart idx,infinity) of s; + endfor + s +enddef; +tile_grain := 1in/300; +vardef def_tile (suffix t) (expr wd, ht) = + if not picture tlist.t: + picture tlist.scantokens (digits_to_brackets t); + fi + tlist.t := nullpicture; + tlist.t.dx := max (floor wd, 1); + tlist.t.dy := max (floor ht, 1); +enddef; +vardef use_tile (suffix t) (expr x, y, wd, ht) = + if (picture tlist.t): + for nx = 0 upto wd/tlist.t.dx: + for ny = 0 upto ht/tlist.t.dy: + addto currentpicture + also (tlist.t shifted + ((x,y) + (nx*tlist.t.dx, ny*tlist.t.dy)) t_); + endfor + endfor + else: + errhelp "feynmf: your tiling has not been defined, " + & "check spelling and reprocess!"; + errmessage "feynmf: tiling `" & str t & "' not known, " + & "replaced by `shaded'"; + use_tile (shaded, x, y, wd, ht); + fi +enddef; +vardef shade_rectangle (expr dd, x, y, wd, ht) = + save d, u, dx, dy, currentpen; + pen currentpen; + pickup pencircle scaled thin; + d := max (floor (abs dd), 1); + dx := max (wd, ht); + dy := max (wd, ht); + for u = 0 step d/dx until 1: + if dd > 0: + cdraw (x-d,y+u*dy-d)--(x+(1-u)*dx+d,y+dy+d); + cdraw (x+u*dx-d,y-d)--(x+dx+d,y+(1-u)*dy+d); + else: + cdraw (x-d,y+u*dy+d)--(x+u*dx+d,y-d); + cdraw (x+(1-u)*dx-d,y+dy+d)--(x+dx+d,y+(1-u)*dy-d); + fi + endfor +enddef; +def addto_tile (suffix t) = + addto tlist.t +enddef; +vardef tile_from_string (suffix t) (expr str) = + tile_grain := max (floor tile_grain, 1); + save grain, mx, x, y, n, c, pic; + string c; + picture pic; + pic := nullpicture; + grain := tile_grain; + mx := 0; + x := 0; + y := 0; + for n := 1 upto length str: + c := substring (n-1,n) of str; + if c = "/": + mx := max (mx, x); + y := y+1; + x := 0; + elseif c = "*": + addto pic also (unitpixel shifted (x,-y) t_); + x := x+1; + elseif c = ".": + x := x+1; + fi + endfor + def_tile (t, grain*mx, grain*(y+1)); + addto_tile (t) also (pic shifted (0,y) scaled grain t_); + pic := nullpicture; +enddef; +tile_from_string (gray10, + " ... /"& + " .*. /"& + " ... "); +tile_from_string (gray25, + " .. /"& + " *. "); +tile_from_string (gray50, + " .* /"& + " *. "); +tile_from_string (gray75, + " ** /"& + " .* "); +tile_from_string (gray90, + " *** /"& + " *.* /"& + " *** "); +def_tile (shaded, 4thin, 4thin); +pickup pencircle scaled thin; +begin_sketch + save dx, dy; + (dx,dy) = (tlist.shaded.dx,tlist.shaded.dy); + shade_rectangle (dx, 0, 0, dx, dy); + cullit; + fill unitsquare xscaled dx yscaled dy; + cull currentpicture keeping (2,infinity); + tlist.shaded := currentpicture; +end_sketch; +def_tile (hatched, 5thin, 5thin); +begin_sketch + save dx, dy; + (dx,dy) = (tlist.hatched.dx,tlist.hatched.dy); + shade_rectangle (dx, 0, 0, dx, dy); + shade_rectangle (-dx, 0, 0, dx, dy); + cullit; + fill unitsquare xscaled dx yscaled dy; + cull currentpicture keeping (2,infinity); + tlist.hatched := currentpicture; +end_sketch; +vardef make_halftone (suffix t) (expr g, wd, ht) = + tile_grain := max (floor tile_grain, 1); + if (halftone_cache_g <> g) + or (halftone_cache_grain <> tile_grain) + or (halftone_cache_wd <> wd) + or (halftone_cache_ht <> ht): + halftone_cache_g := g; + halftone_cache_grain := tile_grain; + halftone_cache_wd := wd; + halftone_cache_ht := ht; + grain := tile_grain; + def_tile (t, grain*wd, grain*ht); + if g <= 0: + addto_tile (t) contour unitsquare xscaled wd yscaled ht scaled grain t_; + elseif g < 1: + save period, offset, b, w; + period := max (1/g, 1/(1-g)); + offset := wd - (period * ceiling (wd/period)) mod wd; + b := 0; + w := 0; + randomseed := halftone_randomseed; + for y = 0 upto ht-1: + for x = 0 upto wd-1: + if w > g*(b+w): + addto_tile (t) also (unitpixel + shifted (floor (x + y*offset + 2*uniformdeviate period) + mod wd, y) + scaled grain t_); + b := b+1; + else: + w := w+1; + fi; + endfor + endfor + cull tlist.t keeping (1,infinity); + fi + fi +enddef; +halftone_cache_g := -1; +halftone_cache_grain := -1; +halftone_cache_wd := -1; +halftone_cache_ht := -1; +halftone_randomseed := 137; +vardef tile (suffix t) (expr p) = + save u, x, y, max_x, min_x, max_y, min_y, xx, yy; + -max_x = -max_y = min_x = min_y = infinity; + for u = 0 step 0.1 until length p: + x := xpart (point u of p); + y := ypart (point u of p); + max_x := max(max_x, x); + max_y := max(max_y, y); + min_x := min(min_x, x); + min_y := min(min_y, y); + endfor + cullit withweight 2; + use_tile (t, min_x, min_y, max_x-min_x, max_y-min_y); + fill p; + cull currentpicture keeping (2,infinity) +enddef; +vardef drawtile (suffix t) (expr p) = + tile (t, p); + cdraw p +enddef; +vardef use_halftone (expr g, x, y, wd, ht) = + make_halftone (__tmp_tile__, g, 50, 50); + use_tile (__tmp_tile__, x, y, wd, ht) +enddef; +vardef halftone (expr g, p) = + make_halftone (__tmp_tile__, g, 50, 50); + tile (__tmp_tile__, p) +enddef; +vardef drawhalftone (expr g, p) = + halftone (g, p); + cdraw p +enddef; +vardef shade expr p = + tile (shaded, p) +enddef; +vardef hatch expr p = + tile (hatched, p) +enddef; +vardef emptydraw expr p = + cullit; + unfill p; + cullit; + cdraw p; +enddef; +vardef shadedraw expr p = + cullit; + unfill p; + cullit; + shade p; + cdraw p; +enddef; +vardef hatchdraw expr p = + cullit; + unfill p; + cullit; + hatch p; + cdraw p; +enddef; +vardef marrow (expr p, frac) = + save a, t, z; + pair z; + a = angle direction frac*length(p) of p; + z = point frac*length(p) of p; + (t1,whatever) = p intersectiontimes + (halfcircle scaled 2/3arrow_len rotated (a+90) shifted z); + (t2,whatever) = p intersectiontimes + (halfcircle scaled 4/3arrow_len rotated (a-90) shifted z); + arrow_head (p, t1, t2, arrow_ang) +enddef; +vardef tarrow (expr p, frac) = + save a, t, z; + pair z; + t1 = frac*length p; + a = angle direction t1 of p; + z = point t1 of p; + (t2,whatever) = p intersectiontimes + (halfcircle scaled 2arrow_len rotated (a-90) shifted z); + arrow_head (p, t1, t2, arrow_ang) +enddef; +vardef harrow (expr p, frac) = + save a, t, z; + pair z; + t2 = frac*length p; + a = angle direction t2 of p; + z = point t2 of p; + (t1,whatever) = p intersectiontimes + (halfcircle scaled 2arrow_len rotated (a+90) shifted z); + arrow_head (p, t1, t2, arrow_ang) +enddef; +vardef arrow_head (expr p, from, to, ang) = + save tip, ap, t; + pair tip; + path ap; + t1 := from; + t2 := to; + if t1 = -1: t1 := 0; fi + if t2 = -1: t2 := infinity; fi + tip = point t2 of p; + ap = subpath (t1,t2) of p shifted -tip; + (ap rotated ang + forced_join reverse ap rotated -ang + -- cycle) shifted tip +enddef; +vardef arrow expr p = + marrow (p, .5) +enddef; +tertiarydef p forced_join q = + subpath (0, length p - 1) of p + & point (length p - 1) of p + .. controls postcontrol (length p - 1) of p + and precontrol infinity of p + .. .5[point infinity of p, point 0 of q] + .. controls postcontrol 0 of q and precontrol 1 of q + .. point 1 of q + & subpath (1, infinity) of q +enddef; +vardef cut_decors (suffix from) (expr p) (suffix to) = + subpath (if known from.decor.shape: + xpart (p intersectiontimes + (from.decor.shape scaled from.decor.size + shifted from.loc)) + else: + 0 + fi, + if known to.decor.shape: + length p + - xpart (reverse p intersectiontimes + (to.decor.shape scaled to.decor.size + shifted to.loc)) + else: + infinity + fi) of p +enddef; +vardef make_blob (expr z_arg, diameter) = + save p,currentpen; path p; pen currentpen; + pickup pencircle scaled thick; + p = fullcircle scaled diameter shifted z_arg; + shadedraw p; +enddef; +vardef draw_blob (expr z_arg, diameter) = + if sketched_blob_diameter <> diameter: % drawn lately? + begin_sketch make_blob (origin, diameter); end_sketch; % redo hard work! + sketched_blob_diameter:= diameter; % record it + fi + use_sketch shifted z_arg; % the easy way ... +enddef; +def force_new_blob = sketched_blob_diameter := -1; enddef; +force_new_blob; % initialize it. +vardef pixlen (expr p, n) = + for k=1 upto length(p): + segment_pixlen (subpath (k-1,k) of p, n) endfor +enddef; +vardef segment_pixlen (expr p, n) = + for k=1 upto n: + abs (point k/n of p - point (k-1)/n of p) endfor +enddef; +vardef wiggly expr p_arg = + save wpp; + numeric wpp; + wpp = ceiling (pixlen (p_arg, 10) / wiggly_len) / length p_arg; + for k=0 upto wpp*length(p_arg) - 1: + point k/wpp of p_arg + {direction k/wpp of p_arg rotated wiggly_slope} .. + point (k+.5)/wpp of p_arg + {direction (k+.5)/wpp of p_arg rotated - wiggly_slope} .. + endfor + if cycle p_arg: cycle else: point infinity of p_arg fi +enddef; +vardef curly expr p = + save cpp; + numeric cpp; + cpp := ceiling (pixlen (p, 10) / curly_len) / length p; + if cycle p: + for k=0 upto cpp*length(p) - 1: + point (k+.33)/cpp of p + {direction (k+.33)/cpp of p rotated 90} .. + point (k-.33)/cpp of p + {direction (k-.33)/cpp of p rotated -90} .. + endfor + cycle + else: + point 0 of p + {direction 0 of p rotated -90} .. + for k=1 upto cpp*length(p) - 1: + point (k+.33)/cpp of p + {direction (k+.33)/cpp of p rotated 90} .. + point (k-.33)/cpp of p + {direction (k-.33)/cpp of p rotated -90} .. + endfor + point infinity of p + {direction infinity of p rotated 90} + fi +enddef; +vardef zigzag expr p = + save zpp; + numeric zpp; + zpp = ceiling (pixlen (p, 10) / zigzag_len) / length p; + if not cycle p: + point 0 of p -- + fi + for k = 0 upto zpp*length(p) - 1: + point (k+1/3)/zpp of p shifted + (zigzag_width + * dir angle (direction (k+1/3)/zpp of p rotated 90)) -- + point (k+2/3)/zpp of p shifted + (zigzag_width + * dir angle (direction (k+2/3)/zpp of p rotated -90)) -- + endfor + if cycle p: + cycle + else: + point infinity of p + fi +enddef; +save vsty_hash; +def style_def suffix s = + vsty_hash.s := 1; + expandafter quote vardef scantokens ("draw_" & str s) +enddef; +vardef vsty_exists suffix s = + known vsty_hash.s +enddef; +vardef valid_style expr s = + expandafter vsty_exists scantokens (s) +enddef; +style_def phantom expr p = + \ +enddef; +style_def phantom_arrow expr p = + cfill (arrow p); +enddef; +style_def plain expr p = + cdraw p; +enddef; +style_def plain_arrow expr p = + cdraw p; + cfill (arrow p); +enddef; +style_def dbl_plain expr p = + draw_double p; +enddef; +style_def dbl_plain_arrow expr p = + draw_double_arrow p; +enddef; +style_def wiggly expr p = + cdraw (wiggly p); +enddef; +style_def dbl_wiggly expr p = + draw_double (wiggly p); +enddef; +style_def curly expr p = + cdraw (curly p); +enddef; +style_def dbl_curly expr p = + draw_double (curly p); +enddef; +style_def zigzag expr p = + cdraw (zigzag p); +enddef; +style_def dbl_zigzag expr p = + draw_double (zigzag p); +enddef; +style_def dashes expr p = + save dpp; + numeric dpp; + dpp = ceiling (pixlen (p, 10) / dash_len) / length p; + for k=0 upto dpp*length(p) - 1: + cdraw point k/dpp of p .. + point (k+.5)/dpp of p; + endfor +enddef; +style_def dbl_dashes expr p = + save dpp; + numeric dpp; + dpp = ceiling (pixlen (p, 10) / dash_len) / length p; + for k=0 upto dpp*length(p) - 1: + draw_double point k/dpp of p .. + point (k+.5)/dpp of p; + endfor +enddef; +style_def dbl_dashes_arrow expr p = + draw_dbl_dashes p; + shrink (1.5); + cfill (arrow p); + endshrink; +enddef; +style_def dashes_arrow expr p = + draw_dashes p; + cfill (arrow p); +enddef; +style_def dots expr p = + save dpp; + numeric dpp; + dpp = ceiling (pixlen (p, 10) / dot_len) / length p; + for k=0 upto dpp*length(p): + cdrawdot point k/dpp of p; + endfor +enddef; +style_def dbl_dots expr p = + save dpp; + numeric dpp; + dpp = ceiling (pixlen (p, 10) / dot_len) / length p; + begingroup + save oldpen; + pen oldpen; + oldpen := currentpen; + pickup oldpen scaled 3; % draw a thick linn + for k=0 upto dpp*length(p): + cdrawdot point k/dpp of p; + endfor + pickup oldpen; + cullit; + for k=0 upto dpp*length(p): + undrawdot point k/dpp of p; + endfor + cullit; % and remove the stuffing + endgroup; +enddef; +style_def dbl_dots_arrow expr p = + draw_dbl_dots p; + shrink (1.5); + cfill (arrow p); + endshrink; +enddef; +style_def dots_arrow expr p = + draw_dots p; + cfill (arrow p); +enddef; +style_def double expr p = + save oldpen; + pen oldpen; + oldpen := currentpen; + pickup oldpen scaled 3; + ccutdraw p; + pickup oldpen; + cullit; undraw p; cullit; +enddef; +style_def double_arrow expr p = + draw_double p; + shrink (1.5); + cfill (arrow p); + endshrink; +enddef; +style_def vanilla expr p = draw_plain p enddef; +style_def fermion expr p = draw_plain_arrow p enddef; +style_def quark expr p = draw_plain_arrow p enddef; +style_def electron expr p = draw_plain_arrow p enddef; +style_def photon expr p = draw_wiggly p enddef; +style_def boson expr p = draw_wiggly p enddef; +style_def gluon expr p = draw_curly p enddef; +style_def heavy expr p = draw_dbl_plain_arrow p enddef; +style_def ghost expr p = draw_dots_arrow p enddef; +style_def scalar expr p = draw_dashes_arrow p enddef; +vardef fermion expr path_arg = + cfill (arrow (path_arg)); + path_arg +enddef; +vardef photon expr path_arg = + wiggly path_arg +enddef; +vardef gluon expr path_arg = + curly path_arg +enddef; +tracingstats:=1; +boolean vtracing; +vtracing := false; % true +def vinit = + save vhash; + numeric vlist.first, vlist.last; + vlist.first := 1; + vlist.last := 0; + pair vlist[]loc; + numeric vlist[]decor.size, vlist[]decor.ang, + vlist[]arc.first, vlist[]arc.last, + vlist[]arc[], vlist[]arc[]lsr, + vlist[]arc[]tns, vlist[]arc[]lbl.dist, + vlist[]arc[]tag, vlist[]arc[]wd, vlist[]arc[]rub, + vlist[]constr.first, vlist[]constr.last, + vlist[]constr[], lambdax[][], lambday[][]; + string vlist[]name, vlist[]lbl, vlist[]decor.sty, + vlist[]arc[]sty, vlist[]arc[]lbl, vlist[]arc[]lbl.side; + numeric vlist[]lbl.ang; + path vlist[]decor.shape; + numeric plist.first, plist.last, plist[]cnt, plist[]vtx[], + plist[]pull, plist[]lbl.ang, plist[]lbl.dist; + string plist[]lbl, plist[]sty, plist[]cona, plist[]conb; + plist.first := 1; + plist.last := 0; + numeric vlist[]poly.first, vlist[]poly.last, + vlist[]poly[], vlist[]poly[]idx; + pair lambdap[][]; +enddef; +def vertices = + vlist.first upto vlist.last +enddef; +def varcs (text i) = + vlist[i]arc.first upto vlist[i]arc.last +enddef; +def vconstr (text i) = + vlist[i]constr.first upto vlist[i]constr.last +enddef; +def polygons = + plist.first upto plist.last +enddef; +def vpoly (text i) = + vlist[i]poly.first upto vlist[i]poly.last +enddef; +vardef venter suffix v = + if not vexists v: + vlist.last := vlist.last + 1; + vhash.v := vlist.last; + vlist[vhash.v]name := str v; + vlist[vhash.v]loc := (whatever,whatever); + vlist[vhash.v]arc.first := 1; + vlist[vhash.v]arc.last := 0; + vlist[vhash.v]constr.first := 1; + vlist[vhash.v]constr.last := 0; + vlist[vhash.v]lbl := ""; + vlist[vhash.v]lbl.ang := whatever; + vlist[vhash.v]lbl.dist := 3thick; + vlist[vhash.v]poly.first := 1; + vlist[vhash.v]poly.last := 0; + fi +enddef; +vardef vexists suffix v = + if known vhash.v: true else: false fi +enddef; +vardef vlookup suffix v = + if vexists v: vhash.v else: 0 fi +enddef; +vardef vloc suffix v = + vlist[vlookup v]loc +enddef; +vardef vconnect (expr linesty) (text vl) = + save from, nfrom, nto, nopt, sty; + numeric from, nfrom, nto, nopt; + string sty; + getopt (opt, linesty); + sty := opt[opt.first]; + if known opt[opt.first]arg: + message "feynmf: line styles don't take arguments. " + & "Argument `" & opt[opt.first]arg & "' ignored."; + fi + opt.first := opt.first + 1; + forsuffixes to = vl: + venter to; + nto := vlookup to; + if known nfrom: + vlist[nfrom]arc.last := vlist[nfrom]arc.last + 1; + vlist[nfrom]arc[vlist[nfrom]arc.last] := nto; + vlist[nfrom]arc[vlist[nfrom]arc.last]tns := 1; + if nfrom <> nto: + vlist[nto]arc.last := vlist[nto]arc.last + 1; + vlist[nto]arc[vlist[nto]arc.last] := nfrom; + vlist[nto]arc[vlist[nto]arc.last]tns := 1; + fi + vlist[nfrom]arc[vlist[nfrom]arc.last]lbl := ""; + vlist[nfrom]arc[vlist[nfrom]arc.last]lbl.side := ""; + vlist[nfrom]arc[vlist[nfrom]arc.last]lbl.dist := 3thick; + for nopt = opt.first upto opt.last: + if match_option (opt[nopt], "tension"): + get_argument (opt[nopt], scantokens (opt[nopt]arg), + vlist[nfrom]arc[vlist[nfrom]arc.last]tns); + get_argument (opt[nopt], scantokens (opt[nopt]arg), + vlist[nto]arc[vlist[nto]arc.last]tns); + elseif match_option (opt[nopt], "left"): + if known opt[nopt]arg: + vlist[nfrom]arc[vlist[nfrom]arc.last]lsr + := - scantokens (opt[nopt]arg); + else: + vlist[nfrom]arc[vlist[nfrom]arc.last]lsr := -1; + fi + elseif match_option (opt[nopt], "straight"): + vlist[nfrom]arc[vlist[nfrom]arc.last]lsr := 0; + ignore_argument (opt[nopt], opt[nopt]arg); + elseif match_option (opt[nopt], "right"): + if known opt[nopt]arg: + vlist[nfrom]arc[vlist[nfrom]arc.last]lsr + := scantokens (opt[nopt]arg); + else: + vlist[nfrom]arc[vlist[nfrom]arc.last]lsr := 1; + fi + elseif match_option (opt[nopt], "label"): + get_argument (opt[nopt], opt[nopt]arg, + vlist[nfrom]arc[vlist[nfrom]arc.last]lbl); + elseif match_option (opt[nopt], "label.side"): + get_argument (opt[nopt], opt[nopt]arg, + vlist[nfrom]arc[vlist[nfrom]arc.last]lbl.side); + elseif match_option (opt[nopt], "label.dist"): + get_argument (opt[nopt], scantokens (opt[nopt]arg), + vlist[nfrom]arc[vlist[nfrom]arc.last]lbl.dist); + elseif match_option (opt[nopt], "tag"): + if known opt[nopt]arg: + vlist[nfrom]arc[vlist[nfrom]arc.last]tag + := scantokens (opt[nopt]arg); + else: + vlist[nfrom]arc[vlist[nfrom]arc.last]tag := 0; + fi + elseif match_option (opt[nopt], "width"): + get_argument (opt[nopt], scantokens (opt[nopt]arg), + vlist[nfrom]arc[vlist[nfrom]arc.last]wd); + elseif match_option (opt[nopt], "foreground") + or match_option (opt[nopt], "background"): + message "feynmf: color available with MetaPost only!"; + elseif match_option (opt[nopt], "rubout"): + if known opt[nopt]arg: + vlist[nfrom]arc[vlist[nfrom]arc.last]rub + := scantokens (opt[nopt]arg); + else: + vlist[nfrom]arc[vlist[nfrom]arc.last]rub := 2; + fi + else: + ignore_option (opt[nopt], opt[nopt]arg); + fi + endfor + handle_line_style (vlist[nfrom]arc[vlist[nfrom]arc.last]sty, sty); + vlist[nto]arc[vlist[nto]arc.last]lsr + := vlist[nfrom]arc[vlist[nfrom]arc.last]lsr; + fi + nfrom := nto; + endfor +enddef; +vardef handle_line_style (suffix sty) (expr name) = + if valid_style name: + sty := name; + else: + errhelp "feynmf: your linestyle is not recognizable, " + & "check spelling and reprocess!"; + errmessage "feynmf: line style `" & name & "' not known, " + & "replaced by `vanilla'"; + sty := "vanilla"; + fi +enddef; +vardef get_argument (expr opt, arg) (suffix variable) = + if known arg: + variable := arg; + else: + message "feynmf: option `" & opt & "' needs an argument. Ignored."; + fi +enddef; +vardef ignore_argument (expr opt, arg) = + if known arg: + message "feynmf: option `" & opt & "' doesn't take an argument. " + & "Argument `" & arg & "' ignored."; + fi +enddef; +vardef ignore_option (expr opt, arg)= + if known arg: + message "feynmf: ignoring option " & opt & "=" & arg & "."; + else: + message "feynmf: ignoring option " & opt & "."; + fi +enddef; +vardef vconnectn (expr linesty) (suffix v) (expr n) = + vconnect (linesty, vmklist (v, n)); +enddef; +vardef vpath@# (suffix from, to) = + save nfrom, nto, origin, index, unknown_path; + numeric nfrom, nto, origin, index; + path unknown_path; + if (known vloc from) and (known vloc to): + nfrom := vlookup from; + nto := vlookup to; + vmatch_path (nfrom, nto, maybe_empty@#); + if (unknown origin) or (unknown index): + vmatch_path (nto, nfrom, maybe_empty@#); + fi + fi + if (known origin) and (known index): + vbuild_cut_arc (origin, index) + else: + unknown_path + fi +enddef; +vardef maybe_empty@# = + save _prefix; + _prefix=137; + if known _prefix@#: + whatever + else: + @# + fi +enddef; +vardef vmatch_path (expr nfrom, nto, t) = + save i; + for i = varcs (nfrom): + if (vlist[nfrom]arc[i] = nto) and (known vlist[nfrom]arc[i]sty): + if unknown t: + origin := nfrom; + index := i; + else: + if known vlist[nfrom]arc[i]tag: + if vlist[nfrom]arc[i]tag = t: + origin := nfrom; + index := i; + fi + fi + fi + fi + endfor +enddef; +vardef vcyclen (expr sty) (suffix v) (expr n) = + for $ = 1 upto n - 1: + vconnect (sty, v[$], v[$+1]); + endfor + vconnect (sty, v[n], v[1]); +enddef; +vardef vrcyclen (expr sty) (suffix v) (expr n) = + vconnect (sty, v[1], v[n]); + for $ = n downto 2: + vconnect (sty, v[$], v[$-1]); + endfor +enddef; +vardef vforce (expr z) (suffix v) = + venter v; + vlist[vlookup v]loc := z; +enddef; +vardef vshift (expr z) (text vl) = + forsuffixes $=vl: + if vexists $: + vlist[vlookup $]loc := vlist[vlookup $]loc + z; + fi + endfor +enddef; +vardef vconstraint (expr z) (text vl) = + save nfrom, nto; + numeric nfrom, nto; + forsuffixes to = vl: + venter to; + nto := vlookup to; + if known nfrom: + vlist[nfrom]constr.last := vlist[nfrom]constr.last + 1; + vlist[nto]constr.last := vlist[nto]constr.last + 1; + vlist[nfrom]constr[vlist[nfrom]constr.last] := nto; + vlist[nto]constr[vlist[nto]constr.last] := nfrom; + vlist[nto]loc = vlist[nfrom]loc + z; + fi + nfrom := nto; + endfor +enddef; +vardef vpolygon (expr psty) (suffix v) (text vl) = + save nopt, csty, nfrom, nfrom_, nto, i, n, j; + numeric nopt, nfrom, nfrom_, nto, i, n, j; + string csty; + n := count (vl) + 1; + plist.last := plist.last + 1; + plist[plist.last]cnt := n; + plist[plist.last]lbl := ""; + plist[plist.last]lbl.ang := whatever; + plist[plist.last]lbl.dist := 0; + csty := "phantom"; + getopt (opt, psty); + for nopt = opt.first upto opt.last: + if match_option (opt[nopt], "filled"): + get_argument (opt[nopt], opt[nopt]arg, plist[plist.last]sty); + elseif match_option (opt[nopt], "tension"): + if known opt[nopt]arg: + csty := csty & ",tension=" & opt[nopt]arg; + else: + message "feynmf: option `tension' needs an argument. Ignored."; + fi + elseif match_option (opt[nopt], "label"): + get_argument (opt[nopt], opt[nopt]arg, plist[plist.last]lbl); + elseif match_option (opt[nopt], "label.angle"): + get_argument (opt[nopt], scantokens (opt[nopt]arg), + plist[plist.last]lbl.ang); + elseif match_option (opt[nopt], "label.dist"): + get_argument (opt[nopt], scantokens (opt[nopt]arg), + plist[plist.last]lbl.dist); + elseif match_option (opt[nopt], "pull"): + get_argument (opt[nopt], scantokens (opt[nopt]arg), + plist[plist.last]pull); + elseif match_option (opt[nopt], "cona"): + get_argument (opt[nopt], opt[nopt]arg, plist[plist.last]cona); + elseif match_option (opt[nopt], "conb"): + get_argument (opt[nopt], opt[nopt]arg, plist[plist.last]conb); + elseif match_option (opt[nopt], "smooth"): + plist[plist.last]cona := ".."; + plist[plist.last]conb := ".."; + ignore_argument (opt[nopt], opt[nopt]arg); + elseif match_option (opt[nopt], "foreground") + or match_option (opt[nopt], "background"): + message "feynmf: color available with MetaPost only!"; + elseif match_option (opt[nopt], "phantom"): + plist[plist.last]sty := "phantom"; + elseif match_option (opt[nopt], "empty"): + plist[plist.last]sty := "empty"; + elseif match_option (opt[nopt], "full"): + plist[plist.last]sty := "full"; + elseif match_option (opt[nopt], "hatched"): + plist[plist.last]sty := "hatched"; + elseif match_option (opt[nopt], "shaded"): + plist[plist.last]sty := "shaded"; + else: + ignore_option (opt[nopt], opt[nopt]arg); + fi + endfor + canonicalize_filling plist[plist.last]sty; + vconnect (csty, v, vl, v); + i := 1; + forsuffixes to = v, vl, v: + nto := vlookup to; + if known nfrom: + if known nfrom_: + vlist[nto]loc = vlist[nfrom]loc + + (vlist[nfrom]loc - vlist[nfrom_]loc) rotated (360/n); + fi + vlist[nto]poly.last := vlist[nto]poly.last + 1; + vlist[nto]poly[vlist[nto]poly.last] := plist.last; + vlist[nto]poly[vlist[nto]poly.last]idx := i; + plist[plist.last]vtx[i] := nto; + i := i + 1; + nfrom_ := nfrom; + fi + nfrom := nto; + endfor +enddef; +vardef canonicalize_filling suffix f = + if known f: + if is_a_number (f): + if scantokens f <= 1: + f := + if scantokens f = 1: + "full" + elseif scantokens f > 0: + "shaded" + elseif scantokens f = 0: + "empty" + else: + "hatched" + fi; + fi + fi + fi +enddef; +vardef vpolygonn (expr sty) (suffix v) (expr n) = + vpolygon (sty, v[1], for $=2 upto n-1: v[$], endfor v[n]); +enddef; +vardef vrpolygonn (expr sty) (suffix v) (expr n) = + vpolygon (sty, v[n], for $=n-1 downto 2: v[$], endfor v[1]); +enddef; +vardef vlabel (expr s) (suffix v) = + venter v; + vlist[vlookup v]lbl := s; +enddef; +vardef vvertex (expr vtxsty) (text vl) = + save nopt, sty, arg; + numeric nopt, arg; + string sty; + getopt (opt, vtxsty); + forsuffixes v = vl: + venter v; + n := vlookup v; + for nopt = opt.first upto opt.last: + handle_vertex_option (vlist[n], opt[nopt], opt[nopt]arg); + endfor + endfor +enddef; +vardef handle_vertex_option (suffix v) (expr opt, arg) = + if match_option (opt, "label"): + get_argument (opt, arg, v.lbl); + elseif match_option (opt, "label.angle"): + get_argument (opt, scantokens (arg), v.lbl.ang); + elseif match_option (opt, "label.dist"): + get_argument (opt, scantokens (arg), v.lbl.dist); + elseif match_option (opt, "decoration.shape"): + if known arg: + make_decor_shape (v.decor.shape, arg); + else: + message "feynmf: option `decor.shape' needs an argument. Ignored."; + fi + elseif match_option (opt, "decoration.filled"): + get_argument (opt, arg, v.decor.sty); + canonicalize_filling v.decor.sty; + elseif match_option (opt, "decoration.size"): + get_argument (opt, scantokens (arg), v.decor.size); + elseif match_option (opt, "decoration.angle"): + get_argument (opt, scantokens (arg), v.decor.ang); + elseif match_option (opt, "foreground") + or match_option (opt, "background"): + message "feynmf: color available with MetaPost only!"; + else: + ignore_option (opt, arg); + fi +enddef; +vardef make_decor_shape (suffix p) (expr n) = + if match_prefix (n, "circle"): p := fullcircle; + elseif match_prefix (n, "square"): + p := unitsquare shifted -(.5,.5); + elseif match_prefix (n, "cross"): p := polycross 4; + elseif match_prefix (n, "triangle"): p := polygon 3; + elseif match_prefix (n, "triagon"): p := polygon 3; + elseif match_prefix (n, "diamond"): p := polygon 4; + elseif match_prefix (n, "tetragon"): p := polygon 4; + elseif match_prefix (n, "pentagon"): p := polygon 5; + elseif match_prefix (n, "hexagon"): p := polygon 6; + elseif match_prefix (n, "triagram"): p := polygram 3; + elseif match_prefix (n, "tetragram"): p := polygram 4; + elseif match_prefix (n, "pentagram"): p := polygram 5; + elseif match_prefix (n, "hexagram"): p := polygram 6; + elseif match_prefix (n, "triacross"): p := polycross 3; + elseif match_prefix (n, "tetracross"): p := polycross 4; + elseif match_prefix (n, "pentacross"): p := polycross 5; + elseif match_prefix (n, "hexacross"): p := polycross 6; + else: + if feynmfwizard: + p := scantokens(n); + else: + message "feynmf: invalid argument `" & n + & "' to option `decor.shape'. Ignored."; + fi + fi +enddef; +vardef is_a_number expr s = + save n; + if known s: + (true + for n = 1 upto length s: + and ((substring (n-1,n) of s = ".") + or (substring (n-1,n) of s = "-") + or isdigit substring (n-1,n) of s) + endfor) + else: + false + fi +enddef; +vardef vvertexn (expr vtxsty) (suffix v) (expr n) = + vvertex (vtxsty, vmklist (v, n)); +enddef; +vardef vblob (expr bd) (text vl)= + forsuffixes $=vl: + if not vexists $: venter $; fi + vlist[vlookup $]decor.shape := fullcircle; + vlist[vlookup $]decor.size := bd; + vlist[vlookup $]decor.sty := "shaded"; + endfor +enddef; +vardef vdot (text vl)= + forsuffixes $=vl: + if not vexists $: venter $; fi + vlist[vlookup $]decor.shape := fullcircle; + vlist[vlookup $]decor.size := dot_size; + vlist[vlookup $]decor.sty := "full"; + endfor +enddef; +vardef vdotn (suffix v) (expr n) = + vdot (vmklist (v, n)); +enddef; +vardef vblobn (suffix v) (expr n) = + vblob (vmklist (v, n)); +enddef; +vardef curved_left_gallery = .9[se,sw] .. .5[sw,nw] .. .1[nw,ne] enddef; +vardef curved_right_gallery = .9[sw,se] .. .5[se,ne] .. .1[ne,nw] enddef; +vardef curved_bottom_gallery = .9[nw,sw] .. .5[sw,se] .. .1[se,ne] enddef; +vardef curved_top_gallery = .9[sw,nw] .. .5[nw,ne] .. .1[ne,se] enddef; +vardef curved_surround_gallery = + superellipse (.5[se,ne], .5[ne,nw], .5[nw,sw], .5[sw,se], .75) +enddef; +vardef straight_left_gallery = sw -- nw enddef; +vardef straight_right_gallery = se -- ne enddef; +vardef straight_bottom_gallery = sw -- se enddef; +vardef straight_top_gallery = nw -- ne enddef; +vardef straight_surround_gallery = + .5[se,ne] -- ne -- .5[ne,nw] -- nw + -- .5[nw,sw] -- sw -- .5[sw,se] -- se -- cycle +enddef; +vardef curved_galleries = + vardef left_gallery = curved_left_gallery enddef; + vardef right_gallery = curved_right_gallery enddef; + vardef bottom_gallery = curved_bottom_gallery enddef; + vardef top_gallery = curved_top_gallery enddef; + vardef surround_gallery = curved_surround_gallery enddef; +enddef; +vardef straight_galleries = + vardef left_gallery = straight_left_gallery enddef; + vardef right_gallery = straight_right_gallery enddef; + vardef bottom_gallery = straight_bottom_gallery enddef; + vardef top_gallery = straight_top_gallery enddef; + vardef surround_gallery = straight_surround_gallery enddef; +enddef; +vardef vleft (text vl) = vdistribute (left_gallery, vl) enddef; +vardef vright (text vl) = vdistribute (right_gallery, vl) enddef; +vardef vbottom (text vl) = vdistribute (bottom_gallery, vl) enddef; +vardef vtop (text vl) = vdistribute (top_gallery, vl) enddef; +vardef vsurround (text vl) = vdistribute (surround_gallery, vl) enddef; +curved_galleries; +vardef vdistribute (expr p) (text vl) = + save numv, len, off; + numeric numv, len, off; + numv = count (vl); + if cycle p: numv := numv + 1; fi + len := length (p); + if numv = 1: + vforce (point len/2 of p, vl); + else: + off := 0; + forsuffixes $ = vl: + vforce (point off of p, $); + off := off + len/(numv-1); + endfor + fi +enddef; +def vmklist (suffix v) (expr n) = + for $ = 1 upto n-1: v[$], endfor v[n] +enddef; +vardef vleftn (suffix v) (expr n) = + vleft (vmklist (v, n)); +enddef; +vardef vrightn (suffix v) (expr n) = + vright (vmklist (v, n)); +enddef; +vardef vbottomn (suffix v) (expr n) = + vbottom (vmklist (v, n)); +enddef; +vardef vtopn (suffix v) (expr n) = + vtop (vmklist (v, n)); +enddef; +vardef vsurroundn (suffix v) (expr n) = + vsurround (vmklist (v, n)); +enddef; +vardef vfreeze = + for i = vertices: + if unknown vlist[i]loc: + origin = origin + for j = varcs (i): + + vlist[i]arc[j]tns * (vlist[i]loc - vlist[vlist[i]arc[j]]loc) + endfor + for j = vconstr (i): + if i < vlist[i]constr[j]: + + lambda (i, vlist[i]constr[j]) + elseif i > vlist[i]constr[j]: + - lambda (vlist[i]constr[j], i) + fi + endfor + for j = vpoly (i): + + lambdapoly (vlist[i]poly[j], plist[vlist[i]poly[j]]cnt, + vlist[i]poly[j]idx) + endfor; + fi + endfor + if vtracing: vdump; fi +enddef; +vardef lambda (expr i, j) = + (if known (xpart(vlist[i]loc - vlist[j]loc)): + lambdax[i][j] + else: + 0 + fi, + if known (ypart(vlist[i]loc - vlist[j]loc)): + lambday[i][j] + else: + 0 + fi) +enddef; +vardef lambdapoly (expr p, n, i) = + origin + if i = 1: + + lambdap[p][2] rotated (-360/n) + elseif i = 2: + - lambdap[p][1] + fi + if i = n - 1: + - lambdap[p][n] rotated (-360/n) + elseif i = n: + + lambdap[p][n-1] + fi + if (i > 1) and (i < n): + + lambdap[p][i-1] + lambdap[p][i+1] rotated (-360/n) + - lambdap[p][i] - lambdap[p][i] rotated (-360/n) + fi +enddef; +vardef idraw (expr linesty, p) = + save nopt, sty, lbl, wd, rub; + numeric nopt, lbl.dist, wd, rub; + string sty, lbl, lbl.side; + getopt (opt, linesty); + sty := opt[opt.first]; + if known opt[opt.first]arg: + message "feynmf: line styles don't take arguments. " + & "Argument `" & opt[opt.first]arg & "' ignored."; + fi + opt.first := opt.first + 1; + lbl := ""; + lbl.side := ""; + lbl.dist := 3thick; + for nopt = opt.first upto opt.last: + if match_option (opt[nopt], "label"): + get_argument (opt[nopt], opt[nopt]arg, lbl); + elseif match_option (opt[nopt], "label.side"): + get_argument (opt[nopt], opt[nopt]arg, lbl.side); + elseif match_option (opt[nopt], "label.dist"): + get_argument (opt[nopt], scantokens (opt[nopt]arg), lbl.dist); + elseif match_option (opt[nopt], "width"): + get_argument (opt[nopt], scantokens (opt[nopt]arg), wd); + elseif match_option (opt[nopt], "foreground") + or match_option (opt[nopt], "background"): + message "feynmf: color available with MetaPost only!"; + elseif match_option (opt[nopt], "rubout"): + if known opt[nopt]arg: + rub := scantokens (opt[nopt]arg); + else: + rub := 2; + fi + else: + ignore_option (opt[nopt], opt[nopt]arg); + fi + endfor + handle_line_style (sty, sty); + begingroup + vdraw_arc_rubout (rub, sty, wd, p, lbl); + endgroup; +enddef; +vardef ivertex (expr vtxsty, pos) = + save nopt, v; + numeric nopt, v.lbl.ang, v.lbl.dist, + v.decor.size, v.decor.ang; + pair v.loc; + string v.lbl, v.decor.sty; + path v.decor.shape; + v.loc := pos; + v.lbl := ""; + v.lbl.ang := whatever; + v.lbl.dist := 3thick; + v.decor.size := decor_size; + getopt (opt, vtxsty); + for nopt = opt.first upto opt.last: + handle_vertex_option (v, opt[nopt], opt[nopt]arg); + endfor + vdraw_label (v.loc, v.lbl); + vdraw_vertex v; +enddef; +vardef vdraw = + if not feynmfwizard: + vcheck_typos; + fi + for i = vertices: + if not known vlist[i]loc: + errhelp "Your graph specification was not complete (probably a " + & "lone vertex). Check logic and reprocess!"; + errmessage "feynmf: vertex `" & vlist[i]name & "' not determined, " + & "replaced by `(0,0)'."; + vlist[i]loc := origin; + fi + if unknown vlist[i]decor.size: + vlist[i]decor.size = decor_size; + fi + endfor + for i = vertices: + for j = varcs (i): + if known vlist[i]arc[j]sty: + if vlist[i]arc[j]sty <> "": + if unknown vlist[i]arc[j]rub: + begingroup + vdraw_arc (vlist[i]arc[j]sty, vlist[i]arc[j]wd, + vbuild_cut_arc (i, j), vlist[i]arc[j]lbl); + vlist[i]arc[j]sty := ""; + endgroup; + fi + fi + fi + endfor; + endfor + for i = polygons: + vdraw_label (pcenter plist[i], plist[i]lbl); + vdraw_polygon plist[i]; + endfor + for i = vertices: + vdraw_label (vlist[i]loc, vlist[i]lbl); + vdraw_vertex vlist[i]; + endfor + for i = vertices: + for j = varcs (i): + if known vlist[i]arc[j]sty: + if vlist[i]arc[j]sty <> "": + if known vlist[i]arc[j]rub: + begingroup + vdraw_arc_rubout (vlist[i]arc[j]rub, + vlist[i]arc[j]sty, + vlist[i]arc[j]wd, + vbuild_cut_arc (i, j), + vlist[i]arc[j]lbl); + vlist[i]arc[j]sty := ""; + endgroup; + fi + fi + fi + endfor; + endfor +enddef; +vardef vcheck_typos = + save j, err; + boolean wrn; + wrn := false; + for i = vertices: + save connections; + connections = vlist[i]arc.last - vlist[i]arc.first + 1; + if connections < 1: + if unknown vlist[i]loc: + message "feynmf: warning: disconnected and unspecified vertex `" + & substring (2,infinity) of vlist[i]name + & "'."; + wrn := true; + fi + elseif connections = 1: + j := vlist[i]arc[vlist[i]arc.last]; + if j < i: + if vlist[i]loc = vlist[j]loc: + message "feynmf: warning: dangling vertex `" + & substring (2,infinity) of vlist[i]name + & "' colliding with `" + & substring (2,infinity) of vlist[j]name + & "'."; + wrn := true; + fi + fi + fi + endfor + if wrn: + message "feynmf: Have you seen the warning messages above?"; + message " They are usually caused by misspelling a vertex'"; + message " name and can trigger errors further below!"; + message " Fix the typos and run LaTeX and Metafont again."; + fi +enddef; +vardef vbuild_arc (expr lsr, from, to) = + if unknown lsr: + from -- to + else: + if lsr = 0: + from -- to + else: + from + .. (1-lsr)/2 *(to rotatedabout (.5[from,to], 90)) + + (1+lsr)/2 * (to rotatedabout (.5[from,to], -90)) + .. to + fi + fi +enddef; +vardef vbuild_cut_arc (expr origin, index) = + cut_decors (vlist[origin], + if vlist[origin]arc[index] <> origin: + vbuild_arc (vlist[origin]arc[index]lsr, + vlist[origin]loc, + vlist[vlist[origin]arc[index]]loc) + else: + vbuild_tadpole (origin, index) + fi, + vlist[vlist[origin]arc[index]]) +enddef; +vardef vbuild_tadpole (expr origin, index) = + save j, n, nn, nnn, aidx, aang, agap, bgap, ngap, distsum; + n := 0; + distsum := 0; + for j = varcs (origin): + if vlist[origin]arc[j] <> origin: + ang := angle direction 0 of + vbuild_arc (vlist[origin]arc[j]lsr, + vlist[origin]loc, + vlist[vlist[origin]arc[j]]loc); + n := n + 1; + distsum := distsum + + abs (vlist[vlist[origin]arc[j]]loc - vlist[origin]loc); + aang[n] := 360; + for nn = 1 upto n: + if ang < aang[nn]: + for nnn = n - 1 downto nn: + aang[nnn+1] := aang[nnn]; + aidx[nnn+1] := aidx[nnn]; + endfor + aang[nn] := ang; + aidx[nn] := n; + fi + exitif known aidx[n]; + endfor + fi + endfor + aidx[n+1] := aidx[1]; + aang[n+1] := aang[1] + 360; + for nn = 1 upto n: + agap[nn] = aang[nn+1] - aang[nn]; + endfor + if known vlist[origin]arc[index]lsr: + ngap := n; + for nn = 1 upto n: + if (aang[nn] < vlist[origin]arc[index]lsr) + and (vlist[origin]arc[index]lsr < aang[nn+1]): + ngap := nn; + fi + endfor + else: + bgap := 0; + for nn = 1 upto n: + if agap[nn] > bgap: + bgap := agap[nn]; + ngap := nn; + fi + endfor + fi + if vtracing: adump (n + 1); fi + vlist[origin]loc{dir(aang[ngap]+agap[ngap]/4)} + ... vlist[origin]loc + 2/3 * distsum/n + / vlist[origin]arc[index]tns + * dir(aang[ngap]+agap[ngap]/2) + ... {-dir(aang[ngap+1]-agap[ngap]/4)}vlist[origin]loc +enddef; +vardef adump expr n = + save i; + for i = 1 upto n: + message "aidx[" & decimal_ (i) & "]=" & decimal_ (aidx[i]) + & ", aang[" & decimal_ (i) & "]=" & decimal_ (aang[i]) + & ", agap[" & decimal_ (i) & "]=" & decimal_ (agap[i]); + endfor +enddef; +vardef vdraw_arc (expr sty, wd, arc) (suffix lbl) = + if known wd: + save currentpen; + pen currentpen; + pickup pencircle scaled wd; + fi + scantokens ("draw_" & sty) (arc); + vdraw_arc_label (arc, lbl); +enddef; +let plain_draw = draw; +vardef vdraw_arc_rubout (expr rub, sty, wd, arc) (suffix lbl) = + if known rub: + begingroup + def draw expr p = + save oldpen; pen oldpen; + oldpen := currentpen; + save currentpen; pen currentpen; + pickup oldpen scaled rub; + erase plain_draw (subpath (.1,.9)*length(p) of p) + enddef; + vdraw_arc (sty, wd, arc, lbl); + let draw = plain_draw; + endgroup; + fi + vdraw_arc (sty, wd, arc, lbl); +enddef; +vardef vbuild_polygon suffix p = + if known p.pull: + save c; pair c; + c := pcenter p; + for i = 1 upto (p.cnt - 1): + vbuild_polygon_section (p, i, i+1) + endfor + vbuild_polygon_section (p, p.cnt, 1) + else: + for i = 1 upto p.cnt: + vlist[p.vtx[i]]loc + if known p.cona: scantokens (p.cona) else: -- fi + endfor + fi + cycle +enddef; +def vbuild_polygon_section (suffix p) (expr from, to) = + vlist[p.vtx[from]]loc + if known p.cona: scantokens (p.cona) else: -- fi + p.pull[c,.5[vlist[p.vtx[from]]loc,vlist[p.vtx[to]]loc]] + if known p.conb: scantokens (p.conb) else: -- fi +enddef; +vardef pcenter suffix p = + (origin for i = 1 upto p.cnt: + + vlist[p.vtx[i]]loc + endfor) / p.cnt +enddef; +vardef vdraw_arc_label (expr arc) (suffix lbl) = + if lbl <> "": + save _a, _z, _zz, _r; + numeric _a; + pair _z, _zz, _r; + _z := point .5 length (arc) of arc; + if lbl.dist = 0: + LaTeX_text (_z, whatever, lbl); + else: + _r := direction .5 length (arc) of arc rotated - 90; + if lbl.side = "left": + _a := angle (-_r); + elseif lbl.side = "right": + _a := angle (_r); + else: + _zz = _z - .5[point 0 of arc, point infinity of arc]; + if ((_zz if length (_zz) > 0: / length (_zz) fi) + dotprod _r) >= 0: + _a := angle (_r); + else: + _a := angle (-_r); + fi + fi + LaTeX_text (_z + lbl.dist * dir _a, _a, lbl); + fi + fi +enddef; +vardef vdraw_label (expr loc) (suffix lbl) = + if lbl <> "": + save a; + numeric a; + if lbl.dist = 0: + LaTeX_text (loc, whatever, lbl); + else: + if unknown lbl.ang: + if loc = (.5w,.5h): + a := 0; + else: + a := angle (loc - (.5w,.5h)); + fi + else: + a := lbl.ang; + fi + LaTeX_text (loc + lbl.dist * dir a, a, lbl); + fi + fi +enddef; +vardef vdraw_vertex suffix v = + if known v.decor.shape: + if known v.decor.sty: + if v.decor.sty = "empty": + emptydraw ( + elseif v.decor.sty = "full": + cfilldraw ( + elseif is_a_number v.decor.sty: + drawhalftone (1 - scantokens v.decor.sty / 100, + else: + drawtile (scantokens v.decor.sty, + fi + else: + cfilldraw ( + fi + v.decor.shape + if known v.decor.ang: rotated v.decor.ang fi + scaled v.decor.size shifted v.loc); + fi +enddef; +vardef polygon expr n = + if n > 2: + for i = 1 upto n: + (.5up rotated (360i/n)) -- + endfor + cycle + else: + fullcircle + fi +enddef; +vardef polygram expr n = + if n > 2: + for i = 1 upto n: + (.5up rotated (360i/n)) -- + (.2up rotated (360(i+.5)/n)) -- + endfor + cycle + else: + fullcircle + fi +enddef; +vardef polycross expr n = + save i; + for i = 1 upto n: + origin -- .5 dir (360(i-.5)/n) -- + endfor + cycle +enddef; +vardef vdraw_polygon suffix p = + if known p.sty: + if p.sty = "phantom": + elseif p.sty = "empty": + emptydraw (vbuild_polygon p); + elseif p.sty = "full": + cfilldraw (vbuild_polygon p); + elseif is_a_number p.sty: + drawhalftone (1 - scantokens p.sty / 100, vbuild_polygon p); + else: + drawtile (scantokens p.sty, vbuild_polygon p); + fi + else: + cdraw (vbuild_polygon p); + fi +enddef; +vardef LaTeX expr text = + message (":" & decimal charcode & ":" & text & "%") +enddef; +vardef LaTeX_text (expr z, a, txt) = + LaTeX "\fmfL(" & (decimal (xpart z/LaTeX_unitlength)) & "," + & (decimal (ypart z/LaTeX_unitlength)) & "," + & (voctant a) & "){" & txt & "}"; +enddef; +vardef voctant expr a = + if known a: + voctant_list[floor (a/45 + .5)] + else: + "c" + fi +enddef; +string voctant_list[]; +voctant_list[-4] := "r"; +voctant_list[-3] := "rt"; +voctant_list[-2] := "t"; +voctant_list[-1] := "lt"; +voctant_list[0] := "l"; +voctant_list[1] := "lb"; +voctant_list[2] := "b"; +voctant_list[3] := "rb"; +voctant_list[4] := "r"; +vardef vdump = + message ">>>>> Vertices and arcs for diagram #" & decimal charcode + & " of " & jobname & ".mf:"; + for i = vertices: + message "> " & vlist[i]name & "=" & decimal_pair (vlist[i]loc) + & ": #lines=" + & decimal (vlist[i]arc.last - vlist[i]arc.first + 1) + if vlist[i]lbl <> "": + & ", lbl=" & vlist[i]lbl + & ", l.angle=" & decimal_ (vlist[i]lbl.ang) + & ", l.dist=" & decimal_ (vlist[i]lbl.dist) + fi + & "."; + endfor + for i = vertices: + for j = varcs (i): + if known vlist[i]arc[j]sty: + message "> " & vlist[i]name & "*" & vlist[vlist[i]arc[j]]name + & ": " & vlist[i]arc[j]sty + & ", tns=" & decimal_ (vlist[i]arc[j]tns) + & ", lsr=" & decimal_ (vlist[i]arc[j]lsr) + & ", wd=" & decimal_ (vlist[i]arc[j]wd) + & ", rub=" & decimal_ (vlist[i]arc[j]rub) + if vlist[i]arc[j]lbl <> "": + & ", lbl=" & vlist[i]arc[j]lbl + & ", l.side=" & vlist[i]arc[j]lbl.side + & ", l.dist=" & decimal_ (vlist[i]arc[j]lbl.dist) + fi + & "."; + fi + endfor + for j = vconstr (i): + if i < vlist[i]constr[j]: + save z; + pair z; + z = vlist[vlist[i]constr[j]]loc - vlist[i]loc; + message "> " & vlist[i]name & "&" + & vlist[vlist[i]constr[j]]name + & ": " & decimal_pair (z); + fi + endfor; + endfor +enddef; +vardef decimal_ (text n) = + if known n: decimal n else: "?" fi +enddef; +vardef decimal_pair (text z) = + "(" & decimal_ (xpart z) & "," & decimal_ (ypart z) & ")" +enddef; +def show_diagram_ expr frame = + if (screen_cols < w + 2 xpart frame) or (screen_rows < h + 2 ypart frame): + screen_cols := w + 2 xpart frame; + screen_rows := h + 2 ypart frame; + openwindow currentwindow + from origin to (screen_rows, screen_cols) + at (- xpart frame, h + ypart frame); + fi + showit_; + if showstopping > 0: + stop "This is diagram #" & decimal charcode + & ". Hit return to continue..."; + fi +enddef; +def show_diagram = + def show_diagram = + display blankpicture inwindow currentwindow; + show_diagram_ + enddef; + show_diagram_ +enddef; +def show_all_diagrams expr frame = + def showit = show_diagram frame enddef; + displaying:=1; +enddef; +endinput; +\endinput +%% +%% End of file `feynmf.mf'. diff --git a/Master/texmf-dist/metafont/mftoeps/mftoeps.mf b/Master/texmf-dist/metafont/mftoeps/mftoeps.mf new file mode 100644 index 00000000000..46bc5a1cb9d --- /dev/null +++ b/Master/texmf-dist/metafont/mftoeps/mftoeps.mf @@ -0,0 +1,748 @@ +%%%% +%%%% This file belongs to the MFTOEPS package. +%%%% +%%% mod div +%%% length cycle pos_turn neg_turn +%%% endchar ori_endchar +%%% draw eofill killtext +%%% draw find_BB set_BB reset_BB +%%% draw draw_C normal_draw_C no_export_draw_C +%%% draw fill_C normal_fill_C no_export_fill_C +%%% draw clip_C normal_clip_C +%%% draw write_preamble normal_write_preamble no_export_write_preamble +%%% endchar write_postamble normal_write_postamble no_export_write_postamble +%%% endchar g_save g_restore +%%% message write_PS normal_write_PS +%%% draw write_def +%%% draw fix_line_width set_line_width +%%% draw fix_line_join set_line_join fix_line_cap set_line_cap +%%% draw fix_miter_limit set_miter_limit fix_dash set_dash +%%% draw fix_fill_cmyk set_fill_cmyk fix_draw_cmyk set_draw_cmyk +%%% draw fix_fill_rgb set_fill_rgb fix_draw_rgb set_draw_rgb +%%% xpart norm_color +%%% mode_setup ori_mode_setup eps_mode_setup EPS_mode_setup +%%% draw mftoeps_default +%%\vsize245mm +%%\font\titfnt cmtt10 at 48 pt +%%{\let\makefootline\empty \let\makeheadline\empty +%%\vglue0ptplus1fill +%%\centerline{\titfnt MFTOEPS.MF} +%%\bigskip +%%\centerline{ver. 0.68 (Tuesday, March 4th, 1997)} +%%\vfill\vfill\eject} +% --- +% \MF format for exporting to EPS via LOG-file + AWK-like utility +% --- +% NAME: MFTOEPS.MF +% AUTHORS: B. Jackowski, P. Pianowski, M. Ry\'cko +% HISTORY: +% Version 0.5 (Friday, May 5th, 1995): first public domain release +% Version 0.6 (Thursday, July 27th, 1995): major revision +% * macro |reset_BB| added (it was silly not to have it) +% * |pickup pencircle scaled 0.4pt| performed by |no_export_write_preamble| +% * `mftoeps_bhook' and `mftoeps_ehook' introduced +% * `setlinecap', `setlinejoin', `setmiterlimit', and `setdash' included +% * switching between no export and compatibility modes made more tidy +% * colours are forced to fall into the interval [0..1] +% * formatting, comments and internal naming altered +% Version 0.65 (Friday, September 1st, 1995): +% A lot of small changes introduced introduced during the work over +% PSTOEPS and EPSTOMF converters, and over ROEX macros: +% * defaults for line joins and caps changed (WARNING: incompatibility +% with the version 0.6 described in proceedings of 9th European \TeX +% Conference, Arnhem, Holland); now they are compatible with PostScript, +% not with our predilections +% * `gsave'/`grestore' grouping added (macros |g_save| and |g_restore|); +% the graphic object is embedded into a `gsave'/`grestore' pair +% * |set_BB| and |find_BB| available also in no-export mode +% * string variable |extra_eps_setup| added +% * a general purpose macro |make_list| added +% * version number appears in the header of EPS file +% * |reset_BB| performed by newly introduced |no_export_write_postamble| +% * definitions of EPS header more robust +% * macros |pos_turn|, |neg_turn|, and |is_line| more robust +% * global defaults defined as in ROEX (macro |mftoeps_default|) +% * code optimized, formatting slightly altered (e.g., the underscore +% character ending a name appears as a superscript asterisk) +% This version was released during the 9th EuroTeX meeting in Arnhem +% Version 0.66 (Tuesday, September 19th, 1995): +% * |find_BB| a bit more robust +% * |is_line| is exactly the same as in ROEX.MF (it should have been +% in version 0.65...) +% This version was released during the CyrTUG-95 meeting in Moscow +% Version 0.67 (Friday, October 27th, 1995): +% * |miter_limit| used to be a dimen; it was my mistake (BJ), +% in PostScript it is a dimensionless quantity +% Version 0.68 (Tuesday, March 4th, 1997): +% * |extra_preamble| and |extra_postamble| added +% --- +if known mftoeps: expandafter endinput fi % no double loading +mftoeps:=1; +vardef mftoeps_ver ="0.68" enddef; +% --- +% DECLARATIONS (only explicitly needed): +no_export_level=0; compatibility_level=1; % constants +let ori_mode_setup=mode_setup; +let ori_endchar=endchar; +boolean closed_path; % set by |normal_fill_C|, |normal_draw_C|, + % |close_op|, and just before writing definitions + % of |mid_draw_op|; checked by |mid_draw_op|; +boolean dash_array_empty; % used locally by |set_dash| +boolean known_yes_eps; % used by |eps_mode_setup| +string extra_eps_setup; % used by |eps_mode| for last-minute adjustments +extra_eps_setup=""; % usually there's nothing special to do +string extra_preamble, extra_postamble; % for special comments and/or defs +extra_preamble=extra_postamble=""; % usually there's nothing special to add +% We follow the naming convention of The \MF{}book: +% ``Private tokens always end with the underscore character.'' +% Since the underscore is a rather illegible character, in a ``neat'' +% printing (using MFT utility) it will appear as an superscript asterisk. +%% % an innocent formatting trick: the underscore character ending a name +%% % will be typeset as an superscript asterisk +%% \let\oriunderscore\_ +%% \newif\ifbgroupopen \bgroupopenfalse +%% \def\altdblbackslash#1{\bgroup\bgroupopentrue\it#1} +%% \def\optegroup{\ifbgroupopen\egroup\fi} +%% \def\underscoreasasterisk#1{% +%% \ifx#1\relax\optegroup^*\else\oriunderscore#1\fi} +%% \def\\#1{% +%% \let\_\underscoreasasterisk +%% \altdblbackslash{#1\relax}\optegroup +%% \let\_\oriunderscore} +% --- +def make_list(expr k,l) suffix s = + for i_:=k upto l: if i_>k: , fi \\ s[i_] endfor +enddef; +% --- +vardef distance(expr za,zb) = length(za-zb) enddef; % in fact, an alias +% --- +vardef pos_turn primary p = + interim autorounding:=0; + if check_turn(p)=0: show p; + errhelp "I will leave the path intact, continue with crossed fingers."; + errmessage "Cannot make positive turn (check_turn=0)"; + elseif check_turn(p)<0: reverse fi \\ p +enddef; +% --- +vardef neg_turn primary p = + interim autorounding:=0; + if check_turn(p)=0: show p; + errhelp "I will leave the path intact, continue with crossed fingers."; + errmessage "Cannot make negative turn (check_turn=0)"; + elseif check_turn(p)>0: reverse fi \\ p +enddef; +% --- +vardef check_turn primary p = % seems more adequate than |turningnumber| +% |epsilon|=|totalweight currentpicture| after |fill unitsquare|, +% |eps/epsilon=32|, i.e., we admit accuracy of 32 pixels (isn't it too many?) + save r_,currentpicture; picture currentpicture; + interim turningcheck:=0; interim autorounding:=0; + currentpicture:=nullpicture; fill p; r_:=totalweight(currentpicture); + if r_>eps: 1 elseif r_<-eps: -1 else: turningnumber(p) fi +enddef; +% --- +vardef is_line(expr B) = +% checks if a B\'ezier segment |B| is an almost straight line; +% recall that |z reflectedabout (origin,right)=1/z| for a complex +% number |z| such that |length(z)=1|; recall also that the multiplication +% of complex numbers (|zscale| operation) implies the addition of +% their angle arguments + save pa_,pb_,pc_,pd_,ba_,da_,dc_; pair pa_,pb_,pc_,pd_,ba_,da_,dc_; + pa_:=point 0 of B; pd_:=point 1 of B; + if distance(pa_,pd_)<epsil.dist: + false % either really not a line or an uncertain situation (rounding errors) + else: + da_=unitvector(pd_-pa_) reflectedabout (origin,right); + pb_:=postcontrol 0 of B; if distance(pa_,pb_)<epsil.dist: pb_:=pa_; fi + pc_:=precontrol 1 of B; if distance(pd_,pc_)<epsil.dist: pc_:=pd_; fi + if (pa_=pb_) and (pc_=pd_): true + elseif (pa_=pb_): + dc_=unitvector(pd_-pc_); abs(angle(dc_ zscaled da_))<epsil.ang + elseif (pc_=pd_): + ba_=unitvector(pb_-pa_); abs(angle(ba_ zscaled da_))<epsil.ang + else: + ba_=unitvector(pb_-pa_); dc_=unitvector(pd_-pc_); + (abs(angle(ba_ zscaled da_))<epsil.ang) + and (abs(angle(dc_ zscaled da_))<epsil.ang) + fi + fi +enddef; +% --- +def eofill expr P = + begingroup save pp_; picture pp_; + interim turningcheck:=0; +% the following |addto|s are supposed to fill disjoint areas: + pp_:=nullpicture; addto pp_ contour P.t_; + cull pp_ keeping (1,infinity); addto currentpicture also pp_; + pp_:=nullpicture; addto pp_ contour reverse P.t_; + cull pp_ keeping (1,infinity); addto currentpicture also pp_; + cull currentpicture keeping(1,1); + endgroup +enddef; +% --- +def normal_write_PS expr s = if s<>"": message ":PS: " & s; fi enddef; +% --- +def write_P (expr op,P) = +% writes a point |P| in PostScript, followed by the operation |op| + write_PS bp_pair(P) & op; +enddef; +% --- +def write_B (expr op,B) = +% writes a B\'ezier segment |B| in PostScript, followed by the operation |op| + write_PS bp_pair(postcontrol 0 of B) & bp_pair(precontrol 1 of B) & + bp_pair(point 1 of B) & op; +enddef; +% --- +def write_L (expr op,L) = +% writes a line |L| in PostScript, followed by the operation |op| + write_PS bp_pair(point 1 of L) & op; +enddef; +% --- +vardef write_C (expr C) = +% writes a B\'ezier curve |C| in PostScript followed by an operation +% which depends on whether |C| is cyclic or not + save ll_; + ll_:= % |(length(C)-ll_,length(C)-ll_+1)| is the last segment processed + if (cycle C) and ((point length(C) of C) = (point length(C)-1 of C)): + 2 % artificial situation related to an old EPS2MF converter + else: 1 fi; + write_P(move_op,point 0 of C); + for tt_:=0 upto length(C)-ll_: + if is_line(subpath (tt_,tt_+1) of C): + write_L(line_op,subpath (tt_,tt_+1) of C); + else: + write_B(bezi_op,subpath (tt_,tt_+1) of C); + fi + endfor + if cycle C: write_PS close_op; fi +enddef; +% --- +def no_export_fill_C text t = + begingroup + save rr_; picture rr_; % must not be |pp_| (see |eofill|) + begingroup + save currentpicture; def currentpicture = rr_ enddef; % danger! + currentpicture:=nullpicture; for qq_:=t: eofill qq_; endfor + endgroup; + addto currentpicture also rr_; cullit; + endgroup +enddef; +% --- +def normal_fill_C text t = + write_PS beg_path_op; + set_fill_cmyk; + for pp_:=t: + write_C(pp_); write_PS mid_fill_op; closed_path:=false; + endfor + write_PS end_path_op; +enddef; +% --- +def no_export_draw_C text t = for pp_:=t: draw pp_; endfor enddef; +% --- +def normal_draw_C text t = + write_PS beg_path_op; + set_draw_cmyk; set_line_width; + set_line_join; set_line_cap; + set_miter_limit; set_dash; + for pp_:=t: + write_C(pp_); write_PS mid_draw_op; closed_path:=false; + endfor + write_PS end_path_op; +enddef; +% --- +def normal_clip_C text t = + clipping_count:=0; % local + for pp_:=t: clipping_count:=clipping_count+1; endfor + if clipping_count=0: + if clipping_level>0: g_restore; clipping_level:=clipping_level-1; fi + else: + clipping_level:=clipping_level+1; g_save; + write_PS beg_path_op; + for pp_:=t: write_C(pp_); write_PS mid_clip_op; endfor + write_PS end_path_op; + fi +enddef; +% --- +vardef update_BC(expr C)(suffix xl,yl,xh,yh) = +% updates variables |xl|, |yl|, |xh|, |yh| by finding extremal points +% of a B\'ezier curve |C| + if xl>xpart(point 0 of C): xl:=xpart(point 0 of C); fi + if xh<xpart(point 0 of C): xh:=xpart(point 0 of C); fi + if yl>ypart(point 0 of C): yl:=ypart(point 0 of C); fi + if yh<ypart(point 0 of C): yh:=ypart(point 0 of C); fi + for tt_:=0 upto length(C)-1: + update_BB(subpath (tt_,tt_+1) of C,xl,yl,xh,yh); + endfor +enddef; +% --- +vardef update_BB(expr B) (suffix xl,yl,xh,yh) = +% updates variables |xl|, |yl|, |xh|, |yh| by finding extremal points +% of a B\'ezier segment |B|; the |point 0 of B| is not taken into account + save Bx_,By_,ta_,tb_,vv_; path Bx_, By_; numeric ta_,tb_,vv_; +% + Bx_=(0,xpart(point 0 of B)) + ..controls + (0,xpart(postcontrol 0 of B)) and (1000,xpart(precontrol 1 of B)) + ..(1000,xpart(point 1 of B)); + By_=(0,ypart(point 0 of B)) + ..controls + (0,ypart(postcontrol 0 of B)) and (1000,ypart(precontrol 1 of B)) + ..(1000,ypart(point 1 of B)); +% + ta_:=directiontime right of Bx_; + if ta_>0: + vv_:=ypart (point ta_ of Bx_); + if vv_<xl: xl:=vv_; fi\\ if vv_>xh: xh:=vv_; fi + tb_:=directiontime right of subpath (ta_+eps,1) of Bx_; + if tb_>=0: + vv_:=ypart (point tb_ of (subpath (ta_+eps,1) of Bx_)); + if vv_<xl: xl:=vv_; fi\\ if vv_>xh: xh:=vv_; fi + fi + fi + vv_:=ypart (point 1 of Bx_); if vv_<xl: xl:=vv_; fi\\ if vv_>xh: xh:=vv_; fi +% + ta_:=directiontime right of By_; + if ta_>0: + vv_:=ypart (point ta_ of By_); + if vv_<yl: yl:=vv_; fi\\ if vv_>yh: yh:=vv_; fi + tb_:=directiontime right of subpath (ta_+eps,1) of By_; + if tb_>=0: + vv_:=ypart (point tb_ of (subpath (ta_+eps,1) of By_)); + if vv_<yl: yl:=vv_; fi\\ if vv_>yh: yh:=vv_; fi + fi + fi + vv_:=ypart (point 1 of By_); if vv_<yl: yl:=vv_; fi\\ if vv_>yh: yh:=vv_; fi +enddef; +% --- +% |xl|, |yl|, |xh|, and |yh| can likely be used in a program, hence +% longer names: |xl_crd|, |yl_crd|, |xh_crd|, and |yh_crd|, respectively +def reset_BB = + xl_crd:=whatever; yl_crd:=whatever; xh_crd:=whatever; yh_crd:=whatever; +enddef; +% --- +def find_BB text t = + for CC_:=t: % |t| may be empty + if unknown xl_crd: xl_crd=yl_crd=-xh_crd=-yh_crd=infinity; fi + update_BC(CC_)(xl_crd,yl_crd,xh_crd,yh_crd); + endfor +enddef; +% --- +vardef llxy = (xl_crd,yl_crd) enddef; +vardef urxy = (xh_crd,yh_crd) enddef; +% --- +def set_BB text t = +% it may happen that |t| refers to the previously fixed coordinates of the +% bounding box, therefore the coordinates should not be changed too early + numeric xl_crd_, yl_crd_, xh_crd_, yh_crd_; + for rr_:=t: % syntax trick + if pair rr_: + for ss_:=xpart rr_, ypart rr_: + if unknown xl_crd_: xl_crd_:=ss_; + elseif unknown yl_crd_: yl_crd_:=ss_; + elseif unknown xh_crd_: xh_crd_:=ss_; + elseif unknown yh_crd_: yh_crd_:=ss_; + fi + endfor + else: + if unknown xl_crd_: xl_crd_:=rr_; + elseif unknown yl_crd_: yl_crd_:=rr_; + elseif unknown xh_crd_: xh_crd_:=rr_; + elseif unknown yh_crd_: yh_crd_:=rr_; + fi + fi + endfor + numeric xl_crd, yl_crd, xh_crd, yh_crd; + xl_crd:=xl_crd_; yl_crd:=yl_crd_; xh_crd:=xh_crd_; yh_crd:=yh_crd_; +enddef; +% --- +% somewhat unusual formula was employed in the definition of |bp_num| +% because |(72/300)*x| is not equivalent to |72/300x|: the latter yields +% better accuracy +vardef bp_num primary x = + decimal(scantokens("72/" & decimal(pixels_per_inch))x) +enddef; +vardef bp_pair primary z = + bp_num(xpart(z)) & " " & bp_num(ypart(z)) & " " +enddef; +% --- +mode_def eps_mode = + proofing:=0; % no, we're not making proofs + fontmaking:=0; % no, we're not making a TFM file + tracingtitles:=1; % yes, show titles online + pixels_per_inch:=300; % standard laser printer resolution + blacker:=0; % no additional blackness + fillin:=0; % no compensation for fillin + o_correction:=1; % no reduction in overshoot + mag:=1; % standard magnification + autorounding:=0; % removing pimples is unimportant + scantokens extra_eps_setup; % the user's special last-minute adjustments +enddef; +% --- +mode_def vicar_mode = + proofing:=0; % no, we're not making proofs + fontmaking:=0; % no, we're not making a TFM file + tracingtitles:=1; % yes, show titles online + pixels_per_inch:=300; % standard laser printer resolution + blacker:=0; % no additional blackness + fillin:=0; % no compensation for fillin + o_correction:=1; % no reduction in overshoot + mag:=1; % standard magnification +enddef; +% --- +def EPS_mode_setup = eps_mode_setup enddef; % an alias (upward compatibility) +def eps_mode_setup suffix e_l = +% fixing |export_level|: + known_yes_eps:=(known yesEPS) or (known YESEPS) or (known yeseps); + if not known_yes_eps: export_level:=no_export_level; + elseif str e_l="": export_level:=compatibility_level; + else: + if + (if known e_l: + (e_l=no_export_level) or (e_l=compatibility_level) + else: + false + fi): + export_level:=e_l; + else: + message "Default export level assumed."; + export_level:=compatibility_level; + fi + fi +% |mode_setup| hackery (last chance to abandon exporting): + if export_level<>no_export_level: + if not (string mode): mode:=vicar_mode; fi % for hackers only + mode_setup; % trial setup + if proofing>0: export_level:=no_export_level; fi % proofing has priority + fi +% now either |export_level=no_export_level| +% or |export_level=compatibility_level): + if export_level=no_export_level: + let mode_setup=ori_mode_setup; mode_setup; + let endchar=ori_endchar; + let write_PS=killtext; + let write_preamble=no_export_write_preamble; + let write_postamble=no_export_write_postamble; + let fill_C=no_export_fill_C; + let draw_C=no_export_draw_C; + let clip_C=killtext; + else: % |error_level=compatibility_level| + if not (string mode): mode:=eps_mode; fi % for hackers only + mode_setup; % set private mode + let mode_setup=relax; % no more |mode_setup|s + def endchar = % no shipping characters out + scantokens extra_endchar; endgroup + enddef; + let write_PS=normal_write_PS; + let write_preamble=normal_write_preamble; + let write_postamble=normal_write_postamble; + let fill_C=normal_fill_C; + let draw_C=normal_draw_C; + let clip_C=normal_clip_C; + fi +enddef; +% --- +def plain_new_path_op = "newpath" enddef; +def plain_close_op = "closepath" enddef; +def plain_move_op = "moveto" enddef; +def plain_line_op = "lineto" enddef; +def plain_bezi_op = "curveto" enddef; +def plain_fill_op = "eofill" enddef; +def plain_draw_op = "stroke" enddef; +def plain_clip_op = "eoclip" enddef; +def plain_set_line_width_op = "setlinewidth" enddef; +def plain_set_fill_cmyk_op = "setcmykcolor" enddef; +def plain_set_draw_cmyk_op = "setcmykcolor" enddef; +def plain_set_line_join_op = "setlinejoin" enddef; +def plain_set_line_cap_op = "setlinecap" enddef; +def plain_set_miter_limit_op = "setmiterlimit" enddef; +def plain_set_dash_op = "setdash" enddef; +def plain_g_save_op = "gsave" enddef; +def plain_g_restore_op = "grestore" enddef; +% --- +% there is some inconsistency between Corel and AI (it could be said that +% even between Corel and Corel, and between AI and AI), therefore the code +% for filling, drawing and clipping operations is somewhat messy... +% --- +def close_op = begingroup closed_path:=true; "" endgroup enddef; +def close_path_op = "h" enddef; +def move_op = "m" enddef; +def line_op = "l" enddef; +def bezi_op = "c" enddef; +def beg_path_op = "*u" enddef; +def end_path_op = "*U" enddef; +let beg_fill_op=beg_path_op; +def mid_fill_op = "f" enddef; +def end_fill_op = "*U*f" enddef; +let beg_draw_op=beg_path_op; +def mid_draw_op = if closed_path: "s" else: "S" fi enddef; +def end_draw_op = "*U*d" enddef; +let beg_clip_op=beg_path_op; +def prep_clip_op = "W" enddef; % AI-oriented, here just empty +def do_clip_op = "n" enddef; +def mid_clip_op = + close_path_op & " " & prep_clip_op & " " & do_clip_op +enddef; +def end_clip_op = "*U*c" enddef; +def set_line_width_op = "w" enddef; +def set_fill_cmyk_op = "k" enddef; +def set_draw_cmyk_op = "K" enddef; +def set_line_join_op = "j" enddef; +def set_line_cap_op = "J" enddef; +def set_miter_limit_op = "M" enddef; +def set_dash_op = "d" enddef; +def g_save_op = "q" enddef; +def g_restore_op = "Q" enddef; +% --- +def mark_null = "/oper_kind -1 def" enddef; +def mark_fill = "/oper_kind 0 def" enddef; +def mark_draw = "/oper_kind 1 def" enddef; +def mark_clip = "/oper_kind 2 def" enddef; +def check_fill = "0 oper_kind eq" enddef; +def check_draw = "1 oper_kind eq" enddef; +def check_clip = "2 oper_kind eq" enddef; +% --- +def write_def(expr p,q) = + if p<>"": write_PS "/" & p & " {" & q & "} def"; fi +enddef; +% --- +def no_export_write_preamble expr s = pickup pencircle scaled 0.4pt; enddef; +def normal_write_preamble expr s = + message "generating " & s & ".eps"; + if unknown testing: + batchmode; % don't write mess to the terminal + fi + message ":EPS FILE NAME: " & s; + write_PS "%!PS-Adobe-2.0 EPSF-2.0"; + write_PS "%%Creator: MFTOEPS ver. " & mftoeps_ver; + if (known xl_crd) and (known yl_crd) and (known xh_crd) and (known yh_crd): + write_PS "%%BoundingBox: " & bp_num(xl_crd) & " " & bp_num(yl_crd) + & " " & bp_num(xh_crd) & " " & bp_num(yh_crd); + else: + xl_crd:=0; xh_crd:=72bp; yl_crd:=0; yh_crd:=72bp; + if unknown testing: + errorstopmode; % switch temporarily to the usual mode + fi + message "Unknown bounding box (0 0 72 72 assumed)"; + if unknown testing: + batchmode; % again don't write mess to the terminal + fi + write_PS "%%BoundingBox: 0 0 72 72"; + fi + write_PS "%%Title: " & s & ".eps"; + write_PS "%%CreationDate: " & decimal(day) & "." if month<10: & "0" fi + & decimal(month) & "." & decimal(year) & " " & decimal(time div 60) + & ":" if (time mod 60)<10: & "0" fi & decimal(time mod 60); + write_PS "%%DocumentStyle: compatibility " + & "(CorelDRAW! & Adobe Illustrator oriented)"; + write_PS "%%DocumentFonts:"; + write_PS "%%EndComments"; + write_PS "%%BeginProlog"; + write_PS "/mftoeps_export 100 dict def % you may wish to add some entries"; + write_PS "mftoeps_export begin"; + write_def (close_op,plain_close_op); + write_def (close_path_op,plain_close_op); + write_def (move_op,plain_move_op); + write_def (bezi_op,plain_bezi_op); + write_def (line_op,plain_line_op); + write_def (set_fill_cmyk_op,plain_set_fill_cmyk_op); + write_def (set_draw_cmyk_op,plain_set_draw_cmyk_op); + write_def (beg_path_op,mark_null); + write_def (end_path_op, + end_fill_op & " " & end_draw_op & " " & end_clip_op); + write_def (mid_fill_op,mark_fill); + write_def (end_fill_op,check_fill & " {" & plain_fill_op & "} if") + closed_path:=true; + write_def (mid_draw_op, plain_close_op & " " & mark_draw); + closed_path:=false; + write_def (mid_draw_op, mark_draw); + write_def (end_draw_op,check_draw & " {" & plain_draw_op & "} if") + write_def (prep_clip_op,""); + write_def (do_clip_op, mark_clip); + write_def (end_clip_op,check_clip & + " {" & plain_clip_op & " " & plain_new_path_op & "} if"); + write_def (set_line_width_op,plain_set_line_width_op); + write_def (set_line_join_op,plain_set_line_join_op); + write_def (set_line_cap_op,plain_set_line_cap_op); + write_def (set_miter_limit_op,plain_set_miter_limit_op); + write_def (set_dash_op,plain_set_dash_op); + write_PS "/setcmykcolor where {pop}"; + write_PS " {/setcmykcolor {1 sub /mf exch def"; + write_PS " 3 {mf add neg dup 0 lt {pop 0} if 3 1 roll} repeat"; + write_PS " setrgbcolor} def} ifelse"; + write_def (g_save_op,plain_g_save_op); + write_def (g_restore_op,plain_g_restore_op); + write_PS "/mftoeps_bhook where {pop mftoeps_bhook} {} ifelse"; + scantokens extra_preamble; + write_PS "%%EndProlog"; + write_PS "%%BeginSetup"; % important structural comment + write_PS "%%EndSetup"; % ditto + g_save; + fix_line_width 0.4pt; + fix_fill_cmyk 0,0,0,1; + fix_draw_cmyk 0,0,0,1; + fix_line_join default_line_join; + fix_line_cap default_line_cap; + fix_miter_limit default_miter_limit; + clipping_level:=0; + fix_dash () 0; +enddef; +% --- +def no_export_write_postamble = reset_BB; enddef; +def normal_write_postamble = + forever: exitif clipping_level=0; clip_C; endfor + g_restore; + write_PS "%%Trailer"; + write_PS "/mftoeps_ehook where {pop mftoeps_ehook} {} ifelse"; + scantokens extra_postamble; + write_PS "end showpage"; + if unknown testing: + errorstopmode; % switch to the usual mode + fi + message ""; + reset_BB; +enddef; +% --- +def g_save = write_PS g_save_op enddef; +def g_restore = write_PS g_restore_op enddef; +% --- +def fix_dash (text t) expr x = + def current_dash_array = t enddef; current_dash_offset:=x; +enddef; +def set_dash = + dash_array_empty:=true; + write_PS "[" + for dash_array:=current_dash_array: if not dash_array_empty: & " " fi + & hide(dash_array_empty:=false) bp_num(dash_array) + endfor + & "] " & bp_num(current_dash_offset) & " " & set_dash_op; +enddef; +% --- +def fix_line_width expr p = + current_line_width:=max(p,0); pickup pencircle scaled current_line_width; +enddef; +def set_line_width = + write_PS bp_num(if known current_line_width: current_line_width + else: .5[pen_rt-pen_lft,pen_top-pen_bot] fi) & " " & set_line_width_op; +enddef; +% --- +def fix_line_join expr p = + current_line_join:= + if (round(p)<0) or (round(p)>2): default_line_join else: round(p) fi; +enddef; +def set_line_join = + write_PS decimal(if known current_line_join: current_line_join + else: default_line_join fi) & " " & set_line_join_op; +enddef; +% --- +def fix_line_cap expr p = + current_line_cap:= + if (round(p)<0) or (round(p)>2): default_line_cap else: round(p) fi; +enddef; +def set_line_cap = + write_PS decimal(if known current_line_cap: current_line_cap + else: default_line_cap fi) & " " & set_line_cap_op; +enddef; +% --- +def fix_miter_limit expr p = + current_miter_limit:=if p<1: default_miter_limit else: p fi; +enddef; +def set_miter_limit = + write_PS decimal(if known current_miter_limit: current_miter_limit + else: default_miter_limit fi) & " " & set_miter_limit_op; +enddef; +% --- +def set_fill_cmyk = + write_PS decimal(fill_cyan) & " " & decimal(fill_magenta) & + " " & decimal(fill_yellow) & " " & decimal(fill_black) & " " & + set_fill_cmyk_op; +enddef; +def set_draw_cmyk = + write_PS decimal(draw_cyan) & " " & decimal(draw_magenta) & + " " & decimal(draw_yellow) & " " & decimal(draw_black) & " " & + set_draw_cmyk_op; +enddef; +% --- +vardef norm_color expr c = min(1,max(0,c)) enddef; +def fix_fill_cmyk text t = % syntax trick + fill_cyan:=whatever; fill_magenta:=whatever; + fill_yellow:=whatever; fill_black:=whatever; + for vv_:=t: + if unknown fill_cyan: fill_cyan:=norm_color vv_; + elseif unknown fill_magenta: fill_magenta:=norm_color vv_; + elseif unknown fill_yellow: fill_yellow:=norm_color vv_; + elseif unknown fill_black: fill_black:=norm_color vv_; + fi + endfor +enddef; +def fix_draw_cmyk text t = % syntax trick + draw_cyan:=whatever; draw_magenta:=whatever; + draw_yellow:=whatever; draw_black:=whatever; + for vv_:=t: + if unknown draw_cyan: draw_cyan:=norm_color vv_; + elseif unknown draw_magenta: draw_magenta:=norm_color vv_; + elseif unknown draw_yellow: draw_yellow:=norm_color vv_; + elseif unknown draw_black: draw_black:=norm_color vv_; + fi + endfor +enddef; +% --- +def fix_fill_rgb text t = % syntax trick + begingroup + save R_,G_,B_; + for vv_:=t: + if unknown R_: R_:=norm_color vv_; + elseif unknown G_: G_:=norm_color vv_; + elseif unknown B_: B_:=norm_color vv_; + fi + endfor + convert_rgb_to_cmyk(R_,G_,B_) + (fill_cyan, fill_magenta, fill_yellow, fill_black); + endgroup +enddef; +def fix_draw_rgb text t = % syntax trick + begingroup + save R_,G_,B_; + for vv_:=t: + if unknown R_: R_:=norm_color vv_; + elseif unknown G_: G_:=norm_color vv_; + elseif unknown B_: B_:=norm_color vv_; + fi + endfor + convert_rgb_to_cmyk(R_,G_,B_) + (draw_cyan, draw_magenta, draw_yellow, draw_black); + endgroup +enddef; +% --- +def convert_rgb_to_cmyk (expr R,G,B)(suffix C,M,Y,K) = + begingroup + save C_,M_,Y_,K_; C_:=1-R; M_:=1-G; Y_:=1-B; K_:=min(C_,M_,Y_); + C:=min(1, max(0,C_-under_color_removal(K_))); + M:=min(1, max(0,M_-under_color_removal(K_))); + Y:=min(1, max(0,Y_-under_color_removal(K_))); + K:=min(1, max(0,black_generation(K_))); + endgroup +enddef; +% --- +% DEFAULTS: +def mftoeps_default text t = % main global defaults + forsuffixes S_:=t: + if str S_ = "under_color_removal": + vardef under_color_removal(expr k) = 0 enddef; % modify if you know better + elseif str S_ = "black_generation": + vardef black_generation(expr k) = 0 enddef; % ditto + elseif str S_ = "default_miter_limit": + default_miter_limit:=10; % as in PostScript +% incidentally, |10bp| would convert to |10.00002| during export at |300dpi| + elseif str S_ = "default_line_join": default_line_join:=0; % as in PostScript + elseif str S_ = "default_line_cap": default_line_cap:=0; % ditto + elseif str S_ = "epsil.ang": epsil.ang:=.1; % in degrees + elseif str S_ = "epsil.dist": epsil.dist:=1/10pt; % ca |2/5|pxl at |300dpi| + fi + endfor +enddef; +% +mftoeps_default under_color_removal, black_generation, default_miter_limit, + default_line_join, default_line_cap, epsil.ang, epsil.dist; +% --- +endinput; +%%\end diff --git a/Master/texmf-dist/metafont/misc/3test.mf b/Master/texmf-dist/metafont/misc/3test.mf new file mode 100644 index 00000000000..8a62fb1fdd3 --- /dev/null +++ b/Master/texmf-dist/metafont/misc/3test.mf @@ -0,0 +1,53 @@ +% This tries all characters on TEST.MF using three different sets of parameters +% (appropriate for italic styles) +if unknown cmbase: input cmbase fi % omit if CMMF can be assumed +mag=.5; +mode_setup; let mode_setup=\; + +boolean running; +def abort = hide(scrollmode; running:=false) enddef; +def pause=stop "done with char "&decimal charcode&". " enddef; +let iff=always_iff; +def ligtable text t=enddef; +def charlist text t=enddef; +def extensible text t=enddef; + +string currenttitle; +let semi=;; let echar=endchar; let endchar=enddef; +def cmchar expr s = currenttitle:=s; + let;=testchar semi quote def chartext=enddef; +def testchar = semi let;=semi; + % now `chartext echar' will generate the character to be tested + running:=true; errorstopmode; + for k=1 upto 6: + if running: if known params[k]: scantokens params[k]; font_setup; + currentwindow:=k; + currenttitle & ", " & fontname[k]; + chartext echar; fi fi endfor + pause; enddef; + +string params[],fontname[]; +params[1]="ital_params"; fontname[1]="cmti10"; +params[2]="bold_ital_params"; fontname[2]="cmbxti10"; +params[3]="tt_params"; fontname[3]="cmmi10"; + +w_rows=floor 1/2 screen_rows; w_cols=floor 1/3 screen_cols; +def open(expr k,i,j)= + openwindow k from ((i-1)*w_rows,(j-1)*w_cols) to (i*w_rows,j*w_cols) + at (-10,140) enddef; +def openit = + open(1,1,1); open(2,1,2); open(3,1,3); + open(4,2,1); open(5,2,2); open(6,2,3); enddef; + +begingroup delimiters begintext generate; + def makedef(expr s)(text t) = + expandafter def scantokens s = t enddef; flushtext enddef; + def flushtext suffix t = enddef; + for k=1 upto 6: if known params[k]: + makedef(params[k]) + expandafter expandafter expandafter begintext + scantokens ("input "&fontname[k]); fi endfor +endgroup; + +input test +end diff --git a/Master/texmf-dist/metafont/misc/6test.mf b/Master/texmf-dist/metafont/misc/6test.mf new file mode 100644 index 00000000000..9c66d556fd7 --- /dev/null +++ b/Master/texmf-dist/metafont/misc/6test.mf @@ -0,0 +1,55 @@ +% This tries all characters on TEST.MF using six different sets of parameters +if unknown cmbase: input cmbase fi % omit if CMMF can be assumed +mag=.5; +mode_setup; let mode_setup=\; + +boolean running; +def abort = hide(scrollmode; running:=false) enddef; +def pause=stop "done with char "&decimal charcode&". " enddef; +let iff=always_iff; +def ligtable text t=enddef; +def charlist text t=enddef; +def extensible text t=enddef; + +string currenttitle; +let semi=;; let echar=endchar; let endchar=enddef; +def cmchar expr s = currenttitle:=s; + let;=testchar semi quote def chartext=enddef; +def testchar = semi let;=semi; + % now `chartext echar' will generate the character to be tested + running:=true; errorstopmode; + for k=1 upto 6: + if running: if known params[k]: scantokens params[k]; font_setup; + currentwindow:=k; + currenttitle & ", " & fontname[k]; + chartext echar; fi fi endfor + pause; enddef; + +string params[],fontname[]; +params[1]="roman_params"; fontname[1]="cmr10"; +params[2]="sans_params"; fontname[2]="cmssbx10"; +params[3]="tt_params"; fontname[3]="cmtt10"; +params[4]="bold_params"; fontname[4]="cmb10"; +params[5]="quote_params"; fontname[5]="cmssqi8"; +params[6]="ital_params"; fontname[6]="cmti10"; + +w_rows=floor 1/2 screen_rows; w_cols=floor 1/3 screen_cols; +def open(expr k,i,j)= + openwindow k from ((i-1)*w_rows,(j-1)*w_cols) to (i*w_rows,j*w_cols) + at (-10,140) enddef; +def openit = + open(1,1,1); open(2,1,2); open(3,1,3); + open(4,2,1); open(5,2,2); open(6,2,3); enddef; + +begingroup delimiters begintext generate; + def makedef(expr s)(text t) = + expandafter def scantokens s = t enddef; flushtext enddef; + def flushtext suffix t = enddef; + for k=1 upto 6: if known params[k]: + makedef(params[k]) + expandafter expandafter expandafter begintext + scantokens ("input "&fontname[k]); fi endfor +endgroup; + +input test; +bye diff --git a/Master/texmf-dist/metafont/misc/mode2dpi.mf b/Master/texmf-dist/metafont/misc/mode2dpi.mf new file mode 100644 index 00000000000..9ac21940cfb --- /dev/null +++ b/Master/texmf-dist/metafont/misc/mode2dpi.mf @@ -0,0 +1,9 @@ +% Usage: mf '\mode=what_ever_mode; \input mode2dpi' + +let myexit = primitive_end_; +mode_setup; +string dpi; +dpi := decimal round pixels_per_inch; +message "DPI = " & dpi; +fontmaking := 0; +myexit; diff --git a/Master/texmf-dist/metafont/misc/mode2dpixy.mf b/Master/texmf-dist/metafont/misc/mode2dpixy.mf new file mode 100644 index 00000000000..6a5a94abd75 --- /dev/null +++ b/Master/texmf-dist/metafont/misc/mode2dpixy.mf @@ -0,0 +1,12 @@ +% Usage: mf '\mode=what_ever_mode; \input mode2dpi' + +let myexit = primitive_end_; +mode_setup; +string xdpi; +xdpi := decimal round pixels_per_inch; +message "XDPI = " & xdpi; +string ydpi; +ydpi := decimal round (pixels_per_inch * aspect_ratio); +message "YDPI = " & ydpi; +fontmaking := 0; +myexit; diff --git a/Master/texmf-dist/metafont/misc/modename.mf b/Master/texmf-dist/metafont/misc/modename.mf new file mode 100644 index 00000000000..e4a5b54dc5c --- /dev/null +++ b/Master/texmf-dist/metafont/misc/modename.mf @@ -0,0 +1,7 @@ +% Usage: mf '\mode=what_ever_mode; \input modename' + +let myexit = primitive_end_; +mode_setup; +message "MODENAME = " & mode_name[mode]; +fontmaking := 0; +myexit; diff --git a/Master/texmf-dist/metafont/misc/modes.mf b/Master/texmf-dist/metafont/misc/modes.mf new file mode 100644 index 00000000000..ec3086fa3ef --- /dev/null +++ b/Master/texmf-dist/metafont/misc/modes.mf @@ -0,0 +1,2588 @@ +%%\font\tenlogosl=logosl10 +%%\def\logofont{\ifdim\fontdimen1\font>0pt \tenlogosl\else\tenlogo\fi} +%%\def\MF{{\logofont META}\-{\logofont FONT}} +%%\def\9{${\rm\%}}% print initial comments ragged right +%%%% +%%% input generate +%%% def mode_def +%%% end bye primitive_end_ +%%% addto define_whole_vertical_blacker_pixels %%%% missing in plain.mft +%%% addto coding_scheme font_face_byte font_family %%%% like font_size +%%% addto BCPL_string mode_param mode_special_ mode_output_specials_ +%%% true mode_common_setup_ mode_write_white_setup_ %%%% like mode_setup +%%% true landscape landscape_ +%%% good mode_guard_ %%%% variable that take suffixes +%%%% +% +% Compiled 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 2002, 2004, +% 2005 by Karl Berry. This file is not copyrighted and may be used +% freely. You can retrieve the latest version from {\tt +% ftp://ftp.tug.org/tex/modes.mf}, among other places. +% +% Feel free to change the definitions of |localfont|, |screen_cols|, +% and |screen_rows| at the end of file (see explanations below). +% +% If you make a new |mode_def|, please send it to +% {\tt tex-fonts@tug.org}. See further discussion below. +% +% The mode definitions start at `Here are the modes', several hundred +% lines down. +% +% This file can be run through {\tt MFT} and \TeX\ to produce a nice +% pretty-printed listing, which currently runs to some 41 pages. +% +%%\begingroup \tt \catcode`\{=12 \catcode`\}=12 \obeyspaces +% @mffile{ +% author = "The Metafont community", +% version = "3.7", +% date = "Mon Jan 17 12:53:54 PST 2005" +% filename = "modes.mf", +% email = "tex-fonts@tug.org" +% checksum = "2588 12760 93935", +% codetable = "ISO/ASCII", +% supported = "yes", +% docstring = " +%%\endgroup +% +% This file is a collection of putatively all extant \MF\ modes. +% +% If you have a device which is not mentioned in this file, the best +% thing to do is try to find a device with similar resolution (search +% for the appropriate lines), and see if that suits (a list of fonts to +% try is given above). Otherwise, methods for fiddling with the +% parameters are described in detail below. +% +% Unfortunately, the number of modes eats up a lot of memory; if your +% \MF\ has not increased the table sizes, you may need to remove +% some of the modes from this file (please name it something else then, +% e.g., {\tt local.mf}). If you can suggest a way to redefine |mode_def| +% and/or |mode_setup|, even better; right now, the amount of memory +% used is approximately four times the length of the |mode_def| names. +% +% The primary names are intentionally all eight characters or less, and +% strictly lowercase. This makes it feasible to use them for portable +% directory names, and the \TeX\ Directory Structure standard recommends +% doing so. The synonyms are historical equivalents. +% +% It also makes definitions to put specials identifying the mode in +% the \MF\ GF output, and to put the coding scheme and +% other so-called Xerox-world information in the TFM output. +% +% It also defines a macro |landscape| that inverts |aspect_ratio| and +% changes |pixels_per_inch|, so you can say {\tt mode := whatever; +% landscape; ...} to get landscape fonts. But I can't think of any +% reasonable way to reflect the |landscape| in the directory name, so +% there are also |mode_def|'s for the devices with non-square aspect +% ratios in landscape mode. +% +% Finally, it has some code to handle write-white devices better; this +% code comes into play if a |mode_def| includes the statement +% |mode_write_white_setup_;|. Such |mode_def|s should also define +% |blacker_min|. For further discussion of write/white and white/black +% devices, see the file {\tt ftp://ftp.tug.org/tex/write-white}, +% and also Pierre MacKay's article in the proceedings of the +% 1991 Raster Imaging and Digital Typography conference: +% +%%\begingroup \tt \catcode`\{=12 \catcode`\}=12 \obeyspaces +% @String{proc-RIDT91 = "Raster Imaging and Digital Typography II"} +% @String{pub-CUP = "Cambridge University Press"} +% +% @Inproceedings{Mackay:RIDT91-205, +% author = "Pierre A. MacKay", +% title = "Looking at the Pixels: Quality Control for 300 dpi +% Laser Printer Fonts, especially {\MF}s ", +% pages = "205--215", +% crossref = "Morris:RIDT91", +% } +% +% @Proceedings{Morris:RIDT91, +% title = proc-RIDT91, +% booktitle = proc-RIDT91, +% year = "1991", +% editor = "Robert A. Morris and Jacques Andr{\'e}", +% publisher = pub-CUP, +% address = pub-CUP:adr, +% acknowledgement = ack-kb, +% } +%%\endgroup +% +% This file is typically loaded when making a \MF\ base; for example, +% the command line +%%\begingroup \tt \obeyspaces +% inimf plain input modes dump +%%\endgroup +% makes a file {\tt plain.base} (or {\tt plain.bas}, or something like that) +% with all the modes herein defined (plain itself defines modes called +% |proof|, |smoke|, and |lowres|.) +% +% You can make the Computer Modern base with the command line: +%%\begingroup \tt \obeyspaces +% inimf plain input modes input cmbase dump +%%\endgroup +% It's generally best to avoid doing this, since it's +% easy to forget to update them. Just using {\tt plain.base} is simplest. +% +% On Unix systems, you then install the base file in the system directory +% ({\tt /usr/local/share/texmf/web2c} as distributed) as {\tt mf.base}. +% \MF\ uses the name it was invoked as to determine the format +% or base file to read; thus running {\tt mf} reads {\tt mf.base}, running +% {\tt cmmf} reads {\tt cmmf.base}, and so on. {\tt plain.base} and +% {\tt mf.base} should be the same file (either a hard or soft link +% is ok), so the examples in {\sl The \MF book\/} work. +% +% A user selects a particular mode when running \MF +% by assigning to the variable |mode|. For example: +%%\begingroup \tt \obeyspaces +% mf \char`\\mode:=cx; input cmr10 +%%\endgroup +% sets up values appropriate for the CanonCX engine. +% +% If no mode is assigned, the default is |proof| mode, as stated in {\sl +% The \MF book}. This is the cause of the ``{\tt .2602gf}'' files which +% are the subject of periodic questions. The remedy is simply to assign +% a different mode---|localfont|, for example. +% +% Every site should define the mode |localfont| to be a synonym for the +% mode most commonly used. This file defines |localfont| to be |ljfour|. +% The values for |screen_rows| and |screen_cols|, which determine how big +% \MF's window for online output is, should perhaps also be +% changed; certainly individual users should change them to their +% own tastes. +% +% This file defines {\tt ?} to type out a list of all the known +% |mode_def|s (once only). +% +% Technically, a |mode_def| is a \MF\ definition that typically +% consists of a series of assignments to various device-specific variables, +% either primitive or defined in plain. These variables include the +% following (page numbers refer to {\sl The \MF book\/}: +% +% |aspect_ratio|: the ratio of the vertical resolution to the horizontal +% resolution (page 94). +% +% |blacker|: a correction added to the width of stems and similar +% features, to account for devices which would otherwise make them +% too light (page 93). (Write-white devices are best handled by a more +% sophisticated method than merely adding to |blacker|, as explained +% above.) Compare your results with a good high-resolution example, +% such as one of the volumes of {\sl Computers \& Typesetting}. +% If you compare against the output of a typical write-black 300$\,$dpi +% engine, you will almost certainly wind up with something too dark. +% |blacker| should never be negative, the EC fonts do not compile with +% such a value. +% +% |fillin|: a correction factor for diagonals and other features which +% would otherwise be ``filled in'' (page 94). An ideal device would +% have |fillin=0| (page 94). Negative values for |fillin| typically +% have either gross effects or none at all, and should be avoided. +% Positive values lighten a diagonal line, negative values darken it. +% Changes in the |fillin| value tend to have abruptly non-linear effects +% on the various design-sizes and magnifications of a typeface. +% +% |fontmaking|: if nonzero at the end of the job, \MF\ writes +% a TFM file (page 315). +% +% |o_correction|: a correction factor for the ``overshoot'' of curves +% beyond the baseline or x-height. High resolution curves look better +% with overshoot, so such devices should have |o_correction=1|; but +% at low resolutions, the overshoot appears to simply be a distortion +% (page 93). Here some additional comments about |o_correction|, +% courtesy of Pierre MacKay (edited by Karl): +% +% At present, I find that |o_correction| works nicely at 80 pixels per +% em, and gets increasingly disturbing as you move down towards 50 +% pixels per em. Below that I do not think it ought to happen at all. +% +% The problem, of course, is that full |o_correction| is supposed to +% occur only at the zenith and nadir of the curve of `o', which is +% a small region at high resolution, but may be a long line of +% horizontal pixels at medium resolution. The full |o_correction| +% does not change a 300$\,$dpi {\tt cmr10}, but it changes a 21-pixel +% high {\tt cmr12} to be 23 pixels high. The extra height and depth +% is seen along a line of seven pixels at the bottom and five at +% the top. This is a pronounced overshoot indeed. +% +% For high-resolution devices, such as phototypesetters, the values +% for |blacker|, |fillin|, and |o_correction| don't matter all that much, +% so long as the values are within their normal ranges: between +% 0 and 1, with the values approaching 0, 0, and 1 respectively. +% +% |pixels_per_inch|: the horizontal resolution; the \MF\ primitive +% |hppp| (which is what determines the extension on the GF filename, +% as among other things) is computed from this (page 94). (An ``inch'' +% is 72.27$\,$pt in the \TeX\ world.) +% +% To be more precise, you can determine the resolution of a font given +% a |mode_def| and a magnification |m| by simply multiplying +% |pixels_per_inch| for that |mode_def| by |m|. (Your results may differ +% from \MF's if you don't use equivalent fixed-point arithmetic.) +% Then you can determine the number used in the name of the GF font +% output by rounding. For example, a font generated at |magstep(.5)| +% (which is $\sqrt{1.2}$, which \MF\ computes as 1.09544) for a printer +% with |pixels_per_inch=300| will have a resolution of 328.63312 dots +% per inch, and the GF filename will include the number {\tt 329}. +% +% |proofing|: says whether to put additional specials in the GF file for +% use in making proofsheets via, e.g., the utility program {\tt GFtoDVI} +% (page 323--4). +% +% |tracingtitles|: if nonzero, strings that appear as \MF\ statements +% are typed on the terminal (page 187). +% +% Pierre MacKay {\tt mackay@cs.washington.edu} has a collection of Unix +% tools to make up a minifont of indicator characters to help in testing. +% +% Neenie Billawala's article in the April 1987 issue of {\sl TUGboat} +% describes how to test your printer for the best set of values for the +% magic numbers above. Here are some brief comments on the subject, +% courtesy of Rocky Bernstein and Paul Abrahams: +% +% For medium-to-low resolution devices, you can first set the |blacker| +% and |o_correction| to~0 and decide on a |fillin| value by looking at +% the diagonal of a lowercase `z' in {\tt cmtt10}, or various lines in +% LaTeX's {\tt line10} font. The diagonal should be the same thickness +% as the horizontal bars of the `z'. Then I decide on the |blacker| +% value, generally by checking the smaller fonts for too much filling +% in. Finally, you can set the |o_correction| using the guidelines +% suggested above. +% +% The easiest way to make a new |mode_def| is not by modifying this file +% and rebuilding your base file every time. Instead, use a separate file +% that contains the appropriate values for the mode parameters and read +% it in when running \MF. If you're using Dvips or another utility +% that calls {\tt MakeTeXPK} to make PK files, remember you'll have to call +% \MF\ explicitly to make fonts until you've rebuilt the base files. +% +% To use a separate mode file with \MF, use the following +% command line: +%%\begingroup \tt \obeyspaces +% mf \char`\\smode:="newmode.mf"; mag:=magstep (2.0); input cmr10 +%%\endgroup +% substituting whatever font and magnification you wish, or omitting +% the magnification altogether. +% +% The file {\tt newmode.mf} should contain lines like this (with no +% |mode_def| or |enddef|): +%%\begingroup \tt \catcode`\_=12 \obeyspaces +% mode_param (pixels_per_inch, 100); +% mode_param (blacker, 0); +% mode_param (fillin, 0); +% mode_param (o_correction, 1); +% mode_common_setup_; +%%\endgroup +% changing the values as appropriate, of course. Once you're satisfied +% with the parameters, use inimf as described below to rebuild and +% install the plain (and any other) base files. +% +% For more information on the use of |smode|, see page 269 of +% {\sl The \MF book}. +% +% Matt Swift has contributed a short \TeX\ file to help in testing new +% modes. Remember to remove a leading |"%% "| from each line after +% extracting it. (Only a single \% is shown in the printed version.) +% If you don't use this file for testing, please mention what fonts +% at what sizes you tested your new mode on. This will help other +% people wondering where particular values came from. Ideally, +% you would try normal, bold, and italic variants, at sizes around +% 5$\,$pt, 10$\,$pt and 15$\,$pt. +% +%%%% It seems too difficult to get the verbatim stuff right with MFT alone, +%%%% so why not quote the lines with `%%' and leave the processing to TeX? +%%%% The only drawback is that comment lines have to start with a blank, +%%%% since we have two stop MFT from interpreting them as `%%%' comments. +%%%% Therefore it seems best to quote every line with `%% ' consistently +%%%% to make it easier to extract them. +%%%% +%%%% This verbatim mode is from webman.tex, it assumes that no `?' appears +%%%% in the text being copied. I've hacked it to insert a single `%' at +%%%% the start of each line, so that it looks like normal MFT comments. +%%%% +%%\def\verbatim{\begingroup \def\9{{\rm\%}} +%% \def\do##1{\catcode`##1=12 } \dospecials +%% \parskip 0pt \parindent 0pt +%% \catcode`\ =13 \catcode`\^^M=13 +%% \tt \catcode`\?=0 \verbatimdefs \verbatimgobble} +%%{\catcode`\^^M=13{\catcode`\ =13\gdef\verbatimdefs{\def^^M{\ \par\9}\let =\ }} % +%% \gdef\verbatimgobble#1^^M{\9}} +%%%% +%%\verbatim +%% % modetest.tex -- a file to test a METAFONT mode +%% % +%% % by Matt Swift <swift@alum.mit.edu> +%% % +%% % This file is in the public domain. +%% % +%% % \def\fileversion{v1.2} +%% % \def\filedate{1995/12/31} +%% % +%% % This LaTeX 2e file generates a test page useful for finding a good +%% % METAFONT mode for your printer. It includes the most sensitive +%% % letters in three sizes and all standard CMR font shapes. +%% % +%% % I've made the macros abstract, and I think this file could easily +%% % be adapted to test modes for other METAFONT fonts, or simply font +%% % appearance in general. +%% % +%% % If you want to adapt this to a non-LaTeX format, the LaTeX-specific +%% % commands below that must be altered are \documentclass, +%% % \begin{document}, \end{document}, \makeatletter, \makeatother, +%% % \@for, \@setfontsize, \encodingdefault, \pagestyle, \normalfont, +%% % \rmfamily, \sffamily, \ttfamily, \mdseries, \bfseries, \upshape, +%% % \itshape, \scshape, and \slshape. +%% +%% \def\encodingdefault{T1} % New "Cork" font encoding (dc fonts). +%% \def\encodingdefault{OT1} % Old font encoding (cm fonts). +%% +%% \documentclass{article} +%% \begin{document} +%% +%% % This line can be replaced (by, e.g., sed) to contain a mode name. +%% +%% ::Mode:: +%% +%% \def\makesize#1#2#3{ +%% \expandafter\def\csname ptsize#1\endcsname{#2} +%% \expandafter\def\csname blsize#1\endcsname{#3} +%% } +%% +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% % DEFINE HERE THE POINT SIZES with baselineskips you would like to test. % +%% % With the defaults of 5, 10, and 14 point sizes, everything will fit on % +%% % one page very easily. Twocolumn would allow several more sizes. % +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% \makesize {A}{5}{6} +%% \makesize {B}{10}{12} +%% \makesize {C}{14}{18} +%% +%% \def\sizelist{A,B,C} +%% +%% \def\letters{% +%% MoOzZffii-a\"egsS [/$\backslash$\par +%% } +%% +%% \makeatletter +%% \let\setfontsize\@setfontsize +%% \let\for\@for +%% \parindent\z@ +%% \makeatother +%% +%% \pagestyle{empty} +%% +%% \def\showfonts{% +%% % +%% % The groups prevent warnings when intermediate fonts are not available. +%% % +%% {\rmfamily \mdseries \upshape \letters} % allow no space before this +%% {\rmfamily \mdseries \slshape \letters} +%% {\rmfamily \mdseries \itshape \letters} +%% {\rmfamily \mdseries \scshape \letters} +%% +%% {\rmfamily \bfseries \upshape \letters} +%% {\rmfamily \bfseries \slshape \letters} +%% {\rmfamily \bfseries \itshape \letters} +%% +%% {\sffamily \mdseries \upshape \letters} +%% {\sffamily \mdseries \slshape \letters} +%% +%% {\sffamily \bfseries \upshape \letters} +%% +%% {\ttfamily \mdseries \upshape \letters} +%% {\ttfamily \mdseries \slshape \letters} +%% {\ttfamily \mdseries \itshape \letters} +%% {\ttfamily \mdseries \scshape \letters} +%% } +%% +%% % The \expandafters expand \sizelist. +%% % +%% \expandafter \for +%% \expandafter \sizename +%% \expandafter :% +%% \expandafter =% +%% \sizelist +%% \do {\setfontsize {\sizename} +%% {\csname ptsize\sizename\endcsname} +%% {\csname blsize\sizename\endcsname}% +%% \vskip 1ex\noindent +%% \llap{\normalfont\csname ptsize\sizename \endcsname\,pt\quad}% +%% \showfonts} +%% +%% \end{document} +%% % end of modetest.tex +%%?endgroup\par +%%%% +%%%% Not that anyone would recognize this as the end of the docstring... +%%\begingroup \tt \catcode`\{=12 \catcode`\}=12 \obeyspaces +%" +% } +%%\endgroup + +% Don't let ourselves be processed twice. +if known modes_mf: endinput; fi; +modes_mf := 3.7; + +% Identify ourselves in the format file. +base_version := base_version & "/modes 3.7"; + + +%%\vfill\eject +% Here are useful macros (also called definitions) we use throughout. + +% First, some comments about how the |mode_defs| are constructed (from +% {\tt rocky@panix.com}). In the past, |mode_defs| unconditionally +% assigned a value to the various mode-dependent parameters. +% For example, they contained an assignment |fontmaking:=1|, which +% tells \MF\ to write a TFM file. +% +% But suppose you want to generate a font using all of the setup for +% some mode |m|, but do not want to generate a TFM? One could create +% another mode that doesn't have the assignment, but this seems a bit +% wasteful since the rest of the code in the mode would be duplicated. +% Furthermore, given the way the mode definitions were written, it was +% not possible to change the mode parameters. To see why, I review how +% a \MF\ run typically works. +% +% First, \MF\ is invoked with some base file to load. Then you might +% want give additional instructions, such as |scrollmode|, or |mode:=cx|. +% Next, you input a parameter file, say {\tt cmr10}. The parameter file +% calls a driver file such as {\tt roman.mf} with the command +% |generate roman |. Finally, the driver finishes with |bye| or |end|. +% Thus, any additional commands you give after the input of the +% parameter file are ignored. +% +% Usually, one of the first things a driver file does is to call +% |mode_setup|. It is here that the mode parameters are set. (In our +% hypothetical mode, it would be here that |fontmaking| is assigned.) +% +% To allow a flexible setting of |fontmaking|, we can make a simple +% change: in the |mode_def|, first test to see if a value has been +% defined prior and only make the assignment if not. That is: +% |if unknown fontmaking: fontmaking := 1; fi|. +% +% Alas, this doesn't work. Primitives, like |fontmaking|, are always +% |known|. So instead we create ``guard'' variables, specifically, +% |mode_guard_.fontmaking|; we set the guard when we assign the +% parameter. Then we test whether the guard is |known| before we +% actually do an assignment. This allows more flexible definitions: you +% can specify some of the parameters, and keep the defaults for others. +% +% It is also possible to write a program that creates a |mode_def| +% on the fly. Although useful, this has a slightly different focus +% than starting with an existing |mode_def| and changing a couple +% of parameters. In particular, one still has to peek inside the +% file to see what the old values were and set them again (in the +% new context). Also, such on-the-fly |mode_def| generation programs +% are inherently less machine-independent than a scheme that does +% everything in \MF\ itself. +% +% The upshot of all this is the following: we say, e.g., +% |mode_param (fontmaking, 1)| below, instead of using the assignment +% primitive directly. The name (``|mode_param|'') is kept somewhat +% short because you can also use this to override a mode assignment +% on the command line or in response to the {\tt **} prompt. + +def mode_param (suffix v) (expr e) = + if unknown mode_guard_.v: + v := e; + mode_guard_.v := 1; + fi +enddef; + +% This macro is invoked by all the modes, after |pixels_per_inch| +% has been defined, thus saving some space and time. +def mode_common_setup_ = + mode_param (proofing, 0); + mode_param (fontmaking, 1); + mode_param (tracingtitles, if pixels_per_inch > 1200: 1 else: 0 fi); +enddef; + + +% In a similar spirit, here are definitions to change to ``landscape'' +% mode. You just say {\tt mode := whatever; landscape; ...}, +% and when |mode_setup| is executed, the |aspect_ratio| will be +% inverted, and |pixels_per_inch| changed. +def landscape = + extra_setup := extra_setup & "landscape_;" +enddef; + +def landscape_ = + begingroup + interim warningcheck := 0; + pixels_per_inch := aspect_ratio * pixels_per_inch; + aspect_ratio := 1 / aspect_ratio; + fix_units; % Too bad we can't do this after any |extra_setup|. + endgroup +enddef; + + +% Here are macros to add specials with mode information to the GF file. +% +% Specifically, we add the |pixels_per_inch|, |o_correction|, +% |aspect_ratio| (if not 1), |mag|, |fillin|, and |mode_def| name. This +% information can be used to automatically verify that a font file name +% matches the specification within the file. For example, you could +% check that the number in the filename matches |mag*pixels_per_inch|. +% Or, if the |mode_def| name is part of the font directory path +% (e.g., you put fonts in {\tt .../texmf/fonts/pk/cx}), that all of the +% bitmap files in the directory have the expected |mode_def| name. +def mode_special_ (suffix $) = + string s, d; + s := str $; + d := decimal scantokens s; + special s & "=" & d; +enddef; + +def mode_output_specials_ = + begingroup + save d, s, p, p_p_i; + string p; + + interim warningcheck := 0; % In case |pixels_per_inch>4096|. + + % We need the old |pixels_per_inch| to compute + % the true device resolution. + p_p_i = pixels_per_inch / mag; + + % But now we want to change |pixels_per_inch|, + % so |save| the old value. + save pixels_per_inch; + pixels_per_inch := p_p_i; + + special "jobname=" & jobname; + mode_special_ (mag); + + p := if string mode: + mode + else: + substring (0, length (mode_name[mode]) - 1) of mode_name[mode] + fi; + special "mode=" & p; + + mode_special_ (pixels_per_inch); + if aspect_ratio <> 1: + mode_special_ (aspect_ratio); + fi; + mode_special_ (blacker); + mode_special_ (fillin); + mode_special_ (o_correction); + endgroup +enddef; + + +% Here are macros for Xerox-world font info, which can be useful even +% if you never use a Xerox printer. For instance, {\tt crudetype} uses +% the |coding_scheme| and it is nice to have the font family on record. +% This goes into both the TFM file (as |headerbyte| information), and +% into the GF file (as a |special|). + +% Make the string |s| be |n| bytes long. +def BCPL_string (expr s, n) = + for l := if length (s) >= n: n-1 else: length (s) fi: l + for k := 1 upto l: , substring (k - 1, k) of s endfor + for k := l + 2 upto n: , 0 endfor + endfor +enddef; + +% The string |s| names the encoding scheme, e.g., {\tt TeX text}. +def coding_scheme expr s = + headerbyte 9: BCPL_string (s, 40); + special "codingscheme=" & s +enddef; + +% The string |s| names the font family, e.g., {\tt CMR}. +def font_family expr s = + headerbyte 49: BCPL_string (s, 20); + special "fontid=" & s +enddef; + +% The integer |x| gives the family member number, which should be +% between 0 and 255. +def font_face_byte expr x = + headerbyte 72: x; + special "fontfacebyte"; + numspecial x +enddef; + +% So users can say |if known Xerox_world: ... fi|, per {\sl The \MF book}. +Xerox_world := 1; + +% Redefine |end| to put the extra information above in the GF and TFM +% files. This code is based on that on page 321. +inner end; +let primitive_end_ = end; +def end = + if fontmaking > 0: + font_family font_identifier_; + coding_scheme font_coding_scheme_; + font_face_byte max (0, 254 - round 2designsize); + mode_output_specials_; + fi; + primitive_end_ +enddef; + +% {\sl The \MF book} gives |bye| two different definitions (on pages +% 278 and 321). The first is used in {\tt plain.mf} and is merely +% a synoynym for the primitive |end|. The second, which is not part +% of {\tt plain.mf}, is similar to the code given above. We want the +% extra information to get into the output files regardless of whether +% the \MF\ source used |end| or |bye|. The above changed |end|; +% now we have to redefine |bye| again (as on page 278). +outer end, primitive_end_; +let bye = end; + + +% Here are macros to handle write-white devices. +% +% The basic correction for write-white fonts occurs in the definition +% of |font_setup|. This can be used to extend or change the write-black +% definition in Computer Modern's {\tt cmbase.mf} or other base files +% based on CM, such as {\tt dxbase.mf}. This has no effect at 1200$\,$dpi. +def mode_write_white_setup_ = + newinternal blacker_min; + def define_whole_blacker_pixels(text t) = + forsuffixes $=t: $:=hround($.#*hppp+blacker); + if $ <=blacker_min-1: $:=blacker_min; fi endfor enddef; + + def define_whole_vertical_blacker_pixels(text t) = + forsuffixes $=t: $:=vround($.#*hppp+blacker); + if $ <=blacker_min-1: $:=blacker_min _o_; fi endfor enddef; + + % Only do the above once, in case a font file (unnecessarily) + % calls |mode_setup| more than once. + let mode_write_white_setup_ = relax +enddef; + + +%%%% Continue to print block comments ragged right, but also check +%%%% if comments start with \[ indicating lines to be set flush right. +%% +%%\def\9{$\futurelet\next\doit} +%%\let\[=\relax +%%\def\doit{\ifx\next\[% +%% \def\next{\hfill{\rm\%}}\else\def\next{{\rm\%}}\fi\next} +%%%% +%%\vfill\eject +% Here are the modes, given mostly in alphabetical order. + +% From {\tt J.Hicks@warwick.ac.uk}. +mode_def agfafzz = %\[ AGFA 400PS (406dpi) + mode_param (pixels_per_inch, 406); + mode_param (blacker, .2); + mode_param (fillin, 0); + mode_param (o_correction, .6); + mode_common_setup_; +enddef; +AgfaFourZeroZero := agfafzz; + +% From {\tt picheral@univ-rennes1.fr}. +mode_def agfatfzz = %\[ AGFA P3400PS (400dpi) + mode_param (pixels_per_inch, 400); + cx_; +enddef; +AgfaThreeFourZeroZero := agfatfzz; + +% From {\tt rokicki@neon.stanford.edu}. +mode_def amiga = %\[ Commodore Amiga (100dpi) + mode_param (pixels_per_inch, 100); + mode_param (blacker, 0); + mode_param (fillin, 0); + mode_param (o_correction, .2); + mode_common_setup_; +enddef; +onezz := amiga; +OneZeroZero := amiga; + +mode_def aps = %\[ Autologic APS-Micro5 (723dpi) + mode_param (pixels_per_inch, 722.909); + mode_param (blacker, .2); + mode_param (fillin, .2); + mode_param (o_correction, 1); + mode_common_setup_; +enddef; + +% From {\tt rocky@panix.com}. Tested on the single APS-6 at IBM Research. +mode_def apssixhi = %\[ Autologic APS-Micro6 (1016dpi) + mode_param (pixels_per_inch, 1016); + mode_param (blacker, 0); + mode_param (fillin, 0); + mode_param (o_correction, 1); + mode_common_setup_; +enddef; + +% From {\tt ee@dacth51.bitnet}. +mode_def atariezf = %\[ Atari ST SLM 804 printer (300dpi) + mode_param (pixels_per_inch, 300); + mode_param (blacker, 0); + mode_param (fillin, .5); + mode_param (o_correction, 0); + mode_param (blacker_min, 2); + mode_common_setup_; + mode_write_white_setup_; +enddef; +AtariSLMEightZeroFour := atariezf; + +% From {\tt W.Spit@fys.ruu.nl}. {\tt N.Poppelier@elsevier.nl} says that +% different previewers use different resolutions (95$\,$dpi, 96$\,$dpi, +% or 101$\,$dpi), but no one seems to know what the real resolution is. +mode_def atarinf = %\[ Atari previewer (95dpi) + mode_param (pixels_per_inch, 95); + mode_param (blacker, 0); + mode_param (fillin, 0); + mode_param (o_correction, 0.1); + mode_common_setup_; +enddef; +AtariNineFive := atarinf; + +mode_def atarins = %\[ Atari previewer (96dpi) + mode_param (pixels_per_inch, 96); + mode_param (blacker, 0); + mode_param (fillin, 0); + mode_param (o_correction, 0.1); + mode_common_setup_; +enddef; +AtariNineSix := atarins; + +% From {\tt ee@dacth51.bitnet}. +mode_def atariotf = %\[ Atari ST SM 124 screen (101dpi) + mode_param (pixels_per_inch, 101); + mode_param (blacker, 0); + mode_param (fillin, 0); + mode_param (o_correction, .4); + mode_common_setup_; +enddef; +AtariSMOneTwoFour := atariotf; + +mode_def bitgraph = %\[ BBN Bitgraph (118dpi) + mode_param (pixels_per_inch, 118); + mode_param (blacker, .55); + mode_param (fillin, .1); + mode_param (o_correction, .3); + mode_common_setup_; +enddef; + +% From {\tt sjwright@cix.compulink.co.uk}, 9 February 1994. +mode_def bjtenex = %\[ Canon BubbleJet 10ex (360dpi) + mode_param (pixels_per_inch, 360); + mode_param (blacker, .6); + mode_param (fillin, 0); + mode_param (o_correction, .6); + mode_common_setup_; +enddef; + +% {\tt cgweav@eskimo.com} (Clayton Weaver), 4 February 1997. +% Might want to recheck |o_correction|, which could vary per unit. +mode_def bjtzzex = %\[ Canon BubbleJet 200ex (360 dpi) + mode_param (pixels_per_inch, 360); + mode_param (blacker, 1.2); + mode_param (fillin, .2); + mode_param (o_correction, 0); + mode_common_setup_; +enddef; + +% {\tt Alastair.Jenkins@nrsc.no}, 30 January 1997. +mode_def bjtzzs = %\[ Canon BubbleJet 200 (720x360dpi) + mode_param (pixels_per_inch, 720); + mode_param (aspect_ratio , 0.5); + mode_param (blacker, 0.0); + mode_param (fillin, 0); + mode_param (o_correction, 1.0); + mode_common_setup_; +enddef; + +% {\tt Alastair.Jenkins@nrsc.no}, 30 January 1997. +mode_def bjtzzl = %\[ BubbleJet 200 landscape (360x720 dpi) + bjtzzs_; + landscape; +enddef; + +mode_def boise = %\[ HP 2680A (180dpi) + mode_param (pixels_per_inch, 180); + mode_param (blacker, .55); + mode_param (fillin, .1); + mode_param (o_correction, .3); + mode_common_setup_; +enddef; + +% From {\tt Yves.Arrouye@imag.fr}. +mode_def canonbjc = %\[ Canon BJC-600 (360dpi) + mode_param (pixels_per_inch, 360); + mode_param (blacker, 0); + mode_param (fillin, 0); + mode_param (o_correction, .8); + mode_common_setup_; +enddef; +CanonBJCSixZeroZero := canonbjc; + +% From {\tt swartz@cs.wisc.edu}, 8 April 1993. The straightforward +% mode with |blacker=0|, |fillin=0|, |o_correction=1| seems to +% work fine for the Canon EX engine inside Apple's LaserWriter Pro 630. +% It produces light, clear lines and type. But {\tt ajcarr@ccvax.ucd.ie} +% sent in the revised values below on 12 December 1993, tested on +% the major CM fonts at 5, 7, and 10$\,$pt and producing slightly +% better results. +mode_def canonex = %\[ LaserWriter Pro 630 (600dpi) + mode_param (pixels_per_inch, 600); + mode_param (blacker, .2); + mode_param (fillin, .1); + mode_param (o_correction, .85); + mode_common_setup_; +enddef; +CanonEX := canonex; + +mode_def canonlbp = %\[ Symbolics LGP-10 (240dpi) + mode_param (pixels_per_inch, 240); + mode_param (blacker, .2); + mode_param (fillin, .2); + mode_param (o_correction, .4); + mode_common_setup_; +enddef; +CanonLBPTen := canonlbp; + +% This is really 1301.5; MF produces 1301, so use that. +mode_def cg = %\[ Compugraphic 8600 (1301x1569dpi) + mode_param (pixels_per_inch, 1301); + mode_param (aspect_ratio, 1569 / pixels_per_inch); + mode_param (blacker, .2); + mode_param (fillin, .2); + mode_param (o_correction, 1); + mode_common_setup_; +enddef; +CompugraphicEightSixZeroZero := cg; + +mode_def cgl = %\[ Compugraphic 8600 landscape (1569x1302dpi) + cg_; + landscape; +enddef; + +% These values from Linotype Linotronic [13]00 modified to 1200$\,$dpi. +% From {\tt wagman\%muse.hepnet@Csa2.LBL.Gov}. +mode_def cgnszz = %\[ Compugraphic 9600 (1200dpi) + mode_param (pixels_per_inch, 1200); + mode_param (blacker, .65); + mode_param (fillin, -.1); + mode_param (o_correction, .5); + mode_common_setup_; +enddef; +CompugraphicNineSixZeroZero := cgnszz; + +% This has a resolution of |5333 + 1/3| pixels per inch. +mode_def crs = %\[ Alphatype CRS (5333dpi) + mode_param (pixels_per_inch, 4000 + 4000/3); + mode_param (blacker, 4); + mode_param (fillin, 0); + mode_param (o_correction, 1); + mode_common_setup_; +enddef; + +% This applies to the LaserWriter Plus, HP Laserjet, HP Laserjet Plus, +% and also the Canon LBP-LX engine, in the Laserjet IIP, QMS 410, +% and Apple Personal LaserWriter, and also to the CanonSX engine, +% in the LaserWriter II family. And {\tt hammond@jila02.Colorado.EDU} +% says it works well for the ``enhanced-resolution'' LaserJet III. +% {\tt swartz@cs.wisc.edu} is developing a mode for the Canon EX engine +% inside an Apple Pro 630 printer. +mode_def cx = %\[ Canon CX, SX, LBP-LX (300dpi) + mode_param (pixels_per_inch, 300); + mode_param (blacker, 0); + mode_param (fillin, .2); + mode_param (o_correction, .6); + mode_common_setup_; +enddef; +CanonCX := cx; +corona := cx; +dp := cx; % some kind of DataProducts +hplaser := cx; +imagen := cx; +kyocera := cx; +laserwriter := cx; +% I have seen a claim the LaserJet II was the Canon SX +% write-white engine, but I don't think that's right. +laserjethi := cx; +laserjet := cx; +% {\tt ogawa@orion.arc.nasa.gov} says that this is definitely not a +% write-white engine, despite earlier versions of this file claiming +% the contrary. Thus, probably the same parameters as |cx| will do. +CanonSX := cx; +CanonLBPLX := cx; + +% At least magstep 2 is recommended at this low resolution. +mode_def datadisc = %\[ DataDisc (70dpi) + mode_param (pixels_per_inch, 70); + mode_param (blacker, 0); + mode_param (fillin, 0); + mode_param (o_correction, .2); + mode_common_setup_; +enddef; +DD := datadisc; + +mode_def newdd = %\[ DataDisc (70x93dpi) + mode_param (aspect_ratio, 4/3); + datadisc_; +enddef; +DataDiscNew := newdd; + +mode_def newddl = %\[ DataDisc landscape (93x70dpi) + newdd_; + landscape; +enddef; + +% From {\tt mcgrant@rascals.stanford.edu}. True resolution is 98.2236 +% by 102.4. See comments for |DECsmall| just above. +mode_def declarge = %\[ DEC 19-inch, 1280 x 1024 (100dpi) + mode_param (pixels_per_inch, 100); + mode_param (blacker, 0); + mode_param (fillin, 0); + mode_param (o_correction, 0); + mode_common_setup_; +enddef; +DEClarge := declarge; +elvira := declarge; + +% From {\tt mcgrant@rascals.stanford.edu}. True resolution is 78.1069 +% by 86.0612, but a square aspect ratio works better; furthermore, +% Computer Modern isn't prepared to deal with fractional pixel values. +mode_def decsmall = %\[ DEC 17-inch, 1024 x 768 (82dpi) + mode_param (pixels_per_inch, 82); + mode_param (blacker, 0); + mode_param (fillin, 0); + mode_param (o_correction, 0); + mode_common_setup_; +enddef; +DECsmall := decsmall; + +% From {\tt fieberjr@whitman.bitnet}. +mode_def deskjet = %\[ HP DeskJet 500 (300dpi) + mode_param (pixels_per_inch, 300); + mode_param (blacker, 0); + mode_param (fillin, 0); + mode_param (o_correction, .6); + mode_common_setup_; +enddef; +HPDeskJet := deskjet; + +% From {\tt stsmith@ll.mit.edu}, 10 May 93. +% With |fillin=0|, the diagonal of {\tt cmtt10}'s `z' is too thin. +% |blacker=.8| too thin, 2 too thick. +mode_def docutech = %\[ Xerox 8790 or 4045 (600dpi) + mode_param (pixels_per_inch, 600); + mode_param (blacker, 1); + mode_param (fillin, .1); + mode_param (o_correction, 0.9); + mode_common_setup_; +enddef; +XeroxDocutech := docutech; + +% From {\tt waits.mf}. +mode_def dover = %\[ Xerox Dover (384dpi) + mode_param (pixels_per_inch, 384); + mode_param (blacker, 1.2); + mode_param (fillin, 0); + mode_param (o_correction, .6); + mode_common_setup_; +enddef; + +% Reported by Silas Brown, 4 April 2003, via Debian bug 184875. +% {\tt dvips -Ppdf} wants 8000$\,$dpi fonts, so define a mode for that. +mode_def dpdfezzz = %\[ dvips -Ppdf (8000dpi) + mode_param (pixels_per_inch, 4000 * 2); + mode_param (blacker, 0); + mode_param (fillin, 0); + mode_param (o_correction, 1); + mode_common_setup_; +enddef; + +% {\tt ghibo@galileo.polito.it}, for the Amiga ShowDVI previewer. +mode_def eighthre = %\[ EightThree (83dpi) + mode_param (pixels_per_inch, 83); + mode_param (blacker, 0); + mode_param (fillin, 0); + mode_param (o_correction, .2); + mode_common_setup_; +enddef; +EightThree := eighthre; + +% {\tt arno.wagner@acm.org}, 25 November 1997. To print in 360dpi (much +% faster, but lower quality) use the |epstylus| mode instead. This +% printer seems to make smaller dots when printing at 720$\,$dpi and +% larger ones when printing at 360$\,$dpi. I tried 720x1440 resolution +% as well, but found it not worth the additional time. If you use +% Ghostscript, you need at least version 5.03 to support 720$\,$dpi on +% this printer. This mode may work with the Epson Stylus color 800 as +% well. I tested this mode with Matt Swift's test, found above. +% With |fillin| set to zero, the test had no `\' at 5$\,$pt. +% +mode_def epscszz = %\[ Epson Stylus Color 600 (720 dpi) + mode_param (pixels_per_inch, 720); + mode_param (blacker, .25); + mode_param (fillin, 0.5); + mode_param (o_correction, .8); + mode_common_setup_; +enddef; + +% From {\tt metcalf@catfish.LCS.MIT.EDU}, 5 Dec 1992. +mode_def epsdrft = %\[ Epson (120x72dpi) + mode_param (pixels_per_inch, 120); + mode_param (aspect_ratio, 72 / pixels_per_inch); + epson_; +enddef; +epsdraft := epsdrft; + +mode_def epsdrftl = %\[ Epson (72x120dpi) + epsdrft_; + landscape; +enddef; + +% From {\tt metcalf@catfish.LCS.MIT.EDU}, 5 Dec 1992. +mode_def epsfast = %\[ Epson fast (60x72dpi) + mode_param (pixels_per_inch, 60); + mode_param (aspect_ratio, 72 / pixels_per_inch); + epson_; +enddef; + +mode_def epsfastl = %\[ Epson fast landscape (72x60dpi) + epsfast_; + landscape; +enddef; + +% From Hippocrates Sendoukas {\tt <isendo@mail.ariadne-t.gr>}, 17 April 1999. +mode_def epsmed = %\[ Epson med MX/FX 9-pin (240x144dpi) + mode_param (pixels_per_inch, 240); + mode_param (aspect_ratio, 144 / pixels_per_inch); + epson_; +enddef; + +mode_def epsmedl = %\[ Epson med MX/FX 9-pin landscape (144x240dpi) + epsmed_; + landscape; +enddef; + +% These values from Charles Karney, {\sl TUGboat} 8(2), page 133. This +% is for the Epson MX/FX family (-85, -286), which are 9-pin printers. +% The 24-pin LQ family have higher resolutions; no one has sent me +% definitions for them yet. Ditto for Epson's laser printer. +% (Thanks to {\tt cargo@escargot.cray.com} for all this information.) +mode_def epson = %\[ Epson MX/FX 9-pin (240x216dpi) + mode_param (pixels_per_inch, 240); + mode_param (aspect_ratio, 216 / pixels_per_inch); + mode_param (blacker, 0); + mode_param (fillin, 0); + mode_param (o_correction, .2); + mode_common_setup_; +enddef; +EpsonMXFX := epson; +epshi := epson; +epsonfx := epson; + +mode_def epsonl = %\[ Epson MX/FX 9-pin landscape (216x240dpi) + epson_; + landscape; +enddef; + +% From {\tt sdh@po.cwru.edu}, 6 September 93. +% The modes |cx| and |HPLaserJetIIISi| are too spindly. +% This works (not awesome, o's and e's are slightly taller than +% they should be in large pt. fonts) on my Epson Action Laser 1500 +% with LaserJetIIIsi emulation and RITech (Epson's Resolution +% Enhancement). It might work for the model 1000 or some HP's. +mode_def epsonact = %\[ Epson Action Laser 1500 (300dpi) + mode_param (pixels_per_inch, 300); + mode_param (blacker, .8); + mode_param (fillin, 0); + mode_param (o_correction, 0.95); + mode_common_setup_; +enddef; +EpsonAction := epsonact; + +% Corrected to 216$\,$dpi vertically, 5 Dec 1992. +% From {\tt metcalf@catfish.LCS.MIT.EDU}. +mode_def epsonlo = %\[ Epson (120x216dpi) + mode_param (pixels_per_inch, 120); + mode_param (aspect_ratio, 216 / pixels_per_inch); + epson_; +enddef; +epslo := epsonlo; + +mode_def epsonlol = %\[ Epson landscape (216x120dpi) + epsonlo_; + landscape; +enddef; + +% From {\tt Sebastian\_Kirsch@kl.maus.de}, 19 April 1996. In comparison +% to some postscript fonts, the characters seemed to light with blacker +% 0, but much too heavy with a blacker greater than 1. I tried blacker +% .6 and finally settled for .7. All the other values are rather +% fictional, I didn't really test them out. +mode_def epsonsq = %\[ Epson SQ 870 (360dpi) + mode_param (proofing, 0) + mode_param (pixels_per_inch, 360); + mode_param (blacker, .7); + mode_param (fillin, .2); + mode_param (o_correction, .9); + mode_common_setup_; +enddef; +EpsonSQEightSevenZero := epsonsq; + +% Following three modes from {\tt marc@mpi.nl} (Marc Fleischeuers). +% I could not quite get the `z' diagonal to get as thin as the +% horizontal lines, even pushing |fillin| up to 0.8. This printer tends +% to make things lighter on lower resolutions so I compensate a little +% with increasing |blacker|. But not all the way, as this would fill in +% the little holes in the `e' and `s' at 5$\,$pt. Otherwise it's pretty +% cool, not as crisp as an |ljfour| but better than most inkjets I've seen. +mode_def epstypro = %\[ Epson Stylus Pro (360dpi) + mode_param (pixels_per_inch, 360); + mode_param (blacker, 0.2); + mode_param (fillin, 0.8); + mode_param (o_correction, 0); + mode_common_setup_; +enddef; +EpsonStylusPro := epstypro; + +mode_def epstyplo = %\[ Epson Stylus Pro (180dpi) + mode_param (pixels_per_inch, 180); + mode_param (blacker, .35); + mode_param (fillin, 0.8); + mode_param (o_correction, 0); + mode_common_setup_; +enddef; +EpsonStylusProLow := epstyplo; + +% Good time saver, almost as good as 720x720 but a lot faster. +mode_def epstypmd = %\[ Epson Stylus Pro (720x360dpi) + mode_param (pixels_per_inch, 720); + mode_param (aspect_ratio, 360 / pixels_per_inch); + mode_param (blacker, 0); + mode_param (fillin, 0.8); + mode_param (o_correction, 0); + mode_common_setup_; +enddef; +EpsonStylusProMed := epstypmd; + +mode_def epstypml = %\[ Epson Stylus Pro landscape (360x720dpi) + epstypmd_; + landscape; +enddef; +epstypmdl := epstypml; + +mode_def epswlo = %\[ Epson low MX/FX 9-pin (120x144dpi) + mode_param (pixels_per_inch, 120); + mode_param (aspect_ratio, 144 / pixels_per_inch); + epson_; +enddef; + +mode_def epswlol = %\[ Epson low MX/FX 9-pin landscape (144x120dpi) + epswlo_; + landscape; +enddef; + +mode_def esphi = %\[ Epson Stylus Pro (720dpi) + mode_param (pixels_per_inch, 720); + mode_param (blacker, 0); + mode_param (fillin, 0.8); + mode_param (o_correction, 1); + mode_common_setup_; +enddef; +EpsonStylusProHigh := esphi; + +% From {\tt Tobias.Guenzler@uni-konstanz.de}, 8 December 1994. +% +% The |blacker| parameter is the most critical; changing |o_correction| +% has lesser effect, and may also be increased or decreased somewhat. +% I tested this by comparing output with printouts of a HP LaserJet +% printer using the LJ fonts. This printer had the fancy resolution +% enhancement feature (RET) which makes the pixel steps almost +% invisible. I did most of the comparision with {\tt cmr12}, {\tt cmbx12}, +% {\tt cmr12} magstep2 and {\tt cmss9}. +% +% The Stylus printer is a ink printer, but it works with a piezo drive +% instead of a bubble jet. This may be the reason why it draws its lines +% very tiny and thin. At least the pixel diameters are very sharp and +% they are far away from that bulky dots produced by the needles of +% a NEC P6. +mode_def epstylus = %\[ Epson Stylus (360dpi) + mode_param (pixels_per_inch, 360); + mode_param (blacker, .35); + mode_param (fillin, 0); + mode_param (o_correction, .8); + mode_common_setup_; +enddef; + +% {\tt ghibo@galileo.polito.it}, for the Amiga ShowDVI previewer. +mode_def fourfour = %\[ FourFour (44dpi) + mode_param (pixels_per_inch, 44); + mode_param (blacker, 0.05); + mode_param (fillin, .1); + mode_param (o_correction, .2); + mode_common_setup_; +enddef; +FourFour := fourfour; + +% From {\tt drstrip@intvax.uucp}. +% Revised by {\tt dak@pool.informatik.rwth-aachen.de}, 24 May 1994. +mode_def gtfax = %\[ G3fax (204x196dpi) + mode_param (pixels_per_inch, 204); + mode_param (aspect_ratio, 196 / pixels_per_inch); + mode_param (blacker, 0); + mode_param (fillin, .2); + mode_param (o_correction, .2); + mode_common_setup_; +enddef; +GThreefax := gtfax; +gtfaxhi := GThreefax; + +mode_def gtfaxl = %\[ G3fax landscape (196x204dpi) + gtfax_; + landscape; +enddef; + +% From {\tt dak@pool.informatik.rwth-aachen.de}, 24 May 1994. +mode_def gtfaxlo = %\[ G3fax (204x98dpi) + mode_param (pixels_per_inch, 204); + mode_param (aspect_ratio, 98 / pixels_per_inch); + gtfax_; +enddef; + +mode_def gtfaxlol = %\[ G3fax landscape (98x204dpi) + gtfaxlo_; + landscape; +enddef; + +% {\tt ron@mlfarm.com}, 30 October 1995. +mode_def highfax = %\[ G3fax (200dpi) + mode_param (pixels_per_inch, 200); + mode_param (blacker, 0); + mode_param (fillin, .2); + mode_param (o_correction, .2); + mode_common_setup_; +enddef; +hifax := highfax; + +% {\tt brumski+@osu.edu}, 27 August 1993. +mode_def hprugged = %\[ HP RuggedWriter 480 (180dpi) + mode_param (pixels_per_inch, 180); + mode_param (blacker, .55); + mode_param (fillin, .1); + mode_param (o_correction, .3); + mode_common_setup_; +enddef; + +% Some general comments on the IBM printers, courtesy of {\tt rocky@panix.com}. +% +% IBM 3820's, 3825's, 3827's and 3835's have some sort of corner imaging +% or shading that the IBM 3812's and 3816's don't. The latter two models +% may get this feature in the future. +% +% The IBM 3827 is made by Kodak, the rest are IBM engines. +% +% Some of the other printers have a knob that allows a service engineer +% to set one of up to ten levels of darkness. At IBM Research, we run +% very black. The service engineer sets the level by running a completely +% black page and then two completely blank ones. The black page +% must be black and the following two must be completely white. +% +% Thanks to Jim Hafner ({\tt hafner@ibm.com}) for experimenting with +% |blacker|, and Paul Dantzig for information about these printers. +% +% From {\tt ARNALDO@RIOSC.bitnet}. This is for the 3820, but can be used +% for 3812, 3816, 3825, 3837 3800 and 3827 printers (these are all +% 240$\,$pels IBM printers that use the same font format when driven +% by PSF/VM). +mode_def ibm_a = %\[ IBM 38xx (240dpi) + mode_param (pixels_per_inch, 240); + mode_param (blacker, .35); + mode_param (fillin, -.2); + mode_param (o_correction, .2); + mode_common_setup_; +enddef; + +% From {\tt rocky@panix.com}. For the typewriter, slanted, and italic +% fonts, |blacker=0| makes the `M's and `W's more legible. But then +% the weight of the font does not match the others. +mode_def ibmd = %\[ IBM 38xx (240dpi) + mode_param (pixels_per_inch, 240); + mode_param (blacker, .3); + mode_param (fillin, .4); + mode_param (o_correction, .75); + mode_common_setup_; +enddef; + +% These values from {\tt melvin@math.psu.edu}. +mode_def ibmega = %\[ IBM EGA monitor (96x81dpi) + mode_param (pixels_per_inch, 96); + mode_param (aspect_ratio, .841); + mode_param (blacker, .3); + mode_param (fillin, 0); + mode_param (o_correction, 0); + mode_common_setup_; +enddef; + +mode_def ibmegal = %\[ IBM EGA monitor landscape (81x96dpi) + ibmega_; + landscape; +enddef; + +% From {\tt sperber@provence.informatik.uni-tuebingen.de}, 30 October 1993. +% The difference of 0.1 in |blacker| really does make a difference. +mode_def ibmfzon = %\[ IBM 4019 (300dpi) + mode_param (pixels_per_inch, 300); + mode_param (blacker, .1); + mode_param (fillin, 0); + mode_param (o_correction, .75); + mode_param (blacker_min, 2); + mode_common_setup_; + mode_write_white_setup_; +enddef; +IBMFourZeroOneNine := ibmfzon; + +% From {\tt rocky@panix.com}. The print engine is made by Lexmark. The +% printing person I asked, Paul Dantzig, says that the print quality of +% the 4019 is fairly regular. Unlike the IBM 4216's, to his knowledge +% only there is only one print engine by Lexmar has been ever used in +% the 4019. And unlike the IBM 4029, there are not knobs on the inside +% that would permit one to adjust the blacker to ones taste. +% +% While both RicohA and cx modes settings are acceptable, it looks +% to me that the RicohA fonts are superior. I base this judgement on +% tops and bottoms of curves on {\tt cmr10} such as `S', `U' `e' `o' and +% the apostrophes. This effect is especially noticeable in a small font +% like {\tt cmr6}. +% +% If you want to experiment with another setting, I'd start with |RicohA| +% and set |blacker| to .1 or 0 instead of .2 but definitely keep +% |mode_write_white_setup_|; I'd leave |fillin| and |o_correction| unchanged. +% +% From {\tt vumalki\%weizmann.weizmann.ac.il@taunivm.tau.ac.il} +% and {\tt plotkin@theory.stanford.edu}. +% +% {\tt hafner@almaden.ibm.com} (Jim Hafner) reports that this works fine +% for the Lexmark 4039, a.k.a.\ IBM 4039, as along as the ``Printer +% Darkness'' control is set to ``darker''. +% +mode_def ibmfztn = %\[ IBM 4029-30-39, 4250 (600dpi) + mode_param (pixels_per_inch, 600); + mode_param (blacker, .05); + mode_param (fillin, 0); + mode_param (o_correction, .75); + mode_common_setup_; +enddef; +IBMFourZeroTwoNine := ibmfztn; +IBMFourTwoThreeZero := ibmfztn; +IBMFourTwoFiveZero := ibmfztn; +IBMFourZeroThreeNine := ibmfztn; +LexmarkFourZeroThreeNine := ibmfztn; + +% From Rick Simpson via {\tt erikjan@icce.rug.nl}. +mode_def ibmpp = %\[ IBM ProPrinter (240x216dpi) + mode_param (pixels_per_inch, 240); + mode_param (aspect_ratio, 216 / pixels_per_inch); + mode_param (blacker, 0); + mode_param (fillin, .2); + mode_param (o_correction, 1); + mode_common_setup_; +enddef; +IBMProPrinter := ibmpp; +proprinter := IBMProPrinter; + +mode_def ibmppl = %\[ IBM ProPrinter (216x240dpi) + ibmpp_; + landscape; +enddef; + +% From Rick Simpson via {\tt erikjan@icce.rug.nl}. Also gave values +% of zero for |blacker|, |fillin|, and |o_correction|. +mode_def ibmsoff = %\[ IBM 6154 display (118dpi) + mode_param (pixels_per_inch, 118); + mode_param (blacker, .8); + mode_param (fillin, .2); + mode_param (o_correction, 1); + mode_common_setup_; +enddef; +IBMSixOneFiveFour := ibmsoff; + +% From {\tt rocky@panix.com}. This is an old, untested definition. +mode_def sherpa = %\[ IBM 6670 (Sherpa) (240dpi) + mode_param (pixels_per_inch, 240); + mode_param (blacker, 1); + mode_param (blacker_min, 2); + mode_param (fillin, 1); + mode_param (o_correction, .5); + mode_common_setup_; + mode_write_white_setup_; +enddef; +IBMSixSixSevenZero := sherpa; + +% From {\tt vumalki\%weizmann.weizmann.ac.il@taunivm.tau.ac.il}. +mode_def ibmteot = %\[ IBM 3812 (240dpi) + mode_param (pixels_per_inch, 240); + mode_param (blacker, .6); + mode_param (blacker_min, 2); + mode_param (fillin, .4); + mode_param (o_correction, 0); + mode_common_setup_; + mode_write_white_setup_; +enddef; +IBMThreeEightOneTwo := ibmteot; +IBMUlfHolleberg := IBMThreeEightOneTwo; + +% These values from {\tt d\_webb@chcc.harwell.aea-technology.uk}. +mode_def ibmtetz = %\[ IBM 3820 (240dpi) + mode_param (pixels_per_inch, 240); + mode_param (blacker, .78); + mode_param (fillin, .25); + mode_param (o_correction, .5); + mode_common_setup_; +enddef; +IBMThreeEightTwoZero := ibmtetz; + +% From {\tt x92@vm.urz-uni-heidelberg.de} via {\tt schoepf@sc.zib-berlin.de}. +mode_def ibmtont = %\[ IBM 3193 screen (100dpi) + mode_param (pixels_per_inch, 100); + mode_param (blacker, 0); + mode_param (fillin, 0); + mode_param (o_correction, 0); + mode_common_setup_; +enddef; +IBMThreeOneNineThree := ibmtont; + +% From {\tt x92@vm.urz-uni-heidelberg.de} via {\tt schoepf@sc.zib-berlin.de}. +mode_def ibmtosn = %\[ IBM 3179 screen (87x65dpi) + mode_param (pixels_per_inch, 87); + mode_param (aspect_ratio, 0.75); + mode_param (blacker, 0); + mode_param (fillin, 0); + mode_param (o_correction, 0); + mode_common_setup_; +enddef; +IBMThreeOneSevenNine := ibmtosn; + +mode_def ibmtosnl = %\[ IBM 3179 screen landscape (65x87dpi) + ibmtosn_; + landscape; +enddef; + +% These values from {\tt d\_webb@chcc.harwell.aea-technology.uk}. +% {\tt melvin@math.psu.edu} thinks |pixels_per_inch=96| might be better. +mode_def ibmvga = %\[ IBM VGA monitor (110dpi) + mode_param (pixels_per_inch, 110); + mode_param (blacker, .3); + mode_param (fillin, 0); + mode_param (o_correction, 0); + mode_common_setup_; +enddef; + +% The Chelgraph IBX is the machine introduced to North American \TeX\ +% users by Type~2000 in Mill Valley, California; telephone (415)~388-8873. +% Since the machine's stated output resolution is only 2000$\,$dpi +% this truly spectacular 9600$\,$dpi must be used for translation to +% an outline font description. This has been tested and used in a +% publication of the University of Washington Press. These values +% from Pierre MacKay, based on Lance Carnes' crs values, at magstep~1.8. +mode_def ibx = %\[ Chelgraph IBX (9600dpi) + mode_param (pixels_per_inch, 4000 + 4000 + 1600); + mode_param (blacker, 4); + mode_param (fillin, 0); + mode_param (o_correction, 1); + mode_common_setup_; +enddef; +ChelgraphIBX := ibx; + +% From {\tt local.mf} via {\tt cudat@cu.warwick.ac.uk}. +mode_def itoh = %\[ CItoh 8510A (160x144dpi) + mode_param (pixels_per_inch, 160); + mode_param (aspect_ratio, 144 / pixels_per_inch); + mode_param (blacker, 0); + mode_param (fillin, 0); + mode_param (o_correction, .1); + mode_common_setup_; +enddef; +CItohEightFiveOneZero := itoh; + +mode_def itohl = %\[ CItoh 8510A landscape (144x160dpi) + itoh_; + landscape; +enddef; + +% From {\tt rokicki@cs.umb.edu}. +mode_def itohtoz = %\[ CItoh 310 (240x144dpi) + mode_param (pixels_per_inch, 240); + mode_param (aspect_ratio, 144 / pixels_per_inch); + mode_param (blacker, 0); + mode_param (fillin, 0); + mode_param (o_correction, .2); + mode_common_setup_; +enddef; +citohtoz := itohtoz; +CItohThreeOneZero := itohtoz; +cthreeten := itohtoz; + +mode_def itohtozl = %\[ CItoh 310 landscape (144x240dpi) + itohtoz_; + landscape; +enddef; + +% Perhaps the value for |fillin| should be 0. +mode_def iw = %\[ Apple ImageWriter (144dpi) + mode_param (pixels_per_inch, 144); + mode_param (blacker, 0); + mode_param (fillin, 0.3); + mode_param (o_correction, .2); + mode_common_setup_; +enddef; +imagewriter := iw; + +% From {\tt stsmith@ll.mit.edu}, 20 August 93. +% The mode |cx| is too spindly. +mode_def jetiiisi = %\[ HP Laser Jet IIISi (300dpi) + mode_param (pixels_per_inch, 300); + mode_param (blacker, .2); + mode_param (fillin, 0); + mode_param (o_correction, .7); + mode_common_setup_; +enddef; +HPLaserJetIIISi := jetiiisi; + +% From John Sauter. +mode_def lasf = %\[ DEC LA75 (144dpi) + mode_param (pixels_per_inch, 144); + mode_param (blacker, .3); + mode_param (fillin, -.1); + mode_param (o_correction, 0); + mode_common_setup_; +enddef; +LASevenFive := lasf; + +% Michael Covington's ({\tt mcovingt@ai.uga.edu}) definition for the +% Lexmark Optra R (4049), reflecting a taste for a heavier than +% normal rendition of the Computer Modern fonts. +% +% You may prefer a lesser value of blacker (down to maybe 1.0). +% Initially tested on 10, 12, 17-point CMR and 10-point math italic. +% +% While we're talking about the Optra R, here's another useful fact: +% it takes 32-bit-wide 72-pin SIMMs, 70 or 80 ns. Contrary to the +% documentation, you do not have to use IBM's special SIMMs. +% +% The resolution of 1200 and the |blacker| value of 3 causes {\tt cmbsy7} +% to be generated with incorrect arrows and radical sign. The +% |vtftzzlo| mode also fails. Decreasing |blacker| to 2 works around. +% From {\tt infovore@xs4all.nl} (Olaf Weber) and Henrik Schmiediche. +% +mode_def lexmarkr = %\[ Lexmark Optra R 4049 (1200dpi) + mode_param (pixels_per_inch, 1200); + mode_param (blacker, 2); % used to be 3; works around {\tt cmbsy7} bug + mode_param (fillin, 0); + mode_param (o_correction, 1); + mode_common_setup_; +enddef; +LexmarkOptraR := lexmarkr; + +% Klaus Guntermann {\tt <guntermann@iti.informatik.tu-darmstadt.de>}. +% 19 January 1998. Mode for a Lexmark Optra S laser printer in true +% 1200dpi mode. This printer model seems to be the successor of the +% Optra R series above. +% +mode_def lexmarks = %\[ Lexmark Optra S 1250/1650/2450 (1200dpi) + mode_param (pixels_per_inch, 1200); + mode_param (blacker, 1); + mode_param (fillin, 0); + mode_param (o_correction, 1); + mode_common_setup_; +enddef; +LexmarkOptraS := lexmarks; + +% {\tt uri@watson.ibm.com} (Uri Blumenthal), 9 March 1997. +% This is really a 1200$\,$dpi printer, but it can be operated in 600dpi mode. +mode_def lexmarku = %\[ Lexmark Optra R+ 4049 (600dpi) + mode_param (pixels_per_inch, 600); + mode_param (blacker, .5); + mode_param (fillin, 0); + mode_param (o_correction, .75); + mode_param (tracingtitles, 0); + mode_common_setup_; +enddef; + +mode_def linolo = %\[ Linotype Linotronic [13]00 (635dpi) + mode_param (pixels_per_inch, 635); + linoone_; +enddef; +LinotypeOneZeroZeroLo := linolo; +linohalf := LinotypeOneZeroZeroLo; + +% Mode for Linotype Linotronic L-330 with a RIP-50 raster. +% From: Steven T. Smith {\tt stsmith@ll.mit.edu}, 26 October 95. +mode_def linolttz = %\[ Linotronic L-300 with RIP-50 (3386dpi) + mode_param (pixels_per_inch, 3386); + mode_param (blacker, 0); + mode_param (o_correction, 1); + mode_param (fillin, 0); + mode_common_setup_; +enddef; +LinotypeLThreeThreeZero := linolttz; + +% These values from {\tt d\_webb@chcc.harwell.aea-technology.uk}. +% The `a' in {\tt cmr5} looks better with |blacker=.3|. Values of .2 +% for both |blacker| and |fillin| have also been used. +mode_def linoone = %\[ Linotronic [13]00 (1270dpi) + mode_param (pixels_per_inch, 1270); + mode_param (blacker, .65); + mode_param (o_correction, 1); + mode_param (fillin, -.1); + mode_common_setup_; +enddef; +LinotypeOneZeroZero := linoone; +linohi := LinotypeOneZeroZero; +linothreelo := LinotypeOneZeroZero; + +% These values from {\tt d\_webb@chcc.harwell.aea-technology.uk}. +mode_def linotzzh = %\[ Linotype Linotronic 300 (2540dpi) + mode_param (pixels_per_inch, 2540); + mode_param (blacker, .2); % Copied from |aps|---conjectural. + mode_param (fillin, .2); % (ditto) + mode_param (o_correction, 1); % (ditto) + mode_common_setup_; +enddef; +linothree := linotzzh; +LinotypeThreeZeroZeroHi := linotzzh; +linosuper := linotzzh; + +% (From Matt Swift {\tt swift@alum.mit.edu}, 1 Jan 1996.) This is a mode for +% the HP LaserJet 5P, using dvipsk-5.58f and gs-2.6.2. I tuned it using +% the file modetest.tex. The first sweep was (b,f,o) = (0, {0, .3, .6}, +% 0). The diagonal of 10$\,$pt lowercase z was too thin at .6, too thick +% at 0. The second sweep was ({.4, .5, .6, .7}, .3, 0). At .6, the 5$\,$pt +% small-cap lower-case A was on the verge of being filled in, but .6 is +% a reasonable value. Blacker .4 looked a little spindly for many of +% the 5$\,$pt fonts, especially italic and small-cap. The next sweep was +% (.5, .3, {0, .4, .7, 1}). The sides of the 14$\,$pt upper-case O +% (especially roman and small-cap) are relatively fatter with +% o-correction 0 as opposed to 1. Almost every other mode for 600$\,$dpi +% printers has 1, so I'm going with that. +% +mode_def ljfive = %\[ HP LaserJet 5 (600dpi) + mode_param (pixels_per_inch, 600); + mode_param (blacker, .75); + mode_param (fillin, .3); + mode_param (o_correction, 1); + mode_common_setup_; +enddef; +laserjetfive := ljfive; + +% From Michael Neuhauser {\tt neuhauser@eiunix.tuwien.ac.at}. This is a +% mode for HP LaserJet 5MP. I started with ljfive and found the Computer +% Modern fonts much too black. Therefore I experimented with different +% values of |blacker| to find .4 to be best. +mode_def ljfivemp = %\[ HP LaserJet 5MP (600 dpi) + mode_param (pixels_per_inch, 600); + mode_param (blacker, .4); + mode_param (fillin, .3); + mode_param (o_correction, 1); + mode_common_setup_; +enddef; +laserjetfivemp := ljfivemp; +% There have been many modes for the LaserJet 4. The current values were +% found by {\tt kb@tug.org} to be reasonable on a LaserJet 4MP +% (at the default density setting, with resolution enhacement enabled). +% I don't intend to change them again (unless someone convinces me +% that they are truly mistaken in some way), although I would consider adding +% different modes for other LaserJet 4 printers, if people contribute them. +% +% ({\tt cthiele@ccs.carleton.ca} gets better results with the density +% setting on the printer at 4, instead of 3.) +% +% The first LaserJet 4 mode came from {\tt tonnie@ctrl.phys.tue.nl}, +% 13 January 1993, with |blacker=0|, |fillin=0|, and |o_correction=.6|. +% (This definition was forwarded to me by Barbara Beeton, and was +% intended to be preliminary.) +% +% {\tt fj@iesd.auc.dk} says that |IBMFourZeroTwoNine| works fine. +% +% {\tt mbr@research.nj.nec.com} supplied another set of values: +% |blacker=.6|, |fillin=0|, and |o_correction=1|. He writes: +% I've tested it extensively at 10$\,$pt and 12$\,$pt in both roman, italic, +% and bold, and I've checked all the standard smaller sizes (5, 6, 7, 8, +% and 9$\,$pt). Works reasonably well on both the LaserJet 4 and the 4si, +% although characters come out somewhat lighter on the 4si. Assumes +% that the density controls are set to their default values and that the +% resolution enhancement feature is enabled. The |blacker| value was +% chosen to make 12$\,$pt text look good; for 10$\,$pt text, set |blacker=.66|. +% +% I felt the output with |blacker=.6| was too dark; Computer Modern +% was never intended to be as dark as it appears on 300$\,$dpi printers. +% So I've decreased |blacker| to the value below. The other parameters +% don't seem to matter much. (Even |blacker| doesn't matter all +% {\it that} much.) +% +% Works for a 600$\,$dpi Accel-a-Writer {\tt mackay@cs.washington.edu}, +% 16 August 95. +% +% Possibly also usable for the LaserJet 6 family. +% From {\tt chj@lin.foa.se} (Christian Jvnsson), 29 January 1997. +% +mode_def ljfour = %\[ HP LaserJet 4 (600dpi) + mode_param (pixels_per_inch, 600); + mode_param (blacker, .25); + mode_param (fillin, 0); + mode_param (o_correction, 1); + mode_common_setup_; +enddef; +laserjetfour := ljfour; +% {\tt fn@junior.mathtok.polymtl.ca} uses this for the QMS-860. +qmsesz := ljfour; +% {\tt pete@lovelace.thi.informatik.uni-frankfurt.de} uses this for the +% Apple Laserwriter Select 360, with a Fuji Xerox Xerographic engine. +aselect := ljfour; + +% {\tt jrenkema@worldonline.nl}, 2 January 1998. The LaserJet 5M +% |mode_def|, |blacker=.35|, had very light output on the 4000. The +% |blacker=2| setting results in output comparable to the LaserJet 5M +% with |blacker=.35|. It is also noteworthy that in the ProRes 1200 mode +% HP's resolution enhancement technology (RET) is not used, thus output +% is exactly according to \MF. But perhaps |blacker=2| is too much, as +% Computer Modern is supposed to be pretty light. +mode_def ljfzzz = %\[ LaserJet 4000N, ProRes mode (1200dpi) + mode_param (pixels_per_inch, 1200); + mode_param (blacker, 1); + mode_param (fillin, .1); + mode_param (o_correction, 1); + mode_common_setup_; +enddef; +laserjetfourzerozerozero := ljfzzz; +laserjetfourthousand := ljfzzz; + +% {\tt Nicolai Langfeldt <janl@math.uio.no>}, 16 May 1998. +% This is for the default 16ppm 600dpi mode. +% +mode_def ljfzzzfr = %\[ HP LaserJet 4000 FastRes (600dpi) + mode_param (pixels_per_inch, 600); + mode_param (blacker, 0); + mode_param (fillin, .2); + mode_param (o_correction, 1); + mode_common_setup_; +enddef; + +% From {\tt ST-TeX.MF} via {\tt braams@pttrnl.nl}. (The 300dpi LaserJet +% is another |cx|.) +mode_def ljlo = %\[ HP LaserJet (150dpi) + mode_param (pixels_per_inch, 150); + mode_param (blacker, 0); + mode_param (fillin, .1); + mode_param (o_correction, 1); + mode_common_setup_; +enddef; +laserjetlo := ljlo; + +% {\tt Niko Sauer <nikos@friedrichs.up.ac.za>}, 11 October 2000. +% Here are modes developed for and tested on the HP LaserJet 2100T/TN. +% Mode ljtozz is for a resolution of 1200dpi, and ljtozzfr for 600dpi +% Tradeoffs between |fillin| and |blacker| resulted in very clear, +% sharp renderings of Computer Modern fonts which appears to be +% preferable to what the modes ljfzzz ljfzzzfr for HP LaserJet 4000 +% yield on this printer. Preferences were tested by scrutiny of the +% results by sample of people in the vicinity. +% +mode_def ljtozz = %\[ HP LaserJet 2100T/TN (1200dpi) + mode_param (pixels_per_inch, 1200); + mode_param (blacker, .7); + mode_param (fillin, .15); + mode_param (o_correction, 1); + mode_common_setup_; +enddef; +laserjettwoonezerozero:=ljtozz; +% +mode_def ljtozzfr = %\[ HP LaserJet 2100T/TN (600dpi) + mode_param (pixels_per_inch, 600); + mode_param (blacker, .25); + mode_param (fillin, .3); + mode_param (o_correction, 1); + mode_common_setup_; +enddef; +laserjettwoonezerozerofastres:=ljtozzfr; + +% From {\tt mackay@cs.washington.edu}, 13 January 1993. The actual +% machine resolution of this machine is $1000 \times 400$, but it is +% adjusted with the aid of software so that a $1000 \times 1000$ PK file +% is used. The |o_correction|, however, seems grossly overdone if +% the expected value of at or near unity is applied (on the grounds +% that a 1000$\,$dpi font should be able to do full o-correction). +% Apparently the 400$\,$dpi physical resolution has some effect here. +% In any case, |o_correction=0.4| looks better, and lines up with +% about the right optical adjustment on curves. Tested at American +% School of Classical Studies Publications on 18 July, 1992. +mode_def lmaster = %\[ LaserMaster (1000dpi) + mode_param (pixels_per_inch, 1000); + mode_param (blacker, 0.2); + mode_param (fillin, 0.0); + mode_param (o_correction, 0.4); + mode_common_setup_; +enddef; +lasermaster := lmaster; + +% From {\tt fran@hexamon.demon.co.uk}, 10 March 1996. I tried the entry +% in modes.mf for a DEC LN03. This turned out much too dark---everything +% looks bold. I did try sending write-black fonts to this printer, the +% hairlines disappear. I don't know if these printers have a +% blackness knob $\ldots$ +mode_def lnotr = %\[ DEC LN03R Scriptprinter (300dpi) + mode_param (pixels_per_inch, 300); + mode_param (blacker, 0); + mode_param (blacker_min, 2); + mode_param (fillin, -.6); + mode_param (o_correction, .5); + mode_common_setup_; + mode_write_white_setup_; +enddef; +LNOthreR := lnotr; + +% From Richard Watson at the Queensland Institute of Technology. This +% printer is said to have some kind of Xerox engine, but I don't know which. +mode_def lnzo = %\[ DEC LN01 (300dpi) + mode_param (pixels_per_inch, 300); + mode_param (blacker, .9); + mode_param (blacker_min, 2); + mode_param (fillin, 0); + mode_param (o_correction, .5); + mode_common_setup_; + mode_write_white_setup_; +enddef; +LNZeroOne := lnzo; +lps := lnzo; +LPSFourZero := lnzo; + +% From {\tt hammond@jila.Colorado.EDU}, 21 January 1993. Modified from +% |qms|. Prints exactly like the QMS fonts from Northlake Software. +mode_def lpstz = %\[ DEC lps20 (300dpi) + mode_param (pixels_per_inch, 300); + mode_param (blacker, .6); + mode_param (fillin, -.3); + mode_param (o_correction, .6); + mode_common_setup_; +enddef; +LPSTwoZero := lpstz; + +mode_def lqlores = %\[ Epson LQ-500 (180dpi) + mode_param (pixels_per_inch, 180); + mode_param (blacker, 0); + mode_param (fillin, 0); + mode_param (o_correction, .1); + mode_common_setup_; +enddef; +EpsonLQFiveZeroZeroLo := lqlores; + +% This and |EpsonLQFiveZeroZeroLo| also work for a Mannesmann 300 +% (from {\tt cudat@csv.warwick.ac.uk}, 4 September 1991). The $360\times360$ +% modes for these printers fails for {\tt cudat}, however. +mode_def lqmed = %\[ Epson LQ-500 (360x180dpi) + mode_param (pixels_per_inch, 360); + mode_param (aspect_ratio, 180 / pixels_per_inch); + mode_param (blacker, 0); % 0.3 avoids `holes'. + mode_param (fillin, 0); + mode_param (o_correction, .1); + mode_common_setup_; +enddef; +lqmedres := lqmed; +EpsonLQFiveZeroZeroMed := lqmed; + +mode_def lqmedl = %\[ Epson LQ-500 landscape (180x360dpi) + lqmed_; + landscape; +enddef; + +% These values from {\tt karl@cs.umb.edu}. |blacker = .8| or more +% thickens dots, to their detriment. |blacker = .6| produces two-pixel +% stems, which looks pretty good for {\tt cmr}, but it's a little dark +% for {\tt cmti}, and {\tt cmbx} and {\tt cmr} then turn out the same. +% |o_correction = 1| made no difference. |fillin = 1| made no +% difference. +mode_def lview = %\[ Sigma L-View monitor (118x109dpi) + mode_param (pixels_per_inch, 118.06); + mode_param (aspect_ratio, 109.25 / pixels_per_inch); + mode_param (blacker, 0); + mode_param (fillin, 0); + mode_param (o_correction, 0); + mode_common_setup_; +enddef; + +mode_def lviewl = %\[ Sigma L-View monitor landscape (109x118dpi) + lview_; + landscape; +enddef; + +% From {\tt Pierre.Soille@ipk.fhg.de}, 13 February 1995. +% This printer also runs at 300$\,$dpi (try |cx|), 400$\,$dpi (|next|), +% and 600$\,$dpi (|ljfour|). +mode_def lwpro = %\[ Apple LaserWriterPro 810 (800dpi) + mode_param (pixels_per_inch, 800); + mode_param (blacker, 0); + mode_param (fillin, 0); + mode_param (o_correction, 1); + mode_common_setup_; +enddef; + +% This is untested. +mode_def macmag = %\[ Mac screens at magstep 1 (86dpi) + mode_param (pixels_per_inch, 86.4); + mode_param (blacker, .35); + mode_param (fillin, .1); + mode_param (o_correction, .3); + mode_common_setup_; +enddef; + +% From the VMS distribution tape (except {\tt karl@cs.umb.edu} changed +% the |o_correction| to zero). +mode_def mactrue = %\[ Mac screen (72dpi) + mode_param (pixels_per_inch, 72); + mode_param (blacker, 0); + mode_param (fillin, 0); + mode_param (o_correction, 0); + mode_common_setup_; +enddef; +MacTrueSize := mactrue; + +% From {\tt mcgrant@rascals.stanford.edu}, 17 December 1992. +% Various other values made little difference. +mode_def ncd = %\[ NCD 19-inch (95dpi) + mode_param (pixels_per_inch, 95); + mode_param (blacker, 0); + mode_param (fillin, 0); + mode_param (o_correction, 0); + mode_common_setup_; +enddef; + +% From {\tt rokicki@neon.stanford.edu}. +mode_def nec = %\[ NEC (180dpi) + mode_param (pixels_per_inch, 180); + mode_param (blacker, 0); + mode_param (fillin, 0); + mode_param (o_correction, .2); + mode_common_setup_; +enddef; + +% This is the same as |cx|, except for the resolution. +mode_def nechi = %\[ NEC-P6 (360dpi) + mode_param (pixels_per_inch, 360); + cx_; +enddef; +lqhires := nechi; + +% {\tt fkr@tooyoo1.l.u-tokyo.ac.jp}, 7 June 1995. +mode_def neclm = %\[ NEC PC-PR406LM (320dpi) + mode_param (pixels_per_inch, 320); + mode_param (blacker, .1); + mode_param (fillin, 0); + mode_param (o_correction, .6); + mode_common_setup_; +enddef; + +% {\tt fkr@tooyoo1.l.u-tokyo.ac.jp}, 7 June 1995. +mode_def nectzo = %\[ NEC PC-PR201 series (160dpi) + mode_param (pixels_per_inch, 160); + mode_param (blacker, 0); + mode_param (fillin, 0); + mode_param (o_correction, .2); + mode_common_setup_; +enddef; +NecTwoZeroOne := nectzo; + +% From {\tt rokicki@neon.stanford.edu}. +mode_def nexthi = %\[ NeXT Newgen (400dpi) + mode_param (pixels_per_inch, 400); + cx_; +enddef; +NeXTprinter := nexthi; +Newgen := nexthi; % From {\tt lambert@silver.cs.umanitoba.ca}. + +% From {\tt rokicki@neon.stanford.edu}. +mode_def nextscrn = %\[ NeXT monitor (100dpi) + mode_param (pixels_per_inch, 100); + mode_param (blacker, 0); + mode_param (fillin, 0); + mode_param (o_correction, 0); + mode_common_setup_; +enddef; +NeXTscreen := nextscrn; +nextscreen := nextscrn; + +% {\tt ghibo@galileo.polito.it}, for the Amiga ShowDVI previewer. +mode_def nineone = %\[ NineOne (91x91) (91dpi) + mode_param (pixels_per_inch, 91); + mode_param (blacker, 0); + mode_param (fillin, 0); + mode_param (o_correction, .2); + mode_common_setup_; +enddef; +NineOne := nineone; + +% From {\tt jbotz@mtholyoke.edu}, 21 April 1993. +% Make TFM files only. +mode_def nullmode = %\[ TFM files only (101dpi) + % The resolution is irrelevant, but \MF\ always ships out + % characters, so don't use the default huge |proof| resolution. + mode_param (pixels_per_inch, 101); + mode_param (proofing, -1); + mode_param (fontmaking, 1); +enddef; + +% {\tt ghibo@galileo.polito.it}, for the Amiga ShowDVI previewer. +mode_def onetz = %\[ OneTwoZero (120/120) (120dpi) + mode_param (pixels_per_inch, 120); + mode_param (blacker, 0); + mode_param (fillin, 0); + mode_param (o_correction, .2); + mode_common_setup_; +enddef; +OneTwoZero := onetz; + +% From {\tt deby@cs.utwente.nl} and {\tt issue@vax.oxford.ac.uk}. +mode_def ocessfz = %\[ OCE 6750-PS (508dpi) + mode_param (pixels_per_inch, 508); + mode_param (blacker, 0); + mode_param (fillin, 0); + mode_param (o_correction, .7); + mode_common_setup_; +enddef; +OCESixSevenFiveZeroPS := ocessfz; + +% From {\tt rokicki@neon.stanford.edu}. +mode_def okidata = %\[ Okidata (240x288dpi) + mode_param (pixels_per_inch, 240); + mode_param (aspect_ratio, 288 / pixels_per_inch); + mode_param (blacker, 0); + mode_param (fillin, 0); + mode_param (o_correction, .2); + mode_common_setup_; +enddef; +okihi := okidata; + +mode_def okidatal = %\[ Okidata landscape (288x240dpi) + okidata_; + landscape; +enddef; + +% {\tt roussel@henri.chem.uleth.ca}. For the dark smoothing mode. +mode_def okifte = %\[ Okidata 410e in 600DPI mode (600dpi) + mode_param (pixels_per_inch, 600); + mode_param (blacker, .6); + mode_param (fillin, .1); + mode_param (o_correction, .85); + mode_common_setup_; +enddef; +okifourten := okifte; + +% From {\tt AMSmodes.def}. +mode_def pcscreen = %\[ also, e.g., high-resolution Suns (118dpi) + mode_param (pixels_per_inch, 118); + mode_param (blacker, .5); + mode_param (fillin, .1); + mode_param (o_correction, .3); + mode_common_setup_; +enddef; + +% {\tt fkr@tooyoo1.l.u-tokyo.ac.jp}, 7 June 1995. With the existing +% |bitgraph| and |pcscreen| modes, `m' looks bad: a long vertical +% line extends higher than the letter itself. +mode_def pcprevw = %\[ PC screen preview (118dpi) + mode_param (pixels_per_inch, 118); + mode_param (blacker, .2); + mode_param (fillin, 0); + mode_param (o_correction, .2); + mode_common_setup_; +enddef; + +% Tektronix Color PostScript printer, from {\tt craig@sunspot@noao.edu} +% on 14 January 1993. He writes: This is a thermal wax paper printer. +% The values were determined using the {\tt cmr10} and {\tt cmti10} fonts. +% The generated fonts look reasonable, although vertical lines and +% things like the {\tt [}, {\tt ]}, and {\tt /} characters are pretty thin. +mode_def phaser = %\[ Tektronix Phaser PXi (300dpi) + mode_param (pixels_per_inch, 300); + mode_param (blacker, 1.1); + mode_param (fillin, 0); + mode_param (o_correction, 1); + mode_common_setup_; +enddef; + +% From {\tt metod.kozelj@rzs-hm.si} (Metod Kozelj), 30 July 1998. +% Parameters other than |blacker| have little effect. +mode_def phaserfs = %\[ Tektronix Phaser 560 (1200dpi) + mode_param (pixels_per_inch, 1200); + mode_param (blacker, 0); + mode_param (fillin, 0); + mode_param (o_correction, 1); + mode_common_setup_; +enddef; +phaserfivesixzero := phaserfs; + +% Tektronix Phaser 350 is a 600-by-300 colour wax printer. +% From {\tt dag@ifi.uio.no} (Dag Langmyhr), 10 January 1997. +% Perhaps too fat at small sizes (5$\,$pt) but looks OK for 8$\,$pt and more. +mode_def phasertf = %\[ Tektronix Phaser 350 (600x300dpi) + mode_param (pixels_per_inch, 600); + mode_param (aspect_ratio, 300/pixels_per_inch); + mode_param (blacker, 0); + mode_param (fillin, 0); + mode_param (o_correction, .6); + mode_common_setup_; +enddef; + +mode_def phasertl = %\[ Tektronix Phaser 350 landscape (300x600) + phasertf_; + landscape; +enddef; +phasertfl := phasertl; + +% From Aries Arditi {\tt <aries@play.lighthouse.org>}, 3 February 1998. +% This definition makes one pixel one point, which is convenient when +% you want to image-process the letter images after rendering, and don't +% want to add any device corrections. If you want to grab the images off +% the screen, it's useful to add lines to the definition, as well: +% +%%\begingroup \tt \catcode`\_=12 \obeyspaces +% |mode_param (proofing, 1); +% extra_endchar:=extra_endchar\&"showit"; +% extra_setup := extra_setup\&"def openit = openwindow currentwindow from +% origin to (screen_rows,screen_cols) at (0,50) enddef"; +%%\endgroup +mode_def pixpt = %\[ one pixel per point (72.27dpi) + mode_param (pixels_per_inch, 72.27); + mode_param (blacker, 0); + mode_param (fillin, 0); + mode_param (o_correction, 1); + mode_common_setup_; +enddef; + +% This is a write-white PostScript laser-setter, made by a Xerox +% subsidiary. Its true aspect ratio is 1200$\,$dpi horizontally and +% 600$\,$dpi vertically, but {\tt mis@apsedoff.bitnet} says that the +% printer hides this, and PostScript programs should treat it as having +% a square aspect ratio. But {\tt george@trevnx.bio.dfo.ca} says that +% using the nonsquare aspect ratio produces identical output and uses +% only half the disk space. He also says the fonts are much too dark +% in general, and produce invisible diagonals in the CM typewriter +% fonts---but other changes either produce errors or dark output. +% +% Printware's headquarters is in Minnesota; telephone (612) 456-1400. +mode_def prntware = %\[ Printware 720IQ (1200dpi) + mode_param (pixels_per_inch, 1200); + mode_param (blacker, 0); + mode_param (fillin, 0); + mode_param (o_correction, 1); + mode_common_setup_; +enddef; +PrintwareSevenTwoZeroIQ := prntware; +printware := prntware; + +% From John Gourlay. See {\sl TUGboat} 8(2), page 133. +mode_def qms = %\[ QMS (Xerox engine) (300dpi) + mode_param (pixels_per_inch, 300); + mode_param (blacker, .6); + mode_param (blacker_min, 2); + mode_param (fillin, -.3); + mode_param (o_correction, .6); + mode_common_setup_; + mode_write_white_setup_; +enddef; + +% From {\tt Boris.Hemkemeier@HRZ.Uni-Bielefeld.De}, 24 June 1993. +% With the QMSOneSevenZeroZero mode, the left stem of `M' +% in {\tt cmr10} vanishes completely. +mode_def qmsostf = %\[ QMS 1725 (600dpi) + mode_param (pixels_per_inch, 600); + mode_param (blacker, 1); + mode_param (blacker_min, 2); + mode_param (fillin, 0); + mode_param (o_correction, 1); + mode_common_setup_; + mode_write_white_setup_; +enddef; +QMSOneSevenTwoFive := qmsostf; + +% From {\tt queinnec@geant.cenatls.cena.dgac.fr}, 24 March 1993. +% {\tt k316670@aearn.bitnet} says this print has a CanonNX engine +% switchable between 300 and 600$\,$dpi. +% +% From {\tt mimi@scri.fsu.edu} (Mimi Burbank), 12 September 1996: +% $\ldots$ When I found the note about the left stem of the `M' +% disappearing I was concerned. +% +% The error, I believe, is due to the fact that the font is generated at +% 600$\,$dpi, and was most likely printed on a QMS printer with 300$\,$dpi +% resolution. I just had the same thing happen to me, but with our QMS +% 860 set at 600dpi (the default for only one of our printers) the +% output was beautiful! (I printed the same ps file on a QMS 2000 with +% 300$\,$dpi resolution, and on a QMS 860 with 600$\,$dpi resolution.) +mode_def qmsoszz = %\[ QMS 1700 (600dpi) + mode_param (pixels_per_inch, 600); + mode_param (blacker, .2); + mode_param (blacker_min, 2); + mode_param (fillin, 0); + mode_param (o_correction, 1); + mode_common_setup_; + mode_write_white_setup_; +enddef; +QMSOneSevenZeroZero := qmsoszz; + +% From {\tt teddy@fukt.hk-r.se}, 28 September 1996. +mode_def qmstftf = %\[ QMS 2425 (1200dpi) + mode_param (pixels_per_inch, 1200); + mode_param (blacker, .3); + mode_param (fillin, .5); + mode_param (o_correction, 1); + mode_common_setup_; +enddef; +QMSTwoFourTwoFive := qmstftf; + +% These values from Stan Osborne, {\sl TUGboat} 8(2), page 134. +mode_def ricoh = %\[ e.g., TI Omnilaser (300dpi) + mode_param (pixels_per_inch, 300); + mode_param (blacker, .2); + mode_param (blacker_min, 2); + mode_param (fillin, -.2); + mode_param (o_correction, .5); + mode_common_setup_; + mode_write_white_setup_; +enddef; +RicohFourZeroEightZero := ricoh; +RicohFortyEighty := ricoh; + +% From {\tt Martin.Ward@durham.ac.uk}. Apparently the engine is +% different from the Ricoh 4080. With a larger value of |blacker|, +% characters like the `e' in {\tt cmtt8} look bad. +mode_def ricoha = %\[ e.g., IBM 4216 (300dpi) + mode_param (pixels_per_inch, 300); + mode_param (blacker, .2); + mode_param (blacker_min, 2); + mode_param (fillin, 0); + mode_param (o_correction, .75); + mode_common_setup_; + mode_write_white_setup_; +enddef; +RicohA := ricoha; +IBMFourTwoOneSix := ricoha; + +% From John Sauter. +mode_def ricohlp = %\[ e.g., DEC LN03 (300dpi) + mode_param (pixels_per_inch, 300); + mode_param (blacker, .65); + mode_param (blacker_min, 2); + mode_param (fillin, -.2); + mode_param (o_correction, .5); + mode_common_setup_; + mode_write_white_setup_; +enddef; +RicohLP := ricohlp; +LNOthree := ricohlp; +LNZeroThree := ricohlp; + +% From {\tt nishida@src.ricoh.co.jp} (Akihiro Nishida), 30 August 1996. +% These printers are available only in Japan. +mode_def ricohsp = %\[ Ricoh sp10ps/lp7200-ux (600dpi) + mode_param (pixels_per_inch, 600); + mode_param (blacker, 0); + mode_param (fillin, 0.2); + mode_param (o_correction, .6); + mode_common_setup_; +enddef; + +% From {\tt dickson@eeserv.ee.umanitoba.ca}. {\tt gil.cc.gatech.edu} +% has different values; {\tt img@ai.edinburgh.ac.uk} sets |blacker=.1|. +% Corrected by {\tt andy@vlsi.cs.caltech.edu}, 28 August 1991. +% The darkness knob on the printer has a much larger effect than +% any of these parameters. {\tt carlos@snfep1.if.usp.br} points out +% that the printer can operate at either 300$\,$dpi or 400$\,$dpi, and +% if your fonts don't match the setting, naturally they won't look +% very good. He says the following works in Dvips' {\tt config.ps} file +% to set 400$\,$dpi: +%%\begingroup \tt \catcode`\%=12 \catcode`\{=12 \catcode`\}=12 \obeyspaces +% /SetResolution { +% /setres where { +% /setres get exec +% }{ +% pop +% } ifelse +% } def +% %%BeginFeature *SetResolution 400 +% 400 SetResolution +% %%EndFeature +% %%EndSetup +%%\endgroup +% +% (This is the file {\tt resolution400.ps} supplied with NeWSprint.) +% {\tt simpson@math.psu.edu} only got this work by downloading the code +% via an extra header file, i.e., having this in the Dvips config file: +%%\begingroup \tt \obeyspaces +% M sparcptr +% D 400 +% h resolution400.ps +%%\endgroup +% +mode_def sparcptr = %\[ Sun SPARCprinter (400dpi) + mode_param (pixels_per_inch, 400); + mode_param (blacker, .25); + mode_param (fillin, .2); + mode_param (o_correction, .6); + mode_common_setup_; +enddef; +SparcPrinter := sparcptr; + +% From {\tt ee@dacth51.bitnet}. +mode_def starnlt = %\[ Star NL-10 (240x216dpi) + mode_param (pixels_per_inch, 240); + mode_param (aspect_ratio, 216 / pixels_per_inch); + mode_param (blacker, 0); + mode_param (fillin, .2); + mode_param (o_correction, .4); + mode_common_setup_; +enddef; +StarNLOneZero := starnlt; + +mode_def starnltl = %\[ Star NL-10 landscape (216x240dpi) + starnlt_; + landscape; +enddef; + +% From {\tt alejolo@sue.ideam.gov.co}, 26 November 1998. I have tested +% the default stylewriter mode in modes.mf v3.4 with Oz\TeX\ and my +% StyleWriter II, and still output is too light, particularly the serifs +% and thin cusps such as in CMR's small e, c, t, b and d. Thus I cooked +% up this mode that prints output similar to a standard system font (I +% compared text output with Minion Web as it comes with Internet +% Explorer 4). In general I'd suggest that this mode definition is +% apropriate for all inkjet printers using a BJC-02 ink cartridge. +mode_def styletwo = %\[ Apple StyleWriter II (360dpi) + mode_param (pixels_per_inch, 360); + mode_param (blacker, 0.25); + mode_param (fillin, 0); + mode_param (o_correction, 0.6); + mode_common_setup_; +enddef; +swtwo := styletwo; + +% |stylewriter| mode added by Andrew Trevorrow +% {\tt <akt@netspace.net.au>} for Oz\TeX users. All +% parameters (except |pixels_per_inch|) are the same as the |cx| mode so +% that PK files can be shared by both types of printers. +% +% With |blacker=0|, hbar is indistinguishable for h, i.e., the bar +% disappears. Thus 0.1. From Wulf Hofbauer {\tt <wh@echo.chem.TU-Berlin.DE>}, +% 5 June 1998. +mode_def stylewri = %\[ Apple StyleWriter (360dpi) + mode_param (pixels_per_inch, 360); + mode_param (blacker, 0.1); + mode_param (fillin, .2); + mode_param (o_correction, .6); + mode_common_setup_; +enddef; +stylewriter := stylewri; +stylewr := stylewri; +% From {\tt px@fct.unl.pt (Joaquim Baptista [pxQuim])}. I find +% |epstylus| far too dark. It seems to me that plain values of 0 to +% |blacker| and |fillin| work perfectly with values of |o_correction| in +% the range of .6 to .8. I ended up using [this mode:] +epstylwr := stylewri; +% Andrew defines |sw| as well, but I am reluctant to use such a +% potentially common identifier --{\tt kb@cs.umb.edu}, 8 October 1996. + +% From {\tt grunwald@foobar.colorado.edu}. Sun monitors have several +% different resolutions, but this seems the most common of the lot. +% Use |pcscreen| for high-resolution monitors. +mode_def sun = %\[ Sun and BBN Bitgraph (85dpi) + mode_param (pixels_per_inch, 85); + mode_param (blacker, .35); + mode_param (fillin, .1); + mode_param (o_correction, .3); + mode_common_setup_; +enddef; + +mode_def supre = %\[ Ultre*setter (2400dpi) + mode_param (pixels_per_inch, 2400); + mode_param (blacker, 0); + mode_param (fillin, 0); + mode_param (o_correction, 1); + mode_common_setup_; +enddef; + +mode_def toshiba = %\[ Toshiba 13XX, EpsonLQ (180dpi) + mode_param (pixels_per_inch, 180); + mode_param (blacker, 0); + mode_param (fillin, 0); + mode_param (o_correction, .2); + mode_common_setup_; +enddef; +epsonlq := toshiba; + +mode_def ultre = %\[ Ultre*setter (1200dpi) + mode_param (pixels_per_inch, 1200); + mode_param (blacker, 0); + mode_param (fillin, 0); + mode_param (o_correction, 1); + mode_common_setup_; +enddef; +Prism := ultre; + +% From {\tt Martin.Ward@durham.ac.uk}. +mode_def vs = %\[ VAXstation monitor (78dpi) + mode_param (pixels_per_inch, 78); + mode_param (blacker, 0); + mode_param (fillin, 0); + mode_param (o_correction, 0); + mode_common_setup_; +enddef; +VAXstation := vs; +gpx := vs; + +% From {\tt erikjan@icce.rug.nl}, 23 August 1991. +mode_def vtftzz = %\[ Varityper 4200 B-P (1800dpi) + mode_param (pixels_per_inch, 1800); + mode_param (blacker, 0); + mode_param (fillin, 0); + mode_param (o_correction, 1); + mode_common_setup_; +enddef; +VarityperFourTwoZeroZero := vtftzz; + +% From {\tt mjm@as.arizona.edu}, 26 February 1992. +mode_def vtftzzhi = %\[ Varityper 4300P (2400dpi) + mode_param (pixels_per_inch, 2400); + mode_param (blacker, 0); + mode_param (fillin, 0); + mode_param (o_correction, 1); + mode_common_setup_; +enddef; +VarityperFourThreeZeroZeroHi := vtftzzhi; + +% From {\tt mjm@as.arizona.edu}, 26 February 1992. +mode_def vtftzzlo = %\[ Varityper 4300P (1200dpi) + mode_param (pixels_per_inch, 1200); + mode_param (blacker, 2); % used to be 3.5, see |lexmarkr| comments. + mode_param (fillin, 0); + mode_param (o_correction, 1); + mode_common_setup_; +enddef; +VarityperFourThreeZeroZeroLo := vtftzzlo; + +% From {\tt rocky@panix.com}. This can also be used for the Autologic's +% APS6 cut sheet dry process printer. For that printer, perhaps +% |blacker=0.8| is better. For the Varityper, though, at |blacker=0.8| +% the dots of the umlaut start to fill in. For |blacker<0.6|, the tops +% and bottoms of lowercase g's and s's in {\tt cmr5} drop out. +mode_def vtfzszw = %\[ Varitype 5060W, APS 6 (600dpi) + mode_param (pixels_per_inch, 600); + mode_param (blacker, .7); + mode_param (fillin, 0); + mode_param (o_correction, 1); + mode_common_setup_; +enddef; +VarityperFiveZeroSixZeroW := vtfzszw; +APSSixMed := vtfzszw; + +% The worst problem is toner irregularity. This may be the same printer +% as the IBM 4250. +mode_def vtszz = %\[ Varityper Laser 600 (600dpi) + mode_param (pixels_per_inch, 600); + mode_param (blacker, 0); + mode_param (fillin, 0); + mode_param (o_correction, 1); + mode_common_setup_; +enddef; +VarityperSixZeroZero := vtszz; +VTSix := vtszz; +varityper := vtszz; + +% Some information about Xerox printers, from {\tt siemsen@barnard.usc.edu}: +% The Docutech system and the 4135 have the same engine. +% The 4050, 4075 and 4090 have the same engine. +% The 4650 has a unique engine. +% The 4850 has a unique engine. + +% From {\tt SamuelKey@comcast.net}, for enhanced resolution mode. In +% 600x600 mode, |ljfour| works ok. +mode_def xpstzz = %\[ Xerox Phaser 6200DP (2400x600dpi) + mode_param (pixels_per_inch, 2400); + mode_param (aspect_ratio, 600 / pixels_per_inch); + mode_param (blacker, 0); + mode_param (fillin, 0); + mode_param (o_correction, 1); + mode_common_setup_; +enddef; +XeroxPhaserSixTwoZeroZeroDP := xpstzz; + +mode_def xpstzzl = %\[ Xerox Phaser 6200DP landscape (600x2400dpi) + xpstzz_; + landscape; +enddef; + + +% From {\tt u12570@uicvm.uic.edu}. These values are mostly guesses. +mode_def xrxesnz = %\[ Xerox 8790 or 4045 (300dpi) + mode_param (pixels_per_inch, 300); + mode_param (blacker, 0.4); + mode_param (blacker_min, 2); + mode_param (fillin, 0); + mode_param (o_correction, 0.2); + mode_common_setup_; + mode_write_white_setup_; +enddef; +XeroxEightSevenNineZero := xrxesnz; + +% From {\tt u12570@uicvm.uic.edu}. Many variations for different fonts. +% {\tt bart@cs.tamu.edu} says this works for the Xerox 4700, also. +mode_def xrxfzfz = %\[ Xerox 4050/4075/4090/4700 (300dpi) + mode_param (pixels_per_inch, 300); + mode_param (blacker, .7); + mode_param (fillin, 0); + mode_param (o_correction, .5); + mode_common_setup_; +enddef; +XeroxFourZeroFiveZero := xrxfzfz; + +% From {\tt u12570@uicvm.uic.edu}. He sent many variations of this, +% for different fonts. I don't know a reasonable way to put them in +% yet, so this is just the basic entry. +mode_def xrxnszz = %\[ Xerox 9700 (300dpi) + mode_param (pixels_per_inch, 300); + mode_param (blacker, .7); + mode_param (fillin, 0); + mode_param (o_correction, .5); + mode_common_setup_; +enddef; +XeroxNineSevenZeroZero := xrxnszz; + +% From {\tt lee@sq.com}. These values may be improvable. +mode_def xrxtszz = %\[ Xerox 3700 (300dpi) + mode_param (pixels_per_inch, 300); + mode_param (blacker, .85); + mode_param (blacker_min, 2); + mode_param (fillin, -.1); + mode_param (o_correction, .5); + mode_common_setup_; + mode_write_white_setup_; +enddef; +XeroxThreeSevenZeroZero := xrxtszz; + +mode_def help = %\[ What modes are available? + for i = 1 upto number_of_modes: + message mode_name[i]; + endfor; + % Doesn't make sense to be able to do this twice, so forget this + % definition after it's been used. + save ?; +enddef; + +let ? = help_; + +% These variables determine the size of \MF's (window system) +% window for online output. These numbers should match whatever +% the window system is told, or bizarre positioning of the output +% in the window results. Properly implemented online device drivers +% will use these values as the default size. The defaults here are +% from {\tt plain.mf}. +screen_rows := 400; +screen_cols := 500; + +% The mode most commonly used to make fonts here. +localfont := ljfour; + +%%\bye +%%%% Local variables: +%%%% page-delimiter: "^% here are" +%%%% End: diff --git a/Master/texmf-dist/metafont/misc/ps2mfbas.mf b/Master/texmf-dist/metafont/misc/ps2mfbas.mf new file mode 100644 index 00000000000..a5b2519e563 --- /dev/null +++ b/Master/texmf-dist/metafont/misc/ps2mfbas.mf @@ -0,0 +1,37 @@ +% ps2mfbase.mf +def nonzerowinding = + cull currentpicture dropping (0,0); +enddef; +extra_endchar := extra_endchar & "nonzerowinding;"; +% +smoothing := 0; autorounding := 0; +turningcheck := 0; +define_pixels (FX, FY); +% +picture chp []; +pair p[]; +% +def seac (expr achar, bchar, adx, ady) = + currentpicture := chp [bchar] + chp [achar] shifted (adx * FX, ady * FY); +enddef; +def endseacchar = + endgroup +enddef; +% +def FuF (expr p_path) = + path this_path; + this_path = (p_path -- cycle); +% fill (this_path xscaled FX yscaled FY); + fill (this_path); +enddef; +% +vardef lbl@#(text t) = + if proofing > 1: + forsuffixes $$=b,: + forsuffixes $=t: + makelabel@# (str$.$$, z$.$$); + endfor + endfor + fi +enddef; +% That's all, Folks! diff --git a/Master/texmf-dist/metafont/misc/rtest.mf b/Master/texmf-dist/metafont/misc/rtest.mf new file mode 100644 index 00000000000..f5e449aa7db --- /dev/null +++ b/Master/texmf-dist/metafont/misc/rtest.mf @@ -0,0 +1,13 @@ +% try all characters on TEST.MF using the parameters of cmr10 +if unknown cmbase: input cmbase fi % omit if CMMF can be assumed +mode_setup; + +def generate suffix t= enddef; +input cmr10; font_setup; + +let echar=endchar; +def endchar= echar; stop "done with char "&decimal charcode&". " enddef; +let iff=always_iff; + +input test; +end diff --git a/Master/texmf-dist/metafont/misc/test.mf b/Master/texmf-dist/metafont/misc/test.mf new file mode 100644 index 00000000000..c2d81f03023 --- /dev/null +++ b/Master/texmf-dist/metafont/misc/test.mf @@ -0,0 +1,29 @@ + +cmchar "Lowercase thorn"; +beginchar(oct"015",10u#+serif_fit#,asc_height#,desc_depth#); +italcorr .5x_height#*slant+min(.5curve#-.85u#,-.1u#); +adjust_fit(serif_fit#,0); +pickup tiny.nib; pos1(stem',0); pos2(stem,0); +pos0'(stem',0); pos0(stem,0); z0l=z0'l; x0'=x1; x0=x2; +lft x1l=hround(2.5u-.5stem'); top y1=h; +numeric edge; edge=rt x2r; +pickup fine.nib; pos3(if hefty:thin_join else: hair fi,180); +pos4(vair',90); pos5(curve,0); pos6(vair,-90); +rt x3l=1/3[rt x2,edge]; y3=1/8[bar_height,x_height]; +x4l=w-.5(w-serif_fit)+.5u; top y4r=x_height+oo; +rt x5r=hround min(w-1.35u+.5curve,w-.6u); y5=.5x_height; +x6=x3; bot y6r=-oo; +(x,y4r)=whatever[z3l,z4l]; x4r:=min(x,.5[x5r,x4]); +filldraw stroke z3e{up}...{right}z4e&super_arc.e(4,5) + &z5e{down}...{5(x6-x5),y6-y5}z6e; % bowl +y0=ypart(((edge,h)--(edge,0))intersectionpoint(z3l{up}...{right}z4l)); +pickup tiny.nib; bot y2=-d; +filldraw stroke z1e--z0'e--z0e--z2e; % stem +pickup crisp.nib; pos8(hair,0); pos7'(stem,0); +z7'=z2; x8l=x7'l; bot y8=0; +filldraw stroke z7'e--z8e; % point +if serifs: sloped_serif.l(1,0',a,1/3,jut,serif_drop); % upper serif + dish_serif(2,0,b,1/3,jut,c,1/3,0); fi % lower serif +penlabels(0,1,2,3,4,5,6,8); endchar; + + diff --git a/Master/texmf-dist/metafont/misc/waits.mf b/Master/texmf-dist/metafont/misc/waits.mf new file mode 100644 index 00000000000..4d23e0a00d5 --- /dev/null +++ b/Master/texmf-dist/metafont/misc/waits.mf @@ -0,0 +1,168 @@ +% This file can be loaded after PLAIN.MF. +% It introduces conventions that are commonly used at WAITS. +base_version:=base_version&"/WAITS"; + +% The WAITS implementation allows an extended character set; +% characters :=, <=, <>, and >= are put into the class with <, =, >, :, and |; +% character ^^L (form feed) is in a class by itself, and is like an "outer" \. +% Files containing these special characters should not be expected to work +% elsewhere unless the following replacements are made: + let <= = <=; + let <> = <>; + let >= = >=; + let := = :=; + +% Say "boise_proof" on the command line, to get proofmode on boise +def boise_proof = lcode_:=" /"; + extra_setup:=extra_setup&"grayfont grbois;" enddef; + +screen_rows:=400; screen_cols:=480; + +% Here are conventions for local output devices: + +mode_def dover = % dover mode: for the Xerox Dover + proofing:=0; % no, we're not making proofs + fontmaking:=1; % yes, we are making a font + tracingtitles:=0; % no, don't show titles in the log + pixels_per_inch:=384; + blacker:=1.2; % make pens somewhat blacker + fillin:=0; % no compensation for fillin + o_correction:=.6; % but don't overshoot as much + enddef; + +mode_def imagen = % imagen mode: for the Imagen 8/300 (Canon engine) + proofing:=0; % no, we're not making proofs + fontmaking:=1; % yes, we are making a font + tracingtitles:=0; % no, don't show titles in the log + pixels_per_inch:=300; + blacker:=0; % Canon engine is black enough + fillin:=.2; % and it tends to fill in diagonals + o_correction:=.6; % + enddef; + +mode_def qms = % qms mode: for the QMS (Xerox engine) + proofing:=0; % no, we're not making proofs + fontmaking:=1; % yes, we are making a font + tracingtitles:=0; % no, don't show titles in the log + pixels_per_inch:=300; + blacker:=.75; % (this value is conjectural) + fillin:=0; % (ditto) + o_correction:=.5; % (ditto) + enddef; + +mode_def aps = % aps mode: for the Autologic APS-Micro5 + proofing:=0; % no, we're not making proofs + fontmaking:=1; % yes, we are making a font + tracingtitles:=1; % yes, show titles online + pixels_per_inch:=722.909; % that's roughly 10 per pt + blacker:=.2; % make pens a teeny bit blacker + fillin:=.2; % but compensate for diagonal fillin + o_correction:=1; % and keep the full overshoot + enddef; + +mode_def crs = % crs mode: for the Alphatype CRS + proofing:=0; % no, we're not making proofs + fontmaking:=1; % yes, we are making a font + tracingtitles:=1; % yes, show titles online + begingroup interim warningcheck:=0; % (we need to go past 4096) + pixels_per_inch:=4000+4000/3 endgroup; % HIGH res + blacker:=4; % make pens a lot blacker + fillin:=0; % but don't compensate for fillin + o_correction:=1; % and keep the full overshoot + enddef; + +mode_def boise = % boise mode: for the HP 2680A + proofing:=0; % no, we're not making proofs + fontmaking:=1; % yes, we are making a font + tracingtitles:=0; % no, don't show titles in the log + pixels_per_inch:=180; + blacker:=.55; % make pens a bit blacker + fillin:=.1; % and compensate for diagonal fillin + o_correction:=.3; % but don't overshoot much + enddef; + +mode_def DD = % DD mode: for the DataDisc (usually with mag=magstep 2=1.44) + proofing:=0; % no, we're not making proofs + fontmaking:=1; % yes, we are making a font + tracingtitles:=0; % no, don't show titles in the log + pixels_per_inch:=70; % really lowres + blacker:=0; % don't make the pens any blacker + fillin:=0; % and don't compensate for fillin + o_correction:=.2; % but suppress most overshoots + enddef; + +mode_def canon = % canon mode: for the old Imagen (Canon LBP10) + proofing:=0; % no, we're not making proofs + fontmaking:=1; % yes, we are making a font + tracingtitles:=0; % no, don't show titles in the log + pixels_per_inch:=240; + blacker:=.2; % make pens a wee bit blacker + fillin:=.2; % and compensate for fillin + o_correction:=.4; % but don't overshoot as much + enddef; + +mode_def newDD = % newDD mode: for DataDisc with special aspect ratio + proofing:=0; % no, we're not making proofs + fontmaking:=1; % yes, we are making a font + tracingtitles:=0; % no, don't show titles in the log + pixels_per_inch:=70; % really lowres + blacker:=0; % don't make the pens any blacker + fillin:=0; % and don't compensate for fillin + o_correction:=.2; % but suppress most overshoots + aspect_ratio:=4/3; % this is the new feature... + enddef; + +mode_def cg = % cg mode: for the Compugraphic 8600 + proofing:=0; % no, we're not making proofs + fontmaking:=1; % yes, we are making a font + tracingtitles:=1; % yes, show titles online + pixels_per_inch:=1301.5; % a bit less than 20 per pt + blacker:=.2; % make pens a teeny bit blacker + fillin:=.2; % but compensate for diagonal fillin + o_correction:=1; % and keep the full overshoot + aspect_ratio:=1569/1301.5; % strange, no? + enddef; + +mode_def epson = % Epson + proofing:=0; % no, we're not making proofs + fontmaking:=1; % yes, we are making a font + tracingtitles:=0; % no, don't show titles in the log + pixels_per_inch:=240; % lowres + blacker:=0; % don't make the pens any blacker + fillin:=0; % and don't compensate for fillin + o_correction:=.2; % but suppress most overshoots + aspect_ratio:=9/10; % 216 dots/inch vertical + enddef; + + +localfont:=imagen; + +% Finally, here are macros for Xerox-world font info: + +def font_family expr s = % string s names the font family, e.g., "CMR" + headerbyte 49: BCPL_string(s,20); + special "identifier "&s enddef; +def coding_scheme expr s = % string s names the scheme, e.g. "TEX TEXT" + headerbyte 9: BCPL_string(s,40); + special "codingscheme "&s enddef; +def font_face_byte expr x = % integer x gives the family member number, + headerbyte 72: x; % which should be between 0 and 255 + special "fontfacebyte"; numspecial x enddef; + +def BCPL_string(expr s,n)= % string s becomes an n-byte BCPL string + for l:=if length(s)>=n: n-1 else: length(s) fi: l + for k:=1 upto l: , substring (k-1,k) of s endfor + for k:=l+2 upto n: , 0 endfor endfor enddef; + +Xerox_world:=1; % users can say `if known Xerox_world:...fi' + +inner end; +def bye= + if fontmaking>0: font_family font_identifier_; + coding_scheme font_coding_scheme_; + font_face_byte max(0,254-round 2designsize); fi + tracingstats:=1; % at least for now we want this + end + enddef; + +outer bye,end; diff --git a/Master/texmf-dist/metafont/misc/ztest.mf b/Master/texmf-dist/metafont/misc/ztest.mf new file mode 100644 index 00000000000..35d1489e275 --- /dev/null +++ b/Master/texmf-dist/metafont/misc/ztest.mf @@ -0,0 +1,13 @@ +% try all characters on TEST.MF using the parameters of an unknown font +if unknown cmbase: input cmbase fi % omit if CMMF can be assumed +mode_setup; + +def generate suffix t= enddef; +input z; font_setup; + +let echar=endchar; +def endchar= echar; stop "done with char "&decimal charcode&". " enddef; +let iff=always_iff; + +input test; +end diff --git a/Master/texmf-dist/metafont/roex/roex.mf b/Master/texmf-dist/metafont/roex/roex.mf new file mode 100644 index 00000000000..dbf6f8e35dc --- /dev/null +++ b/Master/texmf-dist/metafont/roex/roex.mf @@ -0,0 +1,1756 @@ +%%%% +%%%% This file belongs to the ROEX package. +%%%% +%%%% --------------------------------------------------------------------- +%%%% MFT formatting commands +%%%% --------------------------------------------------------------------- +%%% length quicksort +%%% length cycle zang pos_turn neg_turn +%%% good enc +%%% labels makelabel +%%% length make_cycle make_join make_cyclic_join make_end make_edge +%%% point predir postdir upredir upostdir udir +%%% dotprod det +%%% subpath pos_subpath neg_subpath +%%% message info_ro info_es +%%% draw roex_default +%%% -- && +%%%% --------------------------------------------------------------------- +%%%% \TeX formatting commands +%%%% --------------------------------------------------------------------- +%%\vsize245mm +%%\font\titfnt cmtt10 at 48 pt +%%{\let\makefootline\empty \let\makeheadline\empty +%%\vglue0ptplus1fill +%%\centerline{\titfnt ROEX.MF} +%%\bigskip +%%\centerline{ver. 0.56 (Wednesday, October 25th, 1995)} +%%\vfill\vfill\eject} +%% % --- +%% \vsize 245mm +%% % an innocent formatting trick: the underscore character ending a name +%% % will be typeset as an superscript asterisk +%% \let\oriunderscore\_ +%% \newif\ifbgroupopen\bgroupopenfalse +%% \def\altdblbackslash#1{\bgroup\bgroupopentrue\it#1} +%% \def\optegroup{\ifbgroupopen\egroup\fi} +%% \def\underscoreasasterisk#1{% +%% \ifx#1\relax\optegroup^*\else\oriunderscore#1\fi} +%% \def\\#1{% +%% \let\_\underscoreasasterisk +%% \altdblbackslash{#1\relax}\optegroup +%% \let\_\oriunderscore} +%% % --- +%% \def\dblhyph{--} +%% \def\8#1{\def\eightparm{#1}\mathrel{\mathcode`\.="8000 \mathcode`\-="8000 +%% \ifx\eightparm\dblhyph\setbox\shorthyf\hbox{\bf -\kern-.05em}\fi% +%% #1\unkern}} % `..' and `--' +%% % --- +%% \def\MP{{\tenlogo META}\-{\tenlogo POST}} +% ------------------------------------------------------------------------ +% This is ROEX.MF file containing \MF definitions implementing +% operations known as `remove overlap' and `expand stroke'. +% ------------------------------------------------------------------------ +% Authors: \bf{}B. Jackowski, P. Pianowski, M. Ry\'cko \& S. Soko\l{}owski +% ------------------------------------------------------------------------ +% H I S T O R Y +% ver. 0.1 (1 / 9 VI 1994): +% * incunabula version +% ver. 0.5 (15 VIII / 1 IX 1995): +% * pioneer version, released during the 9th Euro\TeX conference in Arnhem +% ver. 0.55 (26 IX 1995): +% * if a single path is an argument to |remove_overlap|, removing +% of self-overlaps is performed, hence several adjustments, most +% significant changes were introduced in |is_far_enough| and +% |intersect_two_segments|; this ismprovement is, in fact, a prelude +% towards a more general approach +% * a bug trap added in |clean_path| +% * positioning of labels not forced in |mark_nodes| +% * |quicksort| more flexible +% * more statistics available (optionally) in |find_minimal_secant| +% * displaying information changed +% * \TeX formatting comments collected at the beginning of the file +% * a result of mental laps corrected in |build_node_structure| +% (minimal secant has nothing to do with minimal distance between nodes) +% * a silly bug removed in |prepare_input_data| (|W| instead of |W_|) +% This version was released during the CyrTUG-95 meeting in Moscow +% ver. 0.56 (27 X 1995): +% * comments adjusted to a new distribution +% * the name |miter_limit| changed to |miter_size| in order to avoid +% misunderstanding, as in this implementation it is a dimen, while +% in PostScript it is a dimensionless quantity +% ------------------------------------------------------------------------ +% S Y N O P S I S +% ------------------------------------------------------------------------ +% +% Such operations as `remove overlap' and `expand stroke' are perhaps +% particularly useful in the contex of exporting data from \MF to other +% languages, e.g., to PostScript or HP-GL. Therefore the file ROEX.MF has +% been included into the MFTOEPS package (which accomplishes export from \MF +% to Encapsulated PostScript), although it can be used by ``normal'' \MF +% users, too. Therefore our favourite macros (e.g., |pos_turn|, |neg_turn|, +% |make_list|), are defined identically in both ROEX and MFTOEPS. +% +% We hope that tiny adjustments, if any, should be sufficient for transforming +% the macros to the form accepted by both \MF and \MP. +% +% Sample \MF programs (i.e., simple examples) illustrating the use of the +% ``interface'' macros, i.e., |remove_overlap|, |expand_stroke| and +% |change_weight|, can be found in a subdirectory ROEXSAMP. It is instructive +% to generate EPS files and then to play around with the results using +% CorelDRAW! or Adobe Illustrator. +% +% +% REMOVING OVERLAPS +% +% The command |remove_overlap_| requires three parameters. The first +% parameter is a list of paths to be processed; the paths are assumed to +% have a non-zero |turningnumber| and no self intersecting points (no +% checking is performed, except that non-cyclic paths are ignored). +% The second parameter is a list (possibly empty) of weights assigned +% to paths; more exactly, it is a list of pairs |(i,w.i)|, where |i| is +% the order number of a path and |w.i| is the respective weight. +% If the weight is not specified it is assumed to be equal to |1|. +% The last parameter is a suffix, i.e., the name of the resulting data +% structure; given a suffix is |R|, |R.num| is the number of the resulting +% paths, and |R1|, |R2|, ..., |R[R.num]| are the paths. If the suffix +% contains an index, e.g., |P[x]q|, the user is responsible for providing +% appropriate declarations prior to calling |remove_overlap|, +% in this case: |numeric P[\\]q.num; path P[\\]q[\\]|. If a variable +% |append_results| is assigned a definite value (by default it is undefined), +% |R.num| is not zeroed at the stage of initialisation, thus the results +% are accumulated (see example ROES-02.MF in the subdirectory ROEXSAMP). +% +% The algorithm assumes that a path |p| fills its interior with the colour +% |w*turningnumber(p)|, where |w| is the weight assigned to |p|. If an +% area is coloured by several paths, the colors are summed up. The user +% decides which areas are the resulting ones. By default, these are areas +% which have the interior painted with a colour $\ge1$ and the exterior +% painted with a colour $\le0$. There is a two-parameter function +% (parameters are numbers) that can be redefined by a user, |good_colors|, +% which governs the decision. The user is responsible for a proper definition +% of this function (the formula |good_colors(m,n) and good_colors(n,m)| must +% be false; cf. the default definition of |good_colors| at the end of this +% file). There is also a variable |background_color|, by default equal to |0|, +% which determines the colour of the Euclidian plane. One more function that +% is meant to be redefined by the user, if needed, is one-parameter function +% |touch_path|; the function is applied to every input path at the stage of +% initialisation, and can be used, e.g., for adjusting the direction of paths +% (cf. example RO-04.MF in the subdirectory ROEXSAMP). +% +% The orientation of paths generated by the |remove_overlap| macro is defined +% in such a way that in order to fill the resulting figure the internal +% variable |turningcheck| should be set to zero prior to using the |fill| +% command. +% +% Examples: +% Assume that paths |A|, |B| and |C| are defined as follow (say, |w=h=1cm|): +% |A=unitsquare xscaled 1/5w yscaled h shifted (2/5w,0);| +% |B=A rotatedaround((1/2w,1/2h), 60);| +% |C=B rotatedaround((1/2w,1/2h), 60);| +% Calling +% |remove_overlap (A,B,C) () R;| +% will result in generating a single path |R1| (|R.num=1|) of a six-arm +% propeller shape. Adding one more path: +% |D=reverse fullcircle scaled 3/4w shifted (1/2w,1/2h);| +% and calling +% |remove_overlap (A,B,C,D) ((4,2)) R;| +% (|D| has weight |=2|) will result in generating seven objects: six +% ``tips'' of a propeler and a regular hexagon in the center. Try to guess +% what would be the result of +% |remove_overlap (A,B,C,D) () R;| +% Not all paths need to intersect. For example, the following set of paths +% |A=fullcircle scaled w shifted (1/2w,1/2h);| +% |B=reverse unitsquare xscaled 1/5w yscaled 3/5w shifted (2/5w,1/5w);| +% |C=B rotatedaround((1/2w,1/2h), 90);| +% after calling +% |remove_overlap (A,B,C) () R;| +% will yield a circle surrounding a white cross. Since the orientation +% of the resulting paths is important here, the |fill| commands should be +% preceded by +% |interim turningcheck:=0;| +% assignment. +% +% +% EXPANDING STROKES +% +% Expanding stroke means finding the trace of the outline of an imaginary pen +% moving along a path. There are two commands accomplishing expanding stroke: +% |expand_stroke| and |change_weight|. Both make use of the essentially the +% same algorithm, except that the latter finds only one edge and ignores +% non-cyclic paths. Both commands require three parameters: first and third +% are analogous to the parameters of the |expand_stroke| macro (see above), +% the second denotes the radius (not diameter) of the circular pen. +% The algorithm works in such a way that the result of the |expand_stroke| +% does not depend on the direction of a path for cyclic paths, namely, +% the outer edge is always positively directed and the inner is negatively +% directed, provided the radius is positive; if the radius is negative, +% the outer edge is negatively directed and the inner one---positively. +% For non-cyclic paths positive radius yields positively directed resulting +% paths, negative radius---negatively oriented paths. Although the macro +% |change_weight| is subdued to the same rules, the result depends both +% on the direction of a path and on the sign of a radius. Let |t| and |r| +% denote the turning number and the radius, respectively; there are +% four cases: +% 1) |t>0| and |r>0|: the resulting path is an outer edge positively +% directed, +% 2) |t>0| and |r<0|: the resulting path is an inner edge positively +% directed, +% 3) |t<0| and |r>0|: the resulting path is an inner edge negatively +% directed, +% 4) |t<0| and |r<0|: the resulting path is an outer edge negatively +% directed. +% Following PostScript, we introduced three variables which govern the shape +% of joins and ends: |join_kind| (corresponds to |setlinejoin|), |end_kind| +% (corresponds to |setlinecap|) and |miter_size| (corresponds, as the name +% suggest, to |setmiterlimit|; however, here |miter_size| is a dimen, +% while in PostScript miter limit is a dimensionless quantity). +% Currently both |join_kind| and |end_kind| can receive value |0| or |1|, +% while in PostScript value |2| is also admissible. (The latter option +% will perhaps be included also into the ROEX package some day, but more +% tempting is the implementation of extrapolated non-linear joins.) +% Since the interpretation of |miter_size| (dimen) is slightly different than +% the interpretation of |miter_limit| (a number), |miter_size| must merely +% be non-negative, while |miter_limit| must be greater than or equal to $1$. +% Roughly speaking, value |0| for |join_kind| and |end_kind| denotes cusp +% joins, cut if necessary at miter limit; value |1| denotes rounded rounded +% joins (for details see, e.g., ``PostScript Language Reference Manual,'' +% second ed., Addison-Wesley Publishing Company, Ltd.). +% +% Example: +% Assume that a path |A| is simply a square (say, |w=h=1cm|): +% |A=unitsquare scaled w;| +% After calling +% |expand_stroke(A)(1mm)R;| +% |R1| is a positively directed square of side |12mm|, and |R2| is +% negatively directed square of side |8mm|. +% ------------------------------------------------------------------------ +% C A V E A T S , H I N T S A N D C O M M E N T S +% * The employed algorithms expect that the results are well defined; +% if the data are weird (e.g., self-loooping path are supplied) +% the results, if any, may be weird as well. +% * The case of curves partially overlapping is not handled and, frankly +% speaking, we have no idea how to implement it efficiently and robustly; +% if there are such pairs of paths in the input data, the algorithm almost +% certainly will not produce good results. +% * Only circular pens are implemented so far. +% * Be aware of rounding errors, they may cause unpredictable results; +% in some cases increasing accuracy by using a higher resolution may +% help, but more adequate seems to be preparing better data (cf. the +% program RO-07.MF in the subdirectory ROEXSAMP). +% * Comments in the code are meant primarily for the authors; the user +% is kindly requested not to complain fiercely if they are of a little +% use to her/him. +% * Unfortunately, \MF has no error-handling facility, hence a lot of +% ``bug traps'' can be found in the code; messages issued in the case +% of falling into such a trap are rather useless if you don't know the +% details of the algorithm; this part of the program is certainly to be +% improved; usually the error help says ``Better stop now! Algorithm +% failed'' and this advice should be followed; in practice this means that +% \MF is not able to recognize the details of the picture because of +% very close nodes (intersection points). +% * Usually, the first stage of removing overlaps (finding all intersection +% points) is the longest one, the more segments paths have the longer it +% lasts; a pity that \MF has no built-in function informing about all +% intersection points/times of two B\'ezier curves. +% * Improper definition of |good_colors| may result in erroneous behaviour of +% the algorithm. +% * One peculiar case is considered by the expanding stroke algorithm, +% namely cyclic path of length 2; some more cases might have been taken +% into account... +% * There remain a lot of unsolved problems with numerical instability +% connected with detecting tangent and close points. +% * In The \MF{}book, p. 229, D. E. Knuth writes: +% ``...tiny little loops won't hurt anything if you are filling cycles +% in the correct direction.'' +% Cf. also preceding dangerous band paragraph and exercise on pp. 228--229. +% ROEX does much more complex things with paths than merely filling them, +% hence tiny loops may cause some mess, the more so as the built-in +% function |turningnumber| is very sensitive to such loops, e.g., it may +% happen that |turningnumber(p)=1| while |turningnumber(reverse p)=0| +% (cf. example RO-6.MF in the subdirectory ROEXSAMP); hence a hopefully +% more robust (from the point of view of this application) function +% is used, |check_turn|, which makes use of \MF's |fill| operation. +% * There remain several suboptimal algorithms employed, partially on +% purpose: less efficient algorithms are usually (although not necessarily) +% more comprehensible and flexible (easier to modify), which is important +% at the stage of developing a program. +% * Parameters that may have influence on the process of removing +% overlaps are |epsil.time|, |epsil.ang| (in degrees), |epsil.dist| (in +% resolution-dependent units), and |max_idx|; the choice of good default +% values will need some practice. +% * Incompatible modifications may come, although we shall do our best +% to avoid them. +% ------------------------------------------------------------------------ +% We follow the naming convention of The \MF{}book: +% ``Private tokens always end with the underscore character.'' +% Since the underscore is a rather illegible character, in a ``neat'' +% printing (using MFT utility) it will appear as an superscript asterisk. +% ------------------------------------------------------------------------ +% D E F I N I T I O N S +% ------------------------------------------------------------------------ +% UNIVERSAL MACROS: +% --- +% Without the following redefinition: +def -- = {curl 1} .. tension (1+eps) .. {curl 1} enddef; +% the result of |p intersectiontimes reverse p|, where |p=(a,b)--(a+3c,b+3d)|, +% |a|, |b|, |c|, |d| are arbitrary (sic!) \MF's numbers, yields the result +% |(1/2,1/2)|, which contradicts the statement preceding the exercise 14.17 +% on the page 137 of The \MF{}book. Since it is no longer a ``standard'' +% macro, its formatting is slightly modified. +% --- +%%% length ]]] ]]]] +%%% ; ] +def ]]] = ] ] ] enddef; +def ]]]] = ] ] ] ] enddef; % right brackets should be loners, indeed +%%% ) ] ]] ]]] ]]]] +% --- +vardef distance(expr za,zb) = length(za-zb) enddef; % in fact, an alias +% --- +vardef interval(expr ta,tb,p) = + save ta_,tb_; + if cycle p: + ta_:=ta mod length(p); tb_:=tb mod length(p); + min(length(p)-abs(ta_-tb_), abs(ta_-tb_)) + else: + ta_:=min(max(0,ta),length(p)); tb_:=min(max(0,tb),length(p)); + abs(ta_-tb_) + fi +enddef; +% --- +def make_list(expr k,l) suffix s = + for i_:=k upto l: if i_>k: , fi \\ s[i_] endfor +enddef; +% --- +vardef dec_pair(expr z) = + "(" & decimal(xpart z) & "," & decimal(ypart z) & ")" +enddef; +% --- +primarydef u det v = % dual operation to |dotprod| + (xpart u * ypart v - xpart v * ypart u) +enddef; +% --- +vardef zang(expr u,v) = % useful during testing +% computes the angle form |u| to |v| (useful for testing) + angle(u dotprod v,u det v) mod 360 % CAVEAT! rounding errors +enddef; +% --- +vardef turn_ang(expr za,zb) = % more robust version of |zang| +% The idea of computing the turn angle is based on the following observation: +% |z reflectedabout (origin,right)=1/z| for a complex number |z| such that +% |abs(z)=1|; recall also that multiplication of complex numbers +% (|zscaled| operation) implies addition of their angle arguments. + if (abs(za)>=epsil.len) and (abs(zb)>=epsil.len): % |eps| may be not enough + angle(unitvector(za) zscaled (unitvector(zb) reflectedabout (origin,right))) + else: whatever fi +enddef; +% --- +def predir expr t of p = ((point t of p)-(precontrol t of p)) enddef; +def postdir expr t of p = ((postcontrol t of p)-(point t of p)) enddef; +def udir expr t of p = unitvector(direction t of p) enddef; +def upredir expr t of p = unitvector(predir t of p) enddef; +def upostdir expr t of p = unitvector(postdir t of p) enddef; +% --- +vardef pos_turn primary p = + interim autorounding:=0; + if check_turn(p)=0: show p; + errhelp "I will leave the path intact, continue with crossed fingers."; + errmessage "Cannot make positive turn (check_turn=0)"; + elseif check_turn(p)<0: reverse fi \\ p +enddef; +% --- +vardef neg_turn primary p = + interim autorounding:=0; + if check_turn(p)=0: show p; + errhelp "I will leave the path intact, continue with crossed fingers."; + errmessage "Cannot make negative turn (check_turn=0)"; + elseif check_turn(p)>0: reverse fi \\ p +enddef; +% --- +vardef check_turn primary p = % seems more adequate than |turningnumber| +% |epsilon|=|totalweight currentpicture| after |fill unitsquare|, +% |eps/epsilon=32|, i.e., we admit accuracy of 32 pixels (isn't it too many?) + save r_,currentpicture; picture currentpicture; + interim turningcheck:=0; interim autorounding:=0; + currentpicture:=nullpicture; fill p; r_:=totalweight(currentpicture); + if r_>eps: 1 elseif r_<-eps: -1 else: turningnumber(p) fi +enddef; +% --- +def check_embedding(expr a,b)(suffix res) = +begingroup +% see comment in |check_turn| + save napb_,panb_,currentpicture; picture currentpicture; + interim turningcheck:=0; interim autorounding:=0; + currentpicture:=nullpicture; fill pos_turn a; fill neg_turn b; cullit; + panb_:=totalweight currentpicture; + currentpicture:=nullpicture; fill neg_turn a; fill pos_turn b; cullit; + napb_:=totalweight currentpicture; + if (panb_<eps) and (napb_<>0): res:=1; % $a \subset b$ + elseif (panb_<>0) and (napb_<eps): res:=2; % $b \subset a$ + else: res:=0; fi % undefined result +endgroup +enddef; +% --- +vardef pos_subpath expr z of p = + if not cycle p: subpath z of p + else: + if xpart(z)<=ypart(z): subpath z of p + else: subpath (xpart(z),ypart(z)+length(p)) of p + fi + fi +enddef; +% --- +vardef neg_subpath expr z of p = + if not cycle p: subpath z of p + else: reverse(pos_subpath (ypart z,xpart z) of p) fi +enddef; +% --- +tertiarydef p && q = % |length(p)>0| + (subpath(0,length(p)-1) of p) .. + controls (postcontrol length(p)-1 of p) and (precontrol length(p) of p) + .. q +enddef; +% --- +def make_cycle expr p = % |length(p)>0| + (subpath(0,length(p)-1) of p) .. + controls (postcontrol length(p)-1 of p) and (precontrol length(p) of p) + .. cycle +enddef; +% --- +vardef is_line(expr B) = +% checks if a B\'ezier segment |B| is an almost straight line; +% recall that |z reflectedabout (origin,right)=1/z| for a complex +% number |z| such that |length(z)=1|; recall also that the multiplication +% of complex numbers (|zscale| operation) implies the addition of +% their angle arguments + save pa_,pb_,pc_,pd_,ba_,da_,dc_; pair pa_,pb_,pc_,pd_,ba_,da_,dc_; + pa_:=point 0 of B; pd_:=point 1 of B; + if distance(pa_,pd_)<epsil.dist: + false % either really not a line or an uncertain situation (rounding errors) + else: + da_=unitvector(pd_-pa_) reflectedabout (origin,right); + pb_:=postcontrol 0 of B; if distance(pa_,pb_)<epsil.dist: pb_:=pa_; fi + pc_:=precontrol 1 of B; if distance(pd_,pc_)<epsil.dist: pc_:=pd_; fi + if (pa_=pb_) and (pc_=pd_): true + elseif (pa_=pb_): + dc_=unitvector(pd_-pc_); abs(angle(dc_ zscaled da_))<epsil.ang + elseif (pc_=pd_): + ba_=unitvector(pb_-pa_); abs(angle(ba_ zscaled da_))<epsil.ang + else: + ba_=unitvector(pb_-pa_); dc_=unitvector(pd_-pc_); + (abs(angle(ba_ zscaled da_))<epsil.ang) + and (abs(angle(dc_ zscaled da_))<epsil.ang) + fi + fi +enddef; +% --- +vardef is_tiny_bez(expr B) = +% checks if B\'ezier segment |B| is negligibly small + (distance((postcontrol 0 of B),(point 0 of B))<epsil.dist) + and (distance((precontrol 1 of B),(point 0 of B))<epsil.dist) + and (distance((point 1 of B),(point 0 of B))<epsil.dist) +enddef; +% --- +vardef are_parallel(expr B,C) = +% checks if B\'ezier segments |B| and |C| are linear and parallel +save a_; + if is_line(B) and is_line(C): + a_:=turn_ang((point 0 of B)-(point 1 of B),(point 0 of C)-(point 1 of C)); + (if known a_: abs(a_)<epsil.ang else: false fi) + else: false fi +enddef; +% --- +vardef tidy_lines(expr P) = +% converts almost linear segments of a path |P| into a ``tidy'' lines (|--|) + save B_; path B_; + for i_:=1 upto length(P): if i_>1: & fi + hide(B_:=subpath (i_-1,i_) of P) + if is_line(B_): ((point 0 of B_)--(point 1 of B_)) else: B_ fi + endfor if cycle P: & cycle fi +enddef; +% --- +def add_bez(expr ta,tb, p) = + .. controls (postcontrol ta of p) and (precontrol tb of p) .. (point tb of p) +enddef; +% --- +vardef clean_path(expr P) = +% this routine joins together colinear neighbouring segments and removes +% ``tiny'' edges of a cyclic path |P| (performed at the end of removing +% overlaps and expanding stroke); since some nodes may become ``midline'' +% ones after cleaning, the operation is performed twice + if cycle P: + save P_,for_del_,not_del_,i_,j_; path P_; +% mark all deletable nodes and one non-deletable node: + for i_:=0 upto length(P)-1: + if are_parallel(subpath (i_-1,i_) of P,subpath (i_,i_+1) of P) + or is_tiny_bez(subpath(i_-1,i_) of P): + for_del_[i_]:=1; + else: + not_del_:=i_; + fi + endfor; +% BUG TRAP: + if unknown not_del_: + err_helpless; + errmessage "ROEX ERROR: all nodes deleted during path cleaning"; + fi +% delete nodes: + i_:=j_:=not_del_; % we start with |not_del_|: one of not deleted points + P_:=(point j_ of P) + forever: +% invariant: |i_| recent not deleted point, |j_| current point + hide(j_:=(j_+1) mod length(P)) + if unknown for_del_[j_]: add_bez(i_,j_,P) \\ hide(i_:=j_) fi + exitif j_=not_del_; + endfor & cycle; + tidy_lines(P_) + else: P fi +enddef; +% --- +vardef is_less(expr a,b) = (a<b) enddef; +vardef quicksort@#(expr ii,jj)(suffix s)(text t) = +% sorts |@#.s[ii..jj]| along with |@#.$[ii..jj]| for |$| in |t|, +% using Tony Hoare's ``quick sort'' method; suffix |s| must must not occur +% in the |t| list (no checking is performed); if both |s| and |t| are empty, +% |t| is ignored. +% REMARK 1: the algorithm has no explicit recursion, because of \MF's limits +% on recursion level. +% REMARK 2: the algorithm, of course, is not stable, i.e., it does not +% preserve the order of equal items, but it does not matter here + save i_,j_,k_,l_,cell_,stack_,incl_t_; boolean incl_t_; + pair stack_[\\]; stack_.lev:=0; stack_[incr stack_.lev]:=(ii,jj); + i_:=0; for $:=t: i_:=i_+1; endfor % ``measure'' |t|-list + incl_t_:=(str s <> "") or ((str s = "") and (i_<>0)); + forsuffixes $:= s if incl_t_: , t fi: + if numeric @#.$[ii]: numeric cell_.$; + elseif string @#.$[ii]: string cell_.$; + elseif boolean @#.$[ii]: boolean cell_.$; + fi + endfor + forever: + exitif stack_.lev<=0; + numeric i_,j_; (i_,j_)=stack_[stack_.lev]; stack_.lev:=stack_.lev-1; + if i_<j_: + forsuffixes $:= s if incl_t_: , t fi: cell_.$:=@#.$[i_]; endfor + l_:=i_; + for k_:=i_+1 upto j_: + if is_less(@#.s[k_],cell_.s): + forsuffixes $:=s if incl_t_: , t fi: + @#.$[l_]:=@#.$[k_]; @#.$[k_]:=@#.$[l_+1]; + endfor + l_:=l_+1; + fi + endfor + forsuffixes $:= s if incl_t_: , t fi: @#.$[l_]:=cell_.$; endfor + stack_[incr stack_.lev]:=(i_,l_-1); stack_[incr stack_.lev]:=(l_+1,j_); + fi + endfor +enddef; +% --- +% R-O MACROS: +% --- +% visualising macros (useful for testing): +% --- +def mark_nodes = + if proofing>0: + for i_:=1 upto NODE_.num: + makelabel(decimal(i_) & ":" & decimal(NODE_.pth[i_]), + point TIME_[NODE_.pth[i_]]tim[NODE_.tim[i_]] of PATH_[NODE_.pth[i_]]); + endfor + fi +enddef; +% --- +def mark_area(expr i) = +begingroup + save j_,v_; j_:=i; mark_edge(j_); v_[j_]:=0; + forever: j_:=EDGE_.out[j_]; exitif (j_=i) or (known v_.emerg); + if known v_[j_]: v_.emerg:=0; else: mark_edge(j_); v_[j_]:=0; fi + endfor +endgroup +enddef; +% --- +def mark_edge(expr i) = +begingroup + if proofing>0: + save currentpen, currentpen_path; pen currentpen; path currentpen_path; + makelabel(decimal(i), + (point .5length(the_edge(i)) of the_edge(i))+ + 1pt*(udir .5length(the_edge(i)) of the_edge(i)) rotated 90); + pickup pencircle scaled 1; + draw (point .5length(the_edge(i)) of the_edge(i))-- + ((point .5length(the_edge(i)) of the_edge(i))+ + (1pt*(udir .5length(the_edge(i)) of the_edge(i)) rotated 90)); + makelabel("", point 0 of the_edge(i)); + fi +endgroup +enddef; +% --- +def mark_edges = + for i_:=-EDGE_.num upto EDGE_.num: if i_<>0: mark_edge(i_); fi endfor +enddef; +% --- +def show_area(expr i) = +begingroup + save j_,v_; j_:=i; + message "EDGE " & decimal(j_) & "/" & decimal(EDGE_.pth[j_]) & ":"; + message "color " & + if known EDGE_.col[j_]: decimal(EDGE_.col[j_]) else: "???" fi; + v_[j_]:=0; + forever: j_:=EDGE_.out[j_]; exitif (j_=i) or (known v_.emerg); + if known v_[j_]: v_.emerg:=0; fi + v_[j_]:=0; message " " & decimal(j_) & "/" & decimal(EDGE_.pth[j_]); + endfor +endgroup +enddef; +% --- +def show_areas = + for i_:=-EDGE_.num upto EDGE_.num: if i_<>0: show_area(i_); fi endfor +enddef; +% --- +def err_helpless = + errhelp "Better stop now! Algorithm failed."; +enddef; +% --- +def err_extra_info(expr i,j) = + message +"========================== BEGIN OF ERROR INFO: =========================="; + for k_:=i,j: + if known k_: + message "Edge " & decimal(k_) & + " (a subpath of the path " & decimal(EDGE_.pth[k_]) & "):"; + message "Color:"; show EDGE_.col[k_]; show the_edge(k_); + fi + endfor; +enddef; +% --- +% principal macros: +% --- +vardef edge_path(expr i) = PATH_[EDGE_.pth[i]] enddef; +vardef first_time(expr i) = + TIME_[NODE_.pth[EDGE_.fnd[i]]]tim[NODE_.tim[EDGE_.fnd[i]]] +enddef; +vardef last_time(expr i) = + TIME_[NODE_.pth[EDGE_.lnd[i]]]tim[NODE_.tim[EDGE_.lnd[i]]] +enddef; +% --- +vardef the_edge(expr i) = + if i>0: pos_subpath else: neg_subpath fi + (first_time(i), last_time(i)) of edge_path(i) +enddef; +% --- +vardef make_area(expr i) = + save j_,q_,v_; path q_; j_:=i; v_[j_]:=0; q_:=the_edge(j_); + forever: j_:=EDGE_.out[j_]; exitif (j_=i) or (known v_.emerg); + if known v_[j_]: + show_area(i); err_helpless; + errmessage "RO ERROR: Edge " & decimal(j_) & " revisited"; + v_.emerg:=0; + fi + v_[j_]:=0; q_:=q_ && the_edge(j_); + endfor + make_cycle(q_) +enddef; +% --- +vardef is_tangent(expr i,j,k,l) = + save e_,d_,pi_,pj_,ti_,tj_; path e_,pi_,pj_; + if (TIME_[i]num=0) or (TIME_[j]num=0): true + else: + ti_.loc:=TIME_[i]tim[k]; + ti_.prv:=TIME_[i]tim[(k-1) mod (TIME_[i]num+1)]; + ti_.nxt:=TIME_[i]tim[(k+1) mod (TIME_[i]num+1)]; + tj_.loc:=TIME_[j]tim[l]; + tj_.prv:=TIME_[j]tim[(l-1) mod (TIME_[j]num+1)]; + tj_.nxt:=TIME_[j]tim[(l+1) mod (TIME_[j]num+1)]; + pi_:=PATH_[i] shifted (-point ti_.loc of PATH_[i]); + pj_:=PATH_[j] shifted (-point tj_.loc of PATH_[j]); + d_:=min( + distance(point ti_.loc of pi_, point ti_.prv of pi_), + distance(point ti_.loc of pi_, point ti_.nxt of pi_), + distance(point tj_.loc of pj_, point tj_.prv of pj_), + distance(point tj_.loc of pj_, point tj_.nxt of pj_)); +% BUG TRAP 1: + if d_<epsil.dist: + err_helpless; + errmessage "RO ERROR: Cannot check tangency (too short secants)"; + fi + e_:=enc.pth scaled (1/2[epsil.dist,d_]); + save ta_,tb_,tc_,td_; + save tt_; + (tt_,ta_)=(pos_subpath (ti_.prv,ti_.loc) of pi_) intersectiontimes e_; + save tt_; + (tt_,tb_)=(pos_subpath (ti_.loc,ti_.nxt) of pi_) intersectiontimes e_; + save tt_; + (tt_,tc_)=(pos_subpath (tj_.prv,tj_.loc) of pj_) intersectiontimes e_; + save tt_; + (tt_,td_)=(pos_subpath (tj_.loc,tj_.nxt) of pj_) intersectiontimes e_; +% BUG TRAP 2: + if (ta_<0) or (tb_<0) or (tc_<0) or (td_<0): + err_helpless; errmessage "RO ERROR: Cannot check tangency"; + fi + forsuffixes tt_:=tb_,tc_,td_: tt_:=(tt_-ta_) mod enc.len; endfor + ((tc_>=tb_) and (td_>=tb_)) or ((tc_<=tb_) and (td_<=tb_)) + fi +enddef; +% --- +vardef multi_path_case = PATH_.num>1 enddef; +def prepare_input_data(text P)(text W) = +% |P|: list of paths to be processed (non-cyclic paths are ignored); +% |W|: list of weights given as pairs: (index, value) + PATH_.num:=0; + for P_:=P: if cycle P_: PATH_[incr PATH_.num]:=touch_path(P_); fi endfor + for W_:=W: PATH_.wei[xpart W_]:=ypart W_; endfor + for i_:=1 upto PATH_.num: + if unknown PATH_.wei[i_]: PATH_.wei[i_]:=1; fi + endfor +enddef; +% --- +def initialise_removing_overlaps = +% Given paths are |PATH_1|, |PATH_2|, ..., |PATH_[P.num]|; +% if |PATH_[i][j]| is known, paths |PATH_[i]| and |PATH_[j]| at least touch +% each other; |PATH_.wei[i]| is a weight of a path (corresponds to +% multiplying a turning number by this value or, in other words, to +% applying |PATH_.wei[i]| times a fill operation to the path |PATH_[i]|). +numeric PATH_.num, PATH_[\\][\\], PATH_.wei[\\]; path PATH_[\\]; +% +% Lone paths are stored in variable |LONE_|; |LONE_.col[i]| determines +% the color (being an integer number) of the plane surrounding the path +% |LONE_[i]|; |LONE_.wei| is a weight inherited from |PATH_.wei| (see above). +numeric LONE_.num, LONE_.col[\\], LONE_.wei[\\]; path LONE_[\\]; +% +% |TIME_[i]num| is the number of intersection points for paths |PATH_[i]|, +% |TIME_[i]tim[j]| is the time of intersection of the |j|-th point of path +% |PATH_[i]| (points are sorted with respect to time), |TIME_[i]ntp[j]| +% marks non-tangent points (if known), |TIME_[i]nod[j]| is the node number +% of |j|-th point of path |PATH_[i]| (only non-tangent points are considered +% to be nodes, points on a path are numbered from |0|). +numeric TIME_[\\]num, TIME_[\\]tim[\\], TIME_[\\]ntp[\\], TIME_[\\]nod[\\]; +% +% Variables with prefix |EDGE_| describe the edge structure that results from +% intersecting process; the data structure is similar to Dijkstra's data +% structure for the algorithm finding the convex hull of for a given +% set of points (E. W. Dijkstra, ``A Discipline of programming'', +% Prentice-Hall, Inc., 1976): the edges (edsges?) are numbered +% |-EDGE_.num|, |-EDGE_.num+1|, ..., |-1|, |1|, ... |EDGE_.num-1|, +% |EDGE_.num|; edges |i| and |-i| are in fact the same edge but +% differently oriented, the positive value denotes the edge which +% direction is consistent with the direction of the original path; +% |EDGE_.out[i]| is the number of the leftmost edge outcoming from +% the last node, i.e., |EDGE_.lnd[i]|; the number of the first node +% of |i|-th edge is |EDGE_.fnd[i]|; color of |i|-th edge, i.e., the color +% of the area surrounded by the edge and its leftmost successors is stored +% in |EDGE_.col[i]|; |i|-th edge belongs to the path of |PATH_[EDGE_.pth[i]]|; +% |EDGE_.aux[\\]| is an auxiliary variable; all intersecting paths +% can be grouped into |SPOT_.num| of disjoint ``spots''; for |i=1|, |2|, ..., +% |SPOT_.num|, |EDGE_.bed[i]| is the number of the edge which leftmost +% successors form the area being a boundary of the intersecting paths +% for a given spot and |EDGE_.bpa[i]| is the boundary (since there is +% one-to-one correspondence between boundaries and spots, boundaries are +% pairwise disjoint, too). +numeric EDGE_.num, EDGE_.pth[\\], EDGE_.out[\\], EDGE_.aux[\\], EDGE_.col[\\], + EDGE_.fnd[\\], EDGE_.lnd[\\], EDGE_.are[\\], EDGE_.bed[\\]; +path EDGE_.bpa[\\]; +% +% Variables with prefix |NODE_| describe the node structure and are related +% to the edge structure; the node is not a point on a plane but a point on a +% path, hence several nodes may correspond to one Euclidian point; +% |NODE_.num| is the number of nodes, |NODE_.pth[i]| is the number of a path +% to which the node |i| belongs, |NODE_.tim[i]| is the corresponding time on +% path |PATH_[NODE_.pth[i]]|, |NODE_.ped[i]| is the ordering number of a +% positively-numbered edge leaving the node |i|, |NODE_.ned[i]| is the +% ordering number of negatitively-numbered edge leaving node |i|, +% |NODE_.nod[i]num| is the number of nodes coinciding with node |i| and +% these are nodes |NODE_.nod[i]1|, |NODE_.nod[i]2|, ..., +% |NODE_.nod[i][NODE_.nod[i]num]|. +numeric NODE_.num, NODE_.pth[\\], NODE_.tim[\\], NODE_.ned[\\], + NODE_.ped[\\], NODE_.nod[\\]num, NODE_.nod[\\][\\]; +% +% It often happens that intersecting paths form disjoint areas or that +% there are paths that do not intersect; it is crucial for the colouring +% algorithm to know the embedding ``hierarchy''; the hierarchy is stored in +% a tree structure: the links (suffix |emb|) point upward (from leaves to +% the root), moreover, with each leaf (node) is associated a ``level,'' +% i.e., the number of leaves beneath this leaf; the information stored in +% a leaf is either the number of a lone path or the number of an area being +% the result of the intersecting process (negative value marks the former +% case); the tree is built by adding at first lone paths and next boundary +% paths, i.e., negatively oriented paths surrounding groups of paths (areas, +% see below) resulting from the intersecting process; if there is a lone path +% or a boundary path |q| embedded in a boundary path |p|, there must be also +% an area which belongs to the group of areas surrounded by |p|, which apears +% in the tree between |q| and |p|; such a structure is convenient at the +% stage of finding colors of areas and lone paths. +numeric TREE_.num,TREE_.pth[\\],TREE_.emb[\\],TREE_.lev[\\]; +% +% Finally there are areas which arise during intersecting process; +% |AREA_1|, |AREA_2|, ..., |AREA_[AREA_.num]| are the ordering numbers +% of edges which leftmost successors form areas such that areas arising +% from |AREA_[i]| and |AREA_[j]| are either disjoint or have at most a common +% edge, and, moreover, areas arising from |AREA_1|, |AREA_2|, ..., +% |AREA_[AREA_.num]| exhaust the list of all possible areas in question +% (plus lone paths, i.e., with no intersecting points); |AREA_.spt[i]| is +% a spot number (areas of the same spot number are subsets of the same +% boundary, different boundaries are disjoint); areas are sorted wrt spot +% numbers, moreover, |AREA_[SPOT_[s-1]+1]| thru |AREA_[SPOT_[s]]| are areas +% belonging to a spot |s|, |s=1|, |2|, ..., |SPOT_.num|. +numeric AREA_.num, AREA_[\\], AREA_.spt[\\]; numeric SPOT_.num, SPOT_[\\]; +enddef; +% --- +vardef is_far_enough(expr i,k,dk) = + if act_idx_>=max_idx: were_more_:=1; false + else: + save z_; pair z_; z_:=point k+dk of PATH_[i]; + true + for j_:=0 upto TIME_[i]num: + and + if multi_path_case: + (distance(point TIME_[i]tim[j_] of PATH_[i],z_)>=epsil.dist) + else: + (interval(TIME_[i]tim[j_],(k+dk),PATH_[i])>=epsil.time) + fi + endfor + for j_:=0 upto ignored_.num: + and + if multi_path_case: + (distance(point ignored_[j_] of PATH_[i],z_)>=epsil.dist) + else: + (interval(ignored_[j_],(k+dk),PATH_[i])>=epsil.time) + fi + endfor + fi +enddef; +% --- +def intersect_two_segments(expr i,j,k,l) = +begingroup + save pi_,pj_,stack_; path pi_,pj_,stack_[\\]; numeric stack_.lev; + pi_:=subpath (k,k+1) of PATH_[i]; pj_:=subpath (l,l+1) of PATH_[j]; + stack_.lev:=1; stack_[stack_.lev]:=pj_; + forever: + exitif stack_.lev<=0; + pj_:=stack_[stack_.lev]; stack_.lev:=stack_.lev-1; + save dk_,dl_; (dk_,dl_)=pi_ intersectiontimes pj_; + if dk_>=0: + if is_far_enough(i,k,dk_): + act_idx_:=act_idx_+1; TIME_[i].tim[incr TIME_[i].num]:=k+dk_; + else: ignored_[incr ignored_.num]:=k+dk_; + fi + if (dl_+epsil.time)<length(pj_): + stack_[incr stack_.lev]:=subpath (dl_+epsil.time,length pj_) of pj_; + fi + if (dl_-epsil.time)>0: + stack_[incr stack_.lev]:=subpath (0,dl_-epsil.time) of pj_; + fi + fi + endfor +endgroup +enddef; +% --- +def intersect_two_paths(expr i,j) = +begingroup + save ignored_,were_more_,act_idx_; + act_idx_:=0; ignored_.num:=-1; + for k_:=0 upto length(PATH_[i])-1: + for l_:=0 upto length(PATH_[j])-1: + if (i<>j) or (k_<>l_): + intersect_two_segments(i,j,k_,l_); + fi + endfor + endfor + if known were_more_: + errhelp "Dangerous situation: rounding errors may screw up results."; + errmessage "RO ERROR: there were more than " + & decimal(max_idx) & " intersections (thus some were ignored)"; + fi + quicksort TIME_[i](0,TIME_[i].num)(tim)(); +endgroup +enddef; +% --- +def intersect_all_paths = + for i_:=1 upto PATH_.num: TIME_[i_]num:=-1; endfor + for i_:=1 upto PATH_.num: + for j_:=i_+1 upto PATH_.num: + if xpart(PATH_[i_] intersectiontimes PATH_[j_])>-1: + PATH_[i_][j_]:=0; +% the process is repeated twice (for both paths in turn) because we haven't +% invented an efficient soultion to the following problem: +% given a subpath |S| of a path |P| and a time |t.S|; find a time |t.P| such +% that |point t.S of S=point t.P of P| + intersect_two_paths(i_,j_); intersect_two_paths(j_,i_); + fi + endfor + endfor + if not multi_path_case: + for i_:=1 upto PATH_.num: + PATH_[i_][i_]:=0; intersect_two_paths(i_,i_); + endfor + fi +enddef; +% --- +vardef find_minimal_secant = + save secants_, intervals_; + secants_.num:=0; intervals_.num:=0; + minimal_secant:=minimal_interval:=infinity; + for i_:=1 upto PATH_.num: + for j_:=0 upto TIME_[i_].num: + if TIME_[i_].num>0: + secants_[if tracingremoving>1: incr fi \\ secants_.num]:= + distance(point TIME_[i_]tim[j_] of PATH_[i_], + point TIME_[i_]tim[(j_+1) mod (TIME_[i_].num+1)] of PATH_[i_]); + if tracingremoving>1: + secants_.pth[secants_.num]:=i_; secants_.tim[secants_.num]:=j_; + fi + minimal_secant:=min(minimal_secant,secants_[secants_.num]); + intervals_[if tracingremoving>1: incr fi \\ intervals_.num]:= + interval(TIME_[i_]tim[j_], + TIME_[i_]tim[(j_+1) mod (TIME_[i_].num+1)], PATH_[i_]); + if tracingremoving>1: + intervals_.pth[intervals_.num]:=i_; intervals_.tim[intervals_.num]:=j_; + fi + minimal_interval:=min(minimal_interval,intervals_[intervals_.num]); + fi + endfor; + endfor; + if minimal_secant<>infinity: + info_ro "Minimal secant = " & decimal(minimal_secant/pt) + & "pt, i.e., " & decimal(minimal_secant) & "pxl, " & + if minimal_secant<4/3epsil.dist: "CAVEAT!" else: "seems OK" fi + & " (bound=" & decimal(epsil.dist) & "pxl)"; + fi + if minimal_interval<>infinity: + info_ro "Minimal interval = " & decimal(minimal_interval) & ", " & + if minimal_interval<4/3epsil.time: "CAVEAT!" else: "seems OK" fi + & " (bound=" & decimal(epsil.time) & ")"; + fi + if tracingremoving>1: + quicksort secants_(1,secants_.num)()(tim,pth); + quicksort intervals_(1,intervals_.num)()(tim,pth); + for i_:=1 upto secants_.num: + info_ro "secant=" & decimal(secants_[i_]) + & " path=" & decimal(secants_.pth[i_]) + & " time=" & decimal(secants_.tim[i_]); + endfor + for i_:=1 upto intervals_.num: + info_ro "interval=" & decimal(intervals_[i_]) + & " path=" & decimal(intervals_.pth[i_]) + & " time=" & decimal(intervals_.tim[i_]); + endfor + fi +enddef; +% --- +def build_node_structure = +begingroup + save n_,Tik_,Tjl_; + NODE_.num:=0; + for i_:=1 upto PATH_.num: + for j_:=i_ if multi_path_case: +1 fi upto PATH_.num: + if known PATH_[i_][j_]: + for k_:=0 upto TIME_[i_]num: + for l_:=if i_=j_: k_ else: 0 fi upto TIME_[j_]num: + if distance(point TIME_[i_]tim[k_] of PATH_[i_], + point TIME_[j_]tim[l_] of PATH_[j_])<epsil.dist: + if if multi_path_case: not is_tangent(i_,j_,k_,l_) else: true fi: + TIME_[i_]ntp[k_]:=1; TIME_[j_]ntp[l_]:=1; + if unknown TIME_[i_]nod[k_]: + NODE_.num:=NODE_.num+1; TIME_[i_]nod[k_]:=NODE_.num; + NODE_.pth[NODE_.num]:=i_; NODE_.tim[NODE_.num]:=k_; + NODE_.nod[NODE_.num]num:=0; + fi + if unknown TIME_[j_]nod[l_]: + NODE_.num:=NODE_.num+1; TIME_[j_]nod[l_]:=NODE_.num; + NODE_.pth[NODE_.num]:=j_; NODE_.tim[NODE_.num]:=l_; + NODE_.nod[NODE_.num]num:=0; + fi + Tik_:=TIME_[i_]nod[k_]; Tjl_:=TIME_[j_]nod[l_]; + NODE_.nod[Tik_][incr NODE_.nod[Tik_]num]:=Tjl_; + if (i_<>j_) or (k_<>l_): + NODE_.nod[Tjl_][incr NODE_.nod[Tjl_]num]:=Tik_; + fi + fi + fi + endfor + endfor + fi + endfor + endfor +% BUG TRAP: + for i_:=1 upto PATH_.num: + n_:=0; + for j_:=0 upto TIME_[i_]num: if known TIME_[i_]ntp[j_]: n_:=n_+1; fi endfor + if n_=1: + err_helpless; + errmessage "RO ERROR: Number of non-tangent points must not be 1 (path " + & decimal(i_) & ")"; + fi + endfor +endgroup +enddef; +% --- +def identify_close_nodes = +begingroup +% It is assumed that `close points' and `coinciding points' means the same, +% hence we make a transitive closure of the relation of `being close' +% (in ``normal'' cases the relation is transitive, although from +% a mathematical point of view it is obviously not): + forever: + % Is this loop really needed? I (BJ) could not devise a case where + % more than two turns would be necessary and where the algorithm + % would still work properly + save changed_; + for i_:=1 upto NODE_.num: + save v_; + for j_:=1 upto NODE_.nod[i_]num: v_[NODE_.nod[i_][j_]]:=0; endfor + for j_:=1 upto NODE_.nod[i_]num: + k_:=NODE_.nod[i_][j_]; + for l_:=1 upto NODE_.nod[k_]num: + if NODE_.nod[k_][l_]<>i_: + if unknown v_[NODE_.nod[k_][l_]]: + NODE_.nod[i_][incr NODE_.nod[i_]num]:=NODE_.nod[k_][l_]; + changed_:=v_[NODE_.nod[k_][l_]]:=0; + fi + fi + endfor + endfor + endfor + exitif unknown changed_; + endfor +endgroup +enddef; +% --- +def build_edge_structure = +begingroup + numeric min_sec_[\\],min_sec_.tmp; +% |min_sec_[i]| is a minimal secant for |i|-th path, |i=1|, |2|, ..., |PATH_.num| + save i_,j_,k_; + EDGE_.num:=0; + if NODE_.num>0: + for i_:=1 upto PATH_.num: + for j_:=0 upto TIME_[i_]num: + if known TIME_[i_]ntp[j_]: + EDGE_.num:=EDGE_.num+1; EDGE_.pth[EDGE_.num]=i_; + EDGE_.pth[-EDGE_.num]=i_; EDGE_.fnd[EDGE_.num]:=TIME_[i_]nod[j_]; +% each path should contain at least two non-tangent nodes + k_:=j_+1; + forever: exitif known TIME_[i_]ntp[k_ mod (TIME_[i_]num+1)]; + k_:=k_+1; + endfor; + EDGE_.lnd[EDGE_.num]:=TIME_[i_]nod[k_ mod (TIME_[i_]num+1)]; + min_sec_.tmp:= + distance(point first_time(EDGE_.num) of edge_path(EDGE_.num), + point last_time(EDGE_.num) of edge_path(EDGE_.num)); + if if unknown min_sec_[i_]: true else: min_sec_[i_]>min_sec_.tmp fi: + min_sec_[i_]:=min_sec_.tmp; + fi + EDGE_.fnd[-EDGE_.num]:=EDGE_.lnd[EDGE_.num]; + EDGE_.lnd[-EDGE_.num]:=EDGE_.fnd[EDGE_.num]; + fi + endfor + endfor + for i_:=-EDGE_.num upto EDGE_.num: + if i_>0: NODE_.ped[EDGE_.fnd[i_]]:=i_; + elseif i_<0: NODE_.ned[EDGE_.fnd[i_]]:=i_; + fi + endfor + else: + info_ro "RO WARNING: no intersections detected."; + fi +endgroup +enddef; +% --- +def find_leftmost_edges = +% a simple method is used: a tiny circle is drawn in a node and its +% intersection points with all edges leaving the node are examined +begingroup + save ei_,ej_,i_,j_,k_,leftmost_; path ei_,ej_; numeric min_sec_.loc; + for i_:=-EDGE_.num upto EDGE_.num: if i_<>0: + if tracingleftmost>0: + message "@@@ " & decimal(i_) & "/" & decimal(EDGE_.pth[i_]) + & " (" & decimal(EDGE_.fnd[i_]) & "," & decimal(EDGE_.lnd[i_]) & "):"; + fi + numeric leftmost_.edg,leftmost_.tim,leftmost_.tmp; + min_sec_.loc:=min_sec_[EDGE_.pth[i_]]; + for k_:=1 upto NODE_.nod[EDGE_.lnd[i_]]num: + forsuffixes $:=ped,ned: + j_:=NODE_$[NODE_.nod[EDGE_.lnd[i_]][k_]]; + min_sec_.loc:=min(min_sec_.loc,min_sec_[EDGE_.pth[j_]]); + endfor + endfor +% BUG TRAP 1: (should not happen, see |find_minimal_secant|); + if min_sec_.loc<epsil.dist: + err_extra_info(i_,whatever); showvariable min_sec_; err_helpless; + errmessage "RO ERROR: Cannot continue searching for the leftmost edge"; + fi + ei_:=enc.pth scaled (1/2[epsil.dist,min_sec_.loc]) + shifted point infinity of the_edge(i_); + save tei_,tt_; (tei_,tt_)=ei_ intersectiontimes the_edge(i_); + for k_:=1 upto NODE_.nod[EDGE_.lnd[i_]]num: + forsuffixes $:=ped,ned: + j_:=NODE_$[NODE_.nod[EDGE_.lnd[i_]][k_]]; + ej_:=enc.pth scaled (1/2[epsil.dist,min_sec_.loc]) + shifted point 0 of the_edge(j_); + if tracingleftmost>0: + message " " & decimal(j_) & "/" & decimal(EDGE_.pth[j_]) + & " (" & decimal(EDGE_.fnd[j_]) & "," & decimal(EDGE_.lnd[j_]) & "):"; + fi + save tej_,tt_; (tej_,tt_)=ej_ intersectiontimes the_edge(j_); +% BUG TRAP 2: + if (tei_<0) or (tej_<0): + err_extra_info(i_,j_); showvariable min_sec_; + message "Times: " & decimal(tei_) & " " & decimal(tej_); + err_helpless; + errmessage "RO ERROR: Unsuccesful search for the leftmost edge"; + fi +% it happens that |i_=j_| if |multi_path_case=false| + leftmost_.tmp:=if (i_=-j_): 0 else: (tej_-tei_) mod enc.len fi; + if tracingleftmost>0: + message " " & decimal(leftmost_.tmp) & " " & dec_pair((tei_,tej_)); + fi + if if unknown leftmost_.tim: true else: leftmost_.tmp>leftmost_.tim fi: + leftmost_.edg:=j_; leftmost_.tim:=leftmost_.tmp; + fi + endfor + endfor + EDGE_.out[i_]:=leftmost_.edg; + if tracingleftmost>0: j_:=EDGE_.out[i_]; + message ">>> " & decimal(j_) & "/" & decimal(EDGE_.pth[j_]) + & " (" & decimal(EDGE_.fnd[j_]) & "," & decimal(EDGE_.lnd[j_]) & "):"; + fi + fi endfor +endgroup +enddef; +% --- +def build_area_structure = +begingroup + save i_,j_,v_; + AREA_.num:=0; + for i_:=1 upto EDGE_.num: % \MF's linear equation solver employed + EDGE_.col[i_]-PATH_.wei[EDGE_.pth[i_]]=EDGE_.col[-i_]; + endfor +% split to areas (edges surrounding the same area are assigned the same colour): + for i_:=-EDGE_.num upto EDGE_.num: + if (i_<>0) and (unknown EDGE_.are[i_]): + AREA_[incr AREA_.num]:=i_; + save v_; j_:=i_; v_[j_]:=0; EDGE_.are[j_]:=AREA_.num; + forever: j_:=EDGE_.out[j_]; exitif (j_=i_) or (known v_.emerg); +% BUG TRAP 1: + if j_=-i_: + err_extra_info(i_,whatever); show_area(i_); err_helpless; + errmessage "RO ERROR: strange area"; + fi +% BUG TRAP 2: + if known v_[j_]: + err_extra_info(i_,j_); show_area(i_); err_helpless; + errmessage "RO ERROR: Edge " & decimal(j_) & " revisited"; + v_.emerg:=0; + fi + v_[j_]:=0; EDGE_.are[j_]:=AREA_.num; + if known (EDGE_.col[i_]-EDGE_.col[j_]): +% BUG TRAP 3: + if (EDGE_.col[i_]-EDGE_.col[j_])<>0: + err_extra_info(i_,j_); show_area(i_); err_helpless; + errmessage "RO ERROR: Edges " & decimal(i_) & " and " & decimal(j_) + & " have inconsistent colors"; + fi + else: EDGE_.col[i_]=EDGE_.col[j_]; fi + endfor + fi + endfor +endgroup +enddef; +% --- +def build_spot_structure = +begingroup + save i_,j_; +% areas having a common edge belong to the same spot (\MF's linear +% equation solver employed): + for i_:=1 upto EDGE_.num: if (i_<>0): + if unknown (AREA_.spt[EDGE_.are[i_]]-AREA_.spt[EDGE_.are[-i_]]): + AREA_.spt[EDGE_.are[i_]]=AREA_.spt[EDGE_.are[-i_]]; + fi + fi endfor +% count different spots: + SPOT_.num:=0; + for i_:=1 upto AREA_.num: + if unknown AREA_.spt[i_]: AREA_.spt[i_]=incr SPOT_.num; fi + endfor; +% sort areas wrt spot numbers: + quicksort AREA_(1,AREA_.num)(spt)(); +% define |SPOT_[s]|, |s=1|, |2|, ..., |SPOT_.num|, such that +% |AREA_[SPOT_[s-1]+1]| thru |AREA_[SPOT_[s]]| are areas having the +% same spot number |s|: + SPOT_0=0; for i_:=1 upto AREA_.num: SPOT_[AREA_.spt[i_]]:=i_; endfor +% identify paths for which |check_turn=-1| (such areas are boundaries and +% should be unique for each spot): + i_:=0; + for j_:=1 upto AREA_.num: + if check_turn(make_area(AREA_[j_]))<=0: + i_:=i_+1; + EDGE_.bar[i_]:=j_; EDGE_.bed[i_]:=AREA_[j_]; + EDGE_.bpa[i_]:=make_area(AREA_[j_]); + fi + endfor +% BUG TRAP 4: + if i_<>SPOT_.num: + message "Number of spots=" & decimal(SPOT_.num) & + ", number of boundaries=" & decimal(i_); + err_helpless; + errmessage "RO ERROR: Inconsistent number of spots and boundaries"; + fi +endgroup +enddef; +% --- +def update_tree_levels(expr n) = +% update levels above the inserted leaf (|n|): +begingroup + save i_,j_; + i_:=TREE_.emb[n]; j_:=TREE_.lev[n]; + forever: + exitif i_=0; + j_:=TREE_.lev[i_]:=max(j_+1,TREE_.lev[i_]); i_:=TREE_.emb[i_]; + endfor +endgroup +enddef; +% --- +vardef embedding_pair(expr p,n) = +% returns a pair of numbers, |(out_,in_)|, such that |out_| is either a tree +% address of an area surrounded |p| or zero if not found, and |in_| is a +% tree address of an area surrounding |p| or zero if not found; one branch +% is searched, starting from a zero level leaf, |n|. + save in_,out_,q_; path q_; in_:=out_:=0; n_:=n; + forever: + q_:=if TREE_.pth[n_]<0: LONE_[-TREE_.pth[n_]] + else: make_area(AREA_[TREE_.pth[n_]]) fi; + check_embedding(p_,q_,r_); + if r_=1: % |p_| $\subset$ |q_| + if in_=0: in_:=n_; fi % ``minimal'' surrounding path is to be found + elseif r_=2: % |q_| $\subset$ |p_| + out_:=n_; % ``maximal'' surrounded path is to be found + fi + exitif TREE_.emb[n_]=0; + n_:=TREE_.emb[n_]; + endfor + (out_,in_) +enddef; +% --- +def add_to_queue (expr p,q) = +% updates a queue, i.e., adds to a queue an area belonging to the spot +% of a boundary area, i.e., |AREA_[q]|, surrounding a path described by +% a tree address |p|. +begingroup + save p_,r_,s_,found_; path p_; boolean found_; +% |AREA_[q]| is a boundary, i.e., it is negatively oriented, + p_:=if TREE_.pth[p]<0: LONE_[-TREE_.pth[p]] + else: make_area(AREA_[TREE_.pth[p]]) fi; +% there must be a unique positively oriented area containing |p_|, belonging +% to the ``spot'' of the boundary |AREA_[q]|. + found_:=false; s_:=SPOT_[AREA_.spt[q]-1]; +% |s_| is the last area from a previous spot, |s_+1| will be the first +% area of the current spot + forever: s_:=s_+1; + if s_<>q: + check_embedding(make_area(AREA_[s_]),p_,r_); + found_:=(r_=2); % |r_=2| implies |p_| $\subset$ |make_area(AREA_[s_])| + fi + if found_: + if unknown LVQ_.inq[s_]: LVQ_[incr LVQ_.num]:=s_; LVQ_.inq[s_]:=1; fi + elseif s_=SPOT_[AREA_.spt[q]]: +% the list of candidates has been exhausted without a success, hence +% BUG TRAP: + err_helpless; + errmessage "RO ERROR: cannot build embedding tree (boundary " & + decimal(q) & ")"; + found_:=true; + fi + exitif found_; + endfor; +endgroup +enddef; +% --- +def add_to_tree (expr leaf) = +begingroup + save boundary_,found_,N_,p_; path p_; + TREE_.num:=TREE_.num+1; + N_:=TREE_.num; % abbreviation + TREE_.pth[N_]:=leaf; TREE_.emb[N_]:=0; TREE_.lev[N_]:=0; + p_:=if leaf<0: LONE_[-leaf] else: make_area(AREA_[leaf]) fi; + if (leaf>0) and (check_turn(p_)<0): boundary_:=1; fi + if N_>1: + for l_:=1 upto LVZ_.num: % climbing up from level zero + save out_,in_; (out_,in_)=embedding_pair(p_,LVZ_[l_]); + if (out_<>0) or (in_<>0): % a feasible branch found + if (out_=0) and (in_<>0): % to be added at the bottom, certain + TREE_.emb[N_]:=in_; + if in_=LVZ_[l_]: LVZ_[l_]:=N_; % replace bottom leaf + else: LVZ_[incr LVZ_.num]:=N_; fi % add new bottom leaf + elseif (out_<>0) and (in_=0): % to be added at the top, optional + if TREE_.emb[out_]<>N_: % we weren't here, add +% invariant: |TREE_.emb[out_]=0| + TREE_.emb[out_]:=N_; + TREE_.lev[N_]:=max(TREE_.lev[N_],TREE_.lev[out_]+1); + if known boundary_: add_to_queue(out_,leaf); fi + fi + else: % to be added in the midst, optional + if TREE_.emb[out_]<>N_: % we weren't here, add +% invariant: |TREE_.emb[out_]=in_| + TREE_.emb[out_]:=N_; TREE_.emb[N_]:=in_; + TREE_.lev[N_]:=max(TREE_.lev[N_],TREE_.lev[out_]+1); + if known boundary_: add_to_queue(out_,leaf); fi + fi + fi + found_:=1; update_tree_levels(N_); + fi + endfor; + fi + if unknown found_: LVZ_[incr LVZ_.num]:=N_; fi % a ``separate'' leaf appeared +endgroup +enddef; +% --- +def build_embedding_tree = +begingroup + save LVZ_,QUE_; +% |LVZ_1|, |LVZ_2|, ..., |LVZ_[LVZ_.num]| is the list of zero-level leaves, +% (a temporary data structure, used during building a tree), |LVQ_1|, |LVQ_2|, +% ..., |LVQ_[LVQ_.num]| is the list of leaves waiting in a queue (also +% a temporary data structure); if |LVQ_.inq[i]| is known, |i=1|, |2|, ..., +% |AREA_.num|, area |i| is already in a queue. + TREE_.num:=0; LONE_.num:=0; LVZ_.num:=0; LVQ_.num:=0; +% identify lone paths: + for i_:=1 upto PATH_.num: + if true for j_:=0 upto TIME_[i_]num: and (unknown TIME_[i_]ntp[j_]) endfor: + LONE_[incr LONE_.num]:=PATH_[i_]; LONE_.wei[LONE_.num]:=PATH_.wei[i_]; + fi + endfor +% build the tree: + for i_:=1 upto LONE_.num: add_to_tree(-i_); endfor + for i_:=1 upto SPOT_.num: add_to_tree(EDGE_.bar[i_]); endfor + for i_:=1 upto LVQ_.num: add_to_tree(LVQ_[i_]); endfor +endgroup +enddef; +% --- +def color_paths = % \MF's linear equation solver heavily exploited +begingroup + save i_,j_; + for i_:=1 upto TREE_.num: + if TREE_.emb[i_]=0: % outer path + if TREE_.pth[i_]<0: LONE_.col[-TREE_.pth[i_]]=background_color; + else: EDGE_.col[AREA_[TREE_.pth[i_]]]=background_color; fi + else: % inner path, inherits color from the surrounding path + j_:=TREE_.emb[i_]; + if TREE_.pth[i_]<0: + if TREE_.pth[j_]<0: + LONE_.col[-TREE_.pth[i_]]=LONE_.col[-TREE_.pth[j_]] + +LONE_.wei[-TREE_.pth[j_]]*check_turn(LONE_[-TREE_.pth[j_]]); + else: + LONE_.col[-TREE_.pth[i_]]=EDGE_.col[AREA_[TREE_.pth[j_]]]; + fi + else: + if TREE_.pth[j_]<0: + EDGE_.col[AREA_[TREE_.pth[i_]]]=LONE_.col[-TREE_.pth[j_]] + +LONE_.wei[-TREE_.pth[j_]]*check_turn(LONE_[-TREE_.pth[j_]]); + else: + if AREA_.spt[TREE_.pth[i_]]<>AREA_.spt[TREE_.pth[j_]]: + EDGE_.col[AREA_[TREE_.pth[i_]]]=EDGE_.col[AREA_[TREE_.pth[j_]]]; + fi + fi + fi + fi + endfor; +endgroup +enddef; +% --- +def recombine_edges(suffix R) = +% this routine can be used several times (after completing the process +% of finding the structure of paths after intersecting) with various +% definitions of |good_color| function in order to select various +% sets of areas + if not path R0: numeric R.num; path R[\\]; fi + if (unknown R.num) or (unknown append_results): R.num:=0; fi +% |R|: resulting data structure, namely, |R.num| is the number of output +% paths, |R1|, |R2|, ..., |R[R.num]| are the resulting paths +begingroup + save i_,j_,out_,in_; + for i_:=1 upto LONE_.num: + out_:=LONE_.col[i_]; in_:=out_+LONE_.wei[i_]*check_turn(LONE_[i_]); + if good_colors(in_,out_) or good_colors(out_,in_): + R[incr R.num]:=LONE_[i_]; + R[R.num]:=if good_colors(in_,out_): pos_turn else: neg_turn fi \\ R[R.num]; + fi + endfor + for i_:=-EDGE_.num upto EDGE_.num: if i_<>0: + EDGE_.aux[i_]:=whatever; + fi endfor + for i_:=-EDGE_.num upto EDGE_.num: if i_<>0: +% BUG TRAP 1: + if unknown EDGE_.col[i_]: + err_extra_info(i_,whatever); err_helpless; + errmessage "RO ERROR: Edge " & decimal(j_) & " not colored"; + fi + if good_colors(EDGE_.col[i_],EDGE_.col[-i_]) and (unknown EDGE_.aux[i_]): + save v_; + R.num:=R.num+1; j_:=i_; v_[j_]:=0; + EDGE_.aux[j_]:=0; R[R.num]:=the_edge(j_); + forever: j_:=EDGE_.out[j_]; exitif (j_=i_) or (known v_.emerg); +% BUG TRAP 2: + if known v_[j_]: + err_extra_info(i_,j_); err_helpless; + errmessage "RO ERROR: Edge " & decimal(j_) & " revisited"; + v_.emerg:=0; + fi + v_[j_]:=0; + if good_colors(EDGE_.col[j_],EDGE_.col[-j_]): + EDGE_.aux[j_]:=0; R[R.num]:=R[R.num] && the_edge(j_); + else: j_:=-j_; + fi + endfor + R[R.num]:=clean_path(clean_path(make_cycle(R[R.num]))); + fi + fi endfor +endgroup +enddef; +% --- +def remove_overlap (text P)(text W) suffix R = +begingroup interim autorounding:=0; +% |P|: list of paths to be processed (non-cyclic paths are ignored); +% |W|: list of weights given as pairs: (index, value) +% |R|: resulting data structure, i.e., |R.num| is the number of output paths, +% |R1|, |R2|, ..., |R[R.num]| are the resulting paths + info_ro "initialise_removing_overlaps"; initialise_removing_overlaps; + info_ro "prepare_input_data"; prepare_input_data(P)(W); + info_ro "intersect_all_paths"; intersect_all_paths; + info_ro "find_minimal_secant"; find_minimal_secant; + info_ro "build_node_structure"; build_node_structure; + info_ro "identify_close_nodes"; identify_close_nodes; + info_ro "build_edge_structure"; build_edge_structure; + info_ro "find_leftmost_edges"; find_leftmost_edges; + info_ro "build_area_structure"; build_area_structure; + info_ro "build_spot_structure"; build_spot_structure; + info_ro "build_embedding_tree"; build_embedding_tree; + info_ro "color_paths"; color_paths; + info_ro "recombine_edges"; recombine_edges(R); +endgroup +enddef; +% --- +% E-S MACROS: +% --- +vardef make_join@#(expr pa,pb)= + save kind_; string kind_; kind_:=str @#; if kind_="": kind_:="0" fi; + if (kind_<>"0") and (kind_<>"1"): + errhelp "Will use default."; + errmessage "ES ERROR: don't know how to join"; + kind_:="0"; + fi + if distance(point length(pa) of pa,point 0 of pb)<epsil.dist: + if (point length(pa) of pa)<>(point 0 of pb): + info_es "Points " & dec_pair(point length(pa) of pa) & + " and " & dec_pair(point 0 of pb) & " joined"; + if (tracingexpanding>0) and (proofing>0): + makelabel.lft.nodot("joined",point length(pa) of pa); + fi + fi + pa && pb + elseif kind_="0": + if miter_size<=0: % a special case, isn't it? + pa--pb + else: + save ta_,tb_,za_,da_,zb_,db_,zc_,zd_,ze_,zf_; + pair za_,da_,zb_,db_,zc_,zd_,ze_,zf_; + za_=point length(pa) of pa; + da_=direction length(pa) of pa; + zb_=point 0 of pb; + db_=direction 0 of pb; + zc_=whatever[za_,za_+da_]=whatever[ze_,ze_+(zb_-za_)]; + zd_=whatever[zb_,zb_+db_]=whatever[ze_,ze_+(zb_-za_)]; + ze_=.5[za_,zb_]+miter_size*(unitvector(da_-db_)); +% we used to check |turningnumber(za_--zc_--zd_--zb_--cycle)|, but it was +% not sufficiently robust + (ta_,tb_)=(za_--zc_) intersectiontimes (zd_--zb_); + if ta_<0: % |miter_size| in force: + pa + if distance(point length(pa) of pa,zc_)>=epsil.dist: --zc_ fi + if (distance(zc_,zd_)>=epsil.dist) + and (distance(point 0 of pb,zd_)>=epsil.dist): --zd_ fi + --pb + else: + zf_:=point ta_ of (za_--zc_); + if abs(zf_-.5[za_,zb_])>abs(ze_-.5[za_,zb_]): % |miter_size| in force: + pa + if distance(point length(pa) of pa,zc_)>=epsil.dist: --zc_ fi + if (distance(zc_,zd_)>=epsil.dist) + and (distance(point 0 of pb,zd_)>=epsil.dist): --zd_ fi + --pb + else: + pa + if (distance(point length(pa) of pa,zf_)>=epsil.dist) + and (distance(point 0 of pb,zf_)>=epsil.dist): --zf_ fi + --pb + fi + fi + fi + elseif kind_="1": + pa{direction length(pa) of pa}..{direction 0 of pb}pb + fi +enddef; +% --- +vardef make_cyclic_join@#(expr p)= + save kind_; string kind_; kind_:=str @#; if kind_="": kind_:="0" fi; + if (kind_<>"0") and (kind_<>"1"): + errhelp "Will use default."; + errmessage "ES ERROR: don't know how to join"; + kind_:="0"; + fi + if distance(point length(p) of p,point 0 of p)<epsil.dist: + if (point length(p) of p)<>(point 0 of p): + info_es "Points " & dec_pair(point length(p) of p) & + " and " & dec_pair(point 0 of p) & " joined (cycle)"; + if (tracingexpanding>0) and (proofing>0): + makelabel.lft.nodot("joined (cycle)",point length(p) of p); + fi + fi + make_cycle(p) + elseif kind_="0": + if miter_size<=0: % a special case, isn't it? + p--cycle + else: + save ta_,tb_,za_,da_,zb_,db_,zc_,zd_,ze_,zf_; pair za_,da_,zb_,db_,zc_,zd_,ze_,zf_; + za_=point length(p) of p; da_=direction length(p) of p; + zb_=point 0 of p; db_=direction 0 of p; + zc_=whatever[za_,za_+da_]=whatever[ze_,ze_+(zb_-za_)]; + zd_=whatever[zb_,zb_+db_]=whatever[ze_,ze_+(zb_-za_)]; + ze_=.5[za_,zb_]+miter_size*(unitvector(da_-db_)); +% we used to check |turningnumber(za_--zc_--zd_--zb_--cycle)|, but it was +% not sufficiently robust + (ta_,tb_)=(za_--zc_) intersectiontimes (zd_--zb_); + if ta_<0: % |miter_size| in force: + p + if distance(point length(p) of p,zc_)>=epsil.dist: --zc_ fi + if (distance(zc_,zd_)>=epsil.dist) + and (length((point 0 of p)-zd_)>=epsil.dist): --zd_ fi + --cycle + else: + zf_:=point ta_ of (za_--zc_); + if abs(zf_-.5[za_,zb_])>abs(ze_-.5[za_,zb_]): % |miter_size| in force: + p + if distance(point length(p) of p,zc_)>=epsil.dist: --zc_ fi + if (distance(zc_,zd_)>=epsil.dist) + and (distance(point 0 of p,zd_)>=epsil.dist): --zd_ fi + --cycle + else: + p + if (distance(point length(p) of p,zf_)>=epsil.dist) + and (distance(point 0 of p,zf_)>=epsil.dist): --zf_ fi + --cycle + fi + fi + fi + elseif kind_="1": + p{direction length(p) of p}..{direction 0 of p}cycle + fi +enddef; +% --- +vardef make_end@#(expr pr,pl) = + save kind_; string kind_; kind_:=str @#; if kind_="": kind_:="0" fi; + if (kind_<>"0") and (kind_<>"1"): + errhelp "Will use default."; + errmessage "ES ERROR: don't know how to end"; + kind_:="0"; + fi + if kind_="0": pr--pl--cycle + elseif kind_="1": + save za_,zb_; pair za_,zb_; + za_=1/2[point length(pr) of pr,point 0 of pl] + +(1/2((point length(pr) of pr)-(point 0 of pl)) rotated 90); + zb_=1/2[point length(pl) of pl,point length 0 of pr] + +(1/2((point length(pl) of pl)-(point 0 of pr)) rotated 90); + pr{direction length(pr) of pr}..za_..{direction 0 of pl}pl + {direction length(pl) of pl}..zb_..{direction 0 of pr}cycle + fi +enddef; +% --- +vardef opt_tensions(expr p,b) = +% for a given B\'ezier segment |p| and a distance |b|, an optimal pair of +% `tensions' $(\alpha,\beta)$ is found using least square method such that +% |bez_edge|$(p,b,\alpha,\beta)$ (see below) approximates the edge of +% a circular pen of diameter |b| traversing |p| (more on the employed +% method be found in the article of B. Jackowski and M. Ry\'cko: +% ``Labyrinth of \MF paths in outline,'' proceedings of the 8th European +% \TeX Conference, Sept. 26--30, 1994, Gda\'nsk, Poland) +% + save alpha_,beta_,gx_,gy_,n_,t_,ta_,tb_,tc_,td_,u_,v_,nu_,nv_,x_,y_; + numeric alpha_,beta_,n_,ta_,tb_,tc_,td_, + gx_[\\],gy_[\\],gx_.alpha[\\],gy_.alpha[\\],gx_.beta[\\],gy_.beta[\\], + u_.x,u_.y,v_.x,v_.y,nu_.x,nu_.y,nv_.x,nv_.y, + x_[\\],y_[\\]; + n_:=5; % perhaps for |n_|$=\infty$ algebraic formulas can be derived, but... + (u_.x,u_.y)=(postcontrol 0 of p)-(point 0 of p); + (v_.x,v_.y)=(precontrol 1 of p)-(point 1 of p); + (nu_.x,nu_.y)=unitvector(u_.x,u_.y); (nv_.x,nv_.y)=unitvector(v_.x,v_.y); + for t_:=0 upto n_: + (x_[t_],y_[t_])=(point t_/n_ of p)+b*((udir t_/n_ of p) rotated -90); + endfor + for t_:=1 upto n_-1: + td_:=t_/n_; ta_:=1-td_; tb_:=3ta_*ta_*td_; tc_:=3ta_*td_*td_; + ta_:=ta_*ta_*ta_; td_:=td_*td_*td_; + gx_[t_]=ta_*x_0+tb_*(x_0+alpha_*u_.x)+tc_*(x_[n_]+beta_*v_.x)+td_*x_[n_]; + gx_.alpha[t_]=tb_*nu_.x; gx_.beta[t_]=tc_*nv_.x; + gy_[t_]=ta_*y_0+tb_*(y_0+alpha_*u_.y)+tc_*(y_[n_]+beta_*v_.y)+td_*y_[n_]; + gy_.alpha[t_]=tb_*nu_.y; gy_.beta[t_]=tc_*nv_.y; + endfor + 0=0 for t_:=1 upto n_-1: + +((gx_[t_]-x_[t_])*gx_.alpha[t_]+(gy_[t_]-y_[t_])*gy_.alpha[t_])/n_ + endfor; + 0=0 for t_:=1 upto n_-1: + +((gx_[t_]-x_[t_])*gx_.beta[t_]+(gy_[t_]-y_[t_])*gy_.beta[t_])/n_ + endfor; +%| (u_.x,u_.y)=(postcontrol 0 of p)-(point 0 of p);| +%| (v_.x,v_.y)=(precontrol 1 of p)-(point 1 of p);| +%| ta_:=1/4length((u_.x,u_.y))+1/4length((v_.x,v_.y))| +%| +1/4length((postcontrol 0 of p)-(precontrol 1 of p))| +%| +1/4length((point 0 of p)-(point 1 of p));| +%| message "accuracy=" & decimal| +%| (0+for t_:=1 upto n_-1:+(((gx_[t_]-x_[t_])++(gy_[t_]-y_[t_]))/ta_)/n_| +%| endfor);| +%| message " alpha=" & decimal(alpha_) & " beta=" & decimal(beta_);| +%| for t_:=0 upto n_: fill fullcircle scaled 3 shifted (x_[t_],y_[t_]); endfor| +%| for t_:=1 upto n_-1: makelabel("g" & decimal(t_),(gx_[t_],gy_[t_])); endfor| + (alpha_,beta_) +enddef; +% --- +vardef bez_edge(expr p,b,uv) = + save za_,zb_,u_,v_; pair za_,zb_; u_:=xpart(uv); v_:=ypart(uv); + za_=b*((udir 0 of p) rotated -90); zb_=b*((udir 1 of p) rotated -90); + ((point 0 of p)+za_) .. controls (u_[point 0 of p,postcontrol 0 of p]+za_) + and (v_[point 1 of p,precontrol 1 of p]+zb_) .. ((point 1 of p)+zb_) +enddef; +% --- +def remove_global_loops(suffix E) = +begingroup +% warning: we don't trust too much in the results of ex. 14.17 from +% The \MF{}book, hence a ``par force'' approach; there still exist +% weird cases (e.g., local loops) which remain unsolved, but in practice +% the following algorithm should suffice: + save opt_,ta_,tb_; pair opt_; + opt_:=(0,length(E)); + for i_:=0 upto length(E)-1: + for j_:=i_+2 upto length(E)-1: + numeric ta_,tb_; + (ta_,tb_)=(subpath (i_,i_+1) of E) + intersectiontimes (subpath (j_,j_+1) of E); + if (ta_>0) and ((ta_+i_)>xpart(opt_)) and ((tb_+j_)<ypart(opt_)): + opt_:=(ta_+i_,tb_+j_); + fi + endfor + endfor + if xpart(opt_)>0: + E:=make_cycle(subpath(xpart(opt_),ypart(opt_)) of E); + fi +endgroup +enddef; +% --- +vardef make_edge@#(expr p,b)= + save E_,e_,ta_,tb_,tc_,td_; path E_,e_[\\]; + for i_:=0 upto length(p)-1: + E_:=subpath (i_,i_+1) of p; e_[i_]=bez_edge(E_,b,opt_tensions(E_,b)); + endfor + E_:=e_0; + for i_:=1 upto length(p)-1: + if (length(p)=2) and (cycle p): % this is a peculiar case, indeed! + numeric ta_,tb_,tc_,td_; + (ta_,tb_)=E_ intersectiontimes e_[i_]; + (1-tc_,1-td_)=reverse(E_) intersectiontimes reverse(e_[i_]); + if ta_>=0: + E_:=(subpath(min(ta_,tc_),max(ta_,tc_)) of E_) + && (subpath(min(tb_,td_),max(tb_,td_)) of e_[i_]); + else: E_:=make_join@#(E_,e_[i_]); + fi + else: + numeric ta_,tb_; + (ta_,tb_)=(subpath(length(E_)-1,length(E_)) of E_) + intersectiontimes e_[i_]; + if ta_>=0: + E_:=(subpath (0,length(E_)-1+ta_) of E_) + && (subpath(tb_,1) of e_[i_]); + else: E_:=make_join@#(E_,e_[i_]); fi + fi + endfor + if cycle p: + remove_global_loops(E_); + if not (cycle E_): E_:=make_cyclic_join@#(E_); fi + fi + E_ +enddef; +% --- +def expand_stroke(text P)(expr b) suffix R = +begingroup interim autorounding:=0; + numeric PATH_.num; path PATH_[\\]; + PATH_.num:=0; for P_:=P: PATH_[incr PATH_.num]:=touch_path(P_); endfor + if not path R0: numeric R.num; path R[\\]; fi + if (unknown R.num) or (unknown append_results): R.num:=0; fi + if unknown join_kind: save join_kind; join_kind=0; fi + if unknown end_kind: save end_kind; end_kind=0; fi + for i_:=1 upto PATH_.num: + if not cycle PATH_[i_]: + R[incr R.num]:=make_end[end_kind] + (make_edge[join_kind](PATH_[i_],b), + reverse make_edge[join_kind](PATH_[i_],-b)); + else: + R[incr R.num]:=make_edge[join_kind](PATH_[i_],b); + R[incr R.num]:=reverse make_edge[join_kind](PATH_[i_],-b); + fi + endfor + for i_:=1 upto R.num: R[i_]:=clean_path(clean_path(R[i_])); endfor +endgroup +enddef; +% --- +def change_weight(text P)(expr b) suffix R = +begingroup interim autorounding:=0; + numeric PATH_.num; path PATH_[\\]; + PATH_.num:=0; for P_:=P: PATH_[incr PATH_.num]:=touch_path(P_); endfor + if not path R0: numeric R.num; path R[\\]; fi + if (unknown R.num) or (unknown append_results): R.num:=0; fi + if unknown join_kind: save join_kind; join_kind=0; fi + for i_:=1 upto PATH_.num: +% non-cyclic paths are ignored + if cycle PATH_[i_]: R[incr R.num]:=make_edge[join_kind](PATH_[i_],b); fi + endfor +endgroup +enddef; +% --- +def info_ro expr s = if tracingremoving>0: message s; message ""; fi enddef; +def info_es expr s = if tracingexpanding>0: message s; message ""; fi enddef; +% --- +% DEFAULTS: +% --- +def roex_default text t = + forsuffixes S_:=t: + if str S_ = "good_colors": +% the formula |good_colors(p,q) and good_colors(q,p)| must be |false|! + vardef good_colors(expr i,o) = ((i>=1) and (o<=0)) enddef; + elseif str S_ = "touch_path": + vardef touch_path(expr p) = p enddef; + elseif str S_ = "background_color": background_color:=0; + elseif str S_ = "miter_size": + miter_size:=10pixels_per_inch/72; % i.e., 10bp +% incidentally, |10bp| would convert to |10.00002| during export at |300dpi| + elseif str S_ = "epsil.ang": epsil.ang:=1/10; % in degrees + elseif str S_ = "epsil.dist": epsil.dist:=1/10pt; % ca |2/5|pxl at |300dpi| + elseif str S_ = "epsil.time": epsil.time:=1/100; + elseif str S_ = "epsil.len": epsil.len:=1/1000; % used in |turn_ang| + elseif str S_ = "max_idx": max_idx:=125; + elseif str S_ = "enc": +% |enc| is a prefix of a data structure used in checking tangent +% points and searching for the leftmost edge; |enc.pth| is in both +% cases scaled differently + vardef enc.pth = fullcircle enddef; enc.len:=length(enc.pth); + fi + endfor +enddef; +% +roex_default good_colors, touch_path, background_color, miter_size, + epsil.ang, epsil.dist, epsil.time, epsil.len, max_idx, enc; +% --- +numeric append_results; % initially unknown +newinternal tracingleftmost; tracingleftmost:=0; +newinternal tracingremoving; tracingremoving:=0; +newinternal tracingexpanding; tracingexpanding:=0; +% --- +endinput +%%\end + |