Paste: dragon curve

Author: dondy
Mode: factor
Date: Wed, 13 Feb 2013 11:32:52
Plain Text | 
! Copyright (C) 2013 Dondy.
! See http://factorcode.org/license.txt for BSD license.
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
Mode: factor
Date: Wed, 13 Feb 2013 15:11:39
Plain Text | 
! Copyright (C) 2013 Your name.
! See http://factorcode.org/license.txt for BSD license.
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
Mode: factor
Date: Wed, 13 Feb 2013 17:51:23
Plain Text | 
! 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

New Annotation

Summary:
Author:
Mode:
Body: