Yurttas/PL/IL/Ada-95/F/04/03/00/garden planting p.adb

From ZCubes Wiki
Jump to navigation Jump to search
  1--
  2-- Copyright (C) 2000
  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 
 12-- date   : September 1, 2000.
 13-- author : Salih Yurttas.
 14
 15-- purpose : Implementation of Garden Planting types.
 16
 17-- garden_planting_p.adb
 18
 19
 20with Text_IO; use Text_IO;
 21
 22with Garden_P.Annual_Garden_P;
 23with Garden_P.Perennial_Garden_P;
 24with Garden_P.Veggie_Garden_P;
 25
 26package body Garden_Planting_P is
 27
 28  package APV_IO is new Enumeration_IO(Garden); use APV_IO;
 29
 30  type Position is (B, C, S, Q);
 31
 32  package BCS_IO is new Enumeration_IO(Position); use BCS_IO;
 33
 34  function Get_Garden return Garden is
 35    Choice : Garden;
 36  begin
 37    Put_Line("Choose A|P|V|E");
 38    New_Line;
 39
 40    Put("Annual Garden    - ");
 41    Put(A);
 42    New_Line;
 43    Put("Perennial Garden - ");
 44    Put(P);
 45    New_Line;
 46    Put("Veggie Garden    - ");
 47    Put(V);
 48    New_Line;
 49    Put("Exit             - ");
 50    Put(E);
 51    New_Line;
 52
 53    Get(Choice);
 54    New_Line;
 55
 56    return Choice;
 57  end Get_Garden;
 58
 59  function Get_Position return Position is
 60    Choice : Position;
 61  begin
 62    Put_Line("Choose B|C|S|Q");
 63    New_Line;
 64
 65    Put("Border - ");
 66    Put(B);
 67    New_Line;
 68    Put("Center - ");
 69    Put(C);
 70    New_Line;
 71    Put("Shade  - ");
 72    Put(S);
 73    New_Line;
 74    Put("Quit   - ");
 75    Put(Q);
 76    New_Line;
 77
 78    Get(Choice);
 79    New_Line;
 80
 81    return Choice;
 82  end Get_Position;
 83
 84  procedure Annual_Planting is
 85    B_C_S_Choice : Position;
 86  begin
 87    loop
 88      B_C_S_Choice := Get_Position;
 89
 90      case B_C_S_Choice is
 91
 92        when B => Garden_P.Annual_Garden_P.Get_Border;
 93
 94        when C => Garden_P.Annual_Garden_P.Get_Center;
 95
 96        when S => Garden_P.Annual_Garden_P.Get_Shade;
 97
 98        when Q => exit;
 99
100      end case;
101
102    end loop;
103  end Annual_Planting;
104
105  procedure Perennial_Planting is
106    B_C_S_Choice : Position;
107  begin
108    loop
109      B_C_S_Choice := Get_Position;
110
111      case B_C_S_Choice is
112
113        when B => Garden_P.Perennial_Garden_P.Get_Border;
114
115        when C => Garden_P.Perennial_Garden_P.Get_Center;
116
117        when S => Garden_P.Perennial_Garden_P.Get_Shade;
118
119        when Q => exit;
120
121      end case;
122
123    end loop;
124  end Perennial_Planting;
125
126  procedure Veggie_Planting is
127    B_C_S_Choice : Position;
128  begin
129    loop
130      B_C_S_Choice := Get_Position;
131
132      case B_C_S_Choice is
133
134        when B => Garden_P.Veggie_Garden_P.Get_Border;
135
136        when C => Garden_P.Veggie_Garden_P.Get_Center;
137
138        when S => Garden_P.Veggie_Garden_P.Get_Shade;
139
140        when Q => exit;
141
142      end case;
143
144    end loop;
145  end Veggie_Planting;
146
147end Garden_Planting_P;