Paste: dragon (w/typed and state object)

! Copyright (C) 2013 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.

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

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

CONSTANT: depth 21 ! 6 12 18 neat depths

TUPLE: state { angle float } { color float } { point array } ;
C: <state> state

TYPED: next-color ( state: state -- state )
    [
        [ 360 2.0 depth ^ /f + ] keep
        1.0 1.0 1.0 <hsva> >rgba-components glColor4d
    ] change-color ; inline

TYPED: draw-fwd ( p1: array p2: array -- )
    GL_LINES glBegin [ first2-unsafe glVertex2d ] bi@ glEnd ; inline

TYPED: fwd ( state: state l: float -- state )
    over angle>> [ cos * ] [ sin * ] 2bi
    '[
        dup first2-unsafe [ _ + ] [ _ + ] bi* 2array
        [ swap draw-fwd ] keep
    ] change-point ; inline

TYPED: trn ( state: state d: float -- state )
    pi * 180 /f '[ _ + ] change-angle ; inline

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

: dragon ( -- )
    0.0 0.0 { 150 180 } <state>
    400.0 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
Author:	erg (and mrjbq7!)
Mode:	factor
Date:	Tue, 19 Feb 2013 18:11:22