crt.pp 17 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884
  1. {
  2. This file is part of the Free Pascal run time library.
  3. Copyright (c) 1999-2000 by the Free Pascal development team.
  4. Borland Pascal 7 Compatible CRT Unit - Go32V2 implementation
  5. See the file COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************}
  11. unit crt;
  12. {$GOTO on}
  13. interface
  14. {$i crth.inc}
  15. Var
  16. ScreenWidth,
  17. ScreenHeight : word;
  18. implementation
  19. uses
  20. dos;
  21. {$ASMMODE INTEL}
  22. var
  23. DelayCnt : Longint;
  24. VidSeg : Word;
  25. {****************************************************************************
  26. Low level Routines
  27. ****************************************************************************}
  28. procedure dosmemfillword(segm, ofs: Word; count: Word; w: Word); assembler;
  29. asm
  30. mov ax, segm
  31. mov es, ax
  32. mov di, ofs
  33. mov ax, w
  34. mov cx, count
  35. rep stosw
  36. end;
  37. procedure dosmemmove(sseg, sofs, dseg, dofs: Word; count: Word); assembler;
  38. asm
  39. mov ax, dseg
  40. mov es, ax
  41. mov di, dofs
  42. mov si, sofs
  43. mov dx, count
  44. mov cx, dx
  45. mov ax, sseg
  46. push ds
  47. mov ds, ax
  48. shr cx, 1
  49. jz @@1
  50. rep movsw
  51. @@1:
  52. and dl, 1
  53. jz @@2
  54. rep movsb
  55. @@2:
  56. pop ds
  57. end;
  58. procedure setscreenmode(mode : byte);
  59. var
  60. regs : registers;
  61. begin
  62. regs.ax:=mode;
  63. intr($10,regs);
  64. end;
  65. function GetScreenHeight : word;
  66. begin
  67. getscreenheight:=mem[$40:$84]+1;
  68. If mem[$40:$84]=0 then
  69. getscreenheight := 25;
  70. end;
  71. function GetScreenWidth : word;
  72. begin
  73. getscreenwidth:=memw[$40:$4a];
  74. end;
  75. procedure SetScreenCursor(x,y : smallint);
  76. var
  77. regs : registers;
  78. begin
  79. regs.ax:=$0200;
  80. regs.bx:=0;
  81. regs.dx:=(y-1) shl 8+(x-1);
  82. intr($10,regs);
  83. end;
  84. procedure GetScreenCursor(var x,y : smallint);
  85. begin
  86. x:=mem[$40:$50]+1;
  87. y:=mem[$40:$51]+1;
  88. end;
  89. procedure DetectSnow;
  90. var
  91. regs: Registers;
  92. ega_switches: Byte;
  93. begin
  94. { the CGA snow bug exists only in 80x25 text modes. The 40x25 text modes and
  95. the graphics modes have no snow even on a true CGA. The monochrome 80x25
  96. text mode (lastmode=7) is not supported by CGA and is not snowy on every
  97. video card that support it (MDA, Hercules, EGA, VGA+) }
  98. if (lastmode<>2) and (lastmode<>3) then
  99. begin
  100. CheckSnow:=false;
  101. exit;
  102. end;
  103. { MCGA/VGA+ test }
  104. regs.ax:=$1A00;
  105. intr($10,regs);
  106. { function supported? }
  107. if regs.al=$1A then
  108. begin
  109. { at this point we have established that an MCGA or VGA+ card is present
  110. in the system. However there could still be two video cards present
  111. (i.e. an oldschool dual monitor configuration), and one of them could be
  112. a CGA, so check BL (=active display code) as well. }
  113. CheckSnow:=regs.bl=2;
  114. exit;
  115. end;
  116. { EGA test }
  117. regs.ah:=$12;
  118. regs.bx:=$FF10;
  119. intr($10,regs);
  120. { function supported? }
  121. if regs.bh<>$FF then
  122. begin
  123. ega_switches:=regs.cl and $0f;
  124. { in all the following cases a CGA card is also present and the EGA only
  125. works in monochrome mode, but we've already checked that we're not in a
  126. monochrome text mode (because lastmode<>7), so it must be the CGA
  127. currently active }
  128. CheckSnow:=(ega_switches=4) { primary CGA 40x25, secondary EGA+ 80x25 mono }
  129. or (ega_switches=5) { primary CGA 80x25, secondary EGA+ 80x25 mono }
  130. or (ega_switches=10) { primary EGA+ 80x25 mono, secondary CGA 40x25 (optional) }
  131. or (ega_switches=11); { primary EGA+ 80x25 mono, secondary CGA 80x25 (optional) }
  132. exit;
  133. end;
  134. CheckSnow:=true;
  135. end;
  136. {****************************************************************************
  137. Helper Routines
  138. ****************************************************************************}
  139. var
  140. WinMin: packed record
  141. X, Y: Byte;
  142. end absolute WindMin;
  143. WinMax: packed record
  144. X, Y: Byte;
  145. end absolute WindMax;
  146. Function FullWin:boolean;
  147. {
  148. Full Screen 80x25? Window(1,1,80,25) is used, allows faster routines
  149. }
  150. begin
  151. FullWin:=(WinMin.X=0) and (WinMin.Y=0) and
  152. (word(WinMax.X+1)=ScreenWidth) and (word(WinMax.Y+1)=ScreenHeight);
  153. end;
  154. {****************************************************************************
  155. Public Crt Functions
  156. ****************************************************************************}
  157. procedure textmode (Mode: word);
  158. var
  159. regs : registers;
  160. begin
  161. lastmode:=mode;
  162. mode:=mode and $ff;
  163. setscreenmode(mode);
  164. { set 8x8 font }
  165. if (lastmode and $100)<>0 then
  166. begin
  167. regs.ax:=$1112;
  168. regs.bx:=$0;
  169. intr($10,regs);
  170. end;
  171. screenwidth:=getscreenwidth;
  172. screenheight:=getscreenheight;
  173. windmin:=0;
  174. windmax:=(screenwidth-1) or ((screenheight-1) shl 8);
  175. DetectSnow;
  176. end;
  177. Procedure TextColor(Color: Byte);
  178. {
  179. Switch foregroundcolor
  180. }
  181. Begin
  182. TextAttr:=(Color and $f) or (TextAttr and $70);
  183. If (Color>15) Then TextAttr:=TextAttr Or Blink;
  184. End;
  185. Procedure TextBackground(Color: Byte);
  186. {
  187. Switch backgroundcolor
  188. }
  189. Begin
  190. TextAttr:=((Color shl 4) and ($f0 and not Blink)) or (TextAttr and ($0f OR Blink) );
  191. End;
  192. Procedure HighVideo;
  193. {
  194. Set highlighted output.
  195. }
  196. Begin
  197. TextColor(TextAttr Or $08);
  198. End;
  199. Procedure LowVideo;
  200. {
  201. Set normal output
  202. }
  203. Begin
  204. TextColor(TextAttr And $77);
  205. End;
  206. Procedure NormVideo;
  207. {
  208. Set normal back and foregroundcolors.
  209. }
  210. Begin
  211. TextColor(7);
  212. TextBackGround(0);
  213. End;
  214. Procedure GotoXy(X: tcrtcoord; Y: tcrtcoord);
  215. {
  216. Go to coordinates X,Y in the current window.
  217. }
  218. Begin
  219. If (X>0) and (X<=WinMax.X- WinMin.X+1) and
  220. (Y>0) and (Y<=WinMax.Y-WinMin.Y+1) Then
  221. Begin
  222. Inc(X,WinMin.X);
  223. Inc(Y,WinMin.Y);
  224. SetScreenCursor(x,y);
  225. End;
  226. End;
  227. Procedure Window(X1, Y1, X2, Y2: Byte);
  228. {
  229. Set screen window to the specified coordinates.
  230. }
  231. Begin
  232. if (X1>X2) or (word(X2)>ScreenWidth) or
  233. (Y1>Y2) or (word(Y2)>ScreenHeight) then
  234. exit;
  235. WindMin:=((Y1-1) Shl 8)+(X1-1);
  236. WindMax:=((Y2-1) Shl 8)+(X2-1);
  237. GoToXY(1,1);
  238. End;
  239. Procedure ClrScr;
  240. {
  241. Clear the current window, and set the cursor on 1,1
  242. }
  243. var
  244. fil : word;
  245. y : word;
  246. begin
  247. fil:=32 or (textattr shl 8);
  248. if FullWin then
  249. DosmemFillWord(VidSeg,0,ScreenHeight*ScreenWidth,fil)
  250. else
  251. begin
  252. for y:=WinMin.Y to WinMax.Y do
  253. DosmemFillWord(VidSeg,(y*ScreenWidth+word(WinMin.X))*2,WinMax.X-WinMin.X+1,fil);
  254. end;
  255. Gotoxy(1,1);
  256. end;
  257. Procedure ClrEol;
  258. {
  259. Clear from current position to end of line.
  260. }
  261. var
  262. x,y : smallint;
  263. fil : word;
  264. Begin
  265. GetScreenCursor(x,y);
  266. fil:=32 or (textattr shl 8);
  267. if x<=(WinMax.X+1) then
  268. DosmemFillword(VidSeg,(word(y-1)*ScreenWidth+word(x-1))*2,WinMax.X-x+2,fil);
  269. End;
  270. Function WhereX: tcrtcoord;
  271. {
  272. Return current X-position of cursor.
  273. }
  274. var
  275. x,y : smallint;
  276. Begin
  277. GetScreenCursor(x,y);
  278. WhereX:=x-WinMin.X;
  279. End;
  280. Function WhereY: tcrtcoord;
  281. {
  282. Return current Y-position of cursor.
  283. }
  284. var
  285. x,y : smallint;
  286. Begin
  287. GetScreenCursor(x,y);
  288. WhereY:=y-WinMin.Y;
  289. End;
  290. {*************************************************************************
  291. KeyBoard
  292. *************************************************************************}
  293. var
  294. keyboard_type: byte; { 0=83/84-key keyboard, $10=101/102+ keyboard }
  295. is_last : boolean;
  296. last : char;
  297. procedure DetectKeyboard;
  298. var
  299. regs: registers;
  300. begin
  301. keyboard_type:=0;
  302. if (Mem[$40:$96] and $10)<>0 then
  303. begin
  304. regs.ax:=$1200;
  305. intr($16,regs);
  306. if regs.ax<>$1200 then
  307. keyboard_type:=$10;
  308. end;
  309. end;
  310. function readkey : char;
  311. var
  312. char2 : char;
  313. char1 : char;
  314. regs : registers;
  315. begin
  316. if is_last then
  317. begin
  318. is_last:=false;
  319. readkey:=last;
  320. end
  321. else
  322. begin
  323. regs.ah:=keyboard_type;
  324. intr($16,regs);
  325. if (regs.al=$e0) and (regs.ah<>0) then
  326. regs.al:=0;
  327. char1:=chr(regs.al);
  328. char2:=chr(regs.ah);
  329. if char1=#0 then
  330. begin
  331. is_last:=true;
  332. last:=char2;
  333. end;
  334. readkey:=char1;
  335. end;
  336. end;
  337. function keypressed : boolean;
  338. var
  339. regs : registers;
  340. begin
  341. if is_last then
  342. begin
  343. keypressed:=true;
  344. exit;
  345. end
  346. else
  347. begin
  348. regs.ah:=keyboard_type+1;
  349. intr($16,regs);
  350. keypressed:=((regs.flags and fZero) = 0);
  351. end;
  352. end;
  353. {*************************************************************************
  354. Delay
  355. *************************************************************************}
  356. procedure Delayloop;assembler;nostackframe;
  357. label
  358. LDelayLoop1, LDelayLoop2;
  359. asm
  360. { input:
  361. es:di = $40:$6c
  362. bx = value of [es:dx] before the call
  363. dx:ax = counter }
  364. LDelayLoop1:
  365. sub ax, 1
  366. sbb dx, 0
  367. jc .LDelayLoop2
  368. cmp bx, word es:[di]
  369. je .LDelayLoop1
  370. LDelayLoop2:
  371. end;
  372. procedure initdelay;
  373. label
  374. LInitDel1;
  375. begin
  376. asm
  377. { for some reason, using int $31/ax=$901 doesn't work here }
  378. { and interrupts are always disabled at this point when }
  379. { running a program inside gdb(pas). Web bug 1345 (JM) }
  380. sti
  381. mov ax, $40
  382. mov es, ax
  383. mov di, $6c
  384. mov bx, es:[di]
  385. LInitDel1:
  386. cmp bx, es:[di]
  387. je LInitDel1
  388. mov bx, es:[di]
  389. mov ax, $FFFF
  390. mov dx, $FFFF
  391. call DelayLoop
  392. mov [DelayCnt], ax
  393. mov [DelayCnt + 2], dx
  394. end ['AX','BX','DX', 'DI'];
  395. DelayCnt := -DelayCnt div $55;
  396. end;
  397. procedure Delay(MS: Word);assembler;
  398. label
  399. LDelay1, LDelay2;
  400. asm
  401. mov ax, $40
  402. mov es, ax
  403. xor di, di
  404. mov cx, MS
  405. test cx, cx
  406. jz LDelay2
  407. mov si, [DelayCnt + 2]
  408. mov bx, es:[di]
  409. LDelay1:
  410. mov ax, [DelayCnt]
  411. mov dx, si
  412. call DelayLoop
  413. loop LDelay1
  414. LDelay2:
  415. end;
  416. procedure sound(hz : word);
  417. label
  418. Lsound_next;
  419. begin
  420. if hz=0 then
  421. begin
  422. nosound;
  423. exit;
  424. end;
  425. asm
  426. mov cx, hz
  427. { dx:ax = 1193046 }
  428. mov ax, $3456
  429. mov dx, $12
  430. div cx
  431. mov cx, ax
  432. in al, $61
  433. test al, 3
  434. jnz Lsound_next
  435. or al, 3
  436. out $61, al
  437. mov al, $b6
  438. out $43, al
  439. Lsound_next:
  440. mov al, cl
  441. out $42, al
  442. mov al, ch
  443. out $42, al
  444. end ['AX','CX','DX'];
  445. end;
  446. procedure nosound; assembler; nostackframe;
  447. asm
  448. in al, $61
  449. and al, $fc
  450. out $61, al
  451. end;
  452. {****************************************************************************
  453. HighLevel Crt Functions
  454. ****************************************************************************}
  455. procedure removeline(y : word);
  456. var
  457. fil : word;
  458. begin
  459. fil:=32 or (textattr shl 8);
  460. y:=WinMin.Y+y;
  461. While (y<=WinMax.Y) do
  462. begin
  463. dosmemmove(VidSeg,(y*ScreenWidth+word(WinMin.X))*2,
  464. VidSeg,((y-1)*ScreenWidth+word(WinMin.X))*2,(WinMax.X-WinMin.X+1)*2);
  465. inc(y);
  466. end;
  467. dosmemfillword(VidSeg,(word(WinMax.Y)*ScreenWidth+word(WinMin.X))*2,(WinMax.X-WinMin.X+1),fil);
  468. end;
  469. procedure delline;
  470. begin
  471. removeline(wherey);
  472. end;
  473. procedure insline;
  474. var
  475. my,y : smallint;
  476. fil : word;
  477. begin
  478. fil:=32 or (textattr shl 8);
  479. y:=WhereY;
  480. my:=WinMax.Y-WinMin.Y;
  481. while (my>=y) do
  482. begin
  483. dosmemmove(VidSeg,(word(WinMin.Y+my-1)*ScreenWidth+word(WinMin.X))*2,
  484. VidSeg,(word(WinMin.Y+my)*ScreenWidth+word(WinMin.X))*2,(WinMax.X-WinMin.X+1)*2);
  485. dec(my);
  486. end;
  487. dosmemfillword(VidSeg,(word(WinMin.Y+y-1)*ScreenWidth+word(WinMin.X))*2,(WinMax.X-WinMin.X+1),fil);
  488. end;
  489. {****************************************************************************
  490. Extra Crt Functions
  491. ****************************************************************************}
  492. procedure cursoron;
  493. var
  494. regs : registers;
  495. begin
  496. regs.ax:=$0100;
  497. If VidSeg=$b800 then
  498. regs.cx:=$0607
  499. else
  500. regs.cx:=$b0d;
  501. intr($10,regs);
  502. end;
  503. procedure cursoroff;
  504. var
  505. regs : registers;
  506. begin
  507. regs.ax:=$0100;
  508. regs.cx:=$2000;
  509. intr($10,regs);
  510. end;
  511. procedure cursorbig;
  512. var
  513. regs : registers;
  514. begin
  515. regs.ax:=$0100;
  516. regs.cx:=$0007;
  517. intr($10,regs);
  518. end;
  519. {*****************************************************************************
  520. Read and Write routines
  521. *****************************************************************************}
  522. var
  523. CurrX,CurrY : smallint;
  524. Procedure VidMemWriteWord(vidmem_offset,w: word);assembler;
  525. label
  526. in_retrace, no_retrace, no_snow, done;
  527. asm
  528. mov di, vidmem_offset
  529. xor ax, ax
  530. mov es, ax
  531. mov dx, es:[$463]
  532. add dx, 6 { DX = CRT Status Register }
  533. mov ax, VidSeg
  534. mov es, ax
  535. test CheckSnow, 1
  536. jz no_snow
  537. mov bx, w
  538. { time critical code follows }
  539. { if you ever need to change this code, make sure you test it on a real }
  540. { 4.77 MHz 8088 with an original IBM CGA card and make sure it doesn't }
  541. { produce snow }
  542. cli
  543. in_retrace:
  544. in al, dx
  545. shr al, 1
  546. jc in_retrace
  547. no_retrace:
  548. in al, dx
  549. shr al, 1
  550. jnc no_retrace
  551. xchg ax, bx
  552. stosw
  553. sti
  554. { time critical code ends here }
  555. jmp done
  556. { separate code path to avoid the unnecessary sti }
  557. no_snow:
  558. mov ax, w
  559. stosw
  560. done:
  561. end;
  562. Procedure WriteChar(c:char);
  563. var
  564. regs : registers;
  565. begin
  566. case c of
  567. #10 : inc(CurrY);
  568. #13 : CurrX:=WinMin.X+1;
  569. #8 : begin
  570. if CurrX>(WinMin.X+1) then
  571. dec(CurrX);
  572. end;
  573. #7 : begin { beep }
  574. regs.dl:=7;
  575. regs.ah:=2;
  576. intr($21,regs);
  577. end;
  578. else
  579. begin
  580. VidMemWriteWord((word(CurrY-1)*ScreenWidth+word(CurrX-1))*2,(textattr shl 8) or byte(c));
  581. inc(CurrX);
  582. end;
  583. end;
  584. if CurrX>(WinMax.X+1) then
  585. begin
  586. CurrX:=(WinMin.X+1);
  587. inc(CurrY);
  588. end;
  589. while CurrY>(WinMax.Y+1) do
  590. begin
  591. removeline(1);
  592. dec(CurrY);
  593. end;
  594. end;
  595. Procedure CrtWrite(var f : textrec);
  596. var
  597. i : smallint;
  598. begin
  599. GetScreenCursor(CurrX,CurrY);
  600. for i:=0 to f.bufpos-1 do
  601. WriteChar(f.buffer[i]);
  602. SetScreenCursor(CurrX,CurrY);
  603. f.bufpos:=0;
  604. end;
  605. Procedure CrtRead(Var F: TextRec);
  606. procedure BackSpace;
  607. begin
  608. if (f.bufpos>0) and (f.bufpos=f.bufend) then
  609. begin
  610. WriteChar(#8);
  611. WriteChar(' ');
  612. WriteChar(#8);
  613. dec(f.bufpos);
  614. dec(f.bufend);
  615. end;
  616. end;
  617. var
  618. ch : Char;
  619. Begin
  620. GetScreenCursor(CurrX,CurrY);
  621. f.bufpos:=0;
  622. f.bufend:=0;
  623. repeat
  624. if f.bufpos>f.bufend then
  625. f.bufend:=f.bufpos;
  626. SetScreenCursor(CurrX,CurrY);
  627. ch:=readkey;
  628. case ch of
  629. #0 : case readkey of
  630. #71 : while f.bufpos>0 do
  631. begin
  632. dec(f.bufpos);
  633. WriteChar(#8);
  634. end;
  635. #75 : if f.bufpos>0 then
  636. begin
  637. dec(f.bufpos);
  638. WriteChar(#8);
  639. end;
  640. #77 : if f.bufpos<f.bufend then
  641. begin
  642. WriteChar(f.bufptr^[f.bufpos]);
  643. inc(f.bufpos);
  644. end;
  645. #79 : while f.bufpos<f.bufend do
  646. begin
  647. WriteChar(f.bufptr^[f.bufpos]);
  648. inc(f.bufpos);
  649. end;
  650. end;
  651. ^S,
  652. #8 : BackSpace;
  653. ^Y,
  654. #27 : begin
  655. while f.bufpos<f.bufend do begin
  656. WriteChar(f.bufptr^[f.bufpos]);
  657. inc(f.bufpos);
  658. end;
  659. while f.bufend>0 do
  660. BackSpace;
  661. end;
  662. #13 : begin
  663. WriteChar(#13);
  664. WriteChar(#10);
  665. f.bufptr^[f.bufend]:=#13;
  666. f.bufptr^[f.bufend+1]:=#10;
  667. inc(f.bufend,2);
  668. break;
  669. end;
  670. #26 : if CheckEOF then
  671. begin
  672. f.bufptr^[f.bufend]:=#26;
  673. inc(f.bufend);
  674. break;
  675. end;
  676. else
  677. begin
  678. if f.bufpos<f.bufsize-2 then
  679. begin
  680. f.buffer[f.bufpos]:=ch;
  681. inc(f.bufpos);
  682. WriteChar(ch);
  683. end;
  684. end;
  685. end;
  686. until false;
  687. f.bufpos:=0;
  688. SetScreenCursor(CurrX,CurrY);
  689. End;
  690. Procedure CrtReturn(Var F: TextRec);
  691. Begin
  692. end;
  693. Procedure CrtClose(Var F: TextRec);
  694. Begin
  695. F.Mode:=fmClosed;
  696. End;
  697. Procedure CrtOpen(Var F: TextRec);
  698. Begin
  699. If F.Mode=fmOutput Then
  700. begin
  701. TextRec(F).InOutFunc:=@CrtWrite;
  702. TextRec(F).FlushFunc:=@CrtWrite;
  703. end
  704. Else
  705. begin
  706. F.Mode:=fmInput;
  707. TextRec(F).InOutFunc:=@CrtRead;
  708. TextRec(F).FlushFunc:=@CrtReturn;
  709. end;
  710. TextRec(F).CloseFunc:=@CrtClose;
  711. End;
  712. procedure AssignCrt(var F: Text);
  713. begin
  714. Assign(F,'');
  715. TextRec(F).OpenFunc:=@CrtOpen;
  716. end;
  717. { use the C version to avoid using dpmiexcp unit
  718. which makes sysutils and exceptions working incorrectly PM }
  719. //function __djgpp_set_ctrl_c(enable : longint) : boolean;cdecl;external;
  720. var
  721. x,y : smallint;
  722. begin
  723. { Detect keyboard type }
  724. DetectKeyboard;
  725. { Load startup values }
  726. ScreenWidth:=GetScreenWidth;
  727. ScreenHeight:=GetScreenHeight;
  728. WindMax:=(ScreenWidth-1) or ((ScreenHeight-1) shl 8);
  729. { Load TextAttr }
  730. GetScreenCursor(x,y);
  731. lastmode := mem[$40:$49];
  732. if screenheight>25 then
  733. lastmode:=lastmode or $100;
  734. DetectSnow;
  735. If not(lastmode=Mono) then
  736. VidSeg := $b800
  737. else
  738. VidSeg := $b000;
  739. TextAttr:=mem[VidSeg:(word(y-1)*ScreenWidth+word(x-1))*2+1];
  740. { Redirect the standard output }
  741. assigncrt(Output);
  742. Rewrite(Output);
  743. TextRec(Output).Handle:=StdOutputHandle;
  744. assigncrt(Input);
  745. Reset(Input);
  746. TextRec(Input).Handle:=StdInputHandle;
  747. { Calculates delay calibration }
  748. initdelay;
  749. { Enable ctrl-c input (JM) }
  750. // __djgpp_set_ctrl_c(0);
  751. end.