mouse.pp 23 KB

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