home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / ECO30603.ZIP / ECO30603.LZH / ECOLIBII / ECO_EMOU.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-06-08  |  38.0 KB  |  1,000 lines
  1. (*
  2.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  3.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  4.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  5.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  6.     ▓▓▓▓▓▓▓▓·──                                              ──·▓▓▓▓▓▓▓▓▓▓▓
  7.     ▓▓▓▓▓▓▓▓│                                                  │░░▓▓▓▓▓▓▓▓▓
  8.     ▓▓▓▓▓▓▓▓   Unit was conceived, designed and written         ░░▓▓▓▓▓▓▓▓▓
  9.     ▓▓▓▓▓▓▓▓   by Floor A.C. Naaijkens for                      ░░▓▓▓▓▓▓▓▓▓
  10.     ▓▓▓▓▓▓▓▓   UltiHouse Software / The ECO Group.              ░░▓▓▓▓▓▓▓▓▓
  11.     ▓▓▓▓▓▓▓▓                                                    ░░▓▓▓▓▓▓▓▓▓
  12.     ▓▓▓▓▓▓▓▓   (C) MCMXCII by EUROCON PANATIONAL CORPORATION.   ░░▓▓▓▓▓▓▓▓▓
  13.     ▓▓▓▓▓▓▓▓   All Rights Reserved for The ECO Group.           ░░▓▓▓▓▓▓▓▓▓
  14.     ▓▓▓▓▓▓▓▓                                                    ░░▓▓▓▓▓▓▓▓▓
  15.     ▓▓▓▓▓▓▓▓│                                                  │░░▓▓▓▓▓▓▓▓▓
  16.     ▓▓▓▓▓▓▓▓·──                                              ──·░░▓▓▓▓▓▓▓▓▓
  17.     ▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓
  18.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  19.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  20.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  21. *)
  22. {$R-,S-,O+}
  23. unit eco_emou;
  24.  
  25. {***************************************************************************}
  26. {*              mouse - turbo pascal mouse unit version 2.2                *}
  27. {*                      by floor naaijkens 14/2/90                         *}
  28. {*                                                                         *}
  29. {*        this program assumes that you have a ms (or compatible)          *}
  30. {*                 mouse driver installed on the computer.                 *}
  31. {*                                                                         *}
  32. {***************************************************************************}
  33.  
  34. interface
  35.  
  36. uses dos;
  37.  
  38.  
  39. {---------------------------------------------------------------------------}
  40. {externally accessable constants}
  41.  
  42. const
  43.  
  44.   leftbutton   = 1;                                    {what the buttons are}
  45.   rightbutton  = 2;
  46.   centerbutton = 4;
  47.  
  48.   standard     = 1;                              {graphic cursor definitions}
  49.   uparrow      = 2;
  50.   downarrow    = 3;
  51.   leftarrow    = 4;
  52.   rightarrow   = 5;
  53.   checkmark    = 6;
  54.   uphand       = 7;
  55.   downhand     = 8;
  56.   lefthand     = 9;
  57.   righthand    = 10;
  58.   stophand     = 11;
  59.   hourglass    = 12;
  60.   diagcross    = 13;
  61.   rectcross    = 14;
  62.   rectbox      = 15;
  63.   targetcross  = 16;
  64.   targetcircle = 17;
  65.   targetbox    = 18;
  66.   questionmark = 19;
  67.  
  68.   maxmousecursorshape = 19;
  69.  
  70. {---------------------------------------------------------------------------}
  71. {externally accessable variables}
  72.  
  73. var
  74.  
  75.   mouse_installed    : boolean;   {initmouse - true if mouse is operable}
  76.   mouse_error        : integer;   {initmouse - error code}
  77.   mouse_type         : integer;   {initmouse - mouse type}
  78.  
  79.   mouse_clicked      : boolean;   {readmouse - true if button was clicked}
  80.   mouse_buttons      : word;      {readmouse - current mouse button status}
  81.   mouse_click_button : word;      {readmouse - click button status}
  82.   mousex             : word;      {readmouse - mouse text x position}
  83.   mousey             : word;      {readmouse - mouse text y position}
  84.   click_mousex       : word;      {readmouse - text x click position}
  85.   click_mousey       : word;      {readmouse - text y click position}
  86.   real_mousex        : word;      {readmouse - real mouse x position}
  87.   real_mousey        : word;      {readmouse - real mouse y position}
  88.  
  89.   mousetextwidth     : word;      {size of text on screen for mouse}
  90.   mousetextheight    : word;
  91.  
  92. {---------------------------------------------------------------------------}
  93. type
  94.      masktype = record                      {mouse graphic cursor definition}
  95.                   def: array [0..1, 0..15] of word;     {graphics cursor def}
  96.                   hotx, hoty: integer;                       { hot spot x,y }
  97.                 end;
  98.  
  99. {---------------------------------------------------------------------------}
  100. {note: you must set the mousetextwidth and mousetextheight values}
  101. {to the current character pixel width and height to properly use the}
  102. {mouse text x,y coordinate system. startup default is 8x8.}
  103. {to start up the mouse you should do the following: }
  104. {initmouse; readmouse; showmouse; - this insures that the mouse is}
  105. {properly setup and ready to run. }
  106.  
  107. {for more information on the mouse interface and programming with }
  108. {with a mouse refer to the microsoft mouse programmer's Reference Guide}
  109. {available from microsoft corporation.}
  110.  
  111. {warning: all mouse drivers are not created equal. i've experienced some}
  112. {problems with non-ms mouse drivers (such as logitec which had trouble}
  113. {with the mouseareahide function) so be careful with the mice you use.}
  114.  
  115. {---------------------------------------------------------------------------}
  116. { function 0 - initialize mouse software and hardware }
  117. procedure initmouse;
  118.  
  119. {---------------------------------------------------------------------------}
  120. { function 1 - show mouse cursor }
  121. procedure showmouse;
  122.  
  123. {---------------------------------------------------------------------------}
  124. { function 2 - hide mouse cursor }
  125. procedure hidemouse;
  126.  
  127. {---------------------------------------------------------------------------}
  128. { function 3 - read mouse position and button status }
  129. procedure readmouse;
  130.  
  131. {---------------------------------------------------------------------------}
  132. { function 4 - sets mouse position }
  133. { x and y values are scaled for text }
  134. procedure setmouseposition(x, y : word);
  135.  
  136. {---------------------------------------------------------------------------}
  137. { function 4 - sets mouse position }
  138. { x and y values are scaled for graphics }
  139. procedure setmousepoint(x, y : word);
  140.  
  141. {---------------------------------------------------------------------------}
  142. { function 5 - gets button press information  }
  143. { x and y values are scaled for text }
  144. function mousepress(button: word;
  145.                      var count, lastx, lasty: word): word;
  146.  
  147. {---------------------------------------------------------------------------}
  148. { function 6 - gets button release information  }
  149. { x and y values are scaled for text }
  150. function mouserelease(button: word;
  151.                        var count, lastx, lasty: word): word;
  152.  
  153. {---------------------------------------------------------------------------}
  154. { functions 7 and 8 - sets area where the mouse is allowed to run }
  155. { x and y values are scaled for text }
  156. procedure setmousearea(x1,y1,x2,y2: word);
  157.  
  158. {---------------------------------------------------------------------------}
  159. { functions 7 and 8 - sets area where the mouse is allowed to run }
  160. { x and y values are scaled for graphics }
  161. procedure setmouseboxarea(var r);
  162.  
  163. {---------------------------------------------------------------------------}
  164. { function 9 - sets the graphics cursor shape }
  165. procedure mousegraphiccursor(shape: integer);
  166.  
  167. {---------------------------------------------------------------------------}
  168. { function 9 - sets a custom graphics cursor shape }
  169. procedure setmousegraphiccursor(var mask:masktype);
  170.  
  171. {---------------------------------------------------------------------------}
  172. { function 10 - sets the text cursor shape }
  173. procedure mousetextcursor(select, start, stop: word);
  174.  
  175. {---------------------------------------------------------------------------}
  176. { function 11 - read mouse motion counters }
  177. procedure readmickey(var x, y: word);
  178.  
  179. {---------------------------------------------------------------------------}
  180. { function 12 - set mouse interrupt service routine and mask }
  181. procedure setmouseisr(mask:word; var address);
  182.  
  183. {---------------------------------------------------------------------------}
  184. { function 13 and 14 - light pen emulation on/off }
  185. procedure lightpen(flag: boolean);
  186.  
  187. {---------------------------------------------------------------------------}
  188. { function 15 - sets the mickey to pixel ratio }
  189. procedure setpixeltomickey(x, y: word);
  190.  
  191. {---------------------------------------------------------------------------}
  192. { function 16 - conditional mouse hide - hides mouse if in text area }
  193. procedure hidemousearea(x1,y1,x2,y2: word);
  194.  
  195. {---------------------------------------------------------------------------}
  196. { function 16 - conditional mouse hide - hides mouse if in graphics area }
  197. procedure hidemouseboxarea(var r);
  198.  
  199. {---------------------------------------------------------------------------}
  200. { function 19 - set double speed threshold }
  201. procedure mousethreshold(threshold:word);
  202.  
  203. {---------------------------------------------------------------------------}
  204. { function 20 - swap current mouse isr with a new one}
  205. { returns old isr and mask in the calling variables }
  206. procedure swapmouseisr(var mask:word; var address);
  207.  
  208. {---------------------------------------------------------------------------}
  209. { function 29 - set mouse page }
  210. procedure setmousepage(page: word);
  211.  
  212. {---------------------------------------------------------------------------}
  213. { function 30 - get mouse page }
  214. function getmousepage: word;
  215.  
  216.  
  217. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  218. { the following procedures use the mouse functions to provide }
  219. { a higher level of control over the mouse }
  220.  
  221. {---------------------------------------------------------------------------}
  222. { checks if mouse is currently inside specified text area }
  223. function mousein(x1,y1,x2,y2: word):boolean;
  224.  
  225. {---------------------------------------------------------------------------}
  226. { checks if mouse is currently inside specified graphic area }
  227. function mouseinbox(var r): boolean;
  228.  
  229. {---------------------------------------------------------------------------}
  230. {has the mouse been clicked recently?}
  231. function mouseclick: boolean;
  232.  
  233. {---------------------------------------------------------------------------}
  234. { checks if mouse was inside specified text area when clicked }
  235. function mouseclickin(x1,y1,x2,y2: word): boolean;
  236.  
  237. {---------------------------------------------------------------------------}
  238. { checks if mouse was inside specified graphic area when clicked }
  239. function mouseclickinbox(var r): boolean;
  240.  
  241. {---------------------------------------------------------------------------}
  242. {pushes current mouse status on the mouse stack}
  243. {returns false if not enough heap space to push}
  244. function pushmouse: boolean;
  245.  
  246. {---------------------------------------------------------------------------}
  247. {pops mouse status from the mouse stack.}
  248. function popmouse: boolean;
  249.  
  250. {---------------------------------------------------------------------------}
  251. {get rid of mouse stack}
  252. procedure zapmousestack;
  253.  
  254. {***************************************************************************}
  255.  
  256. implementation
  257.  
  258. {---------------------------------------------------------------------------}
  259. { local mouse stuff }
  260.  
  261. type
  262.      mrect = record
  263.                x1,y1,x2,y2 : word;                {defines a mouse rectangle}
  264.              end;
  265.  
  266.      mouseptrp   = ^mouseptrrec;               {defines a mouse stack record}
  267.      mouseptrrec = record      {prev points to previous stack record on heap}
  268.         prev : mouseptrp;                {if nil then is top record on stack}
  269.         buf  : pointer;                  {buf points to the mouse data saved}
  270.         size : integer;                    {size = bytes in the mouse buffer}
  271.      end;
  272.                                                 {array of predefined cursors}
  273.      mgcarray = array [1..maxmousecursorshape] of masktype;
  274.  
  275. {---------------------------------------------------------------------------}
  276. var
  277.      mouse_reg  : registers;         {registers used to call mouse interrupt}
  278.      mousestack : mouseptrp;   {mousestack points to last rec on mouse stack}
  279.                                   {if nil then there is nothing on the stack}
  280.  
  281. {---------------------------------------------------------------------------}
  282. const
  283.  
  284.   mousecursor: mgcarray =        {a predefined list of mouse graphic cursors}
  285.  
  286. { standard }
  287.  ((def: (($3fff,$1fff,$0fff,$07ff,$03ff,$01ff,$00ff,$007f,    { screen mask }
  288.           $003f,$001f,$01ff,$10ff,$30ff,$f87f,$f87f,$fc7f),
  289.  
  290.          ($0000,$4000,$6000,$7000,$7800,$7c00,$7e00,$7f00,    { cursor mask }
  291.           $7f80,$7c00,$6c00,$4600,$0600,$0300,$0300,$0000));
  292.  
  293.          hotx: -1; hoty: -1),                                    { hot spot }
  294.  
  295. { uparrow }
  296.   (def: (($f9ff,$f0ff,$e07f,$e07f,$c03f,$c03f,$801f,$801f,
  297.           $000f,$000f,$f0ff,$f0ff,$f0ff,$f0ff,$f0ff,$f0ff),
  298.  
  299.          ($0000,$0600,$0f00,$0f00,$1f80,$1f80,$3fc0,$3fc0,
  300.           $7fe0,$0600,$0600,$0600,$0600,$0600,$0600,$0000));
  301.  
  302.          hotx: 5; hoty: 0),
  303.  
  304. { downarrow }
  305.   (def: (($f0ff,$f0ff,$f0ff,$f0ff,$f0ff,$f0ff,$000f,$000f,
  306.           $801f,$801f,$c03f,$c03f,$e07f,$e07f,$f0ff,$f9ff),
  307.  
  308.          ($0000,$0600,$0600,$0600,$0600,$0600,$0600,$7fe0,
  309.           $3fc0,$3fc0,$1f80,$1f80,$0f00,$0f00,$0600,$0000));
  310.  
  311.          hotx: 5; hoty: 15),
  312.  
  313. { leftarrow }
  314.   (def: (($fe1f,$f01f,$0000,$0000,$0000,$f01f,$fe1f,$ffff,
  315.           $ffff,$ffff,$ffff,$ffff,$ffff,$ffff,$ffff,$ffff),
  316.  
  317.          ($0000,$00c0,$07c0,$7ffe,$07c0,$00c0,$0000,$0000,
  318.           $0000,$0000,$0000,$0000,$0000,$0000,$0000,$0000));
  319.  
  320.          hotx: 0; hoty: 3),
  321.  
  322. { rightarrow }
  323.   (def: (($f87f,$f80f,$0000,$0000,$0000,$f80f,$f87f,$ffff,
  324.           $ffff,$ffff,$ffff,$ffff,$ffff,$ffff,$ffff,$ffff),
  325.  
  326.          ($0000,$0300,$03e0,$7ffe,$03e0,$0300,$0000,$0000,
  327.           $0000,$0000,$0000,$0000,$0000,$0000,$0000,$0000));
  328.  
  329.          hotx: 15; hoty: 3),
  330.  
  331. { checkmark }
  332.   (def: (($fff0,$ffe0,$ffc0,$ff03,$0607,$000f,$001f,$c03f,
  333.           $f07f,$ffff,$ffff,$ffff,$ffff,$ffff,$ffff,$ffff),
  334.  
  335.          ($0000,$0006,$000c,$0018,$0030,$0060,$70c0,$1d80,
  336.           $0700,$0000,$0000,$0000,$0000,$0000,$0000,$0000));
  337.  
  338.          hotx: 6; hoty: 7),
  339.  
  340. { uphand }
  341.   (def: (($e1ff,$e1ff,$e1ff,$e1ff,$e000,$e000,$e000,$0000,    { screen mask }
  342.           $0000,$0000,$0000,$0000,$0000,$0000,$0000,$0000),
  343.  
  344.          ($1e00,$1200,$1200,$1200,$13ff,$1249,$1249,$f249,    { cursor mask }
  345.           $9001,$9001,$9001,$8001,$8001,$8001,$8001,$ffff));
  346.  
  347.          hotx: 5; hoty: 0),                                      { hot spot }
  348.  
  349. { downhand }
  350.   (def: (($0000,$0000,$0000,$0000,$0000,$0000,$0000,$0000,
  351.           $0000,$e000,$e000,$e000,$e1ff,$e1ff,$e1ff,$e1ff),
  352.  
  353.          ($ffff,$8001,$8001,$8001,$8001,$9001,$9001,$9001,
  354.           $f249,$1249,$1249,$13ff,$1200,$1200,$1200,$1e00));
  355.  
  356.          hotx: 5; hoty: 15),
  357.  
  358. { lefthand }
  359.   (def: (($ffff,$ff8f,$ff07,$ff03,$ff81,$8000,$0000,$0000,
  360.           $0000,$8000,$f000,$f800,$f800,$fc00,$fc01,$fc03),
  361.  
  362.          ($0000,$0000,$0070,$0048,$0024,$0032,$7ff2,$800a,
  363.           $7ff6,$0412,$07f2,$0212,$03f2,$0116,$01fc,$0000));
  364.  
  365.          hotx: 0; hoty: 7),
  366.  
  367. { righthand }
  368.   (def: (($ffff,$f1ff,$e0ff,$c0ff,$81ff,$0001,$0000,$0000,
  369.           $0000,$0001,$000f,$001f,$001f,$003f,$803f,$c03f),
  370.  
  371.          ($0000,$0000,$0e00,$1200,$2400,$4c00,$4ffe,$5001,
  372.           $6ffe,$4820,$4fe0,$4840,$4fc0,$6880,$3f80,$0000));
  373.  
  374.          hotx: 15; hoty: 7),
  375.  
  376. { stophand }
  377.   (def: (($fe3f,$f80f,$f007,$f003,$f001,$f001,$0001,$0001,
  378.           $0001,$0001,$8001,$c001,$c001,$e003,$f007,$f80f),
  379.  
  380.          ($0000,$01c0,$0770,$0550,$055c,$0554,$0554,$7554,
  381.           $5554,$4ffc,$2804,$1004,$180c,$0c18,$07f0,$0000));
  382.  
  383.          hotx: 7; hoty: 7),
  384.  
  385. { hourglass }
  386.   (def: (($0000,$0000,$0000,$0000,$8001,$c003,$e007,$f00f,
  387.           $e007,$c003,$8001,$0000,$0000,$0000,$0000,$ffff),
  388.  
  389.          ($0000,$7ffe,$6006,$300c,$1818,$0c30,$0660,$03c0,
  390.           $0660,$0c30,$1998,$33cc,$67e6,$7ffe,$0000,$0000));
  391.  
  392.          hotx: 7; hoty: 7),
  393.  
  394. { diagcross }
  395.   (def: (($07e0,$0180,$0000,$c003,$f00f,$c003,$0000,$0180,
  396.           $07e0,$ffff,$ffff,$ffff,$ffff,$ffff,$ffff,$ffff),
  397.  
  398.          ($0000,$700e,$1c38,$0660,$03c0,$0660,$1c38,$700e,
  399.           $0000,$0000,$0000,$0000,$0000,$0000,$0000,$0000));
  400.  
  401.          hotx: 7; hoty: 4),
  402.  
  403. { rectcross }
  404.   (def: (($fc3f,$fc3f,$fc3f,$0000,$0000,$0000,$fc3f,$fc3f,
  405.           $fc3f,$ffff,$ffff,$ffff,$ffff,$ffff,$ffff,$ffff),
  406.  
  407.          ($0000,$0180,$0180,$0180,$7ffe,$0180,$0180,$0180,
  408.           $0000,$0000,$0000,$0000,$0000,$0000,$0000,$0000));
  409.  
  410.          hotx: 7; hoty: 4),
  411.  
  412.  
  413.   { these cursors need to be updated yet }
  414. { rectbox }
  415.   (def: (($ffff,$ffff,$0000,$0000,$0000,$1ff8,$1ff8,$1ff8,
  416.           $1ff8,$1ff8,$1ff8,$1ff8,$0000,$0000,$0000,$ffff),
  417.  
  418.          ($0000,$0000,$0000,$7ffe,$4002,$4002,$4002,$4002,
  419.           $4002,$4002,$4002,$4002,$4002,$7ffe,$0000,$0000));
  420.  
  421.          hotx: 7; hoty: 8),
  422.  
  423. { targetcross }
  424.   (def: (($ffff,$ffff,$fc7f,$fc7f,$fc7f,$fc7f,$fc7f,$06c1,
  425.           $0101,$06c1,$fc7f,$fc7f,$fc7f,$fc7f,$fc7f,$ffff),
  426.  
  427.          ($0000,$0000,$0000,$0100,$0100,$0100,$0100,$0000,
  428.           $783c,$0000,$0100,$0100,$0100,$0100,$0000,$0000));
  429.  
  430.          hotx: 7; hoty: 4),
  431.  
  432. { targetcircle }
  433.   (def: (($ffff,$ffff,$f01f,$c007,$8003,$0001,$0c61,$06c1,
  434.           $0101,$06c1,$0c61,$0001,$8003,$c007,$f01f,$ffff),
  435.  
  436.          ($0000,$0000,$0000,$07c0,$1d30,$3118,$610c,$600c,
  437.           $783c,$600c,$610c,$3118,$1d30,$07c0,$0000,$0000));
  438.  
  439.          hotx: 7; hoty: 8),
  440.  
  441. { targetbox }
  442.   (def: (($ffff,$ffff,$0001,$0001,$0001,$1c71,$1c71,$06c1,
  443.           $0101,$06c1,$1c71,$1c71,$0001,$0001,$0001,$ffff),
  444.  
  445.          ($0000,$0000,$0000,$7ffc,$4104,$4104,$4104,$4004,
  446.           $783c,$4004,$4104,$4104,$4104,$7ffc,$0000,$0000));
  447.  
  448.          hotx: 7; hoty: 8),
  449.  
  450. { questionmark }
  451.   (def: (($ffff,$e00f,$c007,$8003,$0001,$0001,$0001,$0001,
  452.           $0001,$0001,$0001,$0001,$0001,$8003,$c007,$e00f),
  453.  
  454.          ($0000,$0000,$1ff0,$3ff8,$783c,$739c,$739c,$7f3c,
  455.           $7e7c,$7e7c,$7ffc,$7e7c,$7e7c,$3ff8,$1ff0,$0000));
  456.  
  457.          hotx: 7; hoty: 7));
  458.  
  459.  
  460. {---------------------------------------------------------------------------}
  461. { an inline function to limit an integer between min and max values}
  462. function intlimit(val,min,max: integer): integer;
  463. inline(
  464.    $58        {  pop ax}
  465.   /$5b        {  pop bx}
  466.   /$59        {  pop cx}
  467.   /$39/$c8    {  cmp ax,cx}
  468.   /$7c/$08    {  jl done}
  469.   /$89/$d8    {  mov ax,bx}
  470.   /$39/$c8    {  cmp ax,cx}
  471.   /$7f/$02    {  jg done}
  472.   /$89/$c8);  {  mov ax,cx}
  473.               {done:}
  474.  
  475. {***************************************************************************}
  476. { function 0 - initialize mouse software and hardware }
  477.  
  478. procedure initmouse;
  479. begin
  480.   mouse_reg.ax := 0;              {tell the mouse to start over from scratch}
  481.   intr($33,mouse_reg);
  482.   mouse_error := mouse_reg.ax;
  483.   mouse_type := mouse_reg.bx;
  484.   mouse_installed := mouse_error = -1;      {<-- check if mouse is out there}
  485. end;
  486.  
  487. {---------------------------------------------------------------------------}
  488. { function 1 - show mouse cursor }
  489.  
  490. procedure showmouse;
  491. begin
  492.   if not(mouse_installed) then exit;            {<-- can't do this, no mouse}
  493.   mouse_reg.ax := 1;
  494.   intr($33,mouse_reg);
  495. end;
  496.  
  497. {---------------------------------------------------------------------------}
  498. { function 2 - hide mouse cursor }
  499.  
  500. procedure hidemouse;
  501. begin
  502.   if not(mouse_installed) then exit;            {<-- can't do this, no mouse}
  503.   mouse_reg.ax := 2;
  504.   intr($33,mouse_reg);
  505. end;
  506.  
  507. {---------------------------------------------------------------------------}
  508. { function 3 - read current mouse position and button status }
  509. { x and y values are scaled for text }
  510.  
  511. procedure readmouse;
  512. begin
  513.   if not(mouse_installed) then exit;            {<-- can't do this, no mouse}
  514.   mouse_reg.ax := 3;
  515.   intr($33,mouse_reg);                         {get the current mouse status}
  516.   with mouse_reg do
  517.   begin
  518.     real_mousex := cx;                       {save real mouse x and y values}
  519.     real_mousey := dx;
  520.     mousex := (cx div mousetextwidth);         {save the x and y coordinates}
  521.     mousey := (dx div mousetextheight);
  522.     if (bx <> mouse_buttons) and (bx <> 0) then        {<-- new button down?}
  523.     begin
  524.       mouse_click_button := bx;               {if button down save which one}
  525.       click_mousex := mousex;                           {and the current x,y}
  526.       click_mousey := mousey;
  527.       mouse_clicked := true;                       {tell them it was clicked}
  528.     end;
  529.     mouse_buttons := bx;                 {<-- save the current button status}
  530.   end;
  531. end;
  532.  
  533. {---------------------------------------------------------------------------}
  534. { function 4 - sets mouse position }
  535. { x and y values are scaled for text }
  536.  
  537. procedure setmouseposition(x,y: word);
  538. begin
  539.   if not(mouse_installed) then exit;            {<-- can't do this, no mouse}
  540.   mouse_reg.ax := 4;
  541.   mouse_reg.cx := (x*mousetextwidth);                {tell mouse where to go}
  542.   mouse_reg.dx := (y*mousetextheight);
  543.   intr($33,mouse_reg);
  544.   mousex := x;                                            {update local vars}
  545.   mousey := y;
  546. end;
  547.  
  548. {---------------------------------------------------------------------------}
  549. { function 4 - sets mouse position }
  550. { x and y values are scaled for graphics}
  551.  
  552. procedure setmousepoint(x,y: word);
  553. begin
  554.   if not(mouse_installed) then exit;            {<-- can't do this, no mouse}
  555.   mouse_reg.ax := 4;
  556.   mouse_reg.cx := x;                                 {tell mouse where to go}
  557.   mouse_reg.dx := y;
  558.   intr($33,mouse_reg);
  559.   mousex := x div mousetextwidth;                         {update local vars}
  560.   mousey := y div mousetextheight;
  561. end;
  562.  
  563. {---------------------------------------------------------------------------}
  564. { function 5 - gets button press information  }
  565. { x and y values are scaled for text }
  566.  
  567. function mousepress(button: word;
  568.                     var count, lastx, lasty: word): word;
  569. begin
  570.   if mouse_installed then                          {check if mouse installed}
  571.   begin
  572.     mouse_reg.ax := 5;
  573.     mouse_reg.bx := button;                      {request info on the button}
  574.     intr($33,mouse_reg);
  575.     mousepress := mouse_reg.ax;
  576.     count := mouse_reg.bx;                   {return the info for the button}
  577.     lastx := (mouse_reg.cx div mousetextwidth);
  578.     lasty := (mouse_reg.dx div mousetextheight);
  579.   end
  580.   else
  581.   begin
  582.     mousepress := 0;              {if no mouse everything comes back as zero}
  583.     lastx := 0;
  584.     lasty := 0;
  585.     count := 0;
  586.   end;
  587. end;
  588.  
  589. {---------------------------------------------------------------------------}
  590. { function 6 - gets button release information  }
  591. { x and y values are scaled for text }
  592.  
  593. function mouserelease(button: word;
  594.                        var count, lastx, lasty: word): word;
  595. begin
  596.   if mouse_installed then                          {check if mouse installed}
  597.   begin
  598.     mouse_reg.ax := 6;
  599.     mouse_reg.bx := button;                      {request info on the button}
  600.     intr($33,mouse_reg);
  601.     mouserelease := mouse_reg.ax;
  602.     count := mouse_reg.bx;                   {return the info for the button}
  603.     lastx := (mouse_reg.cx div mousetextwidth);
  604.     lasty := (mouse_reg.dx div mousetextheight);
  605.   end
  606.   else
  607.   begin
  608.     mouserelease := 0;            {if no mouse everything comes back as zero}
  609.     lastx := 0;
  610.     lasty := 0;
  611.     count := 0;
  612.   end;
  613. end;
  614.  
  615. {---------------------------------------------------------------------------}
  616. { functions 7 and 8 - sets area where the mouse is allowed to run }
  617. { x and y values are scaled for text }
  618.  
  619. procedure setmousearea(x1,y1,x2,y2: word);
  620. begin
  621.   if not(mouse_installed) then exit;            {<-- can't do this, no mouse}
  622.   mouse_reg.ax := 7;
  623.   mouse_reg.cx := (x1*mousetextwidth);                       {set the x values}
  624.   mouse_reg.dx := (x2*mousetextwidth);
  625.   intr($33,mouse_reg);
  626.   mouse_reg.ax := 8;
  627.   mouse_reg.cx := (y1*mousetextheight);                      {set the y values}
  628.   mouse_reg.dx := (y2*mousetextheight);
  629.   intr($33,mouse_reg);
  630. end;
  631.  
  632. {---------------------------------------------------------------------------}
  633. { functions 7 and 8 - sets area where the mouse is allowed to run }
  634. { x and y values are scaled for graphics }
  635.  
  636. procedure setmouseboxarea(var r);
  637. begin
  638.   if not(mouse_installed) then exit;            {<-- can't do this, no mouse}
  639.   mouse_reg.ax := 7;
  640.   mouse_reg.cx := mrect(r).x1;                             {set the x values}
  641.   mouse_reg.dx := mrect(r).x2;
  642.   intr($33,mouse_reg);
  643.   mouse_reg.ax := 8;
  644.   mouse_reg.cx := mrect(r).y1;                             {set the y values}
  645.   mouse_reg.dx := mrect(r).y2;
  646.   intr($33,mouse_reg);
  647. end;
  648.  
  649. {---------------------------------------------------------------------------}
  650. { function 9 - sets a custom graphics cursor shape }
  651.  
  652. procedure setmousegraphiccursor(var mask:masktype);
  653. begin
  654.    if not(mouse_installed) then exit;           {<-- can't do this, no mouse}
  655.    mouse_reg.ax := 9;
  656.    mouse_reg.bx := mask.hotx;                            { set the hot spot }
  657.    mouse_reg.cx := mask.hoty;
  658.    mouse_reg.es := seg(mask.def);
  659.    mouse_reg.dx := ofs(mask.def);                { set the new cursor shape }
  660.    intr($33, mouse_reg);
  661. end;
  662.  
  663. {---------------------------------------------------------------------------}
  664. { function 9 - sets the graphics cursor shape }
  665. { graphic cursor routine borrowed from egamouse }
  666.  
  667. procedure mousegraphiccursor(shape:integer);
  668. begin
  669.    if not(mouse_installed) then exit;           {<-- can't do this, no mouse}
  670.    with mousecursor[intlimit(shape,1,maxmousecursorshape)] do
  671.    begin
  672.      mouse_reg.ax := 9;
  673.      mouse_reg.bx := hotx;                               { set the hot spot }
  674.      mouse_reg.cx := hoty;
  675.      mouse_reg.es := seg(def);
  676.      mouse_reg.dx := ofs(def);                   { set the new cursor shape }
  677.      intr($33, mouse_reg);
  678.    end;
  679. end;
  680.  
  681. {---------------------------------------------------------------------------}
  682. { function 10 - sets the text cursor shape }
  683.  
  684. procedure mousetextcursor(select, start, stop: word);
  685. begin
  686.    if not(mouse_installed) then exit;           {<-- can't do this, no mouse}
  687.    mouse_reg.ax := 10;
  688.    mouse_reg.bx := select;                           {select the cursor type}
  689.    mouse_reg.cx := start;                         {and the start/stop values}
  690.    mouse_reg.dx := stop;                           {(or screen/cursor masks)}
  691.    intr($33, mouse_reg);
  692. end;
  693.  
  694. {---------------------------------------------------------------------------}
  695. { function 11 - read mouse motion counters }
  696.  
  697. procedure readmickey(var x, y: word);
  698. begin
  699.   if mouse_installed then                          {check if mouse installed}
  700.   begin
  701.     mouse_reg.ax := 11;
  702.     intr($33, mouse_reg);
  703.     x := mouse_reg.cx;                                 {return mickey values}
  704.     y := mouse_reg.dx;
  705.   end
  706.   else
  707.   begin
  708.     x := 0;                                  {if no mouse return zero values}
  709.     y := 0;
  710.   end;
  711. end;
  712.  
  713. {---------------------------------------------------------------------------}
  714. { function 12 - set mouse interrupt service routine and mask }
  715.  
  716. procedure setmouseisr(mask:word; var address);
  717. type arec = record lo, hi: word; end;
  718. var a : arec absolute address;
  719. begin
  720.   if not(mouse_installed) then exit;            {<-- can't do this, no mouse}
  721.   mouse_reg.cx := mask;                        {<-- set the isr service mask}
  722.   mouse_reg.es := a.hi;
  723.   mouse_reg.dx := a.lo;                         {set the isr service address}
  724.   mouse_reg.ax := 12;
  725.   intr($33, mouse_reg);
  726. end;
  727.  
  728. {---------------------------------------------------------------------------}
  729. { function 13 and 14 - light pen emulation on/off }
  730.  
  731. procedure lightpen(flag:boolean);
  732. begin
  733.   if not(mouse_installed) then exit;            {<-- can't do this, no mouse}
  734.   if flag then
  735.     mouse_reg.ax := 13                           {set light pen emulation on}
  736.   else
  737.     mouse_reg.ax := 14;                         {set light pen emulation off}
  738.   intr($33,mouse_reg)
  739. end;
  740.  
  741.  
  742. {---------------------------------------------------------------------------}
  743. { function 15 - sets the mickey to pixel ratio }
  744.  
  745. procedure setpixeltomickey(x, y: word);
  746. begin
  747.   if not(mouse_installed) then exit;            {<-- can't do this, no mouse}
  748.   mouse_reg.ax := 15;
  749.   mouse_reg.cx := x;                              {set the new mickey values}
  750.   mouse_reg.dx := y;
  751.   intr($33,mouse_reg)
  752. end;
  753.  
  754.  
  755. {---------------------------------------------------------------------------}
  756. { function 16 - conditional mouse hide - hides mouse if in text area }
  757. { use showmouse after using this function - just like regular hidemouse }
  758.  
  759. procedure hidemousearea(x1,y1,x2,y2: word);
  760. begin
  761.   if not(mouse_installed) then exit;            {<-- can't do this, no mouse}
  762.   mouse_reg.ax := 16;
  763.   mouse_reg.cx := (x1*mousetextwidth);                 {set the x and y values}
  764.   mouse_reg.dx := (x2*mousetextwidth);
  765.   mouse_reg.si := (y1*mousetextheight);
  766.   mouse_reg.di := (y2*mousetextheight);
  767.   intr($33,mouse_reg);
  768. end;
  769.  
  770. {---------------------------------------------------------------------------}
  771. { function 16 - conditional mouse hide - hides mouse if in graphics area }
  772. { use showmouse after using this function - just like regular hidemouse }
  773.  
  774. procedure hidemouseboxarea(var r);
  775. begin
  776.   if not(mouse_installed) then exit;            {<-- can't do this, no mouse}
  777.   mouse_reg.ax := 16;
  778.   mouse_reg.cx := mrect(r).x1;                       {set the x and y values}
  779.   mouse_reg.dx := mrect(r).x2;
  780.   mouse_reg.si := mrect(r).y1;
  781.   mouse_reg.di := mrect(r).y2;
  782.   intr($33,mouse_reg);
  783. end;
  784.  
  785. {---------------------------------------------------------------------------}
  786. { function 19 - set double speed threshold }
  787.  
  788. procedure mousethreshold(threshold:word);
  789. begin
  790.   if not(mouse_installed) then exit;            {<-- can't do this, no mouse}
  791.   mouse_reg.ax := 19;
  792.   mouse_reg.dx := threshold;                    {set the new threshold value}
  793.   intr($33,mouse_reg)
  794. end;
  795.  
  796.  
  797. {---------------------------------------------------------------------------}
  798. { function 20 - swap current mouse isr with a new one}
  799. { returns old isr and mask in the calling variables }
  800.  
  801. procedure swapmouseisr(var mask:word; var address);
  802. type arec = record lo, hi: word; end;
  803. var a : arec absolute address;
  804. begin
  805.   if not(mouse_installed) then exit;            {<-- can't do this, no mouse}
  806.   mouse_reg.cx := mask;                        {<-- set new isr service mask}
  807.   mouse_reg.es := a.hi;
  808.   mouse_reg.dx := a.lo;                         {set new isr service address}
  809.   mouse_reg.ax := 20;
  810.   intr($33,mouse_reg);
  811.   mask := mouse_reg.cx;                        {<-- get old isr service mask}
  812.   a.hi := mouse_reg.es;
  813.   a.lo := mouse_reg.dx;                         {get old isr service address}
  814. end;
  815.  
  816. {---------------------------------------------------------------------------}
  817. { function 29 - set mouse page }
  818.  
  819. procedure setmousepage(page:word);
  820. begin
  821.   if not(mouse_installed) then exit;            {<-- can't do this, no mouse}
  822.   mouse_reg.ax := 29;
  823.   mouse_reg.bx := page;                         {set the new threshold value}
  824.   intr($33,mouse_reg)
  825. end;
  826.  
  827. {---------------------------------------------------------------------------}
  828. { function 30 - get mouse page }
  829.  
  830. function getmousepage:word;
  831. begin
  832.   if not(mouse_installed) then exit;            {<-- can't do this, no mouse}
  833.   mouse_reg.ax := 29;
  834.   intr($33,mouse_reg);
  835.   getmousepage := mouse_reg.bx;                 {get the new threshold value}
  836. end;
  837.  
  838.  
  839. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  840. { the following procedures use the mouse functions to provide }
  841. { a higher level of control over the mouse }
  842.  
  843. {---------------------------------------------------------------------------}
  844. {check if mouse is currently in the specified area}
  845. {returns true if it is, false if not}
  846. { x and y values scaled for text mode }
  847.  
  848. function mousein(x1,y1,x2,y2:word):boolean;
  849. begin
  850.    mousein := false;               {<-- assume it won't be in the area first}
  851.    if not(mouse_installed) then exit;           {<-- can't do this, no mouse}
  852.    readmouse;                              {<-- find out where thhe mouse is}
  853.    if (mousex >= x1) and
  854.       (mousex <= x2) and                         {check if it is in the area}
  855.       (mousey >= y1) and
  856.       (mousey <= y2)
  857.      then mousein := true;                         {<-- return true if it is}
  858. end;
  859.  
  860.  
  861. {---------------------------------------------------------------------------}
  862. { check if mouse is currently in the specified box area }
  863. { returns true if it is, false if not }
  864. { x and y values are scaled for graphics }
  865.  
  866. function mouseinbox(var r):boolean;
  867. begin
  868.    mouseinbox := false;            {<-- assume it won't be in the area first}
  869.    if not(mouse_installed) then exit;           {<-- can't do this, no mouse}
  870.    readmouse;                              {<-- find out where thhe mouse is}
  871.    if (mousex * mousetextwidth >= mrect(r).x1) and
  872.       (mousex * mousetextwidth <= mrect(r).x2) and   {check if in the box area}
  873.       (mousey * mousetextheight >= mrect(r).y1) and
  874.       (mousey * mousetextheight <= mrect(r).y2)
  875.      then mouseinbox := true;                      {<-- return true if it is}
  876. end;
  877.  
  878.  
  879. {---------------------------------------------------------------------------}
  880. function mouseclick:boolean;           {has the mouse been clicked recently?}
  881. begin
  882.     mouseclick := mouse_clicked;             {get a copy of the click status}
  883.     mouse_clicked := false;                           {then clear the status}
  884. end;
  885.  
  886. {---------------------------------------------------------------------------}
  887. {check if mouse was in the specified area when clicked.}
  888. {returns true if it was, false if not.}
  889. { x and y values scaled for text mode }
  890.  
  891. function mouseclickin(x1,y1,x2,y2:word):boolean;
  892. begin
  893.   mouseclickin := false;
  894.   if not(mouse_installed) then exit;            {<-- can't do this, no mouse}
  895.   if (click_mousex >= x1) and
  896.      (click_mousex >= x2) and                    {check if it is in the area}
  897.      (click_mousey >= y1) and
  898.      (click_mousey <= y2)
  899.     then mouseclickin := true;                     {<-- return true if it is}
  900. end;
  901.  
  902. {---------------------------------------------------------------------------}
  903. {check if mouse was in the specified area when clicked.}
  904. {returns true if it was, false if not.}
  905. { x and y values are scaled for graphics }
  906.  
  907. function mouseclickinbox(var r):boolean;
  908. begin
  909.   mouseclickinbox := false;
  910.   if not(mouse_installed) then exit;            {<-- can't do this, no mouse}
  911.   if (click_mousex * mousetextwidth >= mrect(r).x1) and
  912.      (click_mousex * mousetextwidth <= mrect(r).x2) and
  913.      (click_mousey * mousetextheight >= mrect(r).y1) and {check if in box area}
  914.      (click_mousey * mousetextheight <= mrect(r).y2)
  915.     then mouseclickinbox := true;                  {<-- return true if it is}
  916. end;
  917.  
  918. {---------------------------------------------------------------------------}
  919. function pushmouse:boolean;  {pushes current mouse status on the mouse stack}
  920. var ptemp : mouseptrp;       {returns false if not enough heap space to push}
  921.  
  922. begin
  923.   pushmouse := false;                      {<-- assume no good to begin with}
  924.   if not(mouse_installed) then exit;            {<-- can't do this, no mouse}
  925.   mouse_reg.ax := 21;                        {find out how much data to save}
  926.   intr($33,mouse_reg);                 {then check to see if it can be saved}
  927.   if maxavail < ( mouse_reg.bx + sizeof(mouseptrrec) ) then exit;
  928.   ptemp := mousestack;                           {<-- save old stack pointer}
  929.   getmem(mousestack,sizeof(mouseptrrec));      {<-- get a new pointer record}
  930.   with mousestack^ do
  931.   begin
  932.     prev := ptemp;                            {<-- link in old stack pointer}
  933.     size := mouse_reg.bx;                      {<-- save how big the data is}
  934.     getmem(buf,size);               {<-- grab some buffer space for the data}
  935.     mouse_reg.ax := 22;
  936.     mouse_reg.es := seg(buf^);            {save the mouse data in the buffer}
  937.     mouse_reg.dx := ofs(buf^);
  938.     intr($33,mouse_reg);
  939.   end;
  940.   pushmouse := true;                               {<-- tell them we made it}
  941. end;
  942.  
  943. {---------------------------------------------------------------------------}
  944. function popmouse:boolean;          {pops mouse status from the mouse stack.}
  945. var ptemp : mouseptrp;                     {returns false if nothing to pop.}
  946.  
  947. begin
  948.   popmouse := false;                       {<-- assume no good to begin with}
  949.   if not(mouse_installed) then exit;            {<-- can't do this, no mouse}
  950.   if mousestack = nil then exit;            {<-- nothing in the stack to pop}
  951.   with mousestack^ do
  952.   begin
  953.     mouse_reg.ax := 23;
  954.     mouse_reg.es := seg(buf^);            {restore mouse data from the stack}
  955.     mouse_reg.dx := ofs(buf^);
  956.     intr($33,mouse_reg);
  957.     ptemp := prev;                              {<-- unlink the prev pointer}
  958.     freemem(buf,size);                           {and free up the heap space}
  959.     freemem(mousestack,sizeof(mouseptrrec));
  960.     mousestack := ptemp;                            {<-- update stack pointer}
  961.   end;
  962.   popmouse := true;                                {<-- tell them we made it}
  963. end;
  964.  
  965. {---------------------------------------------------------------------------}
  966. procedure zapmousestack;                             {get rid of mouse stack}
  967. var ptemp : mouseptrp;
  968.  
  969. begin
  970.    while mousestack <> nil do               {pop the stack until it is empty}
  971.      with mousestack^ do
  972.      begin
  973.        ptemp := prev;                           {<-- unlink the prev pointer}
  974.        freemem(buf,size);                        {and free up the heap space}
  975.        freemem(mousestack,sizeof(mouseptrrec));
  976.        mousestack := ptemp;                         {<-- update stack pointer}
  977.      end;
  978. end;
  979.  
  980. {***************************************************************************}
  981. {initialization section}
  982.  
  983. begin
  984.   mousetextwidth  := 8;                    {size of text on screen for mouse}
  985.   mousetextheight := 8;
  986.   mousestack := nil;
  987.   mouse_installed := false;
  988.   mouse_buttons := 0;
  989.   mouse_click_button := 0;
  990.   mousex := 1;
  991.   mousey := 1;
  992.   click_mousex := 1;
  993.   click_mousey := 1;
  994.   mouse_clicked := false;
  995.   initmouse;
  996. end.
  997.  
  998. {***************************************************************************}
  999. { eof }
  1000.