Oakland CPM Archive/oakcpm.iso/cpm/dskutl/swp-ms10.ark/WINDOW.UNT

Text File | 1989-09-27 | 5.3 KB | 162 lines

{.L-}  { Disable listing by program LISTT }
{*
 * --------------------------------------------------------------------
 *                      W I N D O W   U N I T
 * --------------------------------------------------------------------
 *
 * In this 'unit' a console output filter is incorporated which implements
 * a very simple window mechanism.  A window consists of a number of
 * contiguous lines on the screen which are allowed to scroll.  The lines
 * above the window as well as the lines below the window will not scroll.
 *
 *               I N T E R F A C E   S E C T I O N
 *}

{*
 * Uses CONSOLE.UNT
 *}

{
   procedure DisableWindow ;
   procedure EnableWindow ;
   procedure InitWindowUnit ;
   procedure SetWindow( TopLine, BottomLine : Integer ) ;
}

{*
 *         I M P L E M E N T A T I O N   S E C T I O N
 *}
const
{*
 * The constant WrapAround should reflect the behaviour of the console device.
 * A 'true' value should be specified if an Cr/Lf is inserted after the right-
 * most character on a line is written. A 'false' value should be specified if
 * the cursor stays at the rightmost position, even after writing additional
 * printable characters.
 *}
   WrapAround = True ;  { Wrap to next line if at end of line }

var
   WindowEnabled   : Boolean ;  { Scroll only window region }
   WindowTopLine   : Integer ;  { Ordinal of top line of window }
   WindowBottomLine: Integer ;  { Ordinal of bottom line of window }
   WindowConOutPtr : Integer ;  { Original value of ConOutPtr }

procedure DisableWindow ;
begin
   WindowEnabled:= False ;
end ;  { of DisableWindow }

procedure EnableWindow ;
begin
   WindowEnabled:= True ;
end ;  { of EnableWindow }

procedure SetWindow( TopLine, BottomLine: Integer ) ;
{*
 * Define the window.  The ordinal of the top line and the ordinal of the
 * bottom line together define the region which should scroll.  The line
 * ordinals are forced to be in the range [1..GetMaxY].  Moreover, the
 * size of the window will be at least two lines.
 *}

 function Min( I, J: Integer ) : Integer ;
 begin
    if I<J then  Min:= I
           else  Min:= J ;
 end ;  { of Min }

 function Max( I, J: Integer ) : Integer ;
 begin
    if I<J then  Max:= J
           else  Max:= I ;
 end ;  { of Max }

begin
   TopLine   := Min( Max(TopLine   , 1), Pred(GetMaxY) ) ;
   BottomLine:= Min( Max(BottomLine, 2),      GetMaxY  ) ;
   WindowTopLine   := Min( TopLine, Pred(BottomLine) ) ;
   WindowBottomLine:= Max( Succ(TopLine), BottomLine ) ;
end ;  { of SetWindow }

procedure WindowConOut( Ch : Char ) ;
{*
 * WindowConOut - Write one character to the console device through a
 *                filter, which implements a simple window mechanism.
 *
 * Turbo Pascal 3.00A contains a bug in this area.  The argument for the
 * console output routine is pushed onto the stack, WITHOUT CLEARING THE
 * UPPER BYTE.  If range checks are actived, argument Ch might be out of
 * the range [$00,$FF], resulting in run-time error 91.
 *}
const
   LineFeed      = ^J ;  { Line feed character code }
   CarriageReturn= ^M ;  { Carriage return character code }
   ConOutFunction=  3 ;  { BIOS console output function code }

 procedure ScrollWindow ;
 {*
  * Scroll the 'window' by deleting the top line of the window and inserting
  * a blank line at the bottom of the window.  The cursor position remains
  * at the same position in the TEXT.
  *
  * CAUTION : The procedures GotoXY, DelLine and InsLine generate output,
  *           which should not pass through this filter!
  *}
 var
    XPos: Integer ;  { Current cursor position, X coordinate }
    YPos: Integer ;  { Current cursor position, Y coordinate }
 begin
 {*
  * Save the current cursor position and de-install the window filter.
  *}
    XPos:= WhereX ;
    YPos:= WhereY ;
    ConOutPtr:= WindowConOutPtr ;
 {*
  * Scroll the lines within the window one line up.
  *}
    if WindowTopLine   >      1 then
     begin
      GotoXY( 1, WindowTopLine    ) ;
      DelLine ;
     end ;  { of if }
    if WindowBottomLine<GetMaxY then
     begin
      GotoXY( 1, WindowBottomLine ) ;
      InsLine ;
     end ;  { of if }
 {*
  * Restore the cursor position as well as the window filter.
  *}
    GotoXY( XPos, Pred(YPos) ) ;
    ConOutPtr:= Addr( WindowConOut ) ;
 end ;  { of ScrollWindow }

begin
   if WindowEnabled then
     if WhereY=WindowBottomLine then
       if Ch=LineFeed then
         ScrollWindow
       else
         if WrapAround then
           if WhereX=GetMaxX then
             if Ch<>CarriageReturn then
               ScrollWindow ;

   Bios( ConOutFunction, Ord(Ch) ) ;
end ;  { of MoreConOut }

procedure InitWindowUnit ;
{*
 * Preset the global variables and install the output filter.
 *}
begin
  WindowEnabled   := False ;                 { Set filter state }
  WindowTopLine   := 1 ;                     { Set window to be the .. }
  WindowBottomLine:= GetMaxY ;               {   whole screen }
  WindowConOutPtr := ConOutPtr ;             { Save ptr to original 'filter' }
  ConOutPtr       := Addr( WindowConOut ) ;  { Install output filter }
end ;  { of InitMoreUnit }
{.L+}