diff --git a/.gitattributes b/.gitattributes index 5cda7cd5e1..0a6b8d666b 100644 --- a/.gitattributes +++ b/.gitattributes @@ -7247,6 +7247,8 @@ packages/rtl-console/src/inc/video.inc svneol=native#text/plain packages/rtl-console/src/inc/videoh.inc svneol=native#text/plain packages/rtl-console/src/msdos/crt.pp svneol=native#text/plain packages/rtl-console/src/msdos/keyboard.pp svneol=native#text/plain +packages/rtl-console/src/msdos/mouse.pp svneol=native#text/plain +packages/rtl-console/src/msdos/video.pp svneol=native#text/plain packages/rtl-console/src/netware/crt.pp svneol=native#text/plain packages/rtl-console/src/netware/keyboard.pp svneol=native#text/plain packages/rtl-console/src/netware/mouse.pp svneol=native#text/plain diff --git a/packages/rtl-console/fpmake.pp b/packages/rtl-console/fpmake.pp index 528aa04d3a..1ad57528be 100644 --- a/packages/rtl-console/fpmake.pp +++ b/packages/rtl-console/fpmake.pp @@ -13,11 +13,11 @@ Const UnixLikes = AllUnixOSes -[QNX]; WinEventOSes = [win32,win64]; - KVMAll = [emx,go32v2,netware,netwlibc,os2,win32,win64,win16]+UnixLikes+AllAmigaLikeOSes; + KVMAll = [emx,go32v2,msdos,netware,netwlibc,os2,win32,win64,win16]+UnixLikes+AllAmigaLikeOSes; // all full KVMers have crt too, except Amigalikes - CrtOSes = KVMALL+[msdos,WatCom]-[aros,morphos,amiga]; - KbdOSes = KVMALL+[msdos]; + CrtOSes = KVMALL+[WatCom]-[aros,morphos,amiga]; + KbdOSes = KVMALL; VideoOSes = KVMALL; MouseOSes = KVMALL; TerminfoOSes = UnixLikes-[beos,haiku]; @@ -84,6 +84,7 @@ begin AddInclude('mouseh.inc'); AddInclude('mouse.inc'); AddUnit ('winevent',[win32,win64]); + AddUnit ('video',[go32v2,msdos]); end; T:=P.Targets.AddUnit('video.pp',VideoOSes); @@ -94,6 +95,7 @@ begin AddInclude('videodata.inc',AllAmigaLikeOSes); AddInclude('convert.inc',AllUnixOSes); AddInclude('nwsys.inc',[netware]); + AddUnit ('mouse',[go32v2,msdos]); end; T:=P.Targets.AddUnit('crt.pp',CrtOSes); diff --git a/packages/rtl-console/src/msdos/mouse.pp b/packages/rtl-console/src/msdos/mouse.pp new file mode 100644 index 0000000000..138b3c4e96 --- /dev/null +++ b/packages/rtl-console/src/msdos/mouse.pp @@ -0,0 +1,561 @@ +{ + This file is part of the Free Pascal run time library. + Copyright (c) 1999-2000 by Florian Klaempfl + member of the Free Pascal development team + + Mouse unit for MS-DOS + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} +unit Mouse; +interface + +{$i mouseh.inc} + +{ tells the mouse unit to draw the mouse cursor itself } +procedure DoCustomMouse(b : boolean); + +implementation + +uses + video,dos; + +{$i mouse.inc} + + +var + CurrentMask : word; + MouseCallback : CodePointer; { Mouse call back ptr } +const + { indicates whether the mouse cursor is visible when the mouse cursor is + drawn by this unit (i.e. drawmousecursor=true) } + CustomMouse_MouseIsVisible: boolean = false; + MousePresent : boolean = false; + First_try : boolean = true; + drawmousecursor : boolean = false; + + { CustomMouse_HideCount holds the hide count for the custom drawn mouse + cursor. Normally, when the mouse cursor is drawn by the int 33h mouse + driver (and not by this unit), the driver internally maintains a 'hide + counter', so that if you call HideMouse multiple times, you need to call + ShowMouse the same number of times. When the mouse cursor is customly + drawn by this unit, we use this variable in order to maintain the same + behaviour. } + CustomMouse_HideCount: smallint = 1; + + { position where the mouse was drawn the last time } + oldmousex : smallint = -1; + oldmousey : smallint = -1; + mouselock : boolean = false; + +{ if the cursor is drawn by this the unit, we must be careful } +{ when drawing while the interrupt handler is called } +procedure lockmouse;assembler; + + asm + @@trylockagain: + mov al,1 + xchg al,mouselock + or al,al + jne @@trylockagain + end; + +procedure unlockmouse; + + begin + mouselock:=false; + end; + + +procedure MouseInt;assembler; +asm + push ds + push es + push di + push cx + push dx +{$ifdef FPC_MM_TINY} + push cs + pop ds +{$else} + mov di, SEG @DATA + mov ds, di +{$endif} + mov mousebuttons,bl + mov mousewherex,cx + mov mousewherey,dx + shr cx,1 + shr cx,1 + shr cx,1 + shr dx,1 + shr dx,1 + shr dx,1 +{$ifdef FPC_MM_HUGE} + mov di, SEG ScreenWidth + mov es, di + cmp es:[ScreenWidth], 40 +{$else} + cmp ScreenWidth, 40 +{$endif} + jne @@morethan40cols + shr cx,1 +@@morethan40cols: + { should we draw the mouse cursor? } + cmp drawmousecursor, 0 + je @@mouse_nocursor + cmp CustomMouse_MouseIsVisible, 0 + je @@mouse_nocursor + push ax + push bx +{$ifdef FPC_MM_HUGE} + push si +{$endif} + { check lock } + mov al, 1 + xchg al, mouselock + or al, al + { don't update the cursor yet, because hide/showcursor is called } + jne @@dont_draw + + { calculate address of old mouse cursor } + mov ax, oldmousey +{$ifdef FPC_MM_HUGE} + { ES still points to the data segment of unit 'video' } + mov si, es:[screenwidth] + imul si +{$else} + imul screenwidth +{$endif} + add ax, oldmousex + shl ax, 1 + xchg ax, bx + { load start of video buffer } +{$ifdef FPC_MM_HUGE} + { ES still points to the data segment of unit 'video' } + mov di, es:[videoseg] +{$else} + mov di, videoseg +{$endif} + mov es, di + { remove old cursor } + xor byte ptr es:[bx], 7fh + + { store position of old cursor } + mov oldmousex, cx + mov oldmousey, dx + + { calculate address of new cursor } + mov ax, dx +{$ifdef FPC_MM_HUGE} + imul si +{$else} + imul screenwidth +{$endif} + add ax, cx + shl ax, 1 + xchg ax, bx + { draw new cursor } + xor byte ptr es:[bx], 7fh + + { unlock mouse } + mov mouselock, 0 + +@@dont_draw: +{$ifdef FPC_MM_HUGE} + pop si +{$endif} + pop bx + pop ax +@@mouse_nocursor: + cmp PendingMouseEvents, MouseEventBufSize + je @@mouse_exit +{$if defined(FPC_MM_COMPACT) or defined(FPC_MM_LARGE) or defined(FPC_MM_HUGE)} + les di, [PendingMouseTail] + mov word ptr es:[di], bx + mov word ptr es:[di+2], cx + mov word ptr es:[di+4], dx + mov word ptr es:[di+6], 0 +{$else} + mov di, PendingMouseTail + mov word ptr [di], bx + mov word ptr [di+2], cx + mov word ptr [di+4], dx + mov word ptr [di+6], 0 +{$endif} + add di, 8 + lea ax, PendingMouseEvent + add ax, MouseEventBufSize*8 + cmp di, ax + jne @@mouse_nowrap + lea di, PendingMouseEvent +@@mouse_nowrap: + mov word ptr PendingMouseTail, di + inc PendingMouseEvents +@@mouse_exit: + pop dx + pop cx + pop di + pop es + pop ds + retf +end; + +PROCEDURE Mouse_Action (Mask : Word; P : CodePointer); +VAR + Rg : Registers; +BEGIN + if (P <> MouseCallBack) or (Mask<>CurrentMask) then { Check func different } + begin + { Remove old calback } + if (CurrentMask <> 0) then + begin + Rg.AX := 12; { Function id } + Rg.CX := 0; { Zero mask register } + Rg.ES := 0; { Zero proc seg } + Rg.DX := 0; { Zero proc ofs } + Intr($33, Rg); { Stop INT 33 callback } + end; + if P = nil then + Mask := 0; { Zero mask register } + MouseCallback := P; { Set call back addr } + if Mask<>0 then + begin + Rg.AX := 12; { Set function id } + Rg.CX := Mask; { Set mask register } + If Mask<>0 then + begin + Rg.ES := Seg(P^); + Rg.DX := Ofs(P^); + end + else + begin + Rg.ES:=0; + Rg.DX:=0; + end; + Intr($33, Rg); { Set interrupt 33 } + end; + CurrentMask:=Mask; + end; +END; + + +{ We need to remove the mouse callback before exiting !! PM } + +const StoredExit : CodePointer = Nil; + FirstMouseInitDone : boolean = false; + +procedure MouseSafeExit; +begin + ExitProc:=StoredExit; + if MouseCallBack<>Nil then + Mouse_Action(0, Nil); + if not FirstMouseInitDone then + exit; + FirstMouseInitDone:=false; +end; + +procedure SysInitMouse; +begin + if not MousePresent then + begin + if DetectMouse=0 then + begin + if First_try then + begin + Writeln('No mouse driver found '); + First_try:=false; + end; + exit; + end + else + MousePresent:=true; + end; + { don't do this twice !! PM } + + If not FirstMouseInitDone then + begin + StoredExit:=ExitProc; + ExitProc:=@MouseSafeExit; + FirstMouseInitDone:=true; + end; + If MouseCallBack=Nil then + Mouse_Action($ffff, @MouseInt); { Set masks/interrupt } + drawmousecursor:=false; + CustomMouse_MouseIsVisible:=false; + if (screenwidth>80) or (screenheight>50) then + DoCustomMouse(true); + ShowMouse; +end; + + +procedure SysDoneMouse; +begin + HideMouse; + If (MouseCallBack <> Nil) Then + Mouse_Action(0, Nil); { Clear mask/interrupt } +end; + + +function SysDetectMouse:byte;assembler; +asm + xor ax, ax + mov es, ax + mov di, es:[4*33h] + or di, es:[4*33h+2] + jz @@no_mouse + + push bp + int 33h + pop bp + or ax, ax + jz @@no_mouse + mov ax, bx +@@no_mouse: +end; + + +procedure SysShowMouse; + +begin + if drawmousecursor then + begin + lockmouse; + if CustomMouse_HideCount>0 then + Dec(CustomMouse_HideCount); + if (CustomMouse_HideCount=0) and not(CustomMouse_MouseIsVisible) then + begin + oldmousex:=getmousex-1; + oldmousey:=getmousey-1; + mem[videoseg:(((screenwidth*oldmousey)+oldmousex)*2)+1]:= + mem[videoseg:(((screenwidth*oldmousey)+oldmousex)*2)+1] xor $7f; + CustomMouse_MouseIsVisible:=true; + end; + unlockmouse; + end + else + asm + cmp MousePresent, 1 + jne @@ShowMouseExit + mov ax, 1 + push bp + int 33h + pop bp + @@ShowMouseExit: + end; +end; + + +procedure SysHideMouse; + +begin + if drawmousecursor then + begin + lockmouse; + Inc(CustomMouse_HideCount); + if CustomMouse_MouseIsVisible then + begin + CustomMouse_MouseIsVisible:=false; + mem[videoseg:(((screenwidth*oldmousey)+oldmousex)*2)+1]:= + mem[videoseg:(((screenwidth*oldmousey)+oldmousex)*2)+1] xor $7f; + oldmousex:=-1; + oldmousey:=-1; + end; + unlockmouse; + end + else + asm + cmp MousePresent, 1 + jne @@HideMouseExit + mov ax, 2 + push bp + int 33h + pop bp + @@HideMouseExit: + end; +end; + + +function SysGetMouseX:word;assembler; +asm + cmp MousePresent, 1 + jne @@GetMouseXError + mov ax, 3 + push bp + int 33h + pop bp + xchg ax, cx + shr ax, 1 + shr ax, 1 + shr ax, 1 +{$ifdef FPC_MM_HUGE} + mov bx, SEG ScreenWidth + mov es, bx + cmp es:[ScreenWidth], 40 +{$else} + cmp ScreenWidth, 40 +{$endif} + jne @@morethan40cols + shr ax, 1 +@@morethan40cols: + inc ax + jmp @@exit +@@GetMouseXError: + xor ax, ax +@@exit: +end; + + +function SysGetMouseY:word;assembler; +asm + cmp MousePresent, 1 + jne @@GetMouseYError + mov ax, 3 + push bp + int 33h + pop bp + xchg ax, dx + shr ax, 1 + shr ax, 1 + shr ax, 1 + inc ax + jmp @@exit +@@GetMouseYError: + xor ax, ax +@@exit: +end; + + +function SysGetMouseButtons:word;assembler; +asm + cmp MousePresent, 1 + jne @@GetMouseButtonsError + mov ax, 3 + push bp + int 33h + pop bp + xchg ax, bx + jmp @@exit +@@GetMouseButtonsError: + xor ax, ax +@@exit: +end; + + +procedure SysSetMouseXY(x,y:word);assembler; +asm + cmp MousePresent, 1 + jne @@SetMouseXYExit + mov cx, x + mov dx, y + mov ax, 4 + push bp + int 33h + pop bp +@@SetMouseXYExit: +end; + +Procedure SetMouseXRange (Min,Max:Longint); +begin + If Not(MousePresent) Then Exit; + asm + mov ax, 7 + mov cx, min + mov dx, max + push bp + int 33h + pop bp + end; +end; + +Procedure SetMouseYRange (min,max:Longint); +begin + If Not(MousePresent) Then Exit; + asm + mov ax, 8 + mov cx, min + mov dx, max + push bp + int 33h + pop bp + end; +end; + +procedure DoCustomMouse(b : boolean); + + begin + lockmouse; + CustomMouse_HideCount:=1; + oldmousex:=-1; + oldmousey:=-1; + if ScreenWidth=40 then + SetMouseXRange(0,(screenwidth-1)*16) + else + SetMouseXRange(0,(screenwidth-1)*8); + SetMouseYRange(0,(screenheight-1)*8); + if b then + begin + CustomMouse_MouseIsVisible:=false; + drawmousecursor:=true; + end + else + drawmousecursor:=false; + unlockmouse; + end; + +procedure SysGetMouseEvent(var MouseEvent: TMouseEvent); +var + RR: Registers; +begin + if not MousePresent then + begin + Fillchar(MouseEvent,SizeOf(TMouseEvent),#0); + end; + while PendingMouseEvents = 0 do + begin +(* Give up time slices while waiting for mouse events. *) + Intr ($28, RR); + end; + MouseEvent:=PendingMouseHead^; + inc(PendingMouseHead); + if PendingMouseHead=@PendingMouseEvent[0]+MouseEventBufsize then + PendingMouseHead:=@PendingMouseEvent[0]; + dec(PendingMouseEvents); + if (LastMouseEvent.x<>MouseEvent.x) or (LastMouseEvent.y<>MouseEvent.y) then + MouseEvent.Action:=MouseActionMove; + if (LastMouseEvent.Buttons<>MouseEvent.Buttons) then + begin + if (LastMouseEvent.Buttons and MouseEvent.buttons<>LastMouseEvent.Buttons) then + MouseEvent.Action:=MouseActionUp + else + MouseEvent.Action:=MouseActionDown; + end; + LastMouseEvent:=MouseEvent; +end; + + +Const + SysMouseDriver : TMouseDriver = ( + useDefaultQueue : true; + InitDriver : @SysInitMouse; + DoneDriver : @SysDoneMouse; + DetectMouse : @SysDetectMouse; + ShowMouse : @SysShowMouse; + HideMouse : @SysHideMouse; + GetMouseX : @SysGetMouseX; + GetMouseY : @SysGetMouseY; + GetMouseButtons : @SysGetMouseButtons; + SetMouseXY : @SysSetMouseXY; + GetMouseEvent : @SysGetMouseEvent; + PollMouseEvent : Nil; + PutMouseEvent : Nil; + ); + +Begin + SetMouseDriver(SysMouseDriver); +end. diff --git a/packages/rtl-console/src/msdos/video.pp b/packages/rtl-console/src/msdos/video.pp new file mode 100644 index 0000000000..aa7eef1e60 --- /dev/null +++ b/packages/rtl-console/src/msdos/video.pp @@ -0,0 +1,296 @@ +{ + This file is part of the Free Pascal run time library. + Copyright (c) 1999-2000 by Florian Klaempfl + member of the Free Pascal development team + + Video unit for MS-DOS + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} +unit Video; + +interface + +{$i videoh.inc} + +var + VideoSeg : word; + + +implementation + +uses + mouse, + dos; + +{$i video.inc} + + { used to know if LastCursorType is valid } +const + LastCursorType : word = crUnderline; + +{ allways set blink state again } + +procedure SetHighBitBlink; +var + regs : registers; +begin + regs.ax:=$1003; + regs.bx:=$0001; + intr($10,regs); +end; + +function BIOSGetScreenMode(var Cols,Rows: word; var Color: boolean): boolean; +var + r: registers; + B: array[0..63] of byte; + OK: boolean; +begin + r.ah:=$1b; r.bx:=0; + r.es:=Seg(B); r.di:=Ofs(B); + intr($10,r); + OK:=(r.al=$1b); + if OK then + begin + Cols:=PWord(@B[5])^; Rows:=B[$22]; + Color:=PWord(@B[$27])^<>0; + end; + BIOSGetScreenMode:=OK; +end; + +procedure SysInitVideo; +var + regs : registers; +begin + VideoSeg:=SegB800; + if (ScreenWidth=$ffff) or (ScreenHeight=$ffff) or + (ScreenWidth=0) or (ScreenHeight=0) then + begin + ScreenColor:=true; + regs.ah:=$0f; + intr($10,regs); + if (regs.al and 1)=0 then + ScreenColor:=false; + if regs.al=7 then + begin + ScreenColor:=false; + VideoSeg:=SegB000; + end + else + VideoSeg:=SegB800; + ScreenWidth:=regs.ah; + regs.ax:=$1130; + regs.bx:=0; + intr($10,regs); + ScreenHeight:=regs.dl+1; + BIOSGetScreenMode(ScreenWidth,ScreenHeight,ScreenColor); + end; + regs.ah:=$03; + regs.bh:=0; + intr($10,regs); + CursorLines:=regs.cl; + CursorX:=regs.dl; + CursorY:=regs.dh; + SetHighBitBlink; + SetCursorType(LastCursorType); +end; + + +procedure SysDoneVideo; +begin + LastCursorType:=GetCursorType; + ClearScreen; + SetCursorType(crUnderLine); + SetCursorPos(0,0); +end; + + +function SysGetCapabilities: Word; +begin + SysGetCapabilities := $3F; +end; + + +procedure SysSetCursorPos(NewCursorX, NewCursorY: Word); +var + regs : registers; +begin + regs.ah:=$02; + regs.bh:=0; + regs.dh:=NewCursorY; + regs.dl:=NewCursorX; + intr($10,regs); + CursorY:=regs.dh; + CursorX:=regs.dl; +end; + +{ I don't know the maximum value for the scan line + probably 7 or 15 depending on resolution !! + } +function SysGetCursorType: Word; +var + regs : registers; +begin + regs.ah:=$03; + regs.bh:=0; + intr($10,regs); + SysGetCursorType:=crHidden; + if (regs.ch and $60)=0 then + begin + SysGetCursorType:=crBlock; + if (regs.ch and $1f)<>0 then + begin + SysGetCursorType:=crHalfBlock; + if regs.cl-1=(regs.ch and $1F) then + SysGetCursorType:=crUnderline; + end; + end; +end; + + +procedure SysSetCursorType(NewType: Word); +var + regs : registers; +const + MaxCursorLines = 7; +begin + regs.ah:=$01; + regs.bx:=NewType; + case NewType of + crHidden : regs.cx:=$2000; + crHalfBlock : begin + regs.ch:=MaxCursorLines shr 1; + regs.cl:=MaxCursorLines; + end; + crBlock : begin + regs.ch:=0; + regs.cl:=MaxCursorLines; + end; + else begin + regs.ch:=MaxCursorLines-1; + regs.cl:=MaxCursorLines; + end; + end; + intr($10,regs); +end; + +procedure SysUpdateScreen(Force: Boolean); +begin + HideMouse; + if not force then + force:=CompareByte(VideoBuf^,OldVideoBuf^,VideoBufSize)<>0; + if Force then + begin + movedata(Seg(videobuf^),Ofs(videobuf^),videoseg,0,VideoBufSize); + move(videobuf^,oldvideobuf^,VideoBufSize); + end; + ShowMouse; +end; + +Procedure DoSetVideoMode(Params: Longint); + +type + wordrec=packed record + lo,hi : word; + end; +var + regs : registers; +begin + regs.ax:=wordrec(Params).lo; + regs.bx:=wordrec(Params).hi; + intr($10,regs); +end; + +Procedure SetVideo8x8; + +type + wordrec=packed record + lo,hi : word; + end; +var + regs : registers; +begin + regs.ax:=3; + regs.bx:=0; + intr($10,regs); + regs.ax:=$1112; + regs.bx:=$0; + intr($10,regs); +end; + +Const + SysVideoModeCount = 5; + SysVMD : Array[0..SysVideoModeCount-1] of TVideoMode = ( + (Col: 40; Row : 25; Color : False), + (Col: 40; Row : 25; Color : True), + (Col: 80; Row : 25; Color : False), + (Col: 80; Row : 25; Color : True), + (Col: 80; Row : 50; Color : True) + ); + +Function SysSetVideoMode (Const Mode : TVideoMode) : Boolean; + +Var + I : Integer; + +begin + I:=SysVideoModeCount-1; + SysSetVideoMode:=False; + While (I>=0) and Not SysSetVideoMode do + If (Mode.col=SysVMD[i].col) and + (Mode.Row=SysVMD[i].Row) and + (Mode.Color=SysVMD[i].Color) then + SysSetVideoMode:=True + else + Dec(I); + If SysSetVideoMode then + begin + If (I