Codebase list el-ixir / 1586115b-4eea-4e20-8586-251e768fc58e/main mycrt.pas
1586115b-4eea-4e20-8586-251e768fc58e/main

Tree @1586115b-4eea-4e20-8586-251e768fc58e/main (Download .tar.gz)

mycrt.pas @1586115b-4eea-4e20-8586-251e768fc58e/mainraw · history · blame

unit mycrt;
interface

procedure gotoxy(x,y:integer);
procedure cursorin;
procedure cursorout;
procedure delay(ms:integer);
procedure crtwrite(txt:string);
function keypressed:boolean;
function readkey:char;
procedure waitkey;
procedure clrscr;
procedure InitCrt;
procedure DoneCrt;

var
  TextAttr:byte;
  ScreenWidth,ScreenHeight:integer;

implementation
uses termio, unix, baseunix;

var
  RealAttr:byte;

procedure gotoxy(x,y:integer);
begin
  write(#27'[',y-1,';',x-1,'f');
end;

procedure cursorout;
begin
  write(#27'[?25l')
end;

procedure cursorin;
begin
  write(#27'[?25h')
end;

procedure delay(ms:integer);
var
  tv:timeval;
begin
  tv.tv_sec:=ms div 1000;
  tv.tv_usec:=(ms mod 1000)*1000;
  fpSelect(input, @tv);
end;

procedure SetAttr;
const
  cols:array[0..7] of integer=(0,4,2,6,1,5,3,7);
begin
  if RealAttr<>TextAttr
    then begin
           RealAttr:=TextAttr;
           write(#27'[0;',(TextAttr shr 3) and 1,
               ';3',cols[TextAttr and 7],
               ';4',cols[(TextAttr shr 4) and 7],
               'm');
         end;
end;

procedure crtwrite(txt:string);
begin
  SetAttr;
  write(txt);
end;

function keypressed:boolean;
begin
  keypressed:=fpSelect(input, 0)<>0;
end;

function readkey:char;
var
  r:char;
begin
  FpRead(0, r, 1);
  readkey:=r;
end;

procedure waitkey;
begin
  fpSelect(input, $7fffffff); { ~24 days, workaround a bug in fpc }
end;

procedure clrscr;
begin
  SetAttr;
  write(#27'[2J'#27'[0;0f');
end;

var
  oldta, curta: TermIOS;
  WinInfo : TWinSize;

procedure InitCrt;
begin
  TextAttr:=7;
  RealAttr:=255;
  TCGetAttr(0, oldta);
  curta:=oldta;
  CFMakeRaw(curta);
  TCSetAttr(0, TCSANOW, curta);
  if fpIOCtl(1,TIOCGWINSZ,@Wininfo)>=0
    then begin
           ScreenWidth:=WinInfo.ws_col;
           ScreenHeight:=WinInfo.ws_row;
           if ScreenWidth<=0
             then ScreenWidth:=80;
           if ScreenHeight<=0
             then ScreenHeight:=25;
         end
    else begin
           ScreenWidth:=80;    
           ScreenHeight:=25;
         end;
end;

procedure DoneCrt;
begin
  TCSetAttr(0, TCSANOW, oldta);
end;

initialization
  InitCrt
finalization
  DoneCrt
end.