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