source: trunk/Sibyl/RTL/CRT.PAS@ 201

Last change on this file since 201 was 8, checked in by RBRi, 19 years ago

+ rest of sibyl stuff
  • Property svn:eol-style set to native
File size: 13.9 KB
Line 
1UNIT CRT;
2
3{***************************************************************************
4 * Speed-Pascal/2 V 2.0 *
5 * *
6 * CRT Standard Unit *
7 * *
8 * (C) 1995 SpeedSoft. All rights reserved. *
9 * *
10 * Note: Some constants/variables moved to SYSTEM *
11 * *
12 ***************************************************************************}
13
14INTERFACE
15
16CONST
17 {Foreground and background color constants}
18 Black = 0;
19 Blue = 1;
20 Green = 2;
21 Cyan = 3;
22 Red = 4;
23 Magenta = 5;
24 Brown = 6;
25 LightGray = 7;
26
27 {Foreground color constants}
28 DarkGray = 8;
29 LightBlue = 9;
30 LightGreen = 10;
31 LightCyan = 11;
32 LightRed = 12;
33 LightMagenta = 13;
34 Yellow = 14;
35 White = 15;
36
37 {Add-in for blinking}
38 Blink = 128;
39
40VAR
41 CheckBreak: BOOLEAN; { Ctrl-Break check }
42 CheckEOF: BOOLEAN; { Ctrl-Z for EOF? }
43 NormAttr:WORD; { Normal text attribute}
44
45PROCEDURE ClrScr;
46PROCEDURE GotoXY(X,Y:BYTE);
47PROCEDURE Window(X1,Y1,X2,Y2:BYTE);
48PROCEDURE TextColor(Color:BYTE);
49PROCEDURE TextBackground(Color:BYTE);
50FUNCTION WhereX: Byte;
51FUNCTION WhereY: WORD;
52PROCEDURE ClrEol;
53PROCEDURE InsLine;
54PROCEDURE DelLine;
55PROCEDURE LowVideo;
56PROCEDURE NormVideo;
57PROCEDURE HighVideo;
58FUNCTION KeyPressed: BOOLEAN;
59FUNCTION ReadKey: CHAR;
60PROCEDURE TextMode(Mode: Integer);
61PROCEDURE Delay(ms:LONGWORD);
62{Sound/NoSound are not implemented, they are replaced by beep in SYSTEM}
63
64IMPLEMENTATION
65
66{$IFDEF OS2}
67USES PmWin;
68{$ENDIF}
69
70{$IFDEF Win95}
71USES WinCon,WinBase,WinUser;
72{$ENDIF}
73
74PROCEDURE CrtError;
75VAR
76 cs:CSTRING;
77 cTitle:CSTRING;
78BEGIN
79 ctitle:='Wrong linker target';
80 cs:='PM Linker mode does not support text screen IO.'+#13+
81 'Use the unit WinCrt if you wish to use text'+#13+
82 'screen IO inside PM applications.';
83 {$IFDEF OS2}
84 WinMessageBox(1,1,cs,ctitle,0,$4000 OR $0010);
85 {$ENDIF}
86 {$IFDEF Win95}
87 MessageBox(0,cs,ctitle,0);
88 {$ENDIF}
89 Halt(0);
90END;
91
92
93{$IFDEF OS2}
94{Internal structures from BSESUB}
95TYPE
96 VIOMODEINFO=RECORD {pack 1}
97 cb:WORD;
98 fbType:BYTE;
99 color:BYTE;
100 col:WORD;
101 row:WORD;
102 hres:WORD;
103 vres:WORD;
104 fmt_ID:BYTE;
105 attrib:BYTE;
106 buf_addr:LONGWORD;
107 buf_length:LONGWORD;
108 full_length:LONGWORD;
109 partial_length:LONGWORD;
110 ext_data_addr:POINTER;
111 END;
112
113 VIOCONFIGINFO=RECORD {pack 2}
114 cb:WORD;
115 adapter:WORD;
116 display:WORD;
117 cbMemory:LONGWORD;
118 Configuration:WORD;
119 VDHVersion:WORD;
120 Flags:WORD;
121 HWBufferSize:LONGWORD;
122 FullSaveSize:LONGWORD;
123 PartSaveSize:LONGWORD;
124 EMAdaptersOFF:WORD;
125 EMDisplaysOFF:WORD;
126 END;
127{$ENDIF}
128
129{Define a text window}
130PROCEDURE Window(X1,Y1,X2,Y2: BYTE);
131VAR MWindMax:WORD;
132begin
133 ASM
134 MOV AX,SYSTEM.MaxWindMax
135 MOV MWindMax,AX
136 END;
137 IF X1<=X2 THEN IF Y1<=Y2 THEN
138 BEGIN
139 Dec(X1);
140 Dec(Y1);
141 IF X1>=0 THEN IF Y1>=0 THEN
142 BEGIN
143 Dec(Y2);
144 Dec(X2);
145 IF X2<lo(MWindMax)+1 THEN IF Y2<Hi(MWindMax)+1 THEN
146 BEGIN
147 WindMin := X1 + WORD(Y1) SHL 8;
148 WindMax := X2 + WORD(Y2) SHL 8;
149 GotoXY(1,1);
150 END;
151 END;
152 END;
153END;
154
155{Set cursor location}
156PROCEDURE GotoXY(X,Y: BYTE);
157BEGIN
158 ScreenInOut.GotoXY(X,Y);
159END;
160
161{internal ANSI color set routine}
162PROCEDURE SetColors;
163VAR ColorString:STRING;
164 Tmp:BYTE;
165 Actual:LONGWORD;
166 Handle:LONGWORD;
167 ff:^FileRec;
168 redirected:BOOLEAN;
169BEGIN
170 ASM
171 MOV AL,SYSTEM.Redirect
172 MOV redirected,AL
173 END;
174
175 IF Redirected THEN exit;
176
177 ff:=@Output;
178 Handle:=ff^.Handle;
179
180 Colorstring:=#27+'[0'; {Reset colors and attributes to black/white}
181 IF TextAttr>127 THEN {IF bit 7 set (blink}
182 Colorstring:=ColorString+';5'; {blink}
183
184 {Set background colors}
185 Tmp:=TextAttr AND 112 ; {Clear bits 7,0 to 3 }
186 Tmp:=Tmp SHR 4; {Adjust position to reflect bgcolor}
187 Tmp:=Tmp AND 7;
188 CASE Tmp OF
189 Black : Tmp:=40; {Values differ from CLR_ constants!}
190 Blue : Tmp:=44;
191 Green : Tmp:=42;
192 Cyan : Tmp:=46;
193 Red : Tmp:=41;
194 Magenta : Tmp:=45;
195 Brown : Tmp:=43; {Yellow with in lower set!}
196 Lightgray: Tmp:=47;
197 END;
198 Colorstring:=Colorstring+';'+tostr(Tmp);
199
200 {Now set forefround...}
201 Tmp:=TextAttr AND 15 ; {Clear bits 4 to 7 }
202 IF Tmp>7 THEN {Is bold character}
203 BEGIN
204 Colorstring:=Colorstring+';1'; {High colors}
205 DEC(Tmp,8);
206 END;
207
208 Tmp:=Tmp AND 7;
209 CASE Tmp OF
210 Black : Tmp:=30;
211 Blue : Tmp:=34;
212 Green : Tmp:=32;
213 Cyan : Tmp:=36;
214 Red : Tmp:=31;
215 Magenta : Tmp:=35;
216 Brown : Tmp:=33; {yellow with in lower set!}
217 Lightgray: Tmp:=37;
218 END;
219
220 Colorstring:=Colorstring+';'+tostr(Tmp)+'m';
221
222 {$IFDEF OS2}
223 ASM
224 LEA EAX,Actual
225 PUSH EAX //pcbActual
226 LEA EDI,ColorString
227 MOVZXB EAX,[EDI]
228 PUSH EAX //cbWrite
229 INC EDI
230 PUSH EDI //pBuffer
231 PUSH DWORD PTR Handle //FileHandle
232 MOV AL,4
233 CALLDLL DosCalls,282 //DosWrite
234 ADD ESP,16
235 END;
236 {$ENDIF}
237 {$IFDEF Win95}
238 WriteFile(ff^.Handle,ColorString[1],length(ColorString),actual,NIL);
239 {$ENDIF}
240END;
241
242{Set foreground color}
243PROCEDURE TextColor(Color:BYTE);
244BEGIN
245 IF ApplicationType=1 THEN CrtError;
246
247 IF Color > White THEN Color := (Color AND 15) OR 128; {Blink}
248 TextAttr := (TextAttr AND 112) OR Color;
249 SetColors;
250END;
251
252{Set background color}
253PROCEDURE TextBackground(Color:BYTE);
254BEGIN
255 IF ApplicationType=1 THEN CrtError;
256 TextAttr := (TextAttr AND $8F) OR ((Color AND $07) SHL 4);
257 SetColors;
258END;
259
260{Clear screen or window}
261PROCEDURE ClrScr;
262VAR
263 Fill: Word;
264 {$IFDEF Win95}
265 ff:^FileRec;
266 co:COORD;
267 Actual:LONGWORD;
268 {$ENDIF}
269BEGIN
270 IF ApplicationType=1 THEN CrtError;
271 {$IFDEF OS2}
272 Fill:= 32 + WORD(TextAttr) SHL 8;
273 VioScrollUpProc(Hi(WindMin),Lo(WindMin),
274 Hi(WindMax),Lo(WindMax),
275 Hi(WindMax)-Hi(WindMin)+1,Fill,0);
276 {$ENDIF}
277 {$IFDEF Win95}
278 Fill:= TextAttr;
279 ff:=@Output;
280 co.x:=Lo(WindMin);
281 co.y:=Hi(WindMin);
282 FillConsoleOutputAttribute(ff^.Handle,Fill,
283 (Hi(WindMax)-Hi(WindMin))*(Lo(WindMax)-Lo(WindMin)),
284 LONGWORD(co),Actual);
285 FillConsoleOutputCharacter(ff^.Handle,' ',
286 (Hi(WindMax)-Hi(WindMin))*(Lo(WindMax)-Lo(WindMin)),
287 LONGWORD(co),Actual);
288 {$ENDIF}
289 GotoXY(1,1);
290END;
291
292{returns current cursor X position}
293FUNCTION WhereX: Byte;
294{$IFDEF Win95}
295VAR csbi:CONSOLE_SCREEN_BUFFER_INFO;
296 ff:^FileRec;
297{$ENDIF}
298BEGIN
299 IF ApplicationType=1 THEN CrtError;
300 {$IFDEF OS2}
301 WhereX := VioWhereXProc - Lo(WindMin);
302 {$ENDIF}
303 {$IFDEF Win95}
304 ff:=@Output;
305 GetConsoleScreenBufferInfo(ff^.Handle,csbi);
306 WhereX:=csbi.dwCursorPosition.X+1-Lo(WindMin);
307 {$ENDIF}
308END;
309
310{returns current cursor Y position}
311FUNCTION WhereY: WORD;
312{$IFDEF Win95}
313VAR csbi:CONSOLE_SCREEN_BUFFER_INFO;
314 ff:^FileRec;
315{$ENDIF}
316BEGIN
317 IF ApplicationType=1 THEN CrtError;
318 {$IFDEF OS2}
319 WhereY:= VioWhereYProc - Hi(WindMin);
320 {$ENDIF}
321 {$IFDEF Win95}
322 ff:=@Output;
323 GetConsoleScreenBufferInfo(ff^.Handle,csbi);
324 WhereY:=csbi.dwCursorPosition.Y+1-Hi(WindMin);
325 {$ENDIF}
326END;
327
328{Deletes til end of line}
329PROCEDURE ClrEol;
330VAR
331 Value:WORD;
332 Y: BYTE;
333BEGIN
334 IF ApplicationType=1 THEN CrtError;
335 Value := Ord(' ') + WORD(TextAttr) SHL 8;
336 {$IFDEF OS2}
337 Y:=VioWhereYProc-1;
338 VioScrollUpProc(Y,VioWhereXProc-1,Y,Lo(WindMax),1,Value,0);
339 {$ENDIF}
340END;
341
342{Insert empty line}
343PROCEDURE InsLine;
344VAR
345 value:WORD;
346BEGIN
347 IF ApplicationType=1 THEN CrtError;
348 value := Ord(' ') + WORD(TextAttr) SHL 8;
349 {$IFDEF OS2}
350 VioScrollDnProc(VioWhereYProc-1,Lo(WindMin),Hi(WindMax),Lo(WindMax),1,Value,0);
351 {$ENDIF}
352END;
353
354{Delete the current line}
355PROCEDURE DelLine;
356VAR
357 value:WORD;
358BEGIN
359 IF ApplicationType=1 THEN CrtError;
360 Value := Ord(' ') + WORD(TextAttr) SHL 8;
361 {$IFDEF OS2}
362 VioScrollUpProc(VioWhereYProc-1,Lo(WindMin),Hi(WindMax),Lo(WindMax),1,Value,0);
363 {$ENDIF}
364END;
365
366{sets low intensity}
367PROCEDURE LowVideo;
368BEGIN
369 IF ApplicationType=1 THEN CrtError;
370 TextAttr := TextAttr AND $F7;
371 SetColors;
372END;
373
374{sets normal intensity}
375PROCEDURE NormVideo;
376BEGIN
377 IF ApplicationType=1 THEN CrtError;
378 TextAttr := NormAttr;
379 SetColors;
380END;
381
382{sets high intensity}
383PROCEDURE HighVideo;
384BEGIN
385 IF ApplicationType=1 THEN CrtError;
386 TextAttr := TextAttr OR $08;
387 SetColors;
388END;
389
390
391PROCEDURE InitCrt;
392VAR Size:WORD;
393 Value:WORD;
394 {$IFDEF Win95}
395 co:COORD;
396 ff:^FileRec;
397 Actual:LONGWORD;
398 {$ENDIF}
399BEGIN
400 Size := 2;
401 {$IFDEF OS2}
402 VioReadCellStrProc(Value, Size, WhereY-1, WhereX-1, 0);
403 {$ENDIF}
404 {$IFDEF Win95}
405 co.X:=1;
406 co.Y:=1;
407 ff:=@Output;
408 ReadConsoleOutputAttribute(ff^.Handle,Value,2,LONGWORD(co),Actual);
409 {$ENDIF}
410 NormAttr := Hi(Value) AND $7F;
411 TextAttr:=NormAttr;
412 {NormVideo;}
413 CheckBreak:=TRUE;
414 CheckEOF:=TRUE;
415END;
416
417{checks if a key was pressed}
418FUNCTION KeyPressed: BOOLEAN;
419{$IFDEF Win95}
420VAR ff:^FileRec;
421 ir:INPUT_RECORD;
422 Actual:LONGWORD;
423{$ENDIF}
424BEGIN
425 IF ApplicationType=1 THEN CrtError;
426 {$IFDEF OS2}
427 KeyPressed:=KeyPressedProc;
428 {$ENDIF}
429 {$IFDEF Win95}
430 ff:=@Input;
431
432 SetConsoleMode(ff^.Handle,ENABLE_WINDOW_INPUT);
433
434 result:=FALSE;
435 PeekConsoleInput(ff^.Handle,ir,1,Actual);
436 IF ir.EventType=KEY_EVENT THEN
437 IF ir.Event.KeyEvent.bKeyDown THEN result:=TRUE;
438
439 SetConsoleMode(ff^.Handle,ENABLE_PROCESSED_INPUT OR ENABLE_LINE_INPUT OR
440 ENABLE_ECHO_INPUT OR ENABLE_WINDOW_INPUT OR ENABLE_MOUSE_INPUT OR
441 ENABLE_PROCESSED_OUTPUT OR ENABLE_WRAP_AT_EOL_OUTPUT);
442 {$ENDIF}
443END;
444
445{Reads a character}
446FUNCTION ReadKey: CHAR;
447{$IFDEF Win95}
448VAR ff:^FileRec;
449 ir:INPUT_RECORD;
450 Actual:LONGWORD;
451LABEL l;
452{$ENDIF}
453BEGIN
454 IF ApplicationType=1 THEN CrtError;
455 {$IFDEF OS2}
456 ReadKey:=ReadKeyProc;
457 {$ENDIF}
458 {$IFDEF Win95}
459 ff:=@Input;
460
461 SetConsoleMode(ff^.Handle,ENABLE_WINDOW_INPUT);
462
463 REPEAT
464 ReadConsoleInput(ff^.Handle,ir,1,Actual);
465 IF ir.EventType=KEY_EVENT THEN
466 IF ir.Event.KeyEvent.bKeyDown THEN goto l;
467 UNTIL FALSE;
468l:
469 ReadKey:=ir.Event.KeyEvent.uChar.AsciiChar;
470 SetConsoleMode(ff^.Handle,ENABLE_PROCESSED_INPUT OR ENABLE_LINE_INPUT OR
471 ENABLE_ECHO_INPUT OR ENABLE_WINDOW_INPUT OR ENABLE_MOUSE_INPUT OR
472 ENABLE_PROCESSED_OUTPUT OR ENABLE_WRAP_AT_EOL_OUTPUT);
473 {$ENDIF}
474END;
475
476{ Set a text mode. (BW40,CO40,BW80,CO80,Mono,Font8x8}
477PROCEDURE TextMode(Mode: Integer);
478VAR
479 Bios: BYTE;
480 Value: Word;
481 {$IFDEF OS2}
482 VioMode:VIOMODEINFO;
483 VioConfig:VIOCONFIGINFO;
484 {$ENDIF}
485BEGIN
486 IF ApplicationType=1 THEN CrtError;
487 {$IFDEF OS2}
488 {Get current video mode}
489 VioMode.cb := SizeOf(VioModeInfo);
490 VioGetModeProc(VioMode, 0);
491
492 {update LastMode}
493 WITH VioMode DO
494 BEGIN
495 IF Col = 40 THEN LastMode := BW40
496 ELSE LastMode := BW80;
497 IF (fbType AND 4) = 0 THEN
498 IF LastMode = BW40 THEN LastMode := CO40
499 ELSE LastMode := CO80;
500 IF Color = 0 THEN LastMode := Mono;
501 IF Row > 25 THEN Inc(LastMode,Font8x8);
502 END;
503
504 TextAttr := LightGray;
505 Bios := Lo(Mode);
506 VioConfig.cb := SizeOf(VioConfigInfo);
507
508 {Get adapter info}
509 VioGetConfigProc(0, VioConfig, 0);
510
511 WITH VioMode DO
512 BEGIN
513 VRes := 400;
514 HRes := 720;
515 cb := SizeOf(VioModeInfo);
516 Row := 25;
517 Col := 80;
518 fbType := 1;
519 Color := 4; { 16 Colors }
520
521 IF ((Bios=BW40)OR(Bios=CO40)) THEN
522 BEGIN
523 Col := 40;
524 HRes := 360;
525 END;
526 END;
527
528 IF (Mode AND Font8x8) <> 0 THEN
529 BEGIN
530 IF VioConfig.Adapter<3 THEN {Mono, CGA, EGA}
531 BEGIN
532 VioMode.VRes := 350;
533 VioMode.HRes := 640;
534 VioMode.Row := 43;
535 END
536 ELSE
537 BEGIN
538 VioMode.VRes := 400;
539 VioMode.HRes := 720;
540 VioMode.Row := 50;
541 END;
542 END;
543
544 CASE Bios of
545 BW40,BW80: VioMode.fbType := 5;
546 MONO:
547 BEGIN
548 VioMode.HRes := 720;
549 VioMode.VRes := 350;
550 VioMode.Color := 0;
551 VioMode.fbType := 0; {no colors}
552 END;
553 END; {case}
554
555 {try to set mode}
556 VioSetModeProc(VioMode, 0);
557 {See what mode is set}
558 VioGetModeProc(VioMode, 0);
559 NormVideo;
560
561 {Set window dimensions}
562 WindMin := 0;
563 WindMax := VioMode.Col - 1 + (VioMode.Row - 1) SHL 8;
564
565 {Clear screen}
566 Value := 32 + WORD(TextAttr) SHL 8; { Clear screen }
567 VioScrollUpProc(0,0,65535,65535,65535,Value,0);
568 {$ENDIF}
569END;
570
571PROCEDURE Delay(ms:LONGWORD);
572BEGIN
573 {$IFDEF OS2}
574 IF ApplicationType<>1 THEN
575 ASM
576 PUSH DWORD PTR ms
577 MOV AL,1
578 CALLDLL DosCalls,229 //DosSleep
579 ADD ESP,4
580 END;
581 {$ENDIF}
582 {$IFDEF Win95}
583 ASM
584 PUSH DWORD PTR ms
585 CALLDLL Kernel32,'Sleep'
586 END;
587 {$ENDIF}
588END;
589
590BEGIN
591 IF ApplicationType<>1 THEN InitCrt;
592END.
Note: See TracBrowser for help on using the repository browser.