Paste: Bresenham's algorithm

USING: accessors continuations kernel locals make math ;
IN: bresenham

TUPLE: point x y ;
C: <point> point

TUPLE: bresenham-state
{ p point }
{ q point }
{ dx integer }
{ dy integer }
{ sx integer }
{ sy integer }
{ error integer } ;

: delta ( p q quot: ( point -- coord ) -- delta )
    bi@ - abs ; inline

: initialize-deltas ( state -- state )
    [ ] [ p>> ] [ q>> ] tri
    [ [ x>> ] delta >>dx ]
    [ [ y>> ] delta >>dy ] 2bi ;

: step ( p q quot: ( point -- coord ) -- step )
    bi@ < 1 -1 ? ; inline

: initialize-steps ( state -- state )
    [ ] [ p>> ] [ q>> ] tri
    [ [ x>> ] step >>sx ]
    [ [ y>> ] step >>sy ] 2bi ;

: initialize-error ( state -- state )
    [ ] [ dx>> ] [ dy>> ] tri - >>error ;

: <bresenham-state> ( p q -- state )
    \ bresenham-state new
        swap >>q
        swap >>p
    initialize-deltas
    initialize-steps
    initialize-error ;

:: ?move-x ( state -- )
    state error>> 2 *
    state dy>> neg > [
        state p>> [ state sx>> + ] change-x drop
        state [ state dy>> - ] change-error drop
    ] when ;

:: ?move-y ( state -- )
    state error>> 2 *
    state dx>> < [
        state p>> [ state sy>> + ] change-y drop
        state [ state dx>> + ] change-error drop
    ] when ;

: plot ( state -- ) p>> clone , ;

: done? ( state -- ? ) [ p>> ] [ q>> ] bi = ;

:: bresenham's-algorithm ( state -- )
    [
        [ t ] [
            state plot
            state done? [ return ] when
            state ?move-x
            state done? [ state plot return ] when
            state ?move-y
        ] while
    ] with-return ;

: draw-line ( from to -- points )
    <bresenham-state> [ bresenham's-algorithm ] { } make ;