! 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 TYPED: next-color ( state: state -- state ) [ [ 360 2 depth ^ /f + ] keep 1.0 1.0 1.0 >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 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