home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / sp15demo.zip / libsrc.zip / LIBSRC / CRT.PAS < prev    next >
Pascal/Delphi Source File  |  1996-02-24  |  14KB  |  572 lines
  1. UNIT 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.  
  14. INTERFACE
  15.  
  16. CONST
  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.  
  40. VAR
  41.   CheckBreak: BOOLEAN;          { Ctrl-Break check }
  42.   CheckEOF: BOOLEAN;            { Ctrl-Z for EOF?  }
  43.   NormAttr:WORD;                { Normal text attribute}
  44.  
  45. PROCEDURE ClrScr;
  46. PROCEDURE GotoXY(X,Y:BYTE);
  47. PROCEDURE Window(X1,Y1,X2,Y2:BYTE);
  48. PROCEDURE TextColor(Color:BYTE);
  49. PROCEDURE TextBackground(Color:BYTE);
  50. FUNCTION WhereX: Byte;
  51. FUNCTION WhereY: WORD;
  52. PROCEDURE ClrEol;
  53. PROCEDURE InsLine;
  54. PROCEDURE DelLine;
  55. PROCEDURE LowVideo;
  56. PROCEDURE NormVideo;
  57. PROCEDURE HighVideo;
  58. FUNCTION KeyPressed: BOOLEAN;
  59. FUNCTION ReadKey: CHAR;
  60. PROCEDURE TextMode(Mode: Integer);
  61. PROCEDURE Delay(ms:LONGWORD);
  62. {Sound/NoSound are not implemented, they are replaced by beep in SYSTEM}
  63.  
  64. IMPLEMENTATION
  65.  
  66. {$IFDEF OS2}
  67. USES PmWin;
  68. {$ENDIF}
  69.  
  70. {$IFDEF Win95}
  71. USES WinCon,WinBase,WinUser;
  72. {$ENDIF}
  73.  
  74. PROCEDURE CrtError;
  75. VAR
  76.    cs:CSTRING;
  77.    cTitle:CSTRING;
  78. BEGIN
  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);
  90. END;
  91.  
  92.  
  93. {$IFDEF OS2}
  94. {Internal structures from BSESUB}
  95. TYPE
  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}
  130. PROCEDURE Window(X1,Y1,X2,Y2: BYTE);
  131. VAR MWindMax:WORD;
  132. begin
  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;
  153. END;
  154.  
  155. {Set cursor location}
  156. PROCEDURE GotoXY(X,Y: BYTE);
  157. BEGIN
  158.      ScreenInOut.GotoXY(X,Y);
  159. END;
  160.  
  161. {internal ANSI color set routine}
  162. PROCEDURE SetColors;
  163. VAR ColorString:STRING;
  164.     Tmp:BYTE;
  165.     Actual:LONGWORD;
  166.     Handle:LONGWORD;
  167.     ff:^FileRec;
  168.     redirected:BOOLEAN;
  169. BEGIN
  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.         PUSHL $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}
  240. END;
  241.  
  242. {Set foreground color}
  243. PROCEDURE TextColor(Color:BYTE);
  244. {$IFDEF OS2}
  245. VAR mode:VioModeInfo;
  246.     t:byte;
  247. {$ENDIF}
  248. {$IFDEF Win95}
  249. VAR t:BYTE;
  250. {$ENDIF}
  251. BEGIN
  252.   IF ApplicationType=1 THEN CrtError;
  253.  
  254.   IF Color > White THEN Color := (Color AND 15) OR 128; {Blink}
  255.   TextAttr := (TextAttr AND 112) OR Color;
  256.   SetColors;
  257. END;
  258.  
  259. {Set background color}
  260. PROCEDURE TextBackground(Color:BYTE);
  261. BEGIN
  262.   IF ApplicationType=1 THEN CrtError;
  263.   TextAttr := (TextAttr AND $8F) OR ((Color AND $07) SHL 4);
  264.   SetColors;
  265. END;
  266.  
  267. {Clear screen or window}
  268. PROCEDURE ClrScr;
  269. VAR
  270.   Fill: Word;
  271.   {$IFDEF Win95}
  272.   ff:^FileRec;
  273.   co:COORD;
  274.   Actual:LONGWORD;
  275.   {$ENDIF}
  276. BEGIN
  277.   IF ApplicationType=1 THEN CrtError;
  278.   Fill:= 32 + WORD(TextAttr) SHL 8;
  279.   {$IFDEF OS2}
  280.   VioScrollUpProc(Hi(WindMin),Lo(WindMin),
  281.                   Hi(WindMax),Lo(WindMax),
  282.                   Hi(WindMax)-Hi(WindMin)+1,Fill,0);
  283.   {$ENDIF}
  284.   {$IFDEF Win95}
  285.   ff:=@Output;
  286.   FillConsoleOutputAttribute(ff^.Handle,Char(Fill),
  287.                              (Hi(WindMin)-Lo(WindMin))*(Hi(WindMax)-Lo(WindMax)),
  288.                              LONGWORD(co),Actual);
  289.   {$ENDIF}
  290.   GotoXY(1,1);
  291. END;
  292.  
  293. {returns current cursor X position}
  294. FUNCTION WhereX: Byte;
  295. {$IFDEF Win95}
  296. VAR csbi:CONSOLE_SCREEN_BUFFER_INFO;
  297.     ff:^FileRec;
  298. {$ENDIF}
  299. BEGIN
  300.   IF ApplicationType=1 THEN CrtError;
  301.   {$IFDEF OS2}
  302.   WhereX := VioWhereXProc - Lo(WindMin);
  303.   {$ENDIF}
  304.   {$IFDEF Win95}
  305.   ff:=@Output;
  306.   GetConsoleScreenBufferInfo(ff^.Handle,csbi);
  307.   WhereX:=csbi.dwCursorPosition.X+1-Lo(WindMin);
  308.   {$ENDIF}
  309. END;
  310.  
  311. {returns current cursor Y position}
  312. FUNCTION WhereY: WORD;
  313. {$IFDEF Win95}
  314. VAR csbi:CONSOLE_SCREEN_BUFFER_INFO;
  315.     ff:^FileRec;
  316. {$ENDIF}
  317. BEGIN
  318.   IF ApplicationType=1 THEN CrtError;
  319.   {$IFDEF OS2}
  320.   WhereY:= VioWhereYProc - Hi(WindMin);
  321.   {$ENDIF}
  322.   {$IFDEF Win95}
  323.   ff:=@Output;
  324.   GetConsoleScreenBufferInfo(ff^.Handle,csbi);
  325.   WhereY:=csbi.dwCursorPosition.Y+1-Hi(WindMin);
  326.   {$ENDIF}
  327. END;
  328.  
  329. {Deletes til end of line}
  330. PROCEDURE ClrEol;
  331. VAR
  332.   Value:WORD;
  333.   Y: BYTE;
  334. BEGIN
  335.   IF ApplicationType=1 THEN CrtError;
  336.   Value := Ord(' ') + WORD(TextAttr) SHL 8;
  337.   {$IFDEF OS2}
  338.   Y:=VioWhereYProc-1;
  339.   VioScrollUpProc(Y,VioWhereXProc-1,Y,Lo(WindMax),1,Value,0);
  340.   {$ENDIF}
  341. END;
  342.  
  343. {Insert empty line}
  344. PROCEDURE InsLine;
  345. VAR
  346.    value:WORD;
  347. BEGIN
  348.   IF ApplicationType=1 THEN CrtError;
  349.   value := Ord(' ') + WORD(TextAttr) SHL 8;
  350.   {$IFDEF OS2}
  351.   VioScrollDnProc(VioWhereYProc-1,Lo(WindMin),Hi(WindMax),Lo(WindMax),1,Value,0);
  352.   {$ENDIF}
  353. END;
  354.  
  355. {Delete the current line}
  356. PROCEDURE DelLine;
  357. VAR
  358.    value:WORD;
  359. BEGIN
  360.   IF ApplicationType=1 THEN CrtError;
  361.   Value := Ord(' ') + WORD(TextAttr) SHL 8;
  362.   {$IFDEF OS2}
  363.   VioScrollUpProc(VioWhereYProc-1,Lo(WindMin),Hi(WindMax),Lo(WindMax),1,Value,0);
  364.   {$ENDIF}
  365. END;
  366.  
  367. {sets low intensity}
  368. PROCEDURE LowVideo;
  369. BEGIN
  370.   IF ApplicationType=1 THEN CrtError;
  371.   TextAttr := TextAttr AND $F7;
  372.   SetColors;
  373. END;
  374.  
  375. {sets normal intensity}
  376. PROCEDURE NormVideo;
  377. BEGIN
  378.   IF ApplicationType=1 THEN CrtError;
  379.   TextAttr := NormAttr;
  380.   SetColors;
  381. END;
  382.  
  383. {sets high intensity}
  384. PROCEDURE HighVideo;
  385. BEGIN
  386.   IF ApplicationType=1 THEN CrtError;
  387.   TextAttr := TextAttr OR $08;
  388.   SetColors;
  389. END;
  390.  
  391.  
  392. PROCEDURE InitCrt;
  393. VAR Size:WORD;
  394.     Value:WORD;
  395.     {$IFDEF Win95}
  396.     co:COORD;
  397.     ff:^FileRec;
  398.     Actual:LONGWORD;
  399.     {$ENDIF}
  400. BEGIN
  401.      Size := 2;
  402.      {$IFDEF OS2}
  403.      VioReadCellStrProc(Value, Size, WhereY-1, WhereX-1, 0);
  404.      {$ENDIF}
  405.      {$IFDEF Win95}
  406.      co.X:=1;
  407.      co.Y:=1;
  408.      ff:=@Output;
  409.      ReadConsoleOutputAttribute(ff^.Handle,Value,2,LONGWORD(co),Actual);
  410.      {$ENDIF}
  411.      NormAttr := Hi(Value) AND $7F;
  412.      TextAttr:=NormAttr;
  413.      {NormVideo;}
  414.      CheckBreak:=TRUE;
  415.      CheckEOF:=TRUE;
  416. END;
  417.  
  418. {checks if a key was pressed}
  419. FUNCTION KeyPressed: BOOLEAN;
  420. BEGIN
  421.      IF ApplicationType=1 THEN CrtError;
  422.      {$IFDEF OS2}
  423.      KeyPressed:=KeyPressedProc;
  424.      {$ENDIF}
  425. END;
  426.  
  427. {Reads a character}
  428. FUNCTION ReadKey: CHAR;
  429. {$IFDEF Win95}
  430. VAR ff:^FileRec;
  431.     ir:INPUT_RECORD;
  432.     Actual:LONGWORD;
  433. LABEL l;
  434. {$ENDIF}
  435. BEGIN
  436.      IF ApplicationType=1 THEN CrtError;
  437.      {$IFDEF OS2}
  438.      ReadKey:=ReadKeyProc;
  439.      {$ENDIF}
  440.      {$IFDEF Win95}
  441.      SetConsoleMode(ff^.Handle,ENABLE_WINDOW_INPUT);
  442.  
  443.      ff:=@Input;
  444.      REPEAT
  445.            ReadConsoleInput(ff^.Handle,ir,1,Actual);
  446.            IF ir.EventType=KEY_EVENT THEN
  447.              IF ir.Event.KeyEvent.bKeyDown THEN goto l;
  448.      UNTIL FALSE;
  449. l:
  450.      ReadKey:=ir.Event.KeyEvent.uChar.AsciiChar;
  451.      SetConsoleMode(ff^.Handle,ENABLE_PROCESSED_INPUT OR ENABLE_LINE_INPUT OR
  452.        ENABLE_ECHO_INPUT OR ENABLE_WINDOW_INPUT OR ENABLE_MOUSE_INPUT OR
  453.        ENABLE_PROCESSED_OUTPUT OR ENABLE_WRAP_AT_EOL_OUTPUT);
  454.      {$ENDIF}
  455. END;
  456.  
  457. { Set a text mode. (BW40,CO40,BW80,CO80,Mono,Font8x8}
  458. PROCEDURE TextMode(Mode: Integer);
  459. VAR
  460.    Bios: BYTE;
  461.    Value: Word;
  462.    {$IFDEF OS2}
  463.    VioMode:VIOMODEINFO;
  464.    VioConfig:VIOCONFIGINFO;
  465.    {$ENDIF}
  466. BEGIN
  467.   IF ApplicationType=1 THEN CrtError;
  468.   {$IFDEF OS2}
  469.   {Get current video mode}
  470.   VioMode.cb := SizeOf(VioModeInfo);
  471.   VioGetModeProc(VioMode, 0);
  472.  
  473.   {update LastMode}
  474.   WITH VioMode DO
  475.   BEGIN
  476.        IF Col = 40 THEN LastMode := BW40
  477.        ELSE LastMode := BW80;
  478.        IF (fbType AND 4) = 0 THEN
  479.           IF LastMode = BW40 THEN LastMode := CO40
  480.        ELSE LastMode := CO80;
  481.        IF Color = 0 THEN LastMode := Mono;
  482.        IF Row > 25 THEN Inc(LastMode,Font8x8);
  483.   END;
  484.  
  485.   TextAttr := LightGray;
  486.   Bios := Lo(Mode);
  487.   VioConfig.cb := SizeOf(VioConfigInfo);
  488.  
  489.   {Get adapter info}
  490.   VioGetConfigProc(0, VioConfig, 0);
  491.  
  492.   WITH VioMode DO
  493.   BEGIN
  494.       VRes := 400;
  495.       HRes := 720;
  496.       cb := SizeOf(VioModeInfo);
  497.       Row := 25;
  498.       Col := 80;
  499.       fbType := 1;
  500.       Color := 4;      { 16 Colors }
  501.  
  502.       IF ((Bios=BW40)OR(Bios=CO40)) THEN
  503.       BEGIN
  504.            Col := 40;
  505.            HRes := 360;
  506.       END;
  507.   END;
  508.  
  509.   IF (Mode AND Font8x8) <> 0 THEN
  510.   BEGIN
  511.        IF VioConfig.Adapter<3 THEN {Mono, CGA, EGA}
  512.        BEGIN
  513.             VioMode.VRes := 350;
  514.             VioMode.HRes := 640;
  515.             VioMode.Row := 43;
  516.        END
  517.        ELSE
  518.        BEGIN
  519.             VioMode.VRes := 400;
  520.             VioMode.HRes := 720;
  521.             VioMode.Row := 50;
  522.        END;
  523.   END;
  524.  
  525.   CASE Bios of
  526.       BW40,BW80: VioMode.fbType := 5;
  527.       MONO:
  528.       BEGIN
  529.            VioMode.HRes := 720;
  530.            VioMode.VRes := 350;
  531.            VioMode.Color := 0;
  532.            VioMode.fbType := 0;  {no colors}
  533.       END;
  534.   END; {case}
  535.  
  536.   {try to set mode}
  537.   VioSetModeProc(VioMode, 0);
  538.   {See what mode is set}
  539.   VioGetModeProc(VioMode, 0);
  540.   NormVideo;
  541.  
  542.   {Set window dimensions}
  543.   WindMin := 0;
  544.   WindMax := VioMode.Col - 1 + (VioMode.Row - 1) SHL 8;
  545.  
  546.   {Clear screen}
  547.   Value := 32 + WORD(TextAttr) SHL 8;    { Clear screen }
  548.   VioScrollUpProc(0,0,65535,65535,65535,Value,0);
  549.   {$ENDIF}
  550. END;
  551.  
  552. PROCEDURE Delay(ms:LONGWORD);
  553. BEGIN
  554.      {$IFDEF OS2}
  555.      ASM
  556.         PUSHL $ms
  557.         MOV AL,1
  558.         CALLDLL DosCalls,229  //DosSleep
  559.         ADD ESP,4
  560.      END;
  561.      {$ENDIF}
  562.      {$IFDEF Win95}
  563.      ASM
  564.         PUSHL $ms
  565.         CALLDLL Kernel32,'Sleep'
  566.      END;
  567.      {$ENDIF}
  568. END;
  569.  
  570. BEGIN
  571.      IF ApplicationType<>1 THEN InitCrt;
  572. END.