Paste: dragon curve (locals)

Author:	dondy
Mode:	factor
Date:	Wed, 13 Feb 2013 19:01:00

Plain Text |

Delete Paste

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

IN: dragon

:: zig ( p1 p2 -- p3 )
    p1 first2 :> ( x1 y1 )
    p2 first2 :> ( x2 y2 )
    x1 x2 + y1 y2 - + 2 / ! (x1+x2+y1-y2)/2
    x2 x1 - 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
    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 zig p3 d 1 - (dragon)
        append
    ] if ;

:: dragon ( -- )
    { 100 100 } :> p1
    { 356 100 } :> p2
    p1 p1 p2 zig p2 3 (dragon)
    . ;

MAIN: dragon

Annotation: typo forgot to call zag

Author:	dondy
Mode:	factor
Date:	Wed, 13 Feb 2013 19:25:17

Plain Text |

Delete Annotation

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

IN: dragon

:: 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)
        append
    ] if ;

:: dragon ( -- )
    { 100 100 } :> p1
    { 356 100 } :> p2
    p1 p1 p2 zig p2 3 (dragon)
    . ;

MAIN: dragon

Annotation: dragon curve stacky

Author:	dondy
Mode:	factor
Date:	Thu, 14 Feb 2013 16:35:34

Plain Text |

Delete Annotation

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

Annotation: zig zag

Author:	erg
Mode:	factor
Date:	Thu, 14 Feb 2013 18:01:20

Plain Text |

Delete Annotation

: zig ( p1 p2 -- p3 )
    [
        [ [ first ] [ second ] bi* + ]
        [ [ second ] [ first ] bi* - ] 2bi + 2 /
    ] [
        [ [ second ] [ first ] bi* - ]
        [ [ first ] [ second ] bi* + ] 2bi + 2 /
    ] 2bi 2array ;

: zag ( p1 p2 -- p3 )
    [
        [ [ first ] bi@ + ] [ [ second ] bi@ + ] 2bi - 2 /
    ] [
        [ [ first ] bi@ - ] [ [ second ] bi@ + ] 2bi + 2 /
    ] 2bi 2array ;

Annotation: rework

Author:	dondy
Mode:	factor
Date:	Thu, 14 Feb 2013 18:01:42

Plain Text |

Delete Annotation

USING: arrays kernel math prettyprint sequences ;

IN: dragon

: zig-1 ( x1 y1 x2 y2 -- x3 ) [ rot swap + swap ] dip - + 2 / ;
: zig-2 ( x1 y1 x2 y2 -- y3 ) [ rot      + swap ] dip + + 2 / ;
: zag-1 ( x1 y1 x2 y2 -- x3 ) [ rot swap + swap ] dip + - 2 / ;
: zag-2 ( x1 y1 x2 y2 -- y3 ) [ rot swap - swap ] dip + + 2 / ;

: zig ( p1 p2 -- p1 p3 p2 )
    [ [ first2 ] bi@
      [ zig-1 ] 4keep zig-2 2array
    ] 2keep [ swap ] dip ;

: zag ( p1 p2 -- p1 p3 p2 )
    [ [ first2 ] bi@
      [ zag-1 ] 4keep zag-2 2array
    ] 2keep [ swap ] dip ;

: (dragon) ( p1 p2 p3 d -- seq )
    dup 0 = [
        2drop
        2array
    ] [
        1 -

        swap dupd swap
        [ dupd swap ] 2dip ! p1 p2 d p2 p3 d

        [ zig ] 4dip ! p1 px p2 d p2 p3 d
        [ zag ] dip ! p1 px p2 d p2 py p3 d

        [ (dragon) ] 4dip ! seq p2 py p3 d
        (dragon) ! seqx seqy
        append
    ] if ;

: dragon ( -- )
    { 0 0 } 
    { 100 100 } zig 2
    (dragon)
    . ;

MAIN: dragon

Annotation: kinda ugly

Author:	erg
Mode:	factor
Date:	Thu, 14 Feb 2013 18:03:56

Plain Text |

Delete Annotation

USING: arrays generalizations kernel locals math sequences nested-comments ;
IN: dondy

: zig ( p1 p2 -- p3 )
    [
        [ [ first ] [ second ] bi* + ]
        [ [ second ] [ first ] bi* - ] 2bi + 2 /
    ] [
        [ [ second ] [ first ] bi* - ]
        [ [ first ] [ second ] bi* + ] 2bi + 2 /
    ] 2bi 2array ;

: zag ( p1 p2 -- p3 )
    [
        [ [ first ] bi@ + ] [ [ second ] bi@ + ] 2bi - 2 /
    ] [
        [ [ first ] bi@ - ] [ [ second ] bi@ + ] 2bi + 2 /
    ] 2bi 2array ;

: dragon' ( vector p1 p2 p3 d -- vector )
    dup zero? [
        2drop 2array over push
    ] [
        {
            [
                nip [ dup ] 2dip
                [ [ zig ] keep ] 2dip 1 - dragon'
            ]
            [
                [ drop ] 3dip [ dup ] 2dip
                [ [ zag ] keep ] [ 1 - ] bi* dragon'
            ]
        } 5 ncleave append
    ] if ;

: dragon ( n -- seq )
    [ V{ } clone { 100 100 } dup { 356 100 } [ zig ] keep ] dip dragon' concat ;

Annotation: ui

Author:	dondy
Mode:	factor
Date:	Fri, 15 Feb 2013 16:35:51

Plain Text |

Delete Annotation

USING: arrays kernel math prettyprint sequences
ui.gadgets.worlds ui.gadgets.worlds.null opengl.gl ;
IN: dragon

: zig ( p1 p2 -- p1 pI p2 )
    [ [ first2 ] bi@
      [ [ rot swap + swap ] dip - + 2 / ] 4keep
      [ rot + swap ] dip + + 2 / 2array
    ] 2keep [ swap ] dip ;

: zag ( p1 p2 -- p1 pA p2 )
    [ [ first2 ] bi@
      [ [ rot swap + swap ] dip + - 2 / ] 4keep
      [ rot swap - swap ] dip + + 2 / 2array
    ] 2keep [ swap ] dip ;

: dragon' ( p1 p2 p3 d -- seq )
    dup zero? [
        2drop 2array
    ] [
        1 - swap dupd swap [ dupd swap ] 2dip ! p1 p2 d p2 p3 d
        [ zig ] 4dip [ zag ] dip ! p1 pI p2 d p2 pA p3 d
        [ dragon' ] 4dip dragon' ! p1 pI p2 d dragon' / p2 pA p3 d dragon'
        append
    ] if ;

: dragon ( -- x )
    "dragon" null-window [
        GL_LINE_STRIP glBegin
        100 200 [ dup 2array ] bi@ zig 2 dragon'
        [ first2 glVertex2d ] each
        glEnd ] into-window  ;

MAIN: dragon

Annotation: ui

Author:	dondy
Mode:	factor
Date:	Fri, 15 Feb 2013 21:55:05

Plain Text |

Delete Annotation

USING: arrays kernel math sequences
accessors ui ui.gadgets ui.gadgets.canvas ui.render math.order math.rectangles math.vectors opengl opengl.gl namespaces ;
IN: dragon

: zig ( p1 p2 -- p1 pI p2 )
    [ [ first2 ] bi@
      [ [ rot swap + swap ] dip - + 2 / ] 4keep
      [ rot + swap ] dip + + 2 / 2array
    ] 2keep [ swap ] dip ;

: zag ( p1 p2 -- p1 pA p2 )
    [ [ first2 ] bi@
      [ [ rot swap + swap ] dip + - 2 / ] 4keep
      [ rot swap - swap ] dip + + 2 / 2array
    ] 2keep [ swap ] dip ;

: dragon' ( p1 p2 p3 d -- seq )
    dup zero? [
        2drop 2array
    ] [
        1 - swap dupd swap [ dupd swap ] 2dip ! p1 p2 d p2 p3 d
        [ zig ] 4dip [ zag ] dip ! p1 pI p2 d p2 pA p3 d
        [ dragon' ] 4dip dragon' ! p1 pI p2 d dragon' / p2 pA p3 d dragon'
        append
    ] if ;

: dragon ( -- seq ) ! [ math.vectors:normalize ] map
    100 200 [ dup 2array ] bi@ zig 2 dragon' ; ! prettyprint:.
! GL_LINE_STRIP glBegin dragon [ glVertex2dv ] each glEnd

: draw-dragon ( -- )
    8 2 - glLineWidth
    8 2 - glPointSize
    1.0 1.0 1.0 1.0 glColor4d
    GL_LINE_STRIP glBegin
    dragon [ normalize ] map [ glVertex2dv ] each
    glEnd ;

TUPLE: dragon-canvas < canvas ;

M: dragon-canvas layout* delete-canvas-dlist ;

M: dragon-canvas draw-gadget* [ draw-dragon ] draw-canvas ;

M: dragon-canvas pref-dim* drop { 400 400 } ;

MAIN-WINDOW: dragon-window { { title "Dragon Curve" } }
  dragon-canvas new-canvas >>gadgets ;

MAIN: dragon-window

Annotation: wtf but it draws smth

Author:	dondy
Mode:	factor
Date:	Fri, 15 Feb 2013 22:32:44

Plain Text |

Delete Annotation

USING: arrays kernel math sequences
locals
math.order math.vectors
accessors
opengl opengl.gl ui ui.gadgets ui.gadgets.canvas ui.render ;
IN: dragon

! : zig ( p1 p2 -- p1 pI p2 )
!     [ [ first2 ] bi@
!       [ [ rot swap + swap ] dip - + 2 / ] 4keep
!       [ rot + swap ] dip + + 2 / 2array
!     ] 2keep [ swap ] dip ;

! : zag ( p1 p2 -- p1 pA p2 )
!     [ [ first2 ] bi@
!       [ [ rot swap + swap ] dip + - 2 / ] 4keep
!       [ rot swap - swap ] dip + + 2 / 2array
!     ] 2keep [ swap ] dip ;

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

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

! : dragon' ( p1 p2 p3 d -- seq )
!     dup zero? [
!         2drop 2array
!     ] [
!         1 - swap dupd swap [ dupd swap ] 2dip ! p1 p2 d p2 p3 d
!         [ zig ] 4dip [ zag ] dip ! p1 pI p2 d p2 pA p3 d
!         [ dragon' ] 4dip dragon' ! p1 pI p2 d dragon' / p2 pA p3 d dragon'
!         append
!     ] if;

:: dragon' ( p1 p2 p3 d -- seq )
    d zero? [
        p1 p2 2array
    ] [
        p1 p2 zig d 1 - dragon'
        p2 p3 zag d 1 - dragon'
        append
    ] if ;

: dragon ( -- seq )
    { 100 100 } { 356 100 } zig 15 dragon' ;

! ---

: draw-dragon ( n -- )
    1 glLineWidth
    1 glPointSize
    1.0 1.0 1.0 1.0 glColor4d
    drop
    GL_LINE_STRIP glBegin
    dragon [ first2 glVertex2d ] each
    glEnd ;

TUPLE: dragon-canvas < canvas ;

M: dragon-canvas layout* delete-canvas-dlist ;
M: dragon-canvas draw-gadget* [ dim>> first2 min 3 /i draw-dragon ] draw-canvas ;
M: dragon-canvas pref-dim* drop { 430 300 } ;

MAIN-WINDOW: dragon-window { { title "Dragon Curve" } }
  dragon-canvas new-canvas >>gadgets ;

MAIN: dragon-window

Annotation: turtle version

Author:	dondy
Mode:	factor
Date:	Fri, 15 Feb 2013 23:50:11

Plain Text |

Delete Annotation

USING: arrays math math.constants math.functions namespaces kernel opengl.gl locals ui.gadgets.canvas ui.gadgets ui.render accessors sequences math.order ui ;
IN: dragon

SYMBOL: angle
SYMBOL: point

: trn ( d -- )
    pi * 180 / angle get + angle set ;

: frw ( l -- )
    [ cos ] [ sin ] bi 2array
    GL_LINE glBegin point get glVertex2d dup glVertex2d glEnd
    point set ;

:: dragon' ( l s d -- )
    s zero? [
        l frw
    ] [
        d 45 * trn
        l 2 sqrt / s 1 -  1 dragon'
        d neg 90 * trn
        l 2 sqrt / s 1 - -1 dragon'
        d 45 * trn
    ] if ;

: dragon ( n -- ) drop
    1 glLineWidth
    1 glPointSize
    1.0 1.0 1.0 1.0 glColor4d
    
    0 angle set
    { 150 180 } point set
    400 12 1 dragon ;

! --- there be dragons beyond this

TUPLE: dragon-canvas < canvas ;

M: dragon-canvas layout* delete-canvas-dlist ;
M: dragon-canvas draw-gadget* [ dim>> first2 min 3 /i dragon ] draw-canvas ;
M: dragon-canvas pref-dim* drop { 430 300 } ;

MAIN-WINDOW: dragon-window { { title "Dragon Curve" } }
  dragon-canvas new-canvas >>gadgets ;

MAIN: dragon-window

Annotation: fixed silly mistakeS

Author:	dondy
Mode:	factor
Date:	Sat, 16 Feb 2013 00:43:11

Plain Text |

Delete Annotation

USING: arrays math math.constants math.functions namespaces kernel
opengl.gl locals ui.gadgets.canvas ui.gadgets ui.render accessors
sequences math.order ui prettyprint math.vectors ;
IN: dragon
! http://rosettacode.org/wiki/Dragon_curve#BASIC
SYMBOLS: point angle ;

: trn ( d -- )
    pi * 180 / angle get + angle set ;

: frw ( l -- )
    [ angle get cos * ]
    [ angle get sin * ] bi 2array
    GL_LINES glBegin
      point get first2 glVertex2d
      dup       first2 glVertex2d
    glEnd
    point set ;

:: dragon' ( l s d -- )
    s zero? [
        l frw
    ] [
        d 45 * trn
        l 2 sqrt / s 1 -  1 dragon'
        d neg 90 * trn
        l 2 sqrt / s 1 - -1 dragon'
        d 45 * trn
    ] if ;

: dragon ( n -- ) drop ! artifact from maze.factor i guess
    1 glLineWidth
    1 glPointSize
    1.0 1.0 1.0 1.0 glColor4d
    0 angle set
    { 150 180 } point set
    400 12 1 dragon' ;

! --- there be dragons beyond this

TUPLE: dragon-canvas < canvas ;

M: dragon-canvas layout* delete-canvas-dlist ;
M: dragon-canvas draw-gadget* [ dim>> first2 min 3 /i dragon ] draw-canvas ;
M: dragon-canvas pref-dim* drop { 800 600 } ;

MAIN-WINDOW: dragon-window { { title "Dragon Curve" } }
  dragon-canvas new-canvas >>gadgets ;

MAIN: dragon-window

Annotation: i don't understand opengl

Author:	dondy
Mode:	factor
Date:	Sat, 16 Feb 2013 11:42:57

Plain Text |

Delete Annotation

USING: arrays math math.constants math.functions namespaces kernel
opengl.gl locals ui.gadgets.canvas ui.gadgets ui.render accessors
sequences math.order ui prettyprint ;
IN: dragon
! http://rosettacode.org/wiki/Dragon_curve#BASIC
SYMBOLS: point angle ;

: trn ( d -- )
    pi * 180 / angle get + angle set ;

: fwd ( l -- )
    [ angle get cos * ]
    [ angle get sin * ] bi 2array
    GL_LINE_STRIP glBegin dup point get 
    first2 [ 100 + ] bi@ glVertex2d
    first2 [ 100 + ] bi@ glVertex2d
    glEnd
    point set ;

:: dragon' ( l s d -- )
    s zero? [
        l fwd
    ] [
        d 45 * trn
        l 2 sqrt / s 1 -  1 dragon'
        d neg 90 * trn
        l 2 sqrt / s 1 - -1 dragon'
        d 45 * trn
    ] if ;

: dragon ( n -- ) drop ! artifact from maze.factor i don't understand
    1 glLineWidth
    1.0 1.0 1.0 glColor3d
    0 angle set
    { 150 180 } point set
    400 12 1 dragon' ;

! --- there be dragons beyond this, no idea why i have to do all this

TUPLE: dragon-canvas < canvas ;

M: dragon-canvas layout* delete-canvas-dlist ;
M: dragon-canvas draw-gadget* [ dim>> first2 min 3 /i dragon ] draw-canvas ;
M: dragon-canvas pref-dim* drop { 640 480 } ;

MAIN-WINDOW: dragon-window { { title "Dragon Curve" } }
  dragon-canvas new-canvas >>gadgets ;

MAIN: dragon-window

Annotation: working version thx PGGB

Author:	dondy
Mode:	factor
Date:	Sat, 16 Feb 2013 12:39:53

Plain Text |

Delete Annotation

USING: arrays math math.constants math.functions namespaces kernel
opengl.gl locals ui.gadgets.canvas ui.gadgets ui.render accessors
sequences math.order ui prettyprint math.vectors ;

IN: dragon ! http://rosettacode.org/wiki/Dragon_curve#BASIC

SYMBOLS: point angle ;

: trn ( d -- )
    pi * 180 / angle get + angle set ;

: draw-fwd ( p -- ) ! this is still kinda ugly, TODO fancy colors
    dup point get swap point get v+
    GL_LINES glBegin [ first2 glVertex2d ] bi@ glEnd
    point get v+ point set ;

: fwd ( l -- )
    [ angle get cos * ]
    [ angle get sin * ] bi 2array draw-fwd ;

:: dragon' ( l s d -- )
    s zero? [
        l fwd
    ] [
        d 45 * trn
        l 2 sqrt / s 1 -  1 dragon'
        d neg 90 * trn
        l 2 sqrt / s 1 - -1 dragon'
        d 45 * trn
    ] if ;

: dragon ( n -- ) drop ! artifact from maze.factor i don't understand but breaks
    1 glLineWidth
    1.0 1.0 1.0 glColor3d
    0 angle set
    { 150 180 } point set
    400 12 1 dragon' ;

! --- there be dragons beyond this, no idea why i have to do some of this

TUPLE: dragon-canvas < canvas ;

M: dragon-canvas draw-gadget* [ dim>> first2 min 3 /i dragon ] draw-canvas ;
M: dragon-canvas pref-dim* drop { 640 480 } ;

MAIN-WINDOW: dragon-window { { title "Dragon Curve" } }
  dragon-canvas new-canvas >>gadgets ;

MAIN: dragon-window

Annotation: dragon-curve 1.0

Author:	dondy
Mode:	factor
Date:	Sat, 16 Feb 2013 15:35:26

Plain Text |

Delete Annotation

USING: arrays math math.constants math.functions namespaces kernel
opengl.gl locals ui.gadgets.canvas ui.gadgets ui.render accessors
sequences math.order ui prettyprint math.vectors random ;

IN: dragon ! http://rosettacode.org/wiki/Dragon_curve#BASIC

SYMBOLS: point angle ;

: trn ( d -- )
    pi * 180 / angle get + angle set ;

: rand-color ( -- ) ! looks silly, but is easy
    0.1 0.9 uniform-random-float
    0.1 0.9 uniform-random-float
    0.1 0.9 uniform-random-float glColor3d ;

: draw-fwd ( p -- )
    rand-color
    dup point get
    GL_LINES glBegin [ first2 glVertex2d ] bi@ glEnd
    point set ;

: fwd ( l -- )
    [ angle get cos * ]
    [ angle get sin * ] bi 2array
    point get v+ draw-fwd ;

:: dragon' ( l s d -- )
    s zero? [
        l fwd
    ] [
        d 45 * trn
        l 2 sqrt / s 1 -  1 dragon'
        d neg 90 * trn
        l 2 sqrt / s 1 - -1 dragon'
        d 45 * trn
    ] if ;

: dragon ( n -- ) drop ! artifact from maze.factor, see draw-gadget*
    0 angle set
    { 150 180 } point set
    400 12 1 dragon' ;

TUPLE: dragon-canvas < canvas ;

! this quote is silly and i have no idea what and why i do this
M: dragon-canvas draw-gadget* [ dim>> first2 min 3 /i dragon ] draw-canvas ;
M: dragon-canvas pref-dim* drop { 640 480 } ;

MAIN-WINDOW: dragon-window { { title "Dragon Curve" } }
  dragon-canvas new-canvas >>gadgets ;

MAIN: dragon-window

Annotation: finished dcurve

Author:	dondy
Mode:	factor
Date:	Sat, 16 Feb 2013 16:47:06

Plain Text |

Delete Annotation

USING: arrays math math.constants math.functions namespaces kernel
colors colors.hsv opengl.gl locals ui.gadgets.canvas ui.gadgets
ui.render accessors sequences math.order ui prettyprint math.vectors random ;

IN: dragon ! http://rosettacode.org/wiki/Dragon_curve#BASIC

SYMBOLS: point angle color ;

: trn ( d -- )
    pi * 180 / angle get + angle set ;

: new-color ( -- )
    color get dup 1.0 1.0 1.0 <hsva> >rgba-components glColor4d
    dup 360 = [ drop 0 color set ] [ 0.1 + color set ] if ;

: draw-fwd ( p -- )
    new-color
    dup point get
    GL_LINES glBegin [ first2 glVertex2d ] bi@ glEnd
    point set ;

: fwd ( l -- )
    [ angle get cos * ]
    [ angle get sin * ] bi 2array
    point get v+ draw-fwd ;

:: dragon' ( l s d -- )
    s zero? [
        l fwd
    ] [
        d 45 * trn
        l 2 sqrt / s 1 -  1 dragon'
        d neg 90 * trn
        l 2 sqrt / s 1 - -1 dragon'
        d 45 * trn
    ] if ;

: dragon ( n -- ) drop ! artifact from maze.factor, see draw-gadget*
    0 angle set
    { 150 180 } point set
    0 color set
    400 12 1 dragon' ;

TUPLE: dragon-canvas < canvas ;

! this quote is silly and i have no idea what and why i do this
M: dragon-canvas draw-gadget* [ dim>> first2 min 3 /i dragon ] draw-canvas ;
M: dragon-canvas pref-dim* drop { 640 480 } ;

MAIN-WINDOW: dragon-window { { title "Dragon Curve" } }
  dragon-canvas new-canvas >>gadgets ;

MAIN: dragon-window

Annotation: neater colorization

Author:	dondy
Mode:	factor
Date:	Sat, 16 Feb 2013 18:53:38

Plain Text |

Delete Annotation

USING: arrays math math.constants math.functions namespaces kernel
colors colors.hsv opengl.gl locals ui.gadgets.canvas ui.gadgets
ui.render accessors sequences math.order ui prettyprint math.vectors
random math.combinatorics ;

IN: dragon ! http://rosettacode.org/wiki/Dragon_curve#BASIC

SYMBOLS: point angle color ;
CONSTANT: depth 18

: trn ( d -- )
    pi * 180 / angle get + angle set ;

: new-color ( -- )
    color get dup 1.0 1.0 1.0 <hsva> >rgba-components glColor4d
    dup 360 = [ drop 0 color set ] [ 360 2 depth ^ / + color set ] if ;

: draw-fwd ( p -- )
    new-color
    dup point get
    GL_LINES glBegin [ first2 glVertex2d ] bi@ glEnd
    point set ;

: fwd ( l -- )
    [ angle get cos * ]
    [ angle get sin * ] bi 2array
    point get v+ draw-fwd ;

:: dragon' ( l s d -- )
    s zero? [
        l fwd
    ] [
        d 45 * trn
        l 2 sqrt / s 1 -  1 dragon'
        d neg 90 * trn
        l 2 sqrt / s 1 - -1 dragon'
        d 45 * trn
    ] if ;

: dragon ( n -- ) drop ! artifact from maze.factor, see draw-gadget*
    0 0 angle set color set
    { 150 180 } point set
    400 depth 1 dragon' ;

TUPLE: dragon-canvas < canvas ;

! this quote is silly and i have no idea what and why i do this
M: dragon-canvas draw-gadget* [ dim>> first2 min 3 /i dragon ] draw-canvas ;
M: dragon-canvas pref-dim* drop { 640 480 } ;

MAIN-WINDOW: dragon-window { { title "Dragon Curve" } }
  dragon-canvas new-canvas >>gadgets ;

MAIN: dragon-window

Annotation: better hsv colorstuffs

Author:	dondy
Mode:	factor
Date:	Sat, 16 Feb 2013 19:15:02

Plain Text |

Delete Annotation

USING: arrays math math.constants math.functions namespaces kernel
colors colors.hsv opengl.gl locals ui.gadgets.canvas ui.gadgets
ui.render accessors sequences math.order ui prettyprint math.vectors
random math.combinatorics ;

IN: dragon ! http://rosettacode.org/wiki/Dragon_curve#BASIC

SYMBOLS: point angle color ;
CONSTANT: depth 18 ! 6 12 18

: next-color ( -- )
    color get dup
    1.0 1.0 1.0 <hsva> >rgba-components glColor4d
    360 2 depth ^ / + color set ;

: draw-fwd ( p -- )
    next-color
    point get
    GL_LINES glBegin [ first2 glVertex2d ] bi@ glEnd ;

: fwd ( l -- )
    [ angle get cos * ]
    [ angle get sin * ] bi 2array
    point get v+ dup draw-fwd
    point set ;

: trn ( d -- )
    pi * 180 / angle get + angle set ;

:: dragon' ( l s d -- )
    s zero? [
        l fwd
    ] [
        d 45 * trn
        l 2 sqrt / s 1 -  1 dragon'
        d neg 90 * trn
        l 2 sqrt / s 1 - -1 dragon'
        d 45 * trn
    ] if ;

: dragon ( n -- ) drop ! artifact from maze.factor, see draw-gadget*
    0 0 angle set color set
    { 150 180 } point set
    400 depth 1 dragon' ;

TUPLE: dragon-canvas < canvas ;

! this quote is silly and i have no idea what and why i do this
M: dragon-canvas draw-gadget* [ dim>> first2 min 3 /i dragon ] draw-canvas ;
M: dragon-canvas pref-dim* drop { 640 480 } ;

MAIN-WINDOW: dragon-window { { title "Dragon Curve" } }
  dragon-canvas new-canvas >>gadgets ;

MAIN: dragon-window

Annotation: hmmyeah

Author:	dondy
Mode:	factor
Date:	Sat, 16 Feb 2013 21:49:55

Plain Text |

Delete Annotation

USING: accessors arrays colors colors.hsv kernel locals math
math.constants math.functions math.vectors namespaces opengl.gl
sequences ui ui.gadgets ui.gadgets.canvas ui.render ;

IN: dragon ! http://rosettacode.org/wiki/Dragon_curve#BASIC

SYMBOLS: point angle color ;
CONSTANT: depth 18 ! 6 12 18 neat depths

: next-color ( -- )
    color get dup
    1.0 1.0 1.0 <hsva> >rgba-components glColor4d
    ! increment should be constant derived from depth
    360 2 depth ^ / + color set ;

: draw-fwd ( p -- ) ! draw a line btw point get and p
    point get
    GL_LINES glBegin [ first2 glVertex2d ] bi@ glEnd ;

: fwd ( l -- )
    [ angle get cos * ]
    [ angle get sin * ] bi 2array
    point get v+ dup draw-fwd
    point set ;

: trn ( d -- )
    pi * 180 / angle get + angle set ;

:: dragon' ( l s d -- )
    s zero? [
        next-color l fwd
    ] [
        d 45 * trn
        l 2 sqrt / s 1 -  1 dragon'
        d neg 90 * trn
        l 2 sqrt / s 1 - -1 dragon'
        d 45 * trn
    ] if ;

: dragon ( -- )
    0 0 angle set color set
    { 150 180 } point set
    400 depth 1 dragon' ;

TUPLE: dragon-canvas < canvas ;

M: dragon-canvas draw-gadget* [ drop dragon ] draw-canvas ;
M: dragon-canvas pref-dim* drop { 640 480 } ;

MAIN-WINDOW: dragon-window { { title "Dragon Curve" } }
  dragon-canvas new-canvas >>gadgets ;

MAIN: dragon-window

New Annotation

Summary:
Author:
Mode:	textPostgreSQLPowerCenter Parameter Fileactionscriptadaada95ans-forth94antantlrantlr4apacheconfapdlapplescriptaspaspect-jassembly-agcassembly-agsassembly-arm32assembly-m68kassembly-macro32assembly-mcs51assembly-parrotassembly-r2000assembly-x86avroawkbbatchbbjbcelbeanshellbibtexbinsource-agccc#c++cfscriptchillcilclipsclojurecmakecobolcoffeescriptcoldfusioncplex-lpcsscsvcvs-commitddartdjangodockerfiledotdoxygendrawj2ddsssleiffelembperlerlangfactorfhtmlforthfortranfortran90foxprofreemarkergcbasicgettextgherkingnuplotgogradlegroovygsphaskellhaxehexhl7v2hlslhtaccesshtmlhxmli4glicalendariconidlinforminiinno-setupinterlisiojamonjavajava module-infojavaccjavafxjavascriptjcljedit-actionsjflexjhtmljmkjsonjspkotlinlatexlexlilypondlispliterate-haskelllogslogtalklotosluam4macroschedulermailmakefilemaplemarkdownmavenmavscriptmetapostmlmodula3moinmqscmustache-templatemxmlmyghtymysqln3netrexxnqcnsis2objective-cobjectrexxoccamomnimarkopensipsoutlinepascalpatchperlphppikepl-sqlpl-sql9pl1plaintexplantumlpop11postscriptpovraypowerdynamopowershellprogressprologpropertiesprotobufpspptlpurepvwavepyrexpythonqdocrakefilercprdrebolredcoderelax-ng-compactrenderman-ribrestrfcrhtmlroffrpm-specrtfrubyrustrviews#s+sassbtscalaschemesdl/prsgmlshellscriptshtmlsipsippslateslaxsmalltalksmartysmi-mibsparqlsql-loadersqrsquidconfstatasvn-commitswiftswigtcltemplate-toolkittextexinfotldtransact-sqltsptwikityposcripturluscriptvalavbscriptvelocityverilogvhdlvisualbasicvrml2wellknowntextxmlxqxslyabyamlzpt
Body:

Done