! Copyright (C) 2013 Your name.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays generalizations kernel locals math prettyprint sequences ;
IN: dragon

CONSTANT: d 3

:: zig ( p1 p2 -- p1 p3 p2 )
    p1 first2 :> ( x1 y1 )
    p2 first2 :> ( x2 y2 )
    p1
    x1 x2 + y1 y2 - + 2 / ! (x1+x2+y1-y2)/2
    x2 x1 - y1 y2 + + 2 / ! (x2-x1+y1+y2)/2
    2array
    p2 ;

:: zag ( p1 p2 -- p1 p3 p2 )
    p1 first2 :> ( x1 y1 )
    p2 first2 :> ( x2 y2 )
    p1
    x1 x2 + y1 y2 + - 2 / ! (x1+x2-y1+y2)/2
    x1 x2 - y1 y2 + + 2 / ! (x1-x2+y1+y2)/2
    2array
    p2 ;

: dragon ( p1 p2 p3 d -- seq )
    4 npick 0 = [
        2array        ! { p1 p2 } p3 d
        [ 2drop ] dip ! { p1 p2 }
    ] [
        [ 1 - dup ] 3dip ! p1 p2 p3 d-1 d-1
        [ dup ] dip      ! p1 p2 p2 p3 d-1 d-1
        [ rot rot ] 2dip ! p1 p2 d-1 p2 p3 d-1
        zig dragon       ! { } p2 p3 d-1
        swap [ rot ] dip ! p2 p3 d-1 { }
        zag dragon       ! { } { }
        2array           ! { { } { } }
    ] if ;

: main ( -- )
    d { 0 0 } { 400 400 } zig dragon . ;

MAIN: main