mouse.pp 23 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790
  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. {$i mouseh.inc}
  16. { tells the mouse unit to draw the mouse cursor itself }
  17. procedure DoCustomMouse(b : boolean);
  18. implementation
  19. uses
  20. video,go32;
  21. {$i mouse.inc}
  22. var
  23. RealSeg : Word; { Real mode segment }
  24. RealOfs : Word; { Real mode offset }
  25. CurrentMask : word;
  26. MouseCallback : Pointer; { Mouse call back ptr }
  27. UnderNT: boolean;
  28. {$ifdef DEBUG}
  29. EntryEDI,EntryESI : longint;
  30. EntryDS,EntryES : word;
  31. {$endif DEBUG}
  32. { Real mode registers in text segment below $ffff limit
  33. for Windows NT
  34. NOTE this might cause problem if someone want to
  35. protect text section against writing (would be possible
  36. with CWSDPMI under raw dos, not implemented yet !) }
  37. ActionRegs : TRealRegs;external name '___v2prt0_rmcb_regs';
  38. v2prt0_ds_alias : word;external name '___v2prt0_ds_alias';
  39. const
  40. MousePresent : boolean = false;
  41. First_try : boolean = true;
  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. pushl %eax;
  192. PUSH %ES; { Save ES register }
  193. PUSH %DS; { Save DS register }
  194. PUSH %FS; { Save FS register }
  195. PUSHL %EDI; { Save register }
  196. PUSHL %ESI; { Save register }
  197. pushl %ebx;
  198. pushl %ecx;
  199. pushl %edx;
  200. { ; caution : ds is not the selector for our data !! }
  201. MOVW %cs:v2prt0_ds_alias,%ax
  202. movw %ax,%es
  203. { ES now has dataseg alias that is never invalid }
  204. {$ifdef DEBUG}
  205. MOVL %EDI,%ES:EntryEDI
  206. MOVL %ESI,%ES:EntryESI
  207. MOVW %DS,%AX
  208. MOVW %AX,%ES:EntryDS
  209. MOVW %ES,%AX
  210. MOVW %AX,%ES:EntryES
  211. {$endif DEBUG}
  212. { movw %cs:v2prt0_ds_alias,%ax v2prt0 is not locked !!
  213. movw %ax,%ds
  214. movw %ax,%es }
  215. PUSH %ES; { Push data seg }
  216. POP %DS; { Load data seg }
  217. {$ifdef DEBUG}
  218. incl callcounter
  219. CMPL $ACTIONREGS,%edi
  220. JE .L_ActionRegsOK
  221. INCL MouseError
  222. JMP .L_NoCallBack
  223. .L_ActionRegsOK:
  224. {$endif DEBUG}
  225. MOVL MOUSECALLBACK, %EAX; { Fetch callback addr }
  226. CMPL $0, %EAX; { Check for nil ptr }
  227. JZ .L_NoCallBack; { Ignore if nil }
  228. MOVL %EDI,%EAX; { %EAX = @actionregs }
  229. MOVL (%EAX), %EDI; { EDI from actionregs }
  230. MOVL 4(%EAX), %ESI; { ESI from actionregs }
  231. MOVL 16(%EAX), %EBX; { EBX from actionregs }
  232. MOVL 20(%EAX), %EDX; { EDX from actionregs }
  233. MOVL 24(%EAX), %ECX; { ECX from actionregs }
  234. MOVL 28(%EAX), %EAX; { EAX from actionregs }
  235. CALL *MOUSECALLBACK; { Call callback proc }
  236. .L_NoCallBack:
  237. popl %edx;
  238. popl %ecx;
  239. popl %ebx;
  240. POPL %ESI; { Recover register }
  241. POPL %EDI; { Recover register }
  242. POP %FS; { Restore FS register }
  243. POP %DS; { Restore DS register }
  244. POP %ES; { Restore ES register }
  245. movw %es,%ax
  246. cmpw $0,%ax
  247. jne .Lesisok
  248. { ; caution : ds is not the selector for our data !! }
  249. MOVW %cs:v2prt0_ds_alias,%ax
  250. movw %ax,%es
  251. .Lesisok:
  252. lsl %eax,%eax
  253. cmpl %edi,%eax
  254. ja .Ldontzeroedi
  255. movzwl %di,%edi
  256. .Ldontzeroedi:
  257. movw %ds,%ax
  258. lsl %eax,%eax
  259. cmpl %esi,%eax
  260. ja .Lsimplecopy
  261. movzwl %si,%eax
  262. jmp .Lcopyend
  263. .Lsimplecopy:
  264. movl %esi,%eax
  265. .Lcopyend:
  266. MOVL %ds:(%Eax), %EAX
  267. MOVL %EAX, %ES:42(%EDI) { Set as return addr }
  268. ADDW $4, %ES:46(%EDI) { adjust stack }
  269. popl %eax
  270. IRET { Interrupt return }
  271. END;
  272. Function Allocate_mouse_bridge : boolean;
  273. var
  274. error : word;
  275. begin
  276. ASM
  277. LEAL ACTIONREGS, %EDI; { Addr of actionregs }
  278. LEAL MOUSE_TRAP, %ESI; { Procedure address }
  279. CMPB $0, UnderNT
  280. JZ .LGo32
  281. LEAL MOUSE_TRAP_NT, %ESI; { Procedure address }
  282. .LGo32:
  283. PUSH %DS; { Save DS segment }
  284. PUSH %ES; { Save ES segment }
  285. MOVW v2prt0_ds_alias,%ES; { ES now has dataseg alias that is never invalid }
  286. PUSH %CS;
  287. POP %DS; { DS now has codeseg }
  288. MOVW $0x303, %AX; { Function id }
  289. INT $0x31; { Call DPMI bridge }
  290. JNC .L_call_ok; { Branch if ok }
  291. POP %ES; { Restore ES segment }
  292. POP %DS; { Restore DS segment }
  293. MOVW $0,REALSEG;
  294. MOVW $0,REALOFS;
  295. JMP .L_exit
  296. .L_call_ok:
  297. POP %ES; { Restore ES segment }
  298. POP %DS; { Restore DS segment }
  299. MOVW %CX,REALSEG; { Transfer real seg }
  300. MOVW %DX,REALOFS; { Transfer real ofs }
  301. MOVW $0, %AX; { Force error to zero }
  302. .L_exit:
  303. MOVW %AX, ERROR; { Return error state }
  304. END;
  305. Allocate_mouse_bridge:=error=0;
  306. end;
  307. Procedure Release_mouse_bridge;
  308. begin
  309. ASM
  310. MOVW $0x304, %AX; { Set function id }
  311. MOVW REALSEG, %CX; { Bridged real seg }
  312. MOVW REALOFS, %DX; { Bridged real ofs }
  313. INT $0x31; { Release bridge }
  314. MOVW $0,REALSEG;
  315. MOVW $0,REALOFS;
  316. END;
  317. end;
  318. PROCEDURE Mouse_Action (Mask : Word; P : Pointer);
  319. VAR
  320. Error : Word;
  321. Rg : TRealRegs;
  322. BEGIN
  323. Error := 0; { Preset no error }
  324. If (P <> MouseCallBack) or (Mask<>CurrentMask) Then { Check func different }
  325. Begin
  326. { Remove old calback }
  327. If (CurrentMask <> 0) Then
  328. Begin
  329. Rg.AX := 12; { Function id }
  330. Rg.CX := 0; { Zero mask register }
  331. Rg.ES := 0; { Zero proc seg }
  332. Rg.DX := 0; { Zero proc ofs }
  333. RealIntr($33, Rg); { Stop INT 33 callback }
  334. End;
  335. if RealSeg=0 then
  336. error:=1;
  337. { test addresses for Windows NT }
  338. if (longint(@actionregs)>$ffff) {or
  339. (longint(@mouse_trap)>$ffff)} then
  340. begin
  341. error:=1;
  342. end
  343. else If (P = Nil) Then
  344. Begin
  345. Mask := 0; { Zero mask register }
  346. End;
  347. If (Error = 0) Then
  348. Begin
  349. MouseCallback := P; { Set call back addr }
  350. if Mask<>0 then
  351. begin
  352. Rg.AX := 12; { Set function id }
  353. Rg.CX := Mask; { Set mask register }
  354. If Mask<>0 then
  355. begin
  356. Rg.ES := RealSeg; { Real mode segment }
  357. Rg.DX := RealOfs; { Real mode offset }
  358. end
  359. else
  360. begin
  361. Rg.ES:=0;
  362. Rg.DX:=0;
  363. end;
  364. RealIntr($33, Rg); { Set interrupt 33 }
  365. end;
  366. CurrentMask:=Mask;
  367. End;
  368. End;
  369. If (Error <> 0) Then
  370. Begin
  371. Writeln('GO32V2 mouse handler set failed !!');
  372. ReadLn; { Wait for user to see }
  373. End;
  374. END;
  375. { We need to remove the mouse callback before exiting !! PM }
  376. const StoredExit : Pointer = Nil;
  377. FirstMouseInitDone : boolean = false;
  378. procedure MouseSafeExit;
  379. begin
  380. ExitProc:=StoredExit;
  381. if MouseCallBack<>Nil then
  382. Mouse_Action(0, Nil);
  383. if not FirstMouseInitDone then
  384. exit;
  385. FirstMouseInitDone:=false;
  386. Unlock_Code(Pointer(@Mouse_Trap), 400); { Release trap code }
  387. Unlock_Code(Pointer(@Mouse_Trap_NT), 400); { Release trap code }
  388. Unlock_Code(Pointer(@MouseInt), 400); { Lock MouseInt code }
  389. Unlock_Data(ActionRegs, SizeOf(TRealRegs)); { Release registers }
  390. UnLock_Data(MouseCallBack,SizeOf(Pointer));
  391. { unlock Mouse Queue and related stuff ! }
  392. Unlock_Data(PendingMouseEvent,
  393. MouseEventBufSize*Sizeof(TMouseEvent));
  394. Unlock_Data(PendingMouseTail,SizeOf(longint));
  395. Unlock_Data(PendingMouseEvents,sizeof(byte));
  396. Unlock_Data(MouseButtons,SizeOf(byte));
  397. Unlock_Data(MouseWhereX,SizeOf(word));
  398. Unlock_Data(MouseWhereY,SizeOf(word));
  399. Unlock_Data(drawmousecursor,SizeOf(boolean));
  400. Unlock_Data(mouseisvisible,SizeOf(boolean));
  401. Unlock_Data(mouselock,SizeOf(boolean));
  402. Unlock_Data(videoseg,SizeOf(word));
  403. Unlock_Data(dosmemselector,SizeOf(word));
  404. Unlock_Data(screenwidth,SizeOf(word));
  405. Unlock_Data(OldMouseX,SizeOf(longint));
  406. Unlock_Data(OldMouseY,SizeOf(longint));
  407. {$ifdef DEBUG}
  408. Unlock_Data(EntryEDI, SizeOf(longint));
  409. Unlock_Data(EntryESI, SizeOf(longint));
  410. Unlock_Data(EntryDS, SizeOf(word));
  411. Unlock_Data(EntryES, SizeOf(word));
  412. Unlock_Data(MouseError, SizeOf(longint));
  413. Unlock_Data(callcounter, SizeOf(longint));
  414. {$endif DEBUG}
  415. Release_mouse_bridge;
  416. end;
  417. function RunningUnderWINNT: boolean;
  418. var r: trealregs;
  419. begin
  420. fillchar(r,sizeof(r),0);
  421. r.ax:=$3306;
  422. realintr($21,r);
  423. RunningUnderWINNT:=(r.bx=$3205);
  424. end;
  425. procedure SysInitMouse;
  426. begin
  427. UnderNT:=RunningUnderWINNT;
  428. if not MousePresent then
  429. begin
  430. if DetectMouse=0 then
  431. begin
  432. if First_try then
  433. begin
  434. Writeln('No mouse driver found ');
  435. First_try:=false;
  436. end;
  437. exit;
  438. end
  439. else
  440. MousePresent:=true;
  441. end;
  442. { don't do this twice !! PM }
  443. If not FirstMouseInitDone then
  444. begin
  445. StoredExit:=ExitProc;
  446. ExitProc:=@MouseSafeExit;
  447. Lock_Code(Pointer(@Mouse_Trap), 400); { Lock trap code }
  448. Lock_Code(Pointer(@Mouse_Trap_NT), 400); { Lock trap code }
  449. Lock_Code(Pointer(@MouseInt), 400); { Lock MouseInt code }
  450. Lock_Data(ActionRegs, SizeOf(TRealRegs)); { Lock registers }
  451. Lock_Data(MouseCallBack, SizeOf(pointer));
  452. { lock Mouse Queue and related stuff ! }
  453. Lock_Data(PendingMouseEvent,
  454. MouseEventBufSize*Sizeof(TMouseEvent));
  455. Lock_Data(PendingMouseTail,SizeOf(longint));
  456. Lock_Data(PendingMouseEvents,sizeof(byte));
  457. Lock_Data(MouseButtons,SizeOf(byte));
  458. Lock_Data(MouseWhereX,SizeOf(word));
  459. Lock_Data(MouseWhereY,SizeOf(word));
  460. Lock_Data(drawmousecursor,SizeOf(boolean));
  461. Lock_Data(mouseisvisible,SizeOf(boolean));
  462. Lock_Data(mouselock,SizeOf(boolean));
  463. Lock_Data(videoseg,SizeOf(word));
  464. Lock_Data(dosmemselector,SizeOf(word));
  465. Lock_Data(screenwidth,SizeOf(word));
  466. Lock_Data(OldMouseX,SizeOf(longint));
  467. Lock_Data(OldMouseY,SizeOf(longint));
  468. {$ifdef DEBUG}
  469. Lock_Data(EntryEDI, SizeOf(longint));
  470. Lock_Data(EntryESI, SizeOf(longint));
  471. Lock_Data(EntryDS, SizeOf(word));
  472. Lock_Data(EntryES, SizeOf(word));
  473. Lock_Data(MouseError, SizeOf(longint));
  474. Lock_Data(callcounter, SizeOf(longint));
  475. {$endif DEBUG}
  476. Allocate_mouse_bridge;
  477. FirstMouseInitDone:=true;
  478. end;
  479. If MouseCallBack=Nil then
  480. Mouse_Action($ffff, @MouseInt); { Set masks/interrupt }
  481. drawmousecursor:=false;
  482. mouseisvisible:=false;
  483. if (screenwidth>80) or (screenheight>50) then
  484. DoCustomMouse(true);
  485. ShowMouse;
  486. end;
  487. procedure SysDoneMouse;
  488. begin
  489. HideMouse;
  490. If (MouseCallBack <> Nil) Then
  491. Mouse_Action(0, Nil); { Clear mask/interrupt }
  492. end;
  493. function SysDetectMouse:byte;assembler;
  494. asm
  495. movl $0x200,%eax
  496. movl $0x33,%ebx
  497. int $0x31
  498. movw %cx,%ax
  499. orw %ax,%dx
  500. jz .Lno_mouse
  501. xorl %eax,%eax
  502. pushl %ebp
  503. int $0x33
  504. popl %ebp
  505. orw %ax,%ax
  506. jz .Lno_mouse
  507. movl %ebx,%eax
  508. .Lno_mouse:
  509. end;
  510. procedure SysShowMouse;
  511. begin
  512. if drawmousecursor then
  513. begin
  514. lockmouse;
  515. if not(mouseisvisible) then
  516. begin
  517. oldmousex:=getmousex-1;
  518. oldmousey:=getmousey-1;
  519. mem[videoseg:(((screenwidth*oldmousey)+oldmousex)*2)+1]:=
  520. mem[videoseg:(((screenwidth*oldmousey)+oldmousex)*2)+1] xor $7f;
  521. mouseisvisible:=true;
  522. end;
  523. unlockmouse;
  524. end
  525. else
  526. asm
  527. cmpb $1,MousePresent
  528. jne .LShowMouseExit
  529. movl $1,%eax
  530. pushl %ebp
  531. int $0x33
  532. popl %ebp
  533. .LShowMouseExit:
  534. end;
  535. end;
  536. procedure SysHideMouse;
  537. begin
  538. if drawmousecursor then
  539. begin
  540. lockmouse;
  541. if mouseisvisible then
  542. begin
  543. mouseisvisible:=false;
  544. mem[videoseg:(((screenwidth*oldmousey)+oldmousex)*2)+1]:=
  545. mem[videoseg:(((screenwidth*oldmousey)+oldmousex)*2)+1] xor $7f;
  546. oldmousex:=-1;
  547. oldmousey:=-1;
  548. end;
  549. unlockmouse;
  550. end
  551. else
  552. asm
  553. cmpb $1,MousePresent
  554. jne .LHideMouseExit
  555. movl $2,%eax
  556. pushl %ebp
  557. int $0x33
  558. popl %ebp
  559. .LHideMouseExit:
  560. end;
  561. end;
  562. function SysGetMouseX:word;assembler;
  563. asm
  564. cmpb $1,MousePresent
  565. jne .LGetMouseXError
  566. movl $3,%eax
  567. pushl %ebp
  568. int $0x33
  569. popl %ebp
  570. movzwl %cx,%eax
  571. shrl $3,%eax
  572. incl %eax
  573. ret
  574. .LGetMouseXError:
  575. xorl %eax,%eax
  576. end;
  577. function SysGetMouseY:word;assembler;
  578. asm
  579. cmpb $1,MousePresent
  580. jne .LGetMouseYError
  581. movl $3,%eax
  582. pushl %ebp
  583. int $0x33
  584. popl %ebp
  585. movzwl %dx,%eax
  586. shrl $3,%eax
  587. incl %eax
  588. ret
  589. .LGetMouseYError:
  590. xorl %eax,%eax
  591. end;
  592. function SysGetMouseButtons:word;assembler;
  593. asm
  594. cmpb $1,MousePresent
  595. jne .LGetMouseButtonsError
  596. movl $3,%eax
  597. pushl %ebp
  598. int $0x33
  599. popl %ebp
  600. movw %bx,%ax
  601. ret
  602. .LGetMouseButtonsError:
  603. xorl %eax,%eax
  604. end;
  605. procedure SysSetMouseXY(x,y:word);assembler;
  606. asm
  607. cmpb $1,MousePresent
  608. jne .LSetMouseXYExit
  609. movw x,%cx
  610. movw y,%dx
  611. movl $4,%eax
  612. pushl %ebp
  613. int $0x33
  614. popl %ebp
  615. .LSetMouseXYExit:
  616. end;
  617. Procedure SetMouseXRange (Min,Max:Longint);
  618. begin
  619. If Not(MousePresent) Then Exit;
  620. asm
  621. movl $7,%eax
  622. movl min,%ecx
  623. movl max,%edx
  624. pushl %ebp
  625. int $0x33
  626. popl %ebp
  627. end;
  628. end;
  629. Procedure SetMouseYRange (min,max:Longint);
  630. begin
  631. If Not(MousePresent) Then Exit;
  632. asm
  633. movl $8,%eax
  634. movl min,%ecx
  635. movl max,%edx
  636. pushl %ebp
  637. int $0x33
  638. popl %ebp
  639. end;
  640. end;
  641. procedure DoCustomMouse(b : boolean);
  642. begin
  643. HideMouse;
  644. lockmouse;
  645. oldmousex:=-1;
  646. oldmousey:=-1;
  647. SetMouseXRange(0,(screenwidth-1)*8);
  648. SetMouseYRange(0,(screenheight-1)*8);
  649. if b then
  650. begin
  651. mouseisvisible:=false;
  652. drawmousecursor:=true;
  653. end
  654. else
  655. drawmousecursor:=false;
  656. unlockmouse;
  657. end;
  658. const
  659. LastCallcounter : longint = 0;
  660. procedure SysGetMouseEvent(var MouseEvent: TMouseEvent);
  661. begin
  662. if not MousePresent then
  663. begin
  664. Fillchar(MouseEvent,SizeOf(TMouseEvent),#0);
  665. end;
  666. {$ifdef DEBUG}
  667. if mouseError>0 then
  668. Writeln('Errors in mouse Handler ',MouseError);
  669. {$ifdef EXTMOUSEDEBUG}
  670. if callcounter>LastCallcounter then
  671. Writeln('Number of calls in mouse Handler ',Callcounter);
  672. {$endif EXTMOUSEDEBUG}
  673. LastCallcounter:=Callcounter;
  674. {$endif DEBUG}
  675. repeat until PendingMouseEvents>0;
  676. MouseEvent:=PendingMouseHead^;
  677. inc(PendingMouseHead);
  678. if longint(PendingMouseHead)=longint(@PendingMouseEvent)+sizeof(PendingMouseEvent) then
  679. PendingMouseHead:=@PendingMouseEvent;
  680. dec(PendingMouseEvents);
  681. if (LastMouseEvent.x<>MouseEvent.x) or (LastMouseEvent.y<>MouseEvent.y) then
  682. MouseEvent.Action:=MouseActionMove;
  683. if (LastMouseEvent.Buttons<>MouseEvent.Buttons) then
  684. begin
  685. if (LastMouseEvent.Buttons=0) then
  686. MouseEvent.Action:=MouseActionDown
  687. else
  688. MouseEvent.Action:=MouseActionUp;
  689. end;
  690. LastMouseEvent:=MouseEvent;
  691. end;
  692. Const
  693. SysMouseDriver : TMouseDriver = (
  694. useDefaultQueue : true;
  695. InitDriver : @SysInitMouse;
  696. DoneDriver : @SysDoneMouse;
  697. DetectMouse : @SysDetectMouse;
  698. ShowMouse : @SysShowMouse;
  699. HideMouse : @SysHideMouse;
  700. GetMouseX : @SysGetMouseX;
  701. GetMouseY : @SysGetMouseY;
  702. GetMouseButtons : @SysGetMouseButtons;
  703. SetMouseXY : @SysSetMouseXY;
  704. GetMouseEvent : @SysGetMouseEvent;
  705. PollMouseEvent : Nil;
  706. PutMouseEvent : Nil;
  707. );
  708. Begin
  709. SetMouseDriver(SysMouseDriver);
  710. end.
  711. {
  712. $Log$
  713. Revision 1.7 2002-09-07 16:01:18 peter
  714. * old logs removed and tabs fixed
  715. Revision 1.6 2002/05/09 08:42:24 carl
  716. * Merges from Fixes branch
  717. Revision 1.1.2.6 2002/04/12 12:01:48 pierre
  718. * fix bug report 1701
  719. Revision 1.1.2.5 2002/01/08 16:34:52 pierre
  720. a working callback for XP
  721. }