From 02f4ff7414818ce60022b0183d159297bc1ee803 Mon Sep 17 00:00:00 2001 From: Tomas Hajny Date: Sun, 9 Jul 2000 07:56:09 +0000 Subject: [PATCH] * proper units added --- api/os2/filectrl.inc | 9 +- api/os2/video.inc | 588 +++++++++++++++++++++++++++++-------------- 2 files changed, 403 insertions(+), 194 deletions(-) diff --git a/api/os2/filectrl.inc b/api/os2/filectrl.inc index 25b8f00491..582f49bf5c 100644 --- a/api/os2/filectrl.inc +++ b/api/os2/filectrl.inc @@ -12,6 +12,10 @@ uses BseDOS; {$ENDIF} +{$IFDEF PPC_FPC} + uses + DosCalls; +{$ENDIF} { not converted to the new error handling scheme (ie: calling ErrorHandler, instead of dumping an error code to ErrorCode) } @@ -150,7 +154,10 @@ end; { $Log$ - Revision 1.1 2000-01-06 01:20:31 peter + Revision 1.2 2000-07-09 07:56:09 hajny + * proper units added + + Revision 1.1 2000/01/06 01:20:31 peter * moved out of packages/ back to topdir Revision 1.1 1999/11/24 23:36:38 peter diff --git a/api/os2/video.inc b/api/os2/video.inc index 98c5029688..8559539f7f 100644 --- a/api/os2/video.inc +++ b/api/os2/video.inc @@ -1,195 +1,397 @@ -{ - 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; - -{ +{ + + System independent low-level video interface for os/2 + + + + $Id$ + +} + + + +uses +{$IFDEF PPC_FPC} + VioCalls; +{$ELSE} + {$IFDEF PPC_VIRTUAL} + Os2Base; + {$ENDIF} +{$ENDIF} + + + +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 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 + Revision 1.2 2000-07-09 07:56:09 hajny + * proper units added + + 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 - -} + + + 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 + + + +} +