home *** CD-ROM | disk | FTP | other *** search
/ Freelog 22 / freelog 22.iso / Prog / Djgpp / GPC2952B.ZIP / lib / gcc-lib / djgpp / 2.952 / units / crt.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-02-08  |  45.1 KB  |  1,283 lines
  1. {
  2. CRT (Crt Replacement Tool)
  3. Portable BP compatible CRT unit for GPC with many extensions
  4.  
  5. This unit is aware of terminal types. This means programs using this
  6. unit will work whether run locally or while being logged in remotely
  7. from a system with a completely different terminal type (as long as
  8. the appropriate terminfo entry is present on the system where the
  9. program is run).
  10.  
  11. NOTES:
  12.  
  13. - The CRT unit needs the ncurses and panel libraries which should be
  14.   available for almost any system. For Dos systems, where ncurses is
  15.   not available, it is configured to use the PDCurses and its panel
  16.   library instead. On Unix systems with X11, it can also use
  17.   PDCurses (xcurses) and xpanel to produce X11 programs. The
  18.   advantage is that the program won't need an xterm with a valid
  19.   terminfo entry, the output may look a little nicer and function
  20.   keys work better than in an xterm, but the disadvantage is that it
  21.   will only run under X. The ncurses and PDCurses libraries
  22.   (including panel and xpanel, resp.) can be found in
  23.   ftp://agnes.dida.physik.uni-essen.de/gnu-pascal/libs/
  24.   (Note that ncurses is already installed on many Unix systems.) For
  25.   ncurses, version 5.0 or newer is strongly recommended because
  26.   older versions contain a bug that severely affects CRT programs.
  27.  
  28.   When an X11 version under Unix is wanted, give `-DX11' when
  29.   compiling crt.pas and crtc.c (or when compiling crt.pas or a
  30.   program that uses CRT with `--automake'). On pre-X11R6 systems,
  31.   give `-DNOX11R6' additionally. You might also have to give the
  32.   path to the X11 libraries with `-L', e.g. `-L /usr/X11/lib'.
  33.  
  34. - A few features cannot be implemented in a portable way and are
  35.   only available on some systems:
  36.  
  37.       Sound, NoSound 1)                  -----------------------.
  38.       GetShiftState                      ------------------.    |
  39.       TextMode etc. 2)                   -------------.    |    |
  40.       CRTSavePreviousScreen              --------.    |    |    |
  41.       Interrupt signal (Ctrl-C) handling ---.    |    |    |    |
  42.                                             |    |    |    |    |
  43.   Linux/x86 3) (terminal)                   X    X 4) X 5) X 6) X 6)
  44.   Other Unix (terminal)                     X    X 7) X 5) -    -
  45.   Unix (X11 version)                        X    X    - 8) X    -
  46.   Dos (DJGPP)                               X    X    X    X    X
  47.   MS-Windows (Cygwin or mingw)              X    -    X 9) X    -
  48.  
  49.   Notes:
  50.  
  51.   1) If you define NO_CRT_DUMMY_SOUND while compiling CRT, you will
  52.      get linking errors when your program tries to use Sound/NoSound
  53.      on a platform where it's not supported (which is useful to
  54.      detect at compile time if playing sound is a major task of your
  55.      program). Otherwise, Sound/NoSound will simply do nothing
  56.      (which is usually acceptable if the program uses these routines
  57.      just for an occasional beep).
  58.  
  59.   2) Changing to monochrome modes works on all platforms. Changing
  60.      the screen size only works on those indicated. However, even on
  61.      the platforms not supported, the program will react to screen
  62.      size changes by external means (e.g. changing the window size
  63.      with the mouse if running in a GUI window or resizing a console
  64.      or virtual terminal).
  65.  
  66.   3) Probably also on other processors, but I've had no chance to
  67.      test this yet.
  68.  
  69.   4) Only on a local console with access permissions to the
  70.      corresponding virtual console memory device or using the
  71.      `crtscreen' utility (see crtscreen.c in the demos directory).
  72.  
  73.   5) Only if supported by an external command (e.g., in xterms and
  74.      on local Linux consoles). The command to be called can be
  75.      defined in the environment variable `RESIZETERM' (where the
  76.      variables `columns' and `lines' in the command are set to the
  77.      size wanted). If not set, the code will try `resize -s' in an
  78.      xterm and otherwise `SVGATextMode' and `setfont'. For this to
  79.      work, these utilities need to be present in the PATH or
  80.      `/usr/sbin' or `/usr/local/sbin'. Furthermore, SVGATextMode and
  81.      setfont require root permissions, either to the executable of
  82.      the program compiled with CRT or to resizecons (called by
  83.      setfont) or SVGATextMode. To allow the latter, do
  84.      "chmod u+s `which resizecons`" and/or
  85.      "chmod u+s `which SVGATextMode`", as root once, but only if you
  86.      really want each user to be allowed to change the text mode.
  87.  
  88.   6) Only on local consoles.
  89.  
  90.   7) Some terminals only. Most xterms etc. support it as well as
  91.      other terminals that support an "alternate screen" in the
  92.      smcup/rmcup terminal capabilities.
  93.  
  94.   8) But the user can resize the window.
  95.  
  96.   9) Only with PDCurses, not with ncurses. Changing the number of
  97.      screen *columns* doesn't work in a full-screen session.
  98.  
  99. - When CRT is initialized (automatically or explicitly; see the
  100.   comments for CRTInit), the screen is cleared, and at the end of
  101.   the program, the cursor is placed at the bottom of the screen
  102.   (curses behaviour).
  103.  
  104. - All the other things (including most details like color and
  105.   function key constants) are compatible with BP's CRT unit, and
  106.   there are many extensions that BP's unit does not have.
  107.  
  108. - When the screen size is changed by an external event (e.g.,
  109.   resizing an xterm or changing the screen size from another VC
  110.   under Linux), the virtual "function key" kbScreenSizeChanged is
  111.   returned. Applications can use the virtual key to resize their
  112.   windows. kbScreenSizeChanged will not be returned if the screen
  113.   size change was initiated by the program itself (by using TextMode
  114.   or SetScreenSize). Note that TextMode sets the current panel to
  115.   the full screen size, sets the text attribute to the default and
  116.   clears the window (BP compatibility), while SetScreenSize does
  117.   not.
  118.  
  119. - After the screen size has been changed, whether by using TextMode,
  120.   SetScreenSize or by an external event, ScreenSize will return the
  121.   new screen size. The current window and all panels will have been
  122.   adjusted to the new screen size. This means, if their right or
  123.   lower ends are outside the new screen size, the windows are moved
  124.   to the left and/or top as far as necessary. If this is not enough,
  125.   i.e., if they are wider/higher than the new screen size, they are
  126.   shrinked to the total screen width/height. When the screen size is
  127.   enlarged, window sizes are not changed, with one exception:
  128.   Windows that extend through the whole screen width/height are
  129.   enlarged to the whole new screen width/height (in particular,
  130.   full-screen windows remain full-screen). This behaviour might not
  131.   be optimal for all purposes, but you can always resize your
  132.   windows in your application after the screen size change.
  133.  
  134. - (ncurses only) The environment variable `ESCDELAY' specifies the
  135.   number of milliseconds allowed between an `Esc' character and the
  136.   rest of an escape sequence (default 1000). Setting it to a value
  137.   too small can cause problems with programs not recognizing escape
  138.   sequences such as function keys, especially over slow network
  139.   connections. Setting it to a value too large can delay the
  140.   recognition of an `ESC' key press notably. On local Linux
  141.   consoles, e.g., 10 seems to be a good value.
  142.  
  143. - When trying to write portable programs, don't rely on exactly the
  144.   same look of your output and the availability of all the key
  145.   combinations. Some kinds of terminals support only some of the
  146.   display attributes and special characters, and usually not all of
  147.   the keys declared are really available. Therefore, it's safer to
  148.   provide the same function on different key combinations and to not
  149.   use the more exotic ones.
  150.  
  151. Copyright (C) 1998-2001 Free Software Foundation, Inc.
  152.  
  153. Author: Frank Heckenbach <frank@pascal.gnu.de>
  154.  
  155. This file is part of GNU Pascal.
  156.  
  157. GNU Pascal is free software; you can redistribute it and/or modify
  158. it under the terms of the GNU General Public License as published by
  159. the Free Software Foundation; either version 2, or (at your option)
  160. any later version.
  161.  
  162. GNU Pascal is distributed in the hope that it will be useful,
  163. but WITHOUT ANY WARRANTY; without even the implied warranty of
  164. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  165. GNU General Public License for more details.
  166.  
  167. You should have received a copy of the GNU General Public License
  168. along with GNU Pascal; see the file COPYING. If not, write to the
  169. Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
  170. 02111-1307, USA.
  171.  
  172. As a special exception, if you link this file with files compiled
  173. with a GNU compiler to produce an executable, this does not cause
  174. the resulting executable to be covered by the GNU General Public
  175. License. This exception does not however invalidate any other
  176. reasons why the executable file might be covered by the GNU General
  177. Public License.
  178.  
  179. Please also note the license of the curses library used.
  180. }
  181.  
  182. {$gnu-pascal,B-,I-}
  183. {$if __GPC_RELEASE__ < 20000412}
  184. {$error This unit requires GPC release 20000412 or newer.}
  185. {$endif}
  186.  
  187. unit {$ifdef THIS_IS_WINCRT} WinCRT {$else} CRT {$endif};
  188.  
  189. interface
  190.  
  191. uses GPC;
  192.  
  193. const
  194.   { CRT modes }
  195.   BW40          = 0;            { 40x25 Black/White }
  196.   CO40          = 1;            { 40x25 Color }
  197.   BW80          = 2;            { 80x25 Black/White }
  198.   CO80          = 3;            { 80x25 Color }
  199.   Mono          = 7;            { 80x25 Black/White }
  200.   Font8x8       = 256;          { Add-in for 80x43 or 80x50 mode }
  201.  
  202.   { Mode constants for Turbo Pascal 3.0 compatibility }
  203.   C40           = CO40;
  204.   C80           = CO80;
  205.  
  206.   { Foreground and background color constants }
  207.   Black         = 0;
  208.   Blue          = 1;
  209.   Green         = 2;
  210.   Cyan          = 3;
  211.   Red           = 4;
  212.   Magenta       = 5;
  213.   Brown         = 6;
  214.   LightGray     = 7;
  215.  
  216.   { Foreground color constants }
  217.   DarkGray      = 8;
  218.   LightBlue     = 9;
  219.   LightGreen    = 10;
  220.   LightCyan     = 11;
  221.   LightRed      = 12;
  222.   LightMagenta  = 13;
  223.   Yellow        = 14;
  224.   White         = 15;
  225.  
  226.   { Add-in for blinking }
  227.   Blink         = 128;
  228.  
  229. type
  230.   TTextAttr = Byte;
  231.  
  232. var
  233.   { If False (default: True), catch interrupt signals (SIGINT;
  234.     Ctrl-C), and other flow control characters as well as SIGTERM,
  235.     SIGHUP and perhaps other signals }
  236.   CheckBreak  : Boolean = True; asmname 'crt_CheckBreak';
  237.  
  238.   { If True (default : False), replace Ctrl-Z by #0 in input }
  239.   CheckEOF    : Boolean = False; asmname 'crt_CheckEOF';
  240.  
  241.   { Ignored -- meaningless in this context }
  242.   DirectVideo : Boolean = True;
  243.  
  244.   { Ignored -- curses or the terminal driver will take care of that
  245.     when necessary }
  246.   CheckSnow   : Boolean = False;
  247.  
  248.   { Current (sic!) text mode }
  249.   LastMode    : Word = 3; asmname 'crt_LastMode';
  250.  
  251.   { Current text attribute }
  252.   TextAttr    : TTextAttr = 7; asmname 'crt_TextAttr';
  253.  
  254.   { Window upper left coordinates. *Obsolete*! Please see WindowMin
  255.     below. }
  256.   WindMin     : Word = not Word (0); asmname 'crt_WindMin';
  257.  
  258.   { Window lower right coordinates. *Obsolete*! Please see WindowMax
  259.     below. }
  260.   WindMax     : Word = not Word (0); asmname 'crt_WindMax';
  261.  
  262. procedure AssignCRT (var F : Text);
  263. function  KeyPressed : Boolean;              asmname 'crt_keypressed';
  264. function  ReadKey : Char;                    asmname 'crt_readkey';
  265.  
  266. { Not effective on all platforms, see above. See also SetScreenSize
  267.   and SetMonochrome. }
  268. procedure TextMode (Mode : Integer);
  269.  
  270. procedure Window (x1, y1, x2, y2 : Integer); asmname 'crt_window';
  271. procedure GotoXY (x, y : Integer);           asmname 'crt_gotoxy';
  272. function  WhereX : Integer;                  asmname 'crt_wherex';
  273. function  WhereY : Integer;                  asmname 'crt_wherey';
  274. procedure ClrScr;                            asmname 'crt_clrscr';
  275. procedure ClrEOL;                            asmname 'crt_clreol';
  276. procedure InsLine;                           asmname 'crt_insline';
  277. procedure DelLine;                           asmname 'crt_delline';
  278. procedure TextColor (Color : TTextAttr);
  279. procedure TextBackground (Color : TTextAttr);
  280. procedure LowVideo;
  281. procedure HighVideo;
  282. procedure NormVideo;
  283. procedure Delay (MS : Word);                 asmname 'crt_delay';
  284.  
  285. { Not available on all platforms, see above }
  286. procedure Sound (Hz : Word);                 asmname 'crt_sound';
  287. procedure NoSound;                           asmname 'crt_nosound';
  288.  
  289. { =================== Extensions over BP's CRT =================== }
  290.  
  291. {
  292.   Initializes the CRT unit. Should be called before using any of
  293.   CRT's routines.
  294.  
  295.   Note: For BP compatibility, CRT is initizalized automatically when
  296.   (almost) any of its routines are used for the first time. In this
  297.   case, some defaults are set to match BP more closely. In
  298.   particular, the PC charset (see SetPCCharSet) is enabled then
  299.   (disabled otherwise), and the update level (see SetCRTUpdate) is
  300.   set to UpdateRegularly (UpdateWaitInput otherwise). This feature
  301.   is meant for BP compatibility *only*. Don't rely on it when
  302.   writing a new program. Use CRTInit then, and set the defaults to
  303.   the values you want explicitly.
  304.  
  305.   SetCRTUpdate is one of those few routines which will not cause CRT
  306.   to be initialized immediately, and a value set with it will
  307.   survive both automatic and explicit initialization, so you can use
  308.   it to set the update level without caring which way CRT will be
  309.   initialized. (This does not apply to SetPCCharSet. Since it works
  310.   on a per-panel basis, it has to initialize CRT first, so there is
  311.   a panel to start with.)
  312.  
  313.   If you terminate the program before calling CRTInit or any routine
  314.   that causes automatic initialization, curses will never be
  315.   initialized, so e.g., the screen won't be cleared. This can be
  316.   useful, e.g., to check the command line arguments (or anything
  317.   else) and if there's a problem, write an error and abort. Just be
  318.   sure to write the error to StdErr, not Output (because Output will
  319.   be assigned to CRT, and therefore writing to Output will cause CRT
  320.   to be initialized, and because errors belong to StdErr, anyway),
  321.   and to call `RestoreTerminal (True)' before (just to be sure, in
  322.   case some code -- perhaps added later, or hidden in the
  323.   initialization of some unit -- does initialize CRT).
  324. }
  325. procedure CRTInit; asmname 'crt_init';
  326.  
  327. { Changes the input and output file and the terminal description CRT
  328.   uses. Only effective with ncurses, and only if called before CRT
  329.   is initialized (automatically or explicitly; see the comments for
  330.   CRTInit). If TerminalType is nil, the default will be used. If
  331.   InputFile and/or OutputFile are null, they remain unchanged. }
  332. procedure CRTSetTerminal (TerminalType : CString; var InputFile, OutputFile : AnyFile); asmname 'crt_SetTerminal';
  333.  
  334. { If called, causes CRT to save the previous screen contents if
  335.   possible (see the comments at the beginning of the unit), and
  336.   restore them when calling RestoreTerminal (True). After
  337.   RestoreTerminal (False), they're saved again, and at the end of
  338.   the program, they're restored. Should be called before
  339.   initializing CRT (using CRTInit or automatically), otherwise the
  340.   previous screen contents may already have been overwritten. Note
  341.   that on some terminals (e.g., xterms and similar), this is the
  342.   default behaviour. Ignored under XCurses, because the program it
  343.   uses its own window, anyway. }
  344. procedure CRTSavePreviousScreen; asmname 'crt_save_previous_screen';
  345.  
  346. { Returns True if CRTSavePreviousScreen was called and is available.
  347.   Note that CRTSavePreviousScreenWorks does not work reliably until
  348.   CRT is initialized, while CRTSavePreviousScreen should be called
  349.   before CRT is initialized. That's why they are two separate
  350.   routines. }
  351. function  CRTSavePreviousScreenWorks : Boolean; asmname 'crt_save_previous_screen_works';
  352.  
  353. { If CRT is initialized automatically, not via CRTInit, and
  354.   CRTAutoInitProc is not nil, it will be called before actually
  355.   initializing CRT. }
  356. var
  357.   CRTAutoInitProc : procedure = nil; asmname 'crt_auto_init_proc';
  358.  
  359. { Aborts with a runtime error saying that CRT was not initialized.
  360.   If you set CRTAutoInitProc to this procedure, you can effectively
  361.   disable CRT's automatic initialization. }
  362. procedure CRTNotInitialized; asmname 'crt_not_initialized';
  363.  
  364. { Set terminal to shell or curses mode. An internal procedure
  365.   registered by CRT via RegisterRestoreTerminal does this as well,
  366.   so CRTSetCursesMode has to be called only in unusual situations,
  367.   e.g. after executing a process that changes terminal modes, but
  368.   does not restore them (e.g. because it crashed or was killed), and
  369.   the process was not executed with the Execute routine, and
  370.   RestoreTerminal was not called otherwise. If you set it to False
  371.   temporarily, be sure to set it back to True before doing any
  372.   further CRT operations, otherwise the result may be strange. }
  373. procedure CRTSetCursesMode (On : Boolean); asmname 'crt_set_curses_mode';
  374.  
  375. { Do the same as `RestoreTerminal (True)', but also clear the screen
  376.   after restoring the terminal (except for XCurses, because the
  377.   program uses its own window, anyway). Does not restore and save
  378.   again the previous screen contents if CRTSavePreviousScreen was
  379.   called. }
  380. procedure RestoreTerminalClearCRT; asmname 'crt_RestoreTerminalClearCRT';
  381.  
  382. { Keyboard and character graphics constants -- BP compatible! =:-}
  383. {$i crt.inc}
  384.  
  385. var
  386.   { Tells whether the XCurses version of CRT is used }
  387.   XCRT : Boolean = {$ifdef XCURSES} True {$else} False {$endif}; asmname 'crt_XCRT';
  388.  
  389.   { If True (default: False), the Beep procedure and writing #7 do a
  390.     Flash instead }
  391.   VisualBell : Boolean = False; asmname 'crt_VisualBell';
  392.  
  393. type
  394.   TKey = Word;
  395.  
  396.   TCursorShape = (CursorIgnored, CursorHidden, CursorNormal, CursorFat, CursorBlock);
  397.  
  398.   TCRTUpdate = (UpdateNever, UpdateWaitInput, UpdateInput,
  399.                 UpdateRegularly, UpdateAlways);
  400.  
  401.   TPoint = record
  402.     X, Y : Integer
  403.   end;
  404.  
  405.   PCharAttr = ^TCharAttr;
  406.   TCharAttr = record
  407.     Ch        : Char;
  408.     Attr      : TTextAttr;
  409.     PCCharSet : Boolean
  410.   end;
  411.  
  412.   PCharAttrs = ^TCharAttrs;
  413.   TCharAttrs = array [1 .. MaxVarSize div SizeOf (TCharAttr)] of TCharAttr;
  414.  
  415.   TWindowXY = packed record
  416.     {$ifdef __BYTES_BIG_ENDIAN__}
  417.     Fill : Integer (BitSizeOf (Word) - 16);
  418.     Y, X : Word (8)
  419.     {$else}
  420.     X, Y : Word (8);
  421.     Fill : Integer (BitSizeOf (Word) - 16)
  422.     {$endif}
  423.   end;
  424.  
  425. { Make sure TWindowXY really has the same size as WindMin and
  426.   WindMax. If not, compilation will abort here with `division by
  427.   zero'. Otherwise, the value of the constant will always be 1, and
  428.   is of no further interest. }
  429. const
  430.   AssertTWindowXYSize = 1 / Ord ((SizeOf (TWindowXY) = SizeOf (WindMin)) and
  431.                                  (SizeOf (TWindowXY) = SizeOf (WindMax)));
  432.  
  433. var
  434.   { Window upper and left coordinates. More comfortable to access
  435.     than WindMin, but also *obsolete*. WindMin and WindowMin still
  436.     work, but have the problem that they implicitly limit the window
  437.     size to 255x255 characters. Though that's not really small for a
  438.     text window, it's easily possible to create bigger ones (e.g. in
  439.     an xterm with a small font, on a high resolution screen and/or
  440.     extending over several virutal desktops). When using coordinates
  441.     greater than 254, the corresponding bytes in WindowMin/WindowMax
  442.     will be set to 254, so, e.g., programs which do
  443.     `Inc (WindowMin.X)' will not fail quite as badly (but probably
  444.     still fail). The routines Window and GetWindow use Integer
  445.     coordinates, and don't suffer from any of these problems, so
  446.     they should be used instead. }
  447.   WindowMin : TWindowXY absolute WindMin;
  448.  
  449.   { Window lower right coordinates. More comfortable to access than
  450.     WindMax, but also *obsolete* (see the comments for WindowMin).
  451.     Use Window and GetWindow instead. }
  452.   WindowMax : TWindowXY absolute WindMax;
  453.  
  454.   { The attribute set by NormVideo }
  455.   NormAttr : TTextAttr = 7; asmname 'crt_NormAttr';
  456.  
  457.   { Tells whether the current mode is monochrome }
  458.   IsMonochrome : Boolean = False; asmname 'crt_IsMonochrome';
  459.  
  460.   { This value can be set to a combination of the shFoo constants
  461.     and will be ORed to the actual shift state returned by
  462.     GetShiftState. This can be used to easily simulate shift keys on
  463.     systems where they can't be accessed. }
  464.   VirtualShiftState : Integer = 0; asmname 'crt_VirtualShiftState';
  465.  
  466. { Returns the size of the screen. Note: In BP's WinCRT unit,
  467.   ScreenSize is a variable. But since writing to it from a program
  468.   is pointless, anyway, providing a function here should not cause
  469.   any incompatibility. }
  470. function  ScreenSize : TPoint; asmname 'crt_GetScreenSize';
  471.  
  472. { Change the screen size if possible. }
  473. procedure SetScreenSize (x, y : Integer); asmname 'crt_SetScreenSize';
  474.  
  475. { Turns colors off or on. }
  476. procedure SetMonochrome (Monochrome : Boolean); asmname 'crt_SetMonochrome';
  477.  
  478. { Tell which modifier keys are currently pressed. The result is a
  479.   combination of the shFoo constants defined in crt.inc, or 0 on
  480.   systems where this function is not supported -- but note
  481.   VirtualShiftState. If supported, ReadKey automatically converts
  482.   kbIns and kbDel keys to kbShIns and kbShDel, resp., if shift is
  483.   pressed. }
  484. function  GetShiftState : Integer; asmname 'crt_getshiftstate';
  485.  
  486. { Get the extent of the current window. Use this procedure rather
  487.   than reading WindMin and WindMax or WindowMin and WindowMax, since
  488.   this routine allows for window sizes larger than 255. The
  489.   resulting coordinates are 1-based (like in Window, unlike WindMin,
  490.   WindMax, WindowMin and WindowMax). Any of the parameters may be
  491.   null in case you're interested in only some of the coordinates. }
  492. procedure GetWindow (var x1, y1, x2, y2 : Integer); asmname 'crt_getwindow';
  493.  
  494. {
  495.   Determine when to update the screen. The possible values are the
  496.   following. The given conditions *guarantee* updates. However,
  497.   updates may occur more frequently (even if the update level is set
  498.   to UpdateNever). About the default value, see the comments for
  499.   CRTInit.
  500.  
  501.   UpdateNever     : never (unless explicitly requested with
  502.                     CRTUpdate)
  503.   UpdateWaitInput : before Delay and CRT input, unless typeahead is
  504.                     detected
  505.   UpdateInput     : before Delay and CRT input
  506.   UpdateRegularly : before Delay and CRT input and otherwise in
  507.                     regular intervals without causing too much
  508.                     refresh. This uses a timer on some systems
  509.                     (currently, Unix with ncurses). This was created
  510.                     for BP compatibility, but for many applications,
  511.                     a lower value causes less flickering in the
  512.                     output, and additionally, timer signals won't
  513.                     disturb other operations. Under DJGPP, this
  514.                     always updates immediately, but this fact should
  515.                     not mislead DJGPP users into thinking this is
  516.                     always so.
  517.   UpdateAlways    : after each output. This can be very slow. (Not
  518.                     so under DJGPP, but this fact should not mislead
  519.                     DJGPP users...)
  520. }
  521. procedure SetCRTUpdate (UpdateLevel : TCRTUpdate); asmname 'crt_setupdatelevel';
  522.  
  523. { Do an update now, independently of the update level }
  524. procedure CRTUpdate; asmname 'crt_update_immediately';
  525.  
  526. { Do an update now and completely redraw the screen }
  527. procedure CRTRedraw; asmname 'crt_redraw';
  528.  
  529. { Return Ord (key) for normal keys and $100 * Ord (fkey) for function keys }
  530. function  ReadKeyWord : TKey; asmname 'crt_readkeyword';
  531.  
  532. { Extract the character and scan code from a TKey value }
  533. function  Key2Char (k : TKey) : Char;
  534. function  Key2Scan (k : TKey) : Char;
  535.  
  536. { Convert a key to upper/lower case if it is a letter, leave it
  537.   unchanged otherwise }
  538. function  UpCaseKey (k : TKey) : TKey;
  539. function  LoCaseKey (k : TKey) : TKey;
  540.  
  541. { Return key codes for the combination of the given key with Ctrl,
  542.   Alt, AltGr or Extra, resp. Returns 0 if the combination is
  543.   unknown. }
  544. function  CtrlKey  (ch : Char) : TKey; asmname 'crt_ctrlkey';
  545. function  AltKey   (ch : Char) : TKey; asmname 'crt_altkey';
  546. function  AltGrKey (ch : Char) : TKey; asmname 'crt_altgrkey';
  547. function  ExtraKey (ch : Char) : TKey; asmname 'crt_extrakey';
  548.  
  549. { Check if k is a pseudo key generated by a deadly signal trapped }
  550. function  IsDeadlySignal (k : TKey) : Boolean;
  551.  
  552. { Produce a beep or a screen flash }
  553. procedure Beep;  asmname 'crt_beep';
  554. procedure Flash; asmname 'crt_flash';
  555.  
  556. { Get size of current window (calculated using GetWindow) }
  557. function  GetXMax : Integer;
  558. function  GetYMax : Integer;
  559.  
  560. { Get/goto an absolute position }
  561. function  WhereXAbs : Integer;
  562. function  WhereYAbs : Integer;
  563. procedure GotoXYAbs (X, Y : Integer);
  564.  
  565. { Turn scrolling on or off }
  566. procedure SetScroll (State : Boolean); asmname 'crt_setscroll';
  567.  
  568. { Read back whether scrolling is enabled }
  569. function  GetScroll : Boolean; asmname 'crt_getscroll';
  570.  
  571. { Determine whether to interpret non-ASCII characters as PC ROM
  572.   characters (True), or in a system dependent way (False). About the
  573.   default, see the comments for CRTInit. }
  574. procedure SetPCCharSet (PCCharSet : Boolean); asmname 'crt_setpccharset';
  575.  
  576. { Read back the value set by SetPCCharSet }
  577. function  GetPCCharSet : Boolean; asmname 'crt_getpccharset';
  578.  
  579. { Determine whether to interpret #7, #8, #10, #13 as control
  580.   characters (True, default), or as graphics characters (False) }
  581. procedure SetControlChars (UseControlChars : Boolean); asmname 'crt_setcontrolchars';
  582.  
  583. { Read back the value set by SetControlChars }
  584. function  GetControlChars : Boolean; asmname 'crt_getcontrolchars';
  585.  
  586. procedure SetCursorShape (Shape : TCursorShape); asmname 'crt_setcursorshape';
  587. function  GetCursorShape : TCursorShape; asmname 'crt_getcursorshape';
  588.  
  589. procedure HideCursor;
  590. procedure HiddenCursor;
  591. procedure NormalCursor;
  592. procedure FatCursor;
  593. procedure BlockCursor;
  594. procedure IgnoreCursor;
  595.  
  596. { Simulates a block cursor by writing a block character onto the
  597.   cursor position. The procedure automatically finds the topmost
  598.   visible panel whose shape is not CursorIgnored and places the
  599.   simulated cursor there (just like the hardware cursor), with
  600.   matching attributes, if the cursor shape is CursorFat or
  601.   CursorBlock (otherwise, no simulated cursor is shown).
  602.  
  603.   Calling this procedure again makes the simulated cursor disappear.
  604.   In particular, to get the effect of a blinking cursor, you have to
  605.   call the procedure repeatedly (say, 8 times a second). CRT will
  606.   not do this for you, since it does not intend to be your main
  607.   event loop. }
  608. procedure SimulateBlockCursor; asmname 'crt_SimulateBlockCursor';
  609.  
  610. { Makes the cursor simulated by SimulateBlockCursor disappear if it
  611.   is active. Does nothing otherwise. You should call this procedure
  612.   after using SimulateBlockCursor before doing any further CRT
  613.   output (though failing to do so should not hurt except for
  614.   possibly leaving the simulated cursor in its old position longer
  615.   than it should). }
  616. procedure SimulateBlockCursorOff; asmname 'crt_SimulateBlockCursorOff';
  617.  
  618. function  GetTextColor : Integer;
  619. function  GetTextBackground : Integer;
  620.  
  621. { Write string at the given position without moving the cursor.
  622.   Truncated at the right margin. }
  623. procedure WriteStrAt (x, y : Integer; s : String; Attr : TTextAttr);
  624.  
  625. { Write (several copies of) a char at then given position without
  626.   moving the cursor. Truncated at the right margin. }
  627. procedure WriteCharAt (x, y, Count : Integer; Ch : Char; Attr : TTextAttr);
  628.  
  629. { Write characters with specified attributes at the given position
  630.   without moving the cursor. Truncated at the right margin. }
  631. procedure WriteCharAttrAt (x, y, Count : Integer; CharAttr : PCharAttrs); asmname 'crt_writecharattrat';
  632.  
  633. { Write a char while moving the cursor }
  634. procedure WriteChar (Ch : Char);
  635.  
  636. { Read a character from a screen position }
  637. procedure ReadChar (x, y : Integer; var Ch : Char; var Attr : TTextAttr); asmname 'crt_readchar';
  638.  
  639. { Change only text attributes, leave characters. Truncated at the
  640.   right margin. }
  641. procedure ChangeTextAttr (x, y, Count : Integer; NewAttr : TTextAttr);
  642.  
  643. { Fill current window }
  644. procedure FillWin (Ch : Char; Attr : TTextAttr); asmname 'crt_fillwin';
  645.  
  646. { Calculate size of memory required for ReadWin in current window. }
  647. function  WinSize : SizeType; asmname 'crt_winsize';
  648.  
  649. { Save window contents. Buf must be WinSize bytes large. }
  650. procedure ReadWin (var Buf); asmname 'crt_readwin';
  651.  
  652. { Restore window contents saved by ReadWin. The size of the current
  653.   window must match the size of the window from which ReadWin was
  654.   used, but the position may be different. }
  655. procedure WriteWin (const Buf); asmname 'crt_writewin';
  656.  
  657. type
  658.   WinState = record
  659.     x1, y1, x2, y2, WhereX, WhereY, NewX1, NewY1, NewX2, NewY2 : Integer;
  660.     TextAttr : TTextAttr;
  661.     CursorShape : TCursorShape;
  662.     ScreenSize : TPoint;
  663.     Buffer : ^Byte
  664.   end;
  665.  
  666. { Save window position and size, cursor position, text attribute and
  667.   cursor shape -- *not* the window contents. }
  668. procedure SaveWin (var State : WinState);
  669.  
  670. { Make a new window (like Window), and save the contents of the
  671.   screen below the window as well as the position and size, cursor
  672.   position, text attribute and cursor shape of the old window. }
  673. procedure MakeWin (var State : WinState; x1, y1, x2, y2 : Integer);
  674.  
  675. { Create window in full size, save previous text mode and all values
  676.   that MakeWin does. }
  677. procedure SaveScreen (var State : WinState);
  678.  
  679. { Restore the data saved by SaveWin, MakeWin or SaveScreen. }
  680. procedure RestoreWin (var State : WinState);
  681.  
  682. { Panels }
  683.  
  684. type
  685.   TPanel = Pointer;
  686.  
  687. function  GetActivePanel : TPanel;                                                         asmname 'crt_GetActivePanel';
  688. procedure PanelNew                 (x1, y1, x2, y2 : Integer; BindToBackground : Boolean); asmname 'crt_PanelNew';
  689. procedure PanelDelete              (Panel : TPanel);                                       asmname 'crt_PanelDelete';
  690. procedure PanelBindToBackground    (Panel : TPanel; Bind : Boolean);                       asmname 'crt_PanelBindToBackground';
  691. function  PanelIsBoundToBackground (Panel : TPanel) : Boolean;                             asmname 'crt_PanelIsBoundToBackground';
  692. procedure PanelActivate            (Panel : TPanel);                                       asmname 'crt_PanelActivate';
  693. procedure PanelHide                (Panel : TPanel);                                       asmname 'crt_PanelHide';
  694. procedure PanelShow                (Panel : TPanel);                                       asmname 'crt_PanelShow';
  695. function  PanelHidden              (Panel : TPanel) : Boolean;                             asmname 'crt_PanelHidden';
  696. procedure PanelTop                 (Panel : TPanel);                                       asmname 'crt_PanelTop';
  697. procedure PanelBottom              (Panel : TPanel);                                       asmname 'crt_PanelBottom';
  698. procedure PanelMoveAbove           (Panel, Above : TPanel);                                asmname 'crt_PanelMoveAbove';
  699. procedure PanelMoveBelow           (Panel, Below : TPanel);                                asmname 'crt_PanelMoveBelow';
  700. function  PanelAbove               (Panel : TPanel) : TPanel;                              asmname 'crt_PanelAbove';
  701. function  PanelBelow               (Panel : TPanel) : TPanel;                              asmname 'crt_PanelBelow';
  702.  
  703. { TPCRT compatibility }
  704.  
  705. { Write a string at the given position without moving the cursor.
  706.   Truncated at the right margin. }
  707. procedure WriteString (const s : String; y, x : Integer);
  708.  
  709. { Write a string at the given position with the given attribute
  710.   without moving the cursor. Truncated at the right margin. }
  711. procedure FastWriteWindow (const s : String; y, x : Integer; Attr : TTextAttr);
  712.  
  713. { Write a string at the given absolute position with the given
  714.   attribute without moving the cursor. Truncated at the right
  715.   margin. }
  716. procedure FastWrite       (const s : String; y, x : Integer; Attr : TTextAttr);
  717.  
  718. { WinCrt compatibility }
  719.  
  720. const
  721.   cw_UseDefault = Integer ($8000);
  722.  
  723. var
  724.   WindowOrg  : TPoint = (cw_UseDefault, cw_UseDefault); { Ignored }
  725.   WindowSize : TPoint = (cw_UseDefault, cw_UseDefault); { Ignored }
  726.   Cursor     : TPoint = (0, 0); { Cursor location, 0-based } asmname 'crt_cursor_pos';
  727.   Origin     : TPoint = (0, 0); { Ignored }
  728.   InactiveTitle : PChar = '(Inactive %s)'; { Ignored }
  729.   AutoTracking : Boolean = True; { Ignored }
  730.   WindowTitle : {$ifdef __BP_TYPE_SIZES__}
  731.                 array [0 .. 79] of Char
  732.                 {$else}
  733.                 TStringBuf
  734.                 {$endif}; { CRT window title, ignored }
  735.  
  736. procedure InitWinCrt; asmname 'crt_initwincrt';
  737.  
  738. { Halts the program }
  739. procedure DoneWinCrt; attribute (noreturn); asmname 'crt_donewincrt';
  740.  
  741. procedure WriteBuf (Buffer : PChar; Count : SizeType); asmname 'crt_writebuf';
  742.  
  743. function  ReadBuf (Buffer : PChar; Count : SizeType) : SizeType; asmname 'crt_readbuf';
  744.  
  745. { 0-based coordinates! }
  746. procedure CursorTo (x, y : Integer); asmname 'crt_cursorto';
  747.  
  748. { Dummy }
  749. procedure ScrollTo (x, y : Integer); asmname 'crt_scrollto';
  750.  
  751. { Dummy }
  752. procedure TrackCursor; asmname 'crt_trackcursor';
  753.  
  754. implementation
  755.  
  756. {$ifdef X11}
  757.   {$L crtx.c, XPanel, XCurses, Xaw, Xmu, Xt, X11}
  758.   {$ifndef NOX11R6} {$L SM, ICE, Xext} {$endif}
  759.   { XCurses under Solaris needs additional libraries. When linking
  760.     dynamically, they are automatically referenced by the other libraries.
  761.     For static linking, however, we have to name them explicitly. }
  762.   {$ifdef __sun__} {$L socket, w, nsl, intl, dl} {$endif}
  763. {$elif defined (USE_PDCURSES)}
  764.   {$L crtc.c, panel, curso}
  765. {$else}
  766.   {$L crtc.c, panel, ncurses}
  767. {$endif}
  768.  
  769. procedure CRT_Done; asmname 'crt_done';
  770. procedure CRT_UnGetCh (k : TKey); asmname 'crt_ungetch';
  771. function  CRT_Read  (var PrivateData; var   Buffer; Size : SizeType) : SizeType; asmname 'crt_read';
  772. function  CRT_Write (var PrivateData; const Buffer; Size : SizeType) : SizeType; asmname 'crt_write';
  773. function  CRT_Get_Input_FD : Integer; asmname 'crt_get_input_fd';
  774. function  CRT_Get_Output_FD : Integer; asmname 'crt_get_output_fd';
  775. procedure CRT_Select (var PrivateData; var ReadSelect, WriteSelect, ExceptSelect : Boolean); asmname 'crt_select';
  776. procedure CRT_Restore_Terminal_No_CRT; asmname 'crt_restore_terminal_no_crt';
  777. procedure CRT_Restore_Terminal_CRT; asmname 'crt_restore_terminal_crt';
  778. procedure CRT_Check_WinChanged; asmname 'crt_check_winchanged';
  779.  
  780. {$define DO_CRT_CHECK_WINCHANGED
  781.   begin
  782.     SetReturnAddress (ReturnAddress (0));
  783.     CRT_Check_WinChanged;
  784.     RestoreReturnAddress
  785.   end
  786. }
  787.  
  788. const
  789.   MonoModes = [BW40, BW80, Mono];
  790.  
  791. var
  792.   TerminalNoCRT : Boolean = False;          asmname 'crt_terminal_no_crt';
  793.   CRTClearFlag  : Boolean = False;          asmname 'crt_clearflag';
  794.   Signaled      : volatile Boolean = False; asmname 'crt_Signaled';
  795.   CRTScreenSize : TPoint = (- 1, - 1);      asmname 'crt_ScreenSize';
  796.   CRTTerminal   : CString = nil;            asmname 'crt_term';
  797.   CRTInputFD    : Integer = - 1;            asmname 'crt_input_fd';
  798.   CRTOutputFD   : Integer = - 1;            asmname 'crt_output_fd';
  799.  
  800. procedure CRTSetTerminal (TerminalType : CString; var InputFile, OutputFile : AnyFile);
  801. begin
  802.   CRTTerminal := TerminalType;
  803.   if @InputFile <> nil then CRTInputFD := FileHandle (InputFile);
  804.   if @OutputFile <> nil then CRTOutputFD := FileHandle (OutputFile)
  805. end;
  806.  
  807. procedure TextColor (Color: TTextAttr);
  808. begin
  809.   if Color and $f0 <> 0 then Color := (Color and $f) or Blink;
  810.   TextAttr := (TextAttr and $70) or Color
  811. end;
  812.  
  813. procedure TextBackground (Color : TTextAttr);
  814. begin
  815.   TextAttr := (TextAttr and $8f) or ((Color and 7) shl 4)
  816. end;
  817.  
  818. function GetTextColor : Integer;
  819. begin
  820.   GetTextColor := TextAttr and $8f
  821. end;
  822.  
  823. function GetTextBackground : Integer;
  824. begin
  825.   GetTextBackground := (TextAttr and $70) shr 4
  826. end;
  827.  
  828. procedure LowVideo;
  829. begin
  830.   TextAttr := TextAttr and not 8
  831. end;
  832.  
  833. procedure HighVideo;
  834. begin
  835.   TextAttr := TextAttr or 8
  836. end;
  837.  
  838. procedure NormVideo;
  839. begin
  840.   TextAttr := NormAttr
  841. end;
  842.  
  843. procedure TextMode (Mode : Integer);
  844. var x, y : Integer;
  845. begin
  846.   DO_CRT_CHECK_WINCHANGED;
  847.   if (Mode and not Font8x8) in [BW40, CO40] then x := 40 else x := 80;
  848.   if Mode and Font8x8 <> 0 then y := 50 else y := 25;
  849.   SetMonochrome ((Mode and $ff) in MonoModes);
  850.   SetScreenSize (x, y);
  851.   NormVideo;
  852.   Window (1, 1, CRTScreenSize.X, CRTScreenSize.Y);
  853.   ClrScr
  854. end;
  855.  
  856. function ScreenSize : TPoint;
  857. begin
  858.   DO_CRT_CHECK_WINCHANGED;
  859.   ScreenSize := CRTScreenSize
  860. end;
  861.  
  862. function CRT_SelectFunc (var PrivateData; Writing : Boolean) : Integer;
  863. var Dummy : Pointer;
  864. begin
  865.   DO_CRT_CHECK_WINCHANGED;
  866.   Dummy := @PrivateData;
  867.   if Writing
  868.     then CRT_SelectFunc := CRT_Get_Output_FD
  869.     else CRT_SelectFunc := CRT_Get_Input_FD
  870. end;
  871.  
  872. procedure AssignCRT (var F : Text);
  873. begin
  874.   AssignTFDD (F, nil, CRT_SelectFunc, CRT_Select, CRT_Read, CRT_Write, nil, nil, nil, nil)
  875. end;
  876.  
  877. procedure WriteStrAt (x, y : Integer; s : String; Attr : TTextAttr);
  878. var OrigAttr : TTextAttr;
  879. begin
  880.   DO_CRT_CHECK_WINCHANGED;
  881.   OrigAttr := TextAttr;
  882.   TextAttr := Attr;
  883.   WriteString (s, y, x);
  884.   TextAttr := OrigAttr
  885. end;
  886.  
  887. procedure WriteCharAt (x, y, Count : Integer; Ch : Char; Attr : TTextAttr);
  888. var
  889.   OrigAttr : TTextAttr;
  890.   Temp : array [1 .. Count] of Char;
  891.   i : Integer;
  892. begin
  893.   DO_CRT_CHECK_WINCHANGED;
  894.   for i := 1 to Count do Temp [i] := Ch;
  895.   OrigAttr := TextAttr;
  896.   TextAttr := Attr;
  897.   WriteString (Temp, y, x);
  898.   TextAttr := OrigAttr
  899. end;
  900.  
  901. procedure WriteChar (Ch : Char);
  902. var Dummy : Integer;
  903. begin
  904.   DO_CRT_CHECK_WINCHANGED;
  905.   Dummy := CRT_Write (Dummy, Ch, 1)
  906. end;
  907.  
  908. procedure WriteString (const s : String; y, x : Integer);
  909. var
  910.   OrigX, OrigY, Dummy, Size : Integer;
  911.   UseControlCharsSave, ScrollSave : Boolean;
  912. begin
  913.   DO_CRT_CHECK_WINCHANGED;
  914.   OrigX := WhereX;
  915.   OrigY := WhereY;
  916.   GotoXY (x, y);
  917.   UseControlCharsSave := GetControlChars;
  918.   SetControlChars (False);
  919.   ScrollSave := GetScroll;
  920.   SetScroll (False);
  921.   Size := Min (Length (s), GetXMax - x + 1);
  922.   if Size > 0 then Dummy := CRT_Write (Dummy, s [1], Size);
  923.   SetScroll (ScrollSave);
  924.   SetControlChars (UseControlCharsSave);
  925.   GotoXY (OrigX, OrigY)
  926. end;
  927.  
  928. procedure FastWriteWindow (const s : String; y, x : Integer; Attr : TTextAttr);
  929. begin
  930.   DO_CRT_CHECK_WINCHANGED;
  931.   WriteStrAt (x, y, s, Attr)
  932. end;
  933.  
  934. procedure FastWrite (const s : String; y, x : Integer; Attr : TTextAttr);
  935. var x1, y1 : Integer;
  936. begin
  937.   DO_CRT_CHECK_WINCHANGED;
  938.   GetWindow (x1, y1, null, null);
  939.   WriteStrAt (x - x1 + 1, y - y1 + 1, s, Attr)
  940. end;
  941.  
  942. procedure ChangeTextAttr (x, y, Count : Integer; NewAttr : TTextAttr);
  943. var
  944.   OrigX, OrigY, i : Integer;
  945.   Ch : Char;
  946.   OrigAttr, Attr : TTextAttr;
  947.   ScrollSave : Boolean;
  948. begin
  949.   DO_CRT_CHECK_WINCHANGED;
  950.   OrigAttr := TextAttr;
  951.   OrigX := WhereX;
  952.   OrigY := WhereY;
  953.   GotoXY (x, y);
  954.   ScrollSave := GetScroll;
  955.   SetScroll (False);
  956.   for i := 1 to Min (Count, GetXMax - x + 1) do
  957.     begin
  958.       ReadChar (x + i - 1, y, Ch, Attr);
  959.       TextAttr := NewAttr;
  960.       WriteChar (Ch)
  961.     end;
  962.   SetScroll (ScrollSave);
  963.   GotoXY (OrigX, OrigY);
  964.   TextAttr := OrigAttr
  965. end;
  966.  
  967. function Key2Char (k : TKey) : Char;
  968. begin
  969.   if k div $100 <> 0
  970.     then Key2Char := #0
  971.     else Key2Char := Chr (k)
  972. end;
  973.  
  974. function Key2Scan (k : TKey) : Char;
  975. begin
  976.   Key2Scan := Chr (k div $100)
  977. end;
  978.  
  979. function UpCaseKey (k : TKey) : TKey;
  980. var ch : Char;
  981. begin
  982.   ch := Key2Char (k);
  983.   if ch = #0
  984.     then UpCaseKey := k
  985.     else UpCaseKey := Ord (UpCase (ch))
  986. end;
  987.  
  988. function LoCaseKey (k : TKey) : TKey;
  989. var ch : Char;
  990. begin
  991.   ch := Key2Char (k);
  992.   if ch = #0
  993.     then LoCaseKey := k
  994.     else LoCaseKey := Ord (LoCase (ch))
  995. end;
  996.  
  997. function CtrlKey (ch : Char) : TKey;
  998. begin
  999.   case ch of
  1000.     'A' .. 'Z' : CtrlKey := Ord (Pred (ch, Ord ('A') - chCtrlA));
  1001.     'a' .. 'z' : CtrlKey := Ord (Pred (ch, Ord ('a') - chCtrlA));
  1002.     else         CtrlKey := 0
  1003.   end
  1004. end;
  1005.  
  1006. function IsDeadlySignal (k : TKey) : Boolean;
  1007. begin
  1008.   IsDeadlySignal := (k = kbInt) or (k = kbTerm) or (k = kbHUp)
  1009. end;
  1010.  
  1011. function GetXMax : Integer;
  1012. var x1, x2 : Integer;
  1013. begin
  1014.   DO_CRT_CHECK_WINCHANGED;
  1015.   GetWindow (x1, null, x2, null);
  1016.   GetXMax := x2 - x1 + 1
  1017. end;
  1018.  
  1019. function GetYMax : Integer;
  1020. var y1, y2 : Integer;
  1021. begin
  1022.   DO_CRT_CHECK_WINCHANGED;
  1023.   GetWindow (null, y1, null, y2);
  1024.   GetYMax := y2 - y1 + 1
  1025. end;
  1026.  
  1027. function WhereXAbs : Integer;
  1028. var x1 : Integer;
  1029. begin
  1030.   DO_CRT_CHECK_WINCHANGED;
  1031.   GetWindow (x1, null, null, null);
  1032.   WhereXAbs := WhereX + x1 - 1
  1033. end;
  1034.  
  1035. function WhereYAbs : Integer;
  1036. var y1 : Integer;
  1037. begin
  1038.   DO_CRT_CHECK_WINCHANGED;
  1039.   GetWindow (null, y1, null, null);
  1040.   WhereYAbs := WhereY + y1 - 1
  1041. end;
  1042.  
  1043. procedure GotoXYAbs (X, Y : Integer);
  1044. var x1, y1 : Integer;
  1045. begin
  1046.   DO_CRT_CHECK_WINCHANGED;
  1047.   GetWindow (x1, y1, null, null);
  1048.   GotoXY (X - x1 + 1, Y - y1 + 1)
  1049. end;
  1050.  
  1051. procedure HideCursor;
  1052. begin
  1053.   DO_CRT_CHECK_WINCHANGED;
  1054.   SetCursorShape (CursorHidden)
  1055. end;
  1056.  
  1057. procedure HiddenCursor;
  1058. begin
  1059.   DO_CRT_CHECK_WINCHANGED;
  1060.   SetCursorShape (CursorHidden)
  1061. end;
  1062.  
  1063. procedure NormalCursor;
  1064. begin
  1065.   DO_CRT_CHECK_WINCHANGED;
  1066.   SetCursorShape (CursorNormal)
  1067. end;
  1068.  
  1069. procedure FatCursor;
  1070. begin
  1071.   DO_CRT_CHECK_WINCHANGED;
  1072.   SetCursorShape (CursorFat)
  1073. end;
  1074.  
  1075. procedure BlockCursor;
  1076. begin
  1077.   DO_CRT_CHECK_WINCHANGED;
  1078.   SetCursorShape (CursorBlock)
  1079. end;
  1080.  
  1081. procedure IgnoreCursor;
  1082. begin
  1083.   DO_CRT_CHECK_WINCHANGED;
  1084.   SetCursorShape (CursorIgnored)
  1085. end;
  1086.  
  1087. procedure SaveWin (var State : WinState);
  1088. begin
  1089.   DO_CRT_CHECK_WINCHANGED;
  1090.   with State do
  1091.     begin
  1092.       GetWindow (x1, y1, x2, y2);
  1093.       NewX1 := x1;
  1094.       NewY1 := y1;
  1095.       NewX2 := x2;
  1096.       NewY2 := y2
  1097.     end;
  1098.   State.WhereX       := WhereX;
  1099.   State.WhereY       := WhereY;
  1100.   State.TextAttr     := TextAttr;
  1101.   State.CursorShape  := GetCursorShape;
  1102.   State.ScreenSize.X := -1;
  1103.   State.ScreenSize.Y := -1;
  1104.   State.Buffer       := nil
  1105. end;
  1106.  
  1107. procedure MakeWin (var State : WinState; x1, y1, x2, y2 : Integer);
  1108. begin
  1109.   DO_CRT_CHECK_WINCHANGED;
  1110.   SaveWin (State);
  1111.   Window (x1, y1, x2, y2);
  1112.   with State do GetWindow (NewX1, NewY1, NewX2, NewY2);
  1113.   GetMem (State.Buffer, WinSize);
  1114.   ReadWin (State.Buffer^)
  1115. end;
  1116.  
  1117. procedure SaveScreen (var State : WinState);
  1118. begin
  1119.   DO_CRT_CHECK_WINCHANGED;
  1120.   MakeWin (State, 1, 1, CRTScreenSize.X, CRTScreenSize.Y);
  1121.   State.ScreenSize  := CRTScreenSize
  1122. end;
  1123.  
  1124. procedure RestoreWin (var State : WinState);
  1125. begin
  1126.   DO_CRT_CHECK_WINCHANGED;
  1127.   if (State.ScreenSize.X <> - 1) and (State.ScreenSize.Y <> - 1) then
  1128.     begin
  1129.       if (State.ScreenSize.X <> CRTScreenSize.X) or (State.ScreenSize.Y <> CRTScreenSize.Y) then
  1130.         SetScreenSize (State.ScreenSize.X, State.ScreenSize.Y);
  1131.       Window (1, 1, CRTScreenSize.X, CRTScreenSize.Y)
  1132.     end;
  1133.   SetCursorShape (State.CursorShape);
  1134.   if State.Buffer <> nil then
  1135.     begin
  1136.       with State do Window (NewX1, NewY1, NewX2, NewY2);
  1137.       WriteWin (State.Buffer^);
  1138.       FreeMem (State.Buffer);
  1139.       State.Buffer := nil
  1140.     end;
  1141.   with State do Window (x1, y1, x2, y2);
  1142.   GotoXY (State.WhereX, State.WhereY);
  1143.   TextAttr := State.TextAttr
  1144. end;
  1145.  
  1146. procedure InitWinCrt;
  1147. begin
  1148.   DO_CRT_CHECK_WINCHANGED
  1149. end;
  1150.  
  1151. procedure DoneWinCrt;
  1152. begin
  1153.   Halt
  1154. end;
  1155.  
  1156. procedure WriteBuf (Buffer : PChar; Count : SizeType);
  1157. var Dummy : Integer;
  1158. begin
  1159.   DO_CRT_CHECK_WINCHANGED;
  1160.   if Count > 0 then Dummy := CRT_Write (Dummy, Buffer^, Count)
  1161. end;
  1162.  
  1163. function ReadBuf (Buffer : PChar; Count : SizeType) : SizeType;
  1164. var Dummy : Integer;
  1165. begin
  1166.   DO_CRT_CHECK_WINCHANGED;
  1167.   ReadBuf := CRT_Read (Dummy, Buffer^, Count)
  1168. end;
  1169.  
  1170. procedure CursorTo (x, y : Integer);
  1171. begin
  1172.   DO_CRT_CHECK_WINCHANGED;
  1173.   GotoXY (x + 1, y + 1)
  1174. end;
  1175.  
  1176. procedure ScrollTo (x, y : Integer);
  1177. begin
  1178. end;
  1179.  
  1180. procedure TrackCursor;
  1181. begin
  1182. end;
  1183.  
  1184. procedure RestoreTerminalClearCRT;
  1185. begin
  1186.   CRTClearFlag := True;
  1187.   RestoreTerminal (True);
  1188.   CRTClearFlag := False
  1189. end;
  1190.  
  1191. procedure CRT_RegisterRestoreTerminal; asmname 'crt_registerrestoreterminal';
  1192. procedure CRT_RegisterRestoreTerminal;
  1193. begin
  1194.   RegisterRestoreTerminal (True,  CRT_Restore_Terminal_No_CRT);
  1195.   RegisterRestoreTerminal (False, CRT_Restore_Terminal_CRT)
  1196. end;
  1197.  
  1198. function CRT_GetProgramName : CString; asmname 'crt_get_program_name';
  1199. function CRT_GetProgramName : CString;
  1200. begin
  1201.   CRT_GetProgramName := CParameters^[0]
  1202. end;
  1203.  
  1204. function CRT_GetCEnvironment : PCStrings; asmname 'crt_get_c_environment';
  1205. function CRT_GetCEnvironment : PCStrings;
  1206. begin
  1207.   CRT_GetCEnvironment := GetCEnvironment
  1208. end;
  1209.  
  1210. {$ifdef USE_NCURSES}
  1211. procedure CRT_DoTextModeCommand (Columns, Lines : Integer); asmname 'crt_dotextmodecommand';
  1212. procedure CRT_DoTextModeCommand (Columns, Lines : Integer);
  1213. var
  1214.   CommandLine : CString;
  1215.   Buffer : TString;
  1216.   Blocked : Boolean;
  1217.   Dummy : Integer;
  1218. begin
  1219.   CommandLine := CStringGetEnv ('RESIZETERM');
  1220.   if CommandLine = nil then
  1221.     CommandLine := 'PATH="$PATH:/usr/local/sbin:/usr/sbin"; { if [ x"$DISPLAY" != x ]; then resize -s "$lines" "$columns" < /dev/null; else SVGATextMode "$columns"x"$lines" || if [ "$lines" -gt 25 ]; then setfont cp850-8x8 -u cp437; else setfont cp850-8x16 -u cp437; fi; fi; } > /dev/null 2>&1';
  1222.   WriteStr (Buffer, 'columns=', Columns, '; lines=', Lines, '; ', CString2String (CommandLine));
  1223.   Blocked := SignalBlocked (SigWinCh);
  1224.   BlockSignal (SigWinCh, True);
  1225.   Signaled := False;
  1226.   Dummy := ExecuteNoTerminal (Buffer);
  1227.   if not Blocked then BlockSignal (SigWinCh, False)
  1228. end;
  1229. {$endif}
  1230.  
  1231. procedure CRTNotInitialized;
  1232. begin
  1233.   SetReturnAddress (ReturnAddress (0));
  1234.   RuntimeError (880); { CRT was not initialized }
  1235.   RestoreReturnAddress
  1236. end;
  1237.  
  1238. procedure Signal_Handler (Signal : TKey); asmname 'crt_signal_handler';
  1239. procedure Signal_Handler (Signal : TKey);
  1240. begin
  1241.   if TerminalNoCRT and (Signal = kbInt) then Exit;
  1242.   Signaled := True;
  1243.   if CheckBreak then
  1244.     begin
  1245.       if Signal = kbInt then Write ('^C');
  1246.       Halt (255)
  1247.     end
  1248.   else
  1249.     CRT_UnGetCh (Signal)
  1250. end;
  1251.  
  1252. procedure CRT_Fatal (Reason : Integer); attribute (noreturn); asmname 'crt_fatal';
  1253. procedure CRT_Fatal;
  1254. begin
  1255.   case Reason of
  1256.     1 :  InternalError (950); { CRT: cannot initialize curses }
  1257.     2 :  RuntimeError  (881); { CRT: error opening terminal }
  1258.     3 :  RuntimeError  (882); { attempt to delete invalid CRT panel }
  1259.     4 :  RuntimeError  (883); { attempt to delete last CRT panel }
  1260.     5 :  RuntimeError  (884); { attempt to activate invalid CRT panel }
  1261.     else InternalError (951)  { cannot create CRT window }
  1262.   end
  1263. end;
  1264.  
  1265. to begin do
  1266.   begin
  1267.     AssignCRT (Input);
  1268.     Reset (Input);
  1269.     AssignCRT (Output);
  1270.     Rewrite (Output)
  1271.   end;
  1272.  
  1273. to end do
  1274.   begin
  1275.     Close (Input);
  1276.     Reset (Input, '-');
  1277.     Close (Output);
  1278.     Rewrite (Output, '-');
  1279.     CRT_Done
  1280.   end;
  1281.  
  1282. end.
  1283.