%D \module
%D   [       file=mp-spec.mp,
%D        version=1999.6.26,
%D          title=PRAGMA graphics,
%D       subtitle=\METAPOST\ Special Extensions,
%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. 

%D This module is rather preliminary and subjected to 
%D changes. Here we closely cooperates with the \METAPOST\ 
%D to \PDF\ converter module built in \CONTEXT\ and provides 
%D for instance shading. More information can be found in 
%D type {supp-mpe.tex}. 

if not known context_basics : input mp-tool ; fi ; 
if     known flush_shade    : endinput      ; fi ; 

let normalfill     = fill ; 
let normalfilldraw = filldraw ;  

numeric _special_counter_ ; _special_counter_ := 1 ; % !! before fill 
boolean _inline_shading_ ; _inline_shading_ = false ; 

def fill = 
  _special_counter_ := _special_counter_ + 1 ; normalfill  
enddef;

def filldraw =
  _special_counter_ := _special_counter_ + 1 ; normalfilldraw  
enddef;

def signal_shading = 
  special "%%MetaPostSpecial: 0" ; % flush before bbox 
  let signal_shading = relax ; 
enddef ; 

def flush_shade (expr typ, siz, dat) = 
  if _inline_shading_ : 
    signal_shading ;
    extra_endfig := extra_endfig
      & "special "
      & "(" & ditto
      & dat & " " 
      & decimal _special_counter_ & " " 
      & decimal typ & " " 
      & decimal siz 
      & " special" 
      & ditto & ");" ;
  else :
    special 
      "%%MetaPostSpecial: " & 
      decimal siz & " " & 
      dat & " " & 
      decimal _special_counter_ & " " & 
      decimal typ ;
  fi ; 
enddef ; 

def linear_shade (expr p, n, ca, cb) = 
  begingroup ; 
  save q, r ; 
  pair q, r  ; 
  if     (n=1) : q := llcorner p ; r := urcorner p ; 
  elseif (n=2) : q := llcorner p ; r := ulcorner p ; 
  elseif (n=3) : q := lrcorner p ; r := ulcorner p ; 
  else         : q := llcorner p ; r := lrcorner p ; 
  fi ; 
  flush_shade(2, 15, "0 1 1" & 
    dddecimal ca & ddecimal q & 
    dddecimal cb & ddecimal r) ; 
  fill p ;
  endgroup ; 
enddef ;  

def circular_shade (expr p, n, ca, cb) = 
  begingroup ; 
  save q, r ; 
  pair q ; 
  numeric r ; 
  r := (xpart lrcorner p - xpart llcorner p) ++ 
       (ypart urcorner p - ypart lrcorner p) ; 
  if     (n=1) : q := llcorner p ; 
  elseif (n=2) : q := lrcorner p ; 
  elseif (n=3) : q := urcorner p ; 
  elseif (n=4) : q := ulcorner p ; 
  else         : q := center p ; r := .5r ; 
  fi ; 
  flush_shade(3, 17, "0 1 1" & 
    dddecimal ca & ddecimal q & " 0" &
    dddecimal cb & ddecimal q & " " & decimal r ) ;
  fill p ;
  endgroup ; 
enddef ;  
