| 1 | ------------------------------------------------------------------------------ | 
|---|
| 2 | --                                                                          -- | 
|---|
| 3 | --                       GNAT ncurses Binding Samples                       -- | 
|---|
| 4 | --                                                                          -- | 
|---|
| 5 | --                                   Rain                                   -- | 
|---|
| 6 | --                                                                          -- | 
|---|
| 7 | --                                 B O D Y                                  -- | 
|---|
| 8 | --                                                                          -- | 
|---|
| 9 | ------------------------------------------------------------------------------ | 
|---|
| 10 | -- Copyright (c) 1998 Free Software Foundation, Inc.                        -- | 
|---|
| 11 | --                                                                          -- | 
|---|
| 12 | -- Permission is hereby granted, free of charge, to any person obtaining a  -- | 
|---|
| 13 | -- copy of this software and associated documentation files (the            -- | 
|---|
| 14 | -- "Software"), to deal in the Software without restriction, including      -- | 
|---|
| 15 | -- without limitation the rights to use, copy, modify, merge, publish,      -- | 
|---|
| 16 | -- distribute, distribute with modifications, sublicense, and/or sell       -- | 
|---|
| 17 | -- copies of the Software, and to permit persons to whom the Software is    -- | 
|---|
| 18 | -- furnished to do so, subject to the following conditions:                 -- | 
|---|
| 19 | --                                                                          -- | 
|---|
| 20 | -- The above copyright notice and this permission notice shall be included  -- | 
|---|
| 21 | -- in all copies or substantial portions of the Software.                   -- | 
|---|
| 22 | --                                                                          -- | 
|---|
| 23 | -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS  -- | 
|---|
| 24 | -- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF               -- | 
|---|
| 25 | -- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.   -- | 
|---|
| 26 | -- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,   -- | 
|---|
| 27 | -- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR    -- | 
|---|
| 28 | -- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR    -- | 
|---|
| 29 | -- THE USE OR OTHER DEALINGS IN THE SOFTWARE.                               -- | 
|---|
| 30 | --                                                                          -- | 
|---|
| 31 | -- Except as contained in this notice, the name(s) of the above copyright   -- | 
|---|
| 32 | -- holders shall not be used in advertising or otherwise to promote the     -- | 
|---|
| 33 | -- sale, use or other dealings in this Software without prior written       -- | 
|---|
| 34 | -- authorization.                                                           -- | 
|---|
| 35 | ------------------------------------------------------------------------------ | 
|---|
| 36 | --  Author:  Laurent Pautet <pautet@gnat.com> | 
|---|
| 37 | --  Modified by:  Juergen Pfeifer, 1997 | 
|---|
| 38 | --  Version Control | 
|---|
| 39 | --  $Revision: 1.6 $ | 
|---|
| 40 | --  Binding Version 01.00 | 
|---|
| 41 | ------------------------------------------------------------------------------ | 
|---|
| 42 | --                                                                          -- | 
|---|
| 43 | with Ada.Numerics.Float_Random; use Ada.Numerics.Float_Random; | 
|---|
| 44 | with Status; use Status; | 
|---|
| 45 | with Terminal_Interface.Curses; use Terminal_Interface.Curses; | 
|---|
| 46 |  | 
|---|
| 47 | procedure Rain is | 
|---|
| 48 |  | 
|---|
| 49 | Visibility : Cursor_Visibility; | 
|---|
| 50 |  | 
|---|
| 51 | subtype X_Position is Line_Position; | 
|---|
| 52 | subtype Y_Position is Column_Position; | 
|---|
| 53 |  | 
|---|
| 54 | Xpos    : array (1 .. 5) of X_Position; | 
|---|
| 55 | Ypos    : array (1 .. 5) of Y_Position; | 
|---|
| 56 |  | 
|---|
| 57 | N : Integer; | 
|---|
| 58 |  | 
|---|
| 59 | G : Generator; | 
|---|
| 60 |  | 
|---|
| 61 | Max_X, X : X_Position; | 
|---|
| 62 | Max_Y, Y : Y_Position; | 
|---|
| 63 |  | 
|---|
| 64 | procedure Next (J : in out Integer); | 
|---|
| 65 | procedure Cursor (X : X_Position; Y : Y_Position); | 
|---|
| 66 |  | 
|---|
| 67 | procedure Next (J : in out Integer) is | 
|---|
| 68 | begin | 
|---|
| 69 | if J = 5 then | 
|---|
| 70 | J := 1; | 
|---|
| 71 | else | 
|---|
| 72 | J := J + 1; | 
|---|
| 73 | end if; | 
|---|
| 74 | end Next; | 
|---|
| 75 |  | 
|---|
| 76 | procedure Cursor (X : X_Position; Y : Y_Position) is | 
|---|
| 77 | begin | 
|---|
| 78 | Move_Cursor (Line => X, Column => Y); | 
|---|
| 79 | end Cursor; | 
|---|
| 80 | pragma Inline (Cursor); | 
|---|
| 81 |  | 
|---|
| 82 | begin | 
|---|
| 83 |  | 
|---|
| 84 | Init_Screen; | 
|---|
| 85 | Set_NL_Mode; | 
|---|
| 86 | Set_Echo_Mode (False); | 
|---|
| 87 |  | 
|---|
| 88 | Visibility := Invisible; | 
|---|
| 89 | Set_Cursor_Visibility (Visibility); | 
|---|
| 90 |  | 
|---|
| 91 | Max_X := Lines - 5; | 
|---|
| 92 | Max_Y := Columns - 5; | 
|---|
| 93 |  | 
|---|
| 94 | for I in Xpos'Range loop | 
|---|
| 95 | Xpos (I) := X_Position (Float (Max_X) * Random (G)) + 2; | 
|---|
| 96 | Ypos (I) := Y_Position (Float (Max_Y) * Random (G)) + 2; | 
|---|
| 97 | end loop; | 
|---|
| 98 |  | 
|---|
| 99 | N := 1; | 
|---|
| 100 | while Process.Continue loop | 
|---|
| 101 |  | 
|---|
| 102 | X := X_Position (Float (Max_X) * Random (G)) + 2; | 
|---|
| 103 | Y := Y_Position (Float (Max_Y) * Random (G)) + 2; | 
|---|
| 104 |  | 
|---|
| 105 | Cursor (X, Y); | 
|---|
| 106 | Add (Ch => '.'); | 
|---|
| 107 |  | 
|---|
| 108 | Cursor (Xpos (N), Ypos (N)); | 
|---|
| 109 | Add (Ch => 'o'); | 
|---|
| 110 |  | 
|---|
| 111 | -- | 
|---|
| 112 | Next (N); | 
|---|
| 113 | Cursor (Xpos (N), Ypos (N)); | 
|---|
| 114 | Add (Ch => 'O'); | 
|---|
| 115 |  | 
|---|
| 116 | -- | 
|---|
| 117 | Next (N); | 
|---|
| 118 | Cursor (Xpos (N) - 1, Ypos (N)); | 
|---|
| 119 | Add (Ch => '-'); | 
|---|
| 120 | Cursor (Xpos (N), Ypos (N) - 1); | 
|---|
| 121 | Add (Str => "|.|"); | 
|---|
| 122 | Cursor (Xpos (N) + 1, Ypos (N)); | 
|---|
| 123 | Add (Ch => '-'); | 
|---|
| 124 |  | 
|---|
| 125 | -- | 
|---|
| 126 | Next (N); | 
|---|
| 127 | Cursor (Xpos (N) - 2, Ypos (N)); | 
|---|
| 128 | Add (Ch => '-'); | 
|---|
| 129 | Cursor (Xpos (N) - 1, Ypos (N) - 1); | 
|---|
| 130 | Add (Str => "/\\"); | 
|---|
| 131 | Cursor (Xpos (N), Ypos (N) - 2); | 
|---|
| 132 | Add (Str => "| O |"); | 
|---|
| 133 | Cursor (Xpos (N) + 1, Ypos (N) - 1); | 
|---|
| 134 | Add (Str => "\\/"); | 
|---|
| 135 | Cursor (Xpos (N) + 2, Ypos (N)); | 
|---|
| 136 | Add (Ch => '-'); | 
|---|
| 137 |  | 
|---|
| 138 | -- | 
|---|
| 139 | Next (N); | 
|---|
| 140 | Cursor (Xpos (N) - 2, Ypos (N)); | 
|---|
| 141 | Add (Ch => ' '); | 
|---|
| 142 | Cursor (Xpos (N) - 1, Ypos (N) - 1); | 
|---|
| 143 | Add (Str => "   "); | 
|---|
| 144 | Cursor (Xpos (N), Ypos (N) - 2); | 
|---|
| 145 | Add (Str => "     "); | 
|---|
| 146 | Cursor (Xpos (N) + 1, Ypos (N) - 1); | 
|---|
| 147 | Add (Str => "   "); | 
|---|
| 148 | Cursor (Xpos (N) + 2, Ypos (N)); | 
|---|
| 149 | Add (Ch => ' '); | 
|---|
| 150 |  | 
|---|
| 151 | Xpos (N) := X; | 
|---|
| 152 | Ypos (N) := Y; | 
|---|
| 153 |  | 
|---|
| 154 | Refresh; | 
|---|
| 155 | Nap_Milli_Seconds (50); | 
|---|
| 156 | end loop; | 
|---|
| 157 |  | 
|---|
| 158 | Visibility := Normal; | 
|---|
| 159 | Set_Cursor_Visibility (Visibility); | 
|---|
| 160 | End_Windows; | 
|---|
| 161 |  | 
|---|
| 162 | end Rain; | 
|---|