+ Merged changes and additions from fixbranch

This commit is contained in:
michael 2000-08-29 05:51:09 +00:00
parent bec1c5cdf9
commit 558f3cd963
13 changed files with 2457 additions and 306 deletions

View File

@ -1,5 +1,5 @@
# #
# Makefile generated by fpcmake v0.99.15 [2000/07/02] # Makefile generated by fpcmake v1.00 [2000/07/11]
# #
defaultrule: all defaultrule: all
@ -184,8 +184,8 @@ endif
# Targets # Targets
override UNITOBJECTS+=ncurses panel ncrt ocrt override UNITOBJECTS+=ncurses panel ncrt ocrt menu
override EXAMPLEOBJECTS+=firework testn ocrt_demo edit_demo db_demo override EXAMPLEOBJECTS+=firework testn ocrt_demo edit_demo db_demo screen_demo
# Clean # Clean

View File

@ -3,8 +3,8 @@
# #
[targets] [targets]
units=ncurses panel ncrt ocrt units=ncurses panel ncrt ocrt menu
examples=firework testn ocrt_demo edit_demo db_demo examples=firework testn ocrt_demo edit_demo db_demo screen_demo
[install] [install]
examplesubdir=ncurses examplesubdir=ncurses

View File

@ -188,7 +188,10 @@ Begin
End. End.
{ {
$Log$ $Log$
Revision 1.3 2000-08-20 10:11:41 jonas Revision 1.4 2000-08-29 05:51:09 michael
+ Merged changes and additions from fixbranch
Revision 1.3 2000/08/20 10:11:41 jonas
* added missing open comment at start of log section * added missing open comment at start of log section
Revision 1.2 2000/07/13 11:33:26 michael Revision 1.2 2000/07/13 11:33:26 michael

View File

@ -7,7 +7,7 @@ Program Edit_Demo;
Programmer: Ken J. Wright, ken@cncware.com Programmer: Ken J. Wright, ken@cncware.com
Date......: 12/12/99 Date......: 12/12/99
Purpose - Demonstrate the use of nCrt unit. Purpose - Demonstrate the use of the oCrt unit.
-------------------------------<< REVISIONS >>-------------------------------- -------------------------------<< REVISIONS >>--------------------------------
Ver | Date | Prog| Description Ver | Date | Prog| Description
@ -16,22 +16,320 @@ Program Edit_Demo;
1.01 | 12/13/99 | kjw | Changed to use oCrt. 1.01 | 12/13/99 | kjw | Changed to use oCrt.
1.02 | 06/16/00 | kjw | Added help & goto line pop-up screens. 1.02 | 06/16/00 | kjw | Added help & goto line pop-up screens.
| Changes for control keys. | Changes for control keys.
1.03 | 07/25/00 | kjw | Added use of new tnMenu object.
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
} }
uses oCrt; uses oCrt;
var
ss : array[1..25] of string[80];
xp,yp : string;
c : char;
win1,status : tnWindow;
idx : integer;
Finished : boolean;
const
MAXLINES = 52; { allow for long screens }
CURLINES : Integer = MAXLINES; { adjusted later }
FRAMED = true;
NOFRAME = false;
bg = 16; { background color multiplier }
type
{ doubly linked list of strings to edit }
pLine = ^tLine;
tLine = Record
s : ^string;
next,
prev : pLine;
End;
s80 = string[80];
var
hdr, { list head }
line, { current position in list }
line1 : pLine; { first list item of current page }
ss : array[1..MAXLINES] of s80; { a sliding screen buffer }
xp,yp : string; { x & y positions for the status line }
EdWin, { main edit window }
StatWin : tnWindow; { status line }
mnu0 : tnMenu; { main menu }
mnu1 : pnMenu; { dynamic menu for sub menus }
xi, { integer scratch pad }
cv, { edit character return value }
idx : integer; { current screen buffer row index }
cline, { current line number }
dlines : integer; { number of displayed lines }
lines : longint; { total number of lines in the list }
mactive, { is the menu active? }
Finished : boolean; { exit when finished }
tf : text; { the text file we are reading/writing }
fnam : string; { name of the current file, tf }
{ replace the old string with a new one }
Procedure ReallocateLine(var p : pLine; s : string);
Begin
If p = Nil Then Exit;
If p^.s^ <> s Then Begin
FreeMem(p^.s,Length(p^.s^)+1);
GetMem(p^.s,Length(s)+1);
p^.s^ := s;
End;
End;
{ insert a new pline into the edit list before p }
Procedure InsertLine(var p : pLine; s : string);
Var
tmp : pLine;
Begin
New(tmp);
GetMem(tmp^.s,Length(s)+1);
tmp^.s^ := s;
tmp^.prev := p^.prev;
tmp^.next := p;
p^.prev := tmp;
tmp^.prev^.next := tmp;
inc(lines);
End;
{ delete a pline from the edit list }
Procedure DeleteLine(var p : pLine);
Var
tmp : pLine;
Begin
FreeMem(p^.s,Length(p^.s^));
tmp := p^.next;
tmp^.prev := p^.prev;
p^.prev^.next := tmp;
Dispose(p);
p := tmp;
dec(lines);
If cline > lines Then cline := lines;
End;
{ return the minimum of two integer values }
Function Min(i1,i2 : integer) : integer;
Begin
If i1 < i2 Then
Min := i1
Else
Min := i2;
End;
{ fill the edit buffer starting with position h in the edit list }
Procedure LoadLines(var h : pLine);
Var
tmp : pLine;
i : integer;
Begin
FillChar(ss,SizeOf(ss),#0);
tmp := h;
If tmp = hdr Then tmp := tmp^.Next;
For i := 1 to CURLINES Do Begin
If (tmp <> Nil) and (tmp <> hdr) Then Begin
ss[i] := tmp^.s^;
tmp := tmp^.next;
dlines := i;
End;
End;
End;
{ display the edit buffer in the edit window }
Procedure DisplayLines;
Var
i : integer;
Begin
With EdWin Do Begin
For i := 1 to CURLINES Do Begin
FWrite(1,i,GetColor,Cols,ss[i]);
End;
End;
End;
{ free the entire edit list }
Procedure ClearLines(var h : pLine);
Var
tmp : pLine;
Begin
If h <> Nil Then Begin
tmp := h^.prev;
If (tmp <> h) and (tmp^.s <> Nil) Then Begin
FreeMem(tmp^.s,Length(tmp^.s^)+1);
tmp^.next := h;
Dispose(tmp);
End;
End;
New(h);
h^.next := h;
h^.prev := h;
h^.s := nil;
End;
Function PromptFile(hs : string; var s : string) : integer;
Var
win : pnWindow;
ret : integer;
Begin
New(win,Init(1,1,EdWin.Cols,3,cyan*bg,FRAMED,cyan*bg+white));
With win^ Do Begin
PutHeader(hs,GetFrameColor,center);
FWrite(2,1,GetColor,0,'Filename: ');
Align(center,center);
Show;
s := Edit(12,1,GetColor+white,Cols,12,fnam,ret);
PromptFile := ret;
Hide;
End;
Dispose(win,Done);
End;
{ prompt for, and open a text file }
Function OpenFile(var f : text; prompt : boolean) : boolean;
Var
s : string;
tst : text;
ret : integer;
Begin
If prompt Then
ret := PromptFile('Open File',s)
Else Begin
s := fnam;
ret := nkEnter;
End;
If ret = nkEnter Then Begin
Assign(tst,s);
{$I-}
Reset(tst);
{$I+}
If IoResult = 0 Then Begin
Close(tst);
Assign(f,s);
Reset(f);
OpenFile := true;
fnam := s;
End Else Begin
nShowMessage('Could not open file "'+s+'"',79,' Error ',78,true);
OpenFile := false;
End;
End Else
OpenFile := false;
End;
{ read a file line by line into the edit list }
Procedure ReadFile(var f : text; prompt : boolean);
Var
err : boolean;
s : string;
win : pnWindow;
Begin
If Not OpenFile(f,prompt) Then Exit;
ClearLines(hdr);
lines := 0;
win := nShowMessage('Reading "'+fnam+'"...',47,' Open File ',46,false);
{$I-}
Repeat
If Not Eof(f) Then Begin
Readln(f,s);
err := (IoResult <> 0);
If Not Err Then InsertLine(hdr,s);
End;
Until Eof(f) or err;
Close(f);
{$I+}
win^.Hide;
win^.Done;
line1 := hdr^.next;
line := line1;
LoadLines(line1);
DisplayLines;
idx := 1;
End;
{ save the edit list to disk }
Procedure SaveFile(var f : text);
Var
tmp : text;
s,
tnam : string;
cur : pLine;
win : pnWindow;
Begin
If PromptFile('Save File',s) = nkEsc Then
Exit
Else
fnam := s;
tnam := fnam+'~';
Assign(tmp,tnam);
Assign(f,fnam);
win := nShowMessage('Saving "'+fnam+'"...',47,' Save File ',46,false);
{$I-}
Reset(tmp);
If IoResult = 0 Then Begin
Close(tmp);
Erase(tmp);
Rename(f,tnam);
Assign(f,fnam);
End;
ReWrite(f);
cur := hdr^.next;
Repeat
If cur <> hdr Then Writeln(f,cur^.s^);
cur := cur^.next;
Until cur = hdr;
Close(f);
{$I+}
win^.Hide;
win^.Done;
End;
{ make the menu appear active }
Procedure MenuUp;
Begin
With mnu0 Do Begin
SetColor(48);
SetCursorColor(79);
Show;
End;
StatWin.FWrite(1,1,StatWin.GetColor,0,'Esc=Edit');
End;
{ make the menu appear inactive }
Procedure MenuDown;
Begin
With mnu0 Do Begin
SetColor(56);
SetCursorColor(56);
Show;
End;
StatWin.FWrite(1,1,StatWin.GetColor,0,'Esc=Menu');
End;
{ execute the File submenu }
Procedure Menu_File;
Begin
mnu0.SetIndex(1);
MenuUp;
New(mnu1,Init(1,1,0,3,1,48,79,8,FRAMED,62));
With mnu1^ Do Begin
Add('Open');
Add('Save');
Add('Exit - F10');
Post; { need the item count for move }
Move(1,nMaxRows-Count-2);
Start;
Case Index of
1 : ReadFile(tf,true);
2 : SaveFile(tf);
3 : Finished := true;
End;
Hide;
End;
Dispose(mnu1,Done);
MenuDown;
End;
{ display the help screen }
Procedure Help; Procedure Help;
Var Var
hwin : pnWindow; hwin : pnWindow;
Begin Begin
New(hwin,Init(1,1,40,20,62,true,49)); mnu0.SetIndex(4);
MenuUp;
New(hwin,Init(1,1,40,20,62,FRAMED,49));
With hwin^ Do Begin With hwin^ Do Begin
Align(center,center); Align(center,center);
PutHeader('Edit_Demo Help',15,center); PutHeader('Edit_Demo Help',15,center);
@ -57,37 +355,65 @@ Begin
Hide; Hide;
End; End;
Dispose(hwin,Done); Dispose(hwin,Done);
MenuDown;
End; End;
Procedure GotoLine(var i : integer); { goto the specified line in the edit buffer }
Function GotoLine : boolean;
Var Var
gwin : pnWindow; gwin : pnWindow;
ii : integer; l,
ii : longint;
esc : boolean; esc : boolean;
aline : pline;
Begin Begin
New(gwin,Init(1,1,40,3,62,true,49)); New(gwin,Init(1,1,40,3,62,FRAMED,49));
With gwin^ Do Begin With gwin^ Do Begin
Align(center,center); Align(center,center);
PutHeader('Goto Line Number',15,center); PutHeader('Goto Line Number',15,center);
FWrite(2,1,63,0,'Line: '); FWrite(2,1,63,0,'Line: ');
Show; Show;
ii := i;
ec.ClearMode := true; ec.ClearMode := true;
i := EditNumber(8,1,63,2,0,'',i,1,win1.rows,esc); ii := EditNumber(8,1,63,8,0,'',cline,1,lines,esc);
If esc or not (i in [1..win1.rows]) Then i := ii; { If esc or not (i in [1..lines]) Then i := ii;}
Hide; Hide;
End; End;
Dispose(gwin,Done); Dispose(gwin,Done);
If Not esc Then Begin
l := 0;
aline := hdr;
Repeat
inc(l);
aline := aline^.next;
Until (l = ii);
line1 := aline;
cline := l;
End;
GotoLine := (Not esc);
End; End;
{ initialize the global stuff }
Procedure EditInit;
Begin Begin
Status.Init(1,nStdScr.Rows,nStdScr.Cols,nStdScr.Rows,63,false,0); With mnu0 Do Begin
nFWrite(1,1,63,80,' [F1-InsLn] [F2-DelLn] [F3-Help] [F10-Exit]'); Init(1,1,45,1,5,56,56,7,NOFRAME,0);
Status.Show; Add('File');
fillchar(ss,sizeof(ss),#0); Add('InsLn');
With win1 Do Begin Add('DelLn');
Init(1,1,nStdScr.Cols,nStdScr.Rows-1,31,true,31); Add('Help');
PutHeader(' nCrt Editor Demonstration ',15,center); Add('Exit');
Post;
Align(left,bottom);
End;
With StatWin Do Begin
Init(1,1,nStdScr.Cols-(mnu0.Wind^.Cols),1,48,NOFRAME,0);
Align(right,bottom);
Show;
End;
MenuDown;
With EdWin Do Begin
Init(1,1,nStdScr.Cols,nStdScr.Rows-1,30,FRAMED,31);
PutHeader(' oCrt Editor Demonstration ',15,center);
Show; Show;
GotoXY(1,1); GotoXY(1,1);
{-------------------------------------------------------------------- {--------------------------------------------------------------------
@ -100,69 +426,187 @@ Begin
{ too re-assign a built-in key, put it in ec.special, { too re-assign a built-in key, put it in ec.special,
then use it in the case statement below then use it in the case statement below
win1.ec.Special := win1.ec.Special + #5; EdWin.ec.Special := EdWin.ec.Special + #5;
} }
{ now let's bind some keystrokes to the editor screen } { now let's bind some keystrokes to the editor window }
ec.AddChMap(^a#0#0+char(nKeyCtrlLeft)); ec.AddChMap(^a#0#0+chr(nKeyCtrlLeft));
ec.AddChMap(^s#0#0+char(nKeyLeft)); ec.AddChMap(^s#0#0+chr(nKeyLeft));
ec.AddChMap(^f#0#0+char(nKeyCtrlRight)); ec.AddChMap(^f#0#0+chr(nKeyCtrlRight));
ec.AddChMap(^d#0#0+char(nKeyRight)); ec.AddChMap(^d#0#0+chr(nKeyRight));
ec.AddChMap(^e#0#0+char(nKeyUp)); ec.AddChMap(^e#0#0+chr(nKeyUp));
ec.AddChMap(^x#0#0+char(nKeyDown)); ec.AddChMap(^x#0#0+chr(nKeyDown));
ec.AddChMap(^q#0#0+char(nKeyHome)); ec.AddChMap(^q#0#0+chr(nKeyHome));
ec.AddChMap(^w#0#0+char(nKeyEnd)); ec.AddChMap(^w#0#0+chr(nKeyEnd));
{ define the number of edit window rows }
CURLINES := Min(MAXLINES,Rows);
End; End;
FillChar(ss,SizeOf(ss),#0);
nEscDelay(250);
idx := 1; idx := 1;
Finished := false; Finished := false;
mactive := false;
ClearLines(hdr);
If ParamCount > 0 Then Begin
fnam := ParamStr(1);
ReadFile(tf,false);
End Else
fnam := '';
{ an empty list? }
If hdr^.next = hdr Then Begin
InsertLine(hdr,'');
line1 := hdr^.next;
line := line1;
dlines := 1;
End;
cline := 1;
End;
Begin
EditInit;
Repeat Repeat
With win1 Do Begin With EdWin Do Begin
Case ec.InsMode of Case ec.InsMode of
true : Status.FWrite(50,1,48,0,'Ins'); true : StatWin.FWrite(11,1,StatWin.GetColor,0,'Ins');
false: Status.FWrite(50,1,48,0,'Ovr'); false: StatWin.FWrite(11,1,StatWin.GetColor,0,'Ovr');
End; End;
Str(WhereX:0,xp); Str(WhereX:0,xp);
Str(WhereY:0,yp); Str(cline:0,yp);
Status.FWrite(60,1,48,80,'X='+xp+', Y='+yp); StatWin.FWrite(16,1,StatWin.GetColor,StatWin.Cols,'Col:'+xp+' Row:'+yp);
ss[idx] := Edit(1,idx,30,Cols,WhereX,ss[idx],c); If mactive Then Begin
Case ord(c) of With mnu0 Do Begin
12 : GotoLine(idx); MenuUp;
Start;
Case Index Of
1 : cv := nkAltF;
2 : cv := nkF1;
3 : cv := nkF2;
4 : cv := nkF3;
5 : cv := nkF10;
Else cv := 0;
End;
MenuDown;
Show;
End;
mactive := false;
Active;
GotoXY(WhereX,WhereY);
End Else Begin
ss[idx] := Edit(1,idx,26,Cols,WhereX,ss[idx],cv);
FWrite(1,idx,GetColor,Cols,ss[idx]);
ReallocateLine(line,ss[idx]);
End;
Case cv of
12 : If GotoLine Then Begin
idx := 1;
LoadLines(line1);
DisplayLines;
End;
{5,} {5,}
nKeyUp : dec(idx); nkUp : Begin
nKeyDown : inc(idx); dec(idx);
nKeyPgUp : idx := 1; dec(cline);
nKeyPgDn : idx := Rows; If (idx < 1) and (line1^.prev <> hdr) Then Begin
nKeyEnter: Begin line1 := line1^.prev;
LoadLines(line1);
DisplayLines;
End;
End;
nkDown : Begin
inc(idx); inc(idx);
inc(cline);
If idx > CURLINES Then Begin
line1 := line1^.next;
LoadLines(line1);
DisplayLines;
End;
End;
nkPgUp : Begin
For xi := 1 to CURLINES Do Begin
line1 := line1^.prev;
dec(cline);
If line1 = hdr Then
line1 := line1^.next;
End;
LoadLines(line1);
DisplayLines;
End;
nkPgDn : Begin
If dlines = CURLINES Then Begin
For xi := 1 to CURLINES Do Begin
inc(cline);
line1 := line1^.next;
If line1 = hdr Then
line1 := line1^.prev;
End;
LoadLines(line1);
DisplayLines;
End;
End;
nkEnter: Begin
GotoXY(1,WhereY); GotoXY(1,WhereY);
If line^.next = hdr Then Begin
InsertLine(hdr,'');
If dlines < CURLINES Then inc(dlines);
End;
If idx < CURLINES Then
inc(idx)
Else Begin
line1 := line1^.next;
LoadLines(line1);
DisplayLines;
End;
inc(cline);
End; End;
14, { ctrl/n } 14, { ctrl/n }
nKeyF1 : Begin nkF1 : Begin
InsLine; { first displayed line? }
system.move(ss[idx],ss[idx+1],(rows-idx)*81); If line1 = line Then Begin
ss[idx] := ''; line1 := line1^.prev;
InsertLine(line,'');
line1 := line1^.next;
End Else
InsertLine(line,'');
LoadLines(line1);
DisplayLines;
End; End;
25, { ctrl/y } 25, { ctrl/y }
nKeyF2 : Begin nkF2 : Begin
DelLine; { first displayed line? }
system.move(ss[idx+1],ss[idx],(rows-idx)*81); If line1 = line Then line1 := line^.next;
ss[rows] := ''; DeleteLine(line);
LoadLines(line1);
DisplayLines;
End; End;
nKeyF3 : Help; nkAltH,
nKeyEsc, nkF3 : Help;
nKeyF10 : Finished := true; nkEsc : mactive := true;
nkF10 : Finished := true;
nkAltF : menu_file;
End; End;
If idx > rows Then idx := rows; Active;
If idx > CURLINES Then idx := CURLINES; { keep in window, }
If idx > dlines Then idx := dlines; { but not below last }
If idx < 1 Then idx := 1; If idx < 1 Then idx := 1;
If cline < 1 Then cline := 1;
If cline > lines Then cline := lines;
GotoXY(WhereX,idx); GotoXY(WhereX,idx);
line := line1;
For xi := 1 to idx-1 Do Begin
line := line^.next;
End;
End; End;
Until Finished; Until Finished;
win1.Done; ClearLines(hdr);
Status.Done; EdWin.Done;
StatWin.Done;
ClrScr; ClrScr;
End. End.
{ {
$Log$ $Log$
Revision 1.3 2000-08-20 10:11:41 jonas Revision 1.4 2000-08-29 05:51:09 michael
+ Merged changes and additions from fixbranch
Revision 1.3 2000/08/20 10:11:41 jonas
* added missing open comment at start of log section * added missing open comment at start of log section
Revision 1.2 2000/07/13 11:33:27 michael Revision 1.2 2000/07/13 11:33:27 michael

46
packages/ncurses/eti.inc Normal file
View File

@ -0,0 +1,46 @@
{
Copyright (c) 1998 Free Software Foundation, Inc.
Permission is hereby granted, free of charge, to any person obtaining a
copy of this software and associated documentation files (the
"Software"), to deal in the Software without restriction, including
without limitation the rights to use, copy, modify, merge, publish,
distribute, distribute with modifications, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included
in all copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,
DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR
OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR
THE USE OR OTHER DEALINGS IN THE SOFTWARE.
Except as contained in this notice, the name(s) of the above copyright
holders shall not be used in advertising or otherwise to promote the
sale, use or other dealings in this Software without prior written
authorization.
}
{
Author: Juergen Pfeifer <Juergen.Pfeifer@T-Online.de> 1995,1997
}
const
E_OK = 0;
E_SYSTEM_ERROR = -(1);
E_BAD_ARGUMENT = -(2);
E_POSTED = -(3);
E_CONNECTED = -(4);
E_BAD_STATE = -(5);
E_NO_ROOM = -(6);
E_NOT_POSTED = -(7);
E_UNKNOWN_COMMAND = -(8);
E_NO_MATCH = -(9);
E_NOT_SELECTABLE = -(10);
E_NOT_CONNECTED = -(11);
E_REQUEST_DENIED = -(12);
E_INVALID_FIELD = -(13);
E_CURRENT = -(14);

348
packages/ncurses/menu.pp Normal file
View File

@ -0,0 +1,348 @@
unit menu;
{---------------------------------------------------------------------------
CncWare
----------------------------------------------------------------------------
Filename..: menu.pp
Programmer: Ken J. Wright
Date......: 07/12/2000
Purpose - Link to the Linux 'menu' library for ncurses menuing
functions.
-------------------------------< Revisions >---------------------------------
Revision| Date | Prog| Description
-----------------------------------------------------------------------------
1.00 | 07/12/00 | kjw | Initial release.
-----------------------------------------------------------------------------
}
{ Automatically converted by H2PAS.EXE from menu.h
Utility made by Florian Klaempfl 25th-28th september 96
Improvements made by Mark A. Malakanov 22nd-25th may 97
Further improvements by Michael Van Canneyt, April 1998
define handling and error recovery by Pierre Muller, June 1998 }
interface
{ C default packing is dword }
{$PACKRECORDS 4}
{
Copyright (c) 1998 Free Software Foundation, Inc.
Permission is hereby granted, free of charge, to any person obtaining a
copy of this software and associated documentation files (the
"Software"), to deal in the Software without restriction, including
without limitation the rights to use, copy, modify, merge, publish,
distribute, distribute with modifications, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included
in all copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,
DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR
OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR
THE USE OR OTHER DEALINGS IN THE SOFTWARE.
Except as contained in this notice, the name(s) of the above copyright
holders shall not be used in advertising or otherwise to promote the
sale, use or other dealings in this Software without prior written
authorization.
}
{
Author: Juergen Pfeifer <Juergen.Pfeifer@T-Online.de> 1995,1997
}
{$linklib menu}
uses ncurses;
{$include eti.inc}
type
Menu_Options = longint;
Item_Options = longint;
const
{ Menu options: }
O_ONEVALUE = $01;
O_SHOWDESC = $02;
O_ROWMAJOR = $04;
O_IGNORECASE = $08;
O_SHOWMATCH = $10;
O_NONCYCLIC = $20;
{ Item options: }
O_SELECTABLE = $01;
type
tTEXT = record
str : pchar;
length : word;
end;
tITEM = record
name : tTEXT; { name of menu item }
description : tTEXT; { description of item, optional in display }
imenu : ^tagMENU; { Pointer to parent menu }
userptr : pointer; { Pointer to user defined per item data }
opt : Item_Options; { Item options }
index : integer; { Item number if connected to a menu }
y : integer; { y and x location of item in menu }
x : integer;
value : bool; { Selection value }
left : ^tagITEM; { neighbour items }
right : ^tagITEM;
up : ^tagITEM;
down : ^tagITEM;
end;
pITEM = ^tITEM;
ppITEM = ^pITEM;
tagITEM = tITEM;
Menu_Hook = procedure;cdecl;
tMENU = record
height : integer; { Nr. of chars high }
width : integer; { Nr. of chars wide }
rows : integer; { Nr. of items high }
cols : integer; { Nr. of items wide }
frows : integer; { Nr. of formatted items high }
fcols : integer; { Nr. of formatted items wide }
arows : integer; { Nr. of items high (actual) }
namelen : integer; { Max. name length }
desclen : integer; { Max. description length }
marklen : integer; { Length of mark, if any }
itemlen : integer; { Length of one item }
spc_desc : integer; { Spacing for descriptor }
spc_cols : integer; { Spacing for columns }
spc_rows : integer; { Spacing for rows }
pattern : ^char; { Buffer to store match chars }
pindex : integer; { Index into pattern buffer }
win : ^WINDOW; { Window containing menu }
sub : ^WINDOW; { Subwindow for menu display }
userwin : ^WINDOW; { User's window }
usersub : ^WINDOW; { User's subwindow }
items : ^pITEM; { array of items }
nitems : integer; { Nr. of items in menu }
curitem : pITEM; { Current item }
toprow : integer; { Top row of menu }
fore : chtype; { Selection attribute }
back : chtype; { Nonselection attribute }
grey : chtype; { Inactive attribute }
pad : byte; { Pad character }
menuinit : Menu_Hook; { User hooks }
menuterm : Menu_Hook;
iteminit : Menu_Hook;
itemterm : Menu_Hook;
userptr : pointer; { Pointer to menus user data }
mark : pchar; { Pointer to marker string }
opt : Menu_Options; { Menu options }
status : word; { Internal state of menu }
end;
pMENU = ^tMENU;
ppMENU = ^pMENU;
tagMENU = tMENU;
const
{ Define keys }
REQ_LEFT_ITEM = KEY_MAX + 1;
REQ_RIGHT_ITEM = KEY_MAX + 2;
REQ_UP_ITEM = KEY_MAX + 3;
REQ_DOWN_ITEM = KEY_MAX + 4;
REQ_SCR_ULINE = KEY_MAX + 5;
REQ_SCR_DLINE = KEY_MAX + 6;
REQ_SCR_DPAGE = KEY_MAX + 7;
REQ_SCR_UPAGE = KEY_MAX + 8;
REQ_FIRST_ITEM = KEY_MAX + 9;
REQ_LAST_ITEM = KEY_MAX + 10;
REQ_NEXT_ITEM = KEY_MAX + 11;
REQ_PREV_ITEM = KEY_MAX + 12;
REQ_TOGGLE_ITEM = KEY_MAX + 13;
REQ_CLEAR_PATTERN = KEY_MAX + 14;
REQ_BACK_PATTERN = KEY_MAX + 15;
REQ_NEXT_MATCH = KEY_MAX + 16;
REQ_PREV_MATCH = KEY_MAX + 17;
MIN_MENU_COMMAND = KEY_MAX + 1;
MAX_MENU_COMMAND = KEY_MAX + 17;
{
Some AT&T code expects MAX_COMMAND to be out-of-band not
just for menu commands but for forms ones as well.
/
#if defined(MAX_COMMAND)
# if (MAX_MENU_COMMAND > MAX_COMMAND)
# error Something is wrong -- MAX_MENU_COMMAND is greater than MAX_COMMAND
# elif (MAX_COMMAND != (KEY_MAX + 128))
# error Something is wrong -- MAX_COMMAND is already inconsistently defined.
# endif
#else
# define MAX_COMMAND (KEY_MAX + 128)
#endif
}
{ --------- prototypes for libmenu functions ----------------------------- }
function menu_items(_para1:pMENU):ppITEM;cdecl;
function current_item(_para1:pMENU):pITEM;cdecl;
function new_item(_para1:pchar; _para2:pchar):pITEM;cdecl;
function new_menu(_para1:ppITEM):pMENU;cdecl;
function item_opts(_para1:pITEM):Item_Options;cdecl;
function menu_opts(_para1:pMENU):Menu_Options;cdecl;
(*
function item_init(_para1:pMENU):Menu_Hook;
function item_term(_para1:pMENU):Menu_Hook;
function menu_init(_para1:pMENU):Menu_Hook;
function menu_term(_para1:pMENU):Menu_Hook;
*)
function menu_sub(_para1:pMENU):pWINDOW;cdecl;
function menu_win(_para1:pMENU):pWINDOW;cdecl;
function item_description(_para1:pITEM):pchar;cdecl;
function item_name(_para1:pITEM):pchar;cdecl;
function menu_mark(_para1:pMENU):pchar;cdecl;
function menu_request_name(_para1:longint):pchar;cdecl;
function menu_pattern(_para1:pMENU):pchar;cdecl;
function menu_userptr(_para1:pMENU):pointer;cdecl;
function item_userptr(_para1:pITEM):pointer;cdecl;
function menu_back(_para1:pMENU):chtype;cdecl;
function menu_fore(_para1:pMENU):chtype;cdecl;
function menu_grey(_para1:pMENU):chtype;cdecl;
function free_item(_para1:pITEM):longint;cdecl;
function free_menu(_para1:pMENU):longint;cdecl;
function item_count(_para1:pMENU):longint;cdecl;
function item_index(_para1:pITEM):longint;cdecl;
function item_opts_off(_para1:pITEM; _para2:Item_Options):longint;cdecl;
function item_opts_on(_para1:pITEM; _para2:Item_Options):longint;cdecl;
function menu_driver(_para1:pMENU; _para2:longint):longint;cdecl;
function menu_opts_off(_para1:pMENU; _para2:Menu_Options):longint;cdecl;
function menu_opts_on(_para1:pMENU; _para2:Menu_Options):longint;cdecl;
function menu_pad(_para1:pMENU):longint;cdecl;
function pos_menu_cursor(_para1:pMENU):longint;cdecl;
function post_menu(_para1:pMENU):longint;cdecl;
function scale_menu(_para1:pMENU; _para2:plongint; _para3:plongint):longint;cdecl;
function set_current_item(menu:pMENU; item:pITEM):longint;cdecl;
{ function set_item_init(_para1:pMENU; _para2:Menu_Hook):longint;cdecl;}
function set_item_opts(_para1:pITEM; _para2:Item_Options):longint;cdecl;
{ function set_item_term(_para1:pMENU; _para2:Menu_Hook):longint;cdecl;}
function set_item_userptr(_para1:pITEM; _para2:pointer):longint;cdecl;
function set_item_value(_para1:pITEM; _para2:bool):longint;cdecl;
function set_menu_back(_para1:pMENU; _para2:chtype):longint;cdecl;
function set_menu_fore(_para1:pMENU; _para2:chtype):longint;cdecl;
function set_menu_format(_para1:pMENU; _para2:longint; _para3:longint):longint;cdecl;
function set_menu_grey(_para1:pMENU; _para2:chtype):longint;cdecl;
{ function set_menu_init(_para1:pMENU; _para2:Menu_Hook):longint;cdecl;}
function set_menu_items(_para1:pMENU; _para2:ppITEM):longint;cdecl;
function set_menu_mark(_para1:pMENU; _para2:pchar):longint;cdecl;
function set_menu_opts(_para1:pMENU; _para2:Menu_Options):longint;cdecl;
function set_menu_pad(_para1:pMENU; _para2:longint):longint;cdecl;
function set_menu_pattern(_para1:pMENU; _para2:pchar):longint;cdecl;
function set_menu_sub(_para1:pMENU; _para2:pWINDOW):longint;cdecl;
{ function set_menu_term(_para1:pMENU; _para2:Menu_Hook):longint;cdecl;}
function set_menu_userptr(_para1:pMENU; _para2:pointer):longint;cdecl;
function set_menu_win(_para1:pMENU; _para2:pWINDOW):longint;cdecl;
function set_top_row(_para1:pMENU; _para2:longint):longint;cdecl;
function top_row(_para1:pMENU):longint;cdecl;
function unpost_menu(_para1:pMENU):longint;cdecl;
function menu_request_by_name(_para1:pchar):longint;cdecl;
function set_menu_spacing(_para1:pMENU; _para2:longint; _para3:longint; _para4:longint):longint;cdecl;
function menu_spacing(_para1:pMENU; _para2:plongint; _para3:plongint; _para4:plongint):longint;cdecl;
function item_value(_para1:pITEM):bool;cdecl;
function item_visible(_para1:pITEM):bool;cdecl;
{ procedure menu_format(_para1:pMENU; _para2:plongint; _para3:plongint);}
implementation
{const External_library=''; Setup as you need!}
function menu_items(_para1:pMENU):ppITEM;cdecl;external;
function current_item(_para1:pMENU):pITEM;cdecl;external;
function new_item(_para1:pchar; _para2:pchar):pITEM;cdecl;external;
function new_menu(_para1:ppITEM):pMENU;cdecl;external;
function item_opts(_para1:pITEM):Item_Options;cdecl;external;
function menu_opts(_para1:pMENU):Menu_Options;cdecl;external;
(*
function item_init(_para1:pMENU):Menu_Hook;
begin
{ You must implemented this function }
end;
function item_term(_para1:pMENU):Menu_Hook;
begin
{ You must implemented this function }
end;
function menu_init(_para1:pMENU):Menu_Hook;
begin
{ You must implemented this function }
end;
function menu_term(_para1:pMENU):Menu_Hook;
begin
{ You must implemented this function }
end;
*)
function menu_sub(_para1:pMENU):pWINDOW;cdecl;external;
function menu_win(_para1:pMENU):pWINDOW;cdecl;external;
function item_description(_para1:pITEM):pchar;cdecl;external;
function item_name(_para1:pITEM):pchar;cdecl;external;
function menu_mark(_para1:pMENU):pchar;cdecl;external;
function menu_request_name(_para1:longint):pchar;cdecl;external;
function menu_pattern(_para1:pMENU):pchar;cdecl;external;
function menu_userptr(_para1:pMENU):pointer;cdecl;external;
function item_userptr(_para1:pITEM):pointer;cdecl;external;
function menu_back(_para1:pMENU):chtype;cdecl;external;
function menu_fore(_para1:pMENU):chtype;cdecl;external;
function menu_grey(_para1:pMENU):chtype;cdecl;external;
function free_item(_para1:pITEM):longint;cdecl;external;
function free_menu(_para1:pMENU):longint;cdecl;external;
function item_count(_para1:pMENU):longint;cdecl;external;
function item_index(_para1:pITEM):longint;cdecl;external;
function item_opts_off(_para1:pITEM; _para2:Item_Options):longint;cdecl;external;
function item_opts_on(_para1:pITEM; _para2:Item_Options):longint;cdecl;external;
function menu_driver(_para1:pMENU; _para2:longint):longint;cdecl;external;
function menu_opts_off(_para1:pMENU; _para2:Menu_Options):longint;cdecl;external;
function menu_opts_on(_para1:pMENU; _para2:Menu_Options):longint;cdecl;external;
function menu_pad(_para1:pMENU):longint;cdecl;external;
function pos_menu_cursor(_para1:pMENU):longint;cdecl;external;
function post_menu(_para1:pMENU):longint;cdecl;external;
function scale_menu(_para1:pMENU; _para2:plongint; _para3:plongint):longint;cdecl;external;
function set_current_item(menu:pMENU; item:pITEM):longint;cdecl;external;
{ function set_item_init(_para1:pMENU; _para2:Menu_Hook):longint;cdecl;external;}
function set_item_opts(_para1:pITEM; _para2:Item_Options):longint;cdecl;external;
{ function set_item_term(_para1:pMENU; _para2:Menu_Hook):longint;cdecl;external;}
function set_item_userptr(_para1:pITEM; _para2:pointer):longint;cdecl;external;
function set_item_value(_para1:pITEM; _para2:bool):longint;cdecl;external;
function set_menu_back(_para1:pMENU; _para2:chtype):longint;cdecl;external;
function set_menu_fore(_para1:pMENU; _para2:chtype):longint;cdecl;external;
function set_menu_format(_para1:pMENU; _para2:longint; _para3:longint):longint;cdecl;external;
function set_menu_grey(_para1:pMENU; _para2:chtype):longint;cdecl;external;
{ function set_menu_init(_para1:pMENU; _para2:Menu_Hook):longint;cdecl;external;}
function set_menu_items(_para1:pMENU; _para2:ppITEM):longint;cdecl;external;
function set_menu_mark(_para1:pMENU; _para2:pchar):longint;cdecl;external;
function set_menu_opts(_para1:pMENU; _para2:Menu_Options):longint;cdecl;external;
function set_menu_pad(_para1:pMENU; _para2:longint):longint;cdecl;external;
function set_menu_pattern(_para1:pMENU; _para2:pchar):longint;cdecl;external;
function set_menu_sub(_para1:pMENU; _para2:pWINDOW):longint;cdecl;external;
{ function set_menu_term(_para1:pMENU; _para2:Menu_Hook):longint;cdecl;external;}
function set_menu_userptr(_para1:pMENU; _para2:pointer):longint;cdecl;external;
function set_menu_win(_para1:pMENU; _para2:pWINDOW):longint;cdecl;external;
function set_top_row(_para1:pMENU; _para2:longint):longint;cdecl;external;
function top_row(_para1:pMENU):longint;cdecl;external;
function unpost_menu(_para1:pMENU):longint;cdecl;external;
function menu_request_by_name(_para1:pchar):longint;cdecl;external;
function set_menu_spacing(_para1:pMENU; _para2:longint; _para3:longint; _para4:longint):longint;cdecl;external;
function menu_spacing(_para1:pMENU; _para2:plongint; _para3:plongint; _para4:plongint):longint;cdecl;external;
function item_value(_para1:pITEM):bool;cdecl;external;
function item_visible(_para1:pITEM):bool;cdecl;external;
(*
procedure menu_format(_para1:pMENU; _para2:plongint; _para3:plongint);
begin
{ You must implemented this function }
end;
*)
begin
end.

View File

@ -53,6 +53,14 @@
| 2) Added nInit and moved code from ncrt.pp & ocrt.pp to it. | 2) Added nInit and moved code from ncrt.pp & ocrt.pp to it.
| 3) KEY_ALTMINUS & KEYALTEQUAL were reversed, but mapping ended | 3) KEY_ALTMINUS & KEYALTEQUAL were reversed, but mapping ended
| up correct. | up correct.
2.15.00 | 1) Added nMaxRows & nMaxCols constants.
| 2) See ocrt.pp
2.16.00 | 08/14/2000 | kjw | See ocrt.pp
| 08/24/2000 | kjw |
| 1) Added nTermName.
| 2) Added CursesFailed.
| 3) Moved all common initialization code to nInit.
| 4) prev_textattr more reliable.
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
} }
@ -81,13 +89,14 @@ Procedure nStop;
Procedure nStart; Procedure nStart;
Function nCursor(c : integer) : integer; Function nCursor(c : integer) : integer;
Function nEscDelay(d : longint) : longint; Function nEscDelay(d : longint) : longint;
Function nTermName : string;
Const Const
NCRT_VERSION_MAJOR = 2; NCRT_VERSION_MAJOR = 2;
NCRT_VERSION_MINOR = 14; NCRT_VERSION_MINOR = 16;
NCRT_VERSION_PATCH = 0; NCRT_VERSION_PATCH = 0;
NCRT_VERSION = '2.14.00'; NCRT_VERSION = '2.16.00';
{ CRT modes } { CRT modes }
BW40 = 0; { 40x25 B/W on Color Adapter } BW40 = 0; { 40x25 B/W on Color Adapter }
@ -171,6 +180,10 @@ Const
cON = 1; { normal cursor } cON = 1; { normal cursor }
cBIG = 2; { very visible cursor } cBIG = 2; { very visible cursor }
{ fullscreen size }
nMaxRows : word = 25; { reset at startup to terminal setting }
nMaxCols : word = 80; { for columns and rows }
var var
CheckBreak, CheckBreak,
CheckEOF, CheckEOF,
@ -194,6 +207,7 @@ Var
ps : array [0..255] of char; { for use with pchars } ps : array [0..255] of char; { for use with pchars }
doRefresh : boolean; { immediate refresh toggle } doRefresh : boolean; { immediate refresh toggle }
SubWn, { window created from window() } SubWn, { window created from window() }
PrevWn, { previous window when active changes }
ActiveWn : pwindow; { current active window for stdout } ActiveWn : pwindow; { current active window for stdout }
tmp_b : boolean; tmp_b : boolean;
isEcho : boolean; { keeps track of echo status } isEcho : boolean; { keeps track of echo status }
@ -230,6 +244,17 @@ type
End; End;
{==========================================================================} {==========================================================================}
{ set the active window for write(ln), read(ln) }
Procedure SetActiveWn(win : pwindow);
Begin
If win <> ActiveWn Then PrevWn := ActiveWn;
{ don't set to a nil window! }
If win <> Nil Then
ActiveWn := win
Else
ActiveWn := stdscr;
End;
{-------------------------------------------- {--------------------------------------------
initialize ncurses screen & keyboard, and initialize ncurses screen & keyboard, and
return a pointer to stdscr. return a pointer to stdscr.
@ -244,6 +269,7 @@ Begin
tcGetAttr(STDIN,tios); tcGetAttr(STDIN,tios);
if initscr=Nil then Begin if initscr=Nil then Begin
StartCurses := false; StartCurses := false;
win := nil;
Exit; Exit;
End Else Begin End Else Begin
StartCurses := true; StartCurses := true;
@ -259,6 +285,9 @@ Begin
isEcho := true; isEcho := true;
doRefresh := true; doRefresh := true;
getmaxyx(stdscr,MaxRows,MaxCols); getmaxyx(stdscr,MaxRows,MaxCols);
{ make these values visible to apps }
nMaxRows := MaxRows;
nMaxCols := MaxCols;
{ define the the alt'd keysets for ncurses } { define the the alt'd keysets for ncurses }
{ alt/a .. atl/z } { alt/a .. atl/z }
for i := ord('a') to ord('z') do Begin for i := ord('a') to ord('z') do Begin
@ -308,17 +337,15 @@ Begin
End; End;
{ see if the specified attribute is high intensity } { see if the specified attribute is high intensity }
Function IsBold(att : integer) : boolean; Function nIsBold(att : integer) : boolean;
Begin Begin
bg := att div 16; bg := att div 16;
fg := att - (bg * 16); fg := att - (bg * 16);
isbold := (fg > 7); nisbold := (fg > 7);
End; End;
{ initialize a color pair } { map a curses color to an ibm color }
Function SetColorPair(att : integer) : integer; Function c2ibm(c : integer) : integer;
var
i : integer;
{ ncurses constants { ncurses constants
COLOR_BLACK = 0; COLOR_BLACK = 0;
COLOR_RED = 1; COLOR_RED = 1;
@ -329,35 +356,56 @@ var
COLOR_CYAN = 6; COLOR_CYAN = 6;
COLOR_WHITE = 7; COLOR_WHITE = 7;
} }
Var
att : integer;
Begin
Case c of
COLOR_BLACK : att := black;
COLOR_RED : att := red;
COLOR_GREEN : att := green;
COLOR_YELLOW : att := brown;
COLOR_BLUE : att := blue;
COLOR_MAGENTA : att := magenta;
COLOR_CYAN : att := cyan;
COLOR_WHITE : att := lightgray;
else att := c;
End;
c2ibm := att;
End;
{ map an ibm color to a curses color }
Function ibm2c(c : integer) : integer;
Var
att : integer;
Begin
Case c of
black : att := COLOR_BLACK;
red : att := COLOR_RED;
green : att := COLOR_GREEN;
brown : att := COLOR_YELLOW;
blue : att := COLOR_BLUE;
magenta : att := COLOR_MAGENTA;
cyan : att := COLOR_CYAN;
lightgray : att := COLOR_WHITE;
else att := c;
End;
ibm2c := att;
End;
{ initialize a color pair }
Function nSetColorPair(att : integer) : integer;
var
i : integer;
Begin Begin
bg := att div 16; bg := att div 16;
fg := att - ((att div 16) * 16); fg := att - (bg * 16);
While bg > 7 Do dec(bg,8); While bg > 7 Do dec(bg,8);
While fg > 7 Do dec(fg,8); While fg > 7 Do dec(fg,8);
{ map to ncurses color values } bg := ibm2c(bg);
case bg of fg := ibm2c(fg);
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]; i := cp[bg,fg];
init_pair(i,fg,bg); init_pair(i,fg,bg);
SetColorPair := i; nSetColorPair := i;
End; End;
{ map a standard color attribute to an ncurses attribute } { map a standard color attribute to an ncurses attribute }
@ -365,8 +413,8 @@ Function CursesAtts(att : byte) : longint;
Var Var
atts : longint; atts : longint;
Begin Begin
atts := COLOR_PAIR(SetColorPair(att)); atts := COLOR_PAIR(nSetColorPair(att));
If IsBold(att) Then atts := atts or A_BOLD; If nIsBold(att) Then atts := atts or A_BOLD;
If (att and $80) = $80 Then atts := atts or A_BLINK; If (att and $80) = $80 Then atts := atts or A_BLINK;
CursesAtts := atts; CursesAtts := atts;
End; End;
@ -380,7 +428,7 @@ Begin
If (win = stdscr) or (win = curscr) Then Exit; If (win = stdscr) or (win = curscr) Then Exit;
If win <> Nil Then delwin(win); If win <> Nil Then delwin(win);
win := Nil; win := Nil;
If ActiveWn = Nil Then ActiveWn := stdscr; If ActiveWn = Nil Then SetActiveWn(stdscr);
End; End;
{----------------------------------------- {-----------------------------------------
@ -389,7 +437,7 @@ End;
-----------------------------------------} -----------------------------------------}
Procedure nWinColor(win : pWindow; att : integer); Procedure nWinColor(win : pWindow; att : integer);
Begin Begin
wattr_set(win,CursesAtts(att)); wattrset(win,CursesAtts(att));
prev_textattr := att; prev_textattr := att;
End; End;
@ -400,6 +448,7 @@ Begin
TouchWin(win); TouchWin(win);
werase(win); werase(win);
If doRefresh Then wrefresh(win); If doRefresh Then wrefresh(win);
prev_textattr := att;
End; End;
{ clear from the cursor to the end of line in a window } { clear from the cursor to the end of line in a window }
@ -784,7 +833,7 @@ Begin
intrflush(SubWn,bool(false)); intrflush(SubWn,bool(false));
keypad(SubWn,bool(true)); keypad(SubWn,bool(true));
scrollok(SubWn,bool(true)); scrollok(SubWn,bool(true));
ActiveWn := SubWn; SetActiveWn(SubWn);
GotoXY(1,1); GotoXY(1,1);
End; End;
@ -844,8 +893,7 @@ End;
Procedure TextMode(mode : word); Procedure TextMode(mode : word);
Begin Begin
nDelWindow(SubWn); nDelWindow(SubWn);
ActiveWn := stdscr; SetActiveWn(stdscr);
NormVideo;
LastMode := mode; LastMode := mode;
DirectVideo := true; DirectVideo := true;
CheckSnow := true; CheckSnow := true;
@ -868,23 +916,18 @@ Begin
If d >= 0 Then ESCDELAY := d; If d >= 0 Then ESCDELAY := d;
End; End;
{ unit initialization, following ncurses init } { return the current terminal name (same as $TERM env variable) }
Procedure nInit; Function nTermName : string;
Begin Begin
SubWn := nil; nTermName := StrPas(termname);
TextMode(LastMode); End;
{ Redirect the standard output } { could not initialize ncurses }
assigncrt(Output); Procedure CursesFailed;
Rewrite(Output); Begin
TextRec(Output).Handle:=StdOutputHandle; { give 'em a clue! }
{ Redirect the standard input } Writeln('StartCurses() failed');
assigncrt(Input); Halt;
Reset(Input);
TextRec(Input).Handle:=StdInputHandle;
nEscDelay(500); { default is 1000 (1 second) }
nCursor(cON); { normal cursor }
End; End;
{ exit procedure to ensure curses is closed up cleanly } { exit procedure to ensure curses is closed up cleanly }
@ -894,9 +937,36 @@ Begin
EndCurses; EndCurses;
End; End;
Procedure nInit;
Begin
{ set the unit exit procedure }
ExitSave := ExitProc;
ExitProc := @nExit;
{ 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;
{ initial window pointers }
SubWn := nil;
PrevWn := ActiveWn;
{ basic gray on black screen }
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;
{ some defaults }
nEscDelay(500); { default is 1000 (1 second) }
nCursor(cON); { normal cursor }
End;
{ {
$Log$ $Log$
Revision 1.2 2000-07-13 11:33:27 michael Revision 1.3 2000-08-29 05:51:09 michael
+ Merged changes and additions from fixbranch
Revision 1.2 2000/07/13 11:33:27 michael
+ removed logs + removed logs
} }

View File

@ -18,22 +18,8 @@ Unit nCrt;
2.00 | 12/13/99 | kjw | nCrt is now a drop-in replacement for the standard 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 | FPC crt unit. All the previous OOP features have
| been moved to a new unit, oCrt (object crt). | been moved to a new unit, oCrt (object crt).
| See oCrt.pp for a complete revision history. | See ocrt.pp & ncrt.inc for a complete revision
2.02 | 12/15/99 | kjw | See ncrt.inc. | history.
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.
2.07 | 01/31/00 | kjw | See ncrt.inc, ocrt.pp
2.08 | 06/09/00 | kjw | See ocrt.pp
2.08.01 | 06/11/00 | kjw | See ocrt.pp
2.09.00 | 06/16/00 | kjw | See ocrt.pp
2.10.00 | 06/23/00 | kjw | See ocrt.pp
2.11.00 | 06/27/00 | kjw | See ocrt.pp
2.12.00 | 06/29/00 | kjw | See ocrt.pp
2.13.00 | 06/30/00 | kjw | See ncrt.inc
2.14.00 | 07/05/00 | kjw | See ncrt.inc
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
} }
Interface Interface
@ -43,23 +29,19 @@ Uses linux,ncurses;
{$i ncrt.inc} {$i ncrt.inc}
Begin 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 } { initialize ncurses }
If Not StartCurses(ActiveWn) Then If StartCurses(ActiveWn) Then
Halt; { defaults, crtassign, etc. }
nInit
{ crtassign } Else
nInit; CursesFailed;
{ set the unit exit procedure }
ExitSave := ExitProc;
ExitProc := @nExit;
End. { of Unit nCrt } End. { of Unit nCrt }
{ {
$Log$ $Log$
Revision 1.2 2000-07-13 11:33:27 michael Revision 1.3 2000-08-29 05:51:09 michael
+ Merged changes and additions from fixbranch
Revision 1.2 2000/07/13 11:33:27 michael
+ removed logs + removed logs
} }

View File

@ -377,6 +377,10 @@ Var
Function waddnstr(_para1:pWINDOW; _para2:pchar; _para3:longint):longint; cdecl;external; Function waddnstr(_para1:pWINDOW; _para2:pchar; _para3:longint):longint; cdecl;external;
Function wattr_on(_para1:pWINDOW; _para2:attr_t):longint; cdecl;external; Function wattr_on(_para1:pWINDOW; _para2:attr_t):longint; cdecl;external;
Function wattr_off(_para1:pWINDOW; _para2:attr_t):longint; cdecl;external; Function wattr_off(_para1:pWINDOW; _para2:attr_t):longint; cdecl;external;
Function wattr_set(win : pwindow; at : longint) : longint; cdecl;external;
function wattron(win : pwindow;at : longint) : longint; cdecl;external;
function wattroff(win : pwindow;at : longint) : longint; cdecl;external;
function wattrset(win : pwindow;at : longint) : longint; cdecl;external;
Function wbkgd(_para1:pWINDOW; _para2:chtype):longint; cdecl;external; Function wbkgd(_para1:pWINDOW; _para2:chtype):longint; cdecl;external;
procedure wbkgdset(_para1:pWINDOW; _para2:chtype);cdecl;external; procedure wbkgdset(_para1:pWINDOW; _para2:chtype);cdecl;external;
Function wborder(_para1:pWINDOW; _para2:chtype; _para3:chtype; _para4:chtype; _para5:chtype; Function wborder(_para1:pWINDOW; _para2:chtype; _para3:chtype; _para4:chtype; _para5:chtype;
@ -392,7 +396,7 @@ Var
Function wgetch(_para1:pWINDOW):longint; cdecl;external; Function wgetch(_para1:pWINDOW):longint; cdecl;external;
Function wgetnstr(_para1:pWINDOW; _para2:pchar; _para3:longint):longint; cdecl;external; Function wgetnstr(_para1:pWINDOW; _para2:pchar; _para3:longint):longint; cdecl;external;
Function whline(_para1:pWINDOW; _para2:chtype; _para3:longint):longint; cdecl;external; Function whline(_para1:pWINDOW; _para2:chtype; _para3:longint):longint; cdecl;external;
Function winch (win : PWindow) : longint; Function winch (win : PWindow) : longint; cdecl;external;
Function winchnstr(_para1:pWINDOW; _para2:pchtype; _para3:longint):longint; cdecl;external; Function winchnstr(_para1:pWINDOW; _para2:pchtype; _para3:longint):longint; cdecl;external;
Function winnstr(_para1:pWINDOW; _para2:pchar; _para3:longint):longint; cdecl;external; Function winnstr(_para1:pWINDOW; _para2:pchar; _para3:longint):longint; cdecl;external;
Function winsch(_para1:pWINDOW; _para2:chtype):longint; cdecl;external; Function winsch(_para1:pWINDOW; _para2:chtype):longint; cdecl;external;
@ -420,6 +424,7 @@ Var
Function mvwchgat(_para1:pWINDOW; _para2:longint; _para3:longint; Function mvwchgat(_para1:pWINDOW; _para2:longint; _para3:longint;
_para4:longint; _para5:longint; _para6:longint; _para4:longint; _para5:longint; _para6:longint;
_para7:longint):longint;cdecl;external; _para7:longint):longint;cdecl;external;
Function PAIR_NUMBER(_para1:longint):longint;cdecl;external;
const const
A_NORMAL = 0; A_NORMAL = 0;
@ -474,10 +479,12 @@ Var
function getpary(win : pwindow) : longint; function getpary(win : pwindow) : longint;
function wstandout(win : pwindow) : longint; function wstandout(win : pwindow) : longint;
function wstandend(win : pwindow) : longint; function wstandend(win : pwindow) : longint;
{kjw, 08/24/2000, changed to cdecl; external
function wattr_set(win : pwindow; at : longint) : longint; function wattr_set(win : pwindow; at : longint) : longint;
function wattron(win : pwindow;at : longint) : longint; function wattron(win : pwindow;at : longint) : longint;
function wattroff(win : pwindow;at : longint) : longint; function wattroff(win : pwindow;at : longint) : longint;
function wattrset(win : pwindow;at : longint) : longint; function wattrset(win : pwindow;at : longint) : longint;
}
function scroll(win : pwindow) : longint; function scroll(win : pwindow) : longint;
function touchwin(win : pwindow) : longint; function touchwin(win : pwindow) : longint;
function touchline(win : pwindow;s,c : longint) : longint; function touchline(win : pwindow;s,c : longint) : longint;
@ -851,6 +858,7 @@ begin
wstandend:=wattr_set(win,A_NORMAL); wstandend:=wattr_set(win,A_NORMAL);
end; end;
(*
function wattron(win : pwindow;at : longint) : longint; function wattron(win : pwindow;at : longint) : longint;
begin begin
wattron:=wattr_on(win,at); wattron:=wattr_on(win,at);
@ -865,7 +873,7 @@ function wattrset(win : pwindow;at : longint) : longint;
begin begin
wattrset:=wattr_set(win,at); wattrset:=wattr_set(win,at);
end; end;
*)
function scroll(win : pwindow) : longint; function scroll(win : pwindow) : longint;
begin begin
scroll:=wscrl(win,1); scroll:=wscrl(win,1);
@ -1329,7 +1337,7 @@ begin
X:=Win^._parx; X:=Win^._parx;
end; end;
end; end;
(* kjw, 08/23/2000, external in v4.2
function winch (win : PWindow) : longint; function winch (win : PWindow) : longint;
begin begin
if win<>nil then if win<>nil then
@ -1348,7 +1356,7 @@ begin
else else
wattr_set:=0; wattr_set:=0;
end; end;
*)
procedure setsyx (y,x : longint); procedure setsyx (y,x : longint);
begin begin
stdscr^._cury := y; stdscr^._cury := y;
@ -1675,7 +1683,9 @@ end;
end. end.
{ {
$Log$ $Log$
Revision 1.2 2000-07-13 11:33:27 michael Revision 1.3 2000-08-29 05:51:09 michael
+ removed logs + Merged changes and additions from fixbranch
Revision 1.2 2000/07/13 11:33:27 michael
+ removed logs
} }

File diff suppressed because it is too large Load Diff

View File

@ -199,6 +199,7 @@ Begin
y := 15; y := 15;
win33.ClrScr; win33.ClrScr;
for i := 1 to 11 do Begin for i := 1 to 11 do Begin
TextAttr := win33.GetColor;
dec(x); dec(x);
dec(y); dec(y);
str(i:0,s); str(i:0,s);
@ -221,11 +222,15 @@ Begin
Dispose(win22,Done); Dispose(win22,Done);
win33.Done; win33.Done;
msgbox.Done; msgbox.Done;
NormVideo;
ClrScr; ClrScr;
End. End.
{ {
$Log$ $Log$
Revision 1.3 2000-08-20 10:11:41 jonas Revision 1.4 2000-08-29 05:51:09 michael
+ Merged changes and additions from fixbranch
Revision 1.3 2000/08/20 10:11:41 jonas
* added missing open comment at start of log section * added missing open comment at start of log section
Revision 1.2 2000/07/13 11:33:27 michael Revision 1.2 2000/07/13 11:33:27 michael

View File

@ -1,7 +1,6 @@
unit panel; unit panel;
{--------------------------------------------------------------------------- {---------------------------------------------------------------------------
CncWare CncWare
(c) Copyright 1999
---------------------------------------------------------------------------- ----------------------------------------------------------------------------
Filename..: panel.pp Filename..: panel.pp
Programmer: Ken J. Wright Programmer: Ken J. Wright
@ -59,7 +58,7 @@ uses ncurses;
implementation implementation
const External_library=''; {const External_library='';}
function panel_window(_para1:pPANEL):pWINDOW;cdecl;External; function panel_window(_para1:pPANEL):pWINDOW;cdecl;External;
procedure update_panels;cdecl;External; procedure update_panels;cdecl;External;
@ -82,7 +81,10 @@ const External_library='';
end. end.
{ {
$Log$ $Log$
Revision 1.3 2000-08-20 10:11:41 jonas Revision 1.4 2000-08-29 05:51:10 michael
+ Merged changes and additions from fixbranch
Revision 1.3 2000/08/20 10:11:41 jonas
* added missing open comment at start of log section * added missing open comment at start of log section
Revision 1.2 2000/07/13 11:33:27 michael Revision 1.2 2000/07/13 11:33:27 michael

View File

@ -0,0 +1,53 @@
program screen_demo;
{---------------------------------------------------------------------------
CncWare
(c) Copyright 2000
---------------------------------------------------------------------------
Filename..: screen_demo.pp
Programmer: Ken J. Wright
Date......: 08/24/2000
Purpose - Demonstrate Linux screen saving/restoring with oCrt.
-------------------------------<< REVISIONS >>--------------------------------
Ver | Date | Prog| Description
-------+----------+-----+----------------------------------------------------
1.00 | 08/24/00 | kjw | Initial Release.
------------------------------------------------------------------------------
}
uses ocrt;
var
i,j : integer;
pb : pnScreenBuf;
begin
For i := 1 to 24 Do Begin
TextColor(i);
For j := 1 to 79 Do Write(chr(j+32));
writeln;
End;
nGrabScreen(pb);
Write('screen stored, press a key to clear');readkey;
NormVideo;
ClrScr;
Write('press a key to restore previous screen');readkey;
nPopScreen(pb);
GotoXY(1,nMaxRows);
Write('press a key to restore to a smaller window');readkey;
ClrScr;
Window(10,5,70,20);
nPopScreen(pb);
Window(1,1,nMaxCols,nMaxRows);
GotoXY(1,nMaxRows);
Write('press a key to offset stored screen');readkey;
ClrScr;
nPopScreen(pb,5,3);
GotoXY(1,nMaxRows);
Write('press a key to restore a portion of this screen in multiple ');readkey;
nGrabScreen(pb,5,3,8,10);
ClrScr;
For i := 0 to 7 Do For j := 0 to 1 Do
nPopScreen(pb,i*10+1,j*12+1);
GotoXY(1,nMaxRows);
{ make sure to clean up! }
nReleaseScreen(pb);
end.