mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-16 05:59:28 +02:00
+ ncrt
This commit is contained in:
peter
parent
d2d87ca660
commit
c25c149492
@ -1,5 +1,5 @@
|
||||
#
|
||||
# Makefile generated by fpcmake v0.99.13 on 1999-11-24 22:54
|
||||
# Makefile generated by fpcmake v0.99.13 on 1999-11-24 23:58
|
||||
#
|
||||
|
||||
defaultrule: all
|
||||
@ -118,8 +118,8 @@ endif
|
||||
|
||||
# Targets
|
||||
|
||||
UNITOBJECTS+=ncurses
|
||||
EXAMPLEOBJECTS+=firework testn
|
||||
UNITOBJECTS+=ncurses ncrt
|
||||
EXAMPLEOBJECTS+=firework testn ncrt_demo
|
||||
|
||||
# Clean
|
||||
|
||||
|
||||
@ -3,8 +3,8 @@
|
||||
#
|
||||
|
||||
[targets]
|
||||
units=ncurses
|
||||
examples=firework testn
|
||||
units=ncurses ncrt
|
||||
examples=firework testn ncrt_demo
|
||||
|
||||
[dirs]
|
||||
fpcdir=../..
|
||||
|
||||
672
packages/ncurses/ncrt.pp
Normal file
672
packages/ncurses/ncrt.pp
Normal file
@ -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 }
|
||||
97
packages/ncurses/ncrt_demo.pp
Normal file
97
packages/ncurses/ncrt_demo.pp
Normal file
@ -0,0 +1,97 @@
|
||||
Program ncrt_demo;
|
||||
{---------------------------------------------------------------------------
|
||||
CncWare
|
||||
(c) Copyright 1999
|
||||
---------------------------------------------------------------------------
|
||||
Filename..: ncrt_demo.pp
|
||||
Programmer: Ken J. Wright
|
||||
Date......: 11/22/99
|
||||
|
||||
Purpose - Demonstrate the use of nCrt.
|
||||
|
||||
-------------------------------<< REVISIONS >>--------------------------------
|
||||
Ver | Date | Prog | Description
|
||||
-------+----------+------+----------------------------------------------------
|
||||
1.00 | 11/22/99 | kjw | Initial Release.
|
||||
------------------------------------------------------------------------------
|
||||
}
|
||||
uses ncrt;
|
||||
var
|
||||
win,win1,
|
||||
stdscr : pwin;
|
||||
s : string;
|
||||
c : char;
|
||||
i,x,y : integer;
|
||||
Begin
|
||||
{---------------------------------------
|
||||
Initialize ncurses screen & keyboard.
|
||||
**** This MUST be called ****
|
||||
---------------------------------------}
|
||||
if Not StartCurses(stdscr) then Begin
|
||||
writeln('ncurses failed to initialize');
|
||||
halt;
|
||||
End;
|
||||
nClrScr(stdscr,7);
|
||||
nDrawBox(btSingle,1,1,80,3,31);
|
||||
FWrite(27,2,30,0,'nCrt Demomstration Program');
|
||||
nNewWindow(win1,9,9,71,16);
|
||||
nWinColor(win1,95);
|
||||
nWriteScr(win1,3,2,95,'This is a background window.');
|
||||
nWriteScr(win1,10,3,95,'It was built first, then displayed later.');
|
||||
FWrite(1,24,15,80,'Enter some text, press [Enter]');
|
||||
nWindow(win,10,10,70,15);
|
||||
nClrScr(win,31);
|
||||
nGotoXY(win,1,1);
|
||||
nEcho(true);
|
||||
s := nReadln(win);
|
||||
FWrite(1,24,15,80,'Enter some more text, press [Enter]');
|
||||
nGotoXY(win,nWhereX(win),nWhereY(win));
|
||||
s := nReadln(win);
|
||||
FWrite(1,24,79,80,'Please wait...');
|
||||
nGotoXY(win,1,1);
|
||||
Delay(500);
|
||||
nDelLine(win);
|
||||
Delay(500);
|
||||
nInsLine(win);
|
||||
Delay(500);
|
||||
nFrame(win1);
|
||||
nRefresh(win1);
|
||||
Delay(4000);
|
||||
nRefresh(win);
|
||||
Delay(2000);
|
||||
ClrScr;
|
||||
FWrite(1,24,14,80,'Enter even more text, press [Enter]');
|
||||
s := nReadln(stdscr);
|
||||
nClrScr(win,47);
|
||||
FWrite(1,24,11,80,'Press some keys, followed by [Esc]');
|
||||
nGotoXY(win,5,1);
|
||||
x := nWhereX(win);
|
||||
y := nWhereY(win);
|
||||
i := 0;
|
||||
nEcho(false);
|
||||
repeat
|
||||
c := nReadkey(win);
|
||||
DelLine;
|
||||
inc(i);
|
||||
until (c = #27) or (i >= 8);
|
||||
While i > 0 Do Begin
|
||||
InsLine;
|
||||
dec(i);
|
||||
End;
|
||||
str(x:0,s);
|
||||
nWrite(win,'x = '+s+', ');
|
||||
str(y:0,s);
|
||||
nWrite(win,'y = '+s);
|
||||
nWriteln(stdscr,'press a key...');
|
||||
readkey;
|
||||
nDrawBox(btSingle,11,11,69,14,63);
|
||||
FWrite(30,11,79,49,' nCrt Demo Program');
|
||||
nDelWindow(win);
|
||||
nDelWindow(win1);
|
||||
nWindow(win,2,2,79,24);
|
||||
nFrame(stdscr);
|
||||
nFrame(win);
|
||||
nDelWindow(win);
|
||||
{ close ncurses & release all data structures }
|
||||
EndCurses;
|
||||
End.
|
||||
@ -17,15 +17,12 @@
|
||||
{
|
||||
Many thanks to Ken Wright for his patches !
|
||||
}
|
||||
|
||||
unit ncurses;
|
||||
|
||||
interface
|
||||
|
||||
{$linklib ncurses}
|
||||
{$linklib c}
|
||||
interface
|
||||
|
||||
{$packrecords C}
|
||||
{$linklib ncurses}
|
||||
{$linklib c}
|
||||
|
||||
{ Manually Added types }
|
||||
Type
|
||||
@ -435,6 +432,9 @@ Var
|
||||
Function wtimeout(_para1:pWINDOW; _para2:longint):longint; cdecl;
|
||||
Function wtouchln(_para1:pWINDOW; _para2:longint; _para3:longint; _para4:longint):longint; cdecl;
|
||||
Function wvline(_para1:pWINDOW; _para2:chtype; _para3:longint):longint; cdecl;
|
||||
Function mvwchgat(_para1:pWINDOW; _para2:longint; _para3:longint;
|
||||
_para4:longint; _para5:longint; _para6:longint;
|
||||
_para7:longint):longint;Cdecl;
|
||||
|
||||
const
|
||||
A_NORMAL = 0;
|
||||
@ -854,6 +854,9 @@ const External_library='';
|
||||
function wtimeout(_para1:pWINDOW; _para2:longint):longint;Cdecl; External;
|
||||
function wtouchln(_para1:pWINDOW; _para2:longint; _para3:longint; _para4:longint):longint;Cdecl; External;
|
||||
function wvline(_para1:pWINDOW; _para2:chtype; _para3:longint):longint;Cdecl; External;
|
||||
function mvwchgat(_para1:pWINDOW; _para2:longint; _para3:longint;
|
||||
_para4:longint; _para5:longint; _para6:longint;
|
||||
_para7:longint):longint;Cdecl; External;
|
||||
|
||||
function wgetstr(w : pwindow;s : pchar) : longint;
|
||||
begin
|
||||
@ -1339,9 +1342,7 @@ const External_library='';
|
||||
end;
|
||||
function mvchgat(y,x,n,a,c,o : longint) : longint;
|
||||
begin
|
||||
{
|
||||
mvchgat:=mvwchgat(stdscr,y,x,n,a,c,o);
|
||||
}
|
||||
end;
|
||||
|
||||
function mvhline_set(y,x,c,n : longint) : longint;
|
||||
@ -1735,9 +1736,3 @@ const External_library='';
|
||||
ACS_STERLING:=acs_map['}'];
|
||||
end;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.3 1999-11-24 23:42:00 peter
|
||||
* fpcmake updates
|
||||
|
||||
}
|
||||
Loading…
Reference in New Issue
Block a user