\ graphics for "henri poincare"
\
\ hp_screen
\ screen and graphics classes to display "henri poincare" components.
\
\ Based on ideas presented by Joel Ryan.
\
\ code: Han-earl Park
\ copyright 2004 buster & friends' C-ALTO Labs
\ (Den haag, December 1997 -
\ (Valencia, October 1998 -
\ (Southampton, May 2000 -
\
\ MOD: HeP 11/24/98	Started fim.screen and gr.particle classes.
\ MOD: HeP 03/04/99	Add pass thru methods for calling an instrument.
\ MOD: HeP 03/29/99	Hide or show particle via the PUT.VISIBLE: method.
\ MOD: HeP 07/27/99	Change name of components to "henri poincare"
\ MOD: HeP 08/12/99	Add key function in gr.space class fro qwerty input.
\ MOD: HeP 11/14/99	Trash put.instrument: method since the fan.out
\					class is now avilable.
\ MOD: HeP 11/17/99	Trash (for the moment) the LINE.MODE: method.
\					rename OVAL.MODE: as BUBBLE.MODE:
\					add OVAL.MODE: and TRACE.MODE: methods to the
\					gr.space class.
\ MOD: HeP 11/29/99	ob.gr.space inherits DELETE: 0STUFF: and }STUFF:
\					methods from ob.list.
\ MOD: HeP 05/24/00	The gr.space and gr.particle classes are now subclasses
\					of gr.view and graphic respecively. Copy some of the
\					code to gr_view.
\ MOD: HeP 05/25/00	Value of iv-grp-visible? is dependent on whether
\					gr.particle has been OPEN:ed.
\ MOD: HeP 06/06/00	Remove (Macintosh) graphics functions since they're
\					defined in gr_view.
\ MOD: HeP 06/22/00	Check that iv-grp-visible? and iv-grp-drawn? are both
\					true before erasing in UNDRAW:
\ MOD: HeP 10/02/00	Add default qwerty key function.
\ MOD: HeP 10/04/00	Redesign! Move offset and scaled drawing from hp_screen+.
\					Redesign involves removal of the graphic environment from
\					the gr.particle class. This is fine, since we assume the
\					user will primarily interact with the gr.space class.
\					Implement HIGHLIGHT:ing methods.
\ MOD: HeP 10/05/00	Use RAW.DRAW: and RAW.UNDRAW: methods. This makes
\					subclassing a little easier.
\ MOD: HeP 10/06/00	Move mouse handler stubs from gr.space to gr.view class.
\					Implement frame (axis) methods.
\ MOD: HeP 10/07/00	Can auto-center around window dimensions!
\ MOD: HeP 10/08/00	Rename DRAW.FRAME: and UNDRAW.FRAME: methods as FRAME.ON:
\					and FRAME.OFF:
\					Add provision to use less that 3 dimensions.
\					Solve some problems with highlighting particles by adding
\					the UNHIGHLIGHT: method.
\ MOD: HeP 10/09/00	RAW.CLOSE: correctly erases particle.
\ MOD: HeP 03-21-04	Cleanup code in GRP.HIGHLIGHT and add dotted lines to mark
\					the axis.
\ MOD: HeP 04-20-04	Minor modifications to ease subclassing.
\ MOD: HeP 05-03-04	Fix stack error in ELEMENT.ON: method.

include?  task-graph_plus  myt:graph_plus
include?  task-device      myt:device
include?  task-gr_view     myt:gr_view


anew task-hp_screen


\ color

0 constant hp_fground_color
1 constant hp_bground_color


\ globals - internal use!

variable  hp-grsp-dimension#

3  array  hp-grsp-offset
3  array  hp-grsp-scale-numer
3  array  hp-grsp-scale-denom

3  array  hp-grsp-frame-offset

variable  hp-grsp-frame?


\ graphical particle

0 constant fgr_bubble_mode
1 constant fgr_trace_mode


method UNHIGHLIGHT:

method PUT.VISIBLE:
method BUBBLE.MODE:		method TRACE.MODE:


:class  OB.GR.PARTICLE  <super  OB.GRAPHIC
	
	iv.long  iv-grp-x
	iv.long  iv-grp-y
	iv.long  iv-grp-z
	
	iv.byte  iv-grp-highlight?
	
	iv.byte  iv-grp-visible?
	iv.byte  iv-grp-drawn?
	
	iv.byte  iv-grp-mode
	
	
:m INIT:	(  --  )
	init: super
\
	0 iv=> iv-grp-x
	0 iv=> iv-grp-y
	0 iv=> iv-grp-z
\
	false  iv=> iv-grp-visible?
	false  iv=> iv-grp-drawn?
;m

:m DEFAULT:	(  --  )
	default: super
\
	false iv=> iv-grp-highlight?
	fgr_bubble_mode iv=> iv-grp-mode
;m


:m RAW.OPEN:	(  --  )
	true  iv=> iv-grp-visible?
;m

:m RAW.CLOSE:	(  --  )
	self undraw: []
	false iv=> iv-grp-highlight?
	false iv=> iv-grp-visible?
;m


: GRP.BUBBLE	(  --  )
	gr.mode@
	gr_xor_mode  gr.mode!
\
	iv-grp-x
	iv-grp-y
	iv-grp-z  2 hp-grsp-frame-offset @ +  -4 ashift  8 +  2 max  \ ***
	gr.circle
\
	gr.mode!
;

: GRP.TRACE		(  --  )
	hp_fground_color  gr.color!
	iv-grp-x iv-grp-y  gr.dot
;

: GRP.HIGHLIGHT	(  --  )
	gr.mode@
	gr_xor_mode  gr.mode!
\
	hp-grsp-frame? @
	IF
		0 hp-grsp-frame-offset @  iv-grp-y  gr.move
		iv-grp-x                  iv-grp-y  gr.draw
		iv-grp-x  1 hp-grsp-frame-offset @  gr.draw
	\
		gr.dotted.on
		0 hp-grsp-frame-offset @  1 hp-grsp-frame-offset @  gr.draw
		0 hp-grsp-frame-offset @  iv-grp-y  gr.draw
		gr.dotted.off
	ELSE
		iv-grp-x 32 -  iv-grp-y  gr.move
		iv-grp-x 32 +  iv-grp-y  gr.draw
		iv-grp-x  iv-grp-y 32 -  gr.move
		iv-grp-x  iv-grp-y 32 +  gr.draw
	THEN
\
	gr.mode!
;


:m BUBBLE.MODE:	(  --  )
	iv-grp-mode  fgr_bubble_mode =  NOT
	IF	iv-grp-visible? iv-grp-drawn?  AND
		IF
			self RAW.UNDRAW: []
			fgr_bubble_mode  iv=> iv-grp-mode
			self RAW.DRAW: []
		ELSE
			fgr_bubble_mode iv=> iv-grp-mode
		THEN
	THEN
;m

:m TRACE.MODE:	(  --  )
	iv-grp-mode  fgr_trace_mode =  NOT
	IF	iv-grp-visible? iv-grp-drawn?  AND
		IF
			self RAW.UNDRAW: []
			fgr_trace_mode  iv=> iv-grp-mode
			self RAW.DRAW: []
		ELSE
			fgr_trace_mode iv=> iv-grp-mode
		THEN
	THEN
;m


:m PUT.VISIBLE:	( flag --  , hide or show particle )
	IF
		true iv=> iv-grp-visible?
		self DRAW: []
	ELSE
		iv-grp-drawn?
		IF	self UNDRAW: []
		THEN
		false  iv=> iv-grp-visible?
	THEN
;m


:m HIGHLIGHT:	(  --  )
	iv-grp-visible? iv-grp-drawn?  AND
	IF
		self RAW.UNDRAW: []
		true  iv=> iv-grp-highlight?
		self RAW.DRAW: []
	ELSE
		true  iv=> iv-grp-highlight?
	THEN
;m

:m UNHIGHLIGHT:	(  --  )
	iv-grp-visible? iv-grp-drawn?  AND
	IF
		self RAW.UNDRAW: []
		false  iv=> iv-grp-highlight?
		self RAW.DRAW: []
	ELSE
		false  iv=> iv-grp-highlight?
	THEN
;m


:m RAW.DRAW:	(  --  )
	iv-grp-mode
	CASE
		fgr_bubble_mode OF  grp.bubble  ENDOF
		fgr_trace_mode  OF  grp.trace   ENDOF
	ENDCASE
	iv-grp-highlight?
	IF	grp.highlight
	THEN
;m

:m RAW.UNDRAW:	(  --  )
	iv-grp-mode  fgr_bubble_mode =
	IF	grp.bubble
	THEN
	iv-grp-highlight?
	IF	grp.highlight
	THEN
;m


:m DRAW:	(  --  )
	iv-grp-visible?
	IF
		self RAW.DRAW: []
		true iv=> iv-grp-drawn?
	THEN
;m

:m UNDRAW:	(  --  )
	iv-grp-visible? iv-grp-drawn?  AND
	IF
		self RAW.UNDRAW: []
	THEN
	false  iv=> iv-grp-drawn?
;m


:m MOVE:	( x y z --  )
	iv-grp-visible? iv-grp-drawn? AND
	IF
		self RAW.UNDRAW: []
	\
		iv=> iv-grp-z
		iv=> iv-grp-y
		iv=> iv-grp-x
	\
		self RAW.DRAW: []
	ELSE
		iv=> iv-grp-z
		iv=> iv-grp-y
		iv=> iv-grp-x
	THEN
;m


: GRP.TRANSLATE	( n dim# -- n , offset and scale coordinate )
	swap								\  -- dim# n
	over  hp-grsp-scale-numer @ *		\  -- dim# n
	over  hp-grsp-scale-denom @ /		\  -- dim# n
	swap  hp-grsp-offset @ +			\  --      n
;

:m ELEMENT.ON:	{ elm# obj --  , draw based on data from particle }
	iv-dev-on-cfa
	IF
		elm#  obj
		self  iv-dev-on-cfa  -3 exec.stack?
	ELSE
		elm#  hp-grsp-dimension# @     dimension: obj mod  ed.at: obj
		0  grp.translate
		elm#  hp-grsp-dimension# @ 1+  dimension: obj mod  ed.at: obj
		1  grp.translate
		elm#  hp-grsp-dimension# @ 2+  dimension: obj mod  ed.at: obj
		2  grp.translate
	\
		self move: []
	THEN
;m

:m ELEMENT.OFF:	( elm# obj --  )
	iv-dev-off-cfa
	IF	self  iv-dev-off-cfa  -3 exec.stack?
	THEN
;m

;class



\ graphical space (screen) class

method HIGHLIGHT.NEXT:

method PUT.FRAME:
method FRAME.ON:		method FRAME.OFF:
method CENTER.ON:		method CENTER.OFF:

method PUT.DIM:			method PUT.SCALE:


:class  OB.GR.SPACE  <super  OB.GR.VIEW
	
	iv.long  iv-grsp-dimension#
	
	3  iv.array  iv-grsp-offset
	3  iv.array  iv-grsp-scale-numer
	3  iv.array  iv-grsp-scale-denom
	
	3  iv.array  iv-grsp-frame-offset
	
	iv.byte  iv-grsp-frame?
	iv.byte  iv-grsp-center?
	
	iv.long  iv-grsp-hilighted
	
	
:m INIT:	(  --  )
	init: super
	-1  iv=> iv-grsp-hilighted
;m

:m DEFAULT:	(  --  )
	0  iv=> iv-grsp-dimension#
\
	0  0 iv-grsp-offset !
	0  1 iv-grsp-offset !
	0  2 iv-grsp-offset !
\
	1  0 iv-grsp-scale-numer !
	1  1 iv-grsp-scale-numer !
	1  2 iv-grsp-scale-numer !
\
	1  0 iv-grsp-scale-denom !
	1  1 iv-grsp-scale-denom !
	1  2 iv-grsp-scale-denom !
\
	0  0 iv-grsp-frame-offset !
	0  1 iv-grsp-frame-offset !
	0  2 iv-grsp-frame-offset !
\
	true  iv=> iv-grsp-frame?
	true  iv=> iv-grsp-center?
\
	hp_bground_color  iv=> iv-grvw-color
;m


: GRSP.TRANSLATE	( n dim# -- n , offset and scale coordinate )
	swap								\  -- dim# n
	over  iv-grsp-scale-numer @ *		\  -- dim# n
	over  iv-grsp-scale-denom @ /		\  -- dim# n
	swap  iv-grsp-offset @ +			\  --      n
;


\ frame (axis)

:m PUT.FRAME:	( x y z --  )
	2 iv-grsp-frame-offset !
	1 iv-grsp-frame-offset !
	0 iv-grsp-frame-offset !
\
	iv-sc-drawn
	IF	self draw: []
	THEN
;m


:m FRAME.ON:	(  --  )
	true  iv=> iv-grsp-frame?
	iv-sc-drawn
	IF	self draw: []
	THEN
;m

:m FRAME.OFF:	(  --  )
	false iv=> iv-grsp-frame?
	iv-sc-drawn
	IF	self draw: []
	THEN
;m


\ center on window

:m CENTER.ON:	(  --  )
	true  iv=> iv-grsp-center?
	iv-sc-drawn
	IF	self draw: []
	THEN
;m

:m CENTER.OFF:	(  --  )
	false iv=> iv-grsp-center?
	iv-sc-drawn
	IF	self draw: []
	THEN
;m


\ highlight particle

:m HIGHLIGHT:	( elm# --  )
	dup -1 =
	IF
		iv-grsp-hilighted  0>=
		IF	iv-grsp-hilighted  get: self  unhighlight: []
		THEN
	ELSE
		iv-grsp-hilighted  0>=
		IF	iv-grsp-hilighted  get: self  unhighlight: []
		THEN
		dup  get: self  highlight: []
	THEN
	iv=> iv-grsp-hilighted
;m

:m HIGHLIGHT.NEXT:	(  --  )
	iv-grsp-hilighted
	-1 =
	IF
		0  self highlight: []
	ELSE
		iv-grsp-hilighted 1+  many: self  mod  self highlight: []
	THEN
;m


\ setup drawing environment

: GRSP.SET.GLOBALS	(  --  , update global variables for particles )
	iv-grsp-dimension#  hp-grsp-dimension# !
\
	0 iv-grsp-scale-numer @  0 hp-grsp-scale-numer !
	1 iv-grsp-scale-numer @  1 hp-grsp-scale-numer !
	2 iv-grsp-scale-numer @  2 hp-grsp-scale-numer !
	0 iv-grsp-scale-denom @  0 hp-grsp-scale-denom !
	1 iv-grsp-scale-denom @  1 hp-grsp-scale-denom !
	2 iv-grsp-scale-denom @  2 hp-grsp-scale-denom !
\
	iv-grsp-center?
	IF
		gr_window_width  2/  0 hp-grsp-offset !
		gr_window_height 2/  1 hp-grsp-offset !
		2 iv-grsp-offset @   2 hp-grsp-offset !
	\
		gr_window_width  2/  0 hp-grsp-frame-offset !
		gr_window_height 2/  1 hp-grsp-frame-offset !
		2 iv-grsp-frame-offset @  2 grsp.translate  2 hp-grsp-frame-offset !
	ELSE
		0 iv-grsp-offset @  0 hp-grsp-offset !
		1 iv-grsp-offset @  1 hp-grsp-offset !
		2 iv-grsp-offset @  2 hp-grsp-offset !
	\
		0 iv-grsp-frame-offset @  0 grsp.translate  0 hp-grsp-frame-offset !
		1 iv-grsp-frame-offset @  1 grsp.translate  1 hp-grsp-frame-offset !
		2 iv-grsp-frame-offset @  2 grsp.translate  2 hp-grsp-frame-offset !
	THEN
\
	iv-grsp-frame?  hp-grsp-frame? !
;


:m DRAW:	(  --  , setup environment and screen and particles )
	grsp.set.globals
	draw: super
\
\	hmsl-window @
\	IF	hmsl-window @  DrawGrowIcon()
\	THEN
\
;m

:m UNDRAW:	(  --  )
	undraw: super
;m


: GRSP.REPORT.ERROR	( $ --  )
	" graphical dimension specified must be -1 or between 0 and 2"
	er_warning  ob.report.error
;


: GRSP.PUT.OFFSET	( n dim# --  )
	dup 0<
	IF
		drop
		dup  0 iv-grsp-offset !
		dup  1 iv-grsp-offset !
		     2 iv-grsp-offset !
	ELSE
		iv-grsp-offset !
	THEN
;

:m PUT.OFFSET:	( n dim# --  , set dimension offset value )
	dup  -1 3  within?
	IF
		grsp.put.offset
	\
		iv-sc-drawn
		IF	self draw: []
		THEN
	ELSE
		2drop
		" put.offset:"  grsp.report.error
	THEN
;m


: GRSP.PUT.SCALE	( numer denom dim# --  )
	dup -1 =
	IF
		drop
		dup  0 iv-grsp-scale-denom !
		dup  1 iv-grsp-scale-denom !
		     2 iv-grsp-scale-denom !
		dup  0 iv-grsp-scale-numer !
		dup  1 iv-grsp-scale-numer !
		     2 iv-grsp-scale-numer !
	ELSE
		swap over iv-grsp-scale-denom !
		          iv-grsp-scale-numer !
	THEN
;

:m PUT.SCALE:	( numer denom dim# --  , set dimension scaling factor )
	dup  -1 3  within?
	IF
		grsp.put.scale
	\
		iv-sc-drawn
		IF	self draw: []
		THEN
	ELSE
		3drop
		" put.scale:"  grsp.report.error
	THEN
;m

:m PUT.DIM:	( dim# --  , assign x dimension number )
	iv=> iv-grsp-dimension#
	iv-sc-drawn
	IF	self draw: []
	THEN
;m


\ pass thru methods

:m BUBBLE.MODE:	(  --  )
	many: self 0
	DO	i get: self  bubble.mode: []
	LOOP
;m

:m TRACE.MODE:	(  --  )
	many: self 0
	DO	i get: self  trace.mode: []
	LOOP
;m


\ qwerty

: GRSP.DEFAULT.KEY.FUNC	{ char grsp --  }
	char
	CASE
		ascii B  OF  bubble.mode: grsp      ENDOF
		ascii T  OF  trace.mode: grsp       ENDOF
		BL       OF  draw: grsp             ENDOF
	\
		TAB_char OF  highlight.next: grsp   ENDOF
		ascii `  OF  -1  highlight: grsp    ENDOF
	\
		ascii F  OF  frame.on: grsp         ENDOF
		ascii G  OF  frame.off: grsp        ENDOF
	ENDCASE
;

:m KEY:	( char --  )
	toupper						\ convert character to upper case
\
	iv-grvw-key-cfa
	IF
		self iv-grvw-key-cfa	\  -- char addr cfa
		-2 exec.stack?			\  --
	ELSE
		self  GRSP.DEFAULT.KEY.FUNC
	THEN
;m

;class



\ test

false .IF
	
	ob.gr.space    test-space
	ob.gr.particle test-particle-1
	ob.gr.particle test-particle-2
	ob.gr.particle test-particle-3
	ob.gr.particle test-particle-4
	ob.gr.particle test-particle-5
	
	: HPSCR.TEST.SHAPE	{ shape | x y z --  }
		0  -> x
		0  -> y
		0  -> z
	\
		256 128 wchoose 
		dup  3  new: shape
		0
		DO	x  12 choose choose+/-  +   gr_window_width  2/ mod  -> x
			y  12 choose choose+/-  +   gr_window_height 2/ mod  -> y
			z  12 choose choose+/-  +   600                 mod  -> z
			x y z  add: shape
		LOOP
	;
	
	: HPSCR.TEST.INIT	(  --  )
		5 new: test-space
		test-particle-1  add: test-space
		test-particle-2  add: test-space
		test-particle-3  add: test-space
		test-particle-4  add: test-space
		test-particle-5  add: test-space
		ascii T  put.key: test-space
		test-space  default-screen !
	\
		5 new: coll-p-1
		player-1  add: coll-p-1
		player-2  add: coll-p-1
		player-3  add: coll-p-1
		player-4  add: coll-p-1
		player-5  add: coll-p-1
		shape-1  HPSCR.TEST.SHAPE
		shape-2  HPSCR.TEST.SHAPE
		shape-3  HPSCR.TEST.SHAPE
		shape-4  HPSCR.TEST.SHAPE
		shape-5  HPSCR.TEST.SHAPE
		shape-1  test-particle-1  build: player-1
		shape-2  test-particle-2  build: player-2
		shape-3  test-particle-3  build: player-3
		shape-4  test-particle-4  build: player-4
		shape-5  test-particle-5  build: player-5
		-1  put.dur.dim: player-1
		-1  put.dur.dim: player-2
		-1  put.dur.dim: player-3
		-1  put.dur.dim: player-4
		-1  put.dur.dim: player-5
		 4  put.duration: player-1
		 4  put.duration: player-2
		 4  put.duration: player-3
		 4  put.duration: player-4
		 4  put.duration: player-5
		8  put.repeat: player-1
		8  put.repeat: player-2
		8  put.repeat: player-3
		8  put.repeat: player-4
		8  put.repeat: player-5
	;
	
	: HPSCR.TEST.TERM	(  --  )
		free: test-space
		free.hierarchy: coll-p-1
	;
	
	if.forgotten  hpscr.test.term
	
	: HPSCR.TEST	(  --  )
		hpscr.test.init   coll-p-1 hmsl.play   hpscr.test.term
	;
	
	cr  ." Enter HPSCR.TEST to test the hp_screen components." cr cr
	
.THEN