File: windows.ads

package info (click to toggle)
libtexttools 2.0.3-4
  • links: PTS
  • area: main
  • in suites: etch, etch-m68k
  • size: 1,188 kB
  • ctags: 635
  • sloc: ada: 13,120; cpp: 1,679; ansic: 777; makefile: 156; sh: 2
file content (324 lines) | stat: -rw-r--r-- 14,686 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
------------------------------------------------------------------------------
-- WINDOWS                                                                  --
--                                                                          --
-- Part of TextTools                                                        --
-- Designed and Programmed by Ken O. Burtch                                 --
--                                                                          --
------------------------------------------------------------------------------
--                                                                          --
--                 Copyright (C) 1999-2003 Ken O. Burtch                    --
--                                                                          --
-- This is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
-- sion.  This is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
-- for  more details.  You should have  received  a copy of the GNU General --
-- Public License  distributed with this;  see file COPYING.  If not, write --
-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
-- MA 02111-1307, USA.                                                      --
--                                                                          --
-- As a special exception,  if other files  instantiate  generics from this --
-- unit, or you link  this unit with other files  to produce an executable, --
-- this  unit  does not  by itself cause  the resulting  executable  to  be --
-- covered  by the  GNU  General  Public  License.  This exception does not --
-- however invalidate  any other reasons why  the executable file  might be --
-- covered by the  GNU Public License.                                      --
--                                                                          --
-- This is maintained at http://www.vaxxine.com/pegasoft                    --
--                                                                          --
------------------------------------------------------------------------------
with common; use common;
  pragma Elaborate( Common );
with os; use os;
with userio; use userio;
with controls; use controls;

package windows is

---> Housekeeping

procedure StartupWindows;
procedure IdleWindows( IdlePeriod : ATimeStamp );
procedure ShutdownWindows;

---> Windows

type AWindowStyle is (Normal, Frameless, Success, Warning, Danger, Status,
                      Emphasis, Subdued, Floating, MenuBar, Menu);
pragma convention( C, AWindowStyle );
type AWindowNumber is new short_integer range 0..16; -- number of windows
CurrentWindow : AWindowNumber;                       -- the active window

type RedrawingAmounts is (none, frame, whole );
pragma convention( C, RedrawingAmounts );
-- You can optimize the redrawing:
--   none: draw only controls, don't redraw window itself
--   frame: draw window frame only and controls
--   whole: erase and redraw whole window and controls

type AWindowDrawingCallBack is access procedure;

type LongLineHandling is (none, justify, wrap );
pragma convention( C, LongLineHandling );

function  OpenWindow( title : str255 ; l, t, r, b : integer;
          Style : AWindowStyle := Normal; HasInfoBar : boolean := false;
          CallBack : AWindowDrawingCallBack := null ) return AWindowNumber;
procedure OpenWindow( title : str255 ; l, t, r, b : integer;
          Style : AWindowStyle := Normal; HasInfoBar : boolean := false;
          CallBack : AWindowDrawingCallBack := null );
procedure SaveWindow( path : string; arch : APathName := NullStr255 );
procedure LoadWindow( path : string; arch : APathName := NullStr255 );
procedure EraseWindow;
procedure DrawWindow( id : AWindowNumber;
              Redraw : RedrawingAmounts := none );
procedure DrawWindow( Redraw : RedrawingAmounts := none );
procedure MoveWindow( id : AWindowNumber; dx, dy : integer );
procedure MoveWindow( dx, dy : integer );
procedure ScrollWindow( id : AWindowNumber; dx, dy : integer );
procedure ScrollWindow( dx, dy : integer );
procedure CloseWindow; -- clears controls, too.
procedure ShellOut( cmd : Str255 );
procedure SetInfoText( text : string );
procedure SetInfoText( text : str255 );
procedure SetWindowTimeout( c : AControlNumber; t : ATimeStamp );
procedure SetWindowTitle( title : Str255 );

function  GetWindowTitle( id : AWindowNumber ) return str255;
function  GetWindowStyle( id : AWindowNumber ) return AWindowStyle;
function  GetWindowCallBack(id : AWindowNumber) return AWindowDrawingCallBack;
function  GetWindowHasFrame( id : AWindowNumber ) return boolean;
function  GetWindowFrame( id : AWindowNumber ) return ARect;
function  GetWindowFrameColour( id : AWindowNumber ) return APenColourName;
function  GetWindowContent( id : AWindowNumber ) return ARect;
function  GetWindowHasInfoBar( id : AWindowNumber ) return boolean;
function  GetWindowInfoText( id : AWindowNumber ) return str255;
function  GetWindowXScroll( id : AWindowNumber ) return integer;
function  GetWindowYScroll( id : AWindowNumber ) return integer;

--procedure SwapWindows( id1, id2 : AWindowNumber );
--procedure MoveToFront( id : AWindowNumber );
--procedure MoveToBack( id : AWindowNumber );

procedure ResetWindow( id : AWindowNumber );
procedure ResetWindow;
procedure RefreshDesktop;

---> Controls in Windows
--

procedure AddControl( ptr : AControlPtr;  -- pointer to the control
          IsGlobal : boolean := true ; -- true if control in global coords.
          Control  : boolean := true );-- false if pgm wants to handle hits
procedure DeleteControl( id : AControlNumber );
function  FindControl( x, y : integer ) return AControlNumber;
function  GetControl( id : AControlNumber ) return AControlPtr;
procedure InvalidateControls( ThisWindow : AWindowNumber );


---> Dialog Manager
--
-- The dialog routines are responsible for all control interactions.
-- Wherever possible, dialog details are kept out of the controls.  One
-- exception is instant simple buttons: the button needs to know how to
-- draw itself (thus, the instant flag must be in it's fields), and it
-- doesn't know when it's selected by a hotkey scan so the dialog manager
-- must "manually" check to see if it hit an instant simple button.
-- Luckily only simple buttons are the only controls that can be instant
-- (unless a make a list of instant simple buttons later).
--
-- Also, scroll bar / list associations are kept in the fields of the
-- controls, though this is not strictly necessary since the controls
-- don't need to know this.  Probably store it in the Window's control
-- list at some later point.
--
-- Dialog Tasks:
--
-- None          -- time out
-- DialogError   -- no controls in window so can't dialog it
-- Hit           -- control was hit and control to program
-- Complete      -- dialog is finished
-- NonControlHit -- window was hit, but not the control
--
-- Whether or not a particular control is handled is determined
-- when the control is added to the window.  This is different than
-- the Apple IIgs where common tasks (over all controls) can be turned
-- on and off.

-- Window updates, focus changes not yet implemented.

type ADialogTask is (None, DialogError, Hit, Complete, NonControlHit);

-- Dialog Record
--
-- Control should be initialized to 1

type ADialogTaskRecord is record
    MyTask   : ADialogTask;    -- what DoDialog is reporting
    InputRec : AnInputRecord;  -- input record received
    Control  : AControlNumber; -- control that is affected
    Action   : ADialogAction;  -- result to return??
end record;
type ADialogTaskCallBack is access
     procedure( DialogTask : in out ADialogTaskRecord);

-- DoDialog
--
-- DialogTask - record returned as result of the dialog
-- TaskCB     - callback for handling manual controls
-- HearInCB   - callback for filtering incoming InputRec
-- HearOutCB  - callback for filtering outgoing Action

procedure DoDialog( DialogTask : in out ADialogTaskRecord;
                    TaskCB    : in ADialogTaskCallBack := null;
                    HearInCB  : in ADialogTaskCallBack := null;
                    HearOutCB : in ADialogTaskCallBack := null );

---> Standard Dialogs

procedure NoteAlert( message : string );    -- OK button
procedure CautionAlert( message : string ); -- OK button
procedure StopAlert( message : string );    -- OK button

function YesAlert( message : string; kind : BeepStyles )
  return boolean; -- Yes (default) or No
function NoAlert( message : string; kind : BeepStyles )
  return boolean; -- No (default) or Yes
function CancelAlert( message, OKCaption : string; kind : BeepStyles )
  return boolean; -- OK (default,customized) or Cancel
function YesCancelAlert( message : string; kind : BeepStyles )
  return AControlNumber; -- Yes, No or Cancel

---> General Window I/O

procedure MoveTo( x, y : integer );    -- move to local x, y
procedure Move( dx, dy : integer );    -- move by indicated x, y change

procedure ToLocal(    r : in out ARect );   -- global to local
procedure ToLocal( x, y : in out integer ); --   coordinates
procedure ToGlobal(   r : in out ARect );   -- local to global
procedure ToGlobal(x, y : in out integer ); --   coordinates

procedure print;                    -- move to next line
procedure print( s : string );      -- print a string
--procedure print( s : str80 );       -- print a str80 string
procedure print( s : str255 );      -- print a str255 string
procedure print( i : integer );     -- print an integer
procedure print( l : long_integer );-- print a long integer

---> Standard File Dialogs

type AValidateFilenameRec is record
     Filename : str255;  -- filename to be validated
     Replied  : boolean; -- true if not cancelled
end record;
procedure ValidateFilename( desc : in out AValidateFilenameRec );

-- These are based on the Apple IIgs file dialogs

type ASelectOpenFileRec is record
     Prompt  : Str255;  -- prompt for user
     Replied : boolean; -- true if file was selected
     Suffix  : Str255;  -- desired file suffix
     Direct  : boolean; -- true if can select directories
     Path    : Str255;  -- file path
     Fname   : Str255;  -- file name (or "" if "accept"ed)
end record;

type ASelectSaveFileRec is record
     Prompt  : Str255;  -- prompt for user
     Replied : boolean; -- true if file was selected
     Default : Str255;  -- default file name
     Path    : Str255;  -- chosen path
     Fname   : Str255;  -- file name
end record;

procedure SelectOpenFile( sofrec : in out ASelectOpenFileRec );
procedure SelectSaveFile( ssfrec : in out ASelectSaveFileRec );

-- Display a dialog box for opening/saving a file and returning the
-- path chosen by the user.

procedure ShowListInfo( title : string;
                        t : integer;
                        lst : in out Str255List.List;
			last : boolean := false;
                        longLines : LongLineHandling := none);
-- display a list for the user to view; list isn't cleared.  List is
-- full-screen except for the top of the window at t.
procedure ShowListInfo( title : string;
                        l, t, r, b : integer;
                        lst : in out Str255List.List;
			last : boolean := false;
                        longLines : LongLineHandling := none);
procedure EditListInfo( title : string;
                        t : integer;
                        lst : in out Str255List.List;
                        result : out boolean;
			last : boolean := false);
procedure EditListInfo( title : string;
                        l, t, r, b : integer;
                        lst : in out Str255List.List;
                        result : out boolean;
			last : boolean := false );

-- Put up a window in the given coordinates and display the string list
-- that you specify.  If you use EditListInfo, the user can edit the
-- list and result is true if the list has been changed.

procedure AppendNotepad( s : in out Str255List.List );

-- Add contents of list to end of notepad accessory

--- These entries for use by Window Editor program ONLY
--- pretend they're private, will ya?!

--- Control Table Definitions (for Windows)

type AControlTableRecord is record
     ptr    : AControlPtr;    -- pointer to a control
     mine   : boolean;        -- true if controlled by Window Manager
end record;
type ControlTableEntries is array(1..AControlNumber'Last)
     of AControlTableRecord;
type AControlTable is record     -- a control table is
     size    : AControlNumber;      --   number of entries in the table
     current : AControlNumber;      --   currently active control
     control : ControlTableEntries; --   the actual table
end record;

---> Window Definition (should be tagged)

type AWindow is record
     Title    : Str255;        -- title of the window
     HasFrame : boolean;       -- true if the window has a visible frame
     Relative : boolean;       -- frame relative to last window (NYI)
     Frame    : ARect;         -- rectangle around whole window
     FrameColour : APenColourName; -- colour of frame
     Content  : ARect;         -- rectangle inside window border
     table    : AControlTable; -- list of controls in the window
     HasInfoBar : boolean;     -- true if has an info bar
     InfoBar  : ARect;         -- dimensions of the info bar
     InfoText : Str255;        -- text in the info bar
     Style    : AWindowStyle;  -- style (purpose) of window
     Loaded   : Boolean;       -- true if loaded with LoadWindow
     SaveX, SaveY : integer;   -- for saving X & Y of Curses' cursor
     DrawCB   : AWindowDrawingCallBack; -- drawing routine (or null)
     SoundPath : APathname;    -- path for sound to play on open
     SoundID  : ASound;        -- id for same
     SongPath : APathname;     -- path for song to play on open
     SongID   : ASong;         -- id for same
     Timeout  : ATimeStamp := -1;  -- timeout in seconds (-1 = none)
     TimeoutControl : AControlNumber; -- control to execute on timeout (NYI)
     ParentFile : APathname;   -- file to inherit controls from (NYI)
     XScroll  : integer;       -- amount of scrolling from home position
     YScroll  : integer;       -- ditto
end record;
pragma Pack( AWindow );

Window : array( 1..AWindowNumber'Last ) of AWindow; -- stack of windows
NextWindow : AWindowNumber; -- next free window, 0 = no more

end windows;