|
@@ -0,0 +1,672 @@
|
|
|
+Unit nCrt;
|
|
|
+{---------------------------------------------------------------------------
|
|
|
+ CncWare
|
|
|
+ (c) Copyright 1999
|
|
|
+ ---------------------------------------------------------------------------
|
|
|
+ Filename..: ncrt.pp
|
|
|
+ Programmer: Ken J. Wright
|
|
|
+ Date......: 03/01/99
|
|
|
+
|
|
|
+ Purpose - Misc crt replacements & extras using ncurses.
|
|
|
+
|
|
|
+ NOTE: Although most of the crt procedures & functions have been replaced,
|
|
|
+ this is NOT intended as a total replacement for the crt unit. It simply
|
|
|
+ makes the ncurses library a little easier to use in a Pascal program,
|
|
|
+ including the most commonly used crt functions, with some familiar naming.
|
|
|
+ This mostly eliminates the need for using crt, or ncurses directly. By
|
|
|
+ utilizing ncurses, we get terminal independence, among other things.
|
|
|
+
|
|
|
+ If you also need some of the functionality of crt, then just add crt to the
|
|
|
+ uses clause of your program *before* ncrt.
|
|
|
+
|
|
|
+-------------------------------<< REVISIONS >>--------------------------------
|
|
|
+ Ver | Date | Prog| Description
|
|
|
+-------+----------+-----+-----------------------------------------------------
|
|
|
+ 1.00 | 03/01/99 | kjw | Initial Release.
|
|
|
+ | 03/22/99 | kjw | Added nDelWindow(), delwin() does not nil pointer.
|
|
|
+ 1.01 | 11/22/99 | kjw | Added the following: nEcho, ClrEol, ClrBot, InsLine,
|
|
|
+ | DelLine, Delay, nClrEol, nClrBot, nInsLine, nDelLine,
|
|
|
+ | nRefresh, nScroll, nDrawBox, nNewWindow, nWinColor,
|
|
|
+ | nWriteScr, nFrame & some functions for returning
|
|
|
+ | line drawing character values.
|
|
|
+------------------------------------------------------------------------------
|
|
|
+}
|
|
|
+Interface
|
|
|
+
|
|
|
+Uses linux,ncurses,strings;
|
|
|
+
|
|
|
+Const
|
|
|
+
|
|
|
+ { border styles for text boxes }
|
|
|
+ btNone : integer = 0;
|
|
|
+ btSingle : integer = 1;
|
|
|
+ btDouble : integer = 2;
|
|
|
+
|
|
|
+ Black = 0;
|
|
|
+ Blue = 1;
|
|
|
+ Green = 2;
|
|
|
+ Cyan = 3;
|
|
|
+ Red = 4;
|
|
|
+ Magenta = 5;
|
|
|
+ Brown = 6;
|
|
|
+ LightGray = 7;
|
|
|
+ DarkGray = 8;
|
|
|
+ LightBlue = 9;
|
|
|
+ LightGreen = 10;
|
|
|
+ LightCyan = 11;
|
|
|
+ LightRed = 12;
|
|
|
+ LightMagenta = 13;
|
|
|
+ Yellow = 14;
|
|
|
+ White = 15;
|
|
|
+
|
|
|
+Type
|
|
|
+ pwin = ^Window;
|
|
|
+
|
|
|
+ Function StartCurses(var win : pWindow) : Boolean;
|
|
|
+Procedure EndCurses;
|
|
|
+Procedure ClrScr;
|
|
|
+Procedure ClrEol;
|
|
|
+Procedure ClrBot;
|
|
|
+Procedure InsLine;
|
|
|
+Procedure DelLine;
|
|
|
+Procedure GotoXY(x,y : integer);
|
|
|
+ Function WhereX : integer;
|
|
|
+ Function WhereY : integer;
|
|
|
+ Function Readkey : char;
|
|
|
+ Function Keypressed : boolean;
|
|
|
+Procedure Delay(DTime: Word);
|
|
|
+Procedure nEcho(b : boolean);
|
|
|
+Procedure nWindow(var win : pWindow; x,y,x1,y1 : integer);
|
|
|
+Procedure nNewWindow(var win : pWindow; x,y,x1,y1 : integer);
|
|
|
+Procedure nDelWindow(var win : pWindow);
|
|
|
+Procedure nWinColor(win : pWindow; att : integer);
|
|
|
+Procedure nClrScr(win : pWindow; att : integer);
|
|
|
+Procedure nClrEol(win : pWindow);
|
|
|
+Procedure nClrBot(win : pWindow);
|
|
|
+Procedure nInsLine(win : pWindow);
|
|
|
+Procedure nDelLine(win : pWindow);
|
|
|
+Procedure nGotoXY(win : pWindow; x,y : integer);
|
|
|
+ Function nWhereX(win : pWindow) : integer;
|
|
|
+ Function nWhereY(win : pWindow) : integer;
|
|
|
+ Function nReadkey(win : pWindow) : char;
|
|
|
+ Function nReadln(win : pWindow) : string;
|
|
|
+Procedure nWrite(win : pWindow; s : string);
|
|
|
+Procedure nWriteln(win : pWindow; s : string);
|
|
|
+Procedure nWriteScr(win : pWindow; x,y,att : integer; s : string);
|
|
|
+Procedure nRefresh(win : pWindow);
|
|
|
+Procedure nScroll(win : pWindow; lines,dir : integer);
|
|
|
+Procedure nDrawBox(LineStyle,x1,y1,x2,y2,att : Integer);
|
|
|
+Procedure nFrame(win : pWindow);
|
|
|
+ Function nHL : char; { horizontal line }
|
|
|
+ Function nVL : char; { vertical line }
|
|
|
+ Function nUL : char; { upper left corner }
|
|
|
+ Function nLL : char; { lower loft corner }
|
|
|
+ Function nUR : char; { upper right corner }
|
|
|
+ Function nLR : char; { lower right corner }
|
|
|
+ Function nLT : char; { left tee }
|
|
|
+ Function nRT : char; { right tee }
|
|
|
+ Function nTT : char; { top tee }
|
|
|
+ Function nBT : char; { bottom tee }
|
|
|
+ Function nPL : char; { plus, + }
|
|
|
+ Function nLA : char; { left arrow }
|
|
|
+ Function nRA : char; { right arrow }
|
|
|
+ Function nUA : char; { up arror }
|
|
|
+ Function nDA : char; { down arrow }
|
|
|
+ Function IsBold(att : integer) : boolean;
|
|
|
+ Function SetColorPair(att : integer) : integer;
|
|
|
+Procedure FWrite(Col,Row,Attrib:byte;Clear:Integer;s:String);
|
|
|
+
|
|
|
+Implementation
|
|
|
+
|
|
|
+Var
|
|
|
+ fg,bg : integer;
|
|
|
+ cp : array [0..7,0..7] of integer; { color pair array }
|
|
|
+ ps : array [0..255] of char; { for use with pchars }
|
|
|
+
|
|
|
+{--------------------------------------
|
|
|
+ initialize ncurses screen & keyboard,
|
|
|
+ return a pointer to stdscr
|
|
|
+ --------------------------------------}
|
|
|
+Function StartCurses(var win : pWindow) : Boolean;
|
|
|
+Begin
|
|
|
+ if initscr=Nil then Begin
|
|
|
+ StartCurses := FALSE;
|
|
|
+ halt;
|
|
|
+ End Else Begin
|
|
|
+ StartCurses := TRUE;
|
|
|
+ start_color;
|
|
|
+ cbreak; { don't buffer keyboard input }
|
|
|
+ noecho; { don't echo kepresses }
|
|
|
+ nonl; { don't process cr in newline }
|
|
|
+ intrflush(stdscr,bool(false));
|
|
|
+ keypad(stdscr,bool(true));
|
|
|
+ win := stdscr;
|
|
|
+ End;
|
|
|
+
|
|
|
+End;
|
|
|
+
|
|
|
+{-------------------
|
|
|
+ Shutdown ncurses
|
|
|
+ -------------------}
|
|
|
+Procedure EndCurses;
|
|
|
+Begin
|
|
|
+ echo;
|
|
|
+ nocbreak;
|
|
|
+ refresh;
|
|
|
+ endwin;
|
|
|
+End;
|
|
|
+
|
|
|
+{ clear stdscr }
|
|
|
+Procedure ClrScr;
|
|
|
+Begin
|
|
|
+ TouchWin(stdscr);
|
|
|
+ erase;
|
|
|
+ refresh;
|
|
|
+End;
|
|
|
+
|
|
|
+{ clear from the cursor to the end of line in stdscr }
|
|
|
+Procedure ClrEol;
|
|
|
+Begin
|
|
|
+ clrtoeol;
|
|
|
+ refresh;
|
|
|
+End;
|
|
|
+
|
|
|
+{ clear from the cursor to the bottom of stdscr }
|
|
|
+Procedure ClrBot;
|
|
|
+Begin
|
|
|
+ clrtobot;
|
|
|
+ refresh;
|
|
|
+End;
|
|
|
+
|
|
|
+{ insert a line at the cursor line in stdscr }
|
|
|
+Procedure InsLine;
|
|
|
+Begin
|
|
|
+ insertln;
|
|
|
+ refresh;
|
|
|
+End;
|
|
|
+
|
|
|
+{ delete line at the cursor in stdscr }
|
|
|
+Procedure DelLine;
|
|
|
+Begin
|
|
|
+ deleteln;
|
|
|
+ refresh;
|
|
|
+End;
|
|
|
+
|
|
|
+{ position cursor in stdscr }
|
|
|
+Procedure GotoXY(x,y : integer);
|
|
|
+Begin
|
|
|
+ move(y-1,x-1);
|
|
|
+ refresh;
|
|
|
+End;
|
|
|
+
|
|
|
+{ find cursor x position in stdscr }
|
|
|
+Function WhereX : integer;
|
|
|
+var x,y : longint;
|
|
|
+Begin
|
|
|
+ getyx(stdscr,y,x);
|
|
|
+ WhereX := x+1;
|
|
|
+End;
|
|
|
+
|
|
|
+{ find cursor y position in stdscr }
|
|
|
+Function WhereY : integer;
|
|
|
+var x,y : longint;
|
|
|
+Begin
|
|
|
+ getyx(stdscr,y,x);
|
|
|
+ WhereY := y+1;
|
|
|
+End;
|
|
|
+
|
|
|
+{ Wait for DTime milliseconds }
|
|
|
+Procedure Delay(DTime: Word);
|
|
|
+Begin
|
|
|
+ Select(0,nil,nil,nil,DTime);
|
|
|
+End;
|
|
|
+
|
|
|
+{ set the echo flag }
|
|
|
+Procedure nEcho(b : boolean);
|
|
|
+Begin
|
|
|
+ Case b of
|
|
|
+ true : echo;
|
|
|
+ false: noecho;
|
|
|
+ End;
|
|
|
+End;
|
|
|
+
|
|
|
+{ create a new subwindow }
|
|
|
+Procedure nWindow(var win : pWindow; x,y,x1,y1 : integer);
|
|
|
+Begin
|
|
|
+ nDelWindow(win);
|
|
|
+ win := subwin(stdscr,y1-y+1,x1-x+1,y-1,x-1);
|
|
|
+ If win = nil then Exit;
|
|
|
+ intrflush(win,bool(false));
|
|
|
+ keypad(win,bool(true));
|
|
|
+End;
|
|
|
+
|
|
|
+{ create a new window }
|
|
|
+Procedure nNewWindow(var win : pWindow; x,y,x1,y1 : integer);
|
|
|
+Begin
|
|
|
+ nDelWindow(win);
|
|
|
+ win := newwin(y1-y+1,x1-x+1,y-1,x-1);
|
|
|
+ If win = nil then Exit;
|
|
|
+ intrflush(win,bool(false));
|
|
|
+ keypad(win,bool(true));
|
|
|
+End;
|
|
|
+
|
|
|
+{ delete a window, note this does not clear it }
|
|
|
+Procedure nDelWindow(var win : pWindow);
|
|
|
+Begin
|
|
|
+ If win <> Nil Then delwin(win);
|
|
|
+ win := Nil;
|
|
|
+End;
|
|
|
+
|
|
|
+{ set the color of the entire window, }
|
|
|
+{ delayed until next refresh }
|
|
|
+Procedure nWinColor(win : pWindow; att : integer);
|
|
|
+Begin
|
|
|
+ wbkgd(win,COLOR_PAIR(SetColorPair(att)));
|
|
|
+ If IsBold(att) Then
|
|
|
+ wattr_set(win,A_BOLD);
|
|
|
+End;
|
|
|
+
|
|
|
+{ clear the specified screen }
|
|
|
+procedure nClrScr(win : pWindow; att : integer);
|
|
|
+Begin
|
|
|
+ wbkgd(win,COLOR_PAIR(SetColorPair(att)));
|
|
|
+ If IsBold(att) Then
|
|
|
+ wattr_set(win,A_BOLD);
|
|
|
+ TouchWin(win);
|
|
|
+ werase(win);
|
|
|
+ wrefresh(win);
|
|
|
+End;
|
|
|
+
|
|
|
+{ clear from the cursor to the end of line in a window }
|
|
|
+Procedure nClrEol(win : pWindow);
|
|
|
+Begin
|
|
|
+ wclrtoeol(win);
|
|
|
+ wrefresh(win);
|
|
|
+End;
|
|
|
+
|
|
|
+{ clear from the cursor to the bottom in a window }
|
|
|
+Procedure nClrBot(win : pWindow);
|
|
|
+Begin
|
|
|
+ wclrtobot(win);
|
|
|
+ wrefresh(win);
|
|
|
+End;
|
|
|
+
|
|
|
+{ insert a line at the cursor line in a window }
|
|
|
+Procedure nInsLine(win : pWindow);
|
|
|
+Begin
|
|
|
+ winsertln(win);
|
|
|
+ wrefresh(win);
|
|
|
+End;
|
|
|
+
|
|
|
+{ delete line at the cursor in stdscr }
|
|
|
+Procedure nDelLine(win : pWindow);
|
|
|
+Begin
|
|
|
+ wdeleteln(win);
|
|
|
+ wrefresh(win);
|
|
|
+End;
|
|
|
+
|
|
|
+{ position cursor in a window }
|
|
|
+Procedure nGotoXY(win : pWindow; x,y : integer);
|
|
|
+Begin
|
|
|
+ wmove(win,y-1,x-1);
|
|
|
+ touchwin(win);
|
|
|
+ wrefresh(win);
|
|
|
+End;
|
|
|
+
|
|
|
+{ find cursor x position in a window }
|
|
|
+Function nWhereX(win : pWindow) : integer;
|
|
|
+var x,y : longint;
|
|
|
+Begin
|
|
|
+ getyx(win,y,x);
|
|
|
+ nWhereX := x+1;
|
|
|
+End;
|
|
|
+
|
|
|
+{ find cursor y position in a window }
|
|
|
+Function nWhereY(win : pWindow) : integer;
|
|
|
+var x,y : longint;
|
|
|
+Begin
|
|
|
+ getyx(win,y,x);
|
|
|
+ nWhereY := y+1;
|
|
|
+End;
|
|
|
+
|
|
|
+{ repaint a window }
|
|
|
+Procedure nRefresh(win : pWindow);
|
|
|
+Begin
|
|
|
+ touchwin(win);
|
|
|
+ wrefresh(win);
|
|
|
+End;
|
|
|
+
|
|
|
+{
|
|
|
+ Check if a key has been pressed.
|
|
|
+ Note: this is best used along with select() on STDIN, as it can suck
|
|
|
+ up lots of cpu time.
|
|
|
+}
|
|
|
+function Keypressed : boolean;
|
|
|
+var l : longint;
|
|
|
+Begin
|
|
|
+ Keypressed := FALSE;
|
|
|
+ nodelay(stdscr,bool(TRUE));
|
|
|
+ l := getch;
|
|
|
+ If l <> ERR Then Begin { ERR = -(1) from unit ncurses }
|
|
|
+ ungetch(l);
|
|
|
+ Keypressed := TRUE;
|
|
|
+ End;
|
|
|
+ nodelay(stdscr,bool(FALSE));
|
|
|
+End;
|
|
|
+
|
|
|
+{ silently read a key from stdscr }
|
|
|
+Function Readkey : char;
|
|
|
+Begin
|
|
|
+ Readkey := nReadkey(stdscr);
|
|
|
+End;
|
|
|
+
|
|
|
+{
|
|
|
+ read a keystroke from a window, including function keys
|
|
|
+ and extended keys (arrows, etc.)
|
|
|
+ Note: Make sure that keypad(win,true) has been issued prior to use.
|
|
|
+ ( nWindow does this )
|
|
|
+}
|
|
|
+Function nReadkey(win : pWindow) : char;
|
|
|
+var
|
|
|
+ c : char;
|
|
|
+ l : longint;
|
|
|
+ xtnded : boolean;
|
|
|
+Begin
|
|
|
+ l := wgetch(win);
|
|
|
+ { if it's an extended key, then map to the IBM values }
|
|
|
+ if l > 255 then begin
|
|
|
+ xtnded := true;
|
|
|
+ c := #27;
|
|
|
+ Case l of
|
|
|
+ KEY_BREAK : Begin xtnded := false; c := #3; End;
|
|
|
+ KEY_BACKSPACE : Begin xtnded := false; c := #8; End;
|
|
|
+ KEY_IC : c := #82; { insert }
|
|
|
+ KEY_DC : c := #83; { delete }
|
|
|
+ KEY_HOME : c := #71; { home }
|
|
|
+ KEY_END : c := #79; { end }
|
|
|
+ KEY_UP : c := #72; { up arrow }
|
|
|
+ KEY_DOWN : c := #80; { down arrow }
|
|
|
+ KEY_LEFT : c := #75; { left arrow }
|
|
|
+ KEY_RIGHT : c := #77; { right arrow }
|
|
|
+ KEY_NPAGE : c := #81; { page down }
|
|
|
+ KEY_PPAGE : c := #73; { page up }
|
|
|
+ Else
|
|
|
+ Begin
|
|
|
+ If l = Key_f(1) Then c := #59 Else
|
|
|
+ If l = Key_f(2) Then c := #60 Else
|
|
|
+ If l = Key_f(3) Then c := #61 Else
|
|
|
+ If l = Key_f(4) Then c := #62 Else
|
|
|
+ If l = Key_f(5) Then c := #63 Else
|
|
|
+ If l = Key_f(6) Then c := #64 Else
|
|
|
+ If l = Key_f(7) Then c := #65 Else
|
|
|
+ If l = Key_f(8) Then c := #66 Else
|
|
|
+ If l = Key_f(9) Then c := #67 Else
|
|
|
+ If l = Key_f(10) Then c := #68;
|
|
|
+ End;
|
|
|
+ End;
|
|
|
+ If xtnded Then Begin
|
|
|
+ nReadKey := #0;
|
|
|
+ ungetch(ord(c));
|
|
|
+ Exit;
|
|
|
+ End Else
|
|
|
+ nReadkey := c;
|
|
|
+ End Else
|
|
|
+ nReadkey := chr(ord(l));
|
|
|
+End;
|
|
|
+
|
|
|
+{ read input string from a window }
|
|
|
+{ note: by default, echo is false }
|
|
|
+Function nReadln(win : pWindow) : string;
|
|
|
+Begin
|
|
|
+ wgetstr(win,ps);
|
|
|
+ nReadln := StrPas(ps);
|
|
|
+End;
|
|
|
+
|
|
|
+{ write a string to a window at the current cursor position }
|
|
|
+Procedure nWrite(win : pWindow; s : string);
|
|
|
+Begin
|
|
|
+ waddstr(win,StrPCopy(ps,s));
|
|
|
+ wrefresh(win);
|
|
|
+End;
|
|
|
+
|
|
|
+{ write a string to a window at the current cursor position }
|
|
|
+{ followed by a newline }
|
|
|
+Procedure nWriteln(win : pWindow; s : string);
|
|
|
+Begin
|
|
|
+ waddstr(win,StrPCopy(ps,s+#10));
|
|
|
+ wrefresh(win);
|
|
|
+End;
|
|
|
+
|
|
|
+{ write a string to a window without refreshing screen }
|
|
|
+Procedure nWriteScr(win : pWindow; x,y,att : integer; s : string);
|
|
|
+Var
|
|
|
+ xx,yy,
|
|
|
+ cp : longint;
|
|
|
+Begin
|
|
|
+ cp := SetColorPair(att);
|
|
|
+ { write string with current attributes }
|
|
|
+ mvwaddstr(win,y-1,x-1,StrPCopy(ps,s));
|
|
|
+ { save the new cursor position }
|
|
|
+ getyx(win,yy,xx);
|
|
|
+ { update with new attributes }
|
|
|
+ If IsBold(att) Then
|
|
|
+ mvwchgat(win,y-1,x-1,-1,A_BOLD,cp,0)
|
|
|
+ Else
|
|
|
+ mvwchgat(win,y-1,x-1,-1,A_NORMAL,cp,0);
|
|
|
+ { return cursor to saved position }
|
|
|
+ wmove(win,yy,xx);
|
|
|
+End;
|
|
|
+
|
|
|
+{ scroll a window, up or down, a specified number of lines }
|
|
|
+Procedure nScroll(win : pwindow; lines,dir : integer);
|
|
|
+var i : integer;
|
|
|
+Begin
|
|
|
+ ScrollOk(win,bool(True));
|
|
|
+ For i := 1 to lines Do Begin
|
|
|
+ wscrl(win,dir);
|
|
|
+ End;
|
|
|
+ wRefresh(win);
|
|
|
+End;
|
|
|
+
|
|
|
+{ draw a colored box, with or without a border }
|
|
|
+Procedure nDrawBox(LineStyle,x1,y1,x2,y2,att : Integer);
|
|
|
+Var
|
|
|
+ win : pWindow;
|
|
|
+Begin
|
|
|
+ win := SubWin(stdscr,y2-y1+1,x2-x1+1,y1-1,x1-1);
|
|
|
+ If win = nil Then Begin
|
|
|
+ write('drawbox: could not allocate window: ',
|
|
|
+ (y2-y1+1),',',(x2-x1+1),',',(y1-1),',',(x1-1));
|
|
|
+ exit;
|
|
|
+ end;
|
|
|
+ wbkgd(win,COLOR_PAIR(SetColorPair(att)));
|
|
|
+ If IsBold(att) Then
|
|
|
+ wattr_set(win,A_BOLD);
|
|
|
+ werase(win);
|
|
|
+ case LineStyle of
|
|
|
+ 1,2 : box(win, ACS_VLINE, ACS_HLINE);
|
|
|
+ End;
|
|
|
+ wrefresh(win);
|
|
|
+ nDelWindow(win);
|
|
|
+End;
|
|
|
+
|
|
|
+{ add a border to a window }
|
|
|
+{ waits for a refresh }
|
|
|
+Procedure nFrame(win : pWindow);
|
|
|
+Begin
|
|
|
+ box(win, ACS_VLINE, ACS_HLINE);
|
|
|
+End;
|
|
|
+
|
|
|
+Function nHL : char;
|
|
|
+Begin
|
|
|
+ nHL := char(ACS_HLINE);
|
|
|
+End;
|
|
|
+
|
|
|
+Function nVL : char;
|
|
|
+Begin
|
|
|
+ nVL := char(ACS_VLINE);
|
|
|
+End;
|
|
|
+
|
|
|
+Function nUL : char;
|
|
|
+Begin
|
|
|
+ nUL := char(ACS_ULCORNER);
|
|
|
+End;
|
|
|
+
|
|
|
+Function nLL : char;
|
|
|
+Begin
|
|
|
+ nLL := char(ACS_LLCORNER);
|
|
|
+End;
|
|
|
+
|
|
|
+Function nUR : char;
|
|
|
+Begin
|
|
|
+ nUR := char(ACS_URCORNER);
|
|
|
+End;
|
|
|
+
|
|
|
+Function nLR : char;
|
|
|
+Begin
|
|
|
+ nLR := char(ACS_LRCORNER);
|
|
|
+End;
|
|
|
+
|
|
|
+Function nLT : char;
|
|
|
+Begin
|
|
|
+ nLT := char(ACS_LTEE);
|
|
|
+End;
|
|
|
+
|
|
|
+Function nRT : char;
|
|
|
+Begin
|
|
|
+ nRT := char(ACS_RTEE);
|
|
|
+End;
|
|
|
+
|
|
|
+Function nTT : char;
|
|
|
+Begin
|
|
|
+ nTT := char(ACS_TTEE);
|
|
|
+End;
|
|
|
+
|
|
|
+Function nBT : char;
|
|
|
+Begin
|
|
|
+ nBT := char(ACS_BTEE);
|
|
|
+End;
|
|
|
+
|
|
|
+Function nPL : char;
|
|
|
+Begin
|
|
|
+ nPL := char(ACS_PLUS);
|
|
|
+End;
|
|
|
+
|
|
|
+Function nLA : char;
|
|
|
+Begin
|
|
|
+ nLA := char(ACS_LARROW);
|
|
|
+End;
|
|
|
+
|
|
|
+Function nRA : char;
|
|
|
+Begin
|
|
|
+ nRA := char(ACS_RARROW);
|
|
|
+End;
|
|
|
+
|
|
|
+Function nUA : char;
|
|
|
+Begin
|
|
|
+ nUA := char(ACS_UARROW);
|
|
|
+End;
|
|
|
+
|
|
|
+Function nDA : char;
|
|
|
+Begin
|
|
|
+ nDA := char(ACS_DARROW);
|
|
|
+End;
|
|
|
+
|
|
|
+{ see if the specified attribute is high intensity, }
|
|
|
+{ used by fwrite() }
|
|
|
+Function IsBold(att : integer) : boolean;
|
|
|
+Begin
|
|
|
+ bg := att div 16;
|
|
|
+ fg := att - ((att div 16) * 16);
|
|
|
+ isbold := (fg > 7);
|
|
|
+End;
|
|
|
+
|
|
|
+{ initialize a color pair, used by fwrite() }
|
|
|
+Function SetColorPair(att : integer) : integer;
|
|
|
+var
|
|
|
+ i : integer;
|
|
|
+{ ncurses constants
|
|
|
+ COLOR_BLACK = 0;
|
|
|
+ COLOR_RED = 1;
|
|
|
+ COLOR_GREEN = 2;
|
|
|
+ COLOR_YELLOW = 3;
|
|
|
+ COLOR_BLUE = 4;
|
|
|
+ COLOR_MAGENTA = 5;
|
|
|
+ COLOR_CYAN = 6;
|
|
|
+ COLOR_WHITE = 7;
|
|
|
+}
|
|
|
+Begin
|
|
|
+ bg := att div 16;
|
|
|
+ fg := att - ((att div 16) * 16);
|
|
|
+ While bg > 7 Do dec(bg,8);
|
|
|
+ While fg > 7 Do dec(fg,8);
|
|
|
+ { map to ncurses color values }
|
|
|
+ case bg of
|
|
|
+ 0 : bg := COLOR_BLACK;
|
|
|
+ 1 : bg := COLOR_BLUE;
|
|
|
+ 2 : bg := COLOR_GREEN;
|
|
|
+ 3 : bg := COLOR_CYAN;
|
|
|
+ 4 : bg := COLOR_RED;
|
|
|
+ 5 : bg := COLOR_MAGENTA;
|
|
|
+ 6 : bg := COLOR_YELLOW;
|
|
|
+ 7 : bg := COLOR_WHITE;
|
|
|
+ end;
|
|
|
+ case fg of
|
|
|
+ 0 : fg := COLOR_BLACK;
|
|
|
+ 1 : fg := COLOR_BLUE;
|
|
|
+ 2 : fg := COLOR_GREEN;
|
|
|
+ 3 : fg := COLOR_CYAN;
|
|
|
+ 4 : fg := COLOR_RED;
|
|
|
+ 5 : fg := COLOR_MAGENTA;
|
|
|
+ 6 : fg := COLOR_YELLOW;
|
|
|
+ 7 : fg := COLOR_WHITE;
|
|
|
+ end;
|
|
|
+ i := cp[bg,fg];
|
|
|
+ init_pair(i,fg,bg);
|
|
|
+ SetColorPair := i;
|
|
|
+End;
|
|
|
+
|
|
|
+{---------------------------------------------------------------
|
|
|
+ write a string to stdscr with color, without moving the cursor
|
|
|
+
|
|
|
+ Col = x position
|
|
|
+ Row = y position
|
|
|
+ Attrib = color (0..127)
|
|
|
+ Clear = clear line up to x position
|
|
|
+ s = string to write
|
|
|
+ ---------------------------------------------------------------}
|
|
|
+procedure FWrite(Col,Row,Attrib:byte;Clear:Integer;s:String);
|
|
|
+Const
|
|
|
+ ClearLine = { Following line is 80 Spaces }
|
|
|
+' ';
|
|
|
+
|
|
|
+Var
|
|
|
+ cs : string;
|
|
|
+ win : pWindow;
|
|
|
+Begin
|
|
|
+ if Clear > 0 Then Begin
|
|
|
+ If Clear > 80 Then Clear := 80;
|
|
|
+ cs := Copy(ClearLine,1,(Clear-Col)-Length(s)+1);
|
|
|
+ End Else
|
|
|
+ cs := '';
|
|
|
+ s := s+cs;
|
|
|
+ If s = '' Then Exit;
|
|
|
+ win := subwin(stdscr,1,Length(s),row-1,col-1);
|
|
|
+ If win = nil Then Begin
|
|
|
+ s := ' FWrite: failed to create sub-window for '+s;
|
|
|
+ write(s,':',length(s));
|
|
|
+ Exit;
|
|
|
+ End;
|
|
|
+ wbkgd(win,COLOR_PAIR(SetColorPair(Attrib)));
|
|
|
+ If isbold(Attrib) then
|
|
|
+ wattr_set(win,A_BOLD);
|
|
|
+ mvwaddstr(win,0,0,StrPCopy(ps,s));
|
|
|
+ wrefresh(win);
|
|
|
+ delwin(win);
|
|
|
+ refresh;
|
|
|
+End;
|
|
|
+
|
|
|
+Begin
|
|
|
+ { load the color pairs array with color pair indices (0..63) }
|
|
|
+ For bg := 0 to 7 Do For fg := 0 to 7 do cp[bg,fg] := (bg*8)+fg;
|
|
|
+End. { of Unit nCrt }
|