Rev 616 | Rev 643 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed
Rev | Author | Line No. | Line |
---|---|---|---|
616 | bw | 1 | {} |
2 | |||
3 | procedure OpenStdout(var f: TextRec); forward; |
||
4 | procedure WriteStdout(var f: TextRec); forward; |
||
5 | procedure CloseStdout(var f: TextRec); forward; |
||
6 | |||
7 | procedure OpenStdin(var f: TextRec); forward; |
||
8 | procedure ReadStdin(var f: TextRec); forward; |
||
9 | procedure CloseStdin(var f: TextRec); forward; |
||
10 | |||
11 | |||
12 | |||
13 | procedure AssignStdout(var f: Text); |
||
14 | begin |
||
15 | Assign(f, ''); |
||
16 | TextRec(f).OpenFunc := @OpenStdout; |
||
17 | Rewrite(f); |
||
18 | end; |
||
19 | |||
20 | procedure OpenStdout(var f: TextRec); |
||
21 | begin |
||
22 | TextRec(f).InOutFunc := @WriteStdout; |
||
23 | TextRec(f).FlushFunc := @WriteStdout; |
||
24 | TextRec(f).CloseFunc := @CloseStdout; |
||
25 | end; |
||
26 | |||
27 | procedure WriteStdout(var f: TextRec); |
||
28 | var |
||
29 | msg: String; |
||
30 | begin |
||
31 | msg := StrPas(PChar(f.bufptr)); |
||
32 | SetLength(msg, f.bufpos); |
||
33 | f.bufpos := 0; |
||
34 | Konsole.Write(msg); |
||
35 | end; |
||
36 | |||
37 | procedure CloseStdout(var f: TextRec); |
||
38 | begin |
||
39 | end; |
||
40 | |||
41 | |||
42 | |||
43 | procedure AssignStdin(var f: Text); |
||
44 | begin |
||
45 | Assign(f, ''); |
||
46 | TextRec(f).OpenFunc := @OpenStdin; |
||
47 | Reset(f); |
||
48 | end; |
||
49 | |||
50 | procedure OpenStdin(var f: TextRec); |
||
51 | begin |
||
52 | TextRec(f).InOutFunc := @ReadStdin; |
||
53 | TextRec(f).FlushFunc := nil; |
||
54 | TextRec(f).CloseFunc := @CloseStdin; |
||
55 | end; |
||
56 | |||
57 | procedure ReadStdin(var f: TextRec); |
||
58 | var |
||
59 | max, curpos: Longint; |
||
60 | c: Longint; |
||
61 | begin |
||
62 | max := f.bufsize - Length(LineEnding); |
||
63 | curpos := 0; |
||
64 | repeat |
||
65 | c := 13{l4_getc()}; |
||
66 | case c of |
||
67 | 13: |
||
68 | begin |
||
69 | {f.bufptr^[curpos] := LineEnding;} |
||
70 | Inc(curpos); |
||
71 | f.bufpos := 0; |
||
72 | f.bufend := curpos; |
||
73 | {l4_putc(Longint(LineEnding));} |
||
74 | break; |
||
75 | end; |
||
76 | 32..126: if curpos < max then |
||
77 | begin |
||
78 | f.bufptr^[curpos] := Char(c); |
||
79 | Inc(curpos); |
||
80 | {l4_putc(c);} |
||
81 | end; |
||
82 | end; |
||
83 | until False; |
||
84 | end; |
||
85 | |||
86 | procedure CloseStdin(var f: TextRec); |
||
87 | begin |
||
88 | end; |
||
89 | |||
90 | |||
91 | { TKonsole } |
||
92 | |||
93 | procedure KonsoleThreadMain(Console: PKonsole); |
||
94 | {Рабочий цикл консоли} |
||
95 | var |
||
96 | ThreadInfo: TKosThreadInfo; |
||
97 | Message: ShortString; |
||
98 | Event: DWord; |
||
99 | begin |
||
100 | kos_maskevents(ME_PAINT or ME_KEYBOARD or ME_IPC); |
||
101 | kos_threadinfo(@ThreadInfo); |
||
102 | Console^.FThreadSlot := kos_getthreadslot(ThreadInfo.ThreadID); |
||
103 | |||
104 | kos_initipc(Console^.FIPCBuffer, Console^.FIPCBufferSize); |
||
105 | |||
106 | {сразу отобразить и активировать окно} |
||
107 | Console^.Paint(); |
||
108 | {$ifndef EMULATOR} |
||
109 | kos_setactivewindow(Console^.FThreadSlot); |
||
110 | {$endif} |
||
111 | |||
112 | {готов к обработке событий} |
||
113 | Console^.FOpened := True; |
||
114 | while not Console^.FTerminate do |
||
115 | begin |
||
116 | Event := kos_getevent(); |
||
619 | bw | 117 | if not Console^.FTerminate then |
616 | bw | 118 | case Event of |
119 | SE_PAINT: Console^.Paint(); |
||
120 | SE_KEYBOARD: Console^.ProcessKeyboard(kos_getkey()); |
||
121 | SE_IPC: while Console^.ReceiveMessage(Message) do Console^.ProcessMessage(Message); |
||
122 | end; |
||
123 | end; |
||
124 | Console^.FOpened := False; |
||
125 | end; |
||
126 | |||
127 | constructor TKonsole.Init(ACaption: String); |
||
128 | const |
||
129 | IPC_SIZE = 4096; |
||
130 | var |
||
131 | ThreadInfo: TKosThreadInfo; |
||
132 | begin |
||
133 | if ACaption <> '' then |
||
134 | FCaption := ACaption else |
||
135 | begin |
||
136 | kos_threadinfo(@ThreadInfo); |
||
137 | FCaption := StrPas(ThreadInfo.AppName); |
||
138 | end; |
||
139 | SetLength(FLines, 1); |
||
140 | FLines[0] := ' '; |
||
141 | FCursor.X := 1; |
||
142 | FCursor.Y := 0; |
||
143 | FMaxLines := 150; |
||
144 | FTerminate := False; |
||
145 | FOpened := False; |
||
146 | FIPCBufferSize := SizeOf(TKosIPC) + IPC_SIZE; |
||
147 | FIPCBuffer := GetMem(FIPCBufferSize); |
||
148 | FIPCBuffer^.Lock := False; |
||
149 | FIPCBuffer^.Size := 0; |
||
150 | FThreadSlot := -1; |
||
151 | FThreadID := BeginThread(TThreadFunc(@KonsoleThreadMain), @Self); |
||
152 | if FThreadID <> 0 then |
||
619 | bw | 153 | {XXX: может зависнуть} |
154 | while not FOpened do ThreadSwitch; |
||
616 | bw | 155 | end; |
156 | |||
157 | destructor TKonsole.Done(); |
||
158 | begin |
||
159 | FTerminate := True; |
||
619 | bw | 160 | if FOpened then begin Self.Write(#0); kos_delay(01); end; |
161 | if FOpened then begin Self.Write(#0); kos_delay(10); end; |
||
162 | if FOpened then begin Self.Write(#0); kos_delay(20); end; |
||
616 | bw | 163 | if FOpened then |
164 | begin |
||
165 | FOpened := False; |
||
166 | KillThread(FThreadID); |
||
167 | end; |
||
168 | FreeMem(FIPCBuffer); |
||
169 | SetLength(FLines, 0); |
||
170 | end; |
||
171 | |||
172 | function TKonsole.ReceiveMessage(var Message: ShortString): Boolean; |
||
173 | {Извлечь первое сообщение из буфера} |
||
174 | var |
||
175 | PMsg: PKosMessage; |
||
176 | Size: Longword; |
||
177 | begin |
||
178 | if FIPCBuffer^.Size > 0 then |
||
179 | begin |
||
180 | FIPCBuffer^.Lock := True; |
||
181 | PMsg := Pointer(Longword(FIPCBuffer) + SizeOf(TKosIPC)); |
||
182 | {TODO: проверка PMsg^.SenderID} |
||
183 | {Size := PMsg^.Size; |
||
184 | Dec(FIPCBuffer^.Size, Size + SizeOf(TKosMessage)); |
||
185 | if Size > 255 then Size := 255; |
||
186 | SetLength(Message, Size); |
||
187 | Move(Pointer(Longword(PMsg) + SizeOf(TKosMessage))^, Message[1], Size); |
||
188 | if FIPCBuffer^.Size > 0 then |
||
189 | Move(Pointer(Longword(PMsg) + SizeOf(TKosMessage) + PMsg^.Size)^, PMsg^, FIPCBuffer^.Size);} |
||
190 | |||
191 | {XXX} |
||
192 | Size := FIPCBuffer^.Size; |
||
193 | Dec(FIPCBuffer^.Size, Size); |
||
194 | if Size > 255 then Size := 255; |
||
195 | SetLength(Message, Size); |
||
196 | Move(PMsg^, Message[1], Size); |
||
197 | |||
198 | Result := True; |
||
199 | end else |
||
200 | begin |
||
201 | Message := ''; |
||
202 | Result := False; |
||
203 | end; |
||
204 | |||
205 | {FIXME: если FIPCBuffer^.Size = 0, то FIPCBuffer^.Lock все равно > 0} |
||
206 | FIPCBuffer^.Lock := False; |
||
207 | end; |
||
208 | |||
209 | procedure TKonsole.ProcessMessage(Message: ShortString); |
||
210 | {Вывести сообщение на консоль} |
||
211 | var |
||
212 | S: String; |
||
213 | LinesCount: Word; |
||
214 | CR, LF, W: Word; |
||
215 | BottomRow: Boolean = True; |
||
216 | begin |
||
217 | if Length(Message) < 1 then Exit; |
||
218 | |||
219 | repeat |
||
220 | CR := Pos(#13, Message); |
||
221 | LF := Pos(#10, Message); |
||
222 | if (CR > 0) and ((CR < LF) or (LF <= 0)) then |
||
223 | W := CR else |
||
224 | if LF > 0 then |
||
225 | W := LF else |
||
226 | W := Length(Message) + 1; |
||
227 | if W > 0 then |
||
228 | begin |
||
229 | if W > 1 then |
||
230 | begin |
||
231 | S := Copy(Message, 1, W - 1); |
||
232 | Delete(FLines[FCursor.Y], FCursor.X, Length(FLines[FCursor.Y]) - FCursor.X); |
||
233 | Insert(S, FLines[FCursor.Y], FCursor.X); |
||
234 | Inc(FCursor.X, Length(S)); |
||
235 | end; |
||
236 | Delete(Message, 1, W); |
||
237 | if W = CR then |
||
238 | {перевод коретки в начало строки} |
||
239 | FCursor.X := 1 else |
||
240 | if W = LF then |
||
241 | begin |
||
242 | {перевод коретки на следующую строку} |
||
243 | BottomRow := False; |
||
244 | Inc(FCursor.Y); |
||
245 | LinesCount := Length(FLines); |
||
246 | while FCursor.Y >= FMaxLines do Dec(FCursor.Y, FMaxLines); |
||
247 | if FCursor.Y < LinesCount then FLines[FCursor.Y] := ''; |
||
248 | while FCursor.Y >= LinesCount do |
||
249 | begin |
||
250 | SetLength(FLines, LinesCount + 1); |
||
251 | FLines[LinesCount] := ''; |
||
252 | Inc(LinesCount); |
||
253 | end; |
||
254 | end; |
||
255 | end; |
||
256 | until Length(Message) <= 0; |
||
257 | |||
258 | Paint(BottomRow); |
||
259 | end; |
||
260 | |||
261 | procedure TKonsole.ProcessKeyboard(Key: Word); |
||
262 | begin |
||
263 | FKeyPressed := Key; |
||
264 | end; |
||
265 | |||
266 | function TKonsole.GetRect(): TKosRect; |
||
267 | var |
||
268 | ThreadInfo: TKosThreadInfo; |
||
269 | begin |
||
270 | kos_threadinfo(@ThreadInfo, FThreadSlot); |
||
271 | Result := ThreadInfo.WindowRect; |
||
272 | end; |
||
273 | |||
274 | function TKonsole.GetKeyPressed(): Word; |
||
275 | begin |
||
276 | Result := FKeyPressed; |
||
277 | FKeyPressed := 0; |
||
278 | end; |
||
279 | |||
280 | procedure TKonsole.Paint(BottomRow: Boolean); |
||
281 | var |
||
282 | Buffer: array[Byte] of Char; |
||
283 | Rect: TKosRect; |
||
284 | J: Longint; |
||
285 | Width, Height, Row: Longint; |
||
286 | CaptionHeight, BorderWidth, FontWidth, FontHeight: Longint; |
||
287 | begin |
||
288 | CaptionHeight := 16; |
||
289 | BorderWidth := 5; |
||
290 | FontWidth := 6; |
||
291 | FontHeight := 9; |
||
292 | |||
293 | kos_begindraw(); |
||
294 | |||
295 | if not BottomRow then |
||
296 | begin |
||
297 | {отрисовка окна} |
||
298 | kos_definewindow(60, 60, 400, 400, $63000000); |
||
299 | {вывод заголовка} |
||
300 | Move(FCaption[1], Buffer, Length(FCaption)); |
||
301 | Buffer[Length(FCaption)] := #0; |
||
302 | kos_setcaption(Buffer); |
||
303 | end; |
||
304 | |||
305 | {подготовка к выводу строк} |
||
306 | Rect := GetRect(); |
||
307 | Dec(Rect.Width, BorderWidth * 2); |
||
308 | Dec(Rect.Height, CaptionHeight + BorderWidth * 2); |
||
309 | Width := Rect.Width div FontWidth; |
||
310 | Height := Rect.Height - FontHeight; |
||
311 | Row := FCursor.Y; |
||
312 | |||
313 | while Height > 0 do |
||
314 | begin |
||
315 | {вывод одной строки} |
||
316 | J := Length(FLines[Row]); |
||
317 | if J > Width then J := Width; |
||
318 | kos_drawtext(0, Height, Copy(FLines[Row], 1, J), $00DD00, $FF000000); |
||
319 | {заливка оставшегося пространства в строке} |
||
320 | J := J * FontWidth; |
||
321 | kos_drawrect(J, Height, Rect.Width - J + 1, FontHeight, $000000); |
||
322 | {подготовка к выводу следующей строки} |
||
323 | Dec(Height, FontHeight); |
||
324 | Dec(Row); |
||
325 | if BottomRow or ((Row < 0) and (Length(FLines) < FMaxLines)) then Break; |
||
326 | while Row < 0 do Inc(Row, FMaxLines); |
||
327 | end; |
||
328 | if FCursor.X <= Width then |
||
329 | {отрисовка курсора} |
||
330 | kos_drawrect((FCursor.X - 1) * FontWidth, Rect.Height - 2, FontWidth, 2, $FFFFFF); |
||
331 | if not BottomRow then |
||
332 | {заливка оставшейся части окна} |
||
333 | kos_drawrect(0, 0, Rect.Width + 1, Height + FontHeight, $000000); |
||
334 | |||
335 | kos_enddraw(); |
||
336 | end; |
||
337 | |||
338 | procedure TKonsole.Write(Message: ShortString); |
||
339 | var |
||
340 | I: Integer; |
||
341 | begin |
||
342 | {XXX: возможна ситуация при которой сообщение не будет отправлено} |
||
343 | if FOpened then |
||
344 | begin |
||
619 | bw | 345 | I := 100; |
616 | bw | 346 | while (kos_sendmsg(FThreadID, @Message[1], Length(Message)) = 2) and (I > 0) do |
347 | begin |
||
348 | Dec(I); |
||
349 | ThreadSwitch; |
||
350 | end; |
||
351 | end; |
||
352 | end;=>>>>=>>=>>>>>> |