Permalink
Cannot retrieve contributors at this time
%% therion source code | |
%% | |
%% therion.mp | |
%% | |
%% This file defines low-level MetaPost macros and variables required | |
%% for generation of map symbols | |
%% | |
%% $Date: 2003/07/01 09:06:44 $ | |
%% $RCSfile: therion.mp,v $ | |
%% $Revision: 1.3 $ | |
%% | |
%% Copyright (C) 2000-2003 Martin Budaj | |
%% | |
%% Some macros are adapted from MPATTERN package of P. Bolek | |
%% | |
%% Some macros are used from MetaFun package of H. Hagen | |
%% | |
%% -------------------------------------------------------------------- | |
%% This program is free software; you can redistribute it and/or modify | |
%% it under the terms of the GNU General Public License as published by | |
%% the Free Software Foundation; either version 2 of the License, or | |
%% any later version. | |
%% | |
%% This program 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA | |
%% -------------------------------------------------------------------- | |
% This file defines low level macros used for map signatures in Therion. | |
% Before loading this file set `Scale' variable to numeric value | |
% representing denominator of the scale ratio. Internal variable | |
% `prologues' is set to 1 by this file. This module loads also | |
% symbol libraries. | |
if unknown mpversion: string mpversion; mpversion := "0.0"; fi | |
if scantokens(mpversion) < 1.0: | |
errmessage "MetaPost 1.0 or later required"; | |
fi | |
tracingstats:=1; | |
prologues:=0; | |
% Set the random seed to a fixed value so therion reproducibly produces the | |
% same output for a given input. | |
randomseed:=42; | |
if known Background: background:=Background fi; | |
%TrueScale:=Scale; | |
% @VARIABLE | |
% symbol_scale -- | |
% | |
% <I>internal numeric</I>; in map symbol definitions used for scaling | |
% in <A HREF="#T">T</A> transformation; recommended | |
% values are 1 or 2. | |
%newinternal symbol_scale; | |
%symbol_scale := 1; | |
% @VARIABLE | |
% fill_only -- | |
% | |
% <I>boolean</I>, used in <A HREF="#thdraw">thdraw</A> and | |
% <A HREF="#thpattfill">thpattfill</A> commands. When set to false, it has | |
% no effect, when it is true, it suppresses all drawing | |
% commands with exception of <I>thpermanentfill</I>, so that only filled | |
% areas are drawn | |
boolean fill_only, horiz_labels, transparency; | |
fill_only := false; | |
horiz_labels:=true; | |
transparency:=false; | |
string ATTR__id, ATTR__survey, ATTR__scrap, NorthDir; | |
boolean ATTR__scrap_centerline; | |
picture ATTR__text; | |
numeric ATTR__height; | |
boolean ATTR__elevation; | |
ATTR__scrap_centerline := false; | |
ATTR__height:=0; | |
ATTR__elevation:=false; | |
boolean ATTR__shotflag_splay; | |
ATTR__shotflag_splay:=false; | |
boolean ATTR__shotflag_duplicate; | |
ATTR__shotflag_duplicate:=false; | |
boolean ATTR__shotflag_approx; | |
ATTR__shotflag_approx:=false; | |
boolean ATTR__stationflag_splay; | |
ATTR__stationflag_splay:=false; | |
save black, white, red, green, blue, background, HelpSymbolColor; | |
if OutputColormodel = "cmyk": | |
cmykcolor black, white, red, green, blue, background, HelpSymbolColor; | |
black := (0,0,0,1); | |
white := (0,0,0,0); | |
red := (0,0.9,0.9,0.2); | |
green := (0.7,0,0.8,0.4); | |
blue := (0.6,0.4,0,0.1); | |
HelpSymbolColor := (0,0,0,0.2); | |
defaultcolormodel := 7; | |
elseif OutputColormodel = "rgb": | |
rgbcolor black, white, red, green, blue, background, HelpSymbolColor; | |
black := (0,0,0); | |
white := (1,1,1); | |
red := (1,0,0); | |
green := (0,1,0); | |
blue := (0,0,1); | |
HelpSymbolColor := (0.8,0.8,0.8); | |
defaultcolormodel := 5; | |
else: | |
black := 0; | |
white := 1; | |
red := 0.3; | |
green := 0.59; | |
blue := 0.11; | |
HelpSymbolColor := 0.8; | |
defaultcolormodel := 3; | |
fi; | |
background = white; | |
color label_fill_color, label_fill_color_tmp; | |
label_fill_color := (1.0, 1.0, 1.0); | |
def push_label_fill_color(expr r,g,b) = | |
label_fill_color_tmp := label_fill_color; | |
label_fill_color := (r,g,b); | |
enddef; | |
def pop_label_fill_color = | |
label_fill_color := label_fill_color_tmp; | |
enddef; | |
def process_filledlabel(expr cent, rot) = | |
begingroup; | |
interim bboxmargin:=2.0bp; | |
q:=((bbox lab) smoothed 2) rotatedaround (cent, rot); | |
fill q withcolor label_fill_color; | |
draw lab rotatedaround (cent, rot); | |
write_circ_bbox(q); % without corners smoothing it was enough to use | |
% write_bbox(q); | |
endgroup; | |
enddef; | |
numeric area_border_errors; | |
area_border_errors = 0; | |
% @VARIABLE | |
% last_write -- | |
% | |
% <I>numeric</I>; charcode of last figure which contained | |
% <A HREF="#write_bbox">write_bbox</A> macro; this value is used by | |
% <A HREF="#close_file">close_file</A> macro. Initially set to -1. | |
numeric last_write; | |
last_write = -1; | |
% @VARIABLE | |
% file_name -- | |
% | |
% <I>string</I>, name of file, where <I>write_bbox</I> macro writes | |
% text clipping path | |
% @VARIABLE | |
% s ch -- | |
% | |
% <I>string</I>, temporary string/char variables | |
string s, ch, file_name, bg_name, clip_name, lang, diff_pos, diff_neg, | |
current_scrap, current_src; | |
% @VARIABLE | |
% u v w -- | |
% | |
% <I>internal numeric variables</I> used as basic length units for drawing; | |
% they are set by <A HREF="#initialize">initialize</A> macro. | |
% <UL> <LI><I>u</I> -- normal unit decreasing with increasing scale | |
% <LI><I>v</I> -- like <I>u</I>, but can increase drammaticaly | |
% when some limit is encountered (to get effects like logarithmic | |
% scale) | |
% <LI><I>w</I> -- nearly constant at all scales | |
% </UL> | |
% @VARIABLE | |
% legend_scale -- | |
% | |
% <I>numeric</I>, length of the longer side of signatures' legend box | |
newinternal legend_scale, u,v,w; | |
% @VARIABLE | |
% lab Lab -- | |
% | |
% <I>picture</I>, in which are saved typeset labels | |
picture lab, Lab; | |
% @VARIABLE | |
% T -- | |
% | |
% <I>transformation</I>, defines transformation function for transforming | |
% every argument of <A HREF="#thdraw>thdraw</A> and <A HREF="#thfill>thfill</A> | |
% macros | |
transform T; | |
% @VARIABLE | |
% p,q -- | |
% | |
% <I>path</I>, for saving temporary paths | |
path p,q; | |
% @MACRO | |
% initialize -- | |
% | |
% initializes basic length units <A HREF="#u">(u,v,w)</A> and pens used | |
% in map symbols according to scale. Five circular pens are defined: | |
% <UL><LI>PenA -- thick; for outlines | |
% <LI>PenB, PenC -- thinner; for pits, symbols etc. | |
% <LI>PenD -- thinnest; for fine details | |
% <LI>PenX -- extra thick; not recommended for use | |
% </UL> | |
def fonts_setup (expr t,s,m,l,h) = | |
write "\def\updown#1#2{\vbox{" & | |
"\offinterlineskip" & | |
"\setbox100=\hbox{#1}" & | |
"\setbox101=\hbox{#2}" & | |
"\ifnum\wd100>\wd101\hsize=\wd100\else\hsize=\wd101\fi" & | |
"\centerline{\box100}\vskip4pt" & | |
"\centerline{\box101}}}" & | |
"\def\thlabel{\thnormalsize}" & | |
"\def\thremark{\thsmallsize\si}" & | |
"\def\thcomment{\thsmallsize}" & | |
"\def\thentrance{\thsmallsize}" & | |
"\def\thaltitude{\thsmallsize}" & | |
"\def\thstationname{\thsmallsize}" & | |
"\def\thdate{\thsmallsize}" & | |
"\def\thheight{\thsmallsize}" & | |
"\def\thheightpos{+\ignorespaces}" & | |
"\def\thheightneg{-\ignorespaces}" & | |
"\def\thframed{\thsmallsize}" & | |
"\def\thwallaltitude{\thtinysize}" | |
to "mptexpre.tex"; | |
write "\def\thtinysize{\size[" & decimal max(optical_zoom*t,0) & "]}" & | |
"\def\thsmallsize{\size[" & decimal max(optical_zoom*s,0) & "]}" & | |
"\def\thnormalsize{\size[" & decimal max(optical_zoom*m,0) & "]}" & | |
"\def\thlargesize{\size[" & decimal max(optical_zoom*l,0) & "]}" & | |
"\def\thhugesize{\size[" & decimal max(optical_zoom*h,0) & "]}" | |
to "mptexpre.tex"; | |
write EOF to "mptexpre.tex"; | |
enddef; | |
def initialize (expr sc) = | |
if unknown BaseScale: BaseScale = sc; fi; | |
optical_zoom := BaseScale/sc; | |
if BaseScale <= 1: % 1:100 | |
u:=14bp; v:=14bp; w:=12bp; | |
fonts_setup(8,10,12,16,24); | |
elseif BaseScale <= 2: % 1:200 | |
u:=12bp; v:=12bp; w:=12bp; | |
fonts_setup(7,8,10,14,20); | |
elseif BaseScale <= 5: % 1:500 | |
u:=10bp; v:=10bp; w:=12bp; | |
fonts_setup(6,7,8,10,14); | |
else: | |
u:=7bp; v:=14bp; w:=10bp; | |
fonts_setup(5,6,7,8,10); | |
fi; | |
u := optical_zoom * u; | |
v := optical_zoom * v; | |
w := optical_zoom * w; | |
defaultscale := 0.8 * optical_zoom; | |
def PenA = pencircle scaled (u/10) enddef; | |
def PenB = pencircle scaled (0.7*u/10) enddef; | |
def PenC = pencircle scaled (0.5*u/10) enddef; | |
def PenD = pencircle scaled (0.35*u/10) enddef; | |
def PenX = pencircle scaled (1.2*u/10) enddef; | |
legend_scale := 3.14*u; | |
enddef; | |
% macro is expanded, we have to know all dimensions and pens before reading | |
% mpattern macros | |
initialize(Scale); | |
vardef thTEX primary s = | |
write "verbatimtex \input th_enc.tex etex" to "mptextmp.mp"; | |
write "btex \mainfont "&s&" etex" to "mptextmp.mp"; | |
write EOF to "mptextmp.mp"; | |
scantokens "input mptextmp" | |
enddef; | |
% @MACRO | |
% inscale -- | |
% | |
% zooms objects to scale specified in legend_scale variable (used in legend | |
% typesetting) | |
def inscale = | |
xscaled legend_scale yscaled (0.618*legend_scale) | |
enddef; | |
% @MACRO | |
% draw_legend_box -- | |
% | |
% draws a legend bounding box and resets drawoptions() options | |
def draw_legend_box = | |
clip currentpicture to unitsquare inscale; | |
drawoptions(); | |
pickup PenB; | |
draw unitsquare inscale; | |
enddef; | |
def clean_legend_box = | |
unfill unitsquare inscale; | |
enddef; | |
def legend_point (expr name) = | |
% if substring (2,9) of name = "station": | |
% scantokens(name)((0.5,0.5) inscale); | |
% else: | |
scantokens(name)((0.5,0.5) inscale,0,1,(0,0)); | |
% fi; | |
draw_legend_box; | |
enddef; | |
def legend_line (expr name) = | |
scantokens(name)((((-0.3,.5)..(.3,.7)..(.5,.3)..{dir 80}(1.3,.9)) inscale) | |
randomized 3mm); | |
draw_legend_box; | |
enddef; | |
% legend_label | |
% legend_area | |
% legend_random | |
% @MACRO | |
% roundone -- | |
% | |
% rounds <I>numeric value</I> to one decimal point | |
vardef roundone(expr n) = | |
% round(10*n)/10 | |
n | |
enddef; | |
% @MACRO | |
% process_label -- | |
% | |
% draws a label saved in <I>lab</I> picture variable and calls | |
% <A HREF="#write_bbox">write_bbox</A> macro. | |
def process_label (expr cent, rot) = | |
begingroup; | |
interim bboxmargin:=0.8bp; | |
q:=((bbox lab) smoothed 2) rotatedaround (cent, rot); | |
draw lab rotatedaround (cent, rot); | |
write_circ_bbox(q); % without corners smoothing it was enough to use | |
% write_bbox(q); | |
endgroup; | |
enddef; | |
% @MACRO | |
% process_uplabel -- | |
% | |
% draws a label into semicircular box and writes clipping path to a file | |
def process_uplabel = | |
begingroup; | |
interim bboxmargin := 0.8 bp; | |
q:=bbox lab; | |
endgroup; | |
alef:=.8-.02*(xpart lrcorner q - xpart llcorner q); | |
% show alef; | |
q:=alef[llcorner q,ulcorner q]{up} .. {down}alef[lrcorner q, urcorner q] -- | |
lrcorner q -- llcorner q -- cycle; | |
draw lab; | |
draw q; | |
q:=reverse q; | |
write_circ_bbox(q); | |
enddef; | |
% @MACRO | |
% process_downlabel -- | |
% | |
% draws a label into down oriented semicircular box and writes | |
% clipping path to a file | |
def process_downlabel = | |
begingroup; | |
interim bboxmargin := 0.8 bp; | |
q:=bbox lab; | |
endgroup; | |
alef:=1-(.8-.02*(xpart lrcorner q - xpart llcorner q)); | |
q:=alef[llcorner q,ulcorner q]{down} .. | |
{up}alef[lrcorner q, urcorner q] -- | |
urcorner q -- ulcorner q -- cycle; | |
draw lab; | |
draw q; | |
write_circ_bbox(q); | |
enddef; | |
% @MACRO | |
% process_updownlabel -- | |
% | |
% draws a label split into down and up oriented semicircular boxes and | |
% writes clipping path to a file | |
def process_updownlabel = | |
begingroup; | |
interim bboxmargin := 0.8 bp; | |
p:=bbox lab; | |
endgroup; | |
leftside:=xpart llcorner p; | |
rightside:=xpart lrcorner p; | |
draw (xpart llcorner p,.5[ypart llcorner p,ypart ulcorner p]) -- | |
(xpart lrcorner p,.5[ypart llcorner p,ypart ulcorner p]); | |
alef:=1.05-.02*(xpart lrcorner p - xpart llcorner p); | |
% alef:=.8-.02*(rightside-leftside); | |
p:=alef[(leftside, ypart llcorner p),(leftside, ypart ulcorner p)]{up} .. | |
{down}alef[(rightside, ypart lrcorner p), (rightside, ypart urcorner p)] | |
-- alef[(rightside, ypart urcorner p), (rightside, ypart lrcorner p)]{down} | |
.. {up}alef[(leftside, ypart ulcorner p),(leftside, ypart llcorner p)] | |
-- cycle; | |
% p:=alef[llcorner p,ulcorner p]{up} .. {down}alef[lrcorner p, urcorner p] -- | |
% aleff[llcorner p,ulcorner p]{down} .. | |
% {up}aleff[lrcorner p, urcorner p] -- cycle; | |
draw lab; | |
draw p; | |
p:=reverse p; | |
write_circ_bbox(p); | |
enddef; | |
def process_updownlabel_OLD = | |
p:=bbox lab; | |
q:=bbox Lab; | |
leftside:=min(xpart llcorner p, xpart ulcorner q); | |
rightside:=max(xpart lrcorner p, xpart urcorner q); | |
draw .5[(leftside, ypart llcorner p),(leftside, ypart ulcorner q)] -- | |
.5[(rightside,ypart lrcorner p),(rightside,ypart urcorner q)]; | |
alef:=.8-.02*(rightside-leftside); | |
q:=alef[(leftside, ypart llcorner p),(leftside, ypart ulcorner p)]{up} .. | |
{down}alef[(rightside, ypart lrcorner p), (rightside, ypart urcorner p)] | |
-- alef[(rightside, ypart urcorner q), (rightside, ypart lrcorner q)]{down} | |
.. {up}alef[(leftside, ypart ulcorner q),(leftside, ypart llcorner q)] | |
-- cycle; | |
draw lab; | |
draw Lab; | |
draw q; | |
q:=reverse q; | |
write_circ_bbox(q); | |
enddef; | |
% @MACRO | |
% process_boxedlabel -- | |
% | |
% draws a label into circular box and writes | |
% clipping path to a file | |
def process_boxedlabel = | |
begingroup; | |
interim bboxmargin:=1.0bp; | |
q:=bbox lab; | |
draw lab; | |
draw q; | |
write_bbox(q); | |
endgroup; | |
enddef; | |
% @MACRO | |
% process_circledlabel -- | |
% | |
% draws a label into circular box and writes | |
% clipping path to a file | |
def process_circledlabel = | |
begingroup; | |
interim bboxmargin := 0.4 bp; | |
q:=bbox lab; | |
endgroup; | |
q:=point 0 of q .. point 1 of q .. point 2 of q .. point 3 of q .. cycle; | |
draw lab; | |
draw q; | |
write_circ_bbox(q); | |
enddef; | |
% @MACRO | |
% write_bbox -- | |
% | |
% Arguments: | |
% <I>path</I> variable -- rectangular bounding box of a label; | |
% assumptions: path is cyclic, counterclockwise oriented, with four points, | |
% composed from linear segments; | |
% see general <A HREF="#write_circ_bbox">write_circ_bbox</A> macro | |
% Results: | |
% one file per figure which uses labels with a clipping path in pseudo-pdf | |
% format | |
def write_bbox (expr q) = | |
file_name := jobname & "." & decimal(charcode) & "bbox"; | |
for i:=4 downto 0: | |
s := decimal(roundone(xpart point i of q)) & " " | |
& decimal(roundone(ypart point i of q)) | |
& if i=4: " m " else: " l" fi; | |
write s to file_name; | |
endfor; | |
last_write := charcode; | |
enddef; | |
% @MACRO | |
% write_circ_bbox -- | |
% | |
% Arguments: | |
% <I>path</I> variable, only assumption is that <I>path</I> is cyclic | |
% and counterclockwise oriented. | |
% Results: | |
% one file per figure which uses labels with a clipping path in pseudo-pdf | |
% format | |
def write_circ_bbox expr q = | |
file_name := jobname & "." & decimal(charcode) & "bbox"; | |
tmp:=length q; | |
s := decimal(roundone(xpart point tmp of q)) & " " | |
& decimal(roundone(ypart point tmp of q)) & " m"; | |
write s to file_name; | |
for i:=tmp downto 1: | |
s := decimal(roundone(xpart precontrol i of q)) & " " | |
& decimal(roundone(ypart precontrol i of q)) & " " | |
& decimal(roundone(xpart postcontrol i-1 of q)) & " " | |
& decimal(roundone(ypart postcontrol i-1 of q)) & " " | |
& decimal(roundone(xpart point i-1 of q)) & " " | |
& decimal(roundone(ypart point i-1 of q)) & " c"; | |
write s to file_name; | |
endfor; | |
last_write := charcode; | |
enddef; | |
% @MACRO | |
% close_file -- | |
% | |
% closes file with a clipping path; it's invoked by <I>endchar</I> macro | |
def close_file = | |
if last_write=charcode: | |
write EOF to jobname & "." & decimal(charcode) & "bbox"; | |
fi; | |
enddef; | |
% endchar should run close_file macro | |
extra_endfig := "close_file;"; | |
% @MACRO | |
% thdraw -- | |
% | |
% like plain MetaPost's <I>draw</I>, but draws a <I>path</I> transformed | |
% (rotated, scaled, shifted) to scrap's coordinates according T variable. | |
% (If <I>fill_only=false</I>) | |
def thdrawoptions(text t) = | |
def _thop_ = t enddef | |
enddef; | |
thdrawoptions(); | |
def thdraw expr p = | |
if not fill_only: | |
addto currentpicture | |
if picture p: | |
also (p transformed T) | |
else: | |
doublepath (p transformed T) withpen currentpen | |
fi | |
_thop_ _op_ | |
else: | |
addto currentpicture also nullpicture | |
fi | |
enddef; | |
% @MACRO | |
% thfill -- | |
% | |
% fills a <I>path</I> transformed | |
% (rotated, scaled, shifted) to scrap's coordinates according T variable. | |
% Filled areas are clipped (like most | |
% other lines and points) with a clipping path around text labels. | |
def thfill expr c = | |
addto currentpicture contour (c transformed T) _thop_ _op_ | |
enddef; | |
def thfilldraw expr c = | |
if not fill_only: | |
addto currentpicture contour (c transformed T) withpen currentpen _thop_ _op_ | |
else: | |
addto currentpicture contour (c transformed T) _thop_ _op_ | |
fi | |
enddef; | |
def thunfill expr c = | |
thfill c withcolor background | |
enddef; | |
def thundraw expr p = | |
thdraw p withcolor background | |
enddef; | |
def thunfilldraw expr c = | |
thfilldraw c withcolor background | |
enddef; | |
def thclean expr c = | |
if transparency: | |
thfill c withcolor background withtransparency 0.5 | |
else: | |
thunfill c | |
fi; | |
enddef; | |
def thPatternFill (expr Path, Pattern) = | |
T:=identity; | |
thclean Path; | |
thfill Path withpattern Pattern; | |
enddef; | |
%def thLegendPatternFill (expr Path, Pattern) = | |
% T:=identity; | |
% thfill Path withpattern Pattern; | |
%enddef; | |
% for drawarrow: | |
def _finarr text t = | |
thdraw _apth t; | |
thfilldraw arrowhead _apth t | |
enddef; | |
% @MACRO | |
% thpermanentfill -- | |
% | |
% Fills specified area with a solid color; this area is not affected by | |
% text clipping path | |
%def thpermanentfill expr c = | |
% addto currentpicture contour (c transformed T) _thop_ _op_ | |
%enddef; | |
let thpermanentfill = thfill; | |
primarydef p aligned al= | |
p shifted (xpart al * xpart U, ypart al * ypart U) | |
enddef; | |
% macros for drawing scraps in upper and lower levels; filled lower scraps | |
% require special treatment (MetaPost doesn't support non-continuous paths). | |
% We can't use one file for both, while PDF XObject has to be explicitly | |
% filled or stroked. Second macro writes also pseudo-pdf code of a clipping | |
% path for given scrap | |
boolean drawnext; | |
drawnext:=true; | |
def draw_upscrap (expr isout)(text t) = | |
path q; | |
for i=t: | |
if (numeric i): | |
if (i=1): drawnext:=true; else: drawnext:=false; fi; | |
else: | |
if drawnext: draw i withpen PenD; fi; | |
if not known q: q:=i; else: q:=q -- i; fi; | |
fi; | |
endfor; | |
if not cycle q: q:=q -- cycle; fi; | |
if turningnumber q = 0: | |
thwarning("scrap outline intersects itself"); | |
fi; | |
if isout=1: | |
if turningnumber q > 0: q := reverse q; fi; | |
else: | |
if turningnumber q < 0: q := reverse q; fi; | |
fi; | |
addto bgfill contour q; | |
enddef; | |
% following macro writes noncontinuous PostScript path directly to EPS file | |
% (filled background and clipping path) | |
picture bgfill; | |
bgfill:=nullpicture; | |
def draw_downscrap = | |
bg_name := jobname & "." & decimal(charcode) & "bg"; | |
clip_name := jobname & "." & decimal(charcode) & "clip"; | |
write "%!PS" to bg_name; | |
write "%%BoundingBox: " & | |
decimal floor xpart llcorner bgfill & " " & | |
decimal floor ypart llcorner bgfill & " " & | |
decimal ceiling xpart urcorner bgfill & " " & | |
decimal ceiling ypart urcorner bgfill | |
to bg_name; | |
write "%%Page: 1 1" to bg_name; | |
write "newpath" to bg_name; | |
for qq within bgfill: | |
q := pathpart qq; | |
tmp:=length q; | |
s := decimal(roundone(xpart point tmp of q)) & " " | |
& decimal(roundone(ypart point tmp of q)) & " m"; | |
write s & "oveto" to bg_name; | |
write s to clip_name; | |
for i:=tmp downto 1: | |
s := decimal(roundone(xpart precontrol i of q)) & " " | |
& decimal(roundone(ypart precontrol i of q)) & " " | |
& decimal(roundone(xpart postcontrol i-1 of q)) & " " | |
& decimal(roundone(ypart postcontrol i-1 of q)) & " " | |
& decimal(roundone(xpart point i-1 of q)) & " " | |
& decimal(roundone(ypart point i-1 of q)) & " c"; | |
write s & "urveto" to bg_name; | |
write s to clip_name; | |
endfor; | |
endfor; | |
write "closepath fill" to bg_name; | |
write "showpage" to bg_name; | |
write "%%EOF" to bg_name; | |
write EOF to bg_name; | |
write EOF to clip_name; | |
bgfill:=nullpicture; | |
enddef; | |
vardef buildcycle(text ll) = | |
save ta_, tb_, k_, i_, pp_; path pp_[]; | |
k_=0; | |
for q=ll: pp_[incr k_]=q; endfor | |
i_=k_; | |
for i=1 upto k_: | |
(ta_[i], length pp_[i_]-tb_[i_]) = | |
pp_[i] intersectiontimes reverse pp_[i_]; | |
if ta_[i]<0: | |
message("[Error: area borders "& area_border[i] &" and "& | |
area_border[i_] &" don't intersect in scrap " & current_scrap & | |
" (file " & current_src & ")]"); | |
area_border_errors := area_border_errors + 1; | |
fi | |
i_ := i; | |
endfor | |
for i=1 upto k_: subpath (ta_[i],tb_[i]) of pp_[i] .. endfor | |
cycle | |
enddef; | |
vardef unitvector primary z = | |
if (z<>(0,0)): | |
z/abs z | |
else: | |
hide(thwarning("strange path")) | |
(0,epsilon) | |
fi | |
enddef; | |
def thwarning (expr m) = | |
message("[Warning: " & m & " in scrap " & current_scrap & "]"); | |
enddef; | |
def check_area_borders = | |
if area_border_errors > 0: | |
fi; | |
enddef; | |
%%%%%%%%%%%% Map symbols management %%%%%%%%%%%%%%%%%%% | |
def mapsymbol (expr name, set, warning) = | |
string s, stype, lname, ID; | |
stype = substring (0,1) of name; | |
lname = name & "_" & set; | |
ID := "ID_" & lname; | |
if (known scantokens ID): | |
if stype = "a": | |
s = "def " & name & " = scantokens(" & ditto & lname & ditto & ") enddef;"; | |
else: | |
s = "let " & name & " = " & lname & ";"; | |
fi; | |
scantokens s; | |
elseif warning: | |
message("[Warning: undefined symbol `" & lname & "']"); | |
fi; | |
enddef; | |
%def hidesymbol (expr name) = | |
% string s, stype; | |
% stype = substring (0,1) of name; | |
% if stype = "a": | |
% s = "def " & name & " = scantokens(" & ditto & "a_empty" & ditto & ") enddef;"; | |
% else: | |
% s = "vardef " & name & "@# (text t) = enddef;"; | |
% fi; | |
% scantokens s; | |
% write name to "missed.dat"; | |
%enddef; | |
def initsymbol (expr name) = | |
s := "ID_" & name & " = 1"; | |
scantokens s; | |
enddef; | |
%%% | |
% comment out groups in order to use 'save ATTR_*' appropriately | |
def beginfig(expr c) = | |
% begingroup | |
charcode:=c; | |
clearxy; clearit; clearpen; | |
pickup defaultpen; | |
drawoptions(); | |
scantokens extra_beginfig; | |
save smartll, smartur; | |
pair smartll[], smartur[]; | |
smart_count := 0; | |
enddef; | |
def endfig = | |
scantokens extra_endfig; | |
shipit; | |
% endgroup | |
enddef; | |
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% | |
% P. Bolek's MPATTERN package adapted and simplified for Therion | |
% (with the same user interface except of patterncolor) | |
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% | |
string Pname_, PXYsteps_; | |
string Pmatrix_; | |
numeric Pnum_; Pnum_=0; | |
numeric pattern_file_offset; | |
pattern_file_offset = 4000; | |
if known numbersystem: % known since v1.770 | |
if numbersystem <> "scaled": | |
pattern_file_offset := scantokens("1000000"); | |
fi | |
fi | |
def PmakeBB_= | |
PBBox_ := "[" & decimal Plft_ & " " & decimal Plow_ & " " | |
& decimal Prt_ & " " & decimal Pup_ & "]"; | |
enddef; | |
def Psteps_= | |
PXYsteps_ := decimal | |
if unknown PXStep_: (Prt_-Plft_) else: PXStep_ fi | |
& ":" & decimal | |
if unknown PYStep_: (Pup_-Plow_) else: PYStep_ fi; | |
enddef; | |
vardef Pfindbounds_= | |
Plow_ = ypart (llcorner currentpicture); | |
Plft_ = xpart (llcorner currentpicture); | |
Pup_ = ypart (urcorner currentpicture); | |
Prt_ = xpart (urcorner currentpicture); | |
PmakeBB_; | |
enddef; | |
def PmakePattern_(expr name)= | |
write Pname_ & ":" | |
& jobname & "." & decimal charcode & ":" | |
& PBBox_ & ":" | |
& PXYsteps_ & ":" | |
& Pmatrix_ | |
to "patterns.dat" | |
enddef; | |
% User interface macros | |
vardef patternbbox(expr a)(text b)= | |
save Pi_, Pz_; | |
numeric Pi_, Pz_[]; | |
if pair a: | |
Plft_:=min(xpart(a),xpart(b)); Plow_:=min(ypart(a),ypart(b)); | |
Prt_:=max(xpart(a),xpart(b)); Pup_:=max(ypart(a),ypart(b)); | |
else: | |
Pi_=1; | |
for t=b: | |
Pz_[Pi_]=t; | |
Pi_:=Pi_+1; | |
endfor; | |
Plft_:=min(a,Pz_2); Plow_:=min(Pz_1,Pz_3); | |
Prt_:=max(a,Pz_2); Pup_:=max(Pz_1,Pz_3); | |
fi; | |
PmakeBB_; | |
enddef; | |
def beginpattern(suffix name)= | |
numeric PXStep_, PYStep_; | |
numeric Plow_, Plft_, Pup_, Prt_; | |
string PBBox_; | |
Pmatrix_:="[1 0 0 1 0 0]"; | |
Pname_:=str name; | |
Pnum_:=Pnum_+1; | |
beginfig(Pnum_+pattern_file_offset); | |
enddef; | |
def endpattern= | |
if unknown PBBox_: | |
Pfindbounds_; | |
fi; | |
endfig; | |
Psteps_; | |
PmakePattern_(Pname_); | |
scantokens("string " & Pname_ & "; "&Pname_&"="&ditto&Pname_&ditto&";"); | |
enddef; | |
picture pattpict; | |
string patterncolor_; | |
patterncolor_ := "0 0 0 1"; | |
primarydef p withpattern s= | |
if known s: | |
p | |
hide(pattpict := image(draw (0,0)--(10,10)); | |
for i within pattpict: | |
if colormodel i = 1: | |
patterncolor_ := decimal greypart i; | |
elseif colormodel i = 5: | |
patterncolor_ := decimal redpart i & " " & decimal greenpart i & " " & decimal bluepart i; | |
elseif colormodel i = 7: | |
patterncolor_ := decimal cyanpart i & " " & decimal magentapart i & " " & decimal yellowpart i & " " & decimal blackpart i; | |
fi | |
endfor;) | |
withprescript(" " & s & " THsetpattern") | |
withprescript(" " & patterncolor_ & " THsetpatterncolor") | |
withoutcolor | |
else: | |
p withcolor red; | |
message("Warning: undefined pattern ignored"); | |
fi; | |
enddef; | |
def patterntransform expr t= | |
Pmatrix_ := "[" & decimal xxpart t | |
& " " & decimal yxpart t | |
& " " & decimal xypart t | |
& " " & decimal yypart t | |
& " " & decimal xpart t | |
& " " & decimal ypart t & "]"; | |
enddef; | |
def patternxstep expr t= | |
PXStep_ = t; | |
enddef; | |
def patternystep expr t= | |
PYStep_ = t; | |
enddef; | |
def patternstep text t= | |
if pair t: | |
PXStep_ = xpart t; | |
PYStep_ = ypart t; | |
else: | |
(PXStep_,PYStep_)=t; | |
fi; | |
enddef; | |
def patterncolor expr t= | |
message("Warning: patterncolor not supported in Therion"); | |
enddef; | |
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% | |
% end of pattern macros | |
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% | |
% transparent colors | |
primarydef p withtransparency t = % TODO: t currently ignored | |
p withprescript(" THsettransparency"); | |
enddef; | |
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% | |
% some useful macros from H. Hagen's MetaFun package | |
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% | |
vardef paired (expr d) = | |
if pair d : d else : (d,d) fi | |
enddef ; | |
primarydef p randomshifted s = | |
begingroup ; save ss ; pair ss ; ss := paired(s) ; | |
p shifted (-.5xpart ss + uniformdeviate xpart ss, | |
-.5ypart ss + uniformdeviate ypart ss) | |
endgroup | |
enddef ; | |
primarydef p randomized s = | |
(if path p : | |
for i=0 upto length(p)-1 : | |
((point i of p) randomshifted s) .. controls | |
((postcontrol i of p) randomshifted s) and | |
((precontrol (i+1) of p) randomshifted s) .. | |
endfor | |
if cycle p : | |
cycle | |
else : | |
((point length(p) of p) randomshifted s) | |
fi | |
elseif pair p : | |
p randomshifted s | |
elseif color p : | |
if color s : | |
(uniformdeviate redpart s * redpart p, | |
uniformdeviate greenpart s * greenpart p, | |
uniformdeviate bluepart s * bluepart p) | |
elseif pair s : | |
((xpart s + uniformdeviate (ypart s - xpart s)) * p) | |
else : | |
(uniformdeviate s * p) | |
fi | |
else : | |
p + uniformdeviate s | |
fi) | |
enddef ; | |
primarydef p llmoved d = | |
((llcorner p) shifted (-xpart paired(d),-ypart paired(d))) | |
enddef ; | |
primarydef p lrmoved d = | |
((lrcorner p) shifted (+xpart paired(d),-ypart paired(d))) | |
enddef ; | |
primarydef p urmoved d = | |
((urcorner p) shifted (+xpart paired(d),+ypart paired(d))) | |
enddef ; | |
primarydef p ulmoved d = | |
((ulcorner p) shifted (-xpart paired(d),+ypart paired(d))) | |
enddef ; | |
primarydef p smoothed d = | |
(p llmoved (-xpart paired(d),0) -- p lrmoved (-xpart paired(d),0) {right} .. | |
p lrmoved (0,-ypart paired(d)) -- p urmoved (0,-ypart paired(d)) {up} .. | |
p urmoved (-xpart paired(d),0) -- p ulmoved (-xpart paired(d),0) {left} .. | |
p ulmoved (0,-ypart paired(d)) -- p llmoved (0,-ypart paired(d)) {down} .. cycle) | |
enddef ; | |
vardef punked primary p = | |
(point 0 of p for i=1 upto length(p)-1 : -- point i of p endfor | |
if cycle p : -- cycle else : -- point length(p) of p fi) | |
enddef ; | |
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% | |
% end of MetaFun macros | |
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% | |
% we input map symbol definitions | |
input thPoint; | |
input thLine; | |
input thArea; | |
input thText; | |
input thSpecial; | |
input uAUT; | |
input uSBE; | |
input thTrans; | |
nonstopmode; |