home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / E / TFF-A32R.LZX / AmigaE3.2a / Src / Tools / CookRawKey / cookRawkeyTest.e < prev   
Encoding:
Text File  |  1994-10-04  |  4.5 KB  |  125 lines
  1. /*------------------------------------------------------------------------*
  2.   cookRawkeyTest.e - test and demonstrate usage of module cookRawkey.m
  3.  
  4.   See function winDim() for a neato (although somewhat messy) example of
  5.   font- and os-sensitivity.
  6.  
  7.   Note: if your using custom fonts, you must have all characters defined
  8.   in order to see them.  If any show up blank (except for, like, Space),
  9.   chances are that character isn't defined in your font.
  10.  *------------------------------------------------------------------------*/
  11.  
  12. MODULE 'devices/inputevent',
  13.        'graphics/gfxbase',
  14.        'graphics/rastport',
  15.        'graphics/text',
  16.        'intuition/intuition',
  17.        'intuition/screens',
  18.        'tools/cookRawkey',
  19.        'tools/ctype'
  20.  
  21. CONST ESCAPE_KEY=27
  22.  
  23. CONST TEXT_MAXLENGTH=23,
  24.       TITLE_MAXLENGTH=20
  25.  
  26. DEF wborleft, wborbottom, fontBelowBase
  27.  
  28. PROC max(a, b) IS IF a>b THEN a ELSE b
  29.  
  30. PROC winDim(gfxBase:PTR TO gfxbase, windowTitle)
  31. /* determine the dimensions necessary to display our text. */
  32.   DEF scr:PTR TO screen, xsize=0, ysize=0
  33.   IF KickVersion(36)
  34.     IF scr:=LockPubScreen('Workbench')
  35.       xsize:=max(gfxBase.defaultfont::textfont.xsize*TEXT_MAXLENGTH,
  36.                  IntuiTextLength([0,1,RP_JAM1,0,0, scr.font,
  37.                                   windowTitle,NIL]:intuitext)+1)+
  38.              (wborleft:=scr.wborleft)+scr.wborright
  39.       ysize:=gfxBase.defaultfont::textfont.ysize+
  40.              scr.rastport::rastport.font::textfont.ysize+
  41.              scr.wbortop+1+
  42.              (wborbottom:=scr.wborbottom)
  43.       UnlockPubScreen(NIL, scr)
  44.     ENDIF
  45.   ELSE
  46.     wborleft:=4
  47.     wborbottom:=4
  48.     xsize:=8*TEXT_MAXLENGTH+(wborleft*2)
  49.     ysize:=8*2+(wborbottom*2+1)
  50.   ENDIF
  51. ENDPROC xsize,ysize
  52.  
  53. PROC format(s, format, n)
  54. /*---------------------------------------------------------*
  55.   format string 's' with number 'n', according to format
  56.   string 'format'.  pads leading spaces in 's' with zeroes.
  57.  *---------------------------------------------------------*/
  58.   DEF i, strLast
  59.   StringF(s, format, n)
  60.   strLast:=StrLen(s)-1
  61.   FOR i:=0 TO strLast DO IF s[i]=" " THEN s[i]:="0"
  62. ENDPROC s
  63.  
  64. PROC main() HANDLE
  65.   DEF win=NIL:PTR TO window, winTitle, winHeight, winWidth,
  66.       idcmpMessage:PTR TO intuimessage, idcmpCode, idcmpQualifier, iAddress,
  67.       error, errorMessage, asciiChar, hexStr[3]:STRING, decStr[3]:STRING
  68.   /*------------------------------*
  69.     Init rawkey conversion module.
  70.    *------------------------------*/
  71.   IF error:=warmupRawkeyCooker() THEN Raise(error)
  72.   winWidth,winHeight:=winDim(gfxbase, winTitle:='Press Escape to Quit')
  73.   /*-- Convert rawkeys until ESC key is pressed. --*/
  74.   IF win:=OpenW(20, 20, winWidth, winHeight,
  75.                 IDCMP_RAWKEY, WFLG_ACTIVATE,
  76.                 winTitle, NIL, WBENCHSCREEN, NIL)
  77.     IF FALSE=KickVersion(36) THEN SetTopaz(win)
  78.     fontBelowBase:=win.rport::rastport.txheight-
  79.                    win.rport::rastport.font::textfont.baseline
  80.     REPEAT
  81.       /*-- Wait on rawkey. --*/
  82.       WHILE (idcmpMessage:=GetMsg(win.userport))=NIL DO WaitPort(win.userport)
  83.       /*-- Copy intuimessage info, then reply. --*/
  84.       idcmpCode:=idcmpMessage.code
  85.       idcmpQualifier:=idcmpMessage.qualifier
  86.       iAddress:=idcmpMessage.iaddress
  87.       ReplyMsg(idcmpMessage)
  88.       /*------------------------*
  89.         Convert rawkey to ascii.
  90.        *------------------------*/
  91.       IF asciiChar:=cookRawkey(idcmpCode, idcmpQualifier, iAddress)
  92.         TextF(wborleft, win.height-wborbottom-fontBelowBase,
  93.               'Char=\c Hex=$\s Dec=\s',
  94.               IF isprint(asciiChar) THEN asciiChar ELSE $7f,
  95.               format(hexStr, '\h[3]', asciiChar),
  96.               format(decStr, '\d[3]', asciiChar))
  97.       ENDIF
  98.     UNTIL asciiChar=ESCAPE_KEY
  99.     CloseW(win)
  100.   ELSE
  101.     WriteF('Can''t open window\n')
  102.   ENDIF
  103.   /*---------------------------------*
  104.     Cleanup rawkey conversion module.
  105.    *---------------------------------*/
  106.   shutdownRawkeyCooker()
  107. EXCEPT
  108.   errorMessage:='figger it out'
  109.   /*--------------------------------------*
  110.     Handle exceptions raised by conversion
  111.    *--------------------------------------*/
  112.   SELECT exception
  113.     CASE "MEM";          errorMessage:='get memory'
  114.     CASE ER_CREATEPORT;  errorMessage:='create message port'
  115.     CASE ER_CREATEIO;    errorMessage:='create IO request'
  116.     CASE ER_OPENDEVICE;  errorMessage:='open console.device'
  117.     CASE ER_ASKKEYMAP;   errorMessage:='ask keymap'
  118.   ENDSELECT
  119.   WriteF('Could not \s!\n', errorMessage)
  120.   /*---------------------------------*
  121.     Cleanup rawkey conversion module.
  122.    *---------------------------------*/
  123.   shutdownRawkeyCooker()
  124. ENDPROC
  125.