%D \module
%D   [       file=spac-grd,
%D        version=2009.10.16, % 1998.03.10, was core-grd.tex
%D          title=\CONTEXT\ Spacing Macros,
%D       subtitle=Grid Snapping,
%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 mreadme.pdf for
%C details.

%D This module will be merged into spac-ver.mkiv.

\writestatus{loading}{ConTeXt Spacing Macros / Grid Snapping}

\unprotect

%D A rather crappy macro that we need to avoid and as such it will probably
%D disappear:

\installcorenamespace{lastnodepusher}

\permanent\let\poplastnode\relax

\permanent\protected\def\pushlastnode
  {\csname\??lastnodepusher
     \ifcsname\??lastnodepusher\the\lastnodetype\endcsname
       \the\lastnodetype
     \else
       \s!unknown
     \fi
   \endcsname}

\defcsname\??lastnodepusher\the\kernnodecode\endcsname
  {\enforced\permanent\protected\edef\poplastnode{\kern\the\lastkern\relax}%
   \kern-\lastkern}

\defcsname\??lastnodepusher\the\gluenodecode\endcsname
  {\enforced\permanent\protected\edef\poplastnode{\vskip\the\lastskip\relax}%
   \vskip-\lastskip}

\defcsname\??lastnodepusher\the\penaltynodecode\endcsname
  {\enforced\permanent\protected\edef\poplastnode{\penalty\the\lastpenalty\relax}%
   \nobreak}

\defcsname\??lastnodepusher\s!unknown\endcsname
  {\enforced\permanent\let\poplastnode\relax}

%D Moved from supp-box:

%D \macros
%D  {startbaselinecorrection,baselinecorrection,
%D   showbaselinecorrection,offbaselinecorrection}
%D
%D Spacing around ruled boxes can get pretty messed up. The
%D next macro tries as good as possible to fix this.
%D
%D \startbuffer[1]
%D \startbaselinecorrection
%D \ruledhbox{Rule Brittanica}
%D \stopbaselinecorrection
%D \stopbuffer
%D
%D \typebuffer[1]
%D
%D The macros put some white space around the box:
%D
%D \getbuffer[1]
%D
%D A simple alternative is \type {\baselinecorrection}, which
%D only looks at the previous line.
%D
%D \startbuffer[2]
%D \baselinecorrection
%D \ruledhbox{Rule Brittanica}
%D \baselinecorrection
%D \stopbuffer
%D
%D \typebuffer[2]
%D
%D This time the last preceding line gets a correction,%
%D dependant on the depth.
%D
%D \getbuffer[2]
%D
%D One can make the correction visible by saying \type
%D {\showbaselinecorrection}. Part of the correction is
%D calculated from the dimensions of a~(. One can disble the
%D correction by calling \type {\offbaselinecorrection}.
%D
%D When visualize the first example looks like:
%D
%D {\showbaselinecorrection\getbuffer[1]}
%D
%D and the second one comes out as:
%D
%D {\showbaselinecorrection\getbuffer[2]}

% \definecolor[GridLineColor][red]
% \definecolor[GridTextColor][blue]

\newdimension\d_spac_lines_correction_before
\newdimension\d_spac_lines_correction_after

\newbox      \b_spac_lines_correction_before
\newbox      \b_spac_lines_correction_after

\def\spac_lines_initialize_corrections
  {\setbox\b_spac_lines_correction_before\hpack{\setstrut\strut}%
   \setbox\b_spac_lines_correction_after \hbox {(}%
   \d_spac_lines_correction_before{\ht\b_spac_lines_correction_before-\ht\b_spac_lines_correction_after}%
   \d_spac_lines_correction_after {\dp\b_spac_lines_correction_before-\dp\b_spac_lines_correction_after}%
   \ifdim\d_spac_lines_correction_before<\zeropoint\d_spac_lines_correction_before\zeropoint\fi
   \ifdim\d_spac_lines_correction_after <\zeropoint\d_spac_lines_correction_after \zeropoint\fi}

% experiment, todo: proper mkiv mechanism
%
% \input ward \par
% \startframedtext test  \stopframedtext
% \input ward \par
% \startlinecorrection \framed{xxx} \stoplinecorrection
% \input ward \par
%
% \setupwhitespace[big]
%
% \input ward \par
% \startframedtext test  \stopframedtext
% \input ward \par
% \startlinecorrection \framed{xxx} \stoplinecorrection
% \input ward \par

% to be redone:

\permanent\protected\def\dotopbaselinecorrection{\expandafter\blank\expandafter[\the\d_spac_lines_correction_before]}
\permanent\protected\def\dobotbaselinecorrection{\expandafter\blank\expandafter[\the\d_spac_lines_correction_after ]}

\permanent\def\showbaselinecorrection
  {\enforced\permanent\protected\def\dobaselinecorrection % visualization is not watertight!
     {\bgroup
      \ifdim\prevdepth>\zeropoint
        \kern-\prevdepth
      \fi
      \setbox\scratchbox\emptyhbox
      \wd\scratchbox\hsize
      \dp\scratchbox\strutdp
      \nointerlineskip
      \forgetall
      \ruledvpack{\box\scratchbox}%
      \egroup
      \prevdepth\strutdp}%
   \enforced\permanent\protected\def\dotopbaselinecorrection{\hrule\s!height\d_spac_lines_correction_before}%
   \enforced\permanent\protected\def\dobotbaselinecorrection{\hrule\s!height\d_spac_lines_correction_after }}

% \def\dobaselinecorrection % beware, this one is redefined below
%   {\ifdim\prevdepth>\zeropoint\kern-\prevdepth\fi
%    \kern\strutdp
%    \prevdepth\strutdp}

\permanent\protected\def\baselinecorrection
  {\endgraf
   \ifvmode
     \ifdim\prevdepth<\maxdimen
       \ifdim\prevdepth<\zeropoint \else
         \ifdim\prevdepth<\strutdepth \relax
           \pushlastnode
           \dobaselinecorrection
           \poplastnode
         \fi
       \fi
     \fi
   \fi}

\permanent\protected\def\pagebaselinecorrection
  {\ifdim\pagegoal<\maxdimen
     \ifdim\pagetotal>\lineheight % or \topskip
       \scratchdimen\pagetotal
       \advanceby\scratchdimen\lineheight
       \ifdim\scratchdimen<\pagegoal
         \baselinecorrection
       \fi
     \fi
   \fi}

\permanent\protected\def\startbaselinecorrection
  {\bgroup
   \enforced\let\stopbaselinecorrection\egroup
   \ifcase\baselinecorrectionmode
   \or % normal
     \baselinecorrection
     \ifvmode
       \setbox\scratchbox\vbox\bgroup\ignorespaces
       \enforced\let\stopbaselinecorrection\donormalstopbaselinecorrection
     \fi
   \or % off
   \or % force
     \baselinecorrection
     \ifvmode
       \setbox\scratchbox\vbox\bgroup\ignorespaces
       \enforced\let\stopbaselinecorrection\doforcedstopbaselinecorrection
     \fi
   \fi}

\permanent\let\stopbaselinecorrection\relax

\permanent\protected\def\donormalstopbaselinecorrection % I have to check columns yet.
  {\egroup
   \topbaselinecorrection
   \box\scratchbox
   \botbaselinecorrection
   \egroup}

\permanent\protected\def\doforcedstopbaselinecorrection % I have to check columns yet.
  {\egroup
   \forcedtopbaselinecorrection
   \box\scratchbox
   \forcedbotbaselinecorrection
   \egroup}

%D We do a bit more checking than needed. The pageborder check
%D is not needed, but I want to look the visualization as good
%D as possible too.

\setnewconstant\baselinecorrectionmode\plusone

\permanent\protected\def\onbaselinecorrection   {\baselinecorrectionmode\plusone  }
\permanent\protected\def\offbaselinecorrection  {\baselinecorrectionmode\plustwo  }
\permanent\protected\def\forcebaselinecorrection{\baselinecorrectionmode\plusthree}

%D \macros
%D  {topbaselinecorrection,botbaselinecorrection}
%D
%D The actual top and bottom corrections are implemented as:

\permanent\protected\def\topbaselinecorrection
  {\ifvmode \ifdim\pagegoal<\maxdimen
     \forcedtopbaselinecorrection
   \fi \fi}

% \permanent\protected\def\forcedtopbaselinecorrection
%   {\ifvmode
%      \bgroup
%      \spac_lines_initialize_corrections
%      \whitespace % no longer ok
%      \nointerlineskip
%      \dotopbaselinecorrection
%      \egroup
%    \fi}

\permanent\protected\def\botbaselinecorrection
  {\ifvmode
     \bgroup
     \spac_lines_initialize_corrections
     \dobotbaselinecorrection
     \allowbreak % new, otherwise problems when many in a row
     \prevdepth\strutdp
     \egroup
   \fi}

% nointerlineskip
%
% startpacked
%     \startlinecorrection \framed{test} \stoplinecorrection
%     \startlinecorrection \framed{test} \stoplinecorrection
% \stoppacked

\permanent\protected\def\forcedtopbaselinecorrection
  {\ifvmode
     \bgroup
     \spac_lines_initialize_corrections
     \vspacing[\v!white]
    %\nointerlineskip %
     \dotopbaselinecorrection
     \egroup
  \fi}

\aliased\let\forcedbotbaselinecorrection\botbaselinecorrection

\permanent\protected\def\dobaselinecorrection
  {\ifdim\prevdepth>\zeropoint
     \vspacing[\todimension{-\prevdepth+\strutdp}]%
   \else
     \vspacing[\the\strutdp]%
   \fi
   \prevdepth\strutdp}

% \permanent\protected\def\dobaselinecorrection
%   {\scratchdimen\dimexpr\ifdim\prevdepth>\zeropoint-\prevdepth+\fi\strutdp\relax
%    \vspacing[\the\scratchdimen]%
%    \prevdepth\strutdp}
%
% some day:
%
% \permanent\protected\def\dobaselinecorrection
%   {\clf_checkstrutdepth\strutdp}
%
% \permanent\protected\def\baselinecorrection
%   {\endgraf
%    \ifvmode
%      \ifdim\prevdepth<\maxdimen
%        \ifdim\prevdepth<\zeropoint \else
%          \ifdim\prevdepth<\strutdepth \relax
%            % works in mvl:
%            % \forcestrutdepth
%            % doesn't work immediately (unless enforced with penalty):
%            % \pushlastnode
%            % \dobaselinecorrection
%            % \poplastnode
%            % works ok:
%              \clf_checkstrutdepth\strutdp
%          \fi
%        \fi
%      \fi
%    \fi}

%D For the moment only with placefloats (should work in mvl and boxes):

\permanent\protected\def\checkprevdepth
  {\endgraf
   \ifvmode
     \ifdim\prevdepth<\maxdimen
       \ifdim\prevdepth<\zeropoint \else
         \ifdim\prevdepth<\strutdepth \relax
           \clf_checkstrutdepth\strutdp
         \fi
       \fi
     \fi
   \fi}

\aliased\let\normalstartbaselinecorrection\startbaselinecorrection

\pushoverloadmode

\permanent\protected\def\startbaselinecorrection
  {\ifgridlinesnapping
     \snaptogridline[\v!normal]\vbox\bgroup
     \enforced\let\stopbaselinecorrection\egroup
   \orelse\ifgridsnapping
     \snaptogrid[\v!normal]\vbox\bgroup
     \enforced\let\stopbaselinecorrection\egroup
   \else
     \normalstartbaselinecorrection
   \fi}

\popoverloadmode

%D Experimental code:

\appendtoks
    \linesnapping \zerocount
\to \everyforgetall

\newtoks \everysynchronizesnapping

\permanent\protected\def\updatelinesnapping
  {\linesnappinghtfactor\numericscale\strutheightfactor\relax
   \linesnappingdpfactor\numericscale\strutdepthfactor \relax
   \expand\everysynchronizesnapping}

\permanent \specificationdef \linesnappingnone \linesnapping \zerocount

\specificationdef \linesnappingzero \linesnapping \plusone \s!factors \s!global \s!constant
    \s!step        \zerocount
    \s!height      \plusthousand
    \s!depth       \plusthousand
\relax
\specificationdef \linesnappingone \linesnapping \plusone \s!factors \s!global \s!constant
    \s!step        \plusone
    \s!height      \plusthousand
    \s!depth       \plusthousand
\relax
\specificationdef \linesnappingtwo \linesnapping \plusone \s!factors \s!global \s!constant
    \s!step        \plustwo
    \s!height      \plusthousand
    \s!depth       \plusthousand
\relax

\specificationdef \linesnappingzeroten \linesnapping \plusone \s!factors \s!global \s!constant
    \s!step        \zerocount
    \s!height      \plusthousand
    \s!depth       \plusthousand
    \s!httolerance \plushundred % 10 percent
    \s!dptolerance \plushundred % 10 percent
\relax
\specificationdef \linesnappingoneten \linesnapping \plusone \s!factors \s!global \s!constant
    \s!step        \plusone
    \s!height      \plusthousand
    \s!depth       \plusthousand
    \s!httolerance \plushundred % 10 percent
    \s!dptolerance \plushundred % 10 percent
\relax
\specificationdef \linesnappingtwoten \linesnapping \plusone \s!factors \s!global \s!constant
    \s!step        \plustwo
    \s!height      \plusthousand
    \s!depth       \plusthousand
    \s!httolerance \plushundred % 10 percent
    \s!dptolerance \plushundred % 10 percent
\relax
\specificationdef \linesnappingtwotwenty \linesnapping \plusone \s!factors \s!global \s!constant
    \s!step        \plustwo
    \s!height      \plusthousand
    \s!depth       \plusthousand
    \s!httolerance \plustwohundred % 20 percent
    \s!dptolerance \plustwohundred % 20 percent
\relax

\specificationdef \linesnappingonetop \linesnapping \plusone \s!factors \s!global \s!constant
    \s!step   \plusone
    \s!height \plusthousand
    \s!depth  \plusthousand
    \s!top
\relax
\specificationdef \linesnappingonebottom \linesnapping \plusone \s!factors \s!global \s!constant
    \s!step   \plusone
    \s!height \plusthousand
    \s!depth  \plusthousand
    \s!bottom
\relax

\specificationdef \linesnappingtwobottom \linesnapping \plusone \s!factors \s!global \s!constant
    \s!step   \plustwo
    \s!height \plusthousand
    \s!depth  \plusthousand
    \s!bottom
\relax
\specificationdef \linesnappingtwotop \linesnapping \plusone \s!factors \s!global \s!constant
    \s!step   \plustwo
    \s!height \plusthousand
    \s!depth  \plusthousand
    \s!top
\relax

\appendtoks
    \updatelinesnapping
\to \everydump

%installaligncommand{\v!nosnapping}{\linesnapping\zerocount}
\installaligncommand{\v!snapping}  {\linesnappingone}

\installcorenamespace {snapping}

\permanent\protected\def\installsnapping#1#2%
  {\ifparameter#2\or
     \instance\protected\defcsname\??snapping#1\endcsname{#2}%
     \installaligncommand{\v!snapping:#1}{#2}%
   \fi}

% \permanent\protected\def\douseinstalledsnapping#1%
%   {\ifcsname\??snapping#1\endcsname
%      \lastnamedcs
%    \orelse\ifgridlinesnapping
%      % use the default
%    \else
%      \linesnappingone
%    \fi}


\permanent\protected\def\douseinstalledsnapping#1%
  {\ifcsname\??snapping#1\endcsname
     \lastnamedcs
   \orelse\ifempty{#1}%
     \ifcsname\??snapping\currentlayoutsnapping\endcsname
       \lastnamedcs
     \else
        % use the default
        \linesnappingone
     \fi
   \else
     \linesnappingone
   \fi}

% We have \quote {yes} as well as \quote {normal} because the regular one has that
% too.

\installsnapping{\v!yes}     {\linesnappingone}
\installsnapping{\v!normal}  {\linesnappingone}

\installsnapping{0}          {\linesnappingzero}
\installsnapping{1}          {\linesnappingone}
\installsnapping{2}          {\linesnappingtwo}

\installsnapping{0:10}       {\linesnappingzeroten}
\installsnapping{1:10}       {\linesnappingoneten}
\installsnapping{2:10}       {\linesnappingtwoten}

\installsnapping{2:20}       {\linesnappingtwotwenty}

\installsnapping{1:\v!top}   {\linesnappingonetop}
\installsnapping{1:\v!bottom}{\linesnappingonebottom}

\installsnapping{2:\v!top}   {\linesnappingtwotop}
\installsnapping{2:\v!bottom}{\linesnappingtwobottom}

% \installsnapping{\v!math:\v!line}    {\linesnappingone}
% \installsnapping{\v!math:\v!halfline}{\linesnappingtwo}

% \startnarrower
%     \showmakeup[line]
%     \setupalign[snapping]
%     \samplefile{tufte}
%     \im{x^{x^2}}
%     \samplefile{tufte}
% \stopnarrower
% \page
% \startnarrower
%     \showmakeup[line]
%     \setupalign[snapping:1]
%     \samplefile{tufte}
%     \im{x^{x^2}}
%     \samplefile{tufte}
% \stopnarrower
% \page
% \startnarrower
%     \showmakeup[line]
%     \setupalign[snapping:2]
%     \samplefile{tufte}
%     \im{x^{x^2}}
%     \samplefile{tufte}
% \stopnarrower
% \page
% \startnarrower
%     \showmakeup[line]
%     \setupalign[snapping:2:10]
%     \samplefile{tufte}
%     \im{x^{x^2}}
%     \samplefile{tufte}
% \stopnarrower

\permanent\protected\def\resetgridlinesnapping
  {\gridlinesnappingfalse
   \linesnapping\zerocount}

\lettonothing\currentlayoutsnapping

\permanent\protected\def\synchronizegridsnapping
  {\edef\p_grid{\rootlayoutparameter\c!grid}%
   \gridsnappingfalse
   \gridlinesnappingfalse
   \resetsystemmode\v!grid
   \resetsystemmode\v!snapping
   \lettonothing\currentlayoutsnapping
   \linesnapping\zerocount
   \spac_grids_snap_value_reset
   \ifx\p_grid\v!no
     % already done
   \orelse\ifx\p_grid\v!snapping
     \checkbodyfontstate
     \gridlinesnappingtrue
     \setsystemmode\v!snapping
     \cdef\currentlayoutsnapping{\rootlayoutparameter\c!snapping}%
     % don't use align here as we don't want to cache
     \ifcsname\??snapping\currentlayoutsnapping\endcsname
        \lastnamedcs
     \fi
   \orelse\ifcsname\??gridsnappers\p_grid\endcsname
     \checkbodyfontstate
     \gridsnappingtrue
     \setsystemmode\v!grid
     \spac_grids_snap_value_set\p_grid
   \fi}

% This is a new one, only for snapping (and tests):

\permanent\tolerant\protected\def\startgridlinesnapping[#1]%
  {\snaptogridline[#1]\vbox\bgroup}

\permanent\protected\def\stopgridlinesnapping
  {\egroup}

\permanent\tolerant\protected\def\placeongridline[#1]%
  {\snaptogridline[#1]\vbox} % mark as done

\permanent\tolerant\protected\def\snaptogridline[#1]%
  {\ifgridlinesnapping
     \expandafter\spac_grids_snap_to_line_indeed
   \orelse\ifgridsnapping
     \expandafter\gobbleoneargument
   \else
     \expandafter\gobbleoneargument
   \fi{#1}}

\def\spac_grids_snap_to_line_indeed#1%
  {\bgroup
   \dowithnextbox{\spac_grids_snap_to_line_finish{#1}}}

\def\spac_grids_snap_to_line_finish#1%
  {\douseinstalledsnapping{#1}%
  %\ifempty\linesnapping\else
   \ifspecification\linesnapping
      \boxsnapping\nextbox\linesnapping
   \fi
 % \ifvmode
 %   \nointerlineskip
 %   \dontleavehmode
 %   \box\nextbox
 %   \par
 % \else
     \box\nextbox
 % \fi
   \egroup}

\permanent\protected\def\applygridlinemethod#1#2%
  {\begingroup
  %\dousealignparameter{\v!snapping:\ifempty{#1}\currentlayoutsnapping\else#1\fi}%
   \douseinstalledsnapping{#1}%
  %\ifempty\linesnapping\else
   \ifspecification\linesnapping
     \boxsnapping#2\linesnapping
   \fi
 % \par     % used in display heads so we can force thsi for the next
 % \ifvmode % safeguard ... in old school grid mode we zero the lineskips
 %   \nointerlineskip
 %   \dontleavehmode
 %    \box#2%
 %   \par
 % \else
     \box#2%
 % \fi
   \endgroup}

\protect \endinput
