mouse.pp 22 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755
  1. {
  2. $Id$
  3. This file is part of the Free Pascal run time library.
  4. Copyright (c) 1999-2000 by Florian Klaempfl
  5. member of the Free Pascal development team
  6. Mouse unit for Go32v2
  7. See the file COPYING.FPC, included in this distribution,
  8. for details about the copyright.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  12. **********************************************************************}
  13. unit Mouse;
  14. interface
  15. const
  16. MouseEventBufSize = 16;
  17. {$i mouseh.inc}
  18. { tells the mouse unit to draw the mouse cursor itself }
  19. procedure DoCustomMouse(b : boolean);
  20. implementation
  21. uses
  22. video,go32;
  23. var
  24. RealSeg : Word; { Real mode segment }
  25. RealOfs : Word; { Real mode offset }
  26. CurrentMask : word;
  27. MouseCallback : Pointer; { Mouse call back ptr }
  28. UnderNT: boolean;
  29. {$ifdef DEBUG}
  30. EntryEDI,EntryESI : longint;
  31. EntryDS,EntryES : word;
  32. {$endif DEBUG}
  33. { Real mode registers in text segment below $ffff limit
  34. for Windows NT
  35. NOTE this might cause problem if someone want to
  36. protect text section against writing (would be possible
  37. with CWSDPMI under raw dos, not implemented yet !) }
  38. ActionRegs : TRealRegs;external name '___v2prt0_rmcb_regs';
  39. v2prt0_ds_alias : word;external name '___v2prt0_ds_alias';
  40. const
  41. MousePresent : boolean = false;
  42. {$ifdef DEBUG}
  43. MouseError : longint = 0;
  44. CallCounter : longint = 0;
  45. {$endif DEBUG}
  46. drawmousecursor : boolean = false;
  47. mouseisvisible : boolean = false;
  48. { position where the mouse was drawn the last time }
  49. oldmousex : longint = -1;
  50. oldmousey : longint = -1;
  51. mouselock : boolean = false;
  52. { if the cursor is drawn by this the unit, we must be careful }
  53. { when drawing while the interrupt handler is called }
  54. procedure lockmouse;assembler;
  55. asm
  56. .Ltrylockagain:
  57. movb $1,%al
  58. xchgb mouselock,%al
  59. orb %al,%al
  60. jne .Ltrylockagain
  61. end;
  62. procedure unlockmouse;
  63. begin
  64. mouselock:=false;
  65. end;
  66. {$ASMMODE ATT}
  67. procedure MouseInt;assembler;
  68. asm
  69. movb %bl,mousebuttons
  70. movw %cx,mousewherex
  71. movw %dx,mousewherey
  72. shrw $3,%cx
  73. shrw $3,%dx
  74. { should we draw the mouse cursor? }
  75. cmpb $0,drawmousecursor
  76. je .Lmouse_nocursor
  77. cmpb $0,mouseisvisible
  78. je .Lmouse_nocursor
  79. pushw %fs
  80. pushl %eax
  81. pushl %edi
  82. { check lock }
  83. movb $1,%al
  84. xchgb mouselock,%al
  85. orb %al,%al
  86. { don't update the cursor yet, because hide/showcursor is called }
  87. jne .Ldont_draw
  88. { load start of video buffer }
  89. movzwl videoseg,%edi
  90. shll $4,%edi
  91. movw dosmemselector,%fs
  92. { calculate address of old mouse cursor }
  93. movl oldmousey,%eax
  94. imulw screenwidth,%ax
  95. addl oldmousex,%eax
  96. leal 1(%edi,%eax,2),%eax
  97. { remove old cursor }
  98. xorb $0x7f,%fs:(%eax)
  99. { store position of old cursor }
  100. movzwl %cx,%ecx
  101. movl %ecx,oldmousex
  102. movzwl %dx,%edx
  103. movl %edx,oldmousey
  104. { calculate address of new cursor }
  105. movl %edx,%eax
  106. imulw screenwidth,%ax
  107. addl %ecx,%eax
  108. leal 1(%edi,%eax,2),%eax
  109. { draw new cursor }
  110. xorb $0x7f,%fs:(%eax)
  111. { unlock mouse }
  112. movb $0,mouselock
  113. .Ldont_draw:
  114. popl %edi
  115. popl %eax
  116. popw %fs
  117. .Lmouse_nocursor:
  118. cmpb MouseEventBufSize,PendingMouseEvents
  119. je .Lmouse_exit
  120. movl PendingMouseTail,%edi
  121. movw %bx,(%edi)
  122. movw %cx,2(%edi)
  123. movw %dx,4(%edi)
  124. movw $0,6(%edi)
  125. addl $8,%edi
  126. leal PendingMouseEvent,%eax
  127. addl MouseEventBufSize*8,%eax
  128. cmpl %eax,%edi
  129. jne .Lmouse_nowrap
  130. leal PendingMouseEvent,%edi
  131. .Lmouse_nowrap:
  132. movl %edi,PendingMouseTail
  133. incb PendingMouseEvents
  134. .Lmouse_exit:
  135. end;
  136. PROCEDURE Mouse_Trap; ASSEMBLER;
  137. ASM
  138. PUSH %ES; { Save ES register }
  139. PUSH %DS; { Save DS register }
  140. PUSHL %EDI; { Save register }
  141. PUSHL %ESI; { Save register }
  142. { ; caution : ds is not the selector for our data !! }
  143. {$ifdef DEBUG}
  144. MOVL %EDI,%ES:EntryEDI
  145. MOVL %ESI,%ES:EntryESI
  146. MOVW %DS,%AX
  147. MOVW %AX,%ES:EntryDS
  148. MOVW %ES,%AX
  149. MOVW %AX,%ES:EntryES
  150. {$endif DEBUG}
  151. { movw %cs:v2prt0_ds_alias,%ax v2prt0 is not locked !!
  152. movw %ax,%ds
  153. movw %ax,%es }
  154. PUSH %ES; { Push data seg }
  155. POP %DS; { Load data seg }
  156. {$ifdef DEBUG}
  157. incl callcounter
  158. CMPL $ACTIONREGS,%edi
  159. JE .L_ActionRegsOK
  160. INCL MouseError
  161. JMP .L_NoCallBack
  162. .L_ActionRegsOK:
  163. {$endif DEBUG}
  164. MOVL MOUSECALLBACK, %EAX; { Fetch callback addr }
  165. CMPL $0, %EAX; { Check for nil ptr }
  166. JZ .L_NoCallBack; { Ignore if nil }
  167. MOVL %EDI,%EAX; { %EAX = @actionregs }
  168. MOVL (%EAX), %EDI; { EDI from actionregs }
  169. MOVL 4(%EAX), %ESI; { ESI from actionregs }
  170. MOVL 16(%EAX), %EBX; { EBX from actionregs }
  171. MOVL 20(%EAX), %EDX; { EDX from actionregs }
  172. MOVL 24(%EAX), %ECX; { ECX from actionregs }
  173. MOVL 28(%EAX), %EAX; { EAX from actionregs }
  174. CALL *MOUSECALLBACK; { Call callback proc }
  175. .L_NoCallBack:
  176. POPL %ESI; { Recover register }
  177. POPL %EDI; { Recover register }
  178. POP %DS; { Restore DS register }
  179. POP %ES; { Restore ES register }
  180. { This works for WinNT
  181. movzwl %si,%eax
  182. but CWSDPMI need this }
  183. movl %esi,%eax
  184. MOVL %ds:(%Eax), %EAX;
  185. MOVL %EAX, %ES:42(%EDI); { Set as return addr }
  186. ADDW $4, %ES:46(%EDI); { adjust stack }
  187. IRET; { Interrupt return }
  188. END;
  189. PROCEDURE Mouse_Trap_NT; ASSEMBLER;
  190. ASM
  191. PUSH %ES; { Save ES register }
  192. PUSH %DS; { Save DS register }
  193. PUSHL %EDI; { Save register }
  194. PUSHL %ESI; { Save register }
  195. { ; caution : ds is not the selector for our data !! }
  196. {$ifdef DEBUG}
  197. MOVL %EDI,%ES:EntryEDI
  198. MOVL %ESI,%ES:EntryESI
  199. MOVW %DS,%AX
  200. MOVW %AX,%ES:EntryDS
  201. MOVW %ES,%AX
  202. MOVW %AX,%ES:EntryES
  203. {$endif DEBUG}
  204. { movw %cs:v2prt0_ds_alias,%ax v2prt0 is not locked !!
  205. movw %ax,%ds
  206. movw %ax,%es }
  207. PUSH %ES; { Push data seg }
  208. POP %DS; { Load data seg }
  209. {$ifdef DEBUG}
  210. incl callcounter
  211. CMPL $ACTIONREGS,%edi
  212. JE .L_ActionRegsOK
  213. INCL MouseError
  214. JMP .L_NoCallBack
  215. .L_ActionRegsOK:
  216. {$endif DEBUG}
  217. MOVL MOUSECALLBACK, %EAX; { Fetch callback addr }
  218. CMPL $0, %EAX; { Check for nil ptr }
  219. JZ .L_NoCallBack; { Ignore if nil }
  220. MOVL %EDI,%EAX; { %EAX = @actionregs }
  221. MOVL (%EAX), %EDI; { EDI from actionregs }
  222. MOVL 4(%EAX), %ESI; { ESI from actionregs }
  223. MOVL 16(%EAX), %EBX; { EBX from actionregs }
  224. MOVL 20(%EAX), %EDX; { EDX from actionregs }
  225. MOVL 24(%EAX), %ECX; { ECX from actionregs }
  226. MOVL 28(%EAX), %EAX; { EAX from actionregs }
  227. CALL *MOUSECALLBACK; { Call callback proc }
  228. .L_NoCallBack:
  229. POPL %ESI; { Recover register }
  230. POPL %EDI; { Recover register }
  231. POP %DS; { Restore DS register }
  232. POP %ES; { Restore ES register }
  233. movzwl %si,%eax
  234. MOVL %ds:(%Eax), %EAX;
  235. MOVL %EAX, %ES:42(%EDI); { Set as return addr }
  236. ADDW $4, %ES:46(%EDI); { adjust stack }
  237. IRET; { Interrupt return }
  238. END;
  239. Function Allocate_mouse_bridge : boolean;
  240. var
  241. error : word;
  242. begin
  243. ASM
  244. LEAL ACTIONREGS, %EDI; { Addr of actionregs }
  245. LEAL MOUSE_TRAP, %ESI; { Procedure address }
  246. CMPB $0, UnderNT
  247. JZ .LGo32
  248. LEAL MOUSE_TRAP_NT, %ESI; { Procedure address }
  249. .LGo32:
  250. PUSH %DS; { Save DS segment }
  251. PUSH %ES; { Save ES segment }
  252. MOVW v2prt0_ds_alias,%ES; { ES now has dataseg alias that is never invalid }
  253. PUSH %CS;
  254. POP %DS; { DS now has codeseg }
  255. MOVW $0x303, %AX; { Function id }
  256. INT $0x31; { Call DPMI bridge }
  257. JNC .L_call_ok; { Branch if ok }
  258. POP %ES; { Restore ES segment }
  259. POP %DS; { Restore DS segment }
  260. MOVW $0,REALSEG;
  261. MOVW $0,REALOFS;
  262. JMP .L_exit
  263. .L_call_ok:
  264. POP %ES; { Restore ES segment }
  265. POP %DS; { Restore DS segment }
  266. MOVW %CX,REALSEG; { Transfer real seg }
  267. MOVW %DX,REALOFS; { Transfer real ofs }
  268. MOVW $0, %AX; { Force error to zero }
  269. .L_exit:
  270. MOVW %AX, ERROR; { Return error state }
  271. END;
  272. Allocate_mouse_bridge:=error=0;
  273. end;
  274. Procedure Release_mouse_bridge;
  275. begin
  276. ASM
  277. MOVW $0x304, %AX; { Set function id }
  278. MOVW REALSEG, %CX; { Bridged real seg }
  279. MOVW REALOFS, %DX; { Bridged real ofs }
  280. INT $0x31; { Release bridge }
  281. MOVW $0,REALSEG;
  282. MOVW $0,REALOFS;
  283. END;
  284. end;
  285. PROCEDURE Mouse_Action (Mask : Word; P : Pointer);
  286. VAR
  287. Error : Word;
  288. Rg : TRealRegs;
  289. BEGIN
  290. Error := 0; { Preset no error }
  291. If (P <> MouseCallBack) or (Mask<>CurrentMask) Then { Check func different }
  292. Begin
  293. { Remove old calback }
  294. If (CurrentMask <> 0) Then
  295. Begin
  296. Rg.AX := 12; { Function id }
  297. Rg.CX := 0; { Zero mask register }
  298. Rg.ES := 0; { Zero proc seg }
  299. Rg.DX := 0; { Zero proc ofs }
  300. RealIntr($33, Rg); { Stop INT 33 callback }
  301. End;
  302. if RealSeg=0 then
  303. error:=1;
  304. { test addresses for Windows NT }
  305. if (longint(@actionregs)>$ffff) {or
  306. (longint(@mouse_trap)>$ffff)} then
  307. begin
  308. error:=1;
  309. end
  310. else If (P = Nil) Then
  311. Begin
  312. Mask := 0; { Zero mask register }
  313. End;
  314. If (Error = 0) Then
  315. Begin
  316. MouseCallback := P; { Set call back addr }
  317. if Mask<>0 then
  318. begin
  319. Rg.AX := 12; { Set function id }
  320. Rg.CX := Mask; { Set mask register }
  321. If Mask<>0 then
  322. begin
  323. Rg.ES := RealSeg; { Real mode segment }
  324. Rg.DX := RealOfs; { Real mode offset }
  325. end
  326. else
  327. begin
  328. Rg.ES:=0;
  329. Rg.DX:=0;
  330. end;
  331. RealIntr($33, Rg); { Set interrupt 33 }
  332. end;
  333. CurrentMask:=Mask;
  334. End;
  335. End;
  336. If (Error <> 0) Then
  337. Begin
  338. Writeln('GO32V2 mouse handler set failed !!');
  339. ReadLn; { Wait for user to see }
  340. End;
  341. END;
  342. { We need to remove the mouse callback before exiting !! PM }
  343. const StoredExit : Pointer = Nil;
  344. FirstMouseInitDone : boolean = false;
  345. procedure MouseSafeExit;
  346. begin
  347. ExitProc:=StoredExit;
  348. if MouseCallBack<>Nil then
  349. Mouse_Action(0, Nil);
  350. if not FirstMouseInitDone then
  351. exit;
  352. FirstMouseInitDone:=false;
  353. Unlock_Code(Pointer(@Mouse_Trap), 400); { Release trap code }
  354. Unlock_Code(Pointer(@Mouse_Trap_NT), 400); { Release trap code }
  355. Unlock_Code(Pointer(@MouseInt), 400); { Lock MouseInt code }
  356. Unlock_Data(ActionRegs, SizeOf(TRealRegs)); { Release registers }
  357. UnLock_Data(MouseCallBack,SizeOf(Pointer));
  358. { unlock Mouse Queue and related stuff ! }
  359. Unlock_Data(PendingMouseEvent,
  360. MouseEventBufSize*Sizeof(TMouseEvent));
  361. Unlock_Data(PendingMouseTail,SizeOf(longint));
  362. Unlock_Data(PendingMouseEvents,sizeof(byte));
  363. Unlock_Data(MouseButtons,SizeOf(byte));
  364. Unlock_Data(MouseWhereX,SizeOf(word));
  365. Unlock_Data(MouseWhereY,SizeOf(word));
  366. Unlock_Data(drawmousecursor,SizeOf(boolean));
  367. Unlock_Data(mouseisvisible,SizeOf(boolean));
  368. Unlock_Data(mouselock,SizeOf(boolean));
  369. Unlock_Data(videoseg,SizeOf(word));
  370. Unlock_Data(dosmemselector,SizeOf(word));
  371. Unlock_Data(screenwidth,SizeOf(word));
  372. Unlock_Data(OldMouseX,SizeOf(longint));
  373. Unlock_Data(OldMouseY,SizeOf(longint));
  374. {$ifdef DEBUG}
  375. Unlock_Data(EntryEDI, SizeOf(longint));
  376. Unlock_Data(EntryESI, SizeOf(longint));
  377. Unlock_Data(EntryDS, SizeOf(word));
  378. Unlock_Data(EntryES, SizeOf(word));
  379. Unlock_Data(MouseError, SizeOf(longint));
  380. Unlock_Data(callcounter, SizeOf(longint));
  381. {$endif DEBUG}
  382. Release_mouse_bridge;
  383. end;
  384. function RunningUnderWINNT: boolean;
  385. var r: trealregs;
  386. begin
  387. fillchar(r,sizeof(r),0);
  388. r.ax:=$3306;
  389. realintr($21,r);
  390. RunningUnderWINNT:=(r.bx=$3205);
  391. end;
  392. procedure InitMouse;
  393. begin
  394. UnderNT:=RunningUnderWINNT;
  395. if not MousePresent then
  396. begin
  397. if DetectMouse=0 then
  398. begin
  399. Writeln('No mouse driver found ');
  400. exit;
  401. end
  402. else
  403. MousePresent:=true;
  404. end;
  405. PendingMouseHead:=@PendingMouseEvent;
  406. PendingMouseTail:=@PendingMouseEvent;
  407. PendingMouseEvents:=0;
  408. FillChar(LastMouseEvent,sizeof(TMouseEvent),0);
  409. { don't do this twice !! PM }
  410. If not FirstMouseInitDone then
  411. begin
  412. StoredExit:=ExitProc;
  413. ExitProc:=@MouseSafeExit;
  414. Lock_Code(Pointer(@Mouse_Trap), 400); { Lock trap code }
  415. Lock_Code(Pointer(@Mouse_Trap_NT), 400); { Lock trap code }
  416. Lock_Code(Pointer(@MouseInt), 400); { Lock MouseInt code }
  417. Lock_Data(ActionRegs, SizeOf(TRealRegs)); { Lock registers }
  418. Lock_Data(MouseCallBack, SizeOf(pointer));
  419. { lock Mouse Queue and related stuff ! }
  420. Lock_Data(PendingMouseEvent,
  421. MouseEventBufSize*Sizeof(TMouseEvent));
  422. Lock_Data(PendingMouseTail,SizeOf(longint));
  423. Lock_Data(PendingMouseEvents,sizeof(byte));
  424. Lock_Data(MouseButtons,SizeOf(byte));
  425. Lock_Data(MouseWhereX,SizeOf(word));
  426. Lock_Data(MouseWhereY,SizeOf(word));
  427. Lock_Data(drawmousecursor,SizeOf(boolean));
  428. Lock_Data(mouseisvisible,SizeOf(boolean));
  429. Lock_Data(mouselock,SizeOf(boolean));
  430. Lock_Data(videoseg,SizeOf(word));
  431. Lock_Data(dosmemselector,SizeOf(word));
  432. Lock_Data(screenwidth,SizeOf(word));
  433. Lock_Data(OldMouseX,SizeOf(longint));
  434. Lock_Data(OldMouseY,SizeOf(longint));
  435. {$ifdef DEBUG}
  436. Lock_Data(EntryEDI, SizeOf(longint));
  437. Lock_Data(EntryESI, SizeOf(longint));
  438. Lock_Data(EntryDS, SizeOf(word));
  439. Lock_Data(EntryES, SizeOf(word));
  440. Lock_Data(MouseError, SizeOf(longint));
  441. Lock_Data(callcounter, SizeOf(longint));
  442. {$endif DEBUG}
  443. Allocate_mouse_bridge;
  444. FirstMouseInitDone:=true;
  445. end;
  446. If MouseCallBack=Nil then
  447. Mouse_Action($ffff, @MouseInt); { Set masks/interrupt }
  448. drawmousecursor:=false;
  449. mouseisvisible:=false;
  450. if (screenwidth>80) or (screenheight>50) then
  451. DoCustomMouse(true);
  452. ShowMouse;
  453. end;
  454. procedure DoneMouse;
  455. begin
  456. HideMouse;
  457. If (MouseCallBack <> Nil) Then
  458. Mouse_Action(0, Nil); { Clear mask/interrupt }
  459. end;
  460. function DetectMouse:byte;assembler;
  461. asm
  462. movl $0x200,%eax
  463. movl $0x33,%ebx
  464. int $0x31
  465. movw %cx,%ax
  466. orw %ax,%dx
  467. jz .Lno_mouse
  468. xorl %eax,%eax
  469. pushl %ebp
  470. int $0x33
  471. popl %ebp
  472. orw %ax,%ax
  473. jz .Lno_mouse
  474. movl %ebx,%eax
  475. .Lno_mouse:
  476. end;
  477. procedure ShowMouse;
  478. begin
  479. if drawmousecursor then
  480. begin
  481. lockmouse;
  482. if not(mouseisvisible) then
  483. begin
  484. oldmousex:=getmousex-1;
  485. oldmousey:=getmousey-1;
  486. mem[videoseg:(((screenwidth*oldmousey)+oldmousex)*2)+1]:=
  487. mem[videoseg:(((screenwidth*oldmousey)+oldmousex)*2)+1] xor $7f;
  488. mouseisvisible:=true;
  489. end;
  490. unlockmouse;
  491. end
  492. else
  493. asm
  494. cmpb $1,MousePresent
  495. jne .LShowMouseExit
  496. movl $1,%eax
  497. pushl %ebp
  498. int $0x33
  499. popl %ebp
  500. .LShowMouseExit:
  501. end;
  502. end;
  503. procedure HideMouse;
  504. begin
  505. if drawmousecursor then
  506. begin
  507. lockmouse;
  508. if mouseisvisible then
  509. begin
  510. mouseisvisible:=false;
  511. mem[videoseg:(((screenwidth*oldmousey)+oldmousex)*2)+1]:=
  512. mem[videoseg:(((screenwidth*oldmousey)+oldmousex)*2)+1] xor $7f;
  513. oldmousex:=-1;
  514. oldmousey:=-1;
  515. end;
  516. unlockmouse;
  517. end
  518. else
  519. asm
  520. cmpb $1,MousePresent
  521. jne .LHideMouseExit
  522. movl $2,%eax
  523. pushl %ebp
  524. int $0x33
  525. popl %ebp
  526. .LHideMouseExit:
  527. end;
  528. end;
  529. function GetMouseX:word;assembler;
  530. asm
  531. cmpb $1,MousePresent
  532. jne .LGetMouseXError
  533. movl $3,%eax
  534. pushl %ebp
  535. int $0x33
  536. popl %ebp
  537. movzwl %cx,%eax
  538. shrl $3,%eax
  539. incl %eax
  540. ret
  541. .LGetMouseXError:
  542. xorl %eax,%eax
  543. end;
  544. function GetMouseY:word;assembler;
  545. asm
  546. cmpb $1,MousePresent
  547. jne .LGetMouseYError
  548. movl $3,%eax
  549. pushl %ebp
  550. int $0x33
  551. popl %ebp
  552. movzwl %dx,%eax
  553. shrl $3,%eax
  554. incl %eax
  555. ret
  556. .LGetMouseYError:
  557. xorl %eax,%eax
  558. end;
  559. function GetMouseButtons:word;assembler;
  560. asm
  561. cmpb $1,MousePresent
  562. jne .LGetMouseButtonsError
  563. movl $3,%eax
  564. pushl %ebp
  565. int $0x33
  566. popl %ebp
  567. movw %bx,%ax
  568. ret
  569. .LGetMouseButtonsError:
  570. xorl %eax,%eax
  571. end;
  572. procedure SetMouseXY(x,y:word);assembler;
  573. asm
  574. cmpb $1,MousePresent
  575. jne .LSetMouseXYExit
  576. movw x,%cx
  577. movw y,%dx
  578. movl $4,%eax
  579. pushl %ebp
  580. int $0x33
  581. popl %ebp
  582. .LSetMouseXYExit:
  583. end;
  584. Procedure SetMouseXRange (Min,Max:Longint);
  585. begin
  586. If Not(MousePresent) Then Exit;
  587. asm
  588. movl $7,%eax
  589. movl min,%ecx
  590. movl max,%edx
  591. pushl %ebp
  592. int $0x33
  593. popl %ebp
  594. end;
  595. end;
  596. Procedure SetMouseYRange (min,max:Longint);
  597. begin
  598. If Not(MousePresent) Then Exit;
  599. asm
  600. movl $8,%eax
  601. movl min,%ecx
  602. movl max,%edx
  603. pushl %ebp
  604. int $0x33
  605. popl %ebp
  606. end;
  607. end;
  608. procedure DoCustomMouse(b : boolean);
  609. begin
  610. HideMouse;
  611. lockmouse;
  612. oldmousex:=-1;
  613. oldmousey:=-1;
  614. SetMouseXRange(0,(screenwidth-1)*8);
  615. SetMouseYRange(0,(screenheight-1)*8);
  616. if b then
  617. begin
  618. mouseisvisible:=false;
  619. drawmousecursor:=true;
  620. end
  621. else
  622. drawmousecursor:=false;
  623. unlockmouse;
  624. end;
  625. const
  626. LastCallcounter : longint = 0;
  627. procedure GetMouseEvent(var MouseEvent: TMouseEvent);
  628. begin
  629. if not MousePresent then
  630. begin
  631. Fillchar(MouseEvent,SizeOf(TMouseEvent),#0);
  632. end;
  633. {$ifdef DEBUG}
  634. if mouseError>0 then
  635. Writeln('Errors in mouse Handler ',MouseError);
  636. {$ifdef EXTMOUSEDEBUG}
  637. if callcounter>LastCallcounter then
  638. Writeln('Number of calls in mouse Handler ',Callcounter);
  639. {$endif EXTMOUSEDEBUG}
  640. LastCallcounter:=Callcounter;
  641. {$endif DEBUG}
  642. repeat until PendingMouseEvents>0;
  643. MouseEvent:=PendingMouseHead^;
  644. inc(PendingMouseHead);
  645. if longint(PendingMouseHead)=longint(@PendingMouseEvent)+sizeof(PendingMouseEvent) then
  646. PendingMouseHead:=@PendingMouseEvent;
  647. dec(PendingMouseEvents);
  648. if (LastMouseEvent.x<>MouseEvent.x) or (LastMouseEvent.y<>MouseEvent.y) then
  649. MouseEvent.Action:=MouseActionMove;
  650. if (LastMouseEvent.Buttons<>MouseEvent.Buttons) then
  651. begin
  652. if (LastMouseEvent.Buttons=0) then
  653. MouseEvent.Action:=MouseActionDown
  654. else
  655. MouseEvent.Action:=MouseActionUp;
  656. end;
  657. LastMouseEvent:=MouseEvent;
  658. end;
  659. function PollMouseEvent(var MouseEvent: TMouseEvent):boolean;
  660. begin
  661. if PendingMouseEvents>0 then
  662. begin
  663. MouseEvent:=PendingMouseHead^;
  664. PollMouseEvent:=true;
  665. end
  666. else
  667. PollMouseEvent:=false;
  668. end;
  669. procedure PutMouseEvent(const MouseEvent: TMouseEvent);
  670. begin
  671. if PendingMouseEvents<MouseEventBufSize then
  672. begin
  673. PendingMouseTail^:=MouseEvent;
  674. inc(PendingMouseTail);
  675. if longint(PendingMouseTail)=longint(@PendingMouseEvent)+sizeof(PendingMouseEvent) then
  676. PendingMouseTail:=@PendingMouseEvent;
  677. { why isn't this done here ?
  678. so the win32 version do this by hand:}
  679. inc(PendingMouseEvents);
  680. end
  681. else
  682. end;
  683. end.
  684. {
  685. $Log$
  686. Revision 1.1 2001-01-13 11:03:58 peter
  687. * API 2 RTL commit
  688. }