diff --git a/api/os2/video.inc b/api/os2/video.inc new file mode 100644 index 0000000000..98c5029688 --- /dev/null +++ b/api/os2/video.inc @@ -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 + +}