''
'' $Id: StrHooks.bas,v 1.2 1994/03/16 15:00:38 alex Rel $
''
'' String gadget hook demo
''
'' Derived from RKM example (c) Copyright 1992 Commodore-Amiga, Inc.
''

DEFINT A-Z

REM $NOWINDOW	' don't need the automatic window in this example

'REM $INCLUDE Exec.bh
'REM $INCLUDE Graphics.bc
'REM $INCLUDE Intuition.bh
'REM $INCLUDE Locale.bh
'REM $INCLUDE Utility.bc

' The callback operates in Intuition's context - lets turn everything off
REM $NOAUTODIM
REM $NOARRAY
REM $NOBREAK
REM $NOOVERFLOW
REM $NOEVENT
REM $NOSTACK

LIBRARY OPEN "exec.library", LIBRARY_MINIMUM&
LIBRARY OPEN "intuition.library", 37
LIBRARY OPEN "locale.library", 38

CONST SG_STRLEN = 44
CONST MYSTRGADWIDTH = 200

DIM SHARED locale&	' default global locale
DIM SHARED tl&(40)
DIM SHARED junk&

' This is an example string editing hook, which shows the basics of
' creating a string editing function.  This hook restricts entry to
' hexadecimal digits (0-9, A-F, a-f) and converts them to upper case.
' To demonstrate processing of mouse-clicks, this hook also detects
' clicking on a character, and converts it to a zero.
'
' NOTE: String editing hooks are called on Intuition's task context,
' so the hook may not use DOS and may not cause xWait&() to be called.

FUNCTION str_hookRoutine&(BYVAL hook&, BYVAL sgw&, BYVAL msg&)
	' Hook must return non-zero if command is supported.
	' This will be changed to zero if the command is unsupported.
	str_hookRoutine& = NOT 0&

	IF PEEKL(msg&) = SGH_KEY& THEN
		' key hit -- could be any key (Shift, repeat, character, etc.) */

		' allow only upper case characters to be entered.
		' act only on modes that add or update characters in the buffer.
		IF PEEKW(sgw& + EditOp) = EO_REPLACECHAR& OR _
		  PEEKW(sgw& + EditOp) = EO_INSERTCHAR& THEN

			' Code contains the ASCII representation of the character
			' entered, if it maps to a single byte.  We could also look
			' into the work buffer to find the new character.
			'
			' If the character is not a legal hex digit, don't use
			' the work buffer and beep the screen.

			IF IsXDigit(locale&, PEEKW(sgw& + SGWorkCode)) = FALSE& THEN
				POKEL sgw& + Actions, (PEEKL(sgw& + Actions) OR SGA_BEEP&) AND NOT SGA_USE&
			ELSE
				' And make it upper-case, for nicety
				
				POKEB PEEKL(sgw& + SGWorkWorkBuffer) + PEEKW(sgw& + SGWorkBufferPos) - 1, _
				  ConvToUpper(locale&, PEEKW(sgw& + SGWorkCode))
			END IF
		END IF
	ELSEIF PEEKL(msg&) = SGH_CLICK& THEN
		' mouse click
		' zero the digit clicked on

		IF PEEKW(sgw& + SGWorkBufferPos) < PEEKW(sgw& + SGWorkNumChars) THEN
			POKEB PEEKL(sgw& + SGWorkWorkBuffer) + PEEKW(sgw& + SGWorkBufferPos), ASC("0")
		END IF
	ELSE
		' UNKNOWN COMMAND
		' hook should return zero if the command is not supported.

		str_hookRoutine& = 0
	END IF
END FUNCTION

DIM SHARED strBorderData(9), strBorder(Border_sizeof \ 2)
DIM SHARED sgg_Gadget(Gadget_sizeof \ 2), sgg_StrInfo(StringInfo_sizeof \ 2)
DIM SHARED sgg_Extend(StringExtend_sizeof \ 2), sgg_Hook(Hook_sizeof \ 2)
DIM SHARED sgg_Buff(SG_STRLEN \ 2), sgg_WBuff(SG_STRLEN \ 2), sgg_UBuff(SG_STRLEN \ 2)

SUB main
	STATIC scr&, drawinfo&, win&, closed, imsg&, imsgClass&, w&

	locale& = OpenLocale&(NULL&)
	IF locale& <> NULL& THEN
		scr& = LockPubScreen&(NULL&)
		IF scr& <> NULL& THEN
			drawinfo& = GetScreenDrawInfo&(scr&)
			IF drawinfo& <> NULL& THEN
			' initialiase everything: Border, Hook, StringExtend, StringInfo and
			' Gadget

				strBorderData(0) = 0 : strBorderData(1) = 0
				strBorderData(2) = MYSTRGADWIDTH + 3 : strBorderData(3) = 0
				strBorderData(4) = MYSTRGADWIDTH + 3 : strBorderData(5) = PEEKW(scr& + RastPort + TxHeight) + 3
				strBorderData(6) = 0 : strBorderData(7) = strBorderData(5)
				strBorderData(8) = 0 : strBorderData(9) = 0

				w& = VARPTR(strBorder(0))
				POKEW w& + BorderLeftEdge, -2
				POKEW w& + BorderTopEdge, -2
				POKEB w& + BorderFrontPen, 1
				POKEB w& + BorderBackPen, 0
				POKEB w& + BorderDrawMode, JAM1&
				POKEB w& + BorderCount, 5
				POKEL w& + XY, VARPTR(strBorderData(0))
				POKEL w& + NextBorder, NULL&

				InitHook VARPTR(sgg_Hook(0)), VARPTRS(str_hookRoutine&)

				w& = VARPTR(sgg_Extend(0))
				POKEB w& + Pens + 0, PEEKW(PEEKL(drawinfo& + dri_Pens) + FILLTEXTPEN& * 2)
				POKEB w& + Pens + 1, PEEKW(PEEKL(drawinfo& + dri_Pens) + FILLPEN& * 2)
				POKEB w& + ActivePens + 0, PEEKW(PEEKL(drawinfo& + dri_Pens) + FILLTEXTPEN& * 2)
				POKEB w& + ActivePens + 1, PEEKW(PEEKL(drawinfo& + dri_Pens) + FILLPEN& * 2)
				POKEL w& + EditHook, VARPTR(sgg_Hook(0))
				POKEL w& + StringExtendWorkBuffer, VARPTR(sgg_WBuff(0))

				w& = VARPTR(sgg_StrInfo(0))
				POKEL w& + StringInfoBuffer, VARPTR(sgg_Buff(0))
				POKEL w& + UndoBuffer, VARPTR(sgg_UBuff(0))
				POKEW w& + MaxChars, SG_STRLEN
				POKEL w& + StringInfoExtension, VARPTR(sgg_Extend(0))

				w& = VARPTR(sgg_Gadget(0))
				POKEW w& + GadgetLeftEdge, 20
				POKEW w& + GadgetTopEdge, 30
				POKEW w& + GadgetWidth, MYSTRGADWIDTH
				POKEW w& + GadgetHeight, PEEKW(scr& + RastPort + TxHeight)
				POKEW w& + GadgetFlags, GFLG_GADGHCOMP& OR GFLG_STRINGEXTEND&
				POKEW w& + GadgetActivation, GACT_RELVERIFY&
				POKEW w& + GadgetGadgetType, GTYP_STRGADGET&
				POKEL w& + GadgetSpecialInfo, VARPTR(sgg_StrInfo(0))
				POKEL w& + GadgetGadgetRender, VARPTR(strBorder(0))

				TAGLIST VARPTR(tl&(0)), _
				  WA_PubScreen&, scr&, _
				  WA_Left&, 21, _
				  WA_Top&, 20, _
				  WA_Width&, 500, _
				  WA_Height&, 150, _
				  WA_MinWidth&, 50, _
				  WA_MaxWidth&, NOT 0&, _
				  WA_MinHeight&, 30, _
				  WA_MaxHeight&, NOT 0&, _
				  WA_SimpleRefresh&, TRUE&, _
				  WA_NoCareRefresh&, TRUE&, _
				  WA_RMBTrap&, TRUE&, _
				  WA_IDCMP&, IDCMP_GADGETUP& OR IDCMP_CLOSEWINDOW&, _
				  WA_Activate&, TRUE&, _
				  WA_CloseGadget&, TRUE&, _
				  WA_DragBar&, TRUE&, _
				  WA_DepthGadget&, TRUE&, _
				  WA_Title&, "String Hook Accepts HEX Digits Only", _
				  WA_Gadgets&, VARPTR(sgg_Gadget(0)), _
				  TAG_END&

				win& = OpenWindowTagList&(NULL&, VARPTR(tl&(0)))
				IF win& <> NULL& THEN
					closed = FALSE&
					WHILE closed = FALSE&
						junk& = WaitPort&(PEEKL(win& + UserPort))
						DO
							imsg& = GetMsg&(PEEKL(win& + UserPort))
							IF imsg& <> NULL& THEN
							' Stash message contents and reply, important when
							' message triggers some lengthy processing

								imsgClass& = PEEKL(imsg& + Class)
								ReplyMsg imsg&
								SELECT CASE imsgClass&
									CASE IDCMP_GADGETUP&
									' if a code is set in the hook after an SGH_KEY
									' command, where SGA_END is set on return from
									' the hook, the code will be returned in the
									' Code field of the IDCMP_GADGETUP message.

									CASE IDCMP_CLOSEWINDOW&
										closed = TRUE&
								END SELECT
							END IF
						LOOP WHILE imsg& <> NULL&
					WEND
					CloseWindow win&
				END IF
				FreeScreenDrawInfo scr&, drawinfo&
			END IF
			UnlockPubScreen NULL&, scr&
		END IF
		CloseLocale locale&
	END IF
END SUB

main
END