mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-07-31 19:06:09 +02:00
* Video.inc for os/2
This commit is contained in:
parent
72077676d3
commit
5b6c306f6d
195
api/os2/video.inc
Normal file
195
api/os2/video.inc
Normal file
@ -0,0 +1,195 @@
|
||||
{
|
||||
System independent low-level video interface for os/2
|
||||
|
||||
$Id$
|
||||
}
|
||||
|
||||
uses viocalls;
|
||||
|
||||
var videobuf:Pvideobuf;
|
||||
videobufsize:cardinal;
|
||||
lastcursortype:word=crunderline;
|
||||
cell_width,cell_height:word;
|
||||
|
||||
{$ASMMODE ATT}
|
||||
|
||||
procedure update_cell_size;
|
||||
|
||||
begin
|
||||
{This function cannot fail when you the default handle is used.}
|
||||
viogetdevicecellsize(cell_height,cell_width,0);
|
||||
end;
|
||||
|
||||
procedure initvideo;
|
||||
|
||||
begin
|
||||
initvideocalled:=true;
|
||||
{Get the address of the videobuffer.}
|
||||
if viogetbuf(videobuf,videobufsize,0)=0 then
|
||||
begin
|
||||
update_cell_size;
|
||||
sethighbitblink;
|
||||
setcursortype(lastcursortype);
|
||||
end
|
||||
else
|
||||
errcode:=errvioinit;
|
||||
end;
|
||||
|
||||
procedure setcursorpos(newcursorx,newcursory:word);
|
||||
|
||||
begin
|
||||
if viosetcurpos(newcursory,newcursorx,0)<>0 then
|
||||
{Do not set an error code; people should fix invalid newcursorx or
|
||||
newcursory values when designing, there is no need for detecting
|
||||
these errors at runtime.}
|
||||
runerror(225);
|
||||
end;
|
||||
|
||||
function getcursortype:word;
|
||||
|
||||
var cd:Tviocursorinfo;
|
||||
|
||||
begin
|
||||
viogetcurtype(cd,0); {Never fails, because handle is default handle.}
|
||||
if cd.attr=-1 then
|
||||
getcursortype:=crhidden
|
||||
else
|
||||
{Because the cursor's start and end lines are returned, we'll have
|
||||
to guess heuristically what cursor type we have.}
|
||||
case cd.cend-cd.ystart of
|
||||
0:
|
||||
{Propably this does not occur, but you'll never know.}
|
||||
getcursortype:=crhidden;
|
||||
1..cell_height div 4:
|
||||
getcursortype=crunderline;
|
||||
cell_height div 4..cell_height div 2:
|
||||
getcursortype:=crhalfblock;
|
||||
else
|
||||
getcursortype:=crblock;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure setcursortype;
|
||||
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure donevideo;
|
||||
|
||||
begin
|
||||
If initvideocalled then
|
||||
begin
|
||||
lastcursortype:=getcursortype;
|
||||
clearscreen;
|
||||
setcursortype(crunderline);
|
||||
setcursorpos(0,0);
|
||||
initvideocalled:=false;
|
||||
videobufsize:=0;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function GetCapabilities: Word;
|
||||
|
||||
begin
|
||||
GetCapabilities := $3F;
|
||||
end;
|
||||
|
||||
|
||||
procedure SetCursorPos(NewCursorX, NewCursorY: Word);
|
||||
|
||||
begin
|
||||
end;
|
||||
|
||||
|
||||
function GetCursorType: Word;
|
||||
|
||||
begin
|
||||
end;
|
||||
|
||||
|
||||
procedure SetCursorType(NewType: Word);
|
||||
|
||||
begin
|
||||
end;
|
||||
|
||||
|
||||
function DefaultVideoModeSelector(const VideoMode: TVideoMode; Params: Longint): Boolean;
|
||||
|
||||
begin
|
||||
end;
|
||||
|
||||
|
||||
procedure ClearScreen;
|
||||
|
||||
begin
|
||||
end;
|
||||
|
||||
|
||||
procedure UpdateScreen(Force: Boolean);
|
||||
begin
|
||||
if LockUpdateScreen<>0 then
|
||||
exit;
|
||||
if not force then
|
||||
begin
|
||||
asm
|
||||
movl VideoBuf,%esi
|
||||
movl OldVideoBuf,%edi
|
||||
movl VideoBufSize,%ecx
|
||||
shrl $2,%ecx
|
||||
repe
|
||||
cmpsl
|
||||
orl %ecx,%ecx
|
||||
jz .Lno_update
|
||||
movb $1,force
|
||||
.Lno_update:
|
||||
end;
|
||||
end;
|
||||
if Force then
|
||||
begin
|
||||
dosmemput(videoseg,0,videobuf^,VideoBufSize);
|
||||
move(videobuf^,oldvideobuf^,VideoBufSize);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure RegisterVideoModes;
|
||||
begin
|
||||
RegisterVideoMode(40, 25, False, DefaultVideoModeSelector, $00000000);
|
||||
RegisterVideoMode(40, 25, True, DefaultVideoModeSelector, $00000001);
|
||||
RegisterVideoMode(80, 25, False, DefaultVideoModeSelector, $00000002);
|
||||
RegisterVideoMode(80, 25, True, DefaultVideoModeSelector, $00000003);
|
||||
end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 2000-02-23 22:44:22 daniel
|
||||
* Video.inc for os/2
|
||||
|
||||
Revision 1.4 1998/12/15 17:17:17 peter
|
||||
+ cursor at 1,1 at the end
|
||||
|
||||
Revision 1.3 1998/12/12 19:13:01 peter
|
||||
* keyboard updates
|
||||
* make test target, make all only makes units
|
||||
|
||||
Revision 1.2 1998/12/10 11:41:50 florian
|
||||
* cursor is properly restored in DoneVideo
|
||||
|
||||
Revision 1.1 1998/12/04 12:48:27 peter
|
||||
* moved some dirs
|
||||
|
||||
Revision 1.4 1998/11/01 20:29:11 peter
|
||||
+ lockupdatescreen counter to not let updatescreen() update
|
||||
|
||||
Revision 1.3 1998/10/28 21:18:26 peter
|
||||
* more fixes
|
||||
|
||||
Revision 1.2 1998/10/28 00:02:08 peter
|
||||
+ mouse
|
||||
+ video.clearscreen, video.videobufsize
|
||||
|
||||
Revision 1.1 1998/10/26 11:31:47 peter
|
||||
+ inital include files
|
||||
|
||||
}
|
Loading…
Reference in New Issue
Block a user