summaryrefslogtreecommitdiff
path: root/metapost/context/mp-core.mp
diff options
context:
space:
mode:
Diffstat (limited to 'metapost/context/mp-core.mp')
-rw-r--r--metapost/context/mp-core.mp232
1 files changed, 232 insertions, 0 deletions
diff --git a/metapost/context/mp-core.mp b/metapost/context/mp-core.mp
new file mode 100644
index 000000000..d4045d3da
--- /dev/null
+++ b/metapost/context/mp-core.mp
@@ -0,0 +1,232 @@
+%D \module
+%D [ file=mp-core.mp,
+%D version=1999.08.12,
+%D title=\CONTEXT\ \METAPOST\ graphics,
+%D subtitle=core interfacing,
+%D author=Hans Hagen,
+%D date=\currentdate,
+%D copyright={PRAGMA / Hans Hagen \& Ton Otten}]
+%C
+%C This module is part of the \CONTEXT\ macro||package and is
+%C therefore copyrighted by \PRAGMA. See licen-en.pdf for
+%C details.
+
+if unknown context_tool : input mp-tool ; fi ;
+if known context_core : endinput ; fi ;
+
+boolean context_core ; context_core := true ;
+
+pair lxy[], rxy[], cxy[], llxy[], lrxy[], ulxy[], urxy[] ;
+path pxy[] ;
+numeric hxy[], wxy[], dxy[], nxy[] ;
+
+def box_found (expr n,x,y,w,h,d) =
+ not ((x=0) and (y=0) and (w=0) and (h=0) and (d=0))
+enddef ;
+
+def initialize_box_pos (expr pos,n,x,y,w,h,d) =
+ pair lxy, rxy, cxy, llxy, lrxy, ulxy, urxy ;
+ path pxy ; numeric hxy, wxy, dxy, nxy;
+ lxy := (x,y) ; lxy[pos] := lxy ;
+ llxy := (x,y-d) ; llxy[pos] := llxy ;
+ lrxy := (x+w,y-d) ; lrxy[pos] := lrxy ;
+ urxy := (x+w,y+h) ; urxy[pos] := urxy ;
+ ulxy := (x,y+h) ; ulxy[pos] := ulxy ;
+ wxy := w ; wxy[pos] := wxy ;
+ hxy := h ; hxy[pos] := hxy ;
+ dxy := d ; dxy[pos] := dxy ;
+ rxy := lxy shifted (wxy,0) ; rxy[pos] := rxy ;
+ pxy := llxy--lrxy--urxy--ulxy--cycle ; pxy[pos] := pxy ;
+ cxy := center pxy ; cxy[pos] := cxy ;
+ nxy := n ; nxy[pos] := nxy ;
+enddef ;
+
+def initialize_box (expr n,x,y,w,h,d) =
+
+ numeric bpos ; bpos := 0 ; initialize_box_pos(bpos,n,x,y,w,h,d) ;
+
+enddef ;
+
+def initialize_area (expr fn,fx,fy,fw,fh,fd,
+ tn,tx,ty,tw,th,td) =
+
+ numeric fpos ; fpos := 1 ; initialize_box_pos(fpos,fn,fx,fy,fw,fh,fd) ;
+ numeric tpos ; tpos := 2 ; initialize_box_pos(tpos,tn,tx,ty,tw,th,td) ;
+
+ do_initialize_area (fpos, tpos) ;
+
+enddef ;
+
+def do_initialize_area (expr fpos, tpos) =
+ lxy := lxy[fpos] ;
+ llxy := (xpart llxy[fpos], ypart llxy[tpos]) ;
+ lrxy := lrxy[tpos] ;
+ urxy := (xpart urxy[tpos], ypart urxy[fpos]) ;
+ ulxy := ulxy[fpos] ;
+ wxy := xpart lrxy - xpart llxy ;
+ hxy := hxy[fpos] ;
+ dxy := dxy[tpos] ;
+ rxy := lxy shifted (wxy,0) ;
+ pxy := llxy--lrxy--urxy--ulxy--cycle ;
+ cxy := center pxy ;
+enddef ;
+
+def initialize_par (expr fn,fx,fy,fw,fh,fd, ln,lx,ly,lw,lh,ld,
+ rn,rx,ry,rw,rh,rd, tn,tx,ty,tw,th,td) =
+
+ numeric fpos ; fpos := 1 ; initialize_box_pos(fpos,fn,fx,fy,fw,fh,fd) ;
+ numeric lpos ; lpos := 3 ; initialize_box_pos(lpos,ln,lx,ly,lw,lh,ld) ;
+ numeric rpos ; rpos := 4 ; initialize_box_pos(rpos,rn,rx,ry,rw,rh,rd) ;
+ numeric tpos ; tpos := 2 ; initialize_box_pos(tpos,tn,tx,ty,tw,th,td) ;
+
+ do_initialize_area (fpos, tpos) ;
+ do_initialize_par (fpos, lpos, rpos, tpos) ;
+
+enddef ;
+
+def do_initialize_par (expr fpos, lpos, rpos, tpos) =
+
+ pair leftxy, righxy ; path txy, mxy, bxy ; % top mid bot
+
+ leftxy := if xpart ulxy[fpos] > xpart ulxy[lpos] : ulxy[fpos] else : ulxy[lpos] fi ;
+ righxy := if xpart urxy[tpos] < xpart urxy[rpos] : urxy[tpos] else : urxy[rpos] fi ;
+
+ pxy := origin ;
+
+ if (round(ypart llxy[fpos]) = round(ypart ulxy[tpos])) and
+ (round(xpart lrxy[tpos]) < round(xpart llxy[fpos])) :
+
+ txy := llxy[fpos] -- (xpart lrxy[rpos], ypart lrxy[fpos]) --
+ (xpart urxy[rpos], ypart urxy[fpos]) -- ulxy[fpos] -- cycle ;
+ mxy := origin ;
+ bxy := (xpart llxy[lpos], ypart llxy[tpos]) -- lrxy[tpos] --
+ urxy[tpos] -- (xpart ulxy[lpos], ypart ulxy[tpos]) -- cycle ;
+
+ elseif ypart llxy[fpos] = ypart llxy[tpos] :
+
+ txy := llxy[fpos] -- lrxy[tpos] -- urxy[tpos] -- ulxy[fpos] --cycle ;
+ mxy := origin ;
+ bxy := origin ;
+
+ else :
+
+ txy := (xpart lrxy[rpos], ypart lrxy[fpos]) --
+ (xpart urxy[rpos], ypart urxy[fpos]) --
+ ulxy[fpos] -- llxy[fpos] -- cycle ;
+ mxy := (xpart llxy[lpos], ypart ulxy[tpos]) --
+ (xpart llxy[rpos], ypart ulxy[tpos]) --
+ (xpart lrxy[rpos], ypart lrxy[fpos]) --
+ (xpart llxy[lpos], ypart llxy[fpos]) -- cycle ;
+ bxy := (xpart llxy[lpos], ypart llxy[tpos]) --
+ (xpart righxy, ypart lrxy[tpos]) --
+ (xpart righxy, ypart urxy[tpos]) --
+ (xpart llxy[lpos], ypart ulxy[tpos]) -- cycle ;
+
+ if (round(point 0 of bxy) = round(point 1 of bxy)) or
+ (round(point 0 of bxy) = round(point 2 of bxy)) :
+ bxy := origin ;
+ fi ;
+
+ if (round(point 0 of mxy) = round(point 1 of mxy)) or
+ (round(point 0 of mxy) = round(point 2 of mxy)) :
+ mxy := origin ;
+ fi ;
+
+ if (round(point 0 of txy) = round(point 1 of txy)) or
+ (round(point 0 of txy) = round(point 2 of txy)) :
+ txy := origin ;
+ fi ;
+
+ if (round (length(mxy)) > 1) :
+ if (round (length(txy)) < 2) :
+ if (round (length(bxy)) < 2) :
+ pxy := mxy ;
+ else :
+ pxy := point 0 of bxy -- point 1 of bxy -- point 2 of bxy --
+ point 1 of mxy -- point 2 of mxy -- point 3 of mxy --
+ cycle ;
+ fi ;
+ else :
+ if (round (length(bxy)) < 2) :
+ pxy := point 1 of mxy --
+ point 1 of txy -- point 2 of txy -- point 3 of txy --
+ point 3 of mxy -- point 0 of mxy --
+ cycle ;
+ else :
+ pxy := point 1 of mxy --
+ point 1 of txy -- point 2 of txy -- point 3 of txy --
+ point 3 of mxy --
+ point 0 of bxy -- point 1 of bxy -- point 2 of bxy --
+ cycle ;
+ fi ;
+ fi ;
+ fi ;
+
+ fi ;
+
+enddef ;
+
+color boxfillcolor ; boxfillcolor := .8white ;
+color boxlinecolor ; boxlinecolor := .8blue ;
+
+def draw_box =
+ pickup pencircle scaled .5 ;
+ draw pxy withcolor boxlinecolor ;
+ draw lxy -- rxy withcolor boxlinecolor ;
+% pickup pencircle scaled 1.5 ;
+% draw llxy withcolor green ;
+% draw lrxy withcolor green ;
+% draw urxy withcolor green ;
+% draw ulxy withcolor green ;
+% draw cxy withcolor red ;
+% pickup pencircle scaled 1 ;
+% draw lxy withcolor red ;
+% draw rxy withcolor red ;
+enddef ;
+
+def draw_par =
+ pickup pencircle scaled .5 ;
+ if length pxy > 1 :
+ fill pxy withcolor boxfillcolor ; draw pxy withcolor boxlinecolor ;
+ else :
+ draw_par_top ; draw_par_mid ; draw_par_bot ;
+ fi ;
+% pickup pencircle scaled 1.5 ;
+% draw llxy[lpos] withcolor red ;
+% draw llxy[rpos] withcolor red ;
+% draw llxy[tpos] withcolor green ;
+% draw llxy[fpos] withcolor green ;
+enddef ;
+
+def draw_par_top =
+ pickup pencircle scaled .5 ;
+ if length txy > 1 :
+ fill txy withcolor boxfillcolor ; draw txy withcolor boxlinecolor ;
+ fi ;
+enddef ;
+
+def draw_par_mid =
+ pickup pencircle scaled .5 ;
+ if length mxy > 1 :
+ fill mxy withcolor boxfillcolor ; draw mxy withcolor boxlinecolor ;
+ fi ;
+enddef ;
+
+def draw_par_bot =
+ pickup pencircle scaled .5 ;
+ if length bxy > 1 :
+ fill bxy withcolor boxfillcolor ; draw bxy withcolor boxlinecolor ;
+ fi ;
+enddef ;
+
+def anchor_box (expr n,x,y,w,h,d) =
+% bboxmargin := 0 ;
+% setbounds currentpicture to unitsquare shifted (x,y) ;
+ currentpicture := currentpicture shifted (-x,-y) ;
+enddef ;
+
+let draw_area = draw_box ;
+let anchor_area = anchor_box ;
+let anchor_par = anchor_box ;
+
+endinput ;