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