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