home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / INSTX210.ZIP / NWINDO.200 < prev    next >
Encoding:
Text File  |  1985-09-08  |  13.3 KB  |  320 lines
  1. {**********************************************************************}
  2. {*             N W I N D O . 2 0 0     :  New Windos Procedures       *}
  3. {*                                                                    *}
  4. {*                  Separate this into File NWINDO.200                *}
  5. {**********************************************************************}
  6. {                 Kloned and Kludged by Lane.H.Ferris                  }
  7. {                     -- The Hunters Helper --                         }
  8. {               Original ideas by Michael A. Covington                 }
  9. {               Requirements: IBM PC or close compatible.              }
  10. {----------------------------------------------------------------------}
  11.  
  12. Const
  13.       MaxWin = 4;       { maximum number of Windows open at once }
  14.       InitDone :boolean = false ;      { Initialization switch   }
  15.  
  16.       On     = True ;
  17.       Off    = False ;
  18.       VideoEnable = $08;               { Video Signal Enable Bit }
  19.       Black  :byte = 0;                { Video Color Attributes  }
  20.       Blue   :byte = 1;
  21.       Green  :byte = 2;
  22.       Cyan   :byte = 3;
  23.       Red    :byte = 4;
  24.       Magenta:byte = 5;
  25.       Yellow :byte = 6;
  26.       White  :byte = 7;
  27.       Bright :byte = 8;
  28.       Blink  :byte = 16;
  29.       BackGround : byte = 16 ;
  30.  
  31. Type
  32.      Imagetype  = array [1..4000] of char;  { Screen Image in the heap    }
  33.      WinDimtype = record
  34.                     x1,y1,x2,y2: integer
  35.                   end;
  36.  
  37.      Screens    = record              { Save Screen Information     }
  38.                    Image: Imagetype;  { Saved screen Image }
  39.                    Dim:   WinDimtype; { Saved Window Dimensions }
  40.                    x,y:   integer;    { Saved cursor position }
  41.                   end;
  42.  
  43.  
  44.  Var
  45.  
  46.   Win:                                { Global variable package }
  47.     record
  48.       Dim:    WinDimtype;             { Current Window Dimensions }
  49.       Depth:  integer;
  50.       Stack:  array[1..maxWin] of ^Screens;
  51.  
  52.     end;
  53.  
  54.   Crtmode     :byte      absolute $0040:$0049;
  55.   Crtwidth    :byte      absolute $0040:$004A;
  56.   Monobuffer  :Imagetype absolute $B000:$0000;
  57.   Colorbuffer :Imagetype absolute $B800:$0000;
  58.   CrtAdapter  :integer   absolute $0040:$0063; { Current Display Adapter }
  59.   VideoMode   :byte      absolute $0040:$0065; { Video Port Mode byte    }
  60.   Video_Buffer:integer;                        { Record the current Video}
  61.   Attr        :byte;
  62.   Switch      :boolean;
  63.   Delta,
  64.   Xtemp,Ytemp :integer;
  65.  
  66. {------------------------------------------------------------------}
  67. {          Get Absolute postion of Cursor into parameters x,y      }
  68. {------------------------------------------------------------------}
  69. Procedure Get_Abs_Cursor (var x,y :integer);
  70.   Var
  71.       Active_Page  : byte absolute $0040:$0062;  { Current Video Page Index}
  72.       Crt_Pages    : array[0..7] of integer absolute $0040:$0050 ;
  73.  
  74.    Begin
  75.  
  76.       X := Crt_Pages[active_page];     { Get Cursor Position       }
  77.       Y := Hi(X)+1;                    { Y get Row                 }
  78.       X := Lo(X)+1;                    { X gets Col position       }
  79.    End;
  80. {----------------------------------------------------------------------}
  81. {      G e t _ A b s _ A t t r  : Get current Text Attributes          }
  82. {----------------------------------------------------------------------}
  83. Procedure  Get_Abs_Attr(Var Byteval:byte);{ Get current text attribute }
  84.    Begin                             { keeping the textcolor. Not the  }
  85.       Get_Abs_Cursor(x,y) ;          { compiler colors.                }
  86.       Byteval :=                     { Get old Cursor attributes }
  87.            Mem[ Video_Buffer:((x-1 + (y-1) * 80 ) * 2)+1 ] ;
  88.    End; { Get_Abs_Attr }
  89. {----------------------------------------------------------------------}
  90. {      L o w V i d e o :   Set Low intensity on Screen                 }
  91. {----------------------------------------------------------------------}
  92. Procedure  LowVideo;                 { Change to Low Video intensity   }
  93.   Var
  94.    Byteval :byte;
  95.    Begin                             { keeping the textcolor. Not the  }
  96.       Get_Abs_Cursor(x,y) ;          { compiler colors.                }
  97.       Byteval :=                     { Get old Cursor attributes }
  98.            Mem[ Video_Buffer:((x-1 + (y-1) * 80 ) * 2)+1 ] ;
  99.       TextColor(Byteval And $07);   { Take Low nibble 0..15  }
  100.    End; { Low Video }
  101. {----------------------------------------------------------------------}
  102. {      N o r m V i d e o :   Set Low intensity on Screen               }
  103. {----------------------------------------------------------------------}
  104. Procedure  NormVideo;                { Change to Low Video intensity   }
  105.   Var
  106.    Byteval :byte;
  107.    Begin                             { keeping the textcolor. Not the  }
  108.       Get_Abs_Cursor(x,y) ;          { compiler colors.                }
  109.       Byteval :=                       { Get old Cursor attributes }
  110.            Mem[ Video_Buffer:((x-1 + (y-1) * 80 ) * 2)+1 ] ;
  111.       TextColor((Byteval and $0F) Or Bright); { Take Low nibble 0..15  }
  112.    End; { Low Video }
  113. {----------------------------------------------------------------------}
  114. {      R e v e r s e V i d e o :   Set Low intensity on Screen         }
  115. {----------------------------------------------------------------------}
  116. Procedure  ReverseVideo;                { Change to Low Video intensity   }
  117.   Var
  118.    Byteval :byte;
  119.    Begin                             { keeping the textcolor. Not the  }
  120.       Get_Abs_Cursor(x,y) ;          { compiler colors.                }
  121.       Byteval :=                       { Get old Cursor attributes }
  122.            Mem[ Video_Buffer:((x-1 + (y-1) * 80 ) * 2)+1 ] ;
  123.                                              { Take high nibble 0..15  }
  124.       TextColor((Byteval div 16) or (Byteval and $08));
  125.       TextBackground(Byteval mod 16);        {  Take low nibble       }
  126.    End; { Low Video }
  127.  
  128. {------------------------------------------------------------------}
  129. {          Turn the Video On/Off to avoid Read/Write snow          }
  130. {------------------------------------------------------------------}
  131. Procedure Video (Switch:boolean);
  132.    Begin
  133.       If (Switch = Off) then
  134.       Port[CrtAdapter+4] := (VideoMode - VideoEnable)
  135.       else Port[CrtAdapter+4] := (VideoMode or VideoEnable);
  136.    End;
  137. {----------------------------------------------------------------------}
  138. {      B l i n k :  Turn the Video Blink Attribute On or Off           }
  139. {----------------------------------------------------------------------}
  140. Procedure BlinkChar(OnOff :boolean);   { Blink at cursor On|Off        }
  141.   Var
  142.     Byteval :byte;
  143.   Begin                                { keeping the textcolor. Not the}
  144.   Get_Abs_Cursor(x,y) ;             { compiler colors.              }
  145.   Byteval :=                        { Get old Cursor attributes     }
  146.         Mem[ Video_Buffer:((x-1 + (y-1) * 80 ) * 2)+1 ] ;
  147.   If (OnOff)
  148.       then Byteval := Byteval Or $80    { Turn Blink On             }
  149.       else Byteval := Byteval And $7F;  { Turn blink Off            }
  150.   Mem[Video_Buffer:((x-1+(y-1)*80)*2)+1] := Byteval;
  151.   End; {Procedure Blink }
  152. {------------------------------------------------------------------}
  153. {     InitWin Saves the Current (whole) Screen                     }
  154. {------------------------------------------------------------------}
  155. Procedure InitWin;
  156.   { Records Initial Window Dimensions }
  157.    Begin
  158.  
  159.       If CrtMode = 7 then
  160.       Video_Buffer := $B000            {Set Ptr to Monobuffer      }
  161.       else Video_Buffer := $B800;      { or Color Buffer          }
  162.  
  163.      with Win.Dim do
  164.        begin x1:=1; y1:=1; x2:=crtwidth; y2:=25 end;
  165.      Win.Depth:=0;
  166.      InitDone := True ;                    { Show initialization Done }
  167. end;
  168. {------------------------------------------------------------------}
  169. {       BoxWin Draws a Box around the current Window               }
  170. {------------------------------------------------------------------}
  171. procedure BoxWin(x1,y1,x2,y2:integer; Attr:byte);
  172.  
  173.   { Draws a box, fills it with blanks, and makes it the current }
  174.   { Window.  Dimensions given are for the box; actual Window is }
  175.   { one unit smaller in each direction.                         }
  176.   { This routine can be used separately from the rest of the    }
  177.   { removable Window package.                                   }
  178.  
  179. var
  180.     x,y      : integer;
  181.  
  182. begin
  183.   Window(1,1,80,25);
  184.   TextColor((Attr Mod 16) or Bright) ;
  185.   TextBackground(Attr Div 16);
  186.  
  187.   { Top }
  188.   gotoxy(x1,y1);                     { Windo Origin        }
  189.   Write( chr(213) );                 { Top Left Corner     }
  190.   For x:=x1+1 to x2-1 do             { Top Bar             }
  191.      Write( chr(205));
  192.   Write( chr(184) );                 { Top Right Corner
  193.  
  194.   { Sides  }
  195.   for y:=y1+1 to y2-1 do
  196.     begin
  197.       gotoxy(x1,y);                  { Left Side Bar       }
  198.       write( chr(179) );
  199.       gotoxy(X2,y) ;                 { Right Side Bar      }
  200.       write( chr(179) );
  201.     end;
  202.  
  203.   { Bottom }
  204.   gotoxy(x1,y2);                     { Bottom Left Corner }
  205.   write( chr(212) );
  206.   for x:=x1+1 to x2-1 do             { Bottom Bar         }
  207.      write( chr(205) );
  208.   write( chr(190) );                 { Bottom Right Corner }
  209.  
  210.   { Make it the current Window }
  211.   Window(x1+1,y1+1,x2-1,y2-1);
  212.   gotoxy(1,1) ;
  213.   TextColor( Attr mod 16);          { Take Low nibble 0..15  }
  214.   TextBackground ( Attr Div 16);    { Take High nibble  0..9 }
  215.   ClrScr;
  216. end;
  217. {------------------------------------------------------------------}
  218. {       MkWin   Make a Window                                      }
  219. {------------------------------------------------------------------}
  220. procedure MkWin(x1,y1,x2,y2 :integer; attr :byte);
  221.   { Create a removable Window }
  222.  
  223. begin
  224.  
  225.   If (InitDone = false) then              { Initialize if not done yet }
  226.       InitWin;
  227.  
  228.   with Win do Depth:=Depth+1;              { Increment Stack pointer }
  229.   if Win.Depth>maxWin then
  230.     begin
  231.       writeln(^G,' Windows nested too deep ');
  232.       halt
  233.     end;
  234.                 {-------------------------------------}
  235.                 {       Save contents of screen       }
  236.                 {-------------------------------------}
  237.   Video(Off) ;                          { Turn off Video to avoid Snow  }
  238.  
  239.   With Win do
  240.     Begin
  241.     New(Stack[Depth]);                  { Allocate Current Screen to Heap }
  242.     If CrtMode = 7 then
  243.     Stack[Depth]^.Image := monobuffer   { set pointer to it      }
  244.     else
  245.     Stack[Depth]^.Image := colorbuffer ;
  246.     End ;
  247.  
  248.     Video(On) ;                           { Turn the Video back on        }
  249.  
  250.   With Win do
  251.      Begin                                { Save Screen Dimentions        }
  252.      Stack[Depth]^.Dim := Dim;
  253.      Stack[Win.Depth]^.x  := wherex;      { Save Cursor Position          }
  254.      Stack[Win.Depth]^.y  := wherey;
  255.      End ;
  256.  
  257.                                           { Validate the Window Placement}
  258.   If (X2 > 80) then                       { If off right of screen       }
  259.           begin
  260.           Delta := X2 - 80;               { Overflow off right margin    }
  261.           X1 := X1 - Delta;               { Move Left window edge        }
  262.           X2 := X2 - Delta;               { Move Right edge on 80        }
  263.           end;
  264.   If (Y2 > 24) then                       { If off bottom   screen       }
  265.           begin
  266.           Delta := Y2 - 24;               { Overflow off right margin    }
  267.           Y1 := Y1 - Delta ;              { Move Top edge up             }
  268.           Y2 := Y2 - Delta ;              { Move Bottom  24              }
  269.           end;
  270.   If (X1 < 1) then X1 := 1;               { Validate left side of window }
  271.   If (Y1 < 1) then Y1 := 1;
  272.  
  273.   BoxWin(x1,y1,x2,y2,Attr);               { Create the New window }
  274.   Win.Dim.x1 := x1+1;
  275.   Win.Dim.y1 := y1+1;                     { Allow for margins }
  276.   Win.Dim.x2 := x2-1;
  277.   Win.Dim.y2 := y2-1;
  278.  
  279. end;
  280. {------------------------------------------------------------------}
  281. {     Remove Window                                                }
  282. {------------------------------------------------------------------}
  283.   { Remove the most recently created removable Window }
  284.   { Restore screen contents, Window Dimensions, and   }
  285.   { position of cursor.  }
  286. Procedure RmWin;
  287.   Var
  288.     Tempbyte : byte;
  289.  
  290.    Begin
  291.    Video(Off);
  292.  
  293.    With Win do
  294.       Begin                                { Restore next Screen       }
  295.       If crtmode = 7 then
  296.       monobuffer := Stack[Depth]^.Image
  297.       else
  298.       colorbuffer := Stack[Depth]^.Image;
  299.       Dispose(Stack[Depth]);                { Remove Screen from Heap   }
  300.  
  301.    Video(On);
  302.  
  303.    With Win do                              { Re-instate the Sub-Window }
  304.     Begin                                   { Position the old cursor   }
  305.       Dim := Stack[Depth]^.Dim;
  306.       Window(Dim.x1,Dim.y1,Dim.x2,Dim.y2);
  307.       gotoxy(Stack[Depth]^.x,Stack[Depth]^.y);
  308.     end;
  309.  
  310.       Get_Abs_Cursor(x,y) ;          { New Cursor Position       }
  311.       Tempbyte :=                    { Get old Cursor attributes }
  312.            Mem[ Video_Buffer:((x-1 + (y-1) * 80 ) * 2)+1 ];
  313.  
  314.       TextColor( Tempbyte And $0F );        { Take Low nibble  0..15}
  315.       TextBackground ( Tempbyte Div 16);   { Take High nibble  0..9 }
  316.       Depth := Depth - 1
  317.     end ;
  318. end;
  319. {......................................................................}
  320.