''
'' $Id: dto.bas,v 1.3 1994/03/18 15:46:20 alex Rel $
''
'' How to embed a DataType object within a window
''
'' Derived from Commodore-Amiga example, Copyright (c) 1992, 1993 Commodore-Amiga, Inc.
''

DEFINT A-Z

'REM $INCLUDE Exec.bh
'REM $INCLUDE DOS.bh
'REM $INCLUDE Graphics.bh
'REM $INCLUDE Intuition.bh
'REM $INCLUDE DataTypes.bh
'REM $INCLUDE DataTypes/DataTypesClass.bc
'REM $INCLUDE DataTypes/PictureClass.bc
'REM $INCLUDE Utility.bh

REM $INCLUDE BLib/VSPrintf.bas

LIBRARY OPEN "exec.library", LIBRARY_MINIMUM&
LIBRARY OPEN "intuition.library", 39
LIBRARY OPEN "graphics.library", 39
LIBRARY OPEN "datatypes.library", 39
LIBRARY OPEN "dos.library", 36
LIBRARY OPEN "utility.library", LIBRARY_MINIMUM&

DIM SHARED tl&(40)	'Generic taglist
DIM SHARED junk&

CONST OPT_NAME = 0
CONST NUM_OPTS = 1

DIM SHARED errbuff(40)

SUB PrintErrorMsg(BYVAL errnum&, BYVAL file&)
	IF errnum& >= DTERROR_UNKNOWN_DATATYPE& THEN
		' use the taglist statement to generate the argument list
		TAGLIST VARPTR(tl&(0)), _
		  file&

		VSPrintf VARPTR(errbuff(0)), GetDTString&(errnum&), VARPTR(tl&(0))
	ELSE
		junk& = Fault&(errnum&, NULL&, VARPTR(errbuff(0)), 80)
	END IF
	PRINT PEEK$(VARPTR(errbuff(0)))
	PRINT "Error #"; errnum&
END SUB

SUB main
	DIM options&(NUM_OPTS)
	STATIC rdargs&, win&, scr&
	STATIC dto&, dtoname&, nomwidth&, nomheight&, modeid&
	STATIC useScreen, going, sigr&, imsg&, imsgClass&, imsgCode, errnum&
	STATIC tstate&, tags&, tag&, titag&, tidata&
	DIM dtf(dtFrameBox_sizeof \ 2), fri(FrameInfo_sizeof \ 2)

	useScreen = FALSE&

	' Parse the arguments.  Note that this simple example assumes
	' that it was started from the shell
	rdargs& = ReadArgs(SADD("NAME/A" + CHR$(0)), VARPTR(options&(0)), NULL&)
	IF rdargs& <> NULL& THEN
		' Get a DataType object
		dto& = NewDTObjectA&(options&(OPT_NAME), NULL&)
		IF dto& <> NULL& THEN
		' Get information about the object */

			TAGLIST VARPTR(tl&(0)), _
			  DTA_ObjName&, VARPTR(dtoname&), _	'get the name of the object
			  _
			  DTA_NominalHoriz&, VARPTR(nomwidth&), _	'get the desired size
			  DTA_NominalVert&, VARPTR(nomheight&), _
			  _
			  PDTA_ModeID&, VARPTR(modeid&), _		'get the mode ID for graphical objects
			  TAG_END&

			IF GetDTAttrsA&(dto&, VARPTR(tl&(0))) THEN
				' Display any information we obtained
			    IF dtoname& <> NULL& THEN PRINT "opened """; PEEK$(dtoname&); """"

				' Show the mode ID
				PRINT "mode ID "; HEX$(modeid&)
				
				' Display the nominal size
				PRINT "nominal width"; nomwidth&; ", height"; nomheight&
			END IF

			' Ask the object what kind of environment it needs
			POKEL VARPTR(dtf(0)) + dtFrameBoxMethodID,  DTM_FRAMEBOX&
			POKEL VARPTR(dtf(0)) + dtf_FrameInfo, VARPTR(fri(0))
			POKEL VARPTR(dtf(0)) + dtf_ContentsInfo, VARPTR(fri(0))
			POKEL VARPTR(dtf(0)) + dtf_SizeFrameInfo, FrameInfo_sizeof
			IF DoDTMethodA&(dto&, NULL&, NULL&, VARPTR(dtf(0))) THEN
				IF PEEKL(VARPTR(fri(0)) + FrameInfoDepth) THEN
					PRINT "PropertyFlags : &h"; HEX$(PEEKL(VARPTR(fri(0)) + fri_PropertyFlags))
					PRINT "RedBits       : &h"; HEX$(PEEKB(VARPTR(fri(0)) + fri_RedBits))
					PRINT "GreenBits     : &h"; HEX$(PEEKB(VARPTR(fri(0)) + fri_GreenBits))
					PRINT "BlueBits      : &h"; HEX$(PEEKB(VARPTR(fri(0)) + fri_BlueBits))
					PRINT "Width         :"; PEEKL(VARPTR(fri(0)) + FrameInfoWidth)
					PRINT "Height        :"; PEEKL(VARPTR(fri(0)) + FrameInfoHeight)
					PRINT "Depth         :"; PEEKL(VARPTR(fri(0)) + FrameInfoDepth)
					PRINT "Screen        : &h"; HEX$(PEEKL(VARPTR(fri(0)) + fri_Screen))
					PRINT "ColorMap      : &h"; HEX$(PEEKL(VARPTR(fri(0)) + fri_ColorMap))
					
					IF PEEKL(VARPTR(fri(0)) + fri_PropertyFlags) AND _
					  (DIPF_IS_HAM& OR DIPF_IS_EXTRAHALFBRITE&) THEN
						PRINT "HAM or ExtraHalfBrite"
						useScreen = TRUE&
					END IF
					
					IF (PEEKL(VARPTR(fri(0)) + fri_PropertyFlags) = 0) AND _
					  (modeid& AND &h800) AND (modeid& <> INVALID_ID&) THEN
						PRINT "ModeID="; HEX$(modeid&)
						useScreen = TRUE&
					END IF
				ELSE
					PRINT "couldn't obtain environment information"
				END IF
			ELSE
				PRINT "couldn't obtain environment information"
			END IF
			
			IF useScreen = TRUE& THEN
				PRINT "this object requires a private screen"
			ELSE
				' Get a lock on the default public screen
				scr& = LockPubScreen&(NULL&)
				IF scr& <> NULL& THEN
					' Make sure we have the dimensions
					IF nomwidth& = 0 THEN nomwidth& = 600
					IF nomheight& = 0 THEN nomheight& = 175
					
					' open the window
					TAGLIST VARPTR(tl&(0)), _
					  WA_InnerWidth&, nomwidth&, _
					  WA_InnerHeight&, nomheight&, _
					  WA_Title&, dtoname&, _
					  WA_IDCMP&, IDCMP_CLOSEWINDOW& OR IDCMP_VANILLAKEY& OR IDCMP_IDCMPUPDATE&, _
					  WA_DragBar&, TRUE&, _
					  WA_DepthGadget&, TRUE&, _
					  WA_CloseGadget&, TRUE&, _
					  WA_AutoAdjust&, TRUE&, _
					  WA_SimpleRefresh&, TRUE&, _
					  WA_BusyPointer&, TRUE&, _
					  WA_Activate&, TRUE&, _
					  TAG_END&

					win& = OpenWindowTagList&(NULL&, VARPTR(tl&(0)))
					IF win& <> NULL& THEN
						' Set the dimensions of the DataType object
						TAGLIST VARPTR(tl&(0)), _
						  GA_Left&, PEEKB(win& + BorderLeft), _
						  GA_Top&, PEEKB(win& + BorderTop), _
						  GA_Width&, PEEKW(win& + WindowWidth) - PEEKB(win& + BorderLeft) - PEEKB(win& + BorderRight), _
						  GA_Height&, PEEKW(win& + WindowHeight) - PEEKB(win& + BorderTop) - PEEKB(win& + BorderBottom), _
						  ICA_TARGET&, ICTARGET_IDCMP&, _
						  TAG_END&
						junk& = SetDTAttrsA&(dto&, NULL&, NULL&, VARPTR(tl&(0)))

						' Add the object to the window
						junk& = AddDTObject&(win&, NULL&, dto&, -1)

						' Refresh the DataType object
						RefreshDTObjectA dto&, win&, NULL&, NULL&

						' Keep going until we're told to stop
						going = TRUE&
						WHILE going = TRUE&
							' wait for an event
							sigr& = xWait((1& << PEEKB(PEEKL(win& + UserPort) + mp_SigBit)) OR _
							  SIGBREAKF_CTRL_C&)
							
							' Did we get a break signal
							IF sigr& AND SIGBREAKF_CTRL_C& THEN going = FALSE&
							
							' Pull Intuition messages
							DO
								imsg& = GetMsg&(PEEKL(win& + UserPort))
								IF imsg& = NULL& THEN EXIT DO
								' Handle each message
								imsgClass& = PEEKL(imsg& + Class)
								imsgCode = PEEKW(imsg& + IntuiMessageCode)
								SELECT CASE imsgClass&
									CASE IDCMP_CLOSEWINDOW&
										going = FALSE&
										
									CASE IDCMP_VANILLAKEY&
										SELECT CASE imsgCode
											CASE &h51, &h71, 27
												going = FALSE&
										END SELECT

									CASE IDCMP_IDCMPUPDATE&
										tags& = PEEKL(imsg& + IAddress)
										tstate& = tags&
										DO
											tag& = NextTagItem&(VARPTR(tstate&))
											IF tag& = NULL& THEN EXIT DO
											titag& = PEEKL(tag& + ti_Tag)
											tidata& = PEEKL(tag& + ti_Data)
											SELECT CASE titag&
												CASE DTA_Busy&
													' Change in busy state */
													IF tidata& THEN
														TAGLIST VARPTR(tl&(0)), _
														  WA_PointerDelay&, TRUE&, _
														  WA_BusyPointer&, TRUE&, _
														  TAG_END&
													ELSE
														TAGLIST VARPTR(tl&(0)), _
														  WA_Pointer&, NULL&, _
														  TAG_END&
													END IF
													SetWindowPointerA win&, VARPTR(tl&(0))
												
												CASE DTA_ErrorLevel&
													' Error message
													IF tidata& THEN
														errnum& = GetTagData&(DTA_ErrorNumber&, NULL&, tags&)
														PrintErrorMsg errnum&, options&(OPT_NAME)
													END IF

												CASE DTA_Sync&
													' Time to refresh
													RefreshDTObjectA dto&, win&, NULL&, NULL&
											END SELECT
										LOOP
								END SELECT
								' Done with the message, so reply to it
								ReplyMsg imsg&
							LOOP
						WEND
						' Remove the object from the window
						junk& = RemoveDTObject&(win&, dto&)

						' Close the window now
						CloseWindow win&
					ELSE
						PRINT "couldn't open window"
					END IF
					' Unlock the screen
					UnlockPubScreen NULL&, scr&
				ELSE
					PRINT "couldn't lock default public screen"
				END IF
			END IF
			DisposeDTObject dto&
		ELSE
			PrintErrorMsg IoErr, options&(OPT_NAME)
		END IF
		FreeArgs rdargs&
	ELSE
		PrintErrorMsg IoErr, NULL&
	END IF
END SUB

main
END