{

  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.2  2000-07-13 11:32:26  michael
  + removed logs
 
}