From 8e8c2afe10886aa845d7c38d3578ada688649a0c Mon Sep 17 00:00:00 2001 From: peter Date: Sun, 6 Feb 2000 17:22:37 +0000 Subject: [PATCH] * updated using a newer ncrt version --- packages/ncurses/Makefile | 6 +- packages/ncurses/Makefile.fpc | 4 +- packages/ncurses/README | 21 - packages/ncurses/edit_demo.pp | 85 ++ packages/ncurses/ncrt.inc | 805 +++++++++++++++++++ packages/ncurses/ncrt.pp | 684 +---------------- packages/ncurses/ncrt_demo.pp | 97 --- packages/ncurses/ncurses.h | 744 ------------------ packages/ncurses/ocrt.pp | 1362 +++++++++++++++++++++++++++++++++ packages/ncurses/ocrt_demo.pp | 219 ++++++ packages/ncurses/panel.pp | 82 ++ 11 files changed, 2593 insertions(+), 1516 deletions(-) delete mode 100644 packages/ncurses/README create mode 100644 packages/ncurses/edit_demo.pp create mode 100644 packages/ncurses/ncrt.inc delete mode 100644 packages/ncurses/ncrt_demo.pp delete mode 100644 packages/ncurses/ncurses.h create mode 100644 packages/ncurses/ocrt.pp create mode 100644 packages/ncurses/ocrt_demo.pp create mode 100644 packages/ncurses/panel.pp diff --git a/packages/ncurses/Makefile b/packages/ncurses/Makefile index bdc367d858..a40951ff93 100644 --- a/packages/ncurses/Makefile +++ b/packages/ncurses/Makefile @@ -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 diff --git a/packages/ncurses/Makefile.fpc b/packages/ncurses/Makefile.fpc index 3a353fff6d..0164af0ef4 100644 --- a/packages/ncurses/Makefile.fpc +++ b/packages/ncurses/Makefile.fpc @@ -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=../.. diff --git a/packages/ncurses/README b/packages/ncurses/README deleted file mode 100644 index 25bf597cc3..0000000000 --- a/packages/ncurses/README +++ /dev/null @@ -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. \ No newline at end of file diff --git a/packages/ncurses/edit_demo.pp b/packages/ncurses/edit_demo.pp new file mode 100644 index 0000000000..0edb78a286 --- /dev/null +++ b/packages/ncurses/edit_demo.pp @@ -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. diff --git a/packages/ncurses/ncrt.inc b/packages/ncurses/ncrt.inc new file mode 100644 index 0000000000..ebd2b90e53 --- /dev/null +++ b/packages/ncurses/ncrt.inc @@ -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; diff --git a/packages/ncurses/ncrt.pp b/packages/ncurses/ncrt.pp index 4e35c7d0dc..664c9b3170 100644 --- a/packages/ncurses/ncrt.pp +++ b/packages/ncurses/ncrt.pp @@ -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 } diff --git a/packages/ncurses/ncrt_demo.pp b/packages/ncurses/ncrt_demo.pp deleted file mode 100644 index 59e49b4bff..0000000000 --- a/packages/ncurses/ncrt_demo.pp +++ /dev/null @@ -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. diff --git a/packages/ncurses/ncurses.h b/packages/ncurses/ncurses.h deleted file mode 100644 index 298d6b81eb..0000000000 --- a/packages/ncurses/ncurses.h +++ /dev/null @@ -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); diff --git a/packages/ncurses/ocrt.pp b/packages/ncurses/ocrt.pp new file mode 100644 index 0000000000..d95ef3d7ab --- /dev/null +++ b/packages/ncurses/ocrt.pp @@ -0,0 +1,1362 @@ +Unit oCrt; +{--------------------------------------------------------------------------- + CncWare + (c) Copyright 1999 + --------------------------------------------------------------------------- + Filename..: ocrt.pp + Programmer: Ken J. Wright, ken@cncware.com + Date......: 03/01/99 + + Purpose - crt unit replacement plus OOP windows using ncurses. + + NOTE: All of the crt procedures & functions have been replaced with ncurses + driven versions. This makes the ncurses library a little easier to use in a + Pascal program and benefits from terminal independence. + +-------------------------------<< 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. + 1.02 | 11/26/99 | kjw | Added nKeypressed(). + 1.03 | 12/01/99 | kjw | Added global boolean nIsActive. + 1.04 | 12/03/99 | kjw | 1) Added procedures nHline, nVLine, & nWriteAC. + | 2) Changed all the line draw character functions + | (i.e., nHL, nVL) to return the longint value from + | ncurses rather than the character value (which was + | not very useful!). Now these can be passed to + | nWriteAC() to correctly write the line drawing + | characters. + | 3) Added more of the ACS characters. + 1.05 | 12/08/99 | kjw | 1) StartCurses() is now done as part of the unit + | initialization block. EndCurses() is done via an + | exit procedure. + | 2) nIsActive is now a function (safer!). + | 3) Added panel unit for windowing. + | 4) Added tnWindow object. + 1.10 | 12/12/99 | kjw | Added nSEdit(). + 1.11 | 12/12/99 | kjw | Added Special property to tEC object. Now any normal + | character can trigger sedit to exit. +------------------------------------------------------------------------------ + 2.00 | 12/13/99 | kjw | nCrt renamed to oCrt. A new nCrt has been created + | which is a drop-in replacement for the FPC crt unit. + | oCrt contains all of nCrt plus the OOP extensions. + | All of the common code is in ncrt.inc. + 2.01 | 12/15/99 | kjw | 1) A tnWindow object now becomes the target for + | stdout following Init & Show. A Hide will put the + | target back to stdscr. + | 2) Added nSetActiveWin() to manually pick a target + | window for stdout. + 2.02 | 12/15/99 | kjw | 1) PutFrame applied keypad to stdscr instead of sub. + | 2) See ncrt.inc + 2.03 | 12/16/99 | kjw | 1) See ncrt.inc + | 2) Added shift/f-key constants. + 2.04 | 01/04/00 | kjw | See ncrt.inc + 2.05 | 01/06/00 | kjw | 1) See ncrt.inc. + | 2) Added boolean internal_fwrite. FWrite was failing + | when trying to write outside of the active window. + | 3) nSEdit was not handling tec.firsttime correctly + | when a tec.special was processed. + 2.06 | 01/11/00 | kjw | See ncrt.inc. +------------------------------------------------------------------------------ +} +Interface + +Uses linux,ncurses,panel; + +Const + + { border styles for text boxes } + btNone : integer = 0; + btSingle : integer = 1; + btDouble : integer = 2; + + nKeyEnter = 13; { Enter key } + nKeyEsc = 27; { Home key } + nKeyHome = 71; { Home key } + nKeyUp = 72; { Up Arrow } + nKeyPgUp = 73; { PgUp Key } + nKeyLeft = 75; { Left Arrow } + nKeyRight = 77; { Right Arrow } + nKeyEnd = 79; { End Key } + nKeyDown = 80; { Down Arrow } + nKeyPgDn = 81; { PgDn Key } + nKeyF1 = 59; { f1 key } + nKeyF2 = 60; { f2 key } + nKeyF3 = 61; { f3 key } + nKeyF4 = 62; { f4 key } + nKeyF5 = 63; { f5 key } + nKeyF6 = 64; { f6 key } + nKeyF7 = 65; { f7 key } + nKeyF8 = 66; { f8 key } + nKeyF9 = 67; { f9 key } + nKeyF10 = 68; { f10 key } + nKeyF11 = 84; { shift/f1 key } + nKeyF12 = 85; { shift/f2 key } + nKeyF13 = 86; { shift/f3 key } + nKeyF14 = 87; { shift/f4 key } + nKeyF15 = 88; { shift/f5 key } + nKeyF16 = 89; { shift/f6 key } + nKeyF17 = 90; { shift/f7 key } + nKeyF18 = 91; { shift/f8 key } + nKeyF19 = 92; { shift/f9 key } + nKeyF20 = 93; { shift/f10 key } + + +Type + { for scrolling a window } + tnUpDown = (up,down); + { for window & header positioning } + tnJustify = (none,left,center,right,top,bottom); + + { used for nSEdit } + {------------------------------------------------------------------ + FirstTime = true : passed string is initialized to ''. + IsHidden = true : causes a string of '*' to display in place of + the actual characters typed. + InsMode : toggle for insert/overwrite mode. + ExitMode = true : sedit exits after every keystroke. + = false: sedit only exits when #27,#13, or any extended + key *except* for Home,End,RArrow,LArrow. + ------------------------------------------------------------------} + tEC = Object + FirstTime, + IsHidden, + InsMode, + ExitMode : boolean; + special : string; + Constructor Init(ft,ih,im,em : boolean; s : string); + Destructor Done; + End; + + pwin = ^Window; + + pnWindow = ^tnWindow; + tnWindow = Object + Private + wn : pwindow; { pointer to win or sub to read/write to } + win : pwindow; { pointer to main window record } + sub : pwindow; { sub window if a bordered window } + pan : ppanel; { pointer to panel record } + subp : ppanel; { sub panel if a bordered window } + visible : boolean; { is the window visible? } + hasframe : boolean; + wincolor, { window color } + framecolor, { frame color } + hdrcolor : integer; { header color } + header : string[80]; { header string } + Public + ec : tEC; { edit control settings } + Constructor Init(x,y,x1,y1,wcolor : integer; + border : boolean; + fcolor : integer); + Destructor Done; + Procedure Show; { display the window } + Procedure Hide; { hide the window } + 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 Readln : string; + Procedure Write(s : string); + Procedure Writeln(s : string); + Procedure WriteAC(x,y,att,c : longint); + Procedure FWrite(x,y,att,z : integer; s : string); + Procedure DrawBox(LineStyle,x1,y1,x2,y2,att : Integer); + Function GetHeader : string; + Procedure PutHeader(hdr : string; hcolor : integer; hpos : tnJustify); + Procedure SetColor(att : integer); + Procedure PutFrame(att : integer); + Procedure Move(x,y : integer); + Procedure Scroll(ln : integer; dir : tnUpDown); + Procedure Align(hpos,vpos : tnJustify); + Function Rows : integer; + Function Cols : integer; + Function SEdit(x,y,att,z,CursPos:Integer;es:String;Var ch : Char) : String; + End; + +Var + nscreen : pwin; + nEC : tEC; + +Procedure nSetActiveWin(win : pwindow); +Procedure nDoNow(donow : boolean); + Function nKeypressed(timeout : word) : boolean; +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 : integer; dir : tnUpDown); +Procedure nDrawBox(win : pWindow; LineStyle,x1,y1,x2,y2,att : Integer); +Procedure nFrame(win : pWindow); + Function nRows(win : pWindow) : integer; + Function nCols(win : pWindow) : integer; + Function nHL : longint; { horizontal line } + Function nVL : longint; { vertical line } + Function nUL : longint; { upper left corner } + Function nLL : longint; { lower loft corner } + Function nUR : longint; { upper right corner } + Function nLR : longint; { lower right corner } + Function nLT : longint; { left tee } + Function nRT : longint; { right tee } + Function nTT : longint; { top tee } + Function nBT : longint; { bottom tee } + Function nPL : longint; { plus, + } + Function nLA : longint; { left arrow } + Function nRA : longint; { right arrow } + Function nUA : longint; { up arror } + Function nDA : longint; { down arrow } + Function nDI : longint; { diamond } + Function nCB : longint; { checkerboard } + Function nDG : longint; { degree } + Function nPM : longint; { plus/minus } + Function nBL : longint; { bullet } +Procedure nHLine(win : pwindow; col,row,attr,x : integer); +Procedure nVLine(win : pwindow; col,row,attr,y : integer); +Procedure nWriteAC(win : pwindow; x,y : integer; att,acs_char : longint); + Function IsBold(att : integer) : boolean; + Function SetColorPair(att : integer) : integer; +Procedure FWrite(col,row,attrib : integer; clear : integer; s : string); + Function nSEdit(win : pwindow; x,y,att,z,CursPos:Integer;es:String;Var ch : Char) : String; + +{$i ncrt.inc} + +Const + internal_fwrite : Boolean = false; + +{ internal wrapper } +Procedure intFWrite(win : pwindow; col,row,attrib,clear : integer; s : string); +Var + tmp : pwindow; +Begin + tmp := ActiveWn; + ActiveWn := win; + internal_fwrite := true; + FWrite(col,row,attrib,clear,s); + internal_fwrite := false; + ActiveWn := tmp; +End; + +{--------------------------------------------------------------------- + tnWindow.Init + + Create a new window. + x = upper left corner x, screen relative + y = upper left corner y, screen relative + x1 = lower right corner x, screen relative + y1 = lower right corner y, screen relative + wcolor = window/text color + border = include a frame? + fcolor = frame color + ---------------------------------------------------------------------} +Constructor tnWindow.Init(x,y,x1,y1,wcolor : integer; + border : boolean; + fcolor : integer); +Begin + visible := false; + hasframe := false; + wincolor := wcolor; + framecolor := fcolor; + hdrcolor := wcolor; + header := ''; + win := nil; + sub := nil; + pan := nil; + subp := nil; + visible := false; + win := newwin(y1-y+1,x1-x+1,y-1,x-1); + pan := new_panel(win); + hide_panel(pan); + If border Then + PutFrame(fcolor) + Else Begin + wn := win; + wbkgd(win,COLOR_PAIR(SetColorPair(wcolor))); + If isbold(wcolor) then wattr_on(win,A_BOLD); + scrollok(win,bool(true)); + intrflush(stdscr,bool(false)); + keypad(stdscr,bool(true)); + End; + ec.Init(false,false,false,false,''); + ActiveWn := wn; +End; + +{ deallocate the window } +Destructor tnWindow.Done; +Begin + If subp <> nil Then del_panel(subp); + If pan <> nil Then del_panel(pan); + If sub <> nil Then delwin(sub); + If win <> nil Then delwin(win); + ec.Done; +End; + +{ display the window and move to the top } +Procedure tnWindow.Show; +Begin + ActiveWn := wn; + visible := true; + show_panel(pan); + If subp <> nil Then show_panel(subp); + update_panels; + doupdate; +End; + +{ hide the window } +Procedure tnWindow.Hide; +Begin + ActiveWn := stdscr; + visible := false; + If subp <> nil Then hide_panel(subp); + hide_panel(pan); + update_panels; + doupdate; +End; + +Procedure tnWindow.ClrScr; +Begin + tmp_b := dorefresh; + dorefresh := visible; + nClrScr(wn,wincolor); + dorefresh := tmp_b; +End; + +Procedure tnWindow.ClrEol; +Begin + tmp_b := dorefresh; + dorefresh := visible; + nClrEol(wn); + dorefresh := tmp_b; +End; + +Procedure tnWindow.ClrBot; +Begin + tmp_b := dorefresh; + dorefresh := visible; + nClrBot(wn); + dorefresh := tmp_b; +End; + +Procedure tnWindow.InsLine; +Begin + tmp_b := dorefresh; + dorefresh := visible; + nInsLine(wn); + dorefresh := tmp_b; +End; + +Procedure tnWindow.DelLine; +Begin + tmp_b := dorefresh; + dorefresh := visible; + nDelLine(wn); + dorefresh := tmp_b; +End; + +{ return the window border header string } +Function tnWindow.GetHeader : string; +Begin + GetHeader := header; +End; + +{---------------------------------------------------------------------- + put/replace a header string at the top of a bordered window + + hdr = header string (top line of window, only if hasframe = true) + hcolor = header line color + hpos = justfication of header string, left, center, or right + ----------------------------------------------------------------------} +Procedure tnWindow.PutHeader(hdr : string; hcolor : integer; hpos : tnJustify); +Var + cp, + hx, + len : integer; + att, + mx,my : longint; +Begin + If Hasframe Then Begin + If hdr <> '' Then Begin + header := hdr; + hdrcolor := hcolor; + getmaxyx(win,my,mx); + nHline(win,2,1,framecolor,mx-1); + len := mx-2; + hdr := Copy(hdr,1,len); + len := Length(hdr); + Case hpos of + left : hx := 1; + center : hx := (mx - len) div 2; + right : hx := (mx - len) - 1; + End; + mvwaddstr(win,0,hx,StrPCopy(ps,hdr)); + cp := SetColorPair(hcolor); + If IsBold(hcolor) Then + att := A_BOLD + Else + att := A_NORMAL; + mvwchgat(win,0,hx,len,att,cp,0); + End; + End; +End; + +{ set the the color of the writable window } +Procedure tnWindow.SetColor(att : integer); +Begin + wbkgd(wn,COLOR_PAIR(SetColorPair(att))); + If isbold(att) then wattr_set(wn,A_BOLD); + wincolor := att; + If visible Then wrefresh(wn); +End; + +{ frame an un-framed window, or update the frame color of a framed window } +Procedure tnWindow.PutFrame(att : integer); +Var + x,y, + mx,my, + atts : longint; +Begin + wbkgd(win,COLOR_PAIR(SetColorPair(att))); + atts := wattr_get(win); + If isbold(att) then wattr_on(win,atts or A_BOLD); + box(win,ACS_VLINE,ACS_HLINE); + framecolor := att; + If framecolor = -1 Then framecolor := wincolor; + hasframe := true; + If sub = nil Then Begin + getbegyx(win,y,x); + getmaxyx(win,my,mx); + sub := newwin(my-2,mx-2,y+1,x+1); + If sub <> nil Then Begin + subp := new_panel(sub); + hide_panel(subp); + wbkgd(sub,COLOR_PAIR(SetColorPair(wincolor))); + If isbold(wincolor) then wattr_on(sub,A_BOLD); + scrollok(sub,bool(true)); + intrflush(sub,bool(false)); + keypad(sub,bool(true)); + wn := sub; + End; + End; + touchwin(sub); + If visible Then Begin + wrefresh(win); + wrefresh(sub); + End; +End; + +{ move the window } +Procedure tnWindow.Move(x,y : integer); +Begin + move_panel(pan,y-1,x-1); + If subp <> nil Then move_panel(subp,y,x); + If visible Then Begin + update_panels; + doupdate; + End; +End; + +Procedure tnWindow.Align(hpos,vpos : tnJustify); +Var + x,y, + bx,by : longint; +Begin + getmaxyx(win,y,x); + getbegyx(win,by,bx); + Case hpos of + none : x := bx+1; + left : x := 1; + right : x := MaxCols - x; + center : x := (MaxCols - x) div 2; + End; + Case vpos of + none : y := by+1; + top : y := 1; + bottom : y := MaxRows - y; + center : y := (MaxRows - y) div 2; + End; + move(x,y); +End; + +Procedure tnWindow.Scroll(ln : integer; dir : tnUpDown); +Begin + nScroll(wn,ln,dir); +End; + +Procedure tnWindow.GotoXY(x,y : integer); +Begin + tmp_b := dorefresh; + dorefresh := visible; + nGotoXY(wn,x,y); + dorefresh := tmp_b; +End; + +Function tnWindow.WhereX : integer; +Begin + WhereX := nWhereX(wn); +End; + +Function tnWindow.WhereY : integer; +Begin + WhereY := nWhereY(wn); +End; + +Function tnWindow.ReadKey : char; +Begin + ReadKey := nReadKey(wn); +End; + +Function tnWindow.Readln : string; +Begin + Readln := nReadln(wn); +End; + + +Procedure tnWindow.Write(s : string); +Begin + tmp_b := dorefresh; + dorefresh := visible; + nWrite(wn,s); + dorefresh := tmp_b; +End; + +Procedure tnWindow.Writeln(s : string); +Begin + tmp_b := dorefresh; + dorefresh := visible; + nWriteln(wn,s); + dorefresh := tmp_b; +End; + +Procedure tnWindow.WriteAC(x,y,att,c : longint); +Begin + tmp_b := dorefresh; + dorefresh := visible; + nWriteAC(wn,x,y,att,c); + dorefresh := tmp_b; +End; + +Procedure tnWindow.FWrite(x,y,att,z : integer; s : string); +Var tmp : pwindow; +Begin + tmp_b := dorefresh; + dorefresh := visible; + tmp := ActiveWn; + ActiveWn := wn; + intFWrite(wn,x,y,att,z,s); + ActiveWn := tmp; + dorefresh := tmp_b; +End; + +Procedure tnWindow.DrawBox(LineStyle,x1,y1,x2,y2,att : Integer); +Begin + tmp_b := dorefresh; + dorefresh := visible; + nDrawBox(wn,LineStyle,x1,y1,x2,y2,att); + dorefresh := tmp_b; +End; + +Function tnWindow.Rows : integer; +Begin + Rows := nRows(wn); +End; + +Function tnWindow.Cols : integer; +Begin + Cols := nCols(wn); +End; + +Function tnWindow.SEdit(x,y,att,z,CursPos:Integer;es:String;Var ch : Char) : String; +var + tmp_ec : tec; +Begin + tmp_ec.Init(nEC.FirstTime,nEC.IsHidden,nEC.InsMode,nEC.ExitMode, + nEC.Special); + nEC.Init(ec.FirstTime,ec.IsHidden,ec.InsMode,ec.ExitMode, + ec.Special); + SEdit := nSEdit(wn,x,y,att,z,CursPos,es,ch); + ec.Init(nEC.FirstTime,nEC.IsHidden,nEC.InsMode,ec.ExitMode, + ec.Special); + nEC.Init(tmp_ec.FirstTime,tmp_ec.IsHidden,tmp_ec.InsMode,tmp_ec.ExitMode, + tmp_ec.Special); + tmp_ec.Done; +End; + +{--------------------------- tEC -------------------------------} + +Constructor tEC.Init(ft,ih,im,em : boolean; s : string); +Begin + FirstTime := ft; + IsHidden := ih; + InsMode := im; + ExitMode := em; + Special := s; +End; + +Destructor tEC.Done; +Begin +End; + +{==========================================================================} + +{ set the active window for write(ln), read(ln) } +Procedure nSetActiveWin(win : pwindow); +Begin + ActiveWn := win; +End; + +{---------------------------------------------------------------- + Set the refresh toggle. + If true, then all changes to a window are immediate. If false, + then changes appear following the next call to nRefresh. + ----------------------------------------------------------------} +Procedure nDoNow(donow : boolean); +Begin + dorefresh := donow; +End; + +{----------------------------------------------------- + Set the echo flag. + This determines whether or not, characters are + echoed to the display when entered via the keyboard. + -----------------------------------------------------} +Procedure nEcho(b : boolean); +Begin + Case b of + true : echo; + false: noecho; + End; + isEcho := b; +End; + +{ create a new subwindow of stdscr } +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)); + scrollok(win,bool(true)); + ActiveWn := win; +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)); + scrollok(win,bool(true)); + ActiveWn := win; +End; + +{ repaint a window } +Procedure nRefresh(win : pWindow); +Begin + touchwin(win); + wrefresh(win); +End; + +{---------------------------------------------- + Wait for a key to be pressed, with a timeout. + If a key is pressed, then nKeypressed returns + immediately as true, otherwise it return as + false after the timeout period. + ----------------------------------------------} +function nKeypressed(timeout : word) : boolean; +var + fds : FDSet; + maxFD : longint; +Begin + FD_Zero(fds); + maxFD := 1; + { turn on stdin bit } + If not FD_IsSet(STDIN,fds) Then FD_Set(STDIN,fds); + { wait for some input } + If Select(maxFD,@fds,nil,nil,timeout) > 0 Then + nKeypressed := TRUE + Else + nKeypressed := FALSE; +End; + +{--------------------------------- + read input string from a window + ---------------------------------} +Function nReadln(win : pWindow) : string; +Begin + wgetstr(win,ps); + nReadln := StrPas(ps); +End; + +{ write a string to a window without refreshing screen } +Procedure nWriteScr(win : pWindow; x,y,att : integer; s : string); +Var + tmp : pwindow; +Begin + tmp := ActiveWn; + tmp_b := doRefresh; + ActiveWn := win; + doRefresh := false; + intFWrite(win,x,y,att,0,s); + ActiveWn := tmp; + doRefresh := tmp_b; +End; + +{---------------------------------------------------------- + Scroll a window, up or down, a specified number of lines. + lines = number of lines to scroll. + dir = direction, up or down. + ----------------------------------------------------------} +Procedure nScroll(win : pWindow; lines : integer; dir : tnUpDown); +Begin + ScrollOk(win,bool(True)); + Case dir of + up : lines := abs(lines); + down : lines := abs(lines) * (-1); + End; + wscrl(win,lines); + If doRefresh Then wRefresh(win); +End; + +{ draw a colored box, with or without a border } +Procedure nDrawBox(win : pWindow; LineStyle,x1,y1,x2,y2,att : Integer); +Var + sub : pWindow; + x,y : longint; +Begin + getbegyx(win,y,x); + sub := subwin(win,y2-y1+1,x2-x1+1,y+y1-1,x+x1-1); + If sub = nil Then exit; + wbkgd(sub,CursesAtts(att)); + werase(sub); + case LineStyle of + 1,2 : box(sub, ACS_VLINE, ACS_HLINE); + End; + If doRefresh Then wrefresh(sub); + nDelWindow(sub); +End; + +{--------------------------- + add a border to a window, + waits for a refresh + ---------------------------} +Procedure nFrame(win : pWindow); +Begin + box(win, ACS_VLINE, ACS_HLINE); +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)); + If doRefresh Then wrefresh(win); +End; + +{ return then number of rows in a window } +Function nRows(win : pWindow) : integer; +Var + x,y : longint; +Begin + getmaxyx(win,y,x); + nRows := y; +End; + +{ return then number of columns in a window } +Function nCols(win : pWindow) : integer; +Var + x,y : longint; +Begin + getmaxyx(win,y,x); + nCols := x; +End; + +{------------------------------------------------------- + Line drawing characters have to be handled specially. + Use nWriteAC() to write these characters. They cannot + be simply included as characters in a string. + -------------------------------------------------------} + +{ returns horizontal line character } +Function nHL : longint; +Begin + nHL := ACS_HLINE; +End; + +{ returns vertical line character } +Function nVL : longint; +Begin + nVL := ACS_VLINE; +End; + +{ returns upper left corner character } +Function nUL : longint; +Begin + nUL := ACS_ULCORNER; +End; + +{ returns lower left corner character } +Function nLL : longint; +Begin + nLL := ACS_LLCORNER; +End; + +{ returns upper right corner character } +Function nUR : longint; +Begin + nUR := ACS_URCORNER; +End; + +{ returns lower right corner character } +Function nLR : longint; +Begin + nLR := ACS_LRCORNER; +End; + +{ returns left tee character } +Function nLT : longint; +Begin + nLT := ACS_LTEE; +End; + +{ returns right tee character } +Function nRT : longint; +Begin + nRT := ACS_RTEE; +End; + +{ returns top tee character } +Function nTT : longint; +Begin + nTT := ACS_TTEE; +End; + +{ returns bottom tee character } +Function nBT : longint; +Begin + nBT := ACS_BTEE; +End; + +{ returns plus/cross character } +Function nPL : longint; +Begin + nPL := ACS_PLUS; +End; + +{ returns left arrow character } +Function nLA : longint; +Begin + nLA := ACS_LARROW; +End; + +{ returns right arrow character } +Function nRA : longint; +Begin + nRA := ACS_RARROW; +End; + +{ returns up arrow character } +Function nUA : longint; +Begin + nUA := ACS_UARROW; +End; + +{ returns down arrow character } +Function nDA : longint; +Begin + nDA := ACS_DARROW; +End; + +{ returns diamond character } +Function nDI : longint; +Begin + nDI := ACS_DIAMOND; +End; + +{ returns checkerboard character } +Function nCB : longint; +Begin + nCB := ACS_CKBOARD; +End; + +{ returns degree character } +Function nDG : longint; +Begin + nDG := ACS_DEGREE; +End; + +{ returns plus/minus character } +Function nPM : longint; +Begin + nPM := ACS_PLMINUS; +End; + +{ returns bullet character } +Function nBL : longint; +Begin + nBL := ACS_BULLET; +End; + +{ draw a horizontal line with color and a start & end position } +Procedure nHLine(win : pwindow; col,row,attr,x : integer); +var + sub : pwindow; + bx,by : longint; +Begin + getbegyx(win,by,bx); + sub := subwin(win,1,x-col+1,by+row-1,bx+col-1); + If sub = nil Then Exit; + x := getmaxx(sub); + wbkgd(sub,CursesAtts(attr)); + mvwhline(sub,0,0,ACS_HLINE,x); + If doRefresh Then wrefresh(sub); + delwin(sub); +End; + +{ draw a vertical line with color and a start & end position } +Procedure nVLine(win : pwindow; col,row,attr,y : integer); +var sub : pwindow; +Begin + sub := subwin(win,y-row+1,1,row-1,col-1); + If sub = nil Then Exit; + wbkgd(sub,CursesAtts(attr)); + mvwvline(sub,0,0,ACS_VLINE,y); + If doRefresh Then wrefresh(sub); + delwin(sub); +End; + +{---------------------------------------------------------------- + Write a character from the alternate character set. A normal + value from the alternate character set is larger than $400000. + If the value passed here is 128..255, then we assume it to be + the ordinal value from the IBM extended character set, and try + to map it to curses correctly. If it does not map, then we just + make it an alternate character and hope the output is what the + programmer expected. Note: this will work on the Linux console + just fine, but for other terminals the passed value must match + the termcap definition for the alternate character. + Note: The cursor returns to it's original position. + ----------------------------------------------------------------} +Procedure nWriteAC(win : pwindow; x,y : integer; att,acs_char : longint); +var + xx,yy, + cp : longint; +Begin + If acs_char in [0..255] Then Begin + Case acs_char of + 176 : acs_char := ACS_CKBOARD; + 179 : acs_char := ACS_VLINE; + 180 : acs_char := ACS_RTEE; + 191 : acs_char := ACS_URCORNER; + 192 : acs_char := ACS_LLCORNER; + 193 : acs_char := ACS_BTEE; + 194 : acs_char := ACS_TTEE; + 195 : acs_char := ACS_LTEE; + 196 : acs_char := ACS_HLINE; + 197 : acs_char := ACS_PLUS; + 218 : acs_char := ACS_ULCORNER; + 217 : acs_char := ACS_LRCORNER; + 241 : acs_char := ACS_PLMINUS; + 248 : acs_char := ACS_DEGREE; + 249 : acs_char := ACS_BULLET; + else acs_char := acs_char or A_ALTCHARSET; + End; + End; + { save the current cursor position } + getyx(win,yy,xx); + cp := SetColorPair(att); + { write character with current attributes } + mvwaddch(win,y-1,x-1,acs_char); + { update with new attributes } + If IsBold(att) Then + att := A_BOLD or A_ALTCHARSET + Else + att := A_NORMAL or A_ALTCHARSET; + mvwchgat(win,y-1,x-1,1,att,cp,0); + { return cursor to saved position } + wmove(win,yy,xx); + If doRefresh Then wrefresh(win); +End; + +{------------------------------------------------------------------- + write a string to stdscr with color, without moving the cursor + + Col = x start position + Row = y start position + Attrib = color (0..127), note color = (background*16)+foreground + Clear = clear line up to x position + s = string to write + -------------------------------------------------------------------} +Procedure FWrite(col,row,attrib : integer; clear : integer; s : string); +Const + ClearLine = { Following line is 80 Spaces } +' '; + +Var + cs : string; + tmp, + sub : pWindow; + x,y, + xx,yy : longint; +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; + tmp := ActiveWn; + getyx(ActiveWn,yy,xx); + If Not internal_fwrite Then ActiveWn := stdscr; + getbegyx(ActiveWn,y,x); + sub := subwin(ActiveWn,1,Length(s),y+row-1,x+col-1); + ActiveWn := tmp; + If sub = nil Then Exit; + wbkgd(sub,COLOR_PAIR(SetColorPair(Attrib))); + If isbold(Attrib) then + wattr_on(sub,A_BOLD); + mvwaddstr(sub,0,0,StrPCopy(ps,s)); + If doRefresh Then wrefresh(sub); + delwin(sub); + wmove(ActiveWn,yy,xx); +End; + +{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~} +{ String Editor } +Function nSEdit(win : pwindow; x,y,att,z,CursPos:integer; + es:string;var ch : char) : string; +Var + ZMode, + SEditExit : boolean; + Index : integer; + hes : string; + +{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~} +Procedure NewString; +BEGIN + nSEdit := es; + hes := es; + FillChar(hes[1],Length(hes),'*'); +END; + +Procedure WriteString; +Var + xx,yy : integer; +Begin + xx := nWhereX(win); + yy := nWhereY(win); + If nEC.IsHidden Then + intFWrite(win,x,y,att,z,hes) + Else + intFWrite(win,x,y,att,z,es); + nGotoXY(win,xx,yy); +End; + +{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~} +Procedure EInsMode; +Begin + nEC.InsMode := (not nEC.InsMode) +End; + +{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~} +Procedure WriteChar; +Begin + If nWhereX(win) >= Length(es)+x Then Repeat + es := es + ' '; + Until Length(es)+X-1 = nWhereX(win); + If Length(es)+X-1 = nWhereX(win) Then Index := Length(es); + es[Index] := ch; + If nEC.IsHidden Then Ch := '*'; + intFWrite(win,nWhereX(win),nWhereY(win),Att,0,Ch); + If (Index < Z-X+1) or not ZMode Then Begin + Index := Index+1; + nGotoXY(win,X+Index-1,Y); + End; + Ch := #255;{ Set Ch to No Execute Character } + NewString; +End; + +{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~} +Procedure EInsert; { Insert } +Begin + If Length(es) < Z-X+1 Then Begin + Insert(' ',es,Index); + NewString; + WriteString; + End; +End; + +{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~} +Procedure EDelete; { Delete } +Begin + Delete(es,Index,1); + NewString; + WriteString; +End; + +{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~} +Procedure ECtrlEnd; { End } +Begin + Delete(es,Index,Length(es)); + NewString; + WriteString; +End; + +{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~} +Procedure EHome; { Home } +Begin + Index := 1; + nGotoXY(win,x,y); +End; + +{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~} +Procedure ELeftArrow; { Left Arrow } +Begin + Index := Index - 1; + If Index < 1 Then + Index := 1 + Else + nGotoXY(win,nWhereX(win)-1,nWhereY(win)); +End; + +{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~} +Procedure ERightArrow; { Right Arrow } +Begin + If Index < z-x+1 Then Begin + nGotoXY(win,nWhereX(win)+1,nWhereY(win)); + Index := Index + 1; + End; +End; + +{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~} +Procedure EEnd; { End } +Begin + Index := Length(es)+1; + If Index >= z-x+1 Then Index := Length(es); + If Index < 1 Then Index := 1; + nGotoXY(win,x+(Index-1),y); +End; + +{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~} +Procedure EBackSpace; { Backspace } +Begin + Index := Index - 1; + If Index < 1 Then Begin + Index := 1; + Exit; + End Else + If nWhereX(win) > x Then nGotoXY(win,nWhereX(win) - 1,nWhereY(win)); + Delete(es,Index,1); + NewString; + WriteString; + nGotoXY(win,x+(Index-1),y); +End; + +{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~} +Procedure ETurboBackSpace; { Ctrl/Backspace } +Begin + If Index = 1 Then Exit; + Delete(es,1,Index-1); + NewString; + Index := 1; + If nWhereX(win) > x Then nGotoXY(win,1,nWhereY(win)); + WriteString; + nGotoXY(win,x,y); +END; + +{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~} +Procedure ECtrlLeftArrow;{ Ctrl Left Arrow } +Begin + If nEC.IsHidden Then Begin + EHome; + Exit; + End; + If es[Index-1] = ' ' Then Index := Index-1; + If es[Index] <> ' ' Then Begin + While (Index > 1) And (es[Index] <> ' ') Do + Index := Index-1; + End Else + If es[Index] = ' ' Then Begin + While (Index > 1) And (es[Index] = ' ') Do + Index := Index-1; + While (Index > 1) And (es[Index] <> ' ') Do + Index := Index-1; + End; + If Index = 1 Then + nGotoXY(win,x,y) + Else Begin + nGotoXY(win,x+Index,y); + Index := Index+1; + End; +End; + +{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~} +Procedure ECtrlRightArrow;{ Ctrl Right Arrow } +Begin + If nEC.IsHidden Then Begin + EEnd; + Exit; + End; + While (Index < Length(es)) And (es[Index] <> ' ') Do + Begin + Index := Index+1; + End; + While (Index < Length(es)) And (es[Index] = ' ') Do + Begin + Index := Index+1; + End; + nGotoXY(win,x+Index-1,y); +End; + +{~~~~~~~~~~~~~~~~~~~~~~~~~~~~} +Procedure CheckForWriteChar; +Begin + If Not (Ch In [#8,#9,#27,#127,#255]) Then Begin + If (ch in [#10,#13]) {and not ControlKey} Then exit; + If nEC.FirstTime Then Begin + es := ''; + WriteString; + nGotoXY(win,X,Y); + Index := 1; + WriteChar; + nEC.FirstTime := False; + End Else Begin + If nEC.InsMode Then Begin + EInsert; + WriteChar; + End Else WriteChar; + End; + End; +End; + +{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~} +Procedure ProcessSpecialKey; +begin + Case ch of + #16..#25, + #30..#38, + #44..#50, + #59..#68, + #84..#90, + #92..#113, + #118, + #132, + #72, + #73, + #80, + #81 : Begin SEditExit:=True;Exit;End; + #71 : EHome; + #75 : ELeftArrow; + #77 : ERightArrow; + #79 : EEnd; + #82 : EInsMode; + #83 : EDelete; + #15, + #115 : ECtrlLeftArrow; + #116 : ECtrlRightArrow; + #117 : ECtrlEnd; + End; +End; + +{~~~~~~~~~~~~~~~~~~~~~~~~~~~~} +Procedure ProcessNormalKey; +Var + i : integer; +begin + For i := 1 to Length(nEC.Special) Do Begin + If ch = nEC.Special[i] Then Begin + SEditExit:=True; + Exit; + End; + End; + case ch of + #8 : Begin nEC.FirstTime := False;EBackSpace;End; + #9 : ECtrlRightArrow; + #127 : Begin nEC.FirstTime := False;ETurboBackSpace;End; + end; + CheckForWriteChar; +end; + +{============================================================================} +Begin + SEditExit := nEC.ExitMode; + ZMode := z <> 0; + If CursPos > Length(es)+x Then + Index := Length(es)+1 { End Of String } + Else Index := CursPos+1-x; { Inside Of String } + If Not ZMode then z := x+length(es); + Newstring; + WriteString; + nGotoXY(win,CursPos,y); + Repeat + If Not ZMode then z := x+length(es); + ch := ReadKey; + If ch = #0 Then Begin + ch := ReadKey; + ProcessSpecialKey; + End Else + ProcessNormalKey; + Until (ch In [#10,#13,#27]) or SEditExit; + If ch = #10 Then ch := #13; + nEC.FirstTime := False; + NewString; +End;{ of nSEdit } + +Begin + nEC.Init(false,false,false,false,''); + { 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 StartCurses(ActiveWn) Then + nscreen := ActiveWn + Else + 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 } + diff --git a/packages/ncurses/ocrt_demo.pp b/packages/ncurses/ocrt_demo.pp new file mode 100644 index 0000000000..cd92034374 --- /dev/null +++ b/packages/ncurses/ocrt_demo.pp @@ -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. diff --git a/packages/ncurses/panel.pp b/packages/ncurses/panel.pp new file mode 100644 index 0000000000..1b0f6d6831 --- /dev/null +++ b/packages/ncurses/panel.pp @@ -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.