Paste: dragon curve (locals)

Author: dondy factor Wed, 13 Feb 2013 19:01:00
Plain Text |
```! Copyright (C) 2013 Your name.
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 factor Wed, 13 Feb 2013 19:25:17
Plain Text |
```! Copyright (C) 2013 Your name.
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 factor Thu, 14 Feb 2013 16:35:34
Plain Text |
```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 factor Thu, 14 Feb 2013 18:01:20
Plain Text |
```: 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 factor Thu, 14 Feb 2013 18:01:42
Plain Text |
```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 factor Thu, 14 Feb 2013 18:03:56
Plain Text |
```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 factor Fri, 15 Feb 2013 16:35:51
Plain Text |
```USING: arrays kernel math prettyprint sequences
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 factor Fri, 15 Feb 2013 21:55:05
Plain Text |
```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" } }

MAIN: dragon-window```

Annotation: wtf but it draws smth

Author: dondy factor Fri, 15 Feb 2013 22:32:44
Plain Text |
```USING: arrays kernel math sequences
locals
math.order math.vectors
accessors
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" } }

MAIN: dragon-window```

Annotation: turtle version

Author: dondy factor Fri, 15 Feb 2013 23:50:11
Plain Text |
```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" } }

MAIN: dragon-window```

Annotation: fixed silly mistakeS

Author: dondy factor Sat, 16 Feb 2013 00:43:11
Plain Text |
```USING: arrays math math.constants math.functions namespaces kernel
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" } }

MAIN: dragon-window```

Annotation: i don't understand opengl

Author: dondy factor Sat, 16 Feb 2013 11:42:57
Plain Text |
```USING: arrays math math.constants math.functions namespaces kernel
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" } }

MAIN: dragon-window```

Annotation: working version thx PGGB

Author: dondy factor Sat, 16 Feb 2013 12:39:53
Plain Text |
```USING: arrays math math.constants math.functions namespaces kernel
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" } }

MAIN: dragon-window```

Annotation: dragon-curve 1.0

Author: dondy factor Sat, 16 Feb 2013 15:35:26
Plain Text |
```USING: arrays math math.constants math.functions namespaces kernel
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" } }

MAIN: dragon-window```

Annotation: finished dcurve

Author: dondy factor Sat, 16 Feb 2013 16:47:06
Plain Text |
```USING: arrays math math.constants math.functions namespaces kernel
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" } }

MAIN: dragon-window```

Annotation: neater colorization

Author: dondy factor Sat, 16 Feb 2013 18:53:38
Plain Text |
```USING: arrays math math.constants math.functions namespaces kernel
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" } }

MAIN: dragon-window```

Annotation: better hsv colorstuffs

Author: dondy factor Sat, 16 Feb 2013 19:15:02
Plain Text |
```USING: arrays math math.constants math.functions namespaces kernel
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" } }

MAIN: dragon-window```

Annotation: hmmyeah

Author: dondy factor Sat, 16 Feb 2013 21:49:55
Plain Text |
```USING: accessors arrays colors colors.hsv kernel locals math
math.constants math.functions math.vectors namespaces opengl.gl

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" } }