Paste: dragon (no arrays)

Author: mrjbq7
Mode: factor
Date: Tue, 19 Feb 2013 20:46:15
Plain Text | 
! 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 fixnum }
    { color float }
    { x float }
    { y float } ;

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 ( x1 y1 x2 y2 -- )
    GL_LINES glBegin [ glVertex2d ] 2bi@ glEnd ; inline

TYPED:: fwd ( state: state l: float -- state )
    state x>> :> x
    state y>> :> y
    state angle>> pi * 180 /f :> angle
    l angle [ cos * ] [ sin * ] 2bi :> ( dx dy )
    state x y x dx + y dy +
    [ draw-fwd ] 2keep [ >>x ] [ >>y ] bi* ;

TYPED: trn ( state: state d: fixnum -- state )
    '[ _ + ] change-angle ; inline

TYPED:: dragon' ( state: state l: float s: fixnum d: fixnum -- )
    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 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

Annotation: ftfi

Author: dondy
Mode: factor
Date: Wed, 20 Feb 2013 08:34:23
Plain Text | 
! 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: fast-dragon ! http://rosettacode.org/wiki/Dragon_curve#BASIC

CONSTANT: depth 12 ! 6 12 18 neat depths

TUPLE: state
    { angle fixnum }
    { color float }
    { x float }
    { y float } ;

C: <state> state

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

! i guess it's faster if you don't have to unbox a quote?
TYPED: draw-fwd ( x1: float y1: float x2: float y2: float -- )
    GL_LINES glBegin glVertex2d glVertex2d glEnd ; inline

TYPED:: fwd ( state: state l: float -- state )
    state x>> :> x
    state y>> :> y
    state angle>> pi * 180 /f :> angle
    l angle [ cos * ] [ sin * ] 2bi :> ( dx dy )
    state x y x dx + y dy +
    [ draw-fwd ] 2keep [ >>x ] [ >>y ] bi* ;

TYPED: trn ( state: state d: fixnum -- state )
    '[ _ + ] change-angle ; inline

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

: dragon ( -- )
    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

New Annotation

Summary:
Author:
Mode:
Body: