* Video.inc for os/2

This commit is contained in:
daniel 2000-02-23 22:44:22 +00:00
parent 72077676d3
commit 5b6c306f6d

195
api/os2/video.inc Normal file
View 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
}