home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / E / TFF-A32R.LZX / AmigaE3.2a / RkrmSrc / Intuition / Gadgets / strhooks.e < prev    next >
Encoding:
Text File  |  1996-08-29  |  7.1 KB  |  189 lines
  1. -> strhooks.e - string gadget hooks demo
  2. -> E-Note: this uses several of the 'tools' modules, notably 'installhook'
  3.  
  4. MODULE 'utility',
  5.        'graphics/rastport',
  6.        'intuition/intuition',
  7.        'intuition/screens',
  8.        'intuition/sghooks',
  9.        'utility/hooks',
  10.        'tools/ctype',
  11.        'tools/installhook'
  12.  
  13. ENUM ERR_NONE, ERR_DRAW, ERR_KICK, ERR_LIB, ERR_PUB, ERR_WIN
  14.  
  15. RAISE ERR_DRAW IF GetScreenDrawInfo()=NIL,
  16.       ERR_LIB  IF OpenLibrary()=NIL,
  17.       ERR_PUB  IF LockPubScreen()=NIL,
  18.       ERR_WIN  IF OpenWindowTagList()=NIL
  19.  
  20. CONST SG_STRLEN=44, MYSTRGADWIDTH=200
  21.  
  22. -> We'll dynamically allocate/clear most structures, buffers
  23. OBJECT vars
  24.   sgg_Window:PTR TO window
  25.   sgg_Gadget:gadget
  26.   sgg_StrInfo:stringinfo
  27.   sgg_Extend:stringextend
  28.   sgg_Hook:hook
  29.   sgg_Buff[SG_STRLEN]:ARRAY
  30.   sgg_WBuff[SG_STRLEN]:ARRAY
  31.   sgg_UBuff[SG_STRLEN]:ARRAY
  32. ENDOBJECT
  33.  
  34. -> Open all required libraries, set-up the string gadget.
  35. -> Prepare the hook, open the sgg_Window and go...
  36. PROC main() HANDLE
  37.   -> E-Note: subtle name changes needed...
  38.   DEF vars=NIL:PTR TO vars, screen=NIL:PTR TO screen,
  39.       drawinfo=NIL:PTR TO drawinfo
  40.  
  41.   IF KickVersion(37)=FALSE THEN Raise(ERR_KICK)
  42.  
  43.   utilitybase:=OpenLibrary('utility.library', 37)
  44.  
  45.   -> Get the correct pens for the screen
  46.   screen:=LockPubScreen(NIL)
  47.  
  48.   drawinfo:=GetScreenDrawInfo(screen)
  49.  
  50.   NEW vars  -> E-Note: raises an exception if it fails
  51.   vars.sgg_Extend.pens[0]:=drawinfo.pens[FILLTEXTPEN]
  52.   vars.sgg_Extend.pens[1]:=drawinfo.pens[FILLPEN]
  53.   vars.sgg_Extend.activepens[0]:=drawinfo.pens[FILLTEXTPEN]
  54.   vars.sgg_Extend.activepens[1]:=drawinfo.pens[FILLPEN]
  55.   vars.sgg_Extend.edithook:=vars.sgg_Hook
  56.   vars.sgg_Extend.workbuffer:=vars.sgg_WBuff
  57.  
  58.   vars.sgg_StrInfo.buffer:=vars.sgg_Buff
  59.   vars.sgg_StrInfo.undobuffer:=vars.sgg_UBuff
  60.   vars.sgg_StrInfo.maxchars:=SG_STRLEN
  61.   vars.sgg_StrInfo.extension:=vars.sgg_Extend
  62.  
  63.   -> There should probably be a border around the string gadget.
  64.   -> As is, it is hard to locate when disabled.
  65.   vars.sgg_Gadget.leftedge:=20
  66.   vars.sgg_Gadget.topedge:=30
  67.   vars.sgg_Gadget.width:=MYSTRGADWIDTH
  68.   vars.sgg_Gadget.height:=screen.rastport.txheight
  69.   vars.sgg_Gadget.flags:=GFLG_GADGHCOMP OR GFLG_STRINGEXTEND
  70.   vars.sgg_Gadget.activation:=GACT_RELVERIFY
  71.   vars.sgg_Gadget.gadgettype:=GTYP_STRGADGET
  72.   vars.sgg_Gadget.specialinfo:=vars.sgg_StrInfo
  73.   -> E-Note: use typed lists for border and its data
  74.   -> E-Note: because we're using E we don't need stupid INIT_LATER
  75.   vars.sgg_Gadget.gadgetrender:=[-2,-2,1,0,RP_JAM1,5,
  76.                                   [0, 0,
  77.                                    MYSTRGADWIDTH+3, 0,
  78.                                    MYSTRGADWIDTH+3, screen.rastport.txheight+3,
  79.                                    0, screen.rastport.txheight+3,
  80.                                    0, 0]:INT,
  81.                                  NIL]:border
  82.  
  83.   -> E-Note: use Wouter's installhook
  84.   installhook(vars.sgg_Hook, {str_hookRoutine})
  85.  
  86.   vars.sgg_Window:=OpenWindowTagList(NIL,
  87.                         [WA_PUBSCREEN, screen,
  88.                          WA_LEFT,      21, WA_TOP,        20,
  89.                          WA_WIDTH,    500, WA_HEIGHT,    150,
  90.                          WA_MINWIDTH,  50, WA_MAXWIDTH,   -1,
  91.                          WA_MINHEIGHT, 30, WA_MAXHEIGHT,  -1,
  92.                          WA_SIMPLEREFRESH, TRUE,
  93.                          WA_NOCAREREFRESH, TRUE,
  94.                          WA_RMBTRAP,       TRUE,
  95.                          WA_IDCMP,   IDCMP_GADGETUP OR IDCMP_CLOSEWINDOW,
  96.                          WA_FLAGS,   WFLG_CLOSEGADGET OR WFLG_NOCAREREFRESH OR
  97.                                      WFLG_DRAGBAR OR WFLG_DEPTHGADGET OR
  98.                                      WFLG_SIMPLE_REFRESH,
  99.                          WA_TITLE,   'String Hook Accepts HEX Digits Only',
  100.                          WA_GADGETS, vars.sgg_Gadget,
  101.                          NIL])
  102.   handleWindow(vars)
  103.   -> E-Note: exit and clean up via handler
  104. EXCEPT DO
  105.   IF (vars<>NIL) AND vars.sgg_Window THEN CloseWindow(vars.sgg_Window)
  106.   -> E-Note: vars automatically freed
  107.   IF drawinfo THEN FreeScreenDrawInfo(screen, drawinfo)
  108.   IF screen THEN UnlockPubScreen(NIL, screen)
  109.   IF utilitybase THEN CloseLibrary(utilitybase)
  110.   -> E-Note: we can print a minimal error message
  111.   SELECT exception
  112.   CASE ERR_DRAW; WriteF('Error: Failed to get drawinfo from screen\n')
  113.   CASE ERR_KICK; WriteF('Error: Needs Kickstart V37+\n')
  114.   CASE ERR_LIB;  WriteF('Error: Failed to open utility.library\n')
  115.   CASE ERR_PUB;  WriteF('Error: Failed to lock public screen\n')
  116.   CASE ERR_WIN;  WriteF('Error: Failed to open window\n')
  117.   CASE "MEM";    WriteF('Error: Ran out of memory\n')
  118.   ENDSELECT
  119. ENDPROC
  120.  
  121. -> This is an example string editing hook, which shows the basics of creating
  122. -> a string editing function.  This hook restricts entry to hexadecimal digits
  123. -> (0-9, A-F, a-f) and converts them to upper case.  To demonstrate processing
  124. -> of mouse-clicks, this hook also detects clicking on a character, and
  125. -> converts it to a zero.
  126. ->
  127. -> NOTE String editing hooks are called on Intuition's task context, so the
  128. -> hook may not use DOS and may not cause Wait() to be called.
  129. PROC str_hookRoutine(hook, sgw:PTR TO sgwork, msg:PTR TO LONG)
  130.   DEF work_ptr, return_code
  131.  
  132.   -> Hook must return non-zero if command is supported.
  133.   -> This will be changed to zero if the command is unsupported.
  134.   return_code:=-1
  135.  
  136.   IF msg[]=SGH_KEY
  137.     -> Key hit -- could be any key (Shift, repeat, character, etc.)
  138.  
  139.     -> Allow only upper case characters to be entered.
  140.     -> Act only on modes that add or update characters in the buffer.
  141.     IF (sgw.editop=EO_REPLACECHAR) OR (sgw.editop=EO_INSERTCHAR)
  142.       -> Code contains the ASCII representation of the character entered, if
  143.       -> it maps to a single byte.  We could also look into the work buffer to
  144.       -> find the new character.
  145.       ->
  146.       ->     sgw.code = sgw.workbuffer[sgw.bufferpos-1]
  147.       ->
  148.       -> If the character is not a legal hex digit, don't use the work buffer
  149.       -> and beep the screen.
  150.       -> E-Note: use isxdigit from 'tools/ctype'
  151.       IF isxdigit(sgw.code)=FALSE
  152.         sgw.actions:=sgw.actions OR SGA_BEEP
  153.         sgw.actions:=sgw.actions AND Not(SGA_USE)
  154.       ELSE
  155.         -> And make it upper-case, for nicety
  156.         work_ptr:=sgw.workbuffer
  157.         work_ptr[sgw.bufferpos-1]:=toupper(sgw.code)
  158.       ENDIF
  159.     ENDIF
  160.   ELSEIF msg[]=SGH_CLICK
  161.     -> Mouse click
  162.     -> Zero the digit clicked on
  163.     IF sgw.bufferpos < sgw.numchars
  164.       work_ptr:=sgw.workbuffer+sgw.bufferpos
  165.       work_ptr[]:="0"
  166.     ENDIF
  167.   ELSE
  168.     -> UNKNOWN COMMAND
  169.     -> Hook should return zero if the command is not supported
  170.     return_code:=0
  171.   ENDIF
  172. ENDPROC return_code
  173.  
  174. -> E-Note: we don't need the hookEntry stuff, installhook does it all
  175.  
  176. -> Process messages received by the sgg_Window.  Quit when the close gadget
  177. -> is selected.
  178. -> E-Note: E version is simpler, since we use WaitIMessage
  179. PROC handleWindow(vars:PTR TO vars)
  180.   DEF class
  181.   REPEAT
  182.     class:=WaitIMessage(vars.sgg_Window)
  183.     -> If a code is set in the hook after an SGH_KEY command, where SGA_END is
  184.     -> set on return from the hook, the code will be returned in the Code field
  185.     -> of the IDCMP_GADGETUP message.
  186.     -> E-Note: ...so use MsgCode() to get at it
  187.   UNTIL class=IDCMP_CLOSEWINDOW
  188. ENDPROC
  189.