home *** CD-ROM | disk | FTP | other *** search
/ The Fred Fish Collection 1.5 / ffcollection-1-5-1992-11.iso / ff_disks / 200-299 / ff253.lzh / MultiSelect / MultiSelect.mod < prev    next >
Text File  |  1989-10-19  |  5KB  |  164 lines
  1. (*---------------------------------------------------------------------------
  2.   :Program.    MultiSelect.mod
  3.   :Author.     Fridtjof Siebert
  4.   :Address.    Nobileweg 67, D-7-Stgt-40
  5.   :Shortcut.   [fbs]
  6.   :Version.    1.0
  7.   :Date.       16-Mar-89
  8.   :Copyright.  PD
  9.   :Language.   Modula-II
  10.   :Translator. M2Amiga v3.1d
  11.   :Contents.   Enables file-multiselection without using keybord. Just
  12.   :Contents.   select the first file, then press RMB while you hold LMB
  13.   :Contents.   down. Then release LMB and select all files and double-
  14.   :Contents.   select the last one. Then releas RMB.
  15. ---------------------------------------------------------------------------*)
  16.  
  17. MODULE MultiSelect;
  18.  
  19. FROM SYSTEM      IMPORT ADR, LONGSET;
  20. FROM Arts        IMPORT Assert, TermProcedure, Terminate;
  21. FROM Exec        IMPORT FindPort, MsgPortPtr, Message, MessagePtr, GetMsg,
  22.                         ReplyMsg, PutMsg, WaitPort, IOStdReq, Interrupt,
  23.                         IOStdReqPtr, OpenDevice, CloseDevice, DoIO, IOFlagSet,
  24.                         NodeType, Forbid, Permit;
  25. FROM ExecSupport IMPORT CreatePort, DeletePort, CreateStdIO, DeleteStdIO;
  26. FROM Input       IMPORT inputName, addHandler, remHandler;
  27. FROM InputEvent  IMPORT InputEvent, InputEventPtr, Class, lButton, rButton,
  28.                         lShift;
  29.  
  30. (*------  Constants:  ------*)
  31.  
  32. CONST
  33.   PortName    = "MultiSelect[fbs].Port";
  34.   ReplyName   = "MultiSelect[fbs].ReplyPort";
  35.   oom         = "Not enough memory!";
  36.  
  37. (*------  VARS:  ------*)
  38.  
  39. VAR
  40.   MyMsg: Message;
  41.   QuitMessage: MessagePtr;
  42.   MyPort, OldPort: MsgPortPtr;
  43.   InputDevPort: MsgPortPtr;
  44.   InputRequestBlock: IOStdReqPtr;
  45.   HandlerStuff: Interrupt;
  46.   HandlerActive, InputOpen: BOOLEAN;
  47.   ev: InputEventPtr;
  48.   leftPressed: BOOLEAN;
  49.   shifted: BOOLEAN;
  50.  
  51. (*------  InputHandler:  ------*)
  52.  
  53. PROCEDURE MyHandler(Ev{8}: InputEventPtr): InputEventPtr; (* $S- *)
  54.  
  55. BEGIN
  56.   ev := Ev;
  57.   WHILE ev#NIL DO
  58.     WITH ev^ DO
  59.       IF class=rawmouse THEN
  60.         CASE code OF
  61.         lButton:                    (* left pressed  *)
  62.           leftPressed := TRUE |
  63.         lButton+128:                (* left released *)
  64.           leftPressed := FALSE |
  65.         rButton:                    (* right pressed *)
  66.           IF leftPressed THEN
  67.             shifted := TRUE;
  68.             class := rawkey;
  69.             code := 96;
  70.           END |
  71.         rButton+128:                (* right released *)
  72.           IF shifted THEN
  73.             shifted := FALSE;
  74.             class := rawkey;
  75.             code := 224;
  76.           END;
  77.         ELSE END;
  78.       END;
  79.       IF shifted THEN INCL(qualifier,lShift) END;
  80.       ev := nextEvent;
  81.     END;
  82.   END;
  83.   RETURN Ev;
  84. END MyHandler; (* $S+ *)
  85.  
  86. (*------  CleanUp:  ------*)
  87.  
  88. PROCEDURE CleanUp();
  89.  
  90. BEGIN
  91.  
  92. (*------  Remove Inputhandler:  ------*)
  93.  
  94.   IF HandlerActive THEN
  95.     WITH InputRequestBlock^ DO
  96.       command := remHandler;
  97.       data := ADR(HandlerStuff);
  98.     END;
  99.     DoIO(InputRequestBlock);
  100.   END;
  101.   IF InputRequestBlock#NIL THEN DeleteStdIO(InputRequestBlock) END;
  102.   IF InputDevPort#NIL THEN DeletePort(InputDevPort) END;
  103.  
  104. (*------  Remove Port:  ------*)
  105.  
  106.   IF MyPort#NIL THEN
  107.     Forbid();
  108.       IF QuitMessage=NIL THEN QuitMessage := GetMsg(MyPort) END;
  109.       WHILE QuitMessage#NIL DO
  110.         ReplyMsg(QuitMessage);
  111.         QuitMessage := GetMsg(MyPort);
  112.       END;
  113.       DeletePort(MyPort);
  114.     Permit();
  115.   END;
  116.  
  117. END CleanUp;
  118.  
  119. (*------  MAIN:  ------*)
  120.  
  121. BEGIN
  122.  
  123. (*------  Initialization:  ------*)
  124.  
  125.   MyPort := NIL; InputDevPort := NIL; InputRequestBlock := NIL;
  126.   HandlerActive := FALSE; InputOpen := FALSE; shifted := FALSE;
  127.   leftPressed := FALSE;
  128.  
  129.   TermProcedure(CleanUp);
  130.  
  131. (*------  Have we already been started?  ------*)
  132.  
  133.   OldPort := FindPort(ADR(PortName));
  134.   IF OldPort#NIL THEN
  135.     MyPort := CreatePort(ADR(ReplyName),0); Assert(MyPort#NIL,ADR(oom));
  136.     MyMsg.node.type := message;
  137.     MyMsg.replyPort := MyPort;
  138.     PutMsg(OldPort,ADR(MyMsg)); WaitPort(MyPort);
  139.     DeletePort(MyPort); MyPort := NIL; Terminate(0);
  140.   END;
  141.   MyPort := CreatePort(ADR(PortName),0); Assert(MyPort#NIL,ADR(oom));
  142.  
  143. (*------  Add Inputhandler:  ------*)
  144.  
  145.   InputDevPort := CreatePort(NIL,0);
  146.   Assert(InputDevPort#NIL,ADR(oom));
  147.   InputRequestBlock := CreateStdIO(InputDevPort);
  148.   Assert(InputRequestBlock#NIL,ADR(oom));
  149.   WITH HandlerStuff DO
  150.     data := NIL; code := ADR(MyHandler); node.pri := 51;
  151.   END;
  152.   OpenDevice(ADR(inputName),0,InputRequestBlock,LONGSET{});
  153.   IF InputRequestBlock^.error#0 THEN Terminate(0) ELSE InputOpen := TRUE END;
  154.   WITH InputRequestBlock^ DO
  155.     command := addHandler; data := ADR(HandlerStuff);
  156.   END;
  157.   DoIO(InputRequestBlock); HandlerActive := TRUE;
  158.  
  159. (*------  Wait:  ------*)
  160.  
  161.   REPEAT WaitPort(MyPort); QuitMessage := GetMsg(MyPort) UNTIL QuitMessage#NIL;
  162.  
  163. END MultiSelect.
  164.