home *** CD-ROM | disk | FTP | other *** search
/ HAM Radio 3 / hamradioversion3.0examsandprograms1992.iso / mods / pk232src / sss_pwin.pas < prev    next >
Pascal/Delphi Source File  |  1986-09-09  |  10KB  |  266 lines
  1.     {----------------------------------------------------------------------}
  2.     {   Pop-up window subroutines of the Split-Screen Server (SSS)         }
  3.     {----------------------------------------------------------------------}
  4.     {                                                                      }
  5.     {  Author:  form SIG disks                                             }
  6.     {                                                                      }
  7.     {  Modified (adapted) by HB9CVV                                        }
  8.     {                                                                      }
  9.     {----------------------------------------------------------------------}
  10.  
  11.  
  12.     { PTWSet  (Screen#, X1, Y1, X2, Y2, BorderSwitch, BackgroundColor,     }
  13.     {          ForegroundColor)                                            }
  14.  
  15.     { Sets up window coordinates so that later references can be made by   }
  16.     { Mnemonic only. PTWSet must be done once for each window before it is }
  17.     { Opened. The Screen# is a number between 1 and the maximum number of  }
  18.     { windows allowable set in the Constants Block below. The X and Y      }
  19.     { Coordinates are the same as for the Turbo Pascal Window procedure.   }
  20.     { A border may be placed around the window and the size of the window  }
  21.     { will be decreased to fit inside the border. The BorderSwitch         }
  22.     { functions are:    0 - No border                                      }
  23.     {                   1 - Single line block graphics border              }
  24.     {                   2 - Double line block graphics border              }
  25.     {                  -1 - Single line Reversed color border              }
  26.     {                  -2 - Double line Reversed color border              }
  27.     { The BackgroundColor and ForegroundColor parameters are the same as   }
  28.     { for the Turbo Pascal TextColor and TextBackground procedures.        }
  29.  
  30.     { PTWOpen (Screen#)                                                    }
  31.  
  32.     { Activates a window (previously set by PTWSet) and saves the screen   }
  33.     { covered by the window. In the Constants Block following, there is a  }
  34.     { parameter that sets the maximum number of windows that may be open   }
  35.     { at any one time.                                                     }
  36.  
  37.     { PTWClose                                                             }
  38.  
  39.     { De-activates the open window, activates the previous window and      }
  40.     { restores the screen covered by the closed window. Note that the      }
  41.     { PTWOpen & PTWClose have a "Push/Pop" type of action.                 }
  42.  
  43.  
  44.     { Constant Values (Parameters) That must be included in the source pgm  }
  45.     {                                                                       }
  46.     {  CONST PTOOLWIN_Number_of_Windows = nn;                               }
  47.     {                                                                       }
  48.     { This determines the number of windows that may be set with the PTWSet }
  49.     { procedure.This also determines the maximum number of windows that may }
  50.     { be open at any one time. Use the greater of the two.                  }
  51.  
  52.  
  53.     { Areas for internal use Begin Here *********************************** }
  54.  
  55.   TYPE
  56.  
  57.     PTOOLWIN_Set_Info = RECORD
  58.                            PTOOLWIN_X1 : Integer;
  59.                            PTOOLWIN_Y1 : Integer;
  60.                            PTOOLWIN_X2 : Integer;
  61.                            PTOOLWIN_Y2 : Integer;
  62.                            PTOOLWIN_Border : Integer;
  63.                            PTOOLWIN_Back : Integer;
  64.                            PTOOLWIN_Fore : Integer;
  65.                          END;
  66.  
  67.     PTOOLWIN_Stacks = ARRAY[1..25] OF STRING[160];
  68.  
  69.  
  70.   CONST
  71.     PTOOLWIN_Screen_Type : Char = 'X';  {Initial value neither 'M' or 'C', LP}
  72.  
  73.  
  74.   VAR
  75.  
  76.     PTOOLWIN_C_Screen : Char ABSOLUTE $B800 : $0000;
  77.     PTOOLWIN_M_Screen : Char ABSOLUTE $B000 : $0000;
  78.  
  79.     PTOOLWIN_Set : ARRAY[1..PTOOLWIN_Number_of_Windows]
  80.     OF PTOOLWIN_Set_Info;
  81.  
  82.     PTOOLWIN_Stack_Num : ARRAY[1..PTOOLWIN_Number_of_Windows] OF Integer;
  83.     PTOOLWIN_Stack_X : ARRAY[1..PTOOLWIN_Number_of_Windows] OF Integer;
  84.     PTOOLWIN_Stack_Y : ARRAY[1..PTOOLWIN_Number_of_Windows] OF Integer;
  85.     PTOOLWIN_Stack : ARRAY[1..PTOOLWIN_Number_of_Windows]
  86.     OF^PTOOLWIN_Stacks;
  87.  
  88.     PTOOLWIN_Curr : PTOOLWIN_Set_Info;
  89.  
  90.  
  91.   CONST
  92.  
  93.     PTOOLWIN_Stack_Size : Byte = 0;
  94.  
  95.     PTOOLWIN_Full_Screen : PTOOLWIN_Set_Info = (PTOOLWIN_X1 : 1;
  96.     PTOOLWIN_Y1 : 1;
  97.     PTOOLWIN_X2 : 80;
  98.     PTOOLWIN_Y2 : 25;
  99.     PTOOLWIN_Border : 0;
  100.     PTOOLWIN_Back : 0;
  101.     PTOOLWIN_Fore : 15);
  102.  
  103.     { Internal Procedures Begin Here ************************************** }
  104.  
  105.   PROCEDURE DetermineDisplay;
  106.  
  107.       { Set ScreenBase to $B000 or $B800, depending on which display is in use.
  108.       A side effect is that the cursor is left at (1,1) on the screen. }
  109.  
  110.     VAR
  111.       M, C : Integer;
  112.       T : Byte;
  113.  
  114.     BEGIN
  115.       M := MemW[$B000:0];               {Mono 1,1}
  116.       C := MemW[$B800:0];               {Color 1,1}
  117.  
  118.       {Set T to a value which is different than either Hi(M) or Hi(C).
  119.       The three values of T, 64, 65 and 66 are arbitrary.}
  120.  
  121.       T := 64;
  122.       IF (Hi(M) = T) OR (Hi(C) = T) THEN T := 65; {If not, neither is 64}
  123.       IF (Hi(M) = T) OR (Hi(C) = T) THEN T := 66; {If not, one is 64,
  124.                                                   the other is not 65.  If so, one is 64, the other is 65, so neither is 66}
  125.       GoToXY(1, 1);                     {To $B000 if mono, $B800 if color}
  126.       Write(Chr(T));
  127.       GoToXY(1, 1);
  128.       IF Mem[$B000:0] = T THEN PTOOLWIN_Screen_Type := 'M' {LP modification}
  129.       ELSE PTOOLWIN_Screen_Type := 'C'; {LP modification}
  130.       MemW[$B000:0] := M;
  131.       MemW[$B800:0] := C;
  132.     END;
  133.  
  134.     { * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
  135.  
  136.   PROCEDURE PTOOLWIN_Open_Window(Screen : Integer; OpenType : Char);
  137.  
  138.     VAR
  139.       I : Byte;
  140.  
  141.     BEGIN
  142.       IF (Screen = 0) OR
  143.       (PTOOLWIN_Stack_Size = 0) THEN PTOOLWIN_Curr := PTOOLWIN_Full_Screen
  144.       ELSE PTOOLWIN_Curr := PTOOLWIN_Set[Screen];
  145.       WITH PTOOLWIN_Curr DO
  146.         BEGIN
  147.           Window(PTOOLWIN_X1, PTOOLWIN_Y1,
  148.           PTOOLWIN_X2, PTOOLWIN_Y2);
  149.           IF PTOOLWIN_Border >= 0 THEN
  150.             BEGIN
  151.               TextBackground(PTOOLWIN_Back);
  152.               TextColor(PTOOLWIN_Fore);
  153.             END
  154.           ELSE
  155.             BEGIN
  156.               TextBackground(PTOOLWIN_Fore);
  157.               TextColor(PTOOLWIN_Back);
  158.             END;
  159.           IF (Abs(PTOOLWIN_Border) = 1) AND
  160.           (OpenType = 'N') THEN
  161.             BEGIN
  162.               GoToXY(1, 1); Write('┌');
  163.               FOR I := 2 TO PTOOLWIN_X2-PTOOLWIN_X1 DO
  164.                 Write('─');
  165.               Write('┐');
  166.               FOR I := 2 TO PTOOLWIN_Y2-PTOOLWIN_Y1 DO
  167.                 BEGIN
  168.                   GoToXY(1, I);
  169.                   Write('│');
  170.                   GoToXY(PTOOLWIN_X2-PTOOLWIN_X1+1, I);
  171.                   Write('│');
  172.                 END;
  173.               GoToXY(1, PTOOLWIN_Y2-PTOOLWIN_Y1+1); Write('└');
  174.               FOR I := 2 TO PTOOLWIN_X2-PTOOLWIN_X1 DO
  175.                 Write('─');
  176.             END;
  177.           IF (Abs(PTOOLWIN_Border) = 2) AND
  178.           (OpenType = 'N') THEN
  179.             BEGIN
  180.               GoToXY(1, 1); Write('╔');
  181.               FOR I := 2 TO PTOOLWIN_X2-PTOOLWIN_X1 DO
  182.                 Write('═');
  183.               Write('╗');
  184.               FOR I := 2 TO PTOOLWIN_Y2-PTOOLWIN_Y1 DO
  185.                 BEGIN
  186.                   GoToXY(1, I);
  187.                   Write('║');
  188.                   GoToXY(PTOOLWIN_X2-PTOOLWIN_X1+1, I);
  189.                   Write('║');
  190.                 END;
  191.               GoToXY(1, PTOOLWIN_Y2-PTOOLWIN_Y1+1); Write('╚');
  192.               FOR I := 2 TO PTOOLWIN_X2-PTOOLWIN_X1 DO
  193.                 Write('═');
  194.             END;
  195.           IF PTOOLWIN_Border <> 0 THEN
  196.             BEGIN
  197.               Window(PTOOLWIN_X1+1, PTOOLWIN_Y1+1,
  198.               PTOOLWIN_X2-1, PTOOLWIN_Y2-1);
  199.               IF OpenType = 'N' THEN
  200.                 IF Abs(PTOOLWIN_Border) = 1 THEN Write('┘')
  201.                 ELSE Write('╝');
  202.             END;
  203.           TextBackground(PTOOLWIN_Back);
  204.           TextColor(PTOOLWIN_Fore);
  205.         END;
  206.     END;
  207.  
  208.  
  209.     { Called Procedures Begin Here ******************************************** }
  210.  
  211.  
  212.   PROCEDURE PTWSet(Window, X1, Y1, X2, Y2, Border, Back, Fore : Integer);
  213.  
  214.     BEGIN
  215.  
  216.       IF PTOOLWIN_Screen_Type = 'X' THEN DetermineDisplay; {LP modification}
  217.  
  218.       WITH PTOOLWIN_Curr DO
  219.         BEGIN
  220.           PTOOLWIN_X1 := X1;
  221.           PTOOLWIN_Y1 := Y1;
  222.           PTOOLWIN_X2 := X2;
  223.           PTOOLWIN_Y2 := Y2;
  224.           PTOOLWIN_Border := Border;
  225.           PTOOLWIN_Back := Back;
  226.           PTOOLWIN_Fore := Fore;
  227.         END;
  228.       PTOOLWIN_Set[Window] := PTOOLWIN_Curr;
  229.  
  230.     END;
  231.  
  232.  
  233.   PROCEDURE PTWOpen(Screen : Integer);
  234.  
  235.     BEGIN
  236.  
  237.       PTOOLWIN_Stack_Size := PTOOLWIN_Stack_Size+1;
  238.       PTOOLWIN_Stack_Num[PTOOLWIN_Stack_Size] := Screen;
  239.       PTOOLWIN_Stack_X[PTOOLWIN_Stack_Size] := WhereX;
  240.       PTOOLWIN_Stack_Y[PTOOLWIN_Stack_Size] := WhereY;
  241.       New(PTOOLWIN_Stack[PTOOLWIN_Stack_Size]);
  242.       IF PTOOLWIN_Screen_Type = 'C' THEN
  243.         Move(PTOOLWIN_C_Screen, PTOOLWIN_Stack[PTOOLWIN_Stack_Size]^, 4000)
  244.       ELSE
  245.         Move(PTOOLWIN_M_Screen, PTOOLWIN_Stack[PTOOLWIN_Stack_Size]^, 4000);
  246.       PTOOLWIN_Open_Window(Screen, 'N');
  247.  
  248.     END;
  249.  
  250.  
  251.   PROCEDURE PTWClose;
  252.  
  253.     BEGIN
  254.       IF PTOOLWIN_Screen_Type = 'C' THEN
  255.         Move(PTOOLWIN_Stack[PTOOLWIN_Stack_Size]^, PTOOLWIN_C_Screen, 4000)
  256.       ELSE
  257.         Move(PTOOLWIN_Stack[PTOOLWIN_Stack_Size]^, PTOOLWIN_M_Screen, 4000);
  258.       Dispose(PTOOLWIN_Stack[PTOOLWIN_Stack_Size]);
  259.       PTOOLWIN_Stack_Size := PTOOLWIN_Stack_Size-1;
  260.       PTOOLWIN_Open_Window(PTOOLWIN_Stack_Num[PTOOLWIN_Stack_Size], 'R');
  261.       GoToXY(PTOOLWIN_Stack_X[PTOOLWIN_Stack_Size+1],
  262.       PTOOLWIN_Stack_Y[PTOOLWIN_Stack_Size+1]);
  263.  
  264.     END;
  265.  
  266.