mouse.pp 24 KB

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