2017-01-22 18:06:01 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								USING: accessors arrays calendar circular colors
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								colors.constants fry kernel locals math math.order math.vectors
							 | 
						
					
						
							
								
									
										
										
										
											2019-04-21 12:53:47 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								namespaces opengl processing.shapes sequences timers ui
							 | 
						
					
						
							
								
									
										
										
										
											2017-01-22 18:06:01 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								ui.gadgets ui.gestures ui.render ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-12-08 22:30:10 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								IN: trails
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! Example 33-15 from the Processing book
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2017-01-22 18:06:01 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: mouse ( -- point )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    ! Return the mouse location relative to the current gadget
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    hand-loc get hand-gadget get screen-loc v- ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-12-08 22:30:10 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: percent->radius ( percent -- radius ) neg 1 + 25 * 5 max ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2019-07-25 12:19:23 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: dot ( pos percent -- )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    '[ _ percent->radius draw-circle ] when* ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-12-08 22:30:10 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2018-01-22 15:27:46 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								TUPLE: trails-gadget < gadget points timer ;
							 | 
						
					
						
							
								
									
										
										
										
											2018-01-22 15:22:46 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: trails-gadget graft*
							 | 
						
					
						
							
								
									
										
										
										
											2019-04-21 14:07:28 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    [ timer>> start-timer ] [ call-next-method ] bi ;
							 | 
						
					
						
							
								
									
										
										
										
											2018-01-22 15:22:46 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: trails-gadget ungraft*
							 | 
						
					
						
							
								
									
										
										
										
											2018-01-22 15:27:46 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    [ timer>> stop-timer ] [ call-next-method ] bi ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-12-08 22:30:10 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								:: iterate-system ( GADGET -- )
							 | 
						
					
						
							
								
									
										
										
										
											2017-01-22 18:06:01 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    ! Add a valid point if the mouse is in the gadget
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    ! Otherwise, add an "invisible" point
							 | 
						
					
						
							
								
									
										
										
										
											2019-07-25 12:19:23 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    hand-gadget get GADGET = [ mouse ] [ f ] if
							 | 
						
					
						
							
								
									
										
										
										
											2017-01-22 18:06:01 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    GADGET points>> circular-push ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-12-08 22:30:10 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2017-01-22 18:06:01 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								M: trails-gadget pref-dim* drop { 500 500 } ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-12-08 22:30:10 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-12-18 01:16:43 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: each-percent ( seq quot -- )
							 | 
						
					
						
							
								
									
										
										
										
											2017-01-22 18:06:01 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    [ dup length ] dip '[ 1 + _ / @ ] each-index ; inline
							 | 
						
					
						
							
								
									
										
										
										
											2008-12-18 01:16:43 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2014-10-25 00:56:37 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M:: trails-gadget draw-gadget* ( GADGET -- )
							 | 
						
					
						
							
								
									
										
										
										
											2018-01-22 10:01:22 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    T{ rgba f 1 1 1 0.4 } fill-color set   ! White, with some transparency
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    T{ rgba f 0 0 0 0   } stroke-color set ! no stroke
							 | 
						
					
						
							
								
									
										
										
										
											2014-10-25 00:56:37 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    COLOR: black gl-clear
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    GADGET points>> [ dot ] each-percent ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-12-08 22:30:10 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2014-10-25 00:56:37 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: <trails-gadget> ( -- trails-gadget )
							 | 
						
					
						
							
								
									
										
										
										
											2017-01-22 18:06:01 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    trails-gadget new
							 | 
						
					
						
							
								
									
										
										
										
											2019-07-25 12:19:23 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        300 f <array> <circular> >>points
							 | 
						
					
						
							
								
									
										
										
										
											2017-01-22 18:06:01 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        t >>clipped?
							 | 
						
					
						
							
								
									
										
										
										
											2018-01-22 15:22:46 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        dup '[ _ dup iterate-system relayout-1 ]
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        f 10 milliseconds <timer> >>timer ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-12-08 22:30:10 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2016-04-21 20:00:06 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								MAIN-WINDOW: trails-window
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    { { title "Trails" } }
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    <trails-gadget> >>gadgets ;
							 |