home *** CD-ROM | disk | FTP | other *** search
/ Atari FTP / ATARI_FTP_0693.zip / ATARI_FTP_0693 / Tex / cm_mf.arc / PLAIN.MF < prev   
Text File  |  1989-01-30  |  22KB  |  586 lines

  1. % This is the plain METAFONT base that's described in The METAFONTbook.
  2. % N.B.: Please change "base_version" whenever this file is modified!
  3. % And don't modify the file under any circumstances.
  4. string base_name, base_version; base_name="plain"; base_version="1.0";
  5.  
  6. message "Preloading the plain base, version "&base_version&": preliminaries,";
  7.  
  8. delimiters ();  % this makes parentheses behave like parentheses
  9. def upto = step 1 until enddef; % syntactic sugar
  10. def downto = step -1 until enddef;
  11. def exitunless expr c = exitif not c enddef;
  12. let relax = \;  % ignore the word `relax', as in TeX
  13. let \\ = \; % double relaxation is like single
  14. def ]] = ] ] enddef; % right brackets should be loners
  15. def -- = {curl 1}..{curl 1} enddef;
  16. def --- = .. tension infinity .. enddef;
  17. def ... = .. tension atleast 1 .. enddef;
  18.  
  19. def gobble primary g = enddef;
  20. primarydef g gobbled gg = enddef;
  21. def hide(text t) = exitif numeric begingroup t;endgroup; enddef;
  22. def ??? = hide(interim showstopping:=1; showdependencies) enddef;
  23. def stop expr s = message s; gobble readstring enddef;
  24.  
  25. smoothing:=1; autorounding:=2;  % this adjusts curves to the raster
  26. turningcheck:=2;                % this will warn about a "strange path"
  27. granularity:=1;                 % this says that pixels are pixels
  28.  
  29. def interact = % sets up to make "show" commands stop
  30.  hide(showstopping:=1; tracingonline:=1) enddef;
  31.  
  32. def loggingall =        % puts tracing info into the log
  33.  tracingcommands:=3; tracingedges:=2; tracingtitles:=1; tracingequations:=1;
  34.  tracingcapsules:=1; tracingspecs:=1; tracingpens:=1; tracingchoices:=1;
  35.  tracingstats:=1; tracingoutput:=1; tracingmacros:=1; tracingrestores:=1;
  36.  enddef;
  37.  
  38. def tracingall =        % turns on every form of tracing
  39.  tracingonline:=1; showstopping:=1; loggingall enddef;
  40.  
  41. def tracingnone =       % turns off every form of tracing
  42.  tracingcommands:=0; tracingonline:=0; showstopping:=0;
  43.  tracingedges:=0; tracingtitles:=0; tracingequations:=0;
  44.  tracingcapsules:=0; tracingspecs:=0; tracingpens:=0; tracingchoices:=0;
  45.  tracingstats:=0; tracingoutput:=0; tracingmacros:=0; tracingrestores:=0;
  46.  enddef;
  47.  
  48. message " basic constants and mathematical macros,";
  49.  
  50. % numeric constants
  51. newinternal eps,epsilon,infinity,_;
  52. eps := .00049;    % this is a pretty small positive number
  53. epsilon := 1/256/256;   % but this is the smallest
  54. infinity := 4095.99998;    % and this is the largest
  55. _ := -1; % internal constant to make macros unreadable but shorter
  56.  
  57. % pair constants
  58. pair right,left,up,down,origin;
  59. origin=(0,0); up=-down=(0,1); right=-left=(1,0);
  60.  
  61. % path constants
  62. path quartercircle,halfcircle,fullcircle,unitsquare;
  63. quartercircle=(right{up}..(right+up)/sqrt2..up{left}) scaled .5;
  64. halfcircle=quartercircle & quartercircle rotated 90;
  65. fullcircle=halfcircle & halfcircle rotated 180 & cycle;
  66. unitsquare=(0,0)--(1,0)--(1,1)--(0,1)--cycle;
  67.  
  68. % transform constants
  69. transform identity;
  70. for z=origin,right,up: z transformed identity = z; endfor
  71.  
  72. % picture constants
  73. picture blankpicture,unitpixel;
  74. blankpicture=nullpicture; % `display blankpicture...'
  75. unitpixel=nullpicture; addto unitpixel contour unitsquare;
  76.  
  77. % string constants
  78. string ditto; ditto = char 34; % ASCII double-quote mark
  79.  
  80. % pen constants
  81. def capsule_def(suffix s) primary u = def s = u enddef enddef;
  82. capsule_def(pensquare) makepen(unitsquare shifted -(.5,.5));
  83. capsule_def(penrazor) makepen((-.5,0)--(.5,0)--cycle);
  84. pen penspeck; penspeck=pensquare scaled eps;
  85.  
  86. % nullary operators
  87. vardef whatever = save ?; ? enddef;
  88.  
  89. % unary operators
  90. let abs = length;
  91.  
  92. vardef round primary u =
  93.  if numeric u: floor(u+.5)
  94.  elseif pair u: (hround xpart u, vround ypart u)
  95.  else: u fi enddef;
  96.  
  97. vardef hround primary x = floor(x+.5) enddef;
  98. vardef vround primary y = floor(y.o_+.5)_o_ enddef;
  99.  
  100. vardef ceiling primary x = -floor(-x) enddef;
  101.  
  102. vardef byte primary s =
  103.  if string s: ASCII fi s enddef;
  104.  
  105. vardef dir primary d = right rotated d enddef;
  106.  
  107. vardef unitvector primary z = z/abs z enddef;
  108.  
  109. vardef inverse primary T =
  110.  transform T_; T_ transformed T = identity; T_ enddef;
  111.  
  112. vardef counterclockwise primary c =
  113.  interim autorounding:=0;
  114.  if turningnumber c <= 0: reverse fi c enddef;
  115.  
  116. vardef tensepath expr r =
  117.  for k=0 upto length r - 1: point k of r --- endfor
  118.  if cycle r: cycle else: point infinity of r fi enddef;
  119.  
  120. % binary operators
  121.  
  122. primarydef x mod y = (x-y*floor(x/y)) enddef;
  123. primarydef x div y = floor(x/y) enddef;
  124. primarydef w dotprod z = (xpart w * xpart z + ypart w * ypart z) enddef;
  125.  
  126. primarydef x**y = if y=2: x*x else: takepower y of x fi enddef;
  127. def takepower expr y of x =
  128.  if x>0: mexp(y*mlog x)
  129.  elseif (x=0) and (y>0): 0
  130.  else: 1
  131.   if y=floor y:
  132.    if y>=0: for n=1 upto y: *x endfor
  133.    else: for n=_ downto y: /x endfor
  134.    fi
  135.   else: hide(errmessage "Undefined power: " & decimal x&"**"&decimal y)
  136.   fi fi enddef;
  137.  
  138. vardef direction expr t of p =
  139.  postcontrol t of p - precontrol t of p enddef;
  140.  
  141. vardef directionpoint expr z of p =
  142.  a_:=directiontime z of p;
  143.  if a_<0: errmessage("The direction doesn't occur"); fi
  144.  point a_ of p enddef;
  145.  
  146. secondarydef p intersectionpoint q =
  147.  begingroup save x_,y_; (x_,y_)=p intersectiontimes q;
  148.  if x_<0: errmessage("The paths don't intersect"); origin
  149.  else: .5[point x_ of p, point y_ of q] fi endgroup
  150. enddef;
  151.  
  152. tertiarydef p softjoin q =
  153.  begingroup c_:=fullcircle scaled 2join_radius shifted point 0 of q;
  154.  a_:=ypart(c_ intersectiontimes p); b_:=ypart(c_ intersectiontimes q);
  155.  if a_<0:point 0 of p{direction 0 of p} else: subpath(0,a_) of p fi
  156.   ... if b_<0:{direction infinity of q}point infinity of q
  157.    else: subpath(b_,infinity) of q fi endgroup enddef;
  158. newinternal join_radius,a_,b_; path c_;
  159.  
  160. % special operators
  161. vardef incr suffix $ = $:=$+1; $ enddef;
  162. vardef decr suffix $ = $:=$-1; $ enddef;
  163.  
  164. def reflectedabout(expr w,z) =    % reflects about the line w..z
  165.  transformed
  166.   begingroup transform T_;
  167.   w transformed T_ = w;  z transformed T_ = z;
  168.   xxpart T_ = -yypart T_; xypart T_ = yxpart T_; % T_ is a reflection
  169.   T_ endgroup enddef;
  170.  
  171. def rotatedaround(expr z, d) =    % rotates d degrees around z
  172.  shifted -z rotated d shifted z enddef;
  173. let rotatedabout = rotatedaround;   % for roundabout people
  174.  
  175. vardef min(expr u)(text t) = % t is a list of numerics, pairs, or strings
  176.  save u_; setu_ u; for uu = t: if uu<u_: u_:=uu; fi endfor
  177.  u_ enddef;
  178.  
  179. vardef max(expr u)(text t) = % t is a list of numerics, pairs, or strings
  180.  save u_; setu_ u; for uu = t: if uu>u_: u_:=uu; fi endfor
  181.  u_ enddef;
  182.  
  183. def setu_ primary u =
  184.  if pair u: pair u_ elseif string u: string u_ fi;
  185.  u_=u enddef;
  186.  
  187. def flex(text t) =           % t is a list of pairs
  188.  hide(n_:=0; for z=t: z_[incr n_]:=z; endfor
  189.   dz_:=z_[n_]-z_1)
  190.  z_1 for k=2 upto n_-1: ...z_[k]{dz_} endfor ...z_[n_] enddef;
  191. newinternal n_; pair z_[],dz_;
  192.  
  193. def superellipse(expr r,t,l,b,s)=
  194.  r{up}...(s[xpart t,xpart r],s[ypart r,ypart t]){t-r}...
  195.  t{left}...(s[xpart t,xpart l],s[ypart l,ypart t]){l-t}...
  196.  l{down}...(s[xpart b,xpart l],s[ypart l,ypart b]){b-l}...
  197.  b{right}...(s[xpart b,xpart r],s[ypart r,ypart b]){r-b}...cycle enddef;
  198.  
  199. vardef interpath(expr a,p,q) =
  200.  for t=0 upto length p-1: a[point t of p, point t of q]
  201.   ..controls a[postcontrol t of p, postcontrol t of q]
  202.    and a[precontrol t+1 of p, precontrol t+1 of q] .. endfor
  203.  if cycle p: cycle
  204.  else: a[point infinity of p, point infinity of q] fi enddef;
  205.  
  206. vardef solve@#(expr true_x,false_x)= % @#(true_x)=true, @#(false_x)=false
  207.  tx_:=true_x; fx_:=false_x;
  208.  forever: x_:=.5[tx_,fx_]; exitif abs(tx_-fx_)<=tolerance;
  209.  if @#(x_): tx_ else: fx_ fi :=x_; endfor
  210.  x_ enddef; % now x_ is near where @# changes from true to false
  211. newinternal tolerance, tx_,fx_,x_; tolerance:=.1;
  212.  
  213. message " macros for converting from device-independent units to pixels,";
  214.  
  215. def fix_units =  % define the conversion factors, given pixels_per_inch
  216.  mm:=pixels_per_inch/25.4;      cm:=pixels_per_inch/2.54;
  217.  pt:=pixels_per_inch/72.27;     pc:=pixels_per_inch/6.0225;
  218.  dd:=1238/1157pt;               cc:=12dd;
  219.  bp:=pixels_per_inch/72;        in:=pixels_per_inch;
  220.  hppp:=pt;                      % horizontal pixels per point
  221.  vppp:=aspect_ratio*hppp;       % vertical pixels per point
  222.  enddef;
  223.  
  224. mm#=2.84528;      pt#=1;        dd#=1.07001;      bp#:=1.00375;
  225. cm#=28.45276;     pc#=12;       cc#=12.84010;     in#:=72.27;
  226.  
  227. newinternal pixels_per_inch;       % the given resolution
  228. newinternal blacker, o_correction; % device-oriented corrections
  229.  
  230. def define_pixels(text t) =
  231.  forsuffixes $=t: $:=$.#*hppp; endfor enddef;
  232. def define_whole_pixels(text t) =
  233.  forsuffixes $=t: $:=hround($.#*hppp); endfor enddef;
  234. def define_whole_vertical_pixels(text t) =
  235.  forsuffixes $=t: $:=vround($.#*hppp); endfor enddef;
  236. def define_good_x_pixels(text t) =
  237.  forsuffixes $=t: $:=good.x($.#*hppp); endfor enddef;
  238. def define_good_y_pixels(text t) =
  239.  forsuffixes $=t: $:=good.y($.#*hppp); endfor enddef;
  240. def define_blacker_pixels(text t) =
  241.  forsuffixes $=t: $:=$.#*hppp+blacker; endfor enddef;
  242. def define_whole_blacker_pixels(text t) =
  243.  forsuffixes $=t: $:=hround($.#*hppp+blacker);
  244.   if $<=0: $:=1; fi endfor enddef;
  245. def define_whole_vertical_blacker_pixels(text t) =
  246.  forsuffixes $=t: $:=vround($.#*hppp+blacker);
  247.   if $<=0: $:=1_o_; fi endfor enddef;
  248. def define_corrected_pixels(text t) =
  249.  forsuffixes $=t: $:=vround($.#*hppp*o_correction)+eps; endfor enddef;
  250. def define_horizontal_corrected_pixels(text t) =
  251.  forsuffixes $=t: $:=hround($.#*hppp*o_correction)+eps; endfor enddef;
  252.  
  253. def lowres_fix(text t) expr ratio =
  254.  begingroup save min,max,first;
  255.  forsuffixes $=t: if unknown min: min=max=first=$; min#=max#=$.#;
  256.   elseif $.#<min#: min:=$; min#:=$.#;
  257.   elseif $.#>max#: max:=$; max#:=$.#; fi endfor
  258.  if max/min>ratio*max#/min#: forsuffixes $=t: $:=first; endfor fi
  259.  endgroup enddef;
  260.  
  261. message " macros and tables for various modes of operation,";
  262.  
  263. def mode_setup =
  264.  warningcheck:=0;
  265.  if unknown mode: mode=proof; fi
  266.  numeric aspect_ratio; transform currenttransform;
  267.  scantokens if string mode:("input "&mode) else: mode_name[mode] fi;
  268.  if unknown mag: mag=1; fi
  269.  if unknown aspect_ratio: aspect_ratio=1; fi
  270.  displaying:=proofing;
  271.  pixels_per_inch:=pixels_per_inch*mag;
  272.  if aspect_ratio=1: let o_=\; let _o_=\
  273.  else: def o_=*aspect_ratio enddef; def _o_=/aspect_ratio enddef fi;
  274.  fix_units;
  275.  scantokens extra_setup; % the user's special last-minute adjustments
  276.  currenttransform:=
  277.   if unknown currenttransform: identity else: currenttransform fi
  278.    yscaled aspect_ratio;
  279.  clearit;
  280.  pickup pencircle scaled (.4pt+blacker);
  281.  warningcheck:=1; enddef;
  282. def smode = string mode; mode enddef;
  283. string extra_setup, mode_name[];
  284. extra_setup="";          % usually there's nothing special to do
  285. newinternal displaying;  % if positive, endchar will `showit'
  286.  
  287. vardef magstep primary m = mexp(46.67432m) enddef;
  288.  
  289. def mode_def suffix $ =
  290.  $:=incr number_of_modes;
  291.  mode_name[$]:=str$ & "_";
  292.  expandafter quote def scantokens mode_name[$] enddef;
  293. newinternal number_of_modes;
  294.  
  295. % proof mode: for initial design of characters
  296. mode_def proof =
  297.  proofing:=2;                   % yes, we're making full proofs
  298.  fontmaking:=0;                 % no, we're not making a font
  299.  tracingtitles:=1;              % yes, show titles online
  300.  pixels_per_inch:=2601.72;      % that's 36 pixels per pt
  301.  blacker:=0;                    % no additional blackness
  302.  fillin:=0;                     % no compensation for fillin
  303.  o_correction:=1;               % no reduction in overshoot
  304.  enddef;
  305.  
  306. % smoke mode: for label-free proofs to mount on the wall
  307. mode_def smoke =
  308.  proof_;                        % same as proof mode, except:
  309.  proofing:=1;                   % yes, we're making unlabeled proofs
  310.  extra_setup:=extra_setup&"grayfont black"; % with solid black pixels
  311.  let makebox=maketicks;         % make the boxes less obtrusive
  312.  enddef;
  313.  
  314. % lowres mode: for certain devices that print 200 pixels per inch
  315. mode_def lowres =
  316.  proofing:=0;                   % no, we're not making proofs
  317.  fontmaking:=1;                 % yes, we are making a font
  318.  tracingtitles:=0;              % no, don't show titles at all
  319.  pixels_per_inch:=200;          % that's the meaning of lowres
  320.  blacker:=.65;                  % make pens a bit blacker
  321.  fillin:=.2;                    % compensate for diagonal fillin
  322.  o_correction:=.4;              % but don't overshoot as much
  323.  enddef;
  324.  
  325. localfont:=lowres;      % the mode most commonly used to make fonts
  326.  
  327. % It is customary to input another file to supplement the PLAIN base.
  328. % This supplementary file adds analogous modes, corresponding to
  329. % local output devices, and it redefines `localfont' as appropriate.
  330. % The values of screen_rows and screen_cols should also be updated.
  331. % The auxiliary file should set base_version:=base_version&"/localname".
  332. % Remember that the present file PLAIN.MF should not be changed;
  333. % all local changes should be confined to a separate file.
  334.  
  335. message " macros for drawing and filling,";
  336.  
  337. pen currentpen;
  338. path currentpen_path;
  339. picture currentpicture;
  340. transform currenttransform;
  341. def t_ = transformed currenttransform enddef;
  342.  
  343. def fill expr c = addto_currentpicture contour c.t_ enddef;
  344. def addto_currentpicture = addto currentpicture enddef;
  345. def draw expr p =
  346.  addto_currentpicture doublepath p.t_ withpen currentpen enddef;
  347. def filldraw expr c = fill counterclockwise c withpen currentpen enddef;
  348. def drawdot expr z = if unknown currentpen_path: def_pen_path_ fi
  349.  addto_currentpicture contour
  350.   currentpen_path shifted z.t_ withpen penspeck enddef;
  351. def def_pen_path_ =
  352.  hide(currentpen_path=tensepath makepath currentpen) enddef;
  353.  
  354. def unfill expr c = fill c withweight _ enddef;
  355. def undraw expr p = draw p withweight _ enddef;
  356. def unfilldraw expr c = filldraw c withweight _ enddef;
  357. def undrawdot expr z = drawdot z withweight _ enddef;
  358. def erase text t = begingroup interim default_wt_:=_;
  359.  cullit; t withweight _; cullit; endgroup enddef;
  360. newinternal default_wt_; default_wt_:=1;
  361.  
  362. def cutdraw expr p =
  363.  cutoff(point 0 of p, 180+angle direction 0 of p);
  364.  cutoff(point infinity of p, angle direction infinity of p);
  365.  draw p enddef;
  366. vardef cutoff(expr z,theta) =
  367.  interim autorounding := 0; interim smoothing := 0;
  368.  addto pic_ doublepath z.t_ withpen currentpen;
  369.  addto pic_ contour
  370.   (cut_ scaled (1+max(pen_lft,pen_rt,pen_top,pen_bot))t_
  371.    rotated theta shifted z);
  372.  cull pic_ keeping (2,2) withweight -default_wt_;
  373.  addto currentpicture also pic_;
  374.  pic_:=nullpicture enddef;
  375. picture pic_; pic_:=nullpicture;
  376. path cut_; cut_ = ((0,_)--(1,_)--(1,1)--(0,1)--cycle) scaled 1.42;
  377.  
  378. def pickup secondary q =
  379.  if numeric q: numeric_pickup_ else: pen_pickup_ fi q enddef;
  380. def numeric_pickup_ primary q =
  381.  if unknown pen_[q]: errmessage "Unknown pen"; clearpen
  382.  else: currentpen:=pen_[q];
  383.   pen_lft:=pen_lft_[q];
  384.   pen_rt:=pen_rt_[q];
  385.   pen_top:=pen_top_[q];
  386.   pen_bot:=pen_bot_[q];
  387.   currentpen_path:=pen_path_[q] fi; enddef;
  388. def pen_pickup_ primary q =
  389.   currentpen:=q yscaled aspect_ratio;
  390.   pen_lft:=xpart penoffset down of currentpen;
  391.   pen_rt:=xpart penoffset up of currentpen;
  392.   pen_top:=(ypart penoffset left of currentpen)_o_;
  393.   pen_bot:=(ypart penoffset right of currentpen)_o_;
  394.   path currentpen_path; enddef;
  395. newinternal pen_lft,pen_rt,pen_top,pen_bot,pen_count_;
  396.  
  397. vardef savepen = pen_[incr pen_count_]=currentpen;
  398.  pen_lft_[pen_count_]=pen_lft;
  399.  pen_rt_[pen_count_]=pen_rt;
  400.  pen_top_[pen_count_]=pen_top;
  401.  pen_bot_[pen_count_]=pen_bot;
  402.  pen_path_[pen_count_]=currentpen_path;
  403.  pen_count_ enddef;
  404.  
  405. def clearpen = currentpen:=nullpen;
  406.  pen_lft:=pen_rt:=pen_top:=pen_bot:=0;
  407.  path currentpen_path;
  408.  enddef;
  409. def clear_pen_memory =
  410.  pen_count_:=0;
  411.  numeric pen_lft_[],pen_rt_[],pen_top_[],pen_bot_[];
  412.  pen currentpen,pen_[];
  413.  path currentpen_path, pen_path_[];
  414.  enddef;
  415.  
  416. vardef lft primary x = x + if pair x: (pen_lft,0) else: pen_lft fi enddef;
  417. vardef rt primary x = x + if pair x: (pen_rt,0) else: pen_rt fi enddef;
  418. vardef top primary y = y + if pair y: (0,pen_top) else: pen_top fi enddef;
  419. vardef bot primary y = y + if pair y: (0,pen_bot) else: pen_bot fi enddef;
  420. vardef good.x primary x = hround(x+pen_lft)-pen_lft enddef;
  421. vardef good.y primary y = vround(y+pen_top)-pen_top enddef;
  422. vardef good.lft primary z = save z_; pair z_;
  423.   (z_+(pen_lft,0))t_=round((z+(pen_lft,0))t_); z_ enddef;
  424. vardef good.rt primary z = save z_; pair z_;
  425.   (z_+(pen_rt,0))t_=round((z+(pen_rt,0))t_); z_ enddef;
  426. vardef good.top primary z = save z_; pair z_;
  427.   (z_+(pen_top,0))t_=round((z+(pen_top,0))t_); z_ enddef;
  428. vardef good.bot primary z = save z_; pair z_;
  429.   (z_+(pen_bot,0))t_=round((z+(pen_bot,0))t_); z_ enddef;
  430.  
  431. vardef penpos@#(expr b,d) =
  432.  (x@#r-x@#l,y@#r-y@#l)=(b,0) rotated d;
  433.  x@#=.5(x@#l+x@#r); y@#=.5(y@#l+y@#r) enddef;
  434.  
  435. def penstroke text t =
  436.  forsuffixes e = l,r: path_.e:=t; endfor
  437.  if cycle path_.l: cyclestroke_
  438.  else: fill path_.l -- reverse path_.r -- cycle fi enddef;
  439. def cyclestroke_ =
  440.  begingroup interim turningcheck:=0;
  441.  addto pic_ contour path_.l.t_ withweight 1;
  442.  addto pic_ contour path_.r.t_ withweight _;
  443.  cull pic_ dropping origin withweight default_wt_;
  444.  addto_currentpicture also pic_;
  445.  pic_:=nullpicture endgroup enddef;
  446. path path_.l,path_.r;
  447.  
  448. message " macros for proof labels and rules,";
  449.  
  450. vardef makelabel@#(expr s,z) = % puts string s at point z
  451.  if known z: special lcode_@# & s;
  452.   numspecial xpart(z.t_); numspecial ypart(z.t_) fi enddef;
  453. string lcode_,lcode_.top,lcode_.lft,lcode_.rt,lcode_.bot,
  454.   lcode_.top.nodot,lcode_.lft.nodot,lcode_.rt.nodot,lcode_.bot.nodot;
  455. lcode_.top=" 1"; lcode_.lft=" 2"; lcode_.rt=" 3"; lcode_.bot=" 4";
  456. lcode_=" 0"; % change to " /" to avoid listing in overflow column
  457. lcode_.top.nodot=" 5"; lcode_.lft.nodot=" 6";
  458. lcode_.rt.nodot=" 7"; lcode_.bot.nodot=" 8";
  459.  
  460. vardef labels@#(text t) =
  461.  if proofing>1: forsuffixes $=t:
  462.   makelabel@#(str$,z$); endfor
  463.  fi enddef;
  464. vardef penlabels@#(text t) =
  465.  if proofing>1: forsuffixes $$=l,,r: forsuffixes $=t:
  466.   makelabel@#(str$.$$,z$.$$); endfor endfor
  467.  fi enddef;
  468.  
  469. def range expr x = numtok[x] enddef;
  470. def numtok suffix x=x enddef;
  471. tertiarydef m thru n =
  472.  m for x=m+1 step 1 until n: , numtok[x] endfor enddef;
  473.  
  474. def proofrule(expr w,z) =
  475.  special "rule"; numspecial xpart w; numspecial ypart w;
  476.  numspecial xpart z; numspecial ypart z enddef;
  477. def screenrule(expr w,z) =
  478.  addto currentpicture doublepath w--z withpen rulepen enddef;
  479. pen rulepen; rulepen = pensquare scaled 2;
  480.  
  481. def makegrid(text xlist,ylist) =
  482.  xmin_ := min(xlist); xmax_ := max(xlist);
  483.  ymin_ := min(ylist); ymax_ := max(ylist);
  484.  for x=xlist: proofrule((x,ymin_), (x,ymax_)); endfor
  485.  for y=ylist: proofrule((xmin_,y), (xmax_,y)); endfor
  486.  enddef;
  487.  
  488. vardef titlefont suffix $ = special "titlefont "&str$ enddef;
  489. vardef labelfont suffix $ = special "labelfont "&str$ enddef;
  490. vardef grayfont suffix $ = special "grayfont "&str$ enddef;
  491. vardef slantfont suffix $ = special "slantfont "&str$ enddef;
  492. def proofoffset primary z = % shifts proof output by z
  493.  special "offset"; numspecial xpart z; numspecial ypart z enddef;
  494. vardef proofrulethickness expr x =
  495.  special "rulethickness"; numspecial x enddef;
  496.  
  497. message " macros for character and font administration,";
  498.  
  499. def beginchar(expr c,w_sharp,h_sharp,d_sharp) =
  500.  begingroup
  501.  charcode:=if known c: byte c else: 0 fi;
  502.  charwd:=w_sharp;      charht:=h_sharp;       chardp:=d_sharp;
  503.  w:=hround(charwd*hppp); h:=vround(charht*hppp); d:=vround(chardp*hppp);
  504.  charic:=0; clearxy; clearit; clearpen; scantokens extra_beginchar;
  505.  enddef;
  506.  
  507. def italcorr expr x_sharp = if x_sharp>0: charic:=x_sharp fi enddef;
  508.  
  509. def change_width =
  510.  w:=w if w>charwd*hppp:- else:+ fi 1 enddef;
  511.  
  512. def endchar =
  513.  scantokens extra_endchar;
  514.  if proofing>0: makebox(proofrule); fi
  515.  chardx:=w;     % desired width of the character in pixels
  516.  shipit;
  517.  if displaying>0: makebox(screenrule); showit; fi
  518.  endgroup enddef;
  519.  
  520. string extra_beginchar, extra_endchar;
  521. extra_beginchar=extra_endchar="";
  522.  
  523. def makebox(text r) =
  524.  for y=0,h.o_,-d.o_: r((0,y),(w,y)); endfor % horizontals
  525.  for x=0,w:   r((x,-d.o_),(x,h.o_)); endfor % verticals
  526.  if charic<>0: r((w+charic*hppp,h.o_),(w+charic*hppp,.5h.o_)); fi
  527.  enddef;
  528.  
  529. def maketicks(text r) =
  530.  for y=0,h.o_,-d.o_: r((0,y),(10,y)); r((w-10,y),(w,y)); endfor
  531.  for x=0,w: r((x,10-d.o_),(x,-d.o_)); r((x,h.o_-10),(x,h.o_)); endfor
  532.  if charic<>0: r((w+charic*hppp,h.o_-10),(w+charic*hppp,h.o_)); fi
  533.  enddef;
  534.  
  535. def font_size expr x = designsize:=x enddef;
  536. def font_slant expr x = fontdimen 1: x enddef;
  537. def font_normal_space expr x = fontdimen 2: x enddef;
  538. def font_normal_stretch expr x = fontdimen 3: x enddef;
  539. def font_normal_shrink expr x = fontdimen 4: x enddef;
  540. def font_x_height expr x = fontdimen 5: x enddef;
  541. def font_quad expr x = fontdimen 6: x enddef;
  542. def font_extra_space expr x = fontdimen 7: x enddef;
  543.  
  544. def font_identifier expr x = font_identifier_:=x enddef;
  545. def font_coding_scheme expr x = font_coding_scheme_:=x enddef;
  546. string font_identifier_, font_coding_scheme_;
  547. font_identifier_=font_coding_scheme_="UNSPECIFIED";
  548.  
  549. message "and a few last-minute items.";
  550.  
  551. vardef z@#=(x@#,y@#) enddef;
  552.  
  553. newinternal screen_rows, screen_cols, currentwindow;
  554. screen_rows:=400;     % these values should be corrected,
  555. screen_cols:=500;     % by reading in a separate file after PLAIN.MF
  556.  
  557. def openit = openwindow currentwindow
  558.  from origin to (screen_rows,screen_cols) at (-50,300) enddef;
  559. def showit = openit; let showit=showit_; showit enddef; % first time only
  560. def showit_ = display currentpicture inwindow currentwindow enddef;
  561.  
  562. def clearxy = save x,y enddef;
  563. def clearit = currentpicture:=nullpicture enddef;
  564. def shipit = shipout currentpicture enddef;
  565. def cullit = cull currentpicture dropping (-infinity,0) enddef;
  566.  
  567. def screenchars =     % endchar should `showit'
  568.  extra_endchar:=extra_endchar&"showit;" enddef;
  569. def screenstrokes =   % every stroke should `showit'
  570.  def addto_currentpicture text t=
  571.   addto currentpicture t; showit enddef; enddef;
  572. def imagerules =      % a box should be part of the character image
  573.  extra_beginchar:=extra_beginchar & "makebox(screenrule);" enddef;
  574. def gfcorners =       % `maketicks' should send rules to the GF file
  575.  extra_setup:=extra_setup & "let makebox=maketicks;proofing:=1;" enddef;
  576. def nodisplays =      % endchar shouldn't `showit'
  577.  extra_setup:=extra_setup & "displaying:=0;" enddef;
  578. def notransforms =    % currenttransform should not be used
  579.  let t_ = \ enddef;
  580.  
  581. let bye = end; outer end,bye;
  582.  
  583. clear_pen_memory;     % initialize the `savepen' mechanism
  584. mode_setup;           % establish proof mode as the default
  585. numeric mode,mag;     % but leave mode and mag undefined
  586.