Programmer's ROM - The Computer Language Library/programmersrom.iso/ada/virterm/curses.src

Text File | 1988-05-03 | 24.2 KB | 748 lines

::::::::::
curses.a
::::::::::
-------- SIMTEL20 Ada Software Repository Prologue ------------
--                                                           -*
-- Unit name    : curses interface package specification
-- Version      : 1.0
-- Author       : Steve Rosen
--              : Siemens Research
--              :
--              :
-- DDN Address  : vrdxhq!siemens!gypsy!rosen@seismo
-- Copyright    : (c)
-- Date created :  6 August 1985
-- Release date :  6 August 1985
-- Last update  :  6 August 1985
-- Machine/System Compiled/Run on : VADS VAX/UNIX 4.06
--                                                           -*
---------------------------------------------------------------
--                                                           -*
-- Keywords     :  display, terminal update, screen
----------------:
--
-- Abstract     :  This package provides an interface to the UNIX
----------------:  curses package through Ada.
--                                                           -*
------------------ Revision history ---------------------------
--                                                           -*
-- DATE         VERSION    AUTHOR                  HISTORY
-- ???        0.0    Steve Rosen        Initial Release
-- 8/6/85    1.0    Karl A. Nyberg        Release to SIMTEL
--                                                           -*
------------------ Distribution and Copyright -----------------
--                                                           -*
-- This prologue must be included in all copies of this software.
--
-- This software is copyright by the author.
--
-- This software is released to the Ada community.
-- This software is released to the Public Domain (note:
--   software released to the Public Domain is not subject
--   to copyright protection).
-- Restrictions on use or distribution:  NONE
--                                                           -*
------------------ Disclaimer ---------------------------------
--                                                           -*
-- This software and its documentation are provided "AS IS" and
-- without any expressed or implied warranties whatsoever.
-- No warranties as to performance, merchantability, or fitness
-- for a particular purpose exist.
--
-- Because of the diversity of conditions and hardware under
-- which this software may be used, no warranty of fitness for
-- a particular purpose is offered.  The user is advised to
-- test the software thoroughly before relying on it.  The user
-- must assume the entire risk and liability of using this
-- software.
--
-- In no event shall any person or organization of people be
-- held responsible for any direct, indirect, consequential
-- or inconsequential damages or lost profits.
--                                                           -*
-------------------END-PROLOGUE--------------------------------

with SYSTEM;
with U_ENV;       -- This package requires the elaboration of U_ENV

package CURSES is

  UNDEFINED_WINDOW_ERROR: exception;

  type WINDOW is new SYSTEM.ADDRESS;
  STDSCR: WINDOW;

  LINES:    constant POSITIVE := 23;
  COLUMNS:  constant POSITIVE := 80;

  function INITSCR return WINDOW;
  procedure DELWIN (WIN: WINDOW);
  procedure ENDWIN;

  function NEWWIN (LINES, COLS, BEGIN_Y, BEGIN_X: INTEGER) return WINDOW;
  function SUBWIN (WIN: WINDOW;
           LINES, COLS, BEGIN_X, BEGIN_Y: INTEGER) return WINDOW;

  procedure MVWIN (WIN: WINDOW; Y, X: INTEGER);

  procedure ADDCH  (CH: CHARACTER);
  procedure WADDCH (WIN: WINDOW; CH: CHARACTER);

  procedure ADDSTR  (S: STRING);
  procedure WADDSTR (WIN: WINDOW; S: STRING);

  procedure BOX (WIN: WINDOW; VERTICAL:   CHARACTER := '|';
                  HORIZONTAL: CHARACTER := '-');

  procedure CLEAR;
  procedure WCLEAR(WIN: WINDOW);

  procedure CLEAROK (SCR: WINDOW; BOOLF: boolean);

  procedure CLRTOBOT;
  procedure WCLRTOBOT (WIN: WINDOW);

  procedure CLRTOEOL;
  procedure WCLRTOEOL (WIN: WINDOW);

  procedure DELCH;
  procedure WDELCH (WIN: WINDOW);

  procedure DELETELN;
  procedure WDELETELN (WIN: WINDOW);

  procedure ERASE;
  procedure WERASE (WIN: WINDOW);

  procedure INSCH (CH: CHARACTER);
  procedure WINSCH (WIN: WINDOW; CH: CHARACTER);

  procedure INSERTLN;
  procedure WINSERTLN (WIN: WINDOW);

  procedure MOVE (Y, X: INTEGER);
  procedure WMOVE (WIN: WINDOW; Y, X: INTEGER);

  procedure OVERLAY (WIN1, WIN2: WINDOW);
  procedure OVERWRITE (WIN1, WIN2: WINDOW);

  procedure REFRESH;
  procedure WREFRESH (WIN: WINDOW);

  procedure STANDOUT;
  procedure WSTANDOUT (WIN: WINDOW);

  procedure STANDEND;
  procedure WSTANDEND (WIN: WINDOW);

  private

    pragma INTERFACE (C, INITSCR);
    pragma INTERFACE (C, DELWIN);
    pragma INTERFACE (C, ENDWIN);
    pragma INTERFACE (C, NEWWIN);
    pragma INTERFACE (C, SUBWIN);
    pragma INTERFACE (C, MVWIN);
    pragma INTERFACE (C, WADDCH);
    pragma INTERFACE (C, WADDSTR);
    pragma INTERFACE (C, BOX);
    pragma INTERFACE (C, WCLEAR);
    pragma INTERFACE (C, CLEAROK);
    pragma INTERFACE (C, WCLRTOBOT);
    pragma INTERFACE (C, WCLRTOEOL);
    pragma INTERFACE (C, WDELCH);
    pragma INTERFACE (C, WDELETELN);
    pragma INTERFACE (C, WERASE);
    pragma INTERFACE (C, WINSCH);
    pragma INTERFACE (C, WINSERTLN);
    pragma INTERFACE (C, WMOVE);
    pragma INTERFACE (C, OVERLAY);
    pragma INTERFACE (C, OVERWRITE);
    pragma INTERFACE (C, WREFRESH);
    pragma INTERFACE (C, WSTANDOUT);
    pragma INTERFACE (C, WSTANDEND);

end CURSES;
::::::::::
curses_body.a
::::::::::
-------- SIMTEL20 Ada Software Repository Prologue ------------
--                                                           -*
-- Unit name    : curses interface package body
-- Version      : 1.0
-- Author       : Steve Rosen
--              : Siemens Research
--              :
--              :
-- DDN Address  : vrdxhq!siemens!gypsy!rosen@seismo
-- Copyright    : (c)
-- Date created :  6 August 1985
-- Release date :  6 August 1985
-- Last update  :  6 August 1985
-- Machine/System Compiled/Run on : VADS VAX/UNIX 4.06
--                                                           -*
---------------------------------------------------------------
--                                                           -*
-- Keywords     :  display, terminal update, screen
----------------:
--
-- Abstract     :  This package provides an interface to the UNIX
----------------:  curses package through Ada.
--                                                           -*
------------------ Revision history ---------------------------
--                                                           -*
-- DATE         VERSION    AUTHOR                  HISTORY
-- ???        0.0    Steve Rosen        Initial Release
-- 8/6/85    1.0    Karl A. Nyberg        Release to SIMTEL
--                                                           -*
------------------ Distribution and Copyright -----------------
--                                                           -*
-- This prologue must be included in all copies of this software.
--
-- This software is copyright by the author.
--
-- This software is released to the Ada community.
-- This software is released to the Public Domain (note:
--   software released to the Public Domain is not subject
--   to copyright protection).
-- Restrictions on use or distribution:  NONE
--                                                           -*
------------------ Disclaimer ---------------------------------
--                                     -*
------------------ Disclaimer ---------------------------------
--                                                           -*
-- This software and its documentation are provided "AS IS" and
-- without any expressed or implied warranties whatsoever.
-- No warranties as to performance, merchantability, or fitness
-- for a particular purpose exist.
--
-- Because of the diversity of conditions and hardware under
-- which this software may be used, no warranty of fitness for
-- a particular purpose is offered.  The user is advised to
-- test the software thoroughly before relying on it.  The user
-- must assume the entire risk and liability of using this
-- software.
--
-- In no event shall any person or organization of people be
-- held responsible for any direct, indirect, consequential
-- or inconsequential damages or lost profits.
--                                                           -*
-------------------END-PROLOGUE--------------------------------

package body CURSES is

  procedure ADDCH  (CH: CHARACTER) is
  begin
    if (STDSCR = WINDOW(0)) then
      raise UNDEFINED_WINDOW_ERROR;
    else
      WADDCH (STDSCR, CH);
    end if;
  end ADDCH;

  procedure ADDSTR  (S: STRING) is
  begin
    if (STDSCR = WINDOW(0)) then
      raise UNDEFINED_WINDOW_ERROR;
    else
      WADDSTR (STDSCR, S);
    end if;
  end ADDSTR;

  procedure CLEAR is
  begin
    if (STDSCR = WINDOW(0)) then
      raise UNDEFINED_WINDOW_ERROR;
    else
      WCLEAR (STDSCR);
    end if;
  end CLEAR;

  procedure CLRTOBOT is
  begin
    if (STDSCR = WINDOW(0)) then
      raise UNDEFINED_WINDOW_ERROR;
    else
      WCLRTOBOT (STDSCR);
    end if;
  end CLRTOBOT;

  procedure CLRTOEOL is
  begin
    if (STDSCR = WINDOW(0)) then
      raise UNDEFINED_WINDOW_ERROR;
    else
      WCLRTOEOL (STDSCR);
    end if;
  end CLRTOEOL;

  procedure DELCH is
  begin
    if (STDSCR = WINDOW(0)) then
      raise UNDEFINED_WINDOW_ERROR;
    else
      WDELCH (STDSCR);
    end if;
  end DELCH;

  procedure DELETELN is
  begin
    if (STDSCR = WINDOW(0)) then
      raise UNDEFINED_WINDOW_ERROR;
    else
      WDELETELN (STDSCR);
    end if;
  end DELETELN;

  procedure ERASE is
  begin
    if (STDSCR = WINDOW(0)) then
      raise UNDEFINED_WINDOW_ERROR;
    else
      WERASE (STDSCR);
    end if;
  end ERASE;

  procedure INSCH (CH: CHARACTER) is
  begin
    if (STDSCR = WINDOW(0)) then
      raise UNDEFINED_WINDOW_ERROR;
    else
      WINSCH (STDSCR, CH);
    end if;
  end INSCH;

  procedure INSERTLN is
  begin
    if (STDSCR = WINDOW(0)) then
      raise UNDEFINED_WINDOW_ERROR;
    else
      WINSERTLN (STDSCR);
    end if;
  end INSERTLN;

  procedure MOVE (Y, X: INTEGER) is
  begin
    if (STDSCR = WINDOW(0)) then
      raise UNDEFINED_WINDOW_ERROR;
    else
      WMOVE (STDSCR, Y, X);
    end if;
  end MOVE;

  procedure REFRESH is
  begin
    if (STDSCR = WINDOW(0)) then
      raise UNDEFINED_WINDOW_ERROR;
    else
      WREFRESH (STDSCR);
    end if;
  end REFRESH;

  procedure STANDOUT is
  begin
    if (STDSCR = WINDOW(0)) then
      raise UNDEFINED_WINDOW_ERROR;
    else
      WSTANDOUT (STDSCR);
    end if;
  end STANDOUT;

  procedure STANDEND is
  begin
    if (STDSCR = WINDOW(0)) then
      raise UNDEFINED_WINDOW_ERROR;
    else
      WSTANDEND (STDSCR);
    end if;
  end STANDEND;

begin
  STDSCR := WINDOW(0);
end CURSES;
::::::::::
towers_of_hanoi.a
::::::::::
-------- SIMTEL20 Ada Software Repository Prologue ------------
--                                                           -*
-- Unit name    : package specification for towers_of_hanoi
-- Version      : 1.0
-- Author       : Steve Rosen
--              : Siemens Research
--              :
--              :
-- DDN Address  : vrdxhq!siemens!gypsy!rosen@seismo
-- Copyright    : (c)
-- Date created :  6 August 1985
-- Release date :  6 August 1985
-- Last update  :  6 August 1985
-- Machine/System Compiled/Run on : VADS VAX/UNIX 4.06
--                                                           -*
---------------------------------------------------------------
--                                                           -*
-- Keywords     :  display, hanoi
----------------:
--
-- Abstract     :  The package for a terminal-independent version
----------------:  of the towers of hanoi demo.
--                                                           -*
------------------ Revision history ---------------------------
--                                                           -*
-- DATE         VERSION    AUTHOR                  HISTORY
-- ???        0.0    Steve Rosen        Initial Release
-- 8/6/85    1.0    Karl A. Nyberg        Release to SIMTEL
--                                                           -*
------------------ Distribution and Copyright -----------------
--                                                           -*
-- This prologue must be included in all copies of this software.
--
-- This software is copyright by the author.
--
-- This software is released to the Ada community.
-- This software is released to the Public Domain (note:
--   software released to the Public Domain is not subject
--   to copyright protection).
-- Restrictions on use or distribution:  NONE
--                                                           -*
------------------ Disclaimer ---------------------------------
--                                                           -*
-- This software and its documentation are provided "AS IS" and
-- without any expressed or implied warranties whatsoever.
-- No warranties as to performance, merchantability, or fitness
-- for a particular purpose exist.
--
-- Because of the diversity of conditions and hardware under
-- which this software may be used, no warranty of fitness for
-- a particular purpose is offered.  The user is advised to
-- test the software thoroughly before relying on it.  The user
-- must assume the entire risk and liability of using this
-- software.
--
-- In no event shall any person or organization of people be
-- held responsible for any direct, indirect, consequential
-- or inconsequential damages or lost profits.
--                                                           -*
-------------------END-PROLOGUE--------------------------------

-----------------------------------------
--    TOWERS_OF_HANOI Specification    --
-----------------------------------------

package TOWERS_OF_HANOI is

  MAX_DISCS: NATURAL := 13;
  NO_DISCS: NATURAL := 5;

  type MOTION is (SMOOTH, FAST, TELEPORT);
  DISPLAY_TYPE: MOTION := SMOOTH;

  type LOCATION is (LEFT, MIDDLE, RIGHT);

  COL: array (LOCATION) of NATURAL;
  COUNT: array (LOCATION) of NATURAL;

  TOP:   constant NATURAL := MAX_DISCS + 5;

  BLANK: constant CHARACTER := ' ';
  DISC:  constant CHARACTER := '=';

  procedure INITIAL;
  procedure FINISH (S: STRING);
  procedure DISPLAY (NUMBER: NATURAL);
  procedure HANOI (NUMBER: NATURAL; START, INTER, FINISH: LOCATION);
  procedure MOVE_DISC (NUMBER: NATURAL; START, FINISH: LOCATION);
  procedure SHOW_DISC (NUMBER: NATURAL; START, FINISH: LOCATION);
  procedure MAKE_DISC (NUMBER: NATURAL; PILE: LOCATION);
  procedure RM_DISC (NUMBER: NATURAL; PILE: LOCATION);
  procedure PLOT_DISC (NUMBER, Y, X: NATURAL; C: CHARACTER);

end TOWERS_OF_HANOI;
::::::::::
towers_of_hanoi_body.a
::::::::::
-------- SIMTEL20 Ada Software Repository Prologue ------------
--                                                           -*
-- Unit name    : package body for towers_of_hanoi
-- Version      : 1.0
-- Author       : Steve Rosen
--              : Siemens Research
--              :
--              :
-- DDN Address  : vrdxhq!siemens!gypsy!rosen@seismo
-- Copyright    : (c)
-- Date created :  6 August 1985
-- Release date :  6 August 1985
-- Last update  :  6 August 1985
-- Machine/System Compiled/Run on : VADS 4.06
--                                                           -*
---------------------------------------------------------------
--                                                           -*
-- Keywords     :  display, hanoi
----------------:
--
-- Abstract     :  The body for a terminal-independent version
----------------:  of the towers of hanoi demo.
--                                                           -*
------------------ Revision history ---------------------------
--                                                           -*
-- DATE         VERSION    AUTHOR                  HISTORY
-- ???        0.0    Steve Rosen        Initial Release
-- 8/6/85    1.0    Karl A. Nyberg        Release to SIMTEL
--                                                           -*
------------------ Distribution and Copyright -----------------
--                                                           -*
-- This prologue must be included in all copies of this software.
--
-- This software is copyright by the author.
--
-- This software is released to the Ada community.
-- This software is released to the Public Domain (note:
--   software released to the Public Domain is not subject
--   to copyright protection).
-- Restrictions on use or distribution:  NONE
--                                                           -*
------------------ Disclaimer ---------------------------------
--                                                           -*
-- This software and its documentation are provided "AS IS" and
-- without any expressed or implied warranties whatsoever.
-- No warranties as to performance, merchantability, or fitness
-- for a particular purpose exist.
--
-- Because of the diversity of conditions and hardware under
-- which this software may be used, no warranty of fitness for
-- a particular purpose is offered.  The user is advised to
-- test the software thoroughly before relying on it.  The user
-- must assume the entire risk and liability of using this
-- software.
--
-- In no event shall any person or organization of people be
-- held responsible for any direct, indirect, consequential
-- or inconsequential damages or lost profits.
--                                                           -*
-------------------END-PROLOGUE--------------------------------

-----------------------------------------
--        TOWERS_OF_HANOI Body         --
-----------------------------------------

with CURSES, TEXT_IO;
use CURSES;

package body TOWERS_OF_HANOI is

  procedure INITIAL is
  begin
    COL(LEFT) := NO_DISCS;
    COL(MIDDLE) := 3 * NO_DISCS;
    COL(RIGHT) := 5 * NO_DISCS;
    STDSCR := INITSCR;
  --NOECHO;
    DISPLAY(NO_DISCS);
  end INITIAL;

  procedure FINISH (S: STRING) is
  begin
    MOVE (LINES - 2, 0);
    REFRESH;
    ENDWIN;
    TEXT_IO.PUT_LINE(S);
  end;

  procedure DISPLAY (NUMBER: NATURAL) is
  begin
    CLEAR;
    STANDOUT;
    MOVE(0, 0);
    ADDSTR(" The Tower of Hanoi ");
    STANDEND;
    for I in reverse 1 .. NUMBER
      loop
    MAKE_DISC (I, LEFT);
      end loop;
  end DISPLAY;

  procedure HANOI (NUMBER: NATURAL; START, INTER, FINISH: LOCATION) is
  begin
    if (NUMBER > 0) then
      HANOI (NUMBER - 1, START, FINISH, INTER);
      MOVE_DISC (NUMBER, START, FINISH);
      HANOI (NUMBER - 1, INTER, START, FINISH);
    end if;
  end HANOI;

  procedure MOVE_DISC (NUMBER: NATURAL; START, FINISH: LOCATION) is
  begin
    RM_DISC (NUMBER, START);
    SHOW_DISC (NUMBER, START, FINISH);
    MAKE_DISC (NUMBER, FINISH);
  end MOVE_DISC;

  procedure SHOW_DISC (NUMBER: NATURAL; START, FINISH: LOCATION) is
    X, Y, DIRECTION: INTEGER;
  begin
    if (COL(START) < COL(FINISH)) then
      DIRECTION := +1;
    else
      DIRECTION := -1;
    end if;

    if (DISPLAY_TYPE = TELEPORT) then
      return;
    end if;

    Y := COUNT(START);
    while (Y < (NO_DISCS - 1))
      loop
    PLOT_DISC (NUMBER, Y, COL(START), BLANK);
    if (DISPLAY_TYPE = SMOOTH) then
      REFRESH;
    end if;
        PLOT_DISC (NUMBER, Y+1, COL(START), DISC);
    if (DISPLAY_TYPE = SMOOTH) then
      REFRESH;
    end if;
    Y := Y + 1;
      end loop;

      REFRESH;
      X := COL(START);
      while (X /= COL(FINISH))
    loop
      PLOT_DISC (NUMBER, Y, X, BLANK);
      PLOT_DISC (NUMBER, Y, X + DIRECTION, DISC);
      if (DISPLAY_TYPE = SMOOTH) then
        REFRESH;
      end if;
      X := X + DIRECTION;
    end loop;
      while (Y > COUNT(FINISH))
    loop
      PLOT_DISC(NUMBER, Y, COL(FINISH), BLANK);
      Y := Y - 1;
      IF (DISPLAY_TYPE = SMOOTH) then
        REFRESH;
      end if;
      PLOT_DISC (NUMBER, Y, COL(FINISH), DISC);
      if (DISPLAY_TYPE = SMOOTH) then
        REFRESH;
      end if;
    end loop;
      REFRESH;
    end SHOW_DISC;

    procedure MAKE_DISC (NUMBER: NATURAL; PILE: LOCATION) is
    begin
      PLOT_DISC (NUMBER, COUNT(PILE), COL (PILE), DISC);
      COUNT(PILE) := COUNT(PILE) + 1;
      REFRESH;
    end MAKE_DISC;

    procedure RM_DISC (NUMBER: NATURAL; PILE: LOCATION) is
    begin
      COUNT(PILE) := COUNT(PILE) - 1;
      PLOT_DISC (NUMBER, COUNT(PILE), COL(PILE), BLANK);
      REFRESH;
    end RM_DISC;

    procedure PLOT_DISC (NUMBER, Y, X: NATURAL; C: CHARACTER) is
    begin
      MOVE (TOP - Y, X - NUMBER);
      for I in 1 .. (2 * NUMBER)
    loop
      ADDCH (C);
    end loop;
    end PLOT_DISC;

end TOWERS_OF_HANOI;
::::::::::
tower.a
::::::::::
-------- SIMTEL20 Ada Software Repository Prologue ------------
--                                                           -*
-- Unit name    : tower.a - main program for towers of hanoi demo
-- Version      : 1.0
-- Author       : Steve Rosen
--              : Siemens Research
--              :
--              :
-- DDN Address  : vrdxhq!siemens!gypsy!rosen@seismo
-- Copyright    : (c)
-- Date created :  6 August 1985
-- Release date :  6 August 1985
-- Last update  :  6 August 1985
-- Machine/System Compiled/Run on : VADS VAX/UNIX 4.06
--                                                           -*
---------------------------------------------------------------
--                                                           -*
-- Keywords     :  display, terminal update, screen
----------------:
--
-- Abstract     :  This procedure provides a demo of the towers of
----------------:  hanoi using UNIX curses that should be relatively
----------------:  terminal independent.
--                                                           -*
------------------ Revision history ---------------------------
--                                                           -*
-- DATE         VERSION    AUTHOR                  HISTORY
-- ???        0.0    Steve Rosen        Initial Release
-- 8/6/85    1.0    Karl A. Nyberg        Release to SIMTEL
--                                                           -*
------------------ Distribution and Copyright -----------------
--                                                           -*
-- This prologue must be included in all copies of this software.
--
-- This software is copyright by the author.
--
-- This software is released to the Ada community.
-- This software is released to the Public Domain (note:
--   software released to the Public Domain is not subject
--   to copyright protection).
-- Restrictions on use or distribution:  NONE
--                                                           -*
------------------ Disclaimer ---------------------------------
--                                                           -*
-- This software and its documentation are provided "AS IS" and
-- without any expressed or implied warranties whatsoever.
-- No warranties as to performance, merchantability, or fitness
-- for a particular purpose exist.
--
-- Because of the diversity of conditions and hardware under
-- which this software may be used, no warranty of fitness for
-- a particular purpose is offered.  The user is advised to
-- test the software thoroughly before relying on it.  The user
-- must assume the entire risk and liability of using this
-- software.
--
-- In no event shall any person or organization of people be
-- held responsible for any direct, indirect, consequential
-- or inconsequential damages or lost profits.
--                                                           -*
-------------------END-PROLOGUE--------------------------------

-------------------------------
--    The Main Procedure     --
-------------------------------

with TOWERS_OF_HANOI;
use TOWERS_OF_HANOI;

procedure TOWER is
begin
  INITIAL;
  HANOI (NO_DISCS, LEFT, MIDDLE, RIGHT);
  delay DURATION(NO_DISCS);
  HANOI (NO_DISCS, RIGHT, MIDDLE, LEFT);
  FINISH ("Done!");
end TOWER;
::::::::::
compile.ctl
::::::::::
a.mklib -f .
ada curses.a
ada curses_body.a
ada towers_of_hanoi.a
ada towers_of_hanoi_body.a
ada tower.a
a.ld -o tower tower -lcurses -ltermlib