%D \module
%D   [       file=mp-grph.mpiv,
%D        version=2000.12.14,
%D          title=\CONTEXT\ \METAPOST\ graphics,
%D       subtitle=graphic text support,
%D         author=Hans Hagen,
%D           date=\currentdate,
%D      copyright={PRAGMA ADE \& \CONTEXT\ Development Team}]
%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.

%D Under construction.

if known context_grph : endinput ; fi ;

boolean context_grph ; context_grph := true ;

picture _currentpicture_ ;

numeric _fig_nesting_ ; _fig_nesting_ := 0 ;

def beginfig (expr c) =
    _fig_nesting_ := _fig_nesting_ + 1 ;
    if _fig_nesting_ = 1 :
        begingroup
        charcode := c ;
        resetfig ;
        scantokens extra_beginfig ;
    fi ;
enddef ;

def endfig =
    ; % safeguard
    if _fig_nesting_ = 1 :
        scantokens extra_endfig ;
        shipit ;
        endgroup ;
    fi ;
    _fig_nesting_ := _fig_nesting_ - 1 ;
enddef;

def resetfig =
    clearxy ;
    clearit ;
    clearpen ;
    pickup defaultpen ;
    interim linecap := linecap ;
    interim linejoin := linejoin ;
    interim miterlimit := miterlimit ;
    save _background_ ; color _background_ ; _background_ :=  background  ;
    save  background  ; color  background  ;  background  := _background_ ;
    drawoptions () ;
enddef ;

def protectgraphicmacros =
    save showtext ;
    save beginfig ; let beginfig = begingraphictextfig ;
    save endfig   ; let endfig   = endgraphictextfig ;
    save end      ; let end      = relax ;
    interim prologues := prologues ;
    resetfig ; % resets currentpicture
enddef ;

numeric currentgraphictext ; currentgraphictext := 0 ;

def data_mpy_file = job_name & "-mpgraph.mpy" enddef ;

def begingraphictextfig (expr n) =
    foundpicture := n ;
    scratchpicture := nullpicture ;
enddef ;

def endgraphictextfig =
    if foundpicture = currentgraphictext :
        expandafter endinput
    else :
        scratchpicture := nullpicture ;
    fi ;
enddef ;

def loadfigure primary filename =
    mfun_load_figure(filename)
enddef ;

def mfun_load_figure (expr filename) text figureattributes =
    begingroup ;
    save figurenumber, figurepicture, number, fixedplace ;
    numeric figurenumber  ; figurenumber := 0 ;
    boolean figureshift ; figureshift := true ;
    picture figurepicture ; figurepicture := currentpicture ;
    def number primary n = hide(figurenumber := n) enddef ;
    def fixedplace = hide(figureshift := false) enddef ;
    protectgraphicmacros ;
    % defaults
    interim linecap    := rounded ;
    interim linejoin   := rounded ;
    interim miterlimit := 10 ;
    %
    currentpicture := nullpicture ;
    draw fullcircle figureattributes ; % expand number
    currentpicture := nullpicture ;
    def beginfig (expr n) =
        currentpicture := nullpicture ;
        if (figurenumber=n) or (figurenumber=0) :
            let endfig = endinput ;
        fi ;
    enddef ;
    let endfig = relax ;
    readfile(filename) ;
    if figureshift :
        currentpicture := currentpicture shifted -llcorner currentpicture ;
    fi ;
    addto figurepicture also currentpicture figureattributes ;
    currentpicture := figurepicture  ;
    endgroup ;
enddef ;

% shared between old and new

boolean mfun_gt_color_fill ;
boolean mfun_gt_color_draw ;
boolean mfun_gt_shade_fill ;
boolean mfun_gt_reverse_fill ;
boolean mfun_gt_outline_fill ;
picture mfun_gt_picture ;

% this is the old version:

def old_graphictext primary t =
    hide (
        if mfun_trial_run :
            let mfun_graphic_text = mfun_no_graphic_text ;
        else :
            let mfun_graphic_text = mfun_do_graphic_text ;
        fi
    )
    mfun_graphic_text(t)
enddef ;

def mfun_do_graphic_text (expr t) =
    % withprescript "gt_stage=final"
    begingroup ;
    save figurepicture ; picture figurepicture ;
    figurepicture := currentpicture ; currentpicture := nullpicture ;
    currentgraphictext := currentgraphictext + 1 ;
    mfun_finish_graphic_text % picks up directives
enddef ;

def mfun_no_graphic_text (expr t) text rest =
    currentgraphictext := currentgraphictext + 1 ;
    draw unitsquare
        withprescript "gt_stage=trial"
        withprescript "gt_index=" & decimal currentgraphictext
        withpostscript t
enddef ;

def mfun_finish_graphic_text text rest =
    protectgraphicmacros ; % resets currentpicture
    interim linecap    := butt ;     % normally rounded
    interim linejoin   := mitered ;  % normally rounded
    interim miterlimit := 10 ;       % todo
    let normalwithshade = withshade ;
    save foundpicture, scratchpicture, str ;
    save fill, draw, withshade, reversefill, outlinefill ;
    save withfillcolor, withdrawcolor ; % quite important
    numeric foundpicture ; picture scratchpicture ; string str ;
    def draw expr p =
        % the first, naive implementation was:
        %   addto scratchpicture doublepath p withpen currentpen ;
        % but it is better to turn lines into fills
        addto scratchpicture contour boundingbox
            image (addto currentpicture doublepath p withpen currentpen) ;
    enddef ;
    def fill expr p =
        addto scratchpicture contour p withpen currentpen ;
    enddef ;
    def mfun_gt_fill  = enddef ; boolean mfun_gt_color_fill ; mfun_gt_color_fill := false ;
    def mfun_gt_draw  = enddef ; boolean mfun_gt_color_draw ; mfun_gt_color_draw := false ;
    def mfun_gt_shade = enddef ; boolean mfun_gt_shade_fill ; mfun_gt_shade_fill := false ;
    boolean mfun_gt_reverse_fill ; mfun_gt_reverse_fill := false ;
    boolean mfun_gt_outline_fill ; mfun_gt_outline_fill := false ;
    def reversefill =
        hide(mfun_gt_reverse_fill := true )
    enddef ;
    def outlinefill =
        hide(mfun_gt_outline_fill := true )
    enddef ;
    def withshade primary c =
        hide(def mfun_gt_shade = normalwithshade c enddef ; mfun_gt_shade_fill := true )
    enddef ;
    def withfillcolor primary c =
        hide(def mfun_gt_fill = withcolor c enddef ; mfun_gt_color_fill := true )
    enddef ;
    def withdrawcolor primary c =
        hide(def mfun_gt_draw = withcolor c enddef ; mfun_gt_color_draw := true )
    enddef ;
    scratchpicture := nullpicture ;
    addto scratchpicture doublepath origin rest ; % pre-roll
    for i within scratchpicture : % Below here is a dirty tricky test!
        if (urcorner dashpart i) = origin :
            mfun_gt_outline_fill := false ;
        fi ;
    endfor ;
    scratchpicture := nullpicture ;
    readfile(data_mpy_file) ;
    scratchpicture := (scratchpicture shifted -llcorner scratchpicture) scaled (1/10) ;
    if not mfun_gt_color_draw and not mfun_gt_color_fill :
        mfun_gt_color_draw := true ;
    fi
    if mfun_gt_shade_fill :
        mfun_gt_color_draw := false ;
        mfun_gt_color_fill := false ;
    fi ;
    currentpicture := figurepicture ;
    if mfun_gt_shade_fill :
        for i within scratchpicture :
            if filled i :
                addto currentpicture contour pathpart i _op_ rest mfun_gt_shade ;
            fi ;
        endfor ;
    else :
        if mfun_gt_color_draw and not mfun_gt_reverse_fill :
            for i within scratchpicture :
                if mfun_gt_color_fill and mfun_gt_outline_fill :
                    addto currentpicture doublepath pathpart i _op_ rest mfun_gt_fill dashed nullpicture ;
                fi ;
                if filled i :
                    addto currentpicture doublepath pathpart i _op_ rest mfun_gt_draw ;
                fi ;
            endfor ;
        fi ;
        if mfun_gt_color_fill :
            for i within scratchpicture :
                if filled i :
                    addto currentpicture contour pathpart i _op_ rest mfun_gt_fill withpen pencircle scaled 0 ;
                fi ;
            endfor ;
        fi ;
        if mfun_gt_color_draw and mfun_gt_reverse_fill :
            for i within scratchpicture :
                if filled i :
                    addto currentpicture doublepath pathpart i _op_ rest mfun_gt_draw ;
                fi ;
            endfor ;
        fi ;
        for i within scratchpicture :
            if stroked i :
                addto currentpicture doublepath pathpart i _op_ rest mfun_gt_draw ;
            fi ;
        endfor ;
    fi ;
    endgroup ;
enddef ;

% and this is the new one:

% boolean mfun_gt_color_fill ;
% boolean mfun_gt_color_draw ;
% boolean mfun_gt_shade_fill ;
% boolean mfun_gt_reverse_fill ;
% picture mfun_gt_picture ;

def mfun_gt_default = % somewhat compatible
    scaled 11.5
    withpen pencircle scaled .1
enddef ;

def new_graphictext primary t = % use outlinetext instead
    begingroup ;
    mfun_graphic_text_indeed(t)
enddef ;

def mfun_graphic_text_indeed(expr t) text rest =
    interim linecap    := butt ;     % normally rounded
    interim linejoin   := mitered ;  % normally rounded
  % interim miterlimit := 10 ;       % todo
    %
    let normalwithshade = withshade ;
    %
    save reversefill, outlinefill, withshade, withfillcolor, withdrawcolor ;
    %
    def mfun_gt_fill  = enddef ;
    def mfun_gt_draw  = enddef ;
    def mfun_gt_shade = enddef ;
    %
    mfun_gt_color_fill   := false ;
    mfun_gt_color_draw   := false ;
    mfun_gt_shade_fill   := false ;
    mfun_gt_reverse_fill := false ;
    %
    def reversefill = hide(mfun_gt_reverse_fill := true) enddef ;
    def outlinefill = enddef ;
    def withshade     primary c = hide(mfun_gt_shade_fill := true; def mfun_gt_shade = normalwithshade c enddef ;) enddef ;
    def withfillcolor primary c = hide(mfun_gt_color_fill := true; def mfun_gt_fill  = withcolor c       enddef ;) enddef ;
    def withdrawcolor primary c = hide(mfun_gt_color_draw := true; def mfun_gt_draw  = withcolor c       enddef ;) enddef ;
    %
    mfun_gt_picture := nullpicture ;
    addto mfun_gt_picture doublepath origin rest ; % preroll
    mfun_gt_picture := nullpicture ;
    %
    def reversefill = enddef ;
    def outlinefill = enddef ;
    def withshade     primary c = enddef ;
    def withfillcolor primary c = enddef ;
    def withdrawcolor primary c = enddef ;
    %
    if mfun_gt_shade_fill :
        draw outlinetext.f(t)(mfun_gt_shade) rest;
    elseif mfun_gt_color_fill and mfun_gt_color_draw :
        if mfun_gt_reverse_fill :
            draw outlinetext.r(t)(mfun_gt_default mfun_gt_fill rest)(mfun_gt_default mfun_gt_draw rest) ;
        else :
            draw outlinetext.b(t)(mfun_gt_default mfun_gt_draw rest)(mfun_gt_default mfun_gt_fill rest);
        fi ;
    elseif mfun_gt_color_fill :
        draw outlinetext.f(t)(mfun_gt_default mfun_gt_fill rest) ;
    elseif mfun_gt_color_draw :
        draw outlinetext.d(t)(mfun_gt_default mfun_gt_draw rest) ;
    else :
        draw outlinetext.d(t)(mfun_gt_default rest) ;
    fi ;
    %
    endgroup ;
enddef ;

let graphictext = old_graphictext ;
%%% graphictext = new_graphictext ; % more than 10 times faster

% example
%
% beginfig (1) ;
%     graphictext
%         "\vbox{\hsize10cm \input tufte }"
%         scaled 8
%         withdrawcolor blue
%         withfillcolor red
%         withpen pencircle scaled 2pt ;
% endfig ;
%
% beginfig(1) ;
%       loadfigure "gracht.mp" rotated 20 ;
%       loadfigure "koe.mp" number 1 scaled 2 ;
% endfig ;
%
% end