/*
** An example of GadTools library usage.
**
** Adapted from RKM: Libraries (1992), p 383-385 
** and NDK example gadget1.c, by David Benn, 
** 18th March, 3rd April, 7th,8th June, 7th October 1995.
**
** Changed by Herbert Breuer,
** included an example how to use shared MsgPorts,
** 30th October - 3rd November 1995.
*/
/* -------------------------- */
/*
** Includes
*/
/* -------------------------- */
#include <ace/acedef.h>
#include <exec/exec.h>
#include <intuition/intuition.h>
#include <libraries/gadtools.h>
#include <utility/utility.h>
/* -------------------------- */
#include <funcs/exec_funcs.h>
#include <funcs/intuition_funcs.h>
#include <funcs/gadtools_funcs.h>
#include <funcs/utility_funcs.h>
/* -------------------------- */
/*
** Shared libraries.
*/
/* -------------------------- */
LIBRARY "exec.library"
LIBRARY "utility.library"
LIBRARY "intuition.library"
LIBRARY "gadtools.library"
/* -------------------------- */
/*
** Constant definitions.
*/
/* -------------------------- */
CONST GAD_SLIDER = 1
CONST GAD_STRING = 2
CONST GAD_BUTTON = 3

/* Range for the slider */

CONST SLIDER_MIN = 1
CONST SLIDER_MAX = 20
/* -------------------------- */
/*
** Global variables.
*/
/* -------------------------- */
DECLARE STRUCT TextAttr gadFont

	gadFont->ta_Name  = SADD("topaz.font")
	gadFont->ta_YSize = 8
	gadFont->ta_Style = 0
	gadFont->ta_Flags = 0

DECLARE STRUCT _Screen		*mysc
DECLARE STRUCT _Window		*_MainWin
DECLARE STRUCT _Gadget		*glist, *gad
DECLARE STRUCT MsgPort		*wd_UserPort
DECLARE STRUCT IntuiMessage	*imsg
DECLARE STRUCT IntuiText	IText

LONGINT		class, iaddr, winptr
SHORTINT	code, qual

SHORTINT	slider_level : slider_level = 5
LONGINT		having_fun   : having_fun   = TRUE

ADDRESS   vi
/* -------------------------- */
/*
** FORWARD SUB declarations.
**/
/* -------------------------- */

/* ami.lib           */
DECLARE FUNCTION NewList(ADDRESS WinList) EXTERNAL

DECLARE STRUCT _List	WinList
DECLARE STRUCT Node		*WinListNode, *SearchNode, *LastNode

LONGINT WinListCount : WinListCount = -1&
/* -------------------------- */
/*
** Subprogram definitions.
*/
/* -------------------------- */
SUB close_window_safely(ADDRESS mywinaddr)

DECLARE STRUCT _Window *mywin : mywin = mywinaddr

ADDRESS	mymsg, _MsgPort

	/* if we got a window pointer */
	IF mywin <> NULL THEN

		/* don't disturb us now */
		Forbid

		/* read the MsgPortPtr out of the structure */
		_MsgPort = mywin->UserPort

		/* does the UserPort already exists */
		IF _MsgPort <> NULL THEN

			REPEAT

				/* get the message, if there is one */
				mymsg = GetMsg(_MsgPort)

				/* don't do it if there isn't one */
				IF mymsg <> NULL THEN
					Remove(mymsg)
					ReplyMsg(mymsg)
				END IF
			UNTIL mymsg = NULL

			/* kill the pointer to the port */
			POKEL @mywin->UserPort,NULL

			/* kill the IDCMPFlags */
			ModifyIDCMP(mywin,NULL)

		END IF

		/* back to normal */
		Permit

		/* close the window now */
		CloseWindow(mywin)
	END IF

END SUB
/* -------------------------- */
SUB open_msg_win

SHARED wd_UserPort, mysc, WinList, WinListNode, WinListCount, IText

DECLARE STRUCT _Window *msgwin
DECLARE STRUCT TagItem *tag, *wintags

LONGINT MsgWinIDCMP
ADDRESS msgwinRPort

	MsgWinIDCMP  = IDCMP_CLOSEWINDOW
	wdwTitle$= "Message Window"

	SetUpTags(wintags,13)

	IF wintags <> NULL THEN
		tag = wintags
		SetTag(WA_Left,50)
		SetTag(WA_Top,50)
		SetTag(WA_InnerWidth,300)
		SetTag(WA_InnerHeight,50)
		SetTag(WA_Title,@wdwTitle$)
		SetTag(WA_CustomScreen,mysc)
		SetTag(WA_Gadgets,glist)
		SetTag(WA_IDCMP,NULL)	/* no IDCMPFlags -> no port! */
		SetTag(WA_DragBar,TRUE)
		SetTag(WA_CloseGadget,TRUE)
		SetTag(WA_GimmeZeroZero,TRUE)
		SetTag(WA_Activate,TRUE)
		SetTagEnd

		msgwin = OpenWindowTagList(NULL,wintags)

		FreeTagItems(wintags)

		IF msgwin <> NULL THEN

			/* remember the window ptrs in a list */
			WinListNode = ALLOC(SIZEOF(Node))
			WinListNode->ln_Name = msgwin
			AddTail(WinList,WinListNode)
			++WinListCount

			/* just for fun, write the window address */
			msg$ = "Window Address: "+HEX$(WinListNode->ln_Name)
			IText->FrontPen	= 1
			IText->BackPen	= 2
			IText->DrawMode	= 1
			IText->LeftEdge	= 10
			IText->TopEdge	= 10
			IText->ITextFont= gadFont
			IText->IText	= @msg$
			IText->NextText	= 0

			msgwinRPort = msgwin->RPort

			PrintIText(msgwinRPort,IText,0,0)

			/* now install the port */
			msgwin->UserPort = wd_UserPort

			/* make the port active with these IDCMPFlags */
			ModifyIDCMP(msgwin, MsgWinIDCMP)
		END IF
	END IF
END SUB
/* -------------------------- */
SUB close_windows(ADDRESS _winaddr)

SHARED _MainWin, glist,  WinList, WinListNode, WinListCount
SHARED SearchNode, LastNode

ADDRESS win_to_close

	IF _winaddr = _MainWin THEN

		/* remove first the gadget list */
		RemoveGList(_MainWin,glist,-1)

		/* just a loop */
		WHILE having_fun

				/* now close all open windows */
				/* start with the last one */
				LastNode = WinList->lh_TailPred

				/* we did reach the list structure
				   lh_TailPred points now to list head */
				IF LastNode = WinList THEN GOTO close_main

				/* read the window pointer from the list */
				win_to_close = LastNode->ln_Name

				/* close the window */
				close_window_safely(win_to_close)

				/* remove this node */
				RemTail(WinList)
		WEND

close_main:		
		/* now close the main window */
		close_window_safely(_MainWin)
	ELSE
		/* close the window first */
		close_window_safely(_winaddr)

		/*	Start at the beginning of the list
			There must be an entry, otherwise only the main window
			would be open. */

		/* start with the first entry */
		SearchNode = WinList->lh_Head

		/* search the list until found */
		FOR i=0 TO WinListCount
			IF _winaddr = SearchNode->ln_Name THEN
				Remove(SearchNode)
				EXIT FOR
			END IF

			/* Win address not found? Look for the next one. */
			SearchNode = SearchNode->ln_Succ
		NEXT			

	END IF
END SUB
/* -------------------------- */
SUB handle_gadget

SHARED class, iaddr, winptr, code, qual

DECLARE STRUCT _Gadget		*gad
DECLARE STRUCT StringInfo	*info

	gad		= iaddr
   	info	= gad->SpecialInfo
	x$		= CSTR(info->Buffer)
	y$		= STR$(code)

	CASE 
		gad->GadgetID = GAD_SLIDER : MsgBox "Speed: "+y$,"OK"
		gad->GadgetID = GAD_STRING : MsgBox x$,"OK"
		gad->GadgetID = GAD_BUTTON : open_msg_win
	END CASE
END SUB
/* -------------------------- */
SUB do_window_refresh(ADDRESS wdw)

	GT_BeginRefresh(wdw)
	GT_EndRefresh(wdw,TRUE)

END SUB
/* -------------------------- */
SUB gadtools_window

/*
** Prepare for using GadTools, set up gadgets
** and open window.
*/

SHARED _MainWin, slider_level, gadFont, glist, gad, wd_UserPort, vi, mysc

DECLARE STRUCT NewGadget	ng
DECLARE STRUCT TagItem		*gadTags, *tag, *wintags

LONGINT MainWinIDCMP

DIM ADDRESS radioButtonStrings(3)

	MainWinIDCMP  = (IDCMP_CLOSEWINDOW OR SLIDERIDCMP)

	wdwTitle$= "GadTools Gadget Demo"

	/* All the gadget creation calls accept a pointer to the previous
	 * gadget, and link the new gadget to that gadget's NextGadget field.
	 * Also, they exit gracefully, returning NULL, if any previous gadget
	 * was NULL.  This limits the amount of checking for failure that
	 * is needed.  You only need to check before you tweak any gadget
	 * structure or use any of its fields, and finally once at the end,
	 * before you add the gadgets. */

	ng->ng_LeftEdge		= 100
	ng->ng_TopEdge		= 20
	ng->ng_Width		= 200
	ng->ng_Height		= 12
	ng->ng_GadgetText	= SADD("Speed:   ")
	ng->ng_TextAttr		= gadFont
	ng->ng_VisualInfo	= vi
	ng->ng_GadgetID		= GAD_SLIDER

	SetUpTags(gadTags,6)

	IF gadTags <> NULL THEN
		tag = gadTags
		SetTag(GTSL_Min,SLIDER_MIN)
		SetTag(GTSL_Max,SLIDER_MAX)
		SetTag(GTSL_Level,slider_level)
		SetTag(GTSL_LevelFormat,SADD("%2ld"))
		SetTag(GTSL_MaxLevelLen,2)
		SetTagEnd
	END IF

	gad = CreateGadgetA(SLIDER_KIND, gad, ng, gadTags)
	slidergad = gad
	FreeTagItems(gadTags)	

	ng->ng_TopEdge		= 40+topborder
	ng->ng_Height		= 14
	ng->ng_GadgetText	= SADD("Type Here:")
	ng->ng_GadgetID		= GAD_STRING

	SetUpTags(gadTags,3)

	IF gadTags <> NULL THEN
		tag = gadTags
		SetTag(GTST_String,SADD("Hello World!"))
		SetTag(GTST_MaxChars,50)
		SetTagEnd
	END IF

	gad = CreateGadgetA(STRING_KIND, gad, ng, gadTags)
	FreeTagItems(gadTags)

	ng->ng_LeftEdge		= ng->ng_LeftEdge + 50
	ng->ng_TopEdge		= 60+topborder
	ng->ng_Width		= 100
	ng->ng_Height		= 12
	ng->ng_GadgetText	= SADD("Click Here")
	ng->ng_GadgetID		= GAD_BUTTON
	ng->ng_Flags		= NULL

	gad	= CreateGadgetA(BUTTON_KIND, gad, ng, NULL)
      
	/*  Open window, render gadgets and enter event-handling loop. */	
	IF gad <> NULL THEN

		SetUpTags(wintags,13)

		IF wintags <> NULL THEN
			tag = wintags
			SetTag(WA_Left,NULL)
			SetTag(WA_Top,NULL)
			SetTag(WA_InnerWidth,400)
			SetTag(WA_InnerHeight,100)
			SetTag(WA_Title,@wdwTitle$)
			SetTag(WA_CustomScreen,mysc)
			SetTag(WA_Gadgets,glist)
			SetTag(WA_IDCMP,NULL)	/* no IDCMP -> no port! */
			SetTag(WA_DragBar,TRUE)
			SetTag(WA_CloseGadget,TRUE)
			SetTag(WA_GimmeZeroZero,TRUE)
			SetTag(WA_Activate,TRUE)
			SetTagEnd

			_MainWin = OpenWindowTagList(NULL,wintags)

			/* we don't need them any more */
			FreeTagItems(wintags)

			IF _MainWin <> NULL THEN

				/* GadTools expects that now */  
				GT_RefreshWindow(_MainWin,NULL)

				/* now install the port */
				_MainWin->UserPort = wd_UserPort

				/* make the port active with these IDCMPFlags */
				ModifyIDCMP(_MainWin, MainWinIDCMP)
			END IF
		END IF
	END IF
END SUB
/* -------------------------- */
/*
** Main program.
*/
/* -------------------------- */
main:
	glist    = NULL
	mysc     = SCREEN(1)

	IF mysc <> NULL THEN

		/* let exec create a MsgPort for us */
		wd_UserPort = CreateMsgPort

		IF wd_UserPort <> NULL THEN

			vi = GetVisualInfoA(mysc, NULL)

			/*  GadTools always requires this step to be taken. */
			gad = CreateContext(@glist)

			gadtools_window

			IF _MainWin <> NULL THEN

				/* create a new list */
				NewList(WinList)

				/* now look for events */
				GOSUB process_window_events

			END IF

			/*	FreeGadgets() must be called after the context has been
				created. It does nothing if glist is NULL. */
			FreeGadgets(glist)
			FreeVisualInfo(vi)
			DeleteMsgPort(wd_UserPort)
		END IF
	END IF

	/* free the memory from node creation */
	CLEAR ALLOC
	LIBRARY CLOSE
END
/* -------------------------- */
*/
/*
** Standard message handling loop with GadTools message
** handling functions used (GT_GetIMsg() and GT_ReplyIMsg()).
*/
process_window_events:

	WHILE having_fun

		/* wait for events at the port
		   this port is the same for all events */

		WaitPort(wd_UserPort)

		/*	Use GT_GetIMsg() and GT_ReplyIMsg() for handling
			IntuiMessages with GadTools gadgets. */

		imsg	= GT_GetIMsg(wd_UserPort)

		/* read all the necessary values out of the message structure */

		class	= imsg->Class
		code	= imsg->Code
		qual	= imsg->Qualifier
		iaddr	= imsg->IAddress
		winptr	= imsg->IDCMPWindow

		/* we have them all, so reply the message */
		GT_ReplyIMsg(imsg)          

		/*  has a window close gadget been clicked? */
		IF class = IDCMP_CLOSEWINDOW THEN
			
			/* close the window */
			close_windows(winptr)

			/* main window closed? */
			IF winptr = _MainWin THEN RETURN
		END IF

		CASE
			class = IDCMP_GADGETUP OR class = IDCMP_GADGETDOWN ~
					OR class = IDCMP_MOUSEMOVE : handle_gadget

			/*  This handling is REQUIRED with GadTools. */
			class = IDCMP_REFRESHWINDOW : do_window_refresh(winptr)
		END CASE
	WEND
RETURN
/* -------------------------- */