USING: arrays kernel locals math prettyprint sequences ;

IN: dragon

: 2p ( p1 p2 -- x1 y1 x2 y2 )
    [ first2 ] dip first2 ;

: zigi-1 ( x1 y1 x2 y2 -- x3 )
    [ rot swap + swap ] dip - + ;

: zigi-2 ( x1 y1 x2 y2 -- y3 )
    [ rot + swap ] dip + + ;

: zigi ( x1 y1 x2 y2 -- x3 y3 )
    4dup zigi-2 [ zigi-1 ] dip ;

: zig ( p1 p2 -- p3 )
    2p zigi 2array [ 2 / ] map ;

: zagi-1 ( x1 y1 x2 y2 -- x3 )
    [ rot swap + swap ] dip + - ;

: zagi-2 ( x1 y1 x2 y2 -- y3 )
    [ rot swap - swap ] dip + + ;

: zagi ( x1 y1 x2 y2 -- x3 y3 )
    4dup zagi-2 [ zagi-1 ] dip ;

: zag ( p1 p2 -- p3 )
    2p zagi 2array [ 2 / ] map ;

: (dragon) ( p1 p2 p3 d -- seq )
    [ 0 = ] keep swap [
        2drop
        2array
    ] [
        1 - ! p1 p2 p3 d
        swap ! p1 p2 d p3
        dupd ! p1 p2 d d p3
        swap ! p1 p2 d p3 d
        [ dupd ! p1 p2 p2 d | p3 d
          swap ! p1 p2 d p2 | p3 d
        ] 2dip ! p1 p2 d p2 p3 d
        [ [ zig ] 2keep ! px p1 p2 | d p2 p3 d
          [ swap ] dip  ! p1 px p2 | d p2 p3 d
        ] 4dip ! p1 px p2 d p2 p3 d
        [ [ zag ] 2keep ! p1 px p2 d py p2 p3 | d
          [ swap ] dip ! p1 px p2 d p2 py p3 | d
        ] dip ! p1 px p2 d p2 py p3 d
        
        [ (dragon) ] 4dip ! seq p2 py p3 d
        (dragon) ! seqx seqy
        append
    ] if ;

: dragon ( -- )
    { 0 0 } dup
    { 100 100 } dup [ zig ] dip 2
    (dragon)
    . ;

MAIN: dragon