home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS - Coast to Coast / simteldosarchivecoasttocoast.iso / pcmag / vol6n20.zip / PROFIL.ZIP / SCREEN.PRF < prev   
Text File  |  1987-01-11  |  8KB  |  185 lines
  1. { These procedures handle the screen display.  Attribute, EGAInstalled, }
  2. { GetVideoMode, and FastWrite are by Brian Foley, and are available in  }
  3. { DL4 as FASTWR.PAS.                                                    }
  4.  
  5. const
  6.   BlankLine = '                                                                                ' ;
  7.  
  8. var
  9.   BaseOfScreen   : integer ;
  10.   WaitForRetrace : boolean ;
  11.   TextAttr,
  12.   EmphAttr       : byte ;
  13.  
  14. function Attribute(Foreground, Background : Byte) : Byte;
  15.   {-Translates foreground and background colors into video attributes.
  16.     "And 127" masks out the blink bit. Add 128 to the result to set it.}
  17. begin
  18.    Attribute := ((Background Shl 4) + Foreground) And 127;
  19. end;
  20.  
  21. function EgaInstalled : Boolean;
  22.   {-Test for presence of the EGA. I have little idea how this works, but
  23.     it does.}
  24. begin
  25. Inline(
  26.   $B8/$00/$12      {      MOV AX,$1200}
  27.   /$BB/$10/$00     {      MOV BX,$10}
  28.   /$B9/$FF/$FF     {      MOV CX,$FFFF}
  29.   /$CD/$10         {      INT $10}
  30.   /$31/$C0         {      XOR AX,AX}
  31.   /$81/$F9/$FF/$FF {      CMP CX,$FFFF}
  32.   /$74/$01         {      JE DONE}
  33.   /$40             {      INC AX}
  34.   /$88/$46/$04     {DONE: MOV [BP+$04],AL}
  35. );
  36. end;
  37.  
  38. procedure GetVideoMode;
  39.   {-Video mode of 7 indicates mono display; all other modes are for color
  40.     displays. This routine MUST be called before any of the screen writing
  41.     routines are used!}
  42. var
  43.      Mode : Integer;
  44. begin
  45.      Inline(
  46.        $B4/$0F        {MOV AH,$F}
  47.        /$CD/$10       {INT $10}
  48.        /$30/$E4       {XOR AH,AH}
  49.        /$89/$46/<Mode {MOV [BP+<Mode],AX}
  50.      );
  51.      IF Mode = 7 then BaseOfScreen := $B000  { Mono }
  52.                  else BaseOfScreen := $B800; { Color }
  53.      WaitForRetrace := (BaseOfScreen = $B800) And Not EgaInstalled;
  54.      { If WaitForRetrace is True, you may want to allow the user to decide
  55.        whether to forego snow prevention in favor of faster screen updates.
  56.        *VERY IMPORTANT*  WaitForRetrace MUST be false if BaseOfScreen = $B000. }
  57. end;
  58.  
  59. procedure FastWrite( St : String80; Row, Col, Attr : Byte );
  60.   {-Write St directly to video memory, without snow.}
  61. begin
  62. Inline(
  63.   $1E                    {         PUSH DS                  ;Save DS}
  64.   /$31/$C0               {         XOR AX,AX                ;AX = 0}
  65.   /$88/$C1               {         MOV CL,AL                ;CL = 0}
  66.   /$8A/$AE/>Row          {         MOV CH,[BP+>Row]         ;CX = Row * 256}
  67.   /$FE/$CD               {         DEC CH                   ;Row to 0..24 range}
  68.   /$D1/$E9               {         SHR CX,1                 ;CX = Row * 128}
  69.   /$89/$CF               {         MOV DI,CX                ;Store in DI}
  70.   /$D1/$EF               {         SHR DI,1                 ;DI = Row * 64}
  71.   /$D1/$EF               {         SHR DI,1                 ;DI = Row * 32}
  72.   /$01/$CF               {         ADD DI,CX                ;DI = (Row * 160)}
  73.   /$8B/$8E/>Col          {         MOV CX,[BP+>Col]         ;CX = Column}
  74.   /$49                   {         DEC CX                   ;Col to 0..79 range}
  75.   /$D1/$E1               {         SHL CX,1                 ;Account for attribute bytes}
  76.   /$01/$CF               {         ADD DI,CX                ;DI = (Row * 160) + (Col * 2)}
  77.   /$8E/$06/>BaseOfScreen {         MOV ES,[>BaseOfScreen]   ;ES:DI points to Base:Row,Col}
  78.   /$8A/$0E/>WaitForRetrace{        MOV CL,[>WaitForRetrace] ;Grab this before changing DS}
  79.   /$8C/$D2               {         MOV DX,SS                ;Move SS...}
  80.   /$8E/$DA               {         MOV DS,DX                ; into DS}
  81.   /$8D/$B6/>St           {         LEA SI,[BP+>St]          ;DS:SI points to St[0]}
  82.   /$FC                   {         CLD                      ;Set direction to forward}
  83.   /$AC                   {         LODSB                    ;AX = Length(St); DS:SI -> St[1]}
  84.   /$91                   {         XCHG AX,CX               ;CX = Length; AL = Wait}
  85.   /$E3/$29               {         JCXZ Exit                ;If string empty, Exit}
  86.   /$8A/$A6/>Attr         {         MOV AH,[BP+>Attr]        ;AH = Attribute}
  87.   /$D0/$D8               {         RCR AL,1                 ;If WaitForRetrace is False...}
  88.   /$73/$1D               {         JNC NoWait               ; use NoWait routine}
  89.   /$BA/$DA/$03           {         MOV DX,$03DA             ;Point DX to CGA status port}
  90.   /$AC                   {Next:    LODSB                    ;Load next character into AL}
  91.                          {                                  ; AH already has Attr}
  92.   /$89/$C3               {         MOV BX,AX                ;Store video word in BX}
  93.   /$FA                   {         CLI                      ;No interrupts now}
  94.   /$EC                   {WaitNoH: IN AL,DX                 ;Get 6845 status}
  95.   /$A8/$08               {         TEST AL,8                ;Check for vertical retrace}
  96.   /$75/$09               {         JNZ Store                ; In progress? go}
  97.   /$D0/$D8               {         RCR AL,1                 ;Else, wait for end of}
  98.   /$72/$F7               {         JC WaitNoH               ; horizontal retrace}
  99.   /$EC                   {WaitH:   IN AL,DX                 ;Get 6845 status again}
  100.   /$D0/$D8               {         RCR AL,1                 ;Wait for horizontal}
  101.   /$73/$FB               {         JNC WaitH                ; retrace}
  102.   /$89/$D8               {Store:   MOV AX,BX                ;Move word back to AX...}
  103.   /$AB                   {         STOSW                    ; and then to screen}
  104.   /$FB                   {         STI                      ;Allow interrupts}
  105.   /$E2/$E8               {         LOOP Next                ;Get next character}
  106.   /$EB/$04               {         JMP SHORT Exit           ;Done}
  107.   /$AC                   {NoWait:  LODSB                    ;Load next character into AL}
  108.                          {                                  ; AH already has Attr}
  109.   /$AB                   {         STOSW                    ;Move video word into place}
  110.   /$E2/$FC               {         LOOP NoWait              ;Get next character}
  111.   /$1F                   {Exit:    POP DS                   ;Restore DS}
  112. );
  113. end;
  114.  
  115. procedure HideCursor ; { hide the DOS cursor by putting it below the screen }
  116. var
  117.    Registers : record
  118.                  case integer of
  119.                    1 : ( ax,bx,cx,dx,bp,si,di,ds,es,flags : integer ) ;
  120.                    2 : ( al,ah,bl,bh,cl,ch,dl,dh : byte ) ;
  121.                  end;
  122. begin
  123.   Registers.dh := 25 ; { row to move cursor to }
  124.   Registers.dl := 0 ;  { column to move cursor to }
  125.   Registers.bh := 0 ;  { screen page }
  126.   Registers.ah := 2 ;  { function identifier }
  127.   intr( $10, Registers ) ; { do it }
  128. end; { procedure HideCursor  }
  129.  
  130. procedure ClearScreen ;
  131. var
  132.   Line : integer ;
  133. begin
  134.   for Line := 1 to 25 do
  135.     FastWrite( BlankLine, Line, 1, TextAttr ) ;
  136.   HideCursor ;
  137. end; { procedure ClearScreen  }
  138.  
  139. procedure SetupScreen ;
  140. var
  141.   ch : char ;
  142. begin
  143.   GetVideoMode ;
  144.  
  145. { Take care of snow elimination }
  146.   if WaitForRetrace then
  147.   begin
  148.     Write( 'Does your screen generate snow? ' ) ;
  149.     Read( KBD, ch ) ;
  150.     WaitForRetrace := (UpCase(ch) <> 'N' ) ;
  151.   end;
  152.  
  153. { Set display attributes }
  154.   if BaseOfScreen = $B000 then
  155.   begin
  156.     TextAttr := Attribute( White, Black ) ;
  157.     EmphAttr := Attribute( Black, White ) ;
  158.   end
  159.   else
  160.   begin
  161.     TextAttr := Attribute( Yellow, Blue ) ;
  162.     EmphAttr := Attribute( White, Blue ) ;
  163.     GraphBackground( Blue ) ;
  164.   end; { if }
  165.   ClearScreen ;
  166. end; { procedure SetupScreen  }
  167.  
  168. procedure DrawProfileScreen ;
  169. begin
  170.   ClearScreen ;
  171.   FastWrite( 'Execution Profiler', 1, 31, EmphAttr ) ;
  172.   FastWrite( Copyright, 2, 23, EmphAttr ) ;
  173. end; { procedure DrawProfileScreen  }
  174.  
  175. procedure DrawWarningScreen ;
  176. begin
  177.   ClearScreen ;
  178.   FastWrite( 'WARNING:', 5, 36, EmphAttr ) ;
  179.   FastWrite( 'This program only works on the IBM PC and close compatibles.', 7, 10, EmphAttr ) ;
  180.   FastWrite( 'If you do not have the right machine, this program might', 8, 12, Emphattr ) ;
  181.   FastWrite( 'crash your system.', 9, 31, Emphattr ) ;
  182.   FastWrite( 'Do you wish to continue? (y or n)', 11, 23, TextAttr ) ;
  183.   GotoXY( 57, 11 );
  184. end;
  185.