paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-12-05 04:30:10 +01:00
Code Issues Packages Projects Releases Wiki Activity

* updated using a newer ncrt version

Browse Source
This commit is contained in:
peter 2000-02-06 17:22:37 +00:00
parent f0efb42197
commit 8e8c2afe10
11 changed files with 2593 additions and 1516 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
packages/ncurses/Makefile
View File

@ -1,5 +1,5 @@
#
# Makefile generated by fpcmake v0.99.13 [2000/01/28]
# Makefile generated by fpcmake v0.99.13 [2000/01/30]
#
defaultrule: all
@ -184,8 +184,8 @@ endif
# Targets
override UNITOBJECTS+=ncurses ncrt
override EXAMPLEOBJECTS+=firework testn ncrt_demo
override UNITOBJECTS+=ncurses panel ncrt ocrt
override EXAMPLEOBJECTS+=firework testn ocrt_demo edit_demo
# Clean

4
packages/ncurses/Makefile.fpc
View File

@ -3,8 +3,8 @@
#
[targets]
units=ncurses ncrt
examples=firework testn ncrt_demo
units=ncurses panel ncrt ocrt
examples=firework testn ocrt_demo edit_demo
[dirs]
fpcdir=../..

21
packages/ncurses/README
View File

@ -1,21 +0,0 @@
This is the ncurses interface for Free Pascal.
You need at least version 0.99.8 to compile this.
Compiling should be as simple as
make install
this will compile the unit ncurses, and make the two programs.
the ncurses unit will be installed in the directory you set in
the makefile.
If the ncurses library is not in /usr/lib, it is possible that
you must set a -Fl/path/to/libncurses/dir option when compiling the
programs.
The firework program is a nice program that is in the test suite of ncurses
the testn program shows how to make a small window and set a border and
colors, and display a string in it.
Enjoy !
Michael.

85
packages/ncurses/edit_demo.pp Normal file
View File

@ -0,0 +1,85 @@
Program Edit_Demo;
{---------------------------------------------------------------------------
CncWare
(c) Copyright 1999
---------------------------------------------------------------------------
Filename..: edit_demo.pp
Programmer: Ken J. Wright, ken@cncware.com
Date......: 12/12/99
Purpose - Demonstrate the use of nCrt unit.
-------------------------------<< REVISIONS >>--------------------------------
Ver | Date | Prog| Description
-------+----------+-----+-----------------------------------------------------
1.00 | 12/12/99 | kjw | Initial Release.
1.01 | 12/13/99 | kjw | Changed to use oCrt.
------------------------------------------------------------------------------
}
uses oCrt;
var
ss : array[1..25] of string[80];
xp,yp,
s : string;
c : char;
win1,status : tnWindow;
idx : integer;
Finished : boolean;
Begin
Status.Init(1,25,80,25,63,false,0);
Status.FWrite(1,1,63,80,' [F1-InsLn] [F2-DelLn] [F10-Exit]');
Status.Show;
fillchar(ss,sizeof(ss),#0);
win1.Init(1,1,80,24,31,true,31);
win1.PutHeader(' nCrt Editor Demonstration ',15,center);
win1.Show;
win1.GotoXY(1,1);
{--------------------------------------------------------------------
The next line causes sedit to exit after every keystroke so we can
capture the insert mode and cursor positions.
--------------------------------------------------------------------}
win1.ec.ExitMode := true;
idx := 1;
Finished := false;
Repeat
With win1 Do Begin
Case ec.InsMode of
true : Status.FWrite(40,1,48,0,'Ins');
false: Status.FWrite(40,1,48,0,'Ovr');
End;
Str(WhereX:0,xp);
Str(WhereY:0,yp);
Status.FWrite(50,1,48,80,'X='+xp+', Y='+yp);
ss[idx] := SEdit(1,idx,30,Cols,WhereX,ss[idx],c);
Case ord(c) of
nKeyUp : dec(idx);
nKeyDown : inc(idx);
nKeyPgUp : idx := 1;
nKeyPgDn : idx := Rows;
nKeyEnter: Begin
inc(idx);
GotoXY(1,WhereY);
End;
nKeyF1 : Begin
InsLine;
system.move(ss[idx],ss[idx+1],(rows-idx)*81);
ss[idx] := '';
End;
nKeyF2 : Begin
DelLine;
system.move(ss[idx+1],ss[idx],(rows-idx)*81);
ss[rows] := '';
End;
nKeyEsc,
nKeyF10 : Finished := true;
End;
If idx > rows Then idx := rows;
If idx < 1 Then idx := 1;
GotoXY(WhereX,idx);
End;
Until Finished;
win1.Done;
Status.Done;
halt(1);
End.

805
packages/ncurses/ncrt.inc Normal file
View File

@ -0,0 +1,805 @@
{---------------------------------------------------------------------------
CncWare
(c) Copyright 1999
Portions copyright the FreePascal Team
---------------------------------------------------------------------------
Filename..: ncrt.inc
Programmer: Ken J. Wright, ken@cncware.com
Date......: 03/01/99
Purpose - Code that is common to nCrt and oCrt.
-------------------------------<< REVISIONS >>--------------------------------
Ver | Date | Prog| Description
-------+----------+-----+-----------------------------------------------------
2.00 | 12/13/99 | kjw | Initial Release.
2.02 | 12/15/99 | kjw | Removed use of endwin. Replaced with tcget/setattr.
2.03 | 12/16/99 | kjw | 1) Added shifted f-keys to nReadkey.
| 2) Added raw & scrollok to StartCurses.
| 3) Added alt'd keyset support.
2.04 | 01/04/00 | kjw | keypressed changed back to method of using getch
| rather than select.
2.05 | 01/06/00 | kjw | 1) StartCurses now defaults to echo. Readkey sets to
| noecho. This allows nCrt to handle echoing in the
| default manor, but allows oCrt to control echoing
| in the app with nEcho. Note: Read(ln) will always
| echo as normal, regardless of any setting by nEcho.
| Also set DoRefresh to true.
| 2) nDelWindow now checks for stdscr or curscr and
| makes sure that ActiveWn is not nil.
| 3) Window() now moves to 1,1 and does not do a
| clrscr.
2.06 | 01/11/00 | kjw | 1) Oops! 2.04 change went back to stdscr vs. ActiveWn.
| Keypressed works correctly with windows again.
| 2) ClrEol works correctly now with color.
------------------------------------------------------------------------------
}
Procedure AssignCrt(var F: Text);
Procedure ClrEol;
Procedure ClrScr;
Procedure ClrBot;
Procedure Delay(DTime: Word);
Procedure DelLine;
Procedure GotoXY(x,y : integer);
Procedure HighVideo;
Procedure InsLine;
Function Keypressed : boolean;
Procedure LowVideo;
Procedure NormVideo;
Procedure NoSound;
Function Readkey : char;
Procedure Sound(hz : word);
Procedure TextBackground(att : byte);
Procedure TextColor(att : byte);
Procedure TextMode(mode : word);
Function WhereX : integer;
Function WhereY : integer;
Procedure Window(x,y,x1,y1 : integer);
Const
{ CRT modes }
BW40 = 0; { 40x25 B/W on Color Adapter }
CO40 = 1; { 40x25 Color on Color Adapter }
BW80 = 2; { 80x25 B/W on Color Adapter }
CO80 = 3; { 80x25 Color on Color Adapter }
Mono = 7; { 80x25 on Monochrome Adapter }
Font8x8 = 256; { Add-in for ROM font }
{ Mode constants for 3.0 compatibility }
C40 = CO40;
C80 = CO80;
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;
Blink = 128;
TextAttr : Byte = $07;
LastMode : Word = 3;
WindMin : Word = $0;
WindMax : Word = $184f;
{ support for the alt'd characters }
{ these get initialized by StartCurses }
KEY_ALTA = 465; { alt/a }
KEY_ALTB = 466;
KEY_ALTC = 467;
KEY_ALTD = 468;
KEY_ALTE = 469;
KEY_ALTF = 470;
KEY_ALTG = 471;
KEY_ALTH = 472;
KEY_ALTI = 473;
KEY_ALTJ = 474;
KEY_ALTK = 475;
KEY_ALTL = 476;
KEY_ALTM = 477;
KEY_ALTN = 478;
KEY_ALTO = 479;
KEY_ALTP = 480;
KEY_ALTQ = 481;
KEY_ALTR = 482;
KEY_ALTS = 483;
KEY_ALTT = 484;
KEY_ALTU = 485;
KEY_ALTV = 486;
KEY_ALTW = 487;
KEY_ALTX = 488;
KEY_ALTY = 489;
KEY_ALTZ = 490; { alt/z }
KEY_ALT1 = 491; { alt/1 }
KEY_ALT2 = 492; { alt/2 }
KEY_ALT3 = 493; { alt/3 }
KEY_ALT4 = 494; { alt/4 }
KEY_ALT5 = 495; { alt/5 }
KEY_ALT6 = 496; { alt/6 }
KEY_ALT7 = 497; { alt/7 }
KEY_ALT8 = 498; { alt/8 }
KEY_ALT9 = 499; { alt/9 }
KEY_ALT0 = 500; { alt/0 }
KEY_ALTEQUAL = 501; { alt/- }
KEY_ALTMINUS = 502; { alt/= }
KEY_ALTTAB = 503; { alt/tab }
var
CheckBreak,
CheckEOF,
CheckSnow,
DirectVideo: Boolean;
Implementation
uses strings;
Const
{ standard file descriptors }
STDIN = 0;
STDOUT = 1;
STDERR = 2;
Var
ExitSave : pointer; { pointer to original exit proc }
fg,bg : integer; { foreground & background }
cp : array [0..7,0..7] of integer; { color pair array }
ps : array [0..255] of char; { for use with pchars }
doRefresh : boolean; { immediate refresh toggle }
SubWn, { window created from window() }
ActiveWn : pwindow; { current active window for stdout }
tmp_b : boolean;
isEcho : boolean; { keeps track of echo status }
MaxRows, { set at startup to terminal values }
MaxCols : longint; { for columns and rows }
tios : TermIOS; { saves the term settings at startup }
{==========================================================================
This code chunk is from the FPC source tree in rtl/inc/textrec.inc.
It is the internal format of a variable of type "Text" as defined and
described in the Borland Pascal docs.
==========================================================================}
const
TextRecNameLength = 256;
TextRecBufSize = 256;
type
TextBuf = array[0..TextRecBufSize-1] of char;
TextRec = Packed Record
Handle,
Mode,
bufsize,
_private,
bufpos,
bufend : longint;
bufptr : ^textbuf;
openfunc,
inoutfunc,
flushfunc,
closefunc : pointer;
UserData : array[1..16] of byte;
name : array[0..textrecnamelength-1] of char;
buffer : textbuf;
End;
{==========================================================================}
{--------------------------------------------
initialize ncurses screen & keyboard, and
return a pointer to stdscr.
NOTE: This is done at unit initialization.
--------------------------------------------}
Function StartCurses(var win : pWindow) : Boolean;
Var
i : integer;
s : string[3];
Begin
{ save the current terminal settings }
tcGetAttr(STDIN,tios);
if initscr=Nil then Begin
StartCurses := false;
Exit;
End Else Begin
StartCurses := true;
start_color;
cbreak; { disable keyboard buffering }
raw; { disable flow control, etc. }
echo; { echo keypresses }
nonl; { don't process cr in newline }
intrflush(stdscr,bool(false));
keypad(stdscr,bool(true));
scrollok(stdscr,bool(true));
win := stdscr;
isEcho := true;
doRefresh := true;
getmaxyx(stdscr,MaxRows,MaxCols);
{ define the the alt'd keysets for ncurses }
{ alt/a .. atl/z }
for i := ord('a') to ord('z') do Begin
s := #27+chr(i)+#0;
define_key(@s[1],400+i-32);
End;
{ alt/1 .. alt/9 }
for i := 1 to 9 do Begin
s := #27+chr(i)+#0;
define_key(@s[1],490+i);
End;
s := #27+'0'+#0; define_key(@s[1],500); { alt/0 }
s := #27+'-'+#0; define_key(@s[1],501); { alt/- }
s := #27+'='+#0; define_key(@s[1],502); { alt/= }
s := #27+#9+#0; define_key(@s[1],503); { alt/tab }
End;
End;
{----------------------------------
Shutdown ncurses.
NOTE: This is done via ExitProc.
----------------------------------}
Procedure EndCurses;
Begin
{ restore the original terminal settings }
{ and leave the screen how the app left it }
tcSetAttr(STDIN,TCSANOW,tios);
End;
{ see if the specified attribute is high intensity }
Function IsBold(att : integer) : boolean;
Begin
bg := att div 16;
fg := att - (bg * 16);
isbold := (fg > 7);
End;
{ initialize a color pair }
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;
{ map a standard color attribute to an ncurses attribute }
Function CursesAtts(att : byte) : longint;
Var
atts : longint;
Begin
atts := COLOR_PAIR(SetColorPair(att));
If IsBold(att) Then atts := atts or A_BOLD;
If (att and $80) = $80 Then atts := atts or A_BLINK;
CursesAtts := atts;
End;
{------------------------------------------------
Delete a window.
NOTE: This does not clear it from the display.
------------------------------------------------}
Procedure nDelWindow(var win : pWindow);
Begin
If (win = stdscr) or (win = curscr) Then Exit;
If win <> Nil Then delwin(win);
win := Nil;
If ActiveWn = Nil Then ActiveWn := stdscr;
End;
{-----------------------------------------
Set the current text color of a window,
delayed until next refresh.
-----------------------------------------}
Procedure nWinColor(win : pWindow; att : integer);
Begin
wattr_set(win,CursesAtts(att));
End;
{ clear the specified window }
procedure nClrScr(win : pWindow; att : integer);
Begin
wbkgd(win,CursesAtts(att));
TouchWin(win);
werase(win);
If doRefresh Then wrefresh(win);
End;
{ clear from the cursor to the end of line in a window }
Procedure nClrEol(win : pWindow);
Var
tmp : pwindow;
x,y,
xb,yb,
xm,ym : longint;
Begin
{--------------------------------------------------------
In order to have the correct color, we must define and
clear a temporary window. ncurses wclrtoeol() uses the
window background color rather that the current color
attribute ;-(
--------------------------------------------------------}
getyx(win,y,x);
getbegyx(win,yb,xb);
getmaxyx(win,ym,xm);
tmp := subwin(win,1,xm-x,yb+y,xb+x);
If tmp = nil then Exit;
wbkgd(tmp,CursesAtts(TextAttr));
werase(tmp);
{ wclrtoeol(win);}
If doRefresh Then wrefresh(tmp);
delwin(tmp);
End;
{ clear from the cursor to the bottom in a window }
Procedure nClrBot(win : pWindow);
Begin
wclrtobot(win);
If doRefresh Then wrefresh(win);
End;
{ insert a line at the cursor line in a window }
Procedure nInsLine(win : pWindow);
Begin
winsertln(win);
If doRefresh Then wrefresh(win);
End;
{ delete line at the cursor in a window }
Procedure nDelLine(win : pWindow);
Begin
wdeleteln(win);
If doRefresh Then wrefresh(win);
End;
{ position cursor in a window }
Procedure nGotoXY(win : pWindow; x,y : integer);
Begin
wmove(win,y-1,x-1);
touchwin(win);
If doRefresh Then 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;
{---------------------------------------------------------------------
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 }
KEY_ALTA : c := #30; { alt/a }
KEY_ALTB : c := #48;
KEY_ALTC : c := #46;
KEY_ALTD : c := #32;
KEY_ALTE : c := #18;
KEY_ALTF : c := #33;
KEY_ALTG : c := #34;
KEY_ALTH : c := #35;
KEY_ALTI : c := #23;
KEY_ALTJ : c := #36;
KEY_ALTK : c := #37;
KEY_ALTL : c := #38;
KEY_ALTM : c := #50;
KEY_ALTN : c := #49;
KEY_ALTO : c := #24;
KEY_ALTP : c := #25;
KEY_ALTQ : c := #16;
KEY_ALTR : c := #19;
KEY_ALTS : c := #31;
KEY_ALTT : c := #20;
KEY_ALTU : c := #22;
KEY_ALTV : c := #47;
KEY_ALTW : c := #17;
KEY_ALTX : c := #45;
KEY_ALTY : c := #21;
KEY_ALTZ : c := #44; { alt/z }
KEY_ALT1 : c := #120; { alt/1 }
KEY_ALT2 : c := #121; { alt/2 }
KEY_ALT3 : c := #122; { alt/3 }
KEY_ALT4 : c := #123; { alt/4 }
KEY_ALT5 : c := #124; { alt/5 }
KEY_ALT6 : c := #125; { alt/6 }
KEY_ALT7 : c := #126; { alt/7 }
KEY_ALT8 : c := #127; { alt/8 }
KEY_ALT9 : c := #128; { alt/9 }
KEY_ALT0 : c := #129; { alt/0 }
KEY_ALTEQUAL : c := #130; { alt/- }
KEY_ALTMINUS : c := #131; { alt/= }
KEY_ALTTAB : c := #15; { alt/tab }
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 Else
If l = Key_f(11) Then c := #84 Else
If l = Key_f(12) Then c := #85 Else
If l = Key_f(13) Then c := #86 Else
If l = Key_f(14) Then c := #87 Else
If l = Key_f(15) Then c := #88 Else
If l = Key_f(16) Then c := #89 Else
If l = Key_f(17) Then c := #90 Else
If l = Key_f(18) Then c := #91 Else
If l = Key_f(19) Then c := #92 Else
If l = Key_f(20) Then c := #93;
End;
End;
If xtnded Then Begin
nReadKey := #0;
ungetch(ord(c));
Exit;
End Else
nReadkey := c;
End Else
nReadkey := chr(ord(l));
End;
{ write a string to a window at the current cursor position }
Procedure nWrite(win : pWindow; s : string);
Begin
waddstr(win,StrPCopy(ps,s));
If doRefresh Then wrefresh(win);
End;
{=========================================================================
CrtWrite, CrtRead, CrtReturn, CrtClose, CrtOpen, AssignCrt.
These functions come from the FPC distribution rtl/linux/crt unit.
These are the hooks into the input/output stream needed for write(ln)
and read(ln).
=========================================================================}
{ used by CrtWrite }
Procedure DoWrite(temp : string);
Begin
nWrite(ActiveWn,temp);
End;
Function CrtWrite(Var F: TextRec): Integer;
{
Top level write function for CRT
}
Var
Temp : String;
idx,i : Longint;
{ oldflush : boolean;}
Begin
{ oldflush:=ttySetFlush(Flushing);}
idx:=0;
while (F.BufPos>0) do
begin
i:=F.BufPos;
if i>255 then
i:=255;
system.Move(F.BufPTR^[idx],Temp[1],F.BufPos);
Temp[0]:=Chr(i);
DoWrite(Temp);
dec(F.BufPos,i);
inc(idx,i);
end;
{ ttySetFlush(oldFLush);}
CrtWrite:=0;
End;
Function CrtRead(Var F: TextRec): Integer;
{
Read from CRT associated file.
}
var
i : longint;
Begin
F.BufEnd:=fdRead(F.Handle, F.BufPtr^, F.BufSize);
{ fix #13 only's -> #10 to overcome terminal setting }
for i:=1to F.BufEnd do
begin
if (F.BufPtr^[i-1]=#13) and (F.BufPtr^[i]<>#10) then
F.BufPtr^[i-1]:=#10;
end;
F.BufPos:=F.BufEnd;
CrtWrite(F);
CrtRead:=0;
End;
Function CrtReturn(Var F:TextRec):Integer;
Begin
CrtReturn:=0;
end;
Function CrtClose(Var F: TextRec): Integer;
{
Close CRT associated file.
}
Begin
F.Mode:=fmClosed;
CrtClose:=0;
End;
Function CrtOpen(Var F: TextRec): Integer;
{
Open CRT associated file.
}
Begin
If F.Mode=fmOutput Then
begin
TextRec(F).InOutFunc:=@CrtWrite;
TextRec(F).FlushFunc:=@CrtWrite;
end
Else
begin
F.Mode:=fmInput;
TextRec(F).InOutFunc:=@CrtRead;
TextRec(F).FlushFunc:=@CrtReturn;
end;
TextRec(F).CloseFunc:=@CrtClose;
CrtOpen:=0;
End;
procedure AssignCrt(var F: Text);
{
Assign a file to the console. All output on file goes to console instead.
}
begin
Assign(F,'');
TextRec(F).OpenFunc:=@CrtOpen;
end;
{==========================================================================
Standard crt unit replacements
==========================================================================}
{ set the text background color }
Procedure TextBackground(att : byte);
Begin
TextAttr:=
((att shl 4) and ($f0 and not Blink)) or (TextAttr and ($0f OR Blink) );
nWinColor(ActiveWn,TextAttr);
End;
{ set the text foreground color }
Procedure TextColor(att : byte);
Begin
TextAttr := (att and $8f) or (TextAttr and $70);
nWinColor(ActiveWn,TextAttr);
End;
{ set to high intensity }
Procedure HighVideo;
Begin
TextColor(TextAttr Or $08);
End;
{ set to low intensity }
Procedure LowVideo;
Begin
TextColor(TextAttr And $77);
End;
{ set to normal display colors }
Procedure NormVideo;
Begin
TextColor(7);
TextBackGround(0);
End;
{ clear stdscr }
Procedure ClrScr;
Begin
nClrScr(ActiveWn,TextAttr);
End;
{ clear from the cursor to the end of line in stdscr }
Procedure ClrEol;
Begin
nClrEol(ActiveWn);
End;
{ clear from the cursor to the bottom of stdscr }
Procedure ClrBot;
Begin
nClrBot(ActiveWn);
End;
{ insert a line at the cursor line in stdscr }
Procedure InsLine;
Begin
nInsLine(ActiveWn);
End;
{ delete line at the cursor in stdscr }
Procedure DelLine;
Begin
nDelLine(ActiveWn);
End;
{ position cursor in stdscr }
Procedure GotoXY(x,y : integer);
Begin
nGotoXY(ActiveWn,x,y);
End;
{ find cursor x position in stdscr }
Function WhereX : integer;
Begin
WhereX := nWhereX(ActiveWn);
End;
{ find cursor y position in stdscr }
Function WhereY : integer;
Begin
WhereY := nWhereY(ActiveWn);
End;
{ Wait for DTime milliseconds }
Procedure Delay(DTime: Word);
Begin
Select(0,nil,nil,nil,DTime);
End;
{ create a new subwindow of stdscr }
Procedure Window(x,y,x1,y1 : integer);
Begin
nDelWindow(SubWn);
SubWn := subwin(stdscr,y1-y+1,x1-x+1,y-1,x-1);
If SubWn = nil then Exit;
intrflush(SubWn,bool(false));
keypad(SubWn,bool(true));
scrollok(SubWn,bool(true));
ActiveWn := SubWn;
GotoXY(1,1);
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.
Better yet, use nKeypressed instead if you don't need
to include file descriptors other than STDIN.
------------------------------------------------------}
function Keypressed : boolean;
var
l : longint;
fd : fdSet;
Begin
Keypressed := FALSE;
nodelay(ActiveWn,bool(TRUE));
l := wgetch(ActiveWn);
If l <> ERR Then Begin { ERR = -(1) from unit ncurses }
ungetch(l);
Keypressed := TRUE;
End;
nodelay(ActiveWn,bool(FALSE));
{ Below is more efficient code, but does not work well with
nReadkey & extended keys because nReadkey's ungetch does not
force a change in STDIN. So, a "while keypressed" block does
not produce the expected results when trapping for char(0)
followed by a second scan code.
FD_Zero(fd);
fd_Set(STDIN,fd);
Keypressed := (Select(STDIN+1,@fd,nil,nil,0) > 0);
}
End;
{ silently read a key from stdscr }
Function Readkey : char;
Begin
tmp_b := IsEcho;
noecho;
Readkey := nReadkey(ActiveWn);
If tmp_b Then echo;
End;
{ a cheap replacement! }
Procedure Sound(hz : word);
Begin
Beep;
wrefresh(ActiveWn);
End;
Procedure NoSound;
Begin
End;
Procedure TextMode(mode : word);
Begin
nDelWindow(SubWn);
ActiveWn := stdscr;
NormVideo;
LastMode := mode;
DirectVideo := true;
CheckSnow := true;
NormVideo;
ClrScr;
End;
{ exit procedure to ensure curses is closed up cleanly }
Procedure nExit;
Begin
ExitProc := ExitSave;
EndCurses;
End;

684
packages/ncurses/ncrt.pp
View File

@ -2,671 +2,57 @@ Unit nCrt;
{---------------------------------------------------------------------------
CncWare
(c) Copyright 1999
Portions copyright the FreePascal Team
---------------------------------------------------------------------------
Filename..: ncrt.pp
Programmer: Ken J. Wright
Programmer: Ken J. Wright, ken@cncware.com
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.
Purpose - A crt replacement using ncurses.
-------------------------------<< 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.
------------------------------------------------------------------------------
2.00 | 12/13/99 | kjw | nCrt is now a drop-in replacement for the standard
| FPC crt unit. All the previous OOP features have
| been moved to a new unit, oCrt (object crt).
| See oCrt.pp for a complete revision history.
2.02 | 12/15/99 | kjw | See ncrt.inc.
2.03 | 12/16/99 | kjw | See ncrt.inc
2.04 | 01/04/00 | kjw | See ncrt.inc
2.05 | 01/06/00 | kjw | See ncrt.inc, ocrt.pp
2.06 | 01/11/00 | kjw | See ncrt.inc.
------------------------------------------------------------------------------
}
Interface
Uses linux,ncurses,strings;
Uses linux,ncurses;
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;
{$i ncrt.inc}
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;
{ initialize ncurses }
If Not StartCurses(ActiveWn) Then
Halt;
SubWn := nil;
TextMode(LastMode);
{ Redirect the standard output }
assigncrt(Output);
Rewrite(Output);
TextRec(Output).Handle:=StdOutputHandle;
{ Redirect the standard input }
assigncrt(Input);
Reset(Input);
TextRec(Input).Handle:=StdInputHandle;
{ set the unit exit procedure }
ExitSave := ExitProc;
ExitProc := @nExit;
End. { of Unit nCrt }

97
packages/ncurses/ncrt_demo.pp
View File

@ -1,97 +0,0 @@
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.

744
packages/ncurses/ncurses.h
View File

@ -1,744 +0,0 @@
/* These are defined only in curses.h, and are used for conditional compiles */
#define NCURSES_VERSION_MAJOR 3
#define NCURSES_VERSION_MINOR 0
#define NCURSES_VERSION_PATCH 980228
/* This is defined in more than one ncurses header, for identification */
#undef NCURSES_VERSION
#define NCURSES_VERSION "3.0"
/*
#ifdef NCURSES_NOMACROS
#define NCURSES_ATTR_T attr_t
#endif
#ifndef NCURSES_ATTR_T
#define NCURSES_ATTR_T int
#endif
#ifndef NCURSES_CONST
#define NCURSES_CONST
#endif
*/
typedef unsigned long chtype;
#define CXX_BUILTIN_BOOL 1
/*
#define CXX_TYPE_OF_BOOL char
*/
/* colors */
extern int COLORS;
extern int COLOR_PAIRS;
#define COLOR_BLACK 0
#define COLOR_RED 1
#define COLOR_GREEN 2
#define COLOR_YELLOW 3
#define COLOR_BLUE 4
#define COLOR_MAGENTA 5
#define COLOR_CYAN 6
#define COLOR_WHITE 7
/* line graphics */
/*
extern chtype acs_map[];
*/
/* VT100 symbols begin here */
/*
#define ACS_ULCORNER (acs_map['l'])
#define ACS_LLCORNER (acs_map['m'])
#define ACS_URCORNER (acs_map['k'])
#define ACS_LRCORNER (acs_map['j'])
#define ACS_LTEE (acs_map['t'])
#define ACS_RTEE (acs_map['u'])
#define ACS_BTEE (acs_map['v'])
#define ACS_TTEE (acs_map['w'])
#define ACS_HLINE (acs_map['q'])
#define ACS_VLINE (acs_map['x'])
#define ACS_PLUS (acs_map['n'])
#define ACS_S1 (acs_map['o'])
#define ACS_S9 (acs_map['s'])
#define ACS_DIAMOND (acs_map['`'])
#define ACS_CKBOARD (acs_map['a'])
#define ACS_DEGREE (acs_map['f'])
#define ACS_PLMINUS (acs_map['g'])
#define ACS_BULLET (acs_map['~'])
#define ACS_LARROW (acs_map[','])
#define ACS_RARROW (acs_map['+'])
#define ACS_DARROW (acs_map['.'])
#define ACS_UARROW (acs_map['-'])
#define ACS_BOARD (acs_map['h'])
#define ACS_LANTERN (acs_map['i'])
#define ACS_BLOCK (acs_map['0'])
#define ACS_S3 (acs_map['p'])
#define ACS_S7 (acs_map['r'])
#define ACS_LEQUAL (acs_map['y'])
#define ACS_GEQUAL (acs_map['z'])
#define ACS_PI (acs_map['{'])
#define ACS_NEQUAL (acs_map['|'])
#define ACS_STERLING (acs_map['}'])
*/
/*
* Line drawing ACS names are of the form ACS_trbl, where t is the top, r
* is the right, b is the bottom, and l is the left. t, r, b, and l might
* be B (blank), S (single), D (double), or T (thick). The subset defined
* here only uses B and S.
*/
/*
#define ACS_BSSB ACS_ULCORNER
#define ACS_SSBB ACS_LLCORNER
#define ACS_BBSS ACS_URCORNER
#define ACS_SBBS ACS_LRCORNER
#define ACS_SBSS ACS_RTEE
#define ACS_SSSB ACS_LTEE
#define ACS_SSBS ACS_BTEE
#define ACS_BSSS ACS_TTEE
#define ACS_BSBS ACS_HLINE
#define ACS_SBSB ACS_VLINE
#define ACS_SSSS ACS_PLUS
*/
#define ERR (-1)
#define OK (0)
#define _SUBWIN 0x01
#define _ENDLINE 0x02
#define _FULLWIN 0x04
#define _SCROLLWIN 0x08
#define _ISPAD 0x10
#define _HASMOVED 0x20
#define _WRAPPED 0x40
/*
* this value is used in the firstchar and lastchar fields to mark
* unchanged lines
*/
#define _NOCHANGE -1
/*
* this value is used in the oldindex field to mark lines created by insertions
* and scrolls.
*/
#define _NEWINDEX -1
/*
typedef struct screen SCREEN;
typedef struct _win_st WINDOW;
*/
typedef chtype attr_t;
struct ldat
{
chtype *text;
short firstchar;
short lastchar;
short oldindex;
};
struct _win_st
{
short _cury, _curx;
short _maxy, _maxx;
short _begy, _begx;
short _flags;
attr_t _attrs;
chtype _bkgd;
bool _notimeout;
bool _clear;
bool _leaveok;
bool _scroll;
bool _idlok;
bool _idcok;
bool _immed;
bool _sync;
bool _use_keypad;
int _delay;
struct ldat *_line;
short _regtop;
short _regbottom;
int _parx;
int _pary;
WINDOW *_parent;
struct pdat
{
short _pad_y, _pad_x;
short _pad_top, _pad_left;
short _pad_bottom, _pad_right;
} _pad;
short _yoffset;
};
extern WINDOW *stdscr;
extern WINDOW *curscr;
extern WINDOW *newscr;
extern int LINES;
extern int COLS;
extern int TABSIZE;
/*
* This global was an undocumented feature under AIX curses.
*/
extern int ESCDELAY;
extern int define_key (char *, int);
extern int keyok (int, bool);
extern int resizeterm (int, int);
extern int use_default_colors (void);
extern int wresize (WINDOW *, int, int);
/*
extern char ttytype[];
*/
extern int baudrate(void);
extern int beep(void);
extern bool can_change_color(void);
extern int cbreak(void);
extern int clearok(WINDOW *,bool);
extern int color_content(short,short*,short*,short*);
extern int copywin(const WINDOW*,WINDOW*,int,int,int,int,int,int,int);
extern int curs_set(int);
extern int def_prog_mode(void);
extern int def_shell_mode(void);
extern int delay_output(int);
extern void delscreen(SCREEN *);
extern int delwin(WINDOW *);
extern WINDOW *derwin(WINDOW *,int,int,int,int);
extern int doupdate(void);
extern WINDOW *dupwin(WINDOW *);
extern int echo(void);
extern int endwin(void);
extern char erasechar(void);
extern void filter(void);
extern int flash(void);
extern int flushinp(void);
extern WINDOW *getwin(FILE *);
extern int halfdelay(int);
extern bool has_colors(void);
extern int has_ic(void);
extern int has_il(void);
extern void idcok(WINDOW *, bool);
extern int idlok(WINDOW *, bool);
extern void immedok(WINDOW *, bool);
extern WINDOW *initscr(void);
extern int init_color(short,short,short,short);
extern int init_pair(short,short,short);
extern int intrflush(WINDOW *,bool);
extern int isendwin(void);
extern int is_linetouched(WINDOW *,int);
extern int is_wintouched(WINDOW *);
extern const char *keyname(int);
extern int keypad(WINDOW *,bool);
extern char killchar(void);
extern int leaveok(WINDOW *,bool);
extern char *longname(void);
extern int meta(WINDOW *,bool);
extern int mvcur(int,int,int,int);
extern int mvderwin(WINDOW *, int, int);
/*
extern int mvprintw(int,int,const char *,...)
GCC_PRINTFLIKE(3,4);
extern int mvscanw(int,int,const char *,...)
GCC_SCANFLIKE(3,4);
*/
extern int mvwin(WINDOW *,int,int);
/*
extern int mvwprintw(WINDOW*,int,int,const char *,...)
GCC_PRINTFLIKE(4,5);
extern int mvwscanw(WINDOW *,int,int,const char *,...)
GCC_SCANFLIKE(4,5);
*/
extern int napms(int);
extern WINDOW *newpad(int,int);
extern SCREEN *newterm(const char *,FILE *,FILE *);
extern WINDOW *newwin(int,int,int,int);
extern int nl(void);
extern int nocbreak(void);
extern int nodelay(WINDOW *,bool);
extern int noecho(void);
extern int nonl(void);
extern int noqiflush(void);
extern int noraw(void);
extern int notimeout(WINDOW *,bool);
extern int overlay(const WINDOW*,WINDOW *);
extern int overwrite(const WINDOW*,WINDOW *);
extern int pair_content(short,short*,short*);
extern int pechochar(WINDOW *, const chtype);
extern int pnoutrefresh(WINDOW*,int,int,int,int,int,int);
extern int prefresh(WINDOW *,int,int,int,int,int,int);
/*
extern int printw(const char *,...)
GCC_PRINTFLIKE(1,2);
*/
extern int putp(const char *);
extern int putwin(WINDOW *, FILE *);
extern int qiflush(void);
extern int raw(void);
extern int resetty(void);
extern int reset_prog_mode(void);
extern int reset_shell_mode(void);
extern int ripoffline(int, int (*init)(WINDOW *, int));
extern int savetty(void);
/*
extern int scanw(const char *,...)
GCC_SCANFLIKE(1,2);
*/
extern int scr_dump(const char *);
extern int scr_init(const char *);
extern int scrollok(WINDOW *,bool);
extern int scr_restore(const char *);
extern int scr_set(const char *);
extern SCREEN *set_term(SCREEN *);
extern int slk_attroff(const attr_t);
extern int slk_attron(const attr_t);
extern int slk_attrset(const attr_t);
extern attr_t slk_attr(void);
extern int slk_clear(void);
extern int slk_init(int);
extern char *slk_label(int);
extern int slk_noutrefresh(void);
extern int slk_refresh(void);
extern int slk_restore(void);
extern int slk_set(int,const char *,int);
extern int slk_touch(void);
extern int start_color(void);
extern WINDOW *subpad(WINDOW *, int, int, int, int);
extern WINDOW *subwin(WINDOW *,int,int,int,int);
extern int syncok(WINDOW *, bool);
extern chtype termattrs(void);
extern char *termname(void);
extern int tigetflag(const char *);
extern int tigetnum(const char *);
extern char *tigetstr(const char *);
extern int typeahead(int);
extern int ungetch(int);
extern void use_env(bool);
extern int vidattr(chtype);
extern int vidputs(chtype, int (*)(int));
extern int vwprintw(WINDOW *,const char *,va_list);
extern int vwscanw(WINDOW *,const char *,va_list);
extern int waddch(WINDOW *, const chtype);
extern int waddchnstr(WINDOW *,const chtype *const,int);
extern int waddnstr(WINDOW *,const char *const,int);
extern int wattr_on(WINDOW *, const attr_t);
extern int wattr_off(WINDOW *, const attr_t);
extern int wbkgd(WINDOW *,const chtype);
extern void wbkgdset(WINDOW *,chtype);
extern int wborder(WINDOW *,chtype,chtype,chtype,chtype,chtype,chtype,chtype,chtype);
extern int wchgat(WINDOW *, int, attr_t, short, const void *);
extern int wclear(WINDOW *);
extern int wclrtobot(WINDOW *);
extern int wclrtoeol(WINDOW *);
extern void wcursyncup(WINDOW *);
extern int wdelch(WINDOW *);
extern int wechochar(WINDOW *, const chtype);
extern int werase(WINDOW *);
extern int wgetch(WINDOW *);
extern int wgetnstr(WINDOW *,char *,int);
extern int whline(WINDOW *, chtype, int);
extern int winchnstr(WINDOW *, chtype *, int);
extern int winnstr(WINDOW *, char *, int);
extern int winsch(WINDOW *, chtype);
extern int winsdelln(WINDOW *,int);
extern int winsnstr(WINDOW *, const char *,int);
extern int wmove(WINDOW *,int,int);
extern int wnoutrefresh(WINDOW *);
/*
extern int wprintw(WINDOW *,const char *,...)
GCC_PRINTFLIKE(2,3);
*/
extern int wredrawln(WINDOW *,int,int);
extern int wrefresh(WINDOW *);
/*
extern int wscanw(WINDOW *,const char *,...)
GCC_SCANFLIKE(2,3);
*/
extern int wscrl(WINDOW *,int);
extern int wsetscrreg(WINDOW *,int,int);
extern void wsyncdown(WINDOW *);
extern void wsyncup(WINDOW *);
extern int wtimeout(WINDOW *,int);
extern int wtouchln(WINDOW *,int,int,int);
extern int wvline(WINDOW *,chtype,int);
#define NCURSES_BITS(mask,shift) ((mask) << ((shift) + 8))
#define A_NORMAL 0L
/*
#define A_ATTRIBUTES NCURSES_BITS(~(1UL - 1UL),0)
*/
#define A_CHARTEXT (NCURSES_BITS(1UL,0) - 1UL)
#define A_COLOR NCURSES_BITS(((1UL) << 8) - 1UL,0)
#define A_STANDOUT NCURSES_BITS(1UL,8)
#define A_UNDERLINE NCURSES_BITS(1UL,9)
#define A_REVERSE NCURSES_BITS(1UL,10)
#define A_BLINK NCURSES_BITS(1UL,11)
#define A_DIM NCURSES_BITS(1UL,12)
#define A_BOLD NCURSES_BITS(1UL,13)
#define A_ALTCHARSET NCURSES_BITS(1UL,14)
#define A_INVIS NCURSES_BITS(1UL,15)
#define A_PROTECT NCURSES_BITS(1UL,16)
#define A_HORIZONTAL NCURSES_BITS(1UL,17)
#define A_LEFT NCURSES_BITS(1UL,18)
#define A_LOW NCURSES_BITS(1UL,19)
#define A_RIGHT NCURSES_BITS(1UL,20)
#define A_TOP NCURSES_BITS(1UL,21)
#define A_VERTICAL NCURSES_BITS(1UL,22)
#define COLOR_PAIR(n) NCURSES_BITS(n, 0)
#define PAIR_NUMBER(a) (((a) & A_COLOR) >> 8)
/*
* pseudo functions
*/
#define wgetstr(w, s) wgetnstr(w, s, -1)
#define getnstr(s, n) wgetnstr(stdscr, s, n)
#define setterm(term) setupterm(term, 1, (int *)0)
#define fixterm() reset_prog_mode()
#define resetterm() reset_shell_mode()
#define saveterm() def_prog_mode()
#define crmode() cbreak()
#define nocrmode() nocbreak()
/*
#define getyx(win,y,x) (y = (win)?(win)->_cury:ERR, x = (win)?(win)->_curx:ERR)
#define getbegyx(win,y,x) (y = (win)?(win)->_begy:ERR, x = (win)?(win)->_begx:ERR)
#define getmaxyx(win,y,x) (y = (win)?((win)->_maxy + 1):ERR, x = (win)?((win)->_maxx + 1):ERR)
#define getparyx(win,y,x) (y = (win)?(win)->_pary:ERR, x = (win)?(win)->_parx:ERR)
*/
#define getsyx(y,x) getyx(stdscr, y, x)
/*
#define setsyx(y,x) (stdscr->_cury = y, stdscr->_curx = x)
*/
#define getattrs(win) ((win)?(win)->_attrs:A_NORMAL)
#define getcurx(win) ((win)?(win)->_curx:ERR)
#define getcury(win) ((win)?(win)->_cury:ERR)
#define getbegx(win) ((win)?(win)->_begx:ERR)
#define getbegy(win) ((win)?(win)->_begy:ERR)
#define getmaxx(win) ((win)?((win)->_maxx + 1):ERR)
#define getmaxy(win) ((win)?((win)->_maxy + 1):ERR)
#define getparx(win) ((win)?(win)->_parx:ERR)
#define getpary(win) ((win)?(win)->_pary:ERR)
/*
#define winch(win) ((win)?(win)->_line[(win)->_cury].text[(win)->_curx]:0)
*/
#define wstandout(win) (wattr_set(win,A_STANDOUT))
#define wstandend(win) (wattr_set(win,A_NORMAL))
/*
#define wattr_set(win,at) ((win)?((win)->_attrs = (at)):0)
*/
#define wattron(win,at) wattr_on(win, at)
#define wattroff(win,at) wattr_off(win, at)
#define wattrset(win,at) wattr_set(win, at)
#define scroll(win) wscrl(win,1)
#define touchwin(win) wtouchln((win), 0, getmaxy(win), 1)
#define touchline(win, s, c) wtouchln((win), s, c, 1)
#define untouchwin(win) wtouchln((win), 0, getmaxy(win), 0)
#define box(win, v, h) wborder(win, v, v, h, h, 0, 0, 0, 0)
#define border(ls, rs, ts, bs, tl, tr, bl, br) wborder(stdscr, ls, rs, ts, bs, tl, tr, bl, br)
#define hline(ch, n) whline(stdscr, ch, n)
#define vline(ch, n) wvline(stdscr, ch, n)
#define winstr(w, s) winnstr(w, s, -1)
#define winchstr(w, s) winchnstr(w, s, -1)
#define winsstr(w, s) winsnstr(w, s, -1)
#define redrawwin(w) wredrawln(w, 0, w->_maxy+1)
#define waddstr(win,str) waddnstr(win,st,-1)
#define waddchstr(win,st) waddchnstr(win,st,-1)
/*
* pseudo functions for standard screen
*/
#define addch(ch) waddch(stdscr,ch)
#define addchnstr(st,n) waddchnstr(stdscr,st,n)
#define addchstr(st) waddchstr(stdscr,st)
#define addnstr(st,n) waddnstr(stdscr,st,n)
#define addstr(st) waddnstr(stdscr,st,-1)
#define attroff(at) wattroff(stdscr,at)
#define attron(at) wattron(stdscr,at)
#define attrset(at) wattrset(stdscr,at)
#define bkgd(ch) wbkgd(stdscr,ch)
#define bkgdset(ch) wbkgdset(stdscr,ch)
#define clear() wclear(stdscr)
#define clrtobot() wclrtobot(stdscr)
#define clrtoeol() wclrtoeol(stdscr)
#define delch() wdelch(stdscr)
#define deleteln() winsdelln(stdscr,-1)
#define echochar(c) wechochar(stdscr,c)
#define erase() werase(stdscr)
#define getch() wgetch(stdscr)
#define getstr(st) wgetstr(stdscr,st)
#define inch() winch(stdscr)
#define inchnstr(s,n) winchnstr(stdscr,s,n)
#define inchstr(s) winchstr(stdscr,s)
#define innstr(s,n) winnstr(stdscr,s,n)
#define insch(c) winsch(stdscr,c)
#define insdelln(n) winsdelln(stdscr,n)
#define insertln() winsdelln(stdscr,1)
#define insnstr(s,n) winsnstr(stdscr,s,n)
#define insstr(s) winsstr(stdscr,s)
#define instr(s) winstr(stdscr,s)
#define move(y,x) wmove(stdscr,y,x)
#define refresh() wrefresh(stdscr)
#define scrl(n) wscrl(stdscr,n)
#define setscrreg(t,b) wsetscrreg(stdscr,t,b)
#define standend() wstandend(stdscr)
#define standout() wstandout(stdscr)
#define timeout(delay) wtimeout(stdscr,delay)
#define wdeleteln(win) winsdelln(win,-1)
#define winsertln(win) winsdelln(win,1)
/*
* mv functions
*/
/*
#define mvwaddch(win,y,x,ch) (wmove(win,y,x) == ERR ? ERR : waddch(win,ch))
#define mvwaddchnstr(win,y,x,st,n) (wmove(win,y,x) == ERR ? ERR : waddchnstr(win,st,n))
#define mvwaddchstr(win,y,x,st) (wmove(win,y,x) == ERR ? ERR : waddchnstr(win,st,-1))
#define mvwaddnstr(win,y,x,st,n) (wmove(win,y,x) == ERR ? ERR : waddnstr(win,st,n))
#define mvwaddstr(win,y,x,st) (wmove(win,y,x) == ERR ? ERR : waddnstr(win,st,-1))
#define mvwdelch(win,y,x) (wmove(win,y,x) == ERR ? ERR : wdelch(win))
#define mvwgetch(win,y,x) (wmove(win,y,x) == ERR ? ERR : wgetch(win))
#define mvwgetnstr(win,y,x,st,n) (wmove(win,y,x) == ERR ? ERR : wgetnstr(win,st,n))
#define mvwgetstr(win,y,x,st) (wmove(win,y,x) == ERR ? ERR : wgetstr(win,st))
#define mvwhline(win,y,x,c,n) (wmove(win,y,x) == ERR ? ERR : whline(win,c,n))
#define mvwinch(win,y,x) (wmove(win,y,x) == ERR ? (chtype)ERR : winch(win))
#define mvwinchnstr(win,y,x,s,n) (wmove(win,y,x) == ERR ? ERR : winchnstr(win,s,n))
#define mvwinchstr(win,y,x,s) (wmove(win,y,x) == ERR ? ERR : winchstr(win,s))
#define mvwinnstr(win,y,x,s,n) (wmove(win,y,x) == ERR ? ERR : winnstr(win,s,n))
#define mvwinsch(win,y,x,c) (wmove(win,y,x) == ERR ? ERR : winsch(win,c))
#define mvwinsnstr(win,y,x,s,n) (wmove(win,y,x) == ERR ? ERR : winsnstr(win,s,n))
#define mvwinsstr(win,y,x,s) (wmove(win,y,x) == ERR ? ERR : winsstr(win,s))
#define mvwinstr(win,y,x,s) (wmove(win,y,x) == ERR ? ERR : winstr(win,s))
#define mvwvline(win,y,x,c,n) (wmove(win,y,x) == ERR ? ERR : wvline(win,c,n))
*/
#define mvaddch(y,x,ch) mvwaddch(stdscr,y,x,ch)
#define mvaddchnstr(y,x,st,n) mvwaddchnstr(stdscr,y,x,st,n)
#define mvaddchstr(y,x,st) mvwaddchstr(stdscr,y,x,st)
#define mvaddnstr(y,x,st,n) mvwaddnstr(stdscr,y,x,st,n)
#define mvaddstr(y,x,st) mvwaddstr(stdscr,y,x,st)
#define mvdelch(y,x) mvwdelch(stdscr,y,x)
#define mvgetch(y,x) mvwgetch(stdscr,y,x)
#define mvgetnstr(y,x,st,n) mvwgetnstr(stdscr,y,x,st,n)
#define mvgetstr(y,x,st) mvwgetstr(stdscr,y,x,st)
#define mvhline(y,x,c,n) mvwhline(stdscr,y,x,c,n)
#define mvinch(y,x) mvwinch(stdscr,y,x)
#define mvinchnstr(y,x,s,n) mvwinchnstr(stdscr,y,x,s,n)
#define mvinchstr(y,x,s) mvwinchstr(stdscr,y,x,s)
#define mvinnstr(y,x,s,n) mvwinnstr(stdscr,y,x,s,n)
#define mvinsch(y,x,c) mvwinsch(stdscr,y,x,c)
#define mvinsnstr(y,x,s,n) mvwinsnstr(stdscr,y,x,s,n)
#define mvinsstr(y,x,s) mvwinsstr(stdscr,y,x,s)
#define mvinstr(y,x,s) mvwinstr(stdscr,y,x,s)
#define mvvline(y,x,c,n) mvwvline(stdscr,y,x,c,n)
#define add_wch(c) wadd_wch(stsdscr,c)
#define addnwstr(wstr,n) waddnwstr(stdscr,wstr,n)
#define addwstr(wstr,n) waddnwstr(stdscr,wstr,-1)
#define attr_get() wattr_get(stdscr)
#define attr_off(a) wattr_off(stdscr,a)
#define attr_on(a) wattr_on(stdscr,a)
#define attr_set(a) wattr_set(stdscr,a)
#define box_set(w,v,h) wborder_set(w,v,v,h,h,0,0,0,9)
#define chgat(n,a,c,o) wchgat(stdscr,n,a,c,o)
#define echo_wchar(c) wecho_wchar(stdscr,c)
#define getbkgd(win) ((win)->_bkgd)
#define get_wch(c) wget_wch(stdscr,c)
#define get_wstr(t) wgetn_wstr(stdscr,t,-1)
#define getn_wstr(t,n) wgetn_wstr(stdscr,t,n)
#define hline_set(c,n) whline_set(stdscr,c,n)
#define in_wch(c) win_wch(stdscr,c)
#define in_wchnstr(c,n) win_wchnstr(stdscr,c,n)
#define in_wchstr(c) win_wchnstr(stdscr,c,-1)
#define innwstr(c,n) winnwstr(stdscr,c,n)
#define ins_nwstr(t,n) wins_nwstr(stdscr,t,n)
#define ins_wch(c) wins_wch(stdscr,c)
#define ins_wstr(t) wins_nwstr(stdscr,t,-1)
#define inwstr(c) winnwstr(stdscr,c,-1)
#define mvadd_wch(y,x,c) mvwadd_wch(stdscr,y,x,c)
#define mvaddnwstr(y,x,wstr,n) mvwaddnwstr(stdscr,y,x,wstr,n)
#define mvaddwstr(y,x,wstr,n) mvwaddnwstr(stdscr,y,x,wstr,-1)
#define mvchgat(y,x,n,a,c,o) mvwchgat(stdscr,y,x,n,a,c,o)
#define mvget_wch(y,x,c) mvwget_wch(stdscr,y,x,c)
#define mvget_wstr(y,x,t) mvwgetn_wstr(stdscr,y,x,t,-1)
#define mvgetn_wstr(y,x,t,n) mvwgetn_wstr(stdscr,y,x,t,n)
#define mvhline_set(y,x,c,n) mvwhline_set(stdscr,y,x,c,n)
#define mvin_wch(y,x,c) mvwin_wch(stdscr,y,x,c)
#define mvin_wchnstr(y,x,c,n) mvwin_wchnstr(stdscr,y,x,c,n)
#define mvin_wchstr(y,x,c) mvwin_wchnstr(stdscr,y,x,c,-1)
#define mvinnwstr(y,x,c,n) mvwinnwstr(stdscr,y,x,c,n)
#define mvins_nwstr(y,x,t,n) mvwins_nwstr(stdscr,y,x,t,n)
#define mvins_wch(y,x,c) mvwins_wch(stdscr,y,x,c)
#define mvins_wstr(y,x,t) mvwins_nwstr(stdscr,y,x,t,-1)
#define mvinwstr(y,x,c) mvwinnwstr(stdscr,y,x,c,-1)
#define mvvline_set(y,x,c,n) mvwvline_set(stdscr,y,x,c,n)
/*
#define mvwadd_wch(y,x,win,c) (wmove(win,y,x) == ERR ? ERR : wadd_wch(stsdscr,c))
#define mvwaddnwstr(y,x,win,wstr,n) (wmove(win,y,x) == ERR ? ERR : waddnwstr(stdscr,wstr,n))
#define mvwaddwstr(y,x,win,wstr,n) (wmove(win,y,x) == ERR ? ERR : waddnwstr(stdscr,wstr,-1))
#define mvwchgat(win,y,x,n,a,c,o) (wmove(win,y,x) == ERR ? ERR : wchgat(win,n,a,c,o))
#define mvwget_wch(win,y,x,c) (wmove(win,y,x) == ERR ? ERR : wget_wch(win,n))
#define mvwget_wstr(win,y,x,t) (wmove(win,y,x) == ERR ? ERR : wgetn_wstr(win,t,-1))
#define mvwgetn_wstr(win,y,x,t,n) (wmove(win,y,x) == ERR ? ERR : wgetn_wstr(win,t,n))
#define mvwhline_set(win,y,x,c,n) (wmove(win,y,x) == ERR ? ERR : whline_set(win,c,n))
#define mvwin_wch(win,y,x,c) (wmove(win,y,x) == ERR ? ERR : win_wch(win,c))
#define mvwin_wchnstr(win,y,x,c,n) (wmove(win,y,x) == ERR ? ERR : win_wchnstr(stdscr,c,n))
#define mvwin_wchstr(win,y,x,c) (wmove(win,y,x) == ERR ? ERR : win_wchnstr(stdscr,c,-1))
#define mvwinnwstr(win,y,x,c,n) (wmove(win,y,x) == ERR ? ERR : winnwstr(stdscr,c,n))
#define mvwins_nwstr(win,y,x,t,n) (wmove(win,y,x) == ERR ? ERR : wins_nwstr(stdscr,t,n))
#define mvwins_wch(win,y,x,c) (wmove(win,y,x) == ERR ? ERR : wins_wch(c))
#define mvwins_wstr(win,y,x,t) (wmove(win,y,x) == ERR ? ERR : wins_nwstr(stdscr,t,-1))
#define mvwinwstr(win,y,x,c) (wmove(win,y,x) == ERR ? ERR : winnwstr(stdscr,c,-1))
#define mvwvline_set(win,y,x,c,n) (wmove(win,y,x) == ERR ? ERR : wvline_set(win,c,n))
*/
#define slk_attr_off(a) slk_attroff(a)
#define slk_attr_on(a) slk_attron(a)
#define slk_attr_set(a) slk_attrset(a)
#define vid_attr(a) vidattr(a)
#define vline_set(c,n) vhline_set(stdscr,c,n)
#define waddwstr(win,wstr,n) waddnwstr(win,wstr,-1)
#define wattr_get(win) ((win)->_attrs)
#define wget_wstr(w,t) wgetn_wstr(w,t,-1)
#define win_wchstr(w,c) win_wchnstr(w,c,-1)
#define wins_wstr(w,t) wins_nwstr(w,t,-1)
#define winwstr(w,c) winnwstr(w,c,-1)
/*
* Pseudo-character tokens outside ASCII range. The curses wgetch() function
* will return any given one of these only if the corresponding k- capability
* is defined in your terminal's terminfo entry.
*/
#define KEY_CODE_YES 0400
#define KEY_MIN 0401
#define KEY_BREAK 0401
#define KEY_DOWN 0402
#define KEY_UP 0403
#define KEY_LEFT 0404
#define KEY_RIGHT 0405
#define KEY_HOME 0406
#define KEY_BACKSPACE 0407
#define KEY_F0 0410
#define KEY_F(n) (KEY_F0+(n))
#define KEY_DL 0510
#define KEY_IL 0511
#define KEY_DC 0512
#define KEY_IC 0513
#define KEY_EIC 0514
#define KEY_CLEAR 0515
#define KEY_EOS 0516
#define KEY_EOL 0517
#define KEY_SF 0520
#define KEY_SR 0521
#define KEY_NPAGE 0522
#define KEY_PPAGE 0523
#define KEY_STAB 0524
#define KEY_CTAB 0525
#define KEY_CATAB 0526
#define KEY_ENTER 0527
#define KEY_SRESET 0530
#define KEY_RESET 0531
#define KEY_PRINT 0532
#define KEY_LL 0533
#define KEY_A1 0534
#define KEY_A3 0535
#define KEY_B2 0536
#define KEY_C1 0537
#define KEY_C3 0540
#define KEY_BTAB 0541
#define KEY_BEG 0542
#define KEY_CANCEL 0543
#define KEY_CLOSE 0544
#define KEY_COMMAND 0545
#define KEY_COPY 0546
#define KEY_CREATE 0547
#define KEY_END 0550
#define KEY_EXIT 0551
#define KEY_FIND 0552
#define KEY_HELP 0553
#define KEY_MARK 0554
#define KEY_MESSAGE 0555
#define KEY_MOVE 0556
#define KEY_NEXT 0557
#define KEY_OPEN 0560
#define KEY_OPTIONS 0561
#define KEY_PREVIOUS 0562
#define KEY_REDO 0563
#define KEY_REFERENCE 0564
#define KEY_REFRESH 0565
#define KEY_REPLACE 0566
#define KEY_RESTART 0567
#define KEY_RESUME 0570
#define KEY_SAVE 0571
#define KEY_SBEG 0572
#define KEY_SCANCEL 0573
#define KEY_SCOMMAND 0574
#define KEY_SCOPY 0575
#define KEY_SCREATE 0576
#define KEY_SDC 0577
#define KEY_SDL 0600
#define KEY_SELECT 0601
#define KEY_SEND 0602
#define KEY_SEOL 0603
#define KEY_SEXIT 0604
#define KEY_SFIND 0605
#define KEY_SHELP 0606
#define KEY_SHOME 0607
#define KEY_SIC 0610
#define KEY_SLEFT 0611
#define KEY_SMESSAGE 0612
#define KEY_SMOVE 0613
#define KEY_SNEXT 0614
#define KEY_SOPTIONS 0615
#define KEY_SPREVIOUS 0616
#define KEY_SPRINT 0617
#define KEY_SREDO 0620
#define KEY_SREPLACE 0621
#define KEY_SRIGHT 0622
#define KEY_SRSUME 0623
#define KEY_SSAVE 0624
#define KEY_SSUSPEND 0625
#define KEY_SUNDO 0626
#define KEY_SUSPEND 0627
#define KEY_UNDO 0630
#define KEY_MOUSE 0631
#define KEY_RESIZE 0632
#define KEY_MAX 0777
extern int mcprint(char *, int);
extern int has_key(int);

1362
packages/ncurses/ocrt.pp Normal file
View File

File diff suppressed because it is too large Load Diff

219
packages/ncurses/ocrt_demo.pp Normal file
View File

@ -0,0 +1,219 @@
Program ocrt_demo;
{---------------------------------------------------------------------------
CncWare
(c) Copyright 1999
---------------------------------------------------------------------------
Filename..: ocrt_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.
1.01 | 12/10/99 | kjw | Added OOP stuff.
1.02 | 12/13/99 | kjw | 1) Changed from nCrt to oCrt.
| 2) Renamed from ncrt_demo to ocrt_demo.
| 3) Added some standard crt code at beginning.
1.03 | 01/06/00 | kjw | Some minor changes for ncrt mods.
------------------------------------------------------------------------------
}
uses oCrt;
var
win,win1,
stdscr : pwin;
s : string;
c : char;
i,j,k,x,y : integer;
var
win11,win22 : pnWindow;
win33,msgbox : TnWindow;
Begin
{ some nCrt standard in/out stuff, like crt }
TextColor(15);
TextBackground(1);
TextAttr := TextAttr + blink;
ClrScr;
GotoXY(2,35);
Writeln(1.0:0:4,' This is a test!');
Window(10,10,70,15);
TextAttr := TextAttr - blink;
TextBackground(2);
ClrScr;
s := ' : ';
for i := 1 to 6 do
writeln(i:0,s,'this is a test');
writeln('Press Enter');
readln(s);
TextBackground(3);
Write('input a number [i]: ');
Readln(i);
Write('input two numbers [j k]: ');
Readln(j,k);
Window(20,11,60,16);
TextBackground(0);
TextColor(15);
ClrScr;
writeln('i: ',i);
writeln('j: ',j);
writeln('k: ',k);
Write('Press a key: ');
readkey;
TextMode(LastMode);
write('Press a key: ');
repeat until keypressed;
while keypressed do readkey;
{ now some oCrt basics }
stdscr := nscreen;
nClrScr(stdscr,7);
nDrawBox(stdscr,btSingle,1,1,80,3,31);
FWrite(27,2,30,0,'nCrt Demonstration Program');
nNewWindow(win1,9,9,71,16);
nClrScr(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);
s := nReadln(win);
If s <> 'oop' Then Begin { skip right to OOP section? }
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);
{ force nCrt to use full screen }
nSetActiveWin(stdscr);
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;
{ turn off oCrt keyboard echo }
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(stdscr,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);
End;
{ and now for some object oCrt }
win := nscreen;
New(win11,Init(1,1,80,25,31,true,30));
win11^.PutHeader(' Now for some OOP with nCrt! ',79,center);
win11^.DrawBox(1,1,1,78,3,62);
New(win22,Init(20,7,60,17,47,false,0));
win33.Init(30,15,50,20,79,true,78);
win33.PutHeader(' Little Window ',15,right);
win33.Writeln('And here is window #3');
win11^.Show;
win11^.GotoXY(2,2);
win11^.Write('Please press a key...');
win11^.ReadKey;
msgbox.init(25,11,55,13,47,true,47);
s := 'Please enter a string';
msgbox.FWrite((msgbox.cols-length(s)) div 2,1,46,0,s);
msgbox.Show;
win11^.GotoXY(1,10);
msgbox.Show;
{ turn on oCrt keyboard echo }
nEcho(true);
s := win11^.Readln;
msgbox.Hide;
win22^.Show;
win22^.Writeln(s);
Delay(2000);
win11^.Hide;
win22^.Writeln('Hiding window 1...');
Delay(2000);
win33.Show;
Delay(2000);
win11^.Show;
win11^.Writeln('Showing window 1');
win22^.Show;
win22^.Writeln('Showing window 2');
win33.Show;
win33.Write('Showing window 3');
nKeypressed(2000);
While Keypressed Do Readkey;
win11^.Hide;
win33.Write('Hiding window 1');
win22^.PutFrame(62);
win22^.PutHeader(' New frame color ',63,center);
win22^.Show;
win33.Show;
nKeypressed(3000);
While Keypressed Do Readkey;
win22^.Hide;
win33.Write('Hiding window 2');
nKeypressed(2000);
While Keypressed Do Readkey;
win33.SetColor(47);
nKeypressed(2000);
While Keypressed Do Readkey;
x := 30;
y := 15;
win33.ClrScr;
for i := 1 to 11 do Begin
dec(x);
dec(y);
str(i:0,s);
win33.Move(x,y);
win33.Writeln('Moved by '+s);
FWrite(1,25,63,80,'Moved by '+s);
Delay(250);
End;
win33.Align(center,none);
win33.PutHeader('Left Header',14,left);
win33.Show;
Delay(1000);
win33.PutHeader('Right Header',14,right);
win33.Show;
Delay(1000);
win33.PutHeader('Center Header',15,center);
win33.Show;
Delay(2000);
Dispose(win11,Done);
Dispose(win22,Done);
win33.Done;
msgbox.Done;
End.

82
packages/ncurses/panel.pp Normal file
View File

@ -0,0 +1,82 @@
unit panel;
{---------------------------------------------------------------------------
CncWare
(c) Copyright 1999
----------------------------------------------------------------------------
Filename..: panel.pp
Programmer: Ken J. Wright
Date......: 12/08/1999
Purpose - Link to the Linux 'panel' library for ncurses windowing
functions. The panel library handles overlapping windows,
whereas, native ncurses windowing is only tiled.
-------------------------------< Revisions >---------------------------------
Revision| Date | Prog| Description
-----------------------------------------------------------------------------
1.00 | 12/08/99 | kjw | Initial release.
-----------------------------------------------------------------------------
}
interface
uses ncurses;
{$PACKRECORDS 4}
{$linklib panel}
type
pPANEL = ^_PANEL;
_PANEL = record
win : ^WINDOW;
wstarty : longint;
wendy : longint;
wstartx : longint;
wendx : longint;
below : ^_panel;
above : ^_panel;
user : longint; { NCURSES_CONST void user; }
obscure : pointer;
end;
function panel_window(_para1:pPANEL):pWINDOW;cdecl;
procedure update_panels;cdecl;
function hide_panel(_para1:pPANEL):longint;cdecl;
function show_panel(_para1:pPANEL):longint;cdecl;
function del_panel(_para1:pPANEL):longint;cdecl;
function top_panel(_para1:pPANEL):longint;cdecl;
function bottom_panel(_para1:pPANEL):longint;cdecl;
function new_panel(_para1:pWINDOW):pPANEL;cdecl;
function panel_above(_para1:pPANEL):pPANEL;cdecl;
function panel_below(_para1:pPANEL):pPANEL;cdecl;
{ extern int set_panel_userptr(PANEL , NCURSES_CONST void ); }
{ extern NCURSES_CONST void panel_userptr(const PANEL ); }
function move_panel(_para1:pPANEL; _para2:longint; _para3:longint):longint;cdecl;
function replace_panel(_para1:pPANEL; _para2:pWINDOW):longint;cdecl;
function panel_hidden(_para1:pPANEL):longint;cdecl;
implementation
const External_library='';
function panel_window(_para1:pPANEL):pWINDOW;cdecl;External;
procedure update_panels;cdecl;External;
function hide_panel(_para1:pPANEL):longint;cdecl;External;
function show_panel(_para1:pPANEL):longint;cdecl;External;
function del_panel(_para1:pPANEL):longint;cdecl;External;
function top_panel(_para1:pPANEL):longint;cdecl;External;
function bottom_panel(_para1:pPANEL):longint;cdecl;External;
function new_panel(_para1:pWINDOW):pPANEL;cdecl;External;
function panel_above(_para1:pPANEL):pPANEL;cdecl;External;
function panel_below(_para1:pPANEL):pPANEL;cdecl;External;
{ extern int set_panel_userptr(PANEL , NCURSES_CONST void ); }
{ extern NCURSES_CONST void panel_userptr(const PANEL ); }
function move_panel(_para1:pPANEL; _para2:longint; _para3:longint):longint;cdecl;External;
function replace_panel(_para1:pPANEL; _para2:pWINDOW):longint;cdecl;External;
function panel_hidden(_para1:pPANEL):longint;cdecl;External;
end.