\ graphics for "henri poincare"
\
\ hp_screen+
\ more elaborate 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/17/99	Started project.
\ MOD: HeP 10/02/00	Add default qwerty key function.
\ MOD: HeP 10/05/00	Use RAW.DRAW: and RAW.UNDRAW: methods. This makes
\					subclassing a little easier.
\					Provisional implementation of 3d ("oblique") drawing and
\					HIGHLIGHT:ing.
\ MOD: HeP 10/06/00	Implement frame (axis) methods.
\ MOD: HeP 10/07/00	Can auto-center around window dimensions!
\					Fix incorrect drawing of 3d oblique projections.
\ MOD: HeP 10/08/00	Add a couple of instance variables to hold the coords of
\					the oblique projection: no longer calculate those coords
\					more than once.
\ MOD: HeP 03-21-04	Cleanup code in GRP.3D.HIGHLIGHT and mark the axis (would
\					have used dotted lines, but the diagonal sometimes goes
\					missing).

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

include?  task-hp_screen   myt:hp_screen


anew task-hp_screen+


method 2D.VIEW:
method 3D.VIEW:

:class  OB.GR.PARTICLE+  <super  OB.GR.PARTICLE
	
	iv.byte  iv-grp-3d-view?
	
	iv.long  iv-grp-3d-x
	iv.long  iv-grp-3d-y
	
	
:m DEFAULT:	(  --  )
	default: super
\
	true  iv=> iv-grp-3d-view?
;m


:m 2D.VIEW:	(  --  )
	iv-grp-3d-view?
	IF	iv-grp-visible? iv-grp-drawn?  AND
		IF
			self RAW.UNDRAW: []
			false iv=> iv-grp-3d-view?
			self RAW.DRAW: []
		ELSE
			false iv=> iv-grp-3d-view?
		THEN
	THEN
;m

:m 3D.VIEW:	(  --  )
	iv-grp-3d-view? NOT
	IF	iv-grp-visible? iv-grp-drawn?  AND
		IF
			self RAW.UNDRAW: []
			true  iv=> iv-grp-3d-view?
			self RAW.DRAW: []
		ELSE
			true  iv=> iv-grp-3d-view?
		THEN
	THEN
;m


: GRP.3D.XY		( x y z -- x y , 2d oblique projection of 3d image )
	2/
	rot  over -
	-rot      +
;

: GRP.3D.HIGHLIGHT	(  --  )
	gr.mode@
	gr_xor_mode  gr.mode!
\
	hp-grsp-frame? @
	IF
		0 hp-grsp-frame-offset @  iv-grp-y  iv-grp-z  GRP.3D.XY  gr.move
		iv-grp-3d-x iv-grp-3d-y  gr.draw
		iv-grp-x  1 hp-grsp-frame-offset @  iv-grp-z  GRP.3D.XY  gr.draw
		iv-grp-3d-x iv-grp-3d-y  gr.move
		iv-grp-x  iv-grp-y  2 hp-grsp-frame-offset @  GRP.3D.XY  gr.draw
	\
	\ draw the axis
	\
	\ "origin" gets reused
		0 hp-grsp-frame-offset @  1 hp-grsp-frame-offset @  2 hp-grsp-frame-offset @
		GRP.3D.XY
	\ the diagonal doesn't like to be dotted...
		2dup  gr.move		\ to "origin"
		0 hp-grsp-frame-offset @  1 hp-grsp-frame-offset @  iv-grp-z
		GRP.3D.XY  gr.draw
	\ ...but dot the rest
		GR.DOTTED.ON
		iv-grp-x  1 hp-grsp-frame-offset @  2 hp-grsp-frame-offset @
		GRP.3D.XY  gr.move
		gr.draw				\ to "origin"
		0 hp-grsp-frame-offset @  iv-grp-y  2 hp-grsp-frame-offset @
		GRP.3D.XY  gr.draw
		GR.DOTTED.OFF
	ELSE
		iv-grp-3d-x 32 - iv-grp-3d-y       gr.move
		iv-grp-3d-x 32 + iv-grp-3d-y       gr.draw
		iv-grp-3d-x      iv-grp-3d-y 32 -  gr.move
		iv-grp-3d-x      iv-grp-3d-y 32 +  gr.draw
		iv-grp-3d-x 16 - iv-grp-3d-y 16 +  gr.move
		iv-grp-3d-x 16 + iv-grp-3d-y 16 -  gr.draw
	THEN
\
	gr.mode!
;

: GRP.3D.BUBBLE	(  --  )
	gr.mode@
	gr_xor_mode  gr.mode!
\
	iv-grp-3d-x 16 -  iv-grp-3d-y 8 -
	iv-grp-3d-x 16 +  iv-grp-3d-y 8 +
	gr.oval
\
	gr.mode!
;

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


:m RAW.DRAW:	(  --  )
	iv-grp-3d-view?
	IF
		iv-grp-x  iv-grp-y  iv-grp-z  GRP.3D.XY
		iv=> iv-grp-3d-y
		iv=> iv-grp-3d-x
	\
		iv-grp-mode
		CASE
			fgr_bubble_mode OF  grp.3d.bubble  ENDOF
			fgr_trace_mode  OF  grp.3d.trace   ENDOF
		ENDCASE
	\
		iv-grp-highlight?
		IF	grp.3d.highlight
		THEN
	ELSE
		raw.draw: super
	THEN
;m

:m RAW.UNDRAW:	(  --  )
	iv-grp-3d-view?
	IF
		iv-grp-mode  fgr_bubble_mode =
		IF	grp.3D.bubble
		THEN
	\
		iv-grp-highlight?
		IF	grp.3d.highlight
		THEN
	ELSE
		raw.undraw: super
	THEN
;m

;class



\ graphical space (screen) class

:class  OB.GR.SPACE+  <super  OB.GR.SPACE
	
	
\ pass thru methods

:m 2D.VIEW:	(  --  )
	many: self  0
	DO	i get: self  2d.view: []
	LOOP
;m

:m 3D.VIEW:	(  --  )
	many: self  0
	DO	i get: self  3d.view: []
	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
	\
		ascii P  OF  2d.view: grsp          ENDOF
		ascii O  OF  3d.view: 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-grsp
	
	ob.gr.particle+  test-grp-1
	ob.gr.particle+  test-grp-2
	ob.gr.particle+  test-grp-3
	ob.gr.particle+  test-grp-4
	
	: HPSCR.TEST.SHAPE+	{ shape | x y z --  }
		0  -> x
		0  -> y
		0  -> z
	\
		x y z  add: shape
	\
		empty: shape
	\
		max.elements: shape 1-
		0
		DO	x  8 choose choose+/-  +   gr_window_width  2/ mod  -> x
			y  8 choose choose+/-  +   gr_window_height 2/ mod  -> y
			z  8 choose choose+/-  +   400 mod                  -> z
			x y z  add: shape
		LOOP
	;
	
	: HPSCR.TEST.INIT+	(  --  )
		128 3  new: shape-1
	\
		64 0
		DO
			200
			32
			i  4*
			add: shape-1
		LOOP
	\
		64 0
		DO
			200
			32
			64 i -  4*
			add: shape-1
		LOOP
	\
		128  3  new: shape-2  shape-2  hpscr.test.shape+
		128  3  new: shape-3  shape-3  hpscr.test.shape+
		128  3  new: shape-4  shape-4  hpscr.test.shape+
	\
		" Test hp" put.title: test-grsp
		ascii H    put.key: test-grsp
		test-grsp  default-screen !
	\
		5  new: test-grsp
		test-grp-1  add: test-grsp
		test-grp-2  add: test-grsp
		test-grp-3  add: test-grsp
		test-grp-4  add: test-grsp
	\
		8  put.duration: player-1
		-1 put.dur.dim: player-1
		1000  put.repeat: player-1
		shape-1 test-grp-1  build: player-1
	\
		shape-2  test-grp-2  build: player-2
		shape-3  test-grp-3  build: player-3
		shape-4  test-grp-4  build: player-4
		-1  put.dur.dim: player-2
		-1  put.dur.dim: player-3
		-1  put.dur.dim: player-4
		 8  put.duration: player-2
		 8  put.duration: player-3
		 8  put.duration: player-4
		1000  put.repeat: player-2
		1000  put.repeat: player-3
		1000  put.repeat: player-4
	\
		4  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
	;
	
	: HPSCR.TEST.TERM+	(  --  )
		free: test-grsp
		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