#!/usr/bin/env pf

BORKED

# a demonstration of opengl in packet forth
# this uses the round-robin schedular to spawn
# (independent) animation tasks

# load deps
load-image
load-opengl

"rr-scheduler.pf" load



# display the surface for the first time
320 240 display 
3d 0 0 movewindow

:noname
	 ((-1 -1 -1)(-1 -1 1)(-1 1 1)(-1 1 -1)) >matrix "v3" polygon
	 (( 1 -1 -1)( 1 -1 1)( 1 1 1)( 1 1 -1)) >matrix "v3" polygon 
; displaylist cube


# EVENT HANDLING

# these have stack effect ( event -- )
# an event is a list with first atom a symbolic selector
# routing is done below
: handle-motion "MOTION : " . . .n ;
: handle-press  "PRESS  : " . . .n ;

# event handler. note you can just define words if you know all
# events and do 'interpret-list'
: handle-event
	split
		[s] motion route handle-motion
		[s] press  route handle-press
	drop	# drop selector
	"NOT HANDLED: " . . .n ;

' handle-event is responder ;


# DRAWING SUPPORT

# setup the context and run the draw-loop (frame tick)

# example program


0.0 variable! _time
: time _time >r r @ .00005 + dup r> ! ;

 (( -1 -1  0 )
  (  1 -1  0 )
  (  1  1  0 ) 
  (  0  0  0 )) >matrix constant vmatrix


: rcord normal time sin dup * dup * dup * * 10. * ;
: rtrans rcord transx rcord transy ;
: settexture curtex @ texture ;
: setblending  1 blend 0 depth [ ((.5 .3 .10101 1.0)) >matrix ]L color ;



: m-yield m-pop yield m-push ;	# pop & push matrix on yield

# some support tasks for the RR scheduler:
: task-blend  		begin  setblending  curtex @ texture yield again ;


: drawit setblending try yield recover drop endtry ;
' drawit is drawer




# ANIMATION TASKS

: drawobject
	-3. transz 
	time 100. * rotz 
	20 for 
		m-push rtrans 5.90 square m-pop 
		m-push rtrans 10.5 wsquare m-pop 
	next ;

: task-animation	m-push begin settexture drawobject m-yield  again ;




# onepole lowpass. coef is input mixin (smoothing coefficient)
# out = state + (in - state) * coef
: onepole-lowpass >r	# save state on rs
	swap 		# ( coef in )
	r - swap *	# ( state.increment )
	r> +		# ( out.state )
; "( in coef state -- out/state )" ,

# smoother. uses onepole-lowpass
: link-smoother		# ( state coef name -- )
	link-buffer , , # append coef and state
does>			# ( in -- state/out )
	>r		# save context pointer to rs
	r @ r follow @	# ( in coef state )
	onepole-lowpass	# ( out/state )
	dup r> follow !	# store state
;


: create-smoother accept link-smoother ; # parsing word wrapper

# setup code for these tasks is symbolic.
# this is easier, since the static constructing words can
# be used (i.e. variable, create, ...) and variables and
# bound words can be used inside the 'skeleton' code,
# like a tasks' main loop

# once the task is compiled, the links are moved to RS,
# so they don't interfere with other tasks.
# this is done by 'load-task' and 'boot-task' defined
# in script/scheduler.pf

# ( -- x y ) generate random target
: random-target 2normal 2. * swap 2. * ;
2.0 variable! square-size

: load-an3 (
	# create vars and helpers
	.0 .10101 create-smoother smooth-x
	.0 .10101 create-smoother smooth-y
	.0 variable! x
	.0 variable! y

	# ( size -- )
	# this moves the square
	: drawsquare
		m-push 
		x @ smooth-x transx 			# get coord + translate
		y @ smooth-y transy 
		square-size @ square 
		m-pop yield ;

	# main loop
	: start 
		random-target y ! x !
		100 rand 1 + for drawsquare next	# random duration
		start ;;

) interpret-list ;


# this uses the load-task instead of start-task interface
# start is just for one function
# load 'protects' the dictionary in case some code is compiled,
# and it starts the 'start' word as a task.
: start-an3 () ['] load-an3 load-task  ;





: make-an4-matrix
	dup >r for 3normal 3 pack next 
	r> pack >matrix ;



: load-an4 (
	variable m
	1.0 variable! a
	2.4 variable! b
	
	: start
		1000 make-an4-matrix m !
		normal 1.0 + a !
		normal 3.0 + b !
		50 rand 1 + for
			m @[ dup a @ + sin b @ * ]! linestrip yield
		next
		start ;;
) interpret-list ;


: start-an4 () ['] load-an4 load-task ;


# this uses 'start-task' because the task is just a function
# and doesn't compile any code..
: task-an3-spawner 100 for start-an3 50 rand 1 + for yield next next exit-task ;
: start-an3-spawner () ['] task-an3-spawner start-task ;



: t-square >float square yield ;

: task-an2  
	# (1 2 3 4 5 6 7 8) shuffle $ t-square cmapw
	2normal 2 pack	# random starting point
	10 for 
		m-push
		dup unpack transx transy 
		r >float .3 * square m-pop yield
	next 
	drop 
	() ['] task-an2 start-task # restart the task
	exit-task ;

: start-an2 () ['] task-an2 start-task ;



: task-an2-spawner
	50 for
		10 rand 1 + for yield next start-an2 "x" .
	next
	exit-task ;

: start-an2-spawner () ['] task-an2-spawner start-task ;


# start some tasks
run start-an3-spawner

# run interactive
interactive