home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD1.iso / GFX / viewer / VISCOM12.LHA / VisageCom.e < prev    next >
Encoding:
Text File  |  1996-11-17  |  20.4 KB  |  560 lines
  1. /*************************************************************************
  2. *                                                                        *
  3. *                              VisageCom                                 *
  4. *                                                                        *
  5. *  By Philippe "Elwood" FERRUCCI                         Decines FRANCE  *
  6. *                                                                        *
  7. *************************************************************************/
  8.  
  9. MODULE 'dos/dos','intuition/screens','intuition/intuition',
  10.        'gadtools','libraries/gadtools','reqtools','libraries/reqtools',
  11.        'utility/tagitem','graphics/gfxbase',
  12.        'graphics/rastport','graphics/text','exec/ports','exec/nodes',
  13.        'dos/dosextens','exec/tasks',
  14.  
  15.        'exec/io',            -> iostdreq
  16.        'devices/input',      -> CMD_WAITEVENT
  17.        'devices/inputevent', -> inputevent
  18.        'exec/memory'         -> MEMF_PUBLIC
  19.  
  20. ENUM NONE,NOARGS,NOMEM,NOLIB,NOGAD,NOFILE1,NOFILE2
  21.  
  22. DEF progname[50]:STRING,args:PTR TO LONG,template,rdargs
  23.  
  24. -> filename can be 108 chars long
  25. DEF filename[108]:STRING,destination[108]:STRING,validdest
  26. DEF p_filelock=NIL,fib=NIL:PTR TO fileinfoblock
  27.  
  28. DEF topscreen=200 -> horizontal line where the visagecom screen will open
  29. DEF scr=NIL:PTR TO screen,win=NIL:PTR TO window,wintitle[100]:STRING
  30.  
  31. DEF screen=NIL:PTR TO screen        -> screen used only when using 'Set Dir'
  32. DEF visual,glist=NIL,p_gad:PTR TO gadget
  33. DEF idcmp
  34.  
  35. DEF getout=0,useranswer,p_task:PTR TO task   -> to find the visage task
  36.  
  37. OBJECT button      -> used to create a list of button
  38.   item:PTR TO CHAR
  39. ENDOBJECT
  40.  
  41. RAISE NOARGS  IF ReadArgs() = NIL,            -> automatic error handling :
  42.       NOLIB   IF OpenLibrary() = NIL,         -> when the program is done
  43.       NOMEM   IF OpenScreenTagList() = NIL,   -> I sequentially pick each
  44.       NOGAD   IF GetVisualInfoA() = NIL,      -> potential failure of the
  45.       NOGAD   IF CreateContext() = NIL,       -> program and I build this
  46.       NOGAD   IF CreateGadgetA() = NIL,       -> list.
  47.       NOMEM   IF OpenWindowTagList() = NIL,   -> Thanks to Wouter, the
  48.       NOFILE1 IF Read() = -1,                 -> source is easier to read
  49.       NOMEM   IF New() = NIL,                 -> and understand.
  50.       NOFILE2 IF AddPart() = NIL,
  51.       NOMEM   IF RtAllocRequestA() = NIL
  52.  
  53. PROC main() HANDLE
  54.   VOID '$VER: VisageCom 1.2 By Philippe "Elwood" FERRUCCI (10/11/96)'
  55.  
  56.   init()
  57.  
  58.   examinefile(filename)
  59.  
  60.   opengui()
  61.  
  62.   Raise(NONE)    -> everything is done we get out of here.
  63.  
  64. EXCEPT
  65.   -> if pointer is still valid then "remove it"
  66.   IF p_filelock THEN UnLock(p_filelock)
  67.   IF fib THEN FreeDosObject(DOS_FIB,fib)
  68.  
  69.   IF scr THEN ScreenToBack(scr)
  70.   IF win THEN CloseWindow(win); win := NIL  -> close the window first !
  71.   IF glist THEN FreeGadgets(glist)          -> and this line second.
  72.   IF visual THEN FreeVisualInfo(visual)
  73.   IF gadtoolsbase THEN CloseLibrary(gadtoolsbase)
  74.   IF reqtoolsbase THEN CloseLibrary(reqtoolsbase)
  75.  
  76.   IF scr    THEN CloseScreen(scr);    scr    := NIL -> those NIL are not
  77.   IF screen THEN CloseScreen(screen); screen := NIL -> usefull
  78.  
  79.   -> I close everything before saying Visage to continue to avoid problems
  80.   -> I encoutered in double buffering mode
  81.   -> (the new selected window wasn't the "in front" one)
  82.  
  83.   -> when Visage is showing an image it (Visage itself or the datatype it
  84.   -> is using) locks that file, so before deleting
  85.   -> I have to say to Visage to continue in order to remove the lock
  86.  
  87.   IF (getout >= 1) AND (getout <= 5) THEN
  88.      IF (p_task := getvisagetask()) THEN Signal(p_task,SIGBREAKF_CTRL_D)
  89.  
  90.   IF (getout = 2) OR (getout = 3)
  91.      Delay(50)             -> I wait a while to be sure lock is dead
  92.      DeleteFile(filename)  -> guess what this dos library function do ?
  93.   ENDIF
  94.  
  95.   SELECT exception
  96.     CASE NOARGS
  97.       WriteF('Usage: \s <filename> <destination>\n',progname)
  98.     CASE NOMEM
  99.       WriteF('Not enough memory !\n')
  100.     CASE NOLIB
  101.       WriteF('Can''t open required libraries !\n')
  102.     CASE NOGAD
  103.       WriteF('Failure in a gadtools function !\n')
  104.     CASE NOFILE1
  105.       WriteF('Can''t read file correctly !\n')
  106.     CASE NOFILE2
  107.       WriteF('Can''t write file !\n')
  108.   ENDSELECT
  109.   CleanUp(0)    -> Amiga E cleans used RAM
  110.  
  111. ENDPROC
  112.  
  113. PROC examinefile(name:PTR TO CHAR)
  114. DEF tmp
  115.  
  116.   IF (p_filelock := Lock(name,ACCESS_READ)) = 0 THEN Raise(NOFILE1)
  117.  
  118.   IF (fib := AllocDosObject(DOS_FIB,NIL)) THEN
  119.      tmp := Examine(p_filelock,fib) 
  120.      IF tmp = 0       -> fills 'fib' structure
  121.         FreeDosObject(DOS_FIB,fib)        -> with infos about the file
  122.         fib := NIL
  123.      ENDIF
  124. ENDPROC
  125.  
  126. PROC opengui()
  127.  
  128.   gadtoolsbase := OpenLibrary('gadtools.library',39)  -> open needed libs
  129.   reqtoolsbase := OpenLibrary('reqtools.library',38)
  130.  
  131.   scr := OpenScreenTagList(NIL,[SA_TOP,topscreen,     -> open screen at
  132.                                 SA_HEIGHT,50,         -> bottom of display
  133.                                 SA_LIKEWORKBENCH,TRUE,
  134.                                 SA_TYPE,PUBLICSCREEN,
  135.                                 SA_PUBNAME,'VisageCom',
  136.                                 SA_DRAGGABLE,FALSE,
  137.   -> opened and prepared behind for aesthetic reasons
  138.                                 SA_BEHIND,TRUE,
  139.                                 SA_QUIET,TRUE,    -> useless but who cares
  140.                                 TAG_DONE])            -> end of tag list
  141.  
  142.   visual := GetVisualInfoA(scr,NIL) -> initialises some gadtools structures
  143.  
  144.   p_gad := CreateContext({glist})   -> creates the shadow gadget used as
  145.                                     -> the first gadget of the window
  146.  
  147.   -> the same thing is done 6 times (each gadget) so it would be too long
  148.   -> and unreadable here. That's why a used a PROC routine.
  149.   p_gad:=preparegadget(p_gad,['_Copy','_Delete','_Move','_Rename',
  150.                               'C_omment','_Set Dir','C_ancel']:button)
  151.  
  152.   -> the window title will be like this: "Choose an action for <filename>"
  153.   StrCopy(wintitle,'Choose an action for ',ALL)
  154.   StrAdd(wintitle,filename,ALL)
  155.  
  156.   win := OpenWindowTagList(NIL,[WA_TOP,0,     -> open a window on the
  157.                                 WA_LEFT,0,    -> previous opened screen
  158.                                 WA_WIDTH,640,
  159.                                 WA_PUBSCREEN,scr,  -> pointer to the screen
  160.                                 WA_GADGETS,glist,  -> gadget list prepared
  161.                                 WA_ACTIVATE,    TRUE,
  162.   -> I want to be warned by the great Amiga IDCMP system when those
  163.   -> events occured: key/mousebutton pressed or window is made inactive or
  164.   -> a gadget has been used
  165.                                 WA_IDCMP,       IDCMP_VANILLAKEY OR
  166.                                                 IDCMP_MOUSEBUTTONS OR
  167.                                                 IDCMP_INACTIVEWINDOW OR
  168.                                                 IDCMP_GADGETUP,
  169.                                 WA_TITLE,       wintitle,
  170.                                 TAG_DONE])
  171.  
  172.   Gt_RefreshWindow(win,NIL)   -> needed by gadtools after window is opened
  173.  
  174.   IF validdest = FALSE THEN disablegad(win,[1,3])
  175.  
  176.   ScreenToFront(scr)          -> the screen is ready to be introduced to you
  177.  
  178.   setmouse(scr,p_gad.leftedge,p_gad.topedge) -> mouse goes to last gadget
  179.  
  180.   -> !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  181.   -> Please pay attention that if you use gadtools features you have to
  182.   -> use gadtools version of message managing: GT_GetIMsg and GT_ReplyIMsg
  183.   -> instead of the intuition equivalent (GetMsg and ReplyMsg) included in
  184.   -> in the E procedure WaitIMessage (have a look at this one in the E doc)
  185.   -> used here (I know I'm a bad boy ! )
  186.  
  187.   WHILE getout = 0
  188.  
  189.     idcmp := WaitIMessage(win)        -> we wait one of the wanted IDCMP
  190.  
  191.     SELECT idcmp
  192.  
  193.       CASE IDCMP_GADGETUP             -> a gadget has been pressed/released
  194.          p_gad := MsgIaddr()          -> which one ?
  195.          getout := p_gad.gadgetid     -> 'getout' is set with the gadget id
  196.  
  197.       CASE IDCMP_MOUSEBUTTONS         -> button pressed
  198.          -> left mouse button pressed outside the window
  199.          IF (MsgCode() = SELECTUP) AND (scr.mousey < 0) THEN getout := -1
  200.  
  201.       CASE IDCMP_INACTIVEWINDOW
  202.          ActivateWindow(win)   -> makes the window be the active one again
  203.  
  204.       CASE IDCMP_VANILLAKEY       -> a key pressed
  205.          useranswer := MsgCode()  -> which one ?
  206.          SELECT useranswer
  207.            CASE "c"               -> Copy
  208.              getout:=1
  209.            CASE "d"               -> Delete
  210.              getout:=2
  211.            CASE "m"               -> Move
  212.              getout:=3
  213.            CASE "r"               -> Rename
  214.              getout:=4
  215.            CASE "o"               -> Comment
  216.              getout:=5
  217.            CASE "s"               -> Set dir
  218.              getout:=6
  219.            CASE "a"               -> Cancel
  220.              getout:=7
  221.          ENDSELECT
  222.  
  223.     ENDSELECT
  224.  
  225.     -> Action !!!
  226.     SELECT getout            -> gadget selected / key pressed
  227.  
  228.     -> please pay attention that all delete actions are made later
  229.     -> see below for explanation
  230.  
  231.       CASE 1
  232.          copyfile(filename)  -> we copy the file to destination
  233.       CASE 3
  234.          copyfile(filename)  -> the same. (delete is done after)
  235.       CASE 4
  236.          IF (dorename(filename)) = 0 THEN getout := 0  -> rename cancelled
  237.       CASE 5
  238.          IF (docomment(filename)) = 0 THEN getout := 0 -> comment cancelled
  239.       CASE 6
  240.          setdir()      -> we change destination
  241.          getout := 0   -> we always continue
  242.     ENDSELECT
  243.  
  244.   ENDWHILE
  245.  
  246. ENDPROC
  247.  
  248. PROC init()
  249. DEF tmplock
  250.  
  251.   -> this is only for writing a good 'Usage' message (if you changed the
  252.   -> name of the prog (in 'Vcom' for instance)
  253.   IF (GetProgramName(progname,50)) = 1 THEN StrCopy(progname,'VisageCom',ALL)
  254.  
  255.   args:=[NIL,NIL,NIL]                          -> init args structure.
  256.   template:='FILE/A,DEST/A,TOPSCREEN/N'        -> 2 arguments needed.
  257.   rdargs:=ReadArgs(template,args,NIL)          -> dos library function.
  258.  
  259.   StrCopy(filename,args[],ALL)                 -> copy of args in Estring
  260.   StrCopy(destination,args[1],ALL)             -> fields.
  261.   IF args[2]
  262.      topscreen := args[2]
  263.      topscreen := ^topscreen
  264.   ENDIF
  265.   FreeArgs(rdargs)                             -> dos library function.
  266.  
  267.   -> we check if destination is valid
  268.   IF (tmplock := Lock(destination,ACCESS_READ)) = 0
  269.      validdest := FALSE
  270.   ELSE
  271.      UnLock(tmplock)
  272.      validdest := TRUE
  273.   ENDIF
  274.  
  275. ENDPROC
  276.  
  277. PROC preparegadget(gad:PTR TO gadget,buttonlist:PTR TO button)
  278. DEF saveptr,id,len,text[100]:STRING
  279.  -> next line used to get the default font
  280. DEF p_ta:PTR TO textattr,gfx:PTR TO gfxbase,p_tf:PTR TO textfont,node:PTR TO node
  281. DEF intuilen,intui:PTR TO intuitext
  282. DEF leftedge,between
  283.  
  284.   -> fasten your seat belt and here we go
  285.   -> I hope this is the good way to do it
  286.  
  287.   len := ListLen(buttonlist)   -> how much gadget we have to create
  288.  
  289.   -> we look for the default font
  290.   gfx := gfxbase           -> we get a pointer to the gfxbase structure
  291.   p_tf := gfx.defaultfont  -> in gfxbase we get a pointer to a textfont struct
  292.   node := p_tf.message.node   -> and another pointer to get the fontname
  293.   p_ta := [node.name,p_tf.ysize,p_tf.style,p_tf.flags]:textattr
  294.  
  295.   saveptr := buttonlist
  296.  
  297.   -> here I count how much pixels must be placed between each gadget
  298.   FOR id := 1 TO len           -> BAD:   FOR ind := 1 TO ListLen(buttonlist)
  299.     StrAdd(text,^buttonlist)   -> we create a string with all texts
  300.     buttonlist++               -> we get the next one
  301.   ENDFOR
  302.   intui := [1,0,RP_JAM1,0,0,p_ta,text,NIL]:intuitext
  303.   intuilen := IntuiTextLength(intui)        -> length of characters
  304.   between := (640 - intuilen) / (len + 1)   -> step between each gadget
  305.   leftedge := -10                           -> a small correction
  306.   intuilen := 0
  307.  
  308.   buttonlist := saveptr
  309.   FOR id := 1 TO len           -> BAD:   FOR ind := 1 TO ListLen(buttonlist)
  310.     StrCopy(text,^buttonlist,ALL)   -> we get the text of the current object
  311.     buttonlist++                    -> we get the next one for next run
  312.  
  313.     -> this, is to create each gadget at 'between' pixels from the previous
  314.     leftedge := leftedge + intuilen + between
  315.  
  316.     -> length of current gadget text
  317.     intui := [1,0,RP_JAM1,0,0,p_ta,text,NIL]:intuitext
  318.     intuilen := IntuiTextLength(intui)
  319.  
  320.     IF ((id = 1) OR (id = 3)) AND (validdest = FALSE)  -> Copy/Move disabled
  321.        gad := CreateGadgetA(
  322.                BUTTON_KIND,gad,              -> type,previous gadget
  323.                [leftedge,20,intuilen+15,20,  -> leftedge,topedge,width,height
  324.                  text,p_ta,                  -> gadgettext,font
  325.                  id,PLACETEXT_IN,            -> ID,position
  326.                  visual,0]:newgadget,        -> visual,userdata
  327.                [GT_UNDERSCORE,"_",
  328.                 GFLG_DISABLED,TRUE,TAG_END])   -> additional taglist
  329.     ELSE
  330.        gad := CreateGadgetA(
  331.                BUTTON_KIND,gad,              -> type,previous gadget
  332.                [leftedge,20,intuilen+15,20,  -> leftedge,topedge,width,height
  333.                  text,p_ta,                  -> gadgettext,font
  334.                  id,PLACETEXT_IN,            -> ID,position
  335.                  visual,0]:newgadget,        -> visual,userdata
  336.                [GT_UNDERSCORE,"_",TAG_END])  -> additional taglist
  337.     ENDIF
  338.   ENDFOR
  339. ENDPROC gad
  340.  
  341. -> enables gadgets of a specific window
  342. PROC enablegad(p_win:PTR TO window,idlist:PTR TO LONG)
  343.   DEF len,i,gadid,p_gad:PTR TO gadget
  344.  
  345.   -> instead of saving the gadget address of the 2 gadgets I wanted to
  346.   -> enable/disable, I wrote this PROC wgich allows you to enable the
  347.   -> first and the third gadget of a specific window calling:
  348.   -> enablegad(win,[1,3])
  349.  
  350.   len := ListLen(idlist)
  351.   p_gad := p_win.firstgadget   -> we get the address of the first gadget
  352.  
  353.   FOR i := 1 TO len            -> for each number of gadget, we lokk for it
  354.     gadid := ^idlist; idlist++          -> in the gadget list
  355.     WHILE p_gad.gadgetid <> gadid       -> of the window
  356.       p_gad := p_gad.nextgadget         -> and we enable the one
  357.     ENDWHILE                            -> we want: the first one and the
  358.     OnGadget(p_gad,p_win,NIL)           -> third one here.
  359.   ENDFOR
  360.  
  361. ENDPROC
  362.  
  363. PROC disablegad(p_win:PTR TO window,idlist:PTR TO LONG)
  364.   DEF len,i,gadid,p_gad:PTR TO gadget
  365.  
  366.   len := ListLen(idlist)
  367.   p_gad := p_win.firstgadget
  368.  
  369.   FOR i := 1 TO len
  370.     gadid := ^idlist; idlist++
  371.     WHILE p_gad.gadgetid <> gadid
  372.       p_gad := p_gad.nextgadget
  373.     ENDWHILE
  374.     OffGadget(p_gad,p_win,NIL)
  375.   ENDFOR
  376.  
  377. ENDPROC
  378.  
  379. PROC copyfile(file)
  380. DEF filelen,filehandler,basename:PTR TO CHAR
  381. DEF mem=NIL
  382.  
  383.   filelen := FileLength(file)
  384.  
  385.   -> file is already locked
  386.  
  387.   IF (filehandler := Open(file,OLDFILE)) = NIL THEN Raise(NOFILE1)
  388.  
  389.   mem := New(filelen)               -> we allocate memory to store the file
  390.   Read(filehandler,mem,filelen)     -> we store the file in memory
  391.   Close(filehandler)                -> close the file
  392.  
  393.   basename := FilePart(file)           -> extract the filename
  394.   AddPart(destination,basename,100)    -> add this name to destination dir
  395.  
  396.   IF (filehandler := Open(destination,NEWFILE)) = NIL THEN Raise(NOFILE2)
  397.   IF Write(filehandler,mem,filelen) = -1  -> error (e.g. no free space)
  398.      Close(filehandler)
  399.      DeleteFile(destination)
  400.   ELSE
  401.      Close(filehandler)
  402.      -> copy date and filecomment found in 'fib'
  403.      IF fib
  404.         SetFileDate(destination,fib.datestamp)
  405.         SetComment(destination,fib.comment)
  406.         FreeDosObject(DOS_FIB,fib); fib := NIL
  407.      ENDIF
  408.   ENDIF
  409.  
  410. ENDPROC
  411.  
  412. PROC dorename(file)
  413. DEF answer[108]:STRING,wintitle[130]:STRING,req
  414.  
  415.   StrCopy(wintitle,'Enter new name for ',ALL)
  416.   StrAdd(wintitle,file,ALL)
  417.  
  418.   StrCopy(answer,file,ALL)
  419.   req := RtAllocRequestA(RT_REQINFO,NIL)     -> allocate what is needed (!)
  420.   useranswer := RtGetStringA(answer,200,wintitle,req,
  421.                              [RT_WINDOW,win,
  422.                               RT_IDCMPFLAGS,IDCMP_INACTIVEWINDOW,
  423.                               RTGS_WIDTH,640,
  424.                               RT_TOPOFFSET,0,
  425.                               TAG_DONE])     -> taglists should end like this
  426.   RtFreeRequest(req)                         -> free what was allocated
  427.  
  428.   -> if user closed the requester with return/OK then rename file
  429.   IF useranswer THEN
  430.      -> if you inactive the requester, useranswer will be the IDCMP
  431.      IF useranswer = IDCMP_INACTIVEWINDOW
  432.         useranswer := 0
  433.      ELSE
  434.         Rename(file,answer)
  435.      ENDIF
  436.  
  437. ENDPROC useranswer     -> used to know if rename has been done or canceled
  438.  
  439. PROC docomment(file)
  440. DEF req,answer[108]:STRING,wintitle[130]:STRING
  441.  
  442.   StrCopy(wintitle,'Enter comment for ',ALL)
  443.   StrAdd(wintitle,file,ALL)
  444.  
  445.   IF fib THEN StrCopy(answer,fib.comment,ALL)
  446.   req := RtAllocRequestA(RT_REQINFO,NIL)     -> allocate what is needed (!)
  447.   useranswer := RtGetStringA(answer,200,wintitle,req,
  448.                              [RT_WINDOW,win,
  449.                               RT_IDCMPFLAGS,IDCMP_INACTIVEWINDOW,
  450.                               RTGS_WIDTH,640,
  451.                               RT_TOPOFFSET,0,
  452.                               TAG_DONE])     -> taglists should end like this
  453.   RtFreeRequest(req)                         -> free what was allocated
  454.  
  455.   -> if user closed the requester with return/OK then save comment
  456.   IF useranswer THEN
  457.      IF useranswer = IDCMP_INACTIVEWINDOW
  458.         useranswer := 0
  459.      ELSE
  460.         SetComment(file,answer)
  461.      ENDIF
  462.  
  463. ENDPROC useranswer     -> used to know if rename has been done or canceled
  464.  
  465. PROC setdir()
  466. DEF req:PTR TO rtfilerequester,answer[108]:ARRAY
  467.  
  468.   req := RtAllocRequestA(RT_FILEREQ,NIL)
  469.  
  470.   -> as my screen was too small for the requester, here is a second one
  471.   screen := OpenScreenTagList(NIL,[SA_LIKEWORKBENCH,TRUE,
  472.                                    SA_TITLE,'Set Dir',
  473.                                    SA_DRAGGABLE,FALSE,
  474.                                    TAG_DONE])
  475.   IF validdest THEN RtChangeReqAttrA(req,[RTFI_DIR,destination])
  476.   useranswer := RtFileRequestA(req,
  477.                                answer,'Choose a new destination',
  478.                                [RT_SCREEN,screen,
  479.                                 RT_REQPOS,REQPOS_CENTERSCR,
  480.                                 RTFI_FLAGS,FREQF_NOFILES,
  481.                                 TAG_DONE])
  482.   IF useranswer
  483.      validdest := TRUE
  484.      StrCopy(destination,req.dir,ALL)
  485.      enablegad(win,[1,3])
  486.   ENDIF
  487.  
  488.   RtFreeRequest(req)
  489.   CloseScreen(screen)
  490.   screen := NIL        -> this NIL is important !
  491.  
  492. ENDPROC
  493.  
  494. PROC getvisagetask()
  495. DEF p_process:PTR TO process,p_cli:PTR TO commandlineinterface
  496. DEF clinum,lastclinum,taskname[80]:STRING,taskfound=FALSE
  497.  
  498.   clinum     := 1
  499.   lastclinum := MaxCli()                  -> get the last cli number
  500.  
  501.   -> browse each cli process from 1 to lastclinum - 1
  502.   WHILE (taskfound=FALSE) AND (clinum<lastclinum)
  503.     p_process := FindCliProc(clinum)      -> finds this process
  504.  
  505.             -> perhaps the task has been removed since the call to MaxCli()
  506.     IF p_process
  507.       p_task := p_process.task              -> pointer to the process task
  508.       p_cli := Shl(p_process.cli,2)         -> converts the BCPL address
  509.       taskname := Shl(p_cli.commandname,2)  -> commandname is a BCPL too
  510.       taskname := TrimStr(taskname)         -> needs a correct format
  511.       taskname := LowerStr(FilePart(taskname))
  512.       IF StrCmp(taskname,'visage',ALL) THEN taskfound := TRUE
  513.     ENDIF
  514.     INC clinum
  515.   ENDWHILE
  516.  
  517.   IF taskfound = FALSE THEN p_task := NIL
  518.  
  519. ENDPROC p_task
  520.  
  521. PROC setmouse(scr:PTR TO screen,x,y)
  522.   DEF p_iostdreq:PTR TO iostdreq,mp:PTR TO msgport,p_ievent:PTR TO inputevent
  523.   DEF ppix:PTR TO iepointerpixel
  524.  
  525.   -> code based upon SetMouse from Ketil Hunn
  526.  
  527.   IF (mp := CreateMsgPort())
  528.      IF (p_ievent := AllocVec(SIZEOF inputevent, MEMF_PUBLIC))
  529.         IF (ppix := AllocVec(SIZEOF iepointerpixel, MEMF_PUBLIC))
  530.            IF p_iostdreq := CreateIORequest(mp,SIZEOF iostdreq)
  531.               IF Not (OpenDevice('input.device', NIL, p_iostdreq, NIL))
  532.                  ppix.screen    := scr
  533.                  ppix.positionx := x
  534.                  ppix.positiony := y
  535.  
  536.                  p_ievent.nextevent    := NIL
  537.                  p_ievent.class        := IECLASS_NEWPOINTERPOS
  538.                  p_ievent.subclass     := IESUBCLASS_PIXEL
  539.                  p_ievent.code         := 0
  540.                  p_ievent.qualifier    := NIL
  541.                  p_ievent.eventaddress := ppix
  542.  
  543.                  p_iostdreq.data    := p_ievent
  544.                  p_iostdreq.length  := SIZEOF inputevent
  545.                  p_iostdreq.command := IND_WRITEEVENT
  546.                  DoIO(p_iostdreq)
  547.  
  548.                  CloseDevice(p_iostdreq)
  549.               ENDIF
  550.               DeleteIORequest(p_iostdreq)
  551.            ENDIF
  552.            FreeVec(ppix)
  553.         ENDIF
  554.         FreeVec(p_ievent)
  555.      ENDIF
  556.      DeleteMsgPort(mp)
  557.   ENDIF
  558.  
  559. ENDPROC
  560.