1 /********************************************************************/
2 /*                                                                  */
3 /*  s7   Seed7 interpreter                                          */
4 /*  Copyright (C) 1990 - 2011  Thomas Mertes                        */
5 /*                                                                  */
6 /*  This program is free software; you can redistribute it and/or   */
7 /*  modify it under the terms of the GNU General Public License as  */
8 /*  published by the Free Software Foundation; either version 2 of  */
9 /*  the License, or (at your option) any later version.             */
10 /*                                                                  */
11 /*  This program is distributed in the hope that it will be useful, */
12 /*  but WITHOUT ANY WARRANTY; without even the implied warranty of  */
13 /*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the   */
14 /*  GNU General Public License for more details.                    */
15 /*                                                                  */
16 /*  You should have received a copy of the GNU General Public       */
17 /*  License along with this program; if not, write to the           */
18 /*  Free Software Foundation, Inc., 51 Franklin Street,             */
19 /*  Fifth Floor, Boston, MA  02110-1301, USA.                       */
20 /*                                                                  */
21 /*  Module: Library                                                 */
22 /*  File: seed7/src/conlib.c                                        */
23 /*  Changes: 1992, 1993, 1994  Thomas Mertes                        */
24 /*  Content: All primitive actions to do text console output.       */
25 /*                                                                  */
26 /********************************************************************/
27 
28 #define LOG_FUNCTIONS 0
29 #define VERBOSE_EXCEPTIONS 0
30 
31 #include "version.h"
32 
33 #include "stdlib.h"
34 #include "stdio.h"
35 #include "string.h"
36 
37 #include "common.h"
38 #include "data.h"
39 #include "heaputl.h"
40 #include "syvarutl.h"
41 #include "striutl.h"
42 #include "objutl.h"
43 #include "runerr.h"
44 #include "con_rtl.h"
45 #include "con_drv.h"
46 
47 #undef EXTERN
48 #define EXTERN
49 #include "conlib.h"
50 
51 
52 
53 /**
54  *  Clear an area of the console with space characters.
55  *  The area is specified in (line, column) coordinates and is
56  *  between the (''upper'', ''left'') and (''lower'', ''right'').
57  */
con_clear(listType arguments)58 objectType con_clear (listType arguments)
59 
60   { /* con_clear */
61     isit_int(arg_2(arguments));
62     isit_int(arg_3(arguments));
63     isit_int(arg_4(arguments));
64     isit_int(arg_5(arguments));
65     conClear(take_int(arg_2(arguments)),
66         take_int(arg_3(arguments)),
67         take_int(arg_4(arguments)),
68         take_int(arg_5(arguments)));
69     return SYS_EMPTY_OBJECT;
70   } /* con_clear */
71 
72 
73 
74 /**
75  *  Get the cursor column of the console.
76  *  @return the cursor column of the console.
77  */
con_column(listType arguments)78 objectType con_column (listType arguments)
79 
80   { /* con_column */
81     return bld_int_temp(conColumn());
82   } /* con_column */
83 
84 
85 
con_cursor(listType arguments)86 objectType con_cursor (listType arguments)
87 
88   { /* con_cursor */
89     isit_bool(arg_2(arguments));
90     if (take_bool(arg_2(arguments)) == SYS_TRUE_OBJECT) {
91       conCursor(TRUE);
92     } else if (take_bool(arg_2(arguments)) == SYS_FALSE_OBJECT) {
93       conCursor(FALSE);
94     } else {
95       logError(printf("con_cursor(");
96                trace1(take_bool(arg_2(arguments)));
97                printf("): Value not TRUE_OBJECT or FALSE_OBJECT.\n"););
98       return raise_exception(SYS_RNG_EXCEPTION);
99     } /* if */
100     return SYS_EMPTY_OBJECT;
101   } /* con_cursor */
102 
103 
104 
105 /**
106  *  Send all buffered data of the console to its destination.
107  *  This causes data to be sent to the text console/window of the OS.
108  */
con_flush(listType arguments)109 objectType con_flush (listType arguments)
110 
111   { /* con_flush */
112     conFlush();
113     return SYS_EMPTY_OBJECT;
114   } /* con_flush */
115 
116 
117 
118 /**
119  *  Get the height of the console.
120  *  @return the height of the console.
121  */
con_height(listType arguments)122 objectType con_height (listType arguments)
123 
124   { /* con_height */
125     return bld_int_temp((intType) conHeight());
126   } /* con_height */
127 
128 
129 
con_h_scl(listType arguments)130 objectType con_h_scl (listType arguments)
131 
132   {
133     intType scroll_amount;
134 
135   /* con_h_scl */
136     isit_int(arg_2(arguments));
137     isit_int(arg_3(arguments));
138     isit_int(arg_4(arguments));
139     isit_int(arg_5(arguments));
140     isit_int(arg_6(arguments));
141     scroll_amount = take_int(arg_6(arguments));
142     if (scroll_amount >= 0) {
143       conLeftScroll(take_int(arg_2(arguments)),
144           take_int(arg_3(arguments)),
145           take_int(arg_4(arguments)),
146           take_int(arg_5(arguments)),
147           scroll_amount);
148     } else {
149       conRightScroll(take_int(arg_2(arguments)),
150           take_int(arg_3(arguments)),
151           take_int(arg_4(arguments)),
152           take_int(arg_5(arguments)),
153           -scroll_amount);
154     } /* if */
155     return SYS_EMPTY_OBJECT;
156   } /* con_h_scl */
157 
158 
159 
160 /**
161  *  Get the cursor line of the console.
162  *  @return the cursor line of the console.
163  */
con_line(listType arguments)164 objectType con_line (listType arguments)
165 
166   { /* con_line */
167     return bld_int_temp(conLine());
168   } /* con_line */
169 
170 
171 
172 /**
173  *  Initializes the console/window.
174  */
con_open(listType arguments)175 objectType con_open (listType arguments)
176 
177   { /* con_open */
178     conOpen();
179     return SYS_EMPTY_OBJECT;
180   } /* con_open */
181 
182 
183 
184 /**
185  *  Set the current position of the console to 'line' and 'column'.
186  */
con_setpos(listType arguments)187 objectType con_setpos (listType arguments)
188 
189   { /* con_setpos */
190     isit_int(arg_2(arguments));
191     isit_int(arg_3(arguments));
192     conSetpos(take_int(arg_2(arguments)), take_int(arg_3(arguments)));
193     return SYS_EMPTY_OBJECT;
194   } /* con_setpos */
195 
196 
197 
con_v_scl(listType arguments)198 objectType con_v_scl (listType arguments)
199 
200   {
201     intType scroll_amount;
202 
203   /* con_v_scl */
204     isit_int(arg_2(arguments));
205     isit_int(arg_3(arguments));
206     isit_int(arg_4(arguments));
207     isit_int(arg_5(arguments));
208     isit_int(arg_6(arguments));
209     scroll_amount = take_int(arg_6(arguments));
210     if (scroll_amount >= 0) {
211       conUpScroll(take_int(arg_2(arguments)),
212           take_int(arg_3(arguments)),
213           take_int(arg_4(arguments)),
214           take_int(arg_5(arguments)),
215           scroll_amount);
216     } else {
217       conDownScroll(take_int(arg_2(arguments)),
218           take_int(arg_3(arguments)),
219           take_int(arg_4(arguments)),
220           take_int(arg_5(arguments)),
221           -scroll_amount);
222     } /* if */
223     return SYS_EMPTY_OBJECT;
224   } /* con_v_scl */
225 
226 
227 
228 /**
229  *  Get the width of the console.
230  *  @return the width of the console.
231  */
con_width(listType arguments)232 objectType con_width (listType arguments)
233 
234   { /* con_width */
235     return bld_int_temp((intType) conWidth());
236   } /* con_width */
237 
238 
239 
240 /**
241  *  Write a string to the current position of the console.
242  *  Unicode characters are written with the encoding of the
243  *  operating system. The cursor position is changed, if
244  *  one of the characters '\n', '\r' and '\b' is written.
245  *  If the standard output file of the operating system has
246  *  been redirected UTF-8 encoded characters are written to
247  *  the redirected file.
248  */
con_write(listType arguments)249 objectType con_write (listType arguments)
250 
251   { /* con_write */
252     isit_stri(arg_2(arguments));
253     conWrite(take_stri(arg_2(arguments)));
254     return SYS_EMPTY_OBJECT;
255   } /* con_write */
256