home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / TUR6_102.ZIP / WINDO.INC < prev   
Encoding:
Text File  |  1985-11-09  |  14.6 KB  |  368 lines
  1. {**********************************************************************}
  2. {                         W I N D O . I N C                            }
  3. {                                                                      }
  4. {**********************************************************************}
  5. {                 Kloned and Kludged by Lane Ferris                    }
  6. {                     -- The Hunters Helper --                         }
  7. {               Original Copyright 1984 by Michael A. Covington        }
  8. {               Extensive Modifications by Lynn Canning 9/25/85        }
  9. {                                          9107 Grandview Dr.          }
  10. {                                          Overland Park, Ks. 66212    }
  11. {                 1) Foreground and Background colors added.           }
  12. {                    NOTE:  Monochrome monitors are automatically set  }
  13. {                           to white on black.                         }
  14. {                 2) Multiple borders added.                           }
  15. {                 3) TimeDelay procedure added.                        }
  16. {               Requirements: IBM PC or close compatible.              }
  17. {----------------------------------------------------------------------}
  18. {                         DOCUMENTATION                                }
  19. {                        by Lynn Canning                               }
  20. {----------------------------------------------------------------------}
  21. { To make a window on the screen, call the procedure                   }
  22. {      MkWin(x1,y1,x2,y2,BD,FG,BG);                                    }
  23. {   The x and y coordinates define the window placement and are the    }
  24. {   same as the Turbo Pascal Window coordinates.                       }
  25. {   The border parameters (BD) are 0 = No border                       }
  26. {                                  1 = Single line border              }
  27. {                                  2 = Double line border              }
  28. {   The foreground (FG) and background (BG) parameters are the same    }
  29. {   values as the corresponding Turbo Pascal values.                   }
  30. {                                                                      }
  31. { The maximum number of windows open at one time is set at five        }
  32. { (see MaxWin=5).  This may be set to greater values if necessary.     }
  33. {                                                                      }
  34. { After the window is made, you must write the text desired from the   }
  35. { calling program.  Note that the usable text area is actually 1       }
  36. { position smaller than the window coordinates to allow for the border.}
  37. { Hence, a window defined as 1,1,80,25 would actually be 2,2,79,24     }
  38. { after the border is created.  When writing to the window in your     }
  39. { calling program, the textcolor and backgroundcolor may be changed as }
  40. { desired by using the standard Turbo Pascal commands.                 }
  41. {                                                                      }
  42. { To return to the previous screen or window, call the procedure       }
  43. {      RmWin;                                                          }
  44. {                                                                      }
  45. { The TimeDelay procedure is involked from your calling program.  It   }
  46. { is similar to the Turbo Pascal DELAY execpt DELAY is based on clock  }
  47. { speed whereas TimeDelay is based on the actual clock.  This means    }
  48. { that the delay will be the same duration on all systems no matter    }
  49. { what the clock speed.                                                }
  50. { The procedure could be used for an error condition as follows:       }
  51. {     MkWin          - make an error message window                    }
  52. {     Writeln        - write error message to window                   }
  53. {     TimeDelay(5)   - leave window on screen 5 seconds                }
  54. {     RmWin          - remove error window                             }
  55. {     cont processing                                                  }
  56. {----------------------------------------------------------------------}
  57.  
  58. Const
  59.  
  60.       InitDone :boolean = false ;      { Initialization switch   }
  61.  
  62.       On     = True ;
  63.       Off    = False ;
  64.       VideoEnable = $08;               { Video Signal Enable Bit }
  65.  
  66. Type
  67.      Imagetype  = array [1..4000] of char;  { Screen Image in the heap    }
  68.      WinDimtype = record
  69.                     x1,y1,x2,y2: integer
  70.                   end;
  71.  
  72.      Screens    = record              { Save Screen Information     }
  73.                    Image: Imagetype;  { Saved screen Image }
  74.                    Dim:   WinDimtype; { Saved Window Dimensions }
  75.                    x,y:   integer;    { Saved cursor position }
  76.                   end;
  77.  
  78.  
  79.  Var
  80.  
  81.   Win:                                { Global variable package }
  82.     record
  83.       Dim:    WinDimtype;             { Current Window Dimensions }
  84.       Depth:  integer;
  85.                    { MaxWin should be included in your program }
  86.                    { and it should be the number of windows saved }
  87.                    { at one time }
  88.                    { It should be in the const section of your program }
  89.       Stack:  array[1..MaxWin] of ^Screens;
  90.  
  91.     end;
  92.  
  93.   Crtmode     :byte      absolute $0040:$0049;
  94.   Crtwidth    :byte      absolute $0040:$004A;
  95.   Monobuffer  :Imagetype absolute $B000:$0000;
  96.   Colorbuffer :Imagetype absolute $B800:$0000;
  97.   CrtAdapter  :integer   absolute $0040:$0063; { Current Display Adapter }
  98.   VideoMode   :byte      absolute $0040:$0065; { Video Port Mode byte    }
  99.   Video_Buffer:integer;                        { Record the current Video}
  100.   FG          :byte;
  101.   BG          :integer;
  102.   BD          :integer;
  103.   Switch      :boolean;
  104.   Delta,
  105.   Xtemp,Ytemp :integer;
  106.   x,y         :integer;
  107.  
  108. {------------------------------------------------------------------}
  109. {                     Delay for  X seconds                         }
  110. {------------------------------------------------------------------}
  111.  
  112. procedure TimeDelay (hold : integer);
  113. type
  114.   RegRec =                                { The data to pass to DOS }
  115.     record
  116.       AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags : Integer;
  117.     end;
  118. var
  119.   regs:regrec;
  120.   ah, al, ch, cl, dh:byte;
  121.   sec               :string[2];
  122.   tmptime, result, secn, error, secn2, diff :integer;
  123.  
  124. begin
  125.   ah := $2c;
  126.   with regs do
  127.   begin
  128.     ax := ah shl 8 + al;
  129.   end;
  130.   intr($21,regs);
  131.   with regs do
  132.   begin
  133.     str(dx shr 8:2, sec);
  134.   end;
  135.   if (sec[1] = ' ') then
  136.     sec[1]:= '0';
  137.   val(sec, secn, error);
  138.   repeat                           { stay in this loop until the time }
  139.      ah := $2c;                    { has expired }
  140.      with regs do
  141.      begin
  142.         ax := ah shl 8 + al;
  143.      end;
  144.      intr($21,regs);
  145.      with regs do
  146.      begin
  147.         str(dx shr 8:2, sec);
  148.      end;
  149.      if (sec[1] = ' ') then
  150.         sec[1]:= '0';
  151.      val(sec, secn2, error);
  152.      diff := secn2 - secn;
  153.      if diff < 0 then            { we just went over the minute }
  154.         diff := diff + 60;       { so add 60 seconds }
  155.   until diff > hold;             { has our time expired yet }
  156. end; { procedure TimeDelay }
  157.  
  158. {------------------------------------------------------------------}
  159. {          Get Absolute postion of Cursor into parameters x,y      }
  160. {------------------------------------------------------------------}
  161. Procedure Get_Abs_Cursor (var x,y :integer);
  162.   Var
  163.       Active_Page  : byte absolute $0040:$0062;  { Current Video Page Index}
  164.       Crt_Pages    : array[0..7] of integer absolute $0040:$0050 ;
  165.  
  166.    Begin
  167.  
  168.       X := Crt_Pages[active_page];     { Get Cursor Position       }
  169.       Y := Hi(X)+1;                    { Y get Row                 }
  170.       X := Lo(X)+1;                    { X gets Col position       }
  171.    End;
  172. {------------------------------------------------------------------}
  173. {          Turn the Video On/Off to avoid Read/Write snow          }
  174. {------------------------------------------------------------------}
  175. Procedure Video (Switch:boolean);
  176.    Begin
  177.       If (Switch = Off) then
  178.       Port[CrtAdapter+4] := (VideoMode - VideoEnable)
  179.       else Port[CrtAdapter+4] := (VideoMode or VideoEnable);
  180.    End;
  181. {------------------------------------------------------------------}
  182. {     InitWin Saves the Current (whole) Screen                     }
  183. {------------------------------------------------------------------}
  184. Procedure InitWin;
  185.   { Records Initial Window Dimensions }
  186.    Begin
  187.  
  188.       If CrtMode = 7 then
  189.       Video_Buffer := $B000            {Set Ptr to Monobuffer      }
  190.       else Video_Buffer := $B800;      { or Color Buffer          }
  191.  
  192.      with Win.Dim do
  193.        begin x1:=1; y1:=1; x2:=crtwidth; y2:=25 end;
  194.      Win.Depth:=0;
  195.      InitDone := True ;                    { Show initialization Done }
  196. end;
  197. {------------------------------------------------------------------}
  198. {       BoxWin Draws a Box around the current Window               }
  199. {------------------------------------------------------------------}
  200. procedure BoxWin(x1,y1,x2,y2:integer; BD:integer; FG:integer; BG:integer);
  201.  
  202.   { Draws a box, fills it with blanks, and makes it the current }
  203.   { Window.  Dimensions given are for the box; actual Window is }
  204.   { one unit smaller in each direction.                         }
  205.  
  206. var
  207.     x,y,I      : integer;
  208.     TB,SID,TLC,TRC,BLC,BRC   :integer;
  209.  
  210. begin
  211.   if Crtmode = 7 then begin
  212.     FG := 7;
  213.     BG := 0;
  214.     end;
  215.   Window(x1,y1,x2,y2);
  216.   TextColor(FG) ;
  217.   TextBackground(BG);
  218.   if BD = 1 then begin
  219.     TB  := 196;
  220.     SID := 179;
  221.     TLC := 218;
  222.     TRC := 191;
  223.     BLC := 192;
  224.     BRC := 217;
  225.     end
  226.   else begin
  227.     TB  := 205;
  228.     SID := 186;
  229.     TLC := 201;
  230.     TRC := 187;
  231.     BLC := 200;
  232.     BRC := 188;
  233.     end;
  234.   if BD <> 0 then begin
  235.   { Top }
  236.   gotoxy(1,1);                       { Windo Origin        }
  237.   Write( chr(TLC) );                 { Top Left Corner     }
  238.   For I:=2 to x2-x1   do             { Top Bar             }
  239.      Write( chr(TB));
  240.   Write( chr(TRC) );                 { Top Right Corner
  241.  
  242.   { Sides  }
  243.   for I:=2 to y2-y1 do
  244.     begin
  245.       gotoxy(1,I);                   { Left Side Bar       }
  246.       write( chr(SID) );
  247.       gotoxy(x2-x1+1,I) ;            { Right Side Bar      }
  248.       write( chr(SID) );
  249.     end;
  250.  
  251.   { Bottom }
  252.   gotoxy(1,y2-y1+1);                   { Bottom Left Corner }
  253.   write( chr(BLC) );
  254.   for I:=2 to x2-x1   do               { Bottom Bar         }
  255.      write( chr(TB) );
  256.  
  257.   { Make it the current Window }
  258.   Window(x1+1,y1+1,x2-1,y2-1);
  259.   write( chr(BRC) );                 { Bottom Right Corner }
  260.   end;
  261.   gotoxy(1,1) ;
  262.   TextColor( FG mod 16);          { Take Low nibble 0..15  }
  263.   TextBackground (BG);    { Take High nibble  0..9 }
  264.   ClrScr;
  265. end;
  266. {------------------------------------------------------------------}
  267. {       MkWin   Make a Window                                      }
  268. {------------------------------------------------------------------}
  269. procedure MkWin(x1,y1,x2,y2 :integer; BD:integer; FG:byte; BG:integer);
  270.   { Create a removable Window }
  271.  
  272. begin
  273.  
  274.   If (InitDone = false) then              { Initialize if not done yet }
  275.       InitWin;
  276.  
  277.   with Win do Depth:=Depth+1;              { Increment Stack pointer }
  278.   if Win.Depth>maxWin then
  279.     begin
  280.       writeln(^G,' Windows nested too deep ');
  281.       halt
  282.     end;
  283.                 {-------------------------------------}
  284.                 {       Save contents of screen       }
  285.                 {-------------------------------------}
  286.   Video(Off) ;                          { Turn off Video to avoid Snow  }
  287.  
  288.   With Win do
  289.     Begin
  290.     New(Stack[Depth]);                  { Allocate Current Screen to Heap }
  291.     If CrtMode = 7 then
  292.     Stack[Depth]^.Image := monobuffer   { set pointer to it      }
  293.     else
  294.     Stack[Depth]^.Image := colorbuffer ;
  295.     End ;
  296.  
  297.     Video(On) ;                           { Turn the Video back on        }
  298.  
  299.   With Win do
  300.      Begin                                { Save Screen Dimentions        }
  301.      Stack[Depth]^.Dim := Dim;
  302.      Stack[Win.Depth]^.x  := wherex;      { Save Cursor Position          }
  303.      Stack[Win.Depth]^.y  := wherey;
  304.      End ;
  305.  
  306.                                           { Validate the Window Placement}
  307.   If (X2 > 80) then                       { If off right of screen       }
  308.           begin
  309.           Delta := (X2 - 80);             { Overflow off right margin    }
  310.           X1 := X1 - Delta ;              { Move Left window edge        }
  311.           X2 := X2 - Delta ;              { Move Right edge on 80        }
  312.           end;
  313.   If (Y2 > 25) then                       { If off bottom   screen       }
  314.           begin
  315.           Delta := Y2 - 25;               { Overflow off right margin    }
  316.           Y1 := Y1 - Delta ;              { Move Top edge up             }
  317.           Y2 := Y2 - Delta ;              { Move Bottom  24              }
  318.           end;
  319.                                           { Create the Window New window }
  320.   BoxWin(x1,y1,x2,y2,BD,FG,BG);
  321.   Win.Dim.x1 := x1+1;
  322.   Win.Dim.y1 := y1+1;                     { Allow for margins }
  323.   Win.Dim.x2 := x2-1;
  324.   Win.Dim.y2 := y2-1;
  325.  
  326. end;
  327. {------------------------------------------------------------------}
  328. {     Remove Window                                                }
  329. {------------------------------------------------------------------}
  330.   { Remove the most recently created removable Window }
  331.   { Restore screen contents, Window Dimensions, and   }
  332.   { position of cursor.  }
  333. Procedure RmWin;
  334.   Var
  335.     Tempbyte : byte;
  336.  
  337.    Begin
  338.    Video(Off);
  339.  
  340.    With Win do
  341.       Begin                                { Restore next Screen       }
  342.       If crtmode = 7 then
  343.       monobuffer := Stack[Depth]^.Image
  344.       else
  345.       colorbuffer := Stack[Depth]^.Image;
  346.       Dispose(Stack[Depth]);                { Remove Screen from Heap   }
  347.  
  348.    Video(On);
  349.  
  350.    With Win do                              { Re-instate the Sub-Window }
  351.     Begin                                   { Position the old cursor   }
  352.       Dim := Stack[Depth]^.Dim;
  353.       Window(Dim.x1,Dim.y1,Dim.x2,Dim.y2);
  354.       gotoxy(Stack[Depth]^.x,Stack[Depth]^.y);
  355.     end;
  356.  
  357.       Get_Abs_Cursor(x,y) ;          { New Cursor Position       }
  358.       Tempbyte :=                    { Get old Cursor attributes }
  359.            Mem[ Video_Buffer:((x-1 + (y-1) * 80 ) * 2)+1 ];
  360.  
  361.       TextColor( Tempbyte And $0F );        { Take Low nibble  0..15}
  362.       TextBackground ( Tempbyte Div 16);   { Take High nibble  0..9 }
  363.       Depth := Depth - 1
  364.     end ;
  365. end;
  366. {------------------------------------------------------------------}
  367. {------------------------------------------------------------------}
  368.