Модуль CRT для Linux

Previous  Top  Next

    
 

 

 

Code:

{

LinCRT Kylix unit v 1.0

Author: Andrei Borovsky, aborovsky@mtu-net.ru

Copyright (c) 2002 Andrei Borovsky

Permission is hereby granted, free of charge, to any person obtaining a

copy of this software and associated documentation files (the

"Software"), to deal in the Software without restriction, including

without limitation the rights to use, copy, modify, merge, publish,

distribute, distribute with modifications, sublicense, and/or sell

copies of the Software, and to permit persons to whom the Software is

furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice shall be included

in all copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESSED

 

OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF

MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.

IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,

DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR

OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR

THE USE OR OTHER DEALINGS IN THE SOFTWARE.

 

Except as contained in this notice, the name(s) of the above copyright

holders shall not be used in advertising or otherwise to promote the

sale, use or other dealings in this Software without prior written

authorization.

}

 

unit LinCRT;

 

interface

 

uses

Libc, NCurses;

 

const

 

// Pseudocharacter values returned by GetKey

 

BS = 127; // Backspace

LF = 10;

TAB = 9;

ESC = 27;

 

kLArrow = 260;

kRArrow = 261;

kDArrow = 258;

kUArrow = 259;

kHome = 262;

kBkSp = 263// Another Backspace code. Curses.h

               // says this value is unreliable (true ;-))

kEnd = 264;

kF1 = 265;

kF2 = 266;

kF3 = 267;

kF4 = 268;

kF5 = 269;

kF6 = 270;

kF7 = 271;

kF8 = 272;

kF9 = 273;

kF10 = 274;

kF11 = 275;

kF12 = 276;

kDel = 330;

kIns = 331;

kPgDn = 338;

kPgUp = 339;

 

mLButtonDown = 501;

mLButtonUp = 502;

mLButtonClk = 503;

mLButtonDblClk = 504;

mMButtonDown = 505;

mMButtonUp = 506;

mMButtonClk = 507;

mMButtonDblClk = 508;

mRButtonDown = 509;

mRButtonUp = 510;

mRButtonClk = 511;

mRButtonDblClk = 512;

mMouseMoved = 561// not supported yet

 

// Color constants

 

Black = 0;

Red = 1;

Green = 2;

Brown = 3;

Blue = 4;

Magenta = 5;

Cyan = 6;

Gray = 7;

LightGray = 7;

DarkGray = 7;

LightRed = 9;

LightGreen = 10;

Yellow = 11;

LightBlue = 12;

LightMagenta = 13;

LightCyan = 14;

White = 15;

Blink = 128;

 

// Additional attributes constants

// (as returned by GetAddAttrXY)

aUnderline = 2;

aInverse = 4;

 

type

 

TOnTermResizeProc = procedure(DoingInput : Boolean);

 

var

 

StdScr, CurWnd : PWINDOW;

OnTermResize : TOnTermResizeProc;

ScrCols, ScrLines : Integer;

WindMin, WindMax : Integer;

TextAttr : Byte;

Inverse, Underline : Boolean;

ScrollWnd : Boolean;

BreakOnResize, Broken  : Boolean;

 

// Clears up to the end of the current line

procedure ClrEol;

// Clears current window

procedure ClrScr;

// Deletes current character

procedure DelChar;

//  Deletes current line

procedure DelLine;

// Finishes with LinCRT

procedure DoneLinCRT;

// Returns additional attributes

function GetAddAttrXY(X, Y : Byte) : Byte;

// Returns character at the specified position

function GetCharXY(X, Y : Byte) : Char;

// Returns character color at the specified position

function GetColorXY(X, Y : Byte) : Byte;

// Reads the key from the mouse or keyboard

function GetKey : Word;

// Sets the cursor position within the current window

procedure GotoXY(X, Y : Byte);

// Initializes the library

procedure InitLinCRT;

// Initializes mouse handling

procedure InitMouse;

// Inserts character in the current position

procedure InsChar(Ch : Char);

// Inserts new line in the current position

procedure InsLine;

// Determines if the key has been pressed

function KeyPressed : Boolean;

// Finishes mouse handling

procedure KillMouse;

// Checks if the mouse event occured within the current winodw

function MouseTrapped : Boolean;

// Puts character in the current position

procedure PutChar(Ch : Char);

// Puts character in the position X, Y

procedure PutCharXY(Ch : Char; X, Y : Byte);

// Reads the key from the keyboard

function ReadKey : Char;

// Sets or disables window scrollng

procedure SetScrollWnd(b : Boolean);

// Sets text and background colors

procedure SetColors(Fg, Bg : Byte);

// Starts the copy of the shell

procedure ShellOut(Cmd : PChar);

// Sets background color

procedure TextBackground(Color : Byte);

// Sets text color

procedure TextColor(Color : Byte);

// Returns the mouse position at the last mouse event

function WhereMouseXY : Word;

// Returns the curent X position

function WhereX : Byte;

// Returns the curent Y position

function WhereY : Byte;

// Opens the new window

procedure Window(X1, Y1, X2, Y2 : Byte);

 

 

implementation

 

const

 

BUF_SIZE = 1024;

STACK_SIZE = 64// This value is the number of color pairs

                   // supported by ncurses

 

type

 

TXtAttr = record

   Fg, Bg,

   PairNum : Byte;

end;

 

var

 

IOBuf : array[0..BUF_SIZE] of Byte;

PairStack : array[0..STACK_SIZE-1] of TXtAttr;

StackHead : Integer;

MouseEvent : MEVENT;

SpKey : Byte;

DoingInput, Intr : Boolean;

 

// Internal routines

 

procedure winch_handler( SigNum : Integer); stdcall;

begin

   if BreakOnResize then Intr := True;

   endwin;

   wrefresh(StdScr);

   ScrCols := StdScr._maxx;

   ScrLines := StdScr._maxy;

   if CurWnd <> StdScr then delwin(CurWnd);

   endwin;

   wrefresh(StdScr);

   CurWnd :=StdScr;

   if Assigned(OnTermResize) then OnTermResize(DoingInput);

end;

 

function GetPair(Fg, Bg : Byte) : Integer;

var

   i, Pos : Integer;

begin

   Pos := -1;

   for i := 0 to StackHead do

   if (PairStack[i].Fg = Fg) and (PairStack[i].Bg = Bg) then

   begin

     Pos := i;

     Break;

   end;

   if Pos < 0 then

   begin

     Pos := StackHead;

     if StackHead < (STACK_SIZE - 1) then

     begin

       Inc(StackHead);

       init_pair(StackHead+1, Fg, Bg);

       PairStack[StackHead].PairNum := StackHead+1;

       PairStack[StackHead].Fg := Fg;

       PairStack[StackHead].Bg := Bg;

       Pos := StackHead;

     end;

   end;

   Result := PairStack[Pos].PairNum;

end;

 

procedure SetAttrs;

var

   Pn : Integer;

begin

   Pn := GetPair(TextAttr and 7, (TextAttr and 112) shr 4);

   wattrset(CurWnd, COLOR_PAIR(Pn));

   CurWnd._bkgd := (Pn shl 8) + 32;

   if (TextAttr and 128) <> 0 then

   set_attr(CurWnd, A_BLINK);

   if (TextAttr and 8) <> 0 then

   set_attr(CurWnd, A_BOLD);

   if Underline then set_attr(CurWnd, A_UNDERLINE);

   if Inverse then set_attr(CurWnd, A_REVERSE);

end;

 

function TranslateMEvent : Word;

begin

   case MouseEvent.bstate of

     BUTTON1_RELEASED : Result := mLButtonUp;

     BUTTON1_PRESSED : Result := mLButtonDown;

     BUTTON1_CLICKED : Result := mLButtonClk;

     BUTTON1_DOUBLE_CLICKED : Result := mLButtonDblClk;

     BUTTON2_RELEASED : Result := mRButtonUp;

     BUTTON2_PRESSED : Result := mRButtonDown;

     BUTTON2_CLICKED : Result := mRButtonClk;

     BUTTON2_DOUBLE_CLICKED : Result := mRButtonDblClk;

     BUTTON3_RELEASED : Result := mMButtonUp;

     BUTTON3_PRESSED : Result := mMButtonDown;

     BUTTON3_CLICKED : Result := mMButtonClk;

     BUTTON3_DOUBLE_CLICKED : Result := mMButtonDblClk;

     REPORT_MOUSE_POSITION : Result := mMouseMoved;

   end;

end;

 

procedure DefineKey(c1, c2, c3 : Byte; Code : Word);

var

   Seq : array[0..4] of Byte;

begin

   Seq[0] := 27;

   Seq[1] := c1;

   Seq[2] := c2;

   Seq[3] := c3;

   Seq[4] := 0;

   define_key(@Seq[0], Code);

end;

 

(*

Here we initiate some pseudocharacter values that

for some reason are not initiated by ncurses itself

(at leas on my system). You may add/remove some

key definitions here, if your program requires this.

Note, that on any terminal there is a sequence that

will not be enterpreted correctly.

*)

 

procedure DefineKeys;

begin

   DefineKey(91, 91, 65, kF1);

   DefineKey(91, 91, 66, kF2);

   DefineKey(91, 91, 67, kF3);

   DefineKey(91, 91, 68, kF4);

   DefineKey(91, 91, 69, kF5);

   DefineKey(91, 70, 0, kEnd);

   DefineKey(91, 72, 0, kHome);

   DefineKey(91, 49, 126, kHome);

   DefineKey(91, 52, 126, kEnd);

end;

 

function TranslateCodes(C : Word) : Byte;

begin

   case C of

     kF1 : Result := 59;

     kF2 : Result := 60;

     kF3 : Result := 61;

     kF4 : Result := 62;

     kF5 : Result := 63;

     kF6 : Result := 64;

     kF7 : Result := 65;

     kF8 : Result := 66;

     kF9 : Result := 67;

     kF10 : Result := 68;

     kF11 : Result := 69;

     kF12 : Result := 70;

     kHome : Result := 71;

     kUArrow : Result := 72;

     kPgUp : Result := 73;

     kLArrow : Result := 75;

     kRArrow : Result := 77;

     kEnd : Result := 79;

     kDArrow : Result := 80;

     kPgDn : Result := 81;

     kIns : Result := 82;

     kDel : Result := 83;

     else Result := 0;

   end;

end;

 

function wread(Win : PWINDOW; Buf : PChar; n : Integer) : Integer;

var

   tx, ty : Word;

   Count, ch : Integer;

begin

   Intr := False;

   Broken := False;

   noecho;

   cbreak;

   nodelay(Win, True);

   Count := 0;

   tx := Win._curx;

   ty := Win._cury;

   waddch(Win, 32);

   Win._cury := ty;

   Win._curx := tx;

   wrefresh(Win);

   ch := 0;

   while ch <> 10 do

   begin

     if Intr then

     begin

       Result := 0;

       Broken := True;

       Buf[Count] := #0;

       Exit;

     end;

     ch := wgetch(Win);

     case ch of

       32..126, 128..255 :

       begin

         waddch(Win, ch);

         tx := Win._curx;

         ty := Win._cury;

         waddch(Win, 32);

         Win._cury := ty;

         Win._curx := tx;

         wrefresh(Win);

         Buf[Count] := Char(Lo(ch));

         Inc(Count);

         if Count = (n - 1) then

         begin

           Buf[Count] := #0;

           Result := 0;

           Exit;

         end;

       end;

       BS, kBkSp, kLArrow :

       begin

         tx := Win._curx;

         ty := Win._cury;

         if Count > 0 then

         begin

           if tx > 0 then Dec(tx)

           else if ty > 0 then

           begin

             Dec(ty);

             tx := Win._maxx;

           end;

           Win._curx := tx;

           Win._cury := ty;

           waddch(Win, 32);

           Win._curx := tx;

           Win._cury := ty;

           wrefresh(Win);

           Dec(Count);

         end;

       end;

     end;

   end;

   Buf[Count] := #0;

   waddch(Win, 10);

   Result := 0;

end;

 

// Text file driver routines

 

function NCInOut(var F : Text) : Integer;

begin

   SetAttrs;

   with TTextRec(F) do

   begin

     if Mode = fmOutput then

     begin

       IOBuf[BufPos] := 0;

       waddstr(CurWnd, @IOBuf[0]);

       BufPos := 0;

       Result := 0;

     end else

     if Mode = fmInput then

     begin

       DoingInput := True;

       echo;

       nocbreak;

       nodelay(CurWnd, False);

       //wgetnstr(CurWnd, @IOBuf[0], BUF_SIZE-2);

       wread(CurWnd, @IOBuf[0], BUF_SIZE-1);

       BufEnd := __strlen(@IOBuf[0])+1;

       if BufEnd < BUF_SIZE then IOBuf[BufEnd-1] := 10;

       BufPos := 0;

       noecho;

       cbreak;

       nodelay(CurWnd, True);

       DoingInput := False;

       Result := 0;

     end;

   end;

end;

 

function NCFlush(var F : Text) : Integer;

begin

   with TTextRec(F) do

   begin

     if Mode = fmOutput then

     begin

       SetAttrs;

       IOBuf[BufPos] := 0;

       waddstr(CurWnd, @IOBuf[0]);

       wrefresh(CurWnd);

       BufPos := 0;

     end else

     begin

       BufEnd := 0;

       FillChar(IOBuf[0], BUF_SIZE, 0);

       BufPos := 0;

     end;

   end;

   Result := 0;

end;

 

function NCClose(var F : Text) : Integer;

begin

   TTextRec(F).Mode := fmClosed;

   Result := 0;

end;

 

function NCOpen(var F : Text) : Integer;

begin

   with TTextRec(F) do

   begin

     if Mode = fmInOut then Mode := fmOutput;

     InOutFunc := @NCInOut;

     FlushFunc := @NCFlush;

     CloseFunc := @NCClose;

     Result:=0;

   end;

   Result := 0;

end;

 

procedure AssignLinCRT(var F : Text);

begin

   with TTextRec(F) do

   begin

     Mode := fmClosed;

     BufSize := BUF_SIZE;

     BufPtr := @IOBuf[0];

     OpenFunc := @NCOpen;

     InOutFunc := nil;

     FlushFunc := nil;

     CloseFunc := nil;

     Name[0] := #0;

   end;

end;

 

// Public LinCRT routines

 

procedure ClrEol;

begin

   SetAttrs;

   wclrtoeol(CurWnd);

   wrefresh(CurWnd);

end;

 

procedure ClrScr;

begin

   SetAttrs;

   wclear(CurWnd);

end;

 

procedure DelChar;

begin

   wdelch(CurWnd);

   wrefresh(CurWnd);

end;

 

procedure DelLine;

begin

   wdeleteln(CurWnd);

   wrefresh(CurWnd);

end;

 

procedure DoneLinCRT;

begin

   endwin;

end;

 

function GetAddAttrXY(X, Y : Byte) : Byte;

var

   tx, ty : Integer;

begin

   tx := CurWnd._curx;

   ty := CurWnd._cury;

   CurWnd._curx := X - 1;

   CurWnd._cury := Y - 1;

   Result := Lo(winch(CurWnd) shr 16);

   CurWnd._curx := tx;

   CurWnd._cury := ty;

end;

 

function GetCharXY(X, Y : Byte) : Char;

var

   tx, ty : Integer;

begin

   tx := CurWnd._curx;

   ty := CurWnd._cury;

   CurWnd._curx := X - 1;

   CurWnd._cury := Y - 1;

   Result := Char(Lo(winch(CurWnd)));

   CurWnd._curx := tx;

   CurWnd._cury := ty;

end;

 

function GetColorXY(X, Y : Byte) : Byte;

var

   tx, ty : Integer;

begin

   tx := CurWnd._curx;

   ty := CurWnd._cury;

   CurWnd._curx := X - 1;

   CurWnd._cury := Y - 1;

   Result := Lo(winch(CurWnd) shr 8);

   CurWnd._curx := tx;

   CurWnd._cury := ty;

end;

 

function GetKey : Word;

var

   Key : Integer;

begin

// If You have some problems with GetKey,

// see the note above the DefineKeys procedure

   noecho;

   nodelay(CurWnd, False);

   cbreak;

   Key := wgetch(CurWnd);

   if Key = KEY_MOUSE then

   begin

     getmouse(MouseEvent);

     Key := TranslateMEvent;

   end;

   Result := Key;

end;

 

procedure GotoXY(X, Y : Byte);

begin

   if (X > 0) and (X < (CurWnd._maxx+2)) then

   CurWnd._curx := X - 1;

   if (Y > 0) and (Y < (CurWnd._maxy+2)) then

   CurWnd._cury := Y - 1;

   wrefresh(CurWnd);

   // wmove(CurWnd, Y-1, X-1);

end;

 

procedure InitLinCRT;

begin

   StdScr := initscr;

   ScrCols := StdScr._maxx;

   ScrLines := StdScr._maxy;

   CurWnd := StdScr;

   WindMin := Lo(CurWnd._begx) + (Lo(CurWnd._begy) shl 8);

   WindMax := Lo(CurWnd._maxx) + (Lo(CurWnd._maxy) shl 8);

   start_color;

   OnTermResize := nil;

   signal(SIGWINCH, @winch_handler);

   TextAttr := 7;

   Inverse := False;

   Underline := False;

   StackHead := -1;

   BreakOnResize := False;

   Broken := False;

   DoingInput := False;

   ScrollWnd := True;

   AssignLinCRT(Input);

   Reset(Input);

   AssignLinCRT(Output);

   ReWrite(Output);

   keypad(StdScr, True);

   DefineKeys;

   SpKey := 0;

   Intr := False;

end;

 

procedure InitMouse;

var

   mask, oldmask : Integer;

begin

   mask := BUTTON1_RELEASED or BUTTON1_PRESSED or BUTTON1_CLICKED or

   BUTTON1_DOUBLE_CLICKED;

   mask := mask or BUTTON2_RELEASED or BUTTON2_PRESSED or BUTTON2_CLICKED or

   BUTTON2_DOUBLE_CLICKED;

   mask := mask or BUTTON3_RELEASED or BUTTON3_PRESSED or BUTTON3_CLICKED or

   BUTTON3_DOUBLE_CLICKED;

//    if TrackMove then mask := mask or REPORT_MOUSE_POSITION;

   mousemask(mask, oldmask);

end;

 

procedure InsChar(Ch : Char);

begin

   SetAttrs;

   winsch(CurWnd, Integer(Ch));

   wrefresh(CurWnd);

end;

 

procedure InsLine;

begin

   SetAttrs;

   winsdelln(CurWnd, 1);

   wrefresh(CurWnd);

end;

 

function KeyPressed : Boolean;

var

   ch : chtype;

begin

   noecho;

   nodelay(CurWnd, True);

   cbreak;

   Result := False;

   ch := wgetch(CurWnd);

   if ch <> ERR then

   begin

     ungetch(ch);

     Result := True;

   end;

end;

 

procedure KillMouse;

var

   oldmask : Integer;

begin

   mousemask(0, oldmask);

end;

 

function MouseTrapped : Boolean;

begin

   Result := wenclose(CurWnd, MouseEvent.y, MouseEvent.x);

end;

 

procedure PutChar(Ch : Char);

var

   tx, ty : Integer;

begin

   scrollok(CurWnd, False);

   tx := CurWnd._curx;

   ty := CurWnd._cury;

   SetAttrs;

   waddch(CurWnd, Byte(Ch));

   CurWnd._curx := tx;

   CurWnd._cury := ty;

   wrefresh(CurWnd);

   scrollok(CurWnd, ScrollWnd);

end;

 

procedure PutCharXY(Ch : Char; X, Y : Byte);

var

   tx, ty : Integer;

begin

   scrollok(CurWnd, False);

   tx := CurWnd._curx;

   ty := CurWnd._cury;

   CurWnd._curx := X-1;

   CurWnd._cury := Y-1;

   SetAttrs;

   waddch(CurWnd, Byte(Ch));

   CurWnd._curx := tx;

   CurWnd._cury := ty;

   wrefresh(CurWnd);

   scrollok(CurWnd, ScrollWnd);

end;

 

function ReadKey : Char;

var

   ch : chtype;

begin

   if SpKey <> 0 then

   begin

     Result := Char(SpKey);

     SpKey := 0;

     Exit;

   end;

   noecho;

   nodelay(CurWnd, False);

   cbreak;

   ch := wgetch(CurWnd);

   if ch > 255 then

   begin

     SpKey := TranslateCodes(ch);

     ch := 0;

   end;

   Result := Char(Lo(ch));

end;

 

procedure SetColors(Fg, Bg : Byte);

begin

   TextAttr := TextAttr and (255 - 112);

   TextAttr := TextAttr or (Bg shl 4);

   if Fg = Blink then TextAttr := TextAttr or Blink

   else

   begin

     TextAttr := TextAttr and 127;

     TextAttr := TextAttr and (255 - 15);

     TextAttr := TextAttr or Fg;

   end;

end;

 

procedure SetScrollWnd(b : Boolean);

begin

   ScrollWnd := b;

   scrollok(CurWnd, ScrollWnd);

end;

 

procedure ShellOut(Cmd : PChar);

begin

   def_prog_mode;

   endwin;

   Libc.system(Cmd);

   wrefresh(StdScr);

   wrefresh(CurWnd);

end;

 

procedure TextBackground(Color : Byte);

begin

   TextAttr := TextAttr and (255 - 112);

   TextAttr := TextAttr or (Color shl 4);

end;

 

procedure TextColor(Color : Byte);

begin

   if Color = Blink then TextAttr := TextAttr or Blink

   else

   begin

     TextAttr := TextAttr and 127;

     TextAttr := TextAttr and (255 - 15);

     TextAttr := TextAttr or Color;

   end;

end;

 

function WhereMouseXY : Word;

var

   X, Y : Integer;

begin

   X := MouseEvent.x;

   Y := MouseEvent.y;

   wmouse_trafo(StdScr, Y, X, False);

   Result := Lo(X) +1 + ((Lo(Y) + 1) shl 8);

end;

 

function WhereX : Byte;

begin

   Result := Lo(CurWnd._curx + 1);

end;

 

function WhereY : Byte;

begin

   Result := Lo(CurWnd._cury + 1);

end;

 

procedure Window(X1, Y1, X2, Y2 : Byte);

var

   Tmp : PWINDOW;

begin

   Tmp := CurWnd;

   CurWnd := newwin(Y2-Y1+1, X2-X1+1, Y1-1, X1-1);

   if CurWnd = nil then CurWnd := Tmp

   else if Tmp <> StdScr then delwin(Tmp);

   WindMin := Lo(CurWnd._begx) + (Lo(CurWnd._begy) shl 8);

   WindMax := Lo(CurWnd._maxx) + (Lo(CurWnd._maxy) shl 8);

   scrollok(CurWnd, ScrollWnd);

   SetAttrs;

   keypad(CurWnd, True)

end;

 

initialization

// dummy

 

finalization

 

endwin;

 

end.

 

{*********************************************}

{  ncurses interface unit

 

Parts of this file are translated from ncurses header file curses.h

Copyright (c) 1998,1999,2000 Free Software Foundation, Inc.

Translator: Andrei Borovsky - aborovsky@mtu-net.ru

 

This traslation is by no means complete.

I have included here only those ncurses functions that

are used (or are planned to be used) in my LinCRT unit.

I have also added here some routines and constants that

I've found useful with ncurses.

}

 

unit NCurses;

 

interface

 

const

 

ERR = -1;

{$EXTERNALSYM ERR}

OK = 0;

{$EXTERNALSYM OK}

KEY_MOUSE = $199;

{$EXTERNALSYM KEY_MOUSE}

 

BUTTON1_RELEASED = $1;

{$EXTERNALSYM BUTTON1_RELEASED}

BUTTON1_PRESSED = $2;

{$EXTERNALSYM BUTTON1_PRESSED}

BUTTON1_CLICKED = $4;

{$EXTERNALSYM BUTTON1_CLICKED}

BUTTON1_DOUBLE_CLICKED = $8;

{$EXTERNALSYM BUTTON1_DOUBLE_CLICKED}

BUTTON2_RELEASED = $40;

{$EXTERNALSYM BUTTON2_RELEASED}

BUTTON2_PRESSED = $80;

{$EXTERNALSYM BUTTON2_PRESSED}

BUTTON2_CLICKED = $100;

{$EXTERNALSYM BUTTON2_CLICKED}

BUTTON2_DOUBLE_CLICKED = $200;

{$EXTERNALSYM BUTTON2_DOUBLE_CLICKED}

BUTTON3_RELEASED = $1000;

{$EXTERNALSYM BUTTON3_RELEASED}

BUTTON3_PRESSED = $2000;

{$EXTERNALSYM BUTTON3_PRESSED}

BUTTON3_CLICKED = $4000;

{$EXTERNALSYM BUTTON3_CLICKED}

BUTTON3_DOUBLE_CLICKED = $8000;

{$EXTERNALSYM BUTTON3_DOUBLE_CLICKED}

REPORT_MOUSE_POSITION = $8000000;

{$EXTERNALSYM REPORT_MOUSE_POSITION}

 

COLOR_BLACK = 0;

{$EXTERNALSYM COLOR_BLACK}

COLOR_RED = 1;

{$EXTERNALSYM COLOR_RED}

COLOR_GREEN = 2;

{$EXTERNALSYM COLOR_GREEN}

COLOR_YELLOW = 3;

{$EXTERNALSYM COLOR_YELLOW}

COLOR_BLUE = 4;

{$EXTERNALSYM COLOR_BLUE}

COLOR_MAGENTA = 5;

{$EXTERNALSYM COLOR_MAGENTA}

COLOR_CYAN = 6;

{$EXTERNALSYM COLOR_CYAN}

COLOR_WHITE = 7;

{$EXTERNALSYM COLOR_WHITE}

 

A_STANDOUT = 1 shl 16;

{$EXTERNALSYM A_STANDOUT}

A_UNDERLINE = 1 shl 17;

{$EXTERNALSYM A_UNDERLINE}

A_REVERSE = 1 shl 18;

{$EXTERNALSYM A_REVERSE}

A_BLINK = 1 shl 19;

{$EXTERNALSYM A_BLINK}

A_DIM = 1 shl 20;

{$EXTERNALSYM A_DIM}

A_BOLD = 1 shl 21;

{$EXTERNALSYM A_BOLD}

A_ALTCHARSET = 1 shl 22;

{$EXTERNALSYM A_ALTCHARSET}

A_INVIS = 1 shl 23;

{$EXTERNALSYM A_INVIS}

 

type

 

chtype = Integer;

{$EXTERNALSYM chtype}

PChtype = ^chtype;

attr_t = chtype;

{$EXTERNALSYM attr_t}

NCURSES_COLOR_T = Word;

{$EXTERNALSYM NCURSES_COLOR_T}

NCURSES_SIZE_T = Word;

{$EXTERNALSYM NCURSES_SIZE_T}

mmask_t = Integer;

{$EXTERNALSYM mmask_t}

 

MEVENT = record

   id : Word;

   x, y, z : Integer;

   bstate : mmask_t;

end;

{$EXTERNALSYM MEVENT}

 

ldat = record

   text : PChtype;

   firstchar : NCURSES_SIZE_T;

   lastchar : NCURSES_SIZE_T;

   oldindex : NCURSES_SIZE_T;

end;

{$EXTERNALSYM ldat}

 

PLdat = ^ldat;

 

pdat = record

   _pad_y, _pad_x : NCURSES_SIZE_T;

   _pad_top, _pad_left : NCURSES_SIZE_T;

   _pad_bottom, _pad_right : NCURSES_SIZE_T;

end;

{$EXTERNALSYM pdat}

 

PWINDOW = ^_win_st;

_win_st = record

   _cury, _curx : NCURSES_SIZE_T;

   _maxy, _maxx : NCURSES_SIZE_T;

   _begy, _begx : NCURSES_SIZE_T;

   _flags : Word;

   _attrs : attr_t;

   _bkgd : chtype;

   _notimeout : Boolean;

   _clear : Boolean;

   _leaveok : Boolean;

   _scroll : Boolean;

   _idlok : Boolean;

   _idcok : Boolean;

   _immed : Boolean;

   _sync : Boolean;

   _use_keypad : Boolean;

   _delay : Integer;

   _line : PLdat;

   _regtop : NCURSES_SIZE_T;

   _regbottom : NCURSES_SIZE_T;

   _parx : Integer;

   _pary : Integer;

   _parent : PWINDOW;

   _pad : pdat;

   _yoffset : NCURSES_SIZE_T;

end;

{$EXTERNALSYM _win_st}

 

WINDOW = _win_st;

{$EXTERNALSYM WINDOW}

 

function cbreak : Integer; cdecl;

{$EXTERNALSYM cbreak}

function COLOR_PAIR(n : Integer) : Integer;

function def_prog_mode : Integer; cdecl;

{$EXTERNALSYM def_prog_mode}

function define_key(definitions : PChar; keycode : Integer) : Integer; cdecl;

{$EXTERNALSYM define_key}

function delwin(win : PWINDOW) : Integer; cdecl;

{$EXTERNALSYM delwin}

function echo : Integer; cdecl;

{$EXTERNALSYM echo}

function endwin : Integer; cdecl;

{$EXTERNALSYM endwin}

function erasechar : Integer; cdecl;

{$EXTERNALSYM erasechar}

function getmouse(var event : MEVENT) : Integer; cdecl;

{$EXTERNALSYM getmouse}

function getyx(win : PWINDOW; var y, x : Word) : Integer;

{$EXTERNALSYM getyx}

function init_pair(pair, f, b : Word) : Integer; cdecl; //i

{$EXTERNALSYM init_pair}

function initscr : PWINDOW; cdecl;

{$EXTERNALSYM initscr}

function keypad(win : PWINDOW; b : Boolean) : Integer; cdecl;

{$EXTERNALSYM keypad}

function leaveok(win : PWINDOW; b : Boolean) : Integer; cdecl;

{$EXTERNALSYM leaveok}

function mousemask(newmask : mmask_t; var oldmask : mmask_t) : mmask_t; cdecl;

{$EXTERNALSYM mousemask}

function mvwaddch(win : PWINDOW; y, x : Integer; ch : chtype) : Integer; cdecl;

{$EXTERNALSYM mvwaddch}

function mvwin(win : PWINDOW; y, x : Integer) : Integer; cdecl;

{$EXTERNALSYM mvwin}

function NCURSES_BITS(mask, shift : Integer) : Integer;

function newwin(nlines, ncols, begin_y, begin_x : Integer) : PWINDOW; cdecl;

{$EXTERNALSYM newwin}

function nl : Integer; cdecl;

{$EXTERNALSYM nl}

function nocbreak : Integer; cdecl;

{$EXTERNALSYM nocbreak}

function nodelay(win : PWINDOW; b : Boolean) : Integer; cdecl;

{$EXTERNALSYM nodelay}

function noecho : Integer; cdecl;

{$EXTERNALSYM noecho}

function notimeout(win : PWINDOW; b : Boolean) : Integer; cdecl;

{$EXTERNALSYM notimeout}

function pechochar(win : PWINDOW; ch : chtype) : Integer; cdecl;

{$EXTERNALSYM pechochar}

function resizeterm(lines, columns : Integer) : Integer; cdecl;

{$EXTERNALSYM resizeterm}

function scroll(win : PWINDOW) : Integer; cdecl;

{$EXTERNALSYM scroll}

function scrollok(win : PWINDOW; b : Boolean) : Integer; cdecl;

{$EXTERNALSYM scrollok}

function set_attr(win : PWINDOW; attr : Integer) : Integer;

function start_color : Integer; cdecl;

{$EXTERNALSYM start_color}

function timeout(delay : Integer) : Integer; cdecl;

{$EXTERNALSYM timeout}

function ungetch(ch : Integer) : Integer; cdecl;

{$EXTERNALSYM ungetch}

function unset_attr(win : PWINDOW; attr : Integer) : Integer;

function waddch(win : PWINDOW; ch : chtype) : Integer; cdecl;

{$EXTERNALSYM waddch}

function waddstr(win : PWINDOW; str : PChar) : Integer; cdecl;

{$EXTERNALSYM waddstr}

function wattr_get(win : PWINDOW; var attrs : attr_t; var pair : Word; opts : Pointer) : Integer; cdecl;

{$EXTERNALSYM wattr_get}

function wattrset(win : PWINDOW; attrs : Integer) : Integer;

{$EXTERNALSYM wattrset}

function wclear(win : PWINDOW) : Integer; cdecl;

{$EXTERNALSYM wclear}

function wclrtoeol(win : PWINDOW) : Integer; cdecl;

{$EXTERNALSYM wclrtoeol}

function wcolor_set(win : PWINDOW; Colors : Word; opts : Pointer) : Integer; cdecl;

{$EXTERNALSYM wcolor_set}

function wdelch(win : PWINDOW) : Integer; cdecl;

{$EXTERNALSYM wdelch}

function wdeleteln(win : PWINDOW) : Integer; cdecl;

{$EXTERNALSYM wdeleteln}

function wenclose(win : PWindow; y, x : Integer) : Boolean; cdecl;

{$EXTERNALSYM wenclose}

function werase(win : PWINDOW) : Integer; cdecl;

{$EXTERNALSYM werase}

function wgetch(win : PWINDOW) : Integer; cdecl;

{$EXTERNALSYM wgetch}

function wgetnstr(win : PWINDOW; str : PChar; n : Integer) : Integer; cdecl;

{$EXTERNALSYM wgetnstr}

function winch(win : PWINDOW) : chtype; cdecl;

{$EXTERNALSYM winch}

function winsch(win : PWINDOW; ch : chtype) : Integer; cdecl;

{$EXTERNALSYM winsch}

function winsdelln(win : PWINDOW; n : Integer) : Integer; cdecl;

{$EXTERNALSYM winsdelln}

function winsstr(win : PWINDOW; str : PChar) : Integer; cdecl;

{$EXTERNALSYM winsstr}

function wmouse_trafo(win : PWINDOW; var pY, pX : Integer; to_screen : Boolean) : Boolean; cdecl;

{$EXTERNALSYM wmouse_trafo}

function wmove(win : PWINDOW; y, x : Integer) : Integer; cdecl;

{$EXTERNALSYM wmove}

function wrefresh(win : PWINDOW) : Integer; cdecl;

{$EXTERNALSYM wrefresh}

 

implementation

 

const

 

libname = 'libncurses.so';

 

function cbreak : Integer; cdecl; external libname name 'cbreak';

function def_prog_mode : Integer; cdecl; external libname name 'def_prog_mode';

function define_key(definitions : PChar; keycode : Integer) : Integer; cdecl; external libname name 'define_key';

function delwin(win : PWINDOW) : Integer; cdecl; external libname name 'delwin';

function echo : Integer; cdecl; external libname name 'echo';

function endwin : Integer; cdecl; external libname name 'endwin';

function erasechar : Integer; cdecl; external libname name 'erasechar';

function getmouse(var event : MEVENT) : Integer; cdecl; external libname name 'getmouse';

function init_pair(pair, f, b : Word) : Integer; cdecl; external libname name 'init_pair';

function initscr : PWINDOW; cdecl; external libname name 'initscr';

function keypad(win : PWINDOW; b : Boolean) : Integer; cdecl; external libname name 'keypad';

function leaveok(win : PWINDOW; b : Boolean) : Integer; cdecl; external libname name 'leaveok';

function mousemask(newmask : mmask_t; var oldmask : mmask_t) : mmask_t; cdecl; external libname name 'mousemask';

function mvwaddch(win : PWINDOW; y, x : Integer; ch : chtype) : Integer; cdecl; external libname name 'mvwaddch';

function mvwin(win : PWINDOW; y, x : Integer) : Integer; cdecl; cdecl; external libname name 'mvwin';

function newwin(nlines, ncols, begin_y, begin_x : Integer) : PWINDOW; cdecl; external libname name 'newwin';

function nl : Integer; cdecl; external libname name 'nl';

function nocbreak : Integer; cdecl; external libname name 'nocbreak';

function nodelay(win : PWINDOW; b : Boolean) : Integer; cdecl; external libname name 'nodelay';

function noecho : Integer; cdecl; external libname name 'noecho';

function notimeout(win : PWINDOW; b : Boolean) : Integer; cdecl; external libname name 'notimeout';

function pechochar(win : PWINDOW; ch : chtype) : Integer; cdecl; external libname name 'pechochar';

function resizeterm(lines, columns : Integer) : Integer; cdecl; external libname name 'resizeterm';

function scroll(win : PWINDOW) : Integer; cdecl; external libname name 'scroll';

function scrollok(win : PWINDOW; b : Boolean) : Integer; cdecl; external libname name 'scrollok';

function start_color : Integer; cdecl; external libname name 'start_color';

function timeout(delay : Integer) : Integer; cdecl; external libname name 'timeout';

function ungetch(ch : Integer) : Integer; cdecl; cdecl; external libname name 'ungetch';

function waddch(win : PWINDOW; ch : chtype) : Integer; cdecl; external libname name 'waddch';

function waddstr(win : PWINDOW; str : PChar) : Integer; cdecl; external libname name 'waddstr';

function wattr_get(win : PWINDOW; var attrs : attr_t; var pair : Word; opts : Pointer) : Integer; cdecl; external libname name 'wattr_get';

//  function wattrset(win : PWindow; attrs : Integer) : Integer; cdecl; external libname name 'wattrset';

function wclear(win : PWINDOW) : Integer; cdecl; external libname name 'wclear';

function wclrtoeol(win : PWINDOW) : Integer; cdecl; external libname name 'wclrtoeol';

function wcolor_set(win : PWINDOW; Colors : Word; opts: Pointer) : Integer; cdecl; external libname name 'wcolor_set';

function wdelch(win : PWINDOW) : Integer; cdecl; external libname name 'wdelch';

function wdeleteln(win :PWINDOW) : Integer; cdecl; external libname name 'wdeleteln';

function wenclose(win : PWINDOW; y, x : Integer) : Boolean; cdecl; external libname name 'wenclose';

function werase(win : PWINDOW) : Integer; cdecl; external libname name 'werase';

function wgetch(win : PWINDOW) : Integer; cdecl; external libname name 'wgetch';

function wgetnstr(win : PWINDOW; str : PChar; n : Integer) : Integer; cdeclexternal libname name 'wgetnstr';

function winch(win : PWINDOW) : chtype; cdecl; external libname name 'winch';

function winsch(win : PWINDOW; ch : chtype) : Integer; cdecl; external libname name 'winsch';

function winsdelln(win : PWINDOW; n : Integer) : Integer; cdecl; external libname name 'winsdelln';

function winsstr(win : PWINDOW; str : PChar) : Integer; cdecl; external libname name 'winsstr';

function wmouse_trafo(win : PWINDOW; var pY, pX : Integer; to_screen : Boolean) : Boolean;  cdecl; external libname name 'wmouse_trafo';

function wmove(win : PWINDOW; y, x : Integer) : Integer; cdecl; external libname name 'wmove';

function wrefresh(win : PWINDOW) : Integer; cdecl; external libname name 'wrefresh';

 

function getyx;

begin

   y := win._cury;

   x := win._curx;

   Result := 0;

end;

 

function set_attr;

begin

   win._attrs := win._attrs or attr;

   Result := 0;

end;

 

function unset_attr;

begin

   win._attrs := win._attrs and not attr;

   Result := 0;

end;

 

function NCURSES_BITS;

begin

   Result := mask shl (shift+8);

end;

 

function COLOR_PAIR;

begin

   Result := NCURSES_BITS(n, 0);

end;

 

function wattrset;

begin

   win._attrs := attrs;

   Result:=0;

end;

end.

 

 

 

 

Пример использования:

Code:

{

In order to see all the key codes

you should run this program either in pure

console mode or in terminals like XTerm,

since the standart KDE terminal program

reserves some keyboard and mouse keys for

its own use.

Also note that I've never seen a terminal

program that supported ALL the ncurses features

correctly.

}

 

program LinCRTDemo;

 

{$APPTYPE CONSOLE}

 

uses

SysUtils, LinCRT;

var

S : String;

Key : Integer;

begin

InitLinCRT;

Window((ScrCols shr 1)-15, 1, (ScrCols shr 1)+15, 4);

TextBackground(Blue);

TextColor(White);

ClrScr;

GotoXY(2, 2);

Write('Hello, this is LinCRT window.');

GotoXY(2, 3);

Write('Press any key to continue.');

GetKey;

Window(2, 7, 35, 10);

SetColors(Yellow, Red);

ClrScr;

WriteLn('This is another window. Type some input and press [Enter].');

ReadLn(S);

Window(9, 12, 40, 15);

SetColors(White, Green);

ClrScr;

Write('You have typed: ');

Underline := True;

WriteLn(S);

Underline := False;

Write('Press any key');

GetKey;

Window(1, 1, ScrCols, ScrLines);

SetColors(LightGreen, Black);

ClrScr;

S := 'Now press some key or mouse button to see its code';

GotoXY((ScrCols - Length(S)) shr 1, 1);

Write(S);

S := 'Or press [q] to quit.';

GotoXY((ScrCols - Length(S)) shr 1, 2);

WriteLn(S);

InitMouse;

Key := GetKey;

while Key <> Byte('q') do

begin

   Write(' '+IntToStr(Key));

   Key := GetKey;

end;

KillMouse;

DoneLinCRT;

end.

 

 

©Drkb::04631