mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-09 22:48:57 +02:00
+ Huge video unit rework for Amiga/MorphOS
* removed tons of Win32 unit leftovers, and other cleanups * cursor handling fixes, additions (like changing cursor shapes) * added initial support for sysmsgs git-svn-id: trunk@11982 -
This commit is contained in:
Károly Balogh
parent
42871abdeb
commit
423aca9d63
@ -22,9 +22,16 @@ uses
|
||||
|
||||
{$i videoh.inc}
|
||||
|
||||
|
||||
{ Amiga specific calls, to help interaction between Keyboard, Mouse and
|
||||
Video units, and Free Vision }
|
||||
procedure GotCloseWindow;
|
||||
function HasCloseWindow: boolean;
|
||||
|
||||
var
|
||||
videoWindow : pWindow;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
@ -45,57 +52,36 @@ var
|
||||
videoPens : array[0..15] of longint;
|
||||
|
||||
oldCursorX, oldCursorY: longint;
|
||||
visibleCursor: boolean;
|
||||
oldvisibleCursor: boolean;
|
||||
cursorType: word;
|
||||
oldcursorType: word;
|
||||
|
||||
gotCloseWindowMsg: boolean;
|
||||
|
||||
procedure SysInitVideo;
|
||||
var counter: longint;
|
||||
begin
|
||||
// writeln('sysinitvideo');
|
||||
InitGraphicsLibrary;
|
||||
InitIntuitionLibrary;
|
||||
{
|
||||
ScreenColor:=true;
|
||||
GetConsoleScreenBufferInfo(TextRec(Output).Handle, OrigConsoleInfo);
|
||||
GetConsoleCursorInfo(TextRec(Output).Handle, OrigConsoleCursorInfo);
|
||||
OrigCP := GetConsoleCP;
|
||||
ConsoleInfo:=OrigConsoleInfo;
|
||||
ConsoleCursorInfo:=OrigConsoleCursorInfo;
|
||||
{
|
||||
About the ConsoleCursorInfo record: There are 3 possible
|
||||
structures in it that can be regarded as the 'screen':
|
||||
- dwsize : contains the cols & row in current screen buffer.
|
||||
- srwindow : Coordinates (relative to buffer) of upper left
|
||||
& lower right corners of visible console.
|
||||
- dmMaximumWindowSize : Maximal size of Screen buffer.
|
||||
The first implementation of video used srWindow. After some
|
||||
bug-reports, this was switched to dwMaximumWindowSize.
|
||||
}
|
||||
with ConsoleInfo.dwMaximumWindowSize do
|
||||
begin
|
||||
ScreenWidth:=X;
|
||||
ScreenHeight:=Y;
|
||||
end;
|
||||
{ TDrawBuffer only has FVMaxWidth elements
|
||||
larger values lead to crashes }
|
||||
if ScreenWidth> FVMaxWidth then
|
||||
ScreenWidth:=FVMaxWidth;
|
||||
CursorX:=ConsoleInfo.dwCursorPosition.x;
|
||||
CursorY:=ConsoleInfo.dwCursorPosition.y;
|
||||
if not ConsoleCursorInfo.bvisible then
|
||||
CursorLines:=0
|
||||
else
|
||||
CursorLines:=ConsoleCursorInfo.dwSize;
|
||||
}
|
||||
|
||||
// fill videobuf and oldvideobuf with different bytes, to allow proper first draw
|
||||
FillDword(VideoBuf^,VideoBufSize Div 4,$1234D3AD);
|
||||
FillDword(OldVideoBuf^,VideoBufSize Div 4,$4321BEEF);
|
||||
|
||||
videoWindow:=OpenWindowTags(Nil, [
|
||||
WA_Left,50,
|
||||
WA_Top,50,
|
||||
WA_InnerWidth,80*8,
|
||||
WA_InnerHeight,25*16,
|
||||
WA_MaxWidth,32768,
|
||||
WA_MaxHeight,32768,
|
||||
// WA_IDCMP,IDCMP_MOUSEBUTTONS Or IDCMP_RAWKEYS,
|
||||
WA_IDCMP,IDCMP_VANILLAKEY Or IDCMP_RAWKEY,
|
||||
WA_IDCMP,IDCMP_VANILLAKEY Or IDCMP_RAWKEY Or
|
||||
IDCMP_CLOSEWINDOW,
|
||||
WA_Title,DWord(PChar('Free Pascal Video Output')),
|
||||
WA_Flags,(WFLG_GIMMEZEROZERO Or WFLG_SMART_REFRESH Or WFLG_NOCAREREFRESH Or WFLG_ACTIVATE Or WFLG_DRAGBAR Or WFLG_DEPTHGADGET)
|
||||
WA_Flags,(WFLG_GIMMEZEROZERO Or WFLG_SMART_REFRESH Or WFLG_NOCAREREFRESH Or
|
||||
WFLG_ACTIVATE Or WFLG_DRAGBAR Or WFLG_DEPTHGADGET Or
|
||||
// WFLG_SIZEGADGET Or WFLG_SIZEBBOTTOM Or
|
||||
WFLG_CLOSEGADGET)
|
||||
]);
|
||||
|
||||
ScreenWidth := 80;
|
||||
@ -115,8 +101,10 @@ begin
|
||||
CursorY:=0;
|
||||
oldCursorX:=0;
|
||||
oldCursorY:=0;
|
||||
visibleCursor:=true;
|
||||
oldvisibleCursor:=true;
|
||||
cursorType:=crHidden;
|
||||
oldcursorType:=crHidden;
|
||||
|
||||
gotCloseWindowMsg:=false;
|
||||
end;
|
||||
|
||||
|
||||
@ -125,101 +113,18 @@ var counter: longint;
|
||||
begin
|
||||
if videoWindow<>nil then CloseWindow(videoWindow);
|
||||
for counter:=0 to 15 do ReleasePen(videoColorMap,videoPens[counter]);
|
||||
|
||||
{
|
||||
SetConsoleScreenBufferSize (TextRec (Output).Handle, OrigConsoleInfo.dwSize);
|
||||
SetConsoleWindowInfo (cardinal (TextRec (Output).Handle), true, OrigConsoleInfo.srWindow);
|
||||
SetConsoleCursorInfo(TextRec(Output).Handle, OrigConsoleCursorInfo);
|
||||
SetConsoleCP(OrigCP);
|
||||
}
|
||||
end;
|
||||
|
||||
|
||||
|
||||
function SysVideoModeSelector (const VideoMode: TVideoMode): boolean;
|
||||
function SysSetVideoMode (Const Mode : TVideoMode) : Boolean;
|
||||
|
||||
{
|
||||
var MI: Console_Screen_Buffer_Info;
|
||||
C: Coord;
|
||||
SR: Small_Rect;
|
||||
}
|
||||
begin
|
||||
{
|
||||
if not (GetConsoleScreenBufferInfo (TextRec (Output).Handle, MI)) then
|
||||
SysVideoModeSelector := false
|
||||
else
|
||||
begin
|
||||
with MI do
|
||||
begin
|
||||
C.X := VideoMode.Col;
|
||||
C.Y := VideoMode.Row;
|
||||
end;
|
||||
with SR do
|
||||
begin
|
||||
Top := 0;
|
||||
Left := 0;
|
||||
{ First, we need to make sure we reach the minimum window size
|
||||
to always fit in the new buffer after changing buffer size. }
|
||||
Right := MI.srWindow.Right - MI.srWindow.Left;
|
||||
if VideoMode.Col <= Right then
|
||||
Right := Pred (VideoMode.Col);
|
||||
Bottom := MI.srWindow.Bottom - MI.srWindow.Top;
|
||||
if VideoMode.Row <= Bottom then
|
||||
Bottom := Pred (VideoMode.Row);
|
||||
end;
|
||||
if SetConsoleWindowInfo (cardinal (TextRec (Output).Handle), true, SR) then
|
||||
if SetConsoleScreenBufferSize (TextRec (Output).Handle, C) then
|
||||
begin
|
||||
with SR do
|
||||
begin
|
||||
{ Now, we can resize the window to the final size. }
|
||||
Right := Pred (VideoMode.Col);
|
||||
Bottom := Pred (VideoMode.Row);
|
||||
end;
|
||||
if SetConsoleWindowInfo (cardinal (TextRec (Output).Handle), true, SR) then
|
||||
begin
|
||||
SysVideoModeSelector := true;
|
||||
SetCursorType (LastCursorType);
|
||||
ClearScreen;
|
||||
end
|
||||
else
|
||||
begin
|
||||
SysVideoModeSelector := false;
|
||||
SetConsoleScreenBufferSize (TextRec (Output).Handle, MI.dwSize);
|
||||
SetConsoleWindowInfo (cardinal (TextRec (Output).Handle), true, MI.srWindow);
|
||||
SetCursorType (LastCursorType);
|
||||
end
|
||||
end
|
||||
else
|
||||
begin
|
||||
SysVideoModeSelector := false;
|
||||
SetConsoleWindowInfo (cardinal (TextRec (Output).Handle), true, MI.srWindow);
|
||||
SetCursorType (LastCursorType);
|
||||
end
|
||||
else
|
||||
SysVideoModeSelector := false;
|
||||
end;
|
||||
}
|
||||
end;
|
||||
|
||||
Const
|
||||
SysVideoModeCount = 6;
|
||||
SysVMD : Array[0..SysVideoModeCount-1] of TVideoMode = (
|
||||
(Col: 40; Row: 25; Color: True),
|
||||
(Col: 80; Row: 25; Color: True),
|
||||
(Col: 80; Row: 30; Color: True),
|
||||
(Col: 80; Row: 43; Color: True),
|
||||
(Col: 80; Row: 50; Color: True),
|
||||
(Col: 80; Row: 25; Color: True) // Reserved for TargetEntry
|
||||
);
|
||||
|
||||
|
||||
Function SysSetVideoMode (Const Mode : TVideoMode) : Boolean;
|
||||
|
||||
Var
|
||||
var
|
||||
I : Integer;
|
||||
|
||||
begin
|
||||
|
||||
{
|
||||
I:=SysVideoModeCount-1;
|
||||
SysSetVideoMode:=False;
|
||||
While (I>=0) and Not SysSetVideoMode do
|
||||
@ -238,21 +143,9 @@ begin
|
||||
ScreenColor:=SysVMD[I].Color;
|
||||
end else SysSetVideoMode := false;
|
||||
end;
|
||||
}
|
||||
end;
|
||||
|
||||
Function SysGetVideoModeData (Index : Word; Var Data : TVideoMode) : boolean;
|
||||
|
||||
begin
|
||||
SysGetVideoModeData:=(Index<=high(SysVMD));
|
||||
If SysGetVideoModeData then
|
||||
Data:=SysVMD[Index];
|
||||
end;
|
||||
|
||||
Function SysGetVideoModeCount : Word;
|
||||
|
||||
begin
|
||||
SysGetVideoModeCount:=SysVideoModeCount;
|
||||
end;
|
||||
|
||||
procedure SysClearScreen;
|
||||
begin
|
||||
@ -260,7 +153,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure DrawChar(x,y: longint; bitmap: pBitmap; drawCursor: boolean);
|
||||
procedure DrawChar(x,y: longint; crType: word);
|
||||
var tmpCharData: word;
|
||||
tmpChar : byte;
|
||||
tmpFGColor : byte;
|
||||
@ -273,17 +166,24 @@ begin
|
||||
tmpChar :=tmpCharData and $0ff;
|
||||
tmpFGColor :=(tmpCharData shr 8) and %00001111;
|
||||
tmpBGColor :=(tmpCharData shr 12) and %00000111;
|
||||
|
||||
|
||||
sX:=x*8;
|
||||
sY:=y*16;
|
||||
|
||||
SetAPen(videoWindow^.Rport,videoPens[tmpFGColor]);
|
||||
SetBPen(videoWindow^.RPort,videoPens[tmpBGColor]);
|
||||
|
||||
if crType <> crBlock then begin
|
||||
SetABPenDrMd(videoWindow^.RPort,videoPens[tmpFGColor],videoPens[tmpBGColor],JAM2);
|
||||
end else begin
|
||||
{ in case of block cursor, swap fg/bg colors
|
||||
and BltTemplate() below will take care of everything }
|
||||
SetABPenDrMd(videoWindow^.RPort,videoPens[tmpBGColor],videoPens[tmpFGColor],JAM2);
|
||||
end;
|
||||
|
||||
BltTemplate(@vgafont[tmpChar,0],0,1,videoWindow^.RPort,sX,sY,8,16);
|
||||
|
||||
if drawCursor then begin
|
||||
gfxMove(videoWindow^.RPort,sX,sY+14); Draw(videoWindow^.RPort,sX+7,sY+14);
|
||||
gfxMove(videoWindow^.RPort,sX,sY+15); Draw(videoWindow^.RPort,sX+7,sY+15);
|
||||
|
||||
if crType = crUnderLine then begin
|
||||
{ draw two lines at the bottom of the char, in case of underline cursor }
|
||||
gfxMove(videoWindow^.RPort,sX,sY+14); Draw(videoWindow^.RPort,sX+7,sY+14);
|
||||
gfxMove(videoWindow^.RPort,sX,sY+15); Draw(videoWindow^.RPort,sX+7,sY+15);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -292,11 +192,12 @@ procedure SysUpdateScreen(force: boolean);
|
||||
var
|
||||
BufCounter : Longint;
|
||||
smallforce : boolean;
|
||||
|
||||
cursormoved : boolean;
|
||||
counter, counterX, counterY: longint;
|
||||
var
|
||||
tmpBitmap : tBitmap;
|
||||
begin
|
||||
smallforce:=false;
|
||||
cursormoved:=false;
|
||||
|
||||
if force then
|
||||
smallforce:=true
|
||||
else begin
|
||||
@ -312,21 +213,23 @@ begin
|
||||
for counterY:=0 to ScreenHeight-1 do begin
|
||||
for counterX:=0 to ScreenWidth-1 do begin
|
||||
if VideoBuf^[BufCounter]<>OldVideoBuf^[BufCounter] then
|
||||
DrawChar(counterX,counterY,@tmpBitmap,false);
|
||||
DrawChar(counterX,counterY,crHidden);
|
||||
Inc(BufCounter);
|
||||
end;
|
||||
end;
|
||||
move(VideoBuf^,OldVideoBuf^,VideoBufSize);
|
||||
end;
|
||||
|
||||
if (oldvisibleCursor<>visibleCursor) or (CursorX<>oldCursorX) or (CursorY<>oldCursorY) then begin
|
||||
writeln('kurzor:',cursorx,' ',cursory);
|
||||
DrawChar(oldCursorY,oldCursorX,@tmpBitmap,false);
|
||||
DrawChar(CursorY,CursorX,@tmpBitmap,visibleCursor);
|
||||
if (cursorType<>oldcursorType) or
|
||||
(CursorX<>oldCursorX) or (CursorY<>oldCursorY) or
|
||||
smallforce then begin
|
||||
DrawChar(oldCursorY,oldCursorX,crHidden);
|
||||
DrawChar(CursorY,CursorX,cursorType);
|
||||
oldCursorX:=CursorX;
|
||||
oldCursorY:=CursorY;
|
||||
oldVisibleCursor:=visibleCursor;
|
||||
oldcursorType:=cursorType;
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
|
||||
@ -344,54 +247,33 @@ end;
|
||||
|
||||
function SysGetCursorType: Word;
|
||||
begin
|
||||
if not visibleCursor then SysGetCursorType:=crHidden
|
||||
else SysGetCursorType:=crUnderline;
|
||||
|
||||
{
|
||||
GetConsoleCursorInfo(TextRec(Output).Handle,ConsoleCursorInfo);
|
||||
if not ConsoleCursorInfo.bvisible then
|
||||
SysGetCursorType:=crHidden
|
||||
else
|
||||
case ConsoleCursorInfo.dwSize of
|
||||
1..30:
|
||||
SysGetCursorType:=crUnderline;
|
||||
31..70:
|
||||
SysGetCursorType:=crHalfBlock;
|
||||
71..100:
|
||||
SysGetCursorType:=crBlock;
|
||||
end;
|
||||
}
|
||||
SysGetCursorType:=cursorType;
|
||||
end;
|
||||
|
||||
|
||||
procedure SysSetCursorType(NewType: Word);
|
||||
begin
|
||||
if newType=crHidden then visibleCursor:=false
|
||||
else visibleCursor:=true;
|
||||
cursorType:=newType;
|
||||
{ FIXME: halfBlock cursors are not supported for now
|
||||
by the rendering code }
|
||||
if cursorType = crHalfBlock then cursorType:=crBlock;
|
||||
|
||||
SysUpdateScreen(false);
|
||||
{
|
||||
GetConsoleCursorInfo(TextRec(Output).Handle,ConsoleCursorInfo);
|
||||
if newType=crHidden then
|
||||
ConsoleCursorInfo.bvisible:=false
|
||||
else
|
||||
begin
|
||||
ConsoleCursorInfo.bvisible:=true;
|
||||
case NewType of
|
||||
crUnderline:
|
||||
ConsoleCursorInfo.dwSize:=10;
|
||||
|
||||
crHalfBlock:
|
||||
ConsoleCursorInfo.dwSize:=50;
|
||||
|
||||
crBlock:
|
||||
ConsoleCursorInfo.dwSize:=99;
|
||||
end
|
||||
end;
|
||||
SetConsoleCursorInfo(TextRec(Output).Handle,ConsoleCursorInfo);
|
||||
}
|
||||
end;
|
||||
|
||||
|
||||
// Amiga specific calls
|
||||
procedure GotCloseWindow;
|
||||
begin
|
||||
gotCloseWindowMsg:=true;
|
||||
end;
|
||||
|
||||
function HasCloseWindow: boolean;
|
||||
begin
|
||||
HasCloseWindow:=gotCloseWindowMsg;
|
||||
gotCloseWindowMsg:=false;
|
||||
end;
|
||||
|
||||
|
||||
const
|
||||
SysVideoDriver : TVideoDriver = (
|
||||
@ -400,13 +282,12 @@ const
|
||||
UpdateScreen : @SysUpdateScreen;
|
||||
ClearScreen : @SysClearScreen;
|
||||
SetVideoMode : @SysSetVideoMode;
|
||||
GetVideoModeCount : @SysGetVideoModeCount;
|
||||
GetVideoModeData : @SysGetVideoModeData;
|
||||
GetVideoModeCount : nil;
|
||||
GetVideoModeData : nil;
|
||||
SetCursorPos : @SysSetCursorPos;
|
||||
GetCursorType : @SysGetCursorType;
|
||||
SetCursorType : @SysSetCursorType;
|
||||
GetCapabilities : @SysGetCapabilities
|
||||
|
||||
);
|
||||
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user