Yurttas/PL/IL/Ada-95/F/05/02/00/menu p.adb

From ZCubes Wiki
Revision as of 05:47, 5 November 2013 by MassBot1 (talk | contribs) (Created page with "<syntaxhighlight lang="ada" line start="1" enclose="div">-- -- Copyright(C) 1998 -- All Rights Reserved. Salih Yurttas, ZCubes, BitsOfCode Software Systems, Inc.. -- -- Permis...")
(diff) ← Older revision | Latest revision (diff) | Newer revision → (diff)
Jump to navigation Jump to search
 1--
 2-- Copyright(C) 1998
 3-- All Rights Reserved. Salih Yurttas, ZCubes, BitsOfCode Software Systems, Inc..
 4--
 5-- Permission to use, copy, modify, and distribute this
 6-- software and its documentation for EDUCATIONAL purposes
 7-- and without fee is hereby granted provided that this
 8-- copyright notice appears in all copies.
 9--
10 
11-- date   : December 4, 1989.
12-- author : Michael Nobles.
13
14-- menu_p.adb
15
16
17package body Menu_P is
18
19  procedure Show_Menu is
20  begin
21    Put("         M E N U               ");
22    Put(" [c] change current data file ");
23    Put(" [r] read  a record number    ");
24    Put(" [w] write a record           ");
25    Put(" [f] find  a last name        ");
26    Put(" [e] exit                     ");
27  end Show_Menu;
28
29  function Menu_Choice return Integer is
30    Choice : String(1..1);
31    Desire : Character;
32    L      : Integer;
33    Valid  : Boolean := False;
34  begin
35    while not Valid loop
36      Fix_Cursor (10,5);
37      Put("What is your choice : ");
38      Get_Line(Choice,L);
39
40      Desire := Choice(1);
41      case Desire is
42        when 'c' |
43             'r' |
44             'w' |
45             'f' |
46             'e'   => Valid := True; 
47        when others => null;
48      end case;
49    end loop;
50
51    case Desire is
52      when 'c' => return 1;
53      when 'r' => return 2;
54      when 'w' => return 3;
55      when 'f' => return 4;
56      when 'e' => return 5;
57      when others => null;
58    end case;
59
60    return -1;
61  end Menu_Choice;
62
63end Menu_P;