home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / E / TFF-A32R.LZX / AmigaE3.2a / PdSrc / rexxHostC / big / big_host.e next >
Encoding:
Text File  |  1996-08-29  |  3.7 KB  |  145 lines
  1. ->
  2. ->  big_host.e
  3. ->
  4. ->  ARexx host (i.e. server) with bunch of totally useless functions...
  5. ->  written in E v3.0 as a demo showing limitless possiblities of the...
  6. ->  rexxHostC class
  7. ->
  8. ->  Public Domain  ·  by Piotr Obminski  ·  27-Dec-94 20:34:44
  9. ->
  10. ->
  11. ->                   !   A M I G A    F O R E V E R   !
  12. ->
  13. ->
  14.  
  15. MODULE  '*rexxHostC'
  16.  
  17.  
  18. DEF rx_obj  : PTR TO rexxHostC
  19.  
  20.  
  21. PROC main() HANDLE
  22.     DEF cb_list : PTR TO LONG
  23.  
  24.     cb_list := [    'LOVE',         { love },
  25.                     'HATE',         { hate },
  26.                     'SAY_PIPI',     { beep },
  27.                     'DISPLAYBEEP',  { beep },
  28.                     'GLOW',         { glow },
  29.                     'NOTHING',      NIL,
  30.                     'WBENCHTOBACK', `WbenchToBack() BUT 'OK',
  31.                     'WBENCHTOFRONT', `WbenchToFront() BUT 'OK',
  32.                     'GO_AWAY',      { go_away },
  33.                     'RATS',         `'BIG RODENTS!',    -> <-- see this?!
  34.                     'ODD',          { odd } ]
  35.  
  36.  
  37.     NEW rx_obj.rexxHostC( cb_list, 'big_host', -51, 
  38.                             `PrintF( 'Setup completed, now try me!\n' )  )
  39.  
  40.  
  41. EXCEPT DO
  42.  
  43.     SELECT exception
  44.         CASE 0
  45.             PrintF( 'You\ave aborted...\n' )
  46.         CASE ERR_NOTUNIQUE
  47.             PrintF( 'It seems that I\am ALREADY RUNNING...\n' )
  48.         CASE ERR_LISTNIL
  49.             PrintF( 'I\ave got NIL for CALLBACK LIST!\n' )
  50.         CASE ERR_NOTADDED
  51.             PrintF( 'HOST could NOT be ADDED!\n' )
  52.         CASE ERR_BADLIST
  53.             PrintF( 'Check your CALLBACK LIST!\n' )
  54.         CASE "MEM"
  55.             PrintF( 'Memory!\n' )
  56.         CASE "REXX"
  57.             PrintF( 'I need rexxsyslib.library!\n' )
  58.         DEFAULT
  59.             PrintF( '? ? ?\n' )         -> this should never happen
  60.     ENDSELECT
  61. ENDPROC
  62.  
  63. -> ------------------------ callbacks -----------------------------
  64.  
  65. ->
  66. -> just says how many arguments it got and displays them, to do that
  67. -> it calls another callback
  68. ->
  69. PROC love()
  70.     PrintF( 'love() here calling hate()...\n' )
  71.     hate()                                  -> just call another callback
  72. ENDPROC 'it''s "kärlek" in Swedish'
  73.  
  74.  
  75. ->
  76. -> just says how many arguments it got and displays them
  77. ->
  78. PROC hate()
  79.     DEF num, i
  80.  
  81.     num := rx_obj.getNumArgs()
  82.  
  83.     PrintF( 'hate() here, I got \d args!\n', num )
  84.  
  85.     FOR i := 1 TO num
  86.         PrintF( 'arg #\d = \s\n', i, rx_obj.getStr( i ) )
  87.     ENDFOR
  88. ENDPROC 'it''s "hat" in Swedish'
  89.  
  90.  
  91. ->
  92. -> Intuition support -- wow!
  93. ->
  94. PROC beep()
  95.     DEF i, how_many = 3, fGotArg = FALSE
  96.  
  97.     IF rx_obj.getNumArgs() > 0 THEN how_many, fGotArg := rx_obj.getNum( 1 )
  98.  
  99.     FOR i := 1 TO 3
  100.         DisplayBeep( NIL )
  101.         Delay( 10 )
  102.     ENDFOR
  103.  
  104.     IF ( fGotArg = TRUE ) AND ( how_many = 3 )
  105.         RETURN 'here you are: as many beeps as you requested!'
  106.     ELSE
  107.         RETURN 'you\ave got default number of beeps which is 3!'
  108.     ENDIF
  109. ENDPROC
  110.  
  111.  
  112. ->
  113. -> some hardware-generated colors in inline assembly
  114. ->
  115. PROC glow()
  116.     DEF i
  117.  
  118.     FOR i := 0 TO 100000
  119.         MOVE.W  $DFF006, $DFF180
  120.         BCHG    #1, $BFE001
  121.     ENDFOR
  122. ENDPROC rx_obj.longToStr( i )    -> because Rexx wants strings!
  123.  
  124.  
  125. ->
  126. -> E's own Odd() for ARexx, it returns '1' for TRUE and '0' for FALSE
  127. -> (which ARexx will see as numbers anyway!), it returns ARexx error
  128. -> RX_WARN (i.e. 5) for bad number of arguments
  129. ->
  130. -> NOTE THAT THEY MUST BE RETURNED AS STRINGS FOR AREXX! (which will then
  131. -> treat them as numbers)
  132. ->
  133. PROC odd()
  134.     IF rx_obj.getNumArgs() <> 1 THEN RETURN 5, 0
  135. ENDPROC IF Odd( rx_obj.getNum( 1 ) ) THEN '1' ELSE '0'
  136.  
  137.  
  138. ->
  139. -> this aborts rexxHostC object (we have the internal COMMAND 'BYE',
  140. -> but let's define a FUNCTION doing exactly the same)
  141. ->
  142. PROC go_away()
  143.     rx_obj.break()              -> that' how our method break() is used
  144. ENDPROC 'if you must...'
  145.