\ more h4th graphics
\
\ graph_plus
\ additional mac specific graphics functions.
\
\ code: Han-earl Park
\ copyright 2004 buster & friends' C-ALTO Labs
\ (Southampton, August 2000 -
\
\ MOD: HeP 08/30/00	Started project.
\ MOD: HeP 09/10/00	Change file name from h4th_graph_plus to graph_plus.
\ MOD: HeP 03-19-04	Add GR.DOTTED.ON and GR.DOTTED.OFF.
\ MOD: HeP 04-19-04	Add SCREENBITS based on Mops code.
\ MOD: HeP 05-03-04	Can change the pen's size.
\					Add drawing of oval outline.
\					Add to sys.init chain.
\					Write test and accidentally come across the Moholy-Nagy
\					emulator (also shows off the limitations of h4th's
\					pseudo-random number generator).
\ MOD: HeP 05-04-04	Implement creating, drawing and disposing of polygons.
\					In test, reset rand-seed to stop too much repetition.
\ MOD: HeP 05-05-04	Prevent nesting of GR.POLYGON{ ... }GR.POLYGON.
\					Redefine GR.CLEAR.
\					Fix silly error in GR.NEW.POLYGON which got the x, y
\					values the other way around.
\ MOD: HeP 05-07-04	Add constant currentA5 equal to $ 904.
\ MOD: HeP 08-04-04	Move reset of polygon{}-depth in }GR.POLYGON earlier. In
\					the old position, the reset did not occur after abort".


anew task-graph_plus


\ screen display dimensions (based on Mops 68k)
\
\ note:	this depends on accessing the Mac's low memory globals, so be careful
\		since this is no longer Apple's idea of a good idea.
\		Note also the following changes from the Mops implementation: We
\		create a constant currentA5, and since h4th does not have Mops'
\		UNPACK, but we use the RECT struct instead.

$ 904  constant  currentA5

: SCREENBITS	(  -- l t r b , dimension coordinates of display )
	currentA5 @		\ fetch address pointed to by a5
	@				\ which in turn points to thePort
	116 -			\ offset address to relevant rect
\
	>r
	r@  ..@ rect_left
	r@  ..@ rect_top
	r@  ..@ rect_right
	r>  ..@ rect_bottom
;


: SCREENBITS.WH	(  -- width height )
	screenbits
	rot -
	-rot swap -
	swap
;


\ macintosh graphic calls

: PenSize()		( wh --  )
	pass: 4  trap: a89b
;


: FrameOval()	( rect --  )
	pass: 4  trap: a8b7
;

: PaintOval()	( rect --  )
	pass: 4  trap: a8b8
;


: OpenPoly()	(  -- polyHandle )
	0>r
	trap: A8CB
	r>
;

: ClosePoly()	(  --  )
	trap: A8CC
;

: KillPoly()	( polyHandle --  )
	>r  trap: A8CD
;

: FramePoly()	( polyHandle --  )
	>r  trap: A8C6
;

: PaintPoly()	( polyHandle --  )
	>r  trap: A8C7
;


\ clear or fill window
\
\ gr.clear is defined in hh:h4th_graph. That implementation uses gr_xmax and
\ gr_ymax to set the erased area, but neither of these values depend on the
\ window's actual dimensions (easily altered via resizing, etc). So, let's
\ redefine it here using gr_window_width and gr_window_height instead.

: GR.FILL	(  --  , fill screen with current color )
	0 0  gr_window_width gr_window_height  gr.rect
;

: GR.CLEAR	(  --  , clear window )
	gr.color@  0 gr.color!
	gr.mode@   gr_insert_mode gr.mode!
\
	0 0  gr_window_width gr_window_height  gr.rect
\
	gr.mode!
	gr.color!
;


\ line size

variable  gr-line-wh

: GR.LINE.WH!	( width height --  )
	16 shift OR
	dup  gr-line-wh !
\
	gr.setport
	PenSize()
;

: GR.LINE.WH@	(  -- width height )
	gr-line-wh @
	dup  $ ffff AND
	swap  -16 shift
;


\ "dotted" lines and patterns

variable  gr-dotted

: GR.DOTTED.ON	(  --  )
	true  gr-dotted !
\
	gr.setport
	gray_pattern penpat()
;

: GR.DOTTED.OFF	(  --  )
	false  gr-dotted !
\
	gr.setport
	pennormal()
;

: GR.DOTTED!	( flag --  )
	IF	gr.dotted.on  ELSE  gr.dotted.off
	THEN
;

: GR.DOTTED@	(  -- flag )
	gr-dotted @
;


\ point

: GR.DOT	( x y --  )
	2dup  gr.move
	gr.draw
;


\ circles and ovals

: GR.OVAL	( x1 y1 x2 y2 --  )
	1+ gr-rect 4+ w!
	1+ gr-rect 6 + w!
	gr-rect w!
	gr-rect 2 + w!
\
	gr.setport
	gr-rect  PaintOval()
;

: GR.FRAME.OVAL	( x1 y1 x2 y2 --  )
	1+ gr-rect 4+ w!
	1+ gr-rect 6 + w!
	gr-rect w!
	gr-rect 2 + w!
\
	gr.setport
	gr-rect  FrameOval()
;


: GR.CIRCLE	{ x y r --  , circle with center x y and radius r }
	x r -  y r -
	x r +  y r +
	gr.oval
;

: GR.FRAME.CIRCLE	{ x y r --  , circle with center x y and radius r }
	x r -  y r -
	x r +  y r +
	gr.frame.oval
;


: GR.ARC	( x y w h ang --  )
	
;


\ polygons
\
\ QuickDraw has its own way of handling polygons so I have no idea how easy
\ it would be to port the following. I recommend using either }GR.POLYGON or
\ }GR.POLYGON.DISPOSE as these check for certain errors and the code most
\ likely to be portable.

variable  polygon-handle	\ previously created polygon

: GR.NEW.POLYGON	( x1 y1 x2 y2 ... xn yn n -- polyHandle | 0 )
	gr.setport
\
	OpenPoly()
\
	dup  polygon-handle !
	IF
		-rot
		gr.move
		1-  0
		DO	gr.draw
		LOOP
	\
		ClosePoly()
	THEN
	polygon-handle @
;

: GR.DISPOSE.POLYGON	( polyHandle --  )
	KillPoly()
;


: GR.POLYGON	( polyHandle --  )
	gr.setport
	PaintPoly()
;


variable  polygon{}-depth

: GR.POLYGON{	(  --  , start specification of polygon )
	polygon{}-depth @  -1 =
	IF
		depth polygon{}-depth !
	ELSE
		true
		abort" Consecutive calls to gr.polygon{ without a }gr.polygon. You cannot nest gr.polygon{...}gr.polygon"
	THEN
;


\ usage:
\
\	gr.polygon{  x0 y0 x1 y1 x2 y2 ... xn yn  }gr.polygon
\	gr.polygon{  x0 y0 x1 y1 x2 y2 ... xn yn  }gr.polygon.dispose
\

: }GR.POLYGON	( x0 y0 ... xn yn -- polyHandle | 0 , draw and return handle )
	depth  polygon{}-depth @ -
\
	-1  polygon{}-depth !	\ reset to prevent nesting
\
	dup  1 AND  0=			\ true if even number of items
	over 0>  AND			\ and greater than zero
	IF
		2/					\ number of points
	\
		gr.new.polygon		\  -- polyHandle
	\
		dup
		IF	dup  gr.polygon
		THEN
	ELSE
		true  abort" Incorrect number of items passed to }gr.polygon."
	THEN
;

: }GR.POLYGON.DISPOSE	( x0 y0 ... xn yn --  , draw and dispose struct )
	}gr.polygon
	?dup
	IF	gr.dispose.polygon
	THEN
;


\ region

: GR.RGN	( ?? --  )
	
;


\ picture

: GR.PICT	( ?? --  )
	
;


\ initialize

: GR.PLUS.INIT	(  --  )
	1  1  16 shift OR  gr-line-wh !
	false  gr-dotted !
	 0  polygon-handle !
	-1  polygon{}-depth !
;

: SYS.INIT	(  --  )
	sys.init
	gr.plus.init
;

gr.plus.init



\ test
\
\ aka the Moholy-Nagy emulator

false .IF
	
	: GRPT.RANDOM.LINE.WH	(  --  )
		20 choose choose  20 choose choose  gr.line.wh!
	;
	
	variable  prev-x
	variable  prev-y
	
	: GRPT.RANDOM.LINE	(  --  )
		prev-x @  prev-y  @   gr.move
	\
		gr_window_width  choose
		gr_window_height choose
		2dup  gr.draw
	\
		prev-y !  prev-x  !
	;
	
	: GRPT.RANDOM.OVAL	(  --  )
		gr_window_width  choose  gr_window_width  choose  2sort
		gr_window_height choose  gr_window_height choose  2sort
		rot swap
	\
		2 choose
		IF
			gr.oval
		ELSE
			gr.frame.oval
		THEN
	;
	
	variable temp
	
	: GRPT.RANDOM.POLYGON	(  --  )
		gr.polygon{
	\
		8 choose choose 2+
		0
		DO	gr_window_width  choose
			gr_window_height choose
		LOOP
	\	
		}gr.polygon.dispose
	;
	
	
	: GRPT.CLEAR.PAUSE	(  -- flag )
		tickcount() rand-seed !	\ otherwise things get repetitive
	\
		240  tickcount() +
		0 0					\  -- tick flag flag
		BEGIN
			2drop
		\
			dup tickcount() time<
		\
			?closebox		\  -- tick flag flag
		\
			2dup  OR
		UNTIL
		nip nip				\  -- flag
	\
		gr.mode@
		gr.color@
	\
		gr_insert_mode  gr.mode!
		8 choose 0= ABS  gr.color!
		gr.fill
	\
		gr.color!
		gr.mode!
	;
	
	
	: GRPT	(  --  )
		gr.mode@
		gr_xor_mode  gr.mode!
	\
		BEGIN
			48 choose
			IF
				4 choose
				CASE
					0  OF  grpt.random.line.wh  ENDOF
					1  OF  grpt.random.line     ENDOF
					2  OF  grpt.random.oval     ENDOF
					3  OF  grpt.random.polygon  ENDOF
				ENDCASE
			\
				?closebox			\  -- flag
			ELSE
				grpt.clear.pause	\  -- flag
			THEN
		UNTIL
	\	
		gr.mode!
	;
	
	: GRPT.INIT	(  --  )
		hmsl-window @ 0=
		IF	HMSL-NewWindow window.defaults
		\
			SCREENBITS	\  -- left top right bottom
		\
			 4 -  hmsl-newwindow .. wt_rect ..! rect_bottom
			 4 -  hmsl-newwindow .. wt_rect ..! rect_right
			40 +  hmsl-newwindow .. wt_rect ..! rect_top
			 4 +  hmsl-newwindow .. wt_rect ..! rect_left
		\
			hmsl-newwindow .. wt_rect ..@ rect_right
			hmsl-newwindow .. wt_rect ..@ rect_left  -
			-> gr_window_width
			hmsl-newwindow .. wt_rect ..@ rect_bottom
			hmsl-newwindow .. wt_rect ..@ rect_top  -
			-> gr_window_height
		\
			0  pad c!
		\
			SCREENBITS.WH
			" width = "  count  pad  $append
			swap  n>text        pad  $append
			"  : "       count  pad  $append
			" height = " count  pad  $append
			n>text              pad  $append
		\
			pad  HMSL-NewWindow ..! wt_title
		\
			HMSL-NewWindow gr.openwindow dup hmsl-window !
			dup
			IF	gr.set.curwindow
 				0  TextFont()
			ELSE 
				drop  ." Could not open window!" cr abort
			THEN
		THEN
		hmsl-window @ SelectWindow()
	;
	
	: GRPT.TERM	(  --  )
		hmsl.close
	;
	
	if.forgotten  grpt.term
	
	
	: GR.PLUS.TEST	(  --  )
		grpt.init  grpt  grpt.term
	;
	
	
	cr ." Enter GR.PLUS.TEST to demo the graph_plus component." cr cr
	
.THEN