# Paste: dragon curve

Author: dondy factor Wed, 13 Feb 2013 11:32:52
Plain Text |
USING: locals sequences math kernel arrays sequences.deep ;

IN: foobar

:: make-point-list ( seq -- newseq )
seq length even? seq empty? not and [
{ }
seq first2 2array suffix
seq 2 tail make-point-list append
] [ { } ] if ;

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

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

:: (dragon) ( p1 p2 p3 d -- seq )
d 0 = [
p1 p2 2array
] [
p1 p1 p2 zig p2 d 1 - (dragon)
p2 p2 p3 zag p3 d 1 - (dragon) 2array
] if ;

: dragon ( -- seq )
[let { 100 100 } :> p1
{ 356 100 } :> p2
p1 p1 p2 zig p2 3 (dragon) ]
flatten
make-point-list ;

## Annotation: dragon curve stacky

Author: dondy factor Wed, 13 Feb 2013 15:11:39
Plain Text |
USING: kernel ;
IN: dragon

CONSTANT: d 15

: zig ( p1 p2 -- p1 p3 p2 ) ;
: zag ( p1 p2 -- p1 p3 p2 ) ;

: is-zero? ( p1 p2 p3 d -- ? p1 p2 p3 d )
[ [ [ 0 = ]
keep swap ]
dip swap ]
dip swap ;

: (dragon) ( p1 p2 p3 d -- seq )
is-zero? [
2array { } swap append
] [
[ 1 - ] 3dip
[ zig (dragon) ] 4keep
zag (dragon)
] if
;

: dragon ( -- seq )
{ }
d { 0 0 } { 400 400 }
zig (dragon)
append
;

## Annotation: dragon curve stacky

Author: dondy factor Wed, 13 Feb 2013 17:51:23
Plain Text |
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