imageFile/f/lib/5TH_DRVMOUSE

   1 var mousex\r
   2 var mousey\r
   3 var mousekeyl\r
   4 var mousekeyr\r
   5 var mousekeym\r
   6 var mousec      ( display coordinates flag )\r
   7 create mousebuf 100 alloc\r
   8 var mousebe     ( amount of buffer elements )\r
   9 var mousepointer\r
  10 D> \listF\I01_MCARROW fsDloadnew mousepointer !\r
  11 \r
  12 : mouseadd ( addr x1 x2 y1 y2 -- )\r
  13 mousebe @ dup 1+ mousebe !\r
  14 14 * mousebuf +          ( ... addr )\r
  15 swap over !\r
  16 4 + swap over !\r
  17 4 + swap over !\r
  18 4 + swap over !\r
  19 4 + ! ;\r
  20 \r
  21 : mousedo ( -- )\r
  22 mouse@\r
  23 dup 0 bit@ if mousekeyl on else mousekeyl off then\r
  24 dup 1 bit@ if mousekeyr on else mousekeyr off then\r
  25     2 bit@ if mousekeym on else mousekeym off then\r
  26 \r
  27 mousey @ + 0 swap 1DF bound mousey !\r
  28 mousex @ + 0 swap 27F bound mousex !\r
  29 \r
  30 mousepointer @ dynp\r
  31 screen dynp mousex @ mousey @ tvidput\r
  32 \r
  33 mousekeyl @ mousekeyr @ + mousekeym @ + if\r
  34 mousebe @ do\r
  35         i 14 * mousebuf +\r
  36         dup @ swap 4 + @ mousey @ rot bound? if\r
  37                 i 14 * mousebuf + 8 +\r
  38                 dup @ swap 4 + @ mousex @ rot bound? if\r
  39                         i 14 * mousebuf + 10 + @ goto pop drop 0 push\r
  40                 then\r
  41         then\r
  42 loop\r
  43 then\r
  44 \r
  45 mousec @ if\r
  46         emitscreen @\r
  47         screen emitscreen !\r
  48         at@\r
  49         0 0 at!\r
  50         mousex @ . tab. mousey @ .\r
  51         at!\r
  52         emitscreen !\r
  53 then ;\r