home *** CD-ROM | disk | FTP | other *** search
/ Amiga MA Magazine 1998 #6 / amigamamagazinepolishissue1998.iso / coders / jËzyki_programowania / amigae / moremodules / arq / req.e < prev   
Text File  |  1977-12-31  |  4KB  |  130 lines
  1. -> Simple ARQ Extended Requester Demo
  2. -> compiled with ec3.1a
  3.  
  4. -> This Code was written by me, Arne Meyer and is FreeWare.
  5. -> Do whatever you like with it.
  6. -> but send me a short eMail if it was useful for you.
  7. -> my email address is <q09883@pbhrzx.uni-paderborn.de>
  8.  
  9. OPT OSVERSION=36
  10. OPT PREPROCESS
  11.  
  12. ->#define DEBUG
  13.  
  14. #ifdef DEBUG
  15. MODULE 'tools/debug'
  16. #endif
  17.  
  18. MODULE 'intuition/intuition', 'tools/arq', 'exec/memory',
  19.        'icon', 'workbench/workbench',
  20.        'intuition/intuitionbase', 'intuition/screens'     -> for img test window
  21.  
  22.  
  23. DEF title[40]:STRING,
  24.     myargs[5]:ARRAY OF LONG
  25.  
  26. -> /// -------------------------- "PROC main" ---------------------------
  27.  
  28. PROC main()
  29. DEF result, rdargs
  30.  
  31.     IF rdargs := ReadArgs( 'TEXT/A,TITLE/A,BUTTONS/A,REQTYPE/N,ICON,X/N,Y/N', myargs, NIL )
  32.         result := geticonimage( myargs[4], Long(myargs[5]), Long(myargs[6]) )
  33.         FreeArgs( rdargs )
  34.     ENDIF
  35.  
  36. ENDPROC result
  37.  
  38. -> /// ------------------------------------------------------------------
  39. -> /// ---------------------- "PROC geticonimage" -----------------------
  40.  
  41. PROC geticonimage( object, xoffset = NIL, yoffset = NIL )
  42. DEF result = NIL,
  43.     dob:PTR TO diskobject
  44.  
  45.     IF (iconbase := OpenLibrary('icon.library',36))
  46.       #ifdef DEBUG
  47.       kputfmt( 'icon.library opened\n', NIL )
  48.       #endif
  49.       IF ( dob := GetDiskObject( object ) )
  50.         #ifdef DEBUG
  51.         kputfmt( 'dob         = $\h\n', [dob] )
  52.         kputfmt( 'dob.magic   = $\h\n', [dob.magic] )
  53.         kputfmt( 'dob.version = $\h\n', [dob.version] )
  54.         kputfmt( 'dob.stack   = $\h\n', [dob.stacksize] )
  55.         #endif
  56.  
  57.         result := doreq(dob.gadget::gadget.gadgetrender,xoffset,yoffset)
  58.  
  59.         FreeDiskObject( dob )
  60.       ELSE
  61.         #ifdef DEBUG
  62.         kputfmt( 'ERRORCODE = $\h\n', [ IoErr() ] )
  63.         #endif
  64.         result := doreq()
  65.       ENDIF
  66.     CloseLibrary( iconbase )
  67.     ENDIF
  68. ENDPROC result
  69.  
  70. -> /// ------------------------------------------------------------------
  71. /*
  72. -> /// ------------------------- "PROC showimg" -------------------------
  73.  
  74. PROC showimg(img:PTR TO image)
  75. DEF wnd:PTR TO window,
  76.     screen:PTR TO screen,
  77.     intuibase:PTR TO intuitionbase
  78.  
  79. WriteF('imgdata  at \h\n',img)
  80.     intuibase := intuitionbase
  81.     screen    := intuibase.activescreen
  82.     wnd := OpenW(0,20,100,100,IDCMP_CLOSEWINDOW,$e,'testwin',screen,2,0)
  83.     DrawImage(wnd.rport,img,20,20)
  84.     WaitIMessage(wnd)
  85.     CloseW(wnd)
  86. ENDPROC
  87.  
  88. -> /// ------------------------------------------------------------------
  89. */
  90. -> /// -------------------------- "PROC doreq" --------------------------
  91.  
  92. PROC doreq(img=NIL:PTR TO image,xoffset=NIL,yoffset=NIL)
  93. DEF result, eestruct:PTR TO exteasystruct  -> for ARQ
  94.  
  95.     NEW eestruct
  96.  
  97.     StringF(title,'\s\c',myargs[1],$a0) -> do the non-blanking space
  98.  
  99.     IF img
  100.         img.leftedge           := img.leftedge + xoffset
  101.         img.topedge            := img.topedge  + yoffset
  102.  
  103.         eestruct.animid        := ARQ_ID_IMAGE
  104.     ELSE
  105.         eestruct.animid        := And(Long(myargs[3]),7)
  106.     ENDIF
  107.  
  108.     eestruct.magic             := ARQ_MAGIC
  109.  
  110.     eestruct.flags             := NIL
  111.     eestruct.sound             := NIL
  112.     eestruct.reserved[0]       := NIL
  113.     eestruct.reserved[1]       := NIL
  114.     eestruct.reserved[2]       := NIL
  115.  
  116.     eestruct.image             := img
  117.  
  118.     eestruct.easy.structsize   := SIZEOF easystruct
  119.     eestruct.easy.flags        := NIL
  120.     eestruct.easy.title        := title
  121.     eestruct.easy.textformat   := myargs[0]
  122.     eestruct.easy.gadgetformat := myargs[2]
  123.  
  124.     result := EasyRequestArgs( NIL, eestruct.easy, NIL, NIL )
  125.  
  126.     END eestruct
  127.  
  128. ENDPROC result
  129. -> /// ------------------------------------------------------------------
  130.