Programmer's ROM - The Computer Language Library/programmersrom.iso/ada/misc/vdt100.src

Text File | 1988-05-03 | 14.8 KB | 494 lines

::::::::::
VDT100.PRO
::::::::::

-------- SIMTEL20 Ada Software Repository Prologue ------------
--                                                           -*
-- Unit name    : VDT100
-- Version      : 1.0
-- Author       : Triplett, Brenda and Hammons, Bud
--              : Department of Computer Science
--              : North Texas State University
--              : Denton, TX  76203
-- DDN Address  : HAMMONS%TI-EG at CSNET-RELAY
-- Copyright    : (c) 1984, 1985 Brenda Triplett and Bud Hammons
-- Date created :  1984
-- Release date :  15 Jan 1985
-- Last update  :  15 Jan 1985
-- Machine/System Compiled/Run on : Telesoft Ada 1.5, VAX
--                                                           -*
---------------------------------------------------------------
--                                                           -*
-- Keywords     :  VT100, TERMINAL INTERFACE, TOWERS OF HANOI
----------------:
--
-- Abstract     :  VDT100.SRC contains a package which provides a
----------------:  set of routines to interface with a VT100
----------------:  computer terminal, providing procedures for
----------------:  functions such as cursor positioning and clear
----------------:  screen.  Included is a test program, which is
----------------:  a solution to the Towers of Hanoi.
----------------:  This is a first student attempt and does not use
----------------:  the IMAGE attribute.
--                                                           -*
------------------ Revision history ---------------------------
--                                                           -*
-- DATE         VERSION    AUTHOR                  HISTORY
-- 15 Jan 85       1.0    Brenda Triplett        Initial Release
--                                                           -*
------------------ 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--------------------------------

::::::::::
VDT100.ADA
::::::::::

--name       : Screen Control
--purpose    : to allow different screen manipulations from a program
--exports    : see following
--exceptions : Mode Error
--             Attribute Error
--imports    : Text IO
--history    :
--                 date      author                reason
--             11-7-84    Brenda Triplett  midterm & for use in 401
---------------------------------------------------------------------------
---------------------------------------------------------------------------
--exports
---------
--name        : Gotoxy
--purpose     : move to location on screen
--parameters  : X => line num
--              Y => column num
-----------------------------------------------------------------------------
--name        : Clear Screen
--purpose     : blank screen
-------------------------------------------------------------------------------
--name        : Set Mode
--purpose     : change from 80 to 132 columns and back
--parameters  : Columns => number of columns desired
--exceptions  : Mode Error => when columns is neither 80 of 132
-------------------------------------------------------------------------------
--name        : Clear Line
--purpose     : Blank out from cursor to end of line
-------------------------------------------------------------------------------
--name        : Set Attributes
--purpose     : change characteristics of the screen
--parameters  : Which1 & Which2 => number corresponding to a characteristic
--exceptions  : Attribute error => when Which1 or Which2 does not correspond
--              to a characteristic
-------------------------------------------------------------------------------
--name        : Set Block
--purpose     : define area when attributes are effective
--parameters  : Width => number of columns in block
--              Depth => number of lines in block
-------------------------------------------------------------------------------
--name        : Cursor Up, Cursor Down
--purpose     : move cursor
--parameters  : Lines => number of lines
-------------------------------------------------------------------------------
--name        : Cursor Forward, Cursor Backwar
--purpose     : move cursor
--parameters  : Columns => number of columns
-------------------------------------------------------------------------------
--name        : Next Line, Previous Line
--purpose     : move cursor
--parameters  : How Many => number of lines
-------------------------------------------------------------------------------
package Screen_Control is
  procedure Gotoxy(X,Y:natural);

  procedure Clear_Screen;

  procedure Set_Mode(Columns:natural);
  Mode_Error : Exception;

  procedure Clear_Line;

  procedure Set_Attributes(Which1,Which2 : Integer);
  Attribute_Error : Exception;
  --0 => normal intensity
  --1 => increase intensity
  --2 => decrease intensity
  --3 => blank
  --4 => underline
  --5 => blink
  --7 => reverse video

  procedure Set_Block(Width,Depth : Integer);

  procedure Cursor_Up(Lines : Integer);
  procedure Cursor_Down(Lines : Integer);
  procedure Cursor_Forward(Columns : Integer);
  procedure Cursor_Backward(Columns : Integer);

  procedure Next_Line(How_Many : Integer);
  procedure Previous_Line(How_Many : Integer);
end Screen_Control;

with Text_IO;
use Text_IO;
package body Screen_Control is

procedure Gotoxy(X,Y:natural) is
begin
  Put(Ascii.ESC);
  Put("[");
  Integer_IO.Put(X,1);
  Put(";");
  Integer_IO.Put(Y,1);
  Put("H");
end Gotoxy;

procedure Clear_Screen is
begin
  Put(Ascii.ESC);
  Put("[2J");
end Clear_Screen;

procedure Set_Mode(Columns:natural) is
begin
  if Columns /=80 and Columns /=132
  then raise Mode_Error;
  elsif Columns = 80
     then
       Put(Ascii.ESC);
       Put("[?");
       Integer_IO.Put(3,1);
       Put("l");
     else
       Put(Ascii.ESC);
       Put("[?");
       Integer_IO.Put(3,1);
       Put("h");
  end if;
end Set_Mode;

procedure Clear_Line is

begin
  Put(Ascii.ESC);
  Put("[");
  Integer_IO.Put(0,1);
  Put("K");
end Clear_Line;

procedure Set_Attributes(Which1,Which2 : Integer) is
begin
  if Which1 < 8 and Which1 >= 0 and Which1 /= 6 and
     Which2 < 8 and Which2 >= 0 and Which2 /= 6
  then
    Put(Ascii.ESC);
    Put("[");
    Integer_IO.Put(Which1);
    Put(";");
    Integer_IO.Put(Which2);
    Put("m");
  else raise Attribute_Error;
  end if;
end Set_Attributes;

procedure Set_Block(Width,Depth : Integer) is
begin
  Put(Ascii.ESC);
  Put("[");
  Integer_IO.Put(Width,1);
  Put(";");
  Integer_IO.Put(Depth,1);
  Put(" q");
end Set_Block;

procedure Cursor_Up(Lines : Integer) is
begin
  Put(Ascii.ESC);
  Put("[");
  Integer_IO.Put(Lines,1);
  Put("A");
end Cursor_Up;

procedure Cursor_Down(Lines : Integer) is
begin
  Put(Ascii.ESC);
  Put("[");
  Integer_IO.Put(Lines,1);
  Put("B");
end Cursor_Down;

procedure Cursor_Forward(Columns : Integer) is
begin
  Put(Ascii.ESC);
  Put("[");
  Integer_IO.Put(Columns,1);
  Put("C");
end Cursor_Forward;

procedure Cursor_Backward(Columns : Integer) is
begin
  Put(Ascii.ESC);
  Put("[");
  Integer_IO.Put(Columns,1);
  Put("D");
end Cursor_Backward;

procedure Next_Line(How_Many : Integer) is
begin
  Put(Ascii.ESC);
  Put("[");
  Integer_IO.Put(How_Many,1);
  Put("E");
end Next_Line;

procedure Previous_Line(How_Many : Integer) is
begin
  Put(Ascii.ESC);
  Put("[");
  Integer_IO.Put(How_Many,1);
  Put("F");
end Previous_Line;
end Screen_Control;


::::::::::
HANOI.ADA
::::::::::

--name       : Towers of Hanoi
--purpose    : to display the solution of the Towers of Hanoi problem
--imports    : Screen Control, Text_IO
--algorithms :
--history    :
--              date        author              reason
--              11-5-84     Brenda Triplett     midterm
-----------------------------------------------------------------------------
--name       : Get Disk Num
--purpose    : read in the number of disks to be moved
--exports    : the number
-----------------------------------------------------------------------------
--name       : Set Up Screen
--purpose    : set up initial screen for Towers of Hanoi problem
-----------------------------------------------------------------------------
--name       : Hanoi
--purpose    : solve Towers of Hanoi problem
--parameters : N => number of disks to be moved
--             X => to be moved from
--             Y => to be moved to
--             Z => to use in moving
--algorithms : if the number of disks to be moved is qreater than zero
--             then
--               call Hanoi with one less disk to be moved from x to z using y
--               move the n-th disk
--               call Hanoi with one less disk to be moved from z to y using x
------------------------------------------------------------------------------
--name       : Move
--purpose    : proform move in Hanoi algorithm
--parameters : From => to be moved from
--             To => to be moved to
--             N => which disk is to be moved
--algorithms : locate where on the screen the disk is to be moved from
--             remove disk
--             locate where on the screen the disk is to be moved to
--             place disk
------------------------------------------------------------------------------
--name       : Locate Disk
--purpose    : locate where on the screen the disk is or will be
--parameters : Where => is the disk on X, Y, or Z rod
--             Which => which disk
-------------------------------------------------------------------------------
--name       : Remove Disk
--purpose    : move disk from the screen location
--parameters : Where => is the disk on X, Y, or Z rod
-------------------------------------------------------------------------------

package Towers_Of_Hanoi is
end Towers_Of_Hanoi;


with Screen_Control,Text_IO;
use Screen_Control,Text_IO;

package body Towers_Of_Hanoi is
  subtype Num is integer range 0..8;
  type Rod is (X,Y,Z);
  N           :Num;
  How_Many    :array (Rod) of Num;

--Locate_Disk & Remove_Disk & Place_Disk

  subtype Line is integer range 0..24;
  subtype Column is integer range 0..80;
  Start_Line,
  Stop_Line        : Line;
  Start_Col,
  Stop_Col         : Column;
  Center           : Column;

  procedure Get_Disk_Num(N: out Num) is
  begin
    Put("enter number of disks (1-8) ");
    Integer_IO.Get(N,1);
    exception
      when Constraint_Error => Get_Disk_Num(N);
  end Get_Disk_Num;

  procedure Set_Up_Screen is
  begin
    Clear_Screen;
    Gotoxy(20,9);
    Put("----------------");
    Gotoxy(20,33);
    Put("----------------");
    Gotoxy(20,57);
    Put("----------------");
    Gotoxy(22,16);
    Put("X");
    Gotoxy(22,40);
    Put("Y");
    Gotoxy(22,64);
    Put("Z");
    for Line_Num in 2..19 loop
      Gotoxy(Line_Num,16);
      Put("|");
      Gotoxy(Line_Num,40);
      Put("|");
      Gotoxy(Line_Num,64);
      Put("|");
    end loop;
  end Set_Up_Screen;

  procedure Locate_Disk(Where:Rod; Which:Num) is
    Largest  :Num;
  begin
    Largest := 8 - Which;
    case Where is
      when X => Center := 16;
                Start_Col := 9 + Largest;
                Stop_Col := 24 - Largest;
      when Y => Center := 40;
                Start_Col := 33 + Largest;
                Stop_Col := 48 - Largest;
      when Z => Center := 64;
                Start_Col := 57 + Largest;
                Stop_Col := 72 - Largest;
    end case;
    Start_Line := 19 - (How_Many(Where) * 2);
    Stop_Line := Start_Line - 1;
  end Locate_Disk;

  procedure Remove_Disk(Where:Rod) is
  begin
    How_Many(Where) := How_Many(Where) - 1;
    Start_Line := Start_Line + 2;
    Stop_Line := Stop_Line + 2;
    Gotoxy(Start_Line,Start_Col);
    Put(" ");
    Gotoxy(Start_Line,Stop_Col);
    Put(" ");
    Gotoxy(Stop_Line,Start_Col);
    for Position in Start_Col..Stop_Col loop
      Put(" ");
    end loop;
    Gotoxy(Start_Line,Center);
    Put("|");
    Gotoxy(Stop_Line,Center);
    Put("|");
  end Remove_Disk;

  procedure Place_Disk(Where:Rod) is
  begin
    How_Many(Where) := How_Many(Where) + 1;
    Gotoxy(Start_Line,Center);
    Put(" ");
    Gotoxy(Start_Line,Start_Col);
    Put("|");
    Gotoxy(Start_Line,Stop_Col);
    Put("|");
    Gotoxy(Stop_Line,Start_Col);
    for Position in Start_Col..Stop_Col loop
      Put("-");
    end loop;
  end Place_Disk;

  procedure Move(From,To:Rod; N:Num) is
  begin
    Gotoxy(24,1);
    Put("move disk # ");
    Integer_IO.Put(N,1);
    Put("from ");
    case From is
      when X => Put("X");
      when Y => Put("Y");
      when Z => Put("Z");
    end case;
    Put(" to ");
    case To is
      when X => Put("X");
      when Y => Put("Y");
      when Z => Put("Z");
    end case;
    Locate_Disk(From,N);
    Remove_Disk(From);
    Locate_Disk(To,N);
    Place_Disk(To);
    for Counter in 1..Integer'last*(999/1000) loop
      null;
    end loop;
  end Move;

  procedure Hanoi(N:Num; X,Y,Z:Rod) is
  begin
    if N /= 0
    then
      Hanoi(N-1,X,Z,Y);
      Move(X,Y, N);
      Hanoi(N-1,Z,Y,X);
    end if;
  end Hanoi;

--towers of hanoi
begin
  How_Many(X) := 0;
  How_Many(Y) := 0;
  How_Many(Z) := 0;
  Clear_Screen;
  Get_Disk_Num(N);
  Set_Up_Screen;
  for Number in reverse 1..N loop
    Locate_Disk(X,Number);
    Place_Disk(X);
    for Counter in 1..Integer'last*(99/100) loop
      null;
    end loop;
  Hanoi(N,X,Y,Z);
end Towers_Of_Hanoi;