home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1987 / 08 / tsr / tsrwind.inc < prev   
Encoding:
Text File  |  1987-06-02  |  5.7 KB  |  135 lines
  1. (* ----------------------------------------------------------------------- *)
  2. (*                              TSRWIND.PAS                                *)
  3. (*        einfache Window-Management-Routinen fuer die TSR-Toolbox         *)
  4. (* ----------------------------------------------------------------------- *)
  5. CONST WinInit: BOOLEAN = FALSE;
  6.       On = TRUE;  Off = FALSE;
  7.       VideoEnable = $08;
  8.       MonoScreen = $B000;  ColorScreen = $B800;  Monochrom = 7;
  9.       MaxWin = 5;
  10.  
  11. TYPE  ScrInhalt = ARRAY [1..4000] OF CHAR;
  12.       WinType = RECORD  x1, y1, x2, y2: INTEGER; END;
  13.       Screens = RECORD              (* gespeicherte Bildschirminformation: *)
  14.                   Bild: ScrInhalt;                     (* Bildschirminhalt *)
  15.                   Dim : WinType;                         (* Fenstergroesse *)
  16.                   x, y: INTEGER;                        (* Cursor-Position *)
  17.                 END;
  18.  
  19.  VAR  Win: RECORD
  20.              Dim   : WinType;                   (* aktuelle Fenstergroesse *)
  21.              Tiefe : INTEGER;
  22.              Keller: ARRAY[1..MaxWin] OF ^Screens;
  23.            END;
  24.       ScreenMode  : BYTE      ABSOLUTE $0040:$0049;
  25.       MonoBuffer  : ScrInhalt ABSOLUTE MonoScreen:$0000;
  26.       ColorBuffer : ScrInhalt ABSOLUTE ColorScreen:$0000;
  27.       Adapter     : INTEGER   ABSOLUTE $0040:$0063;
  28.       VideoMode   : BYTE      ABSOLUTE $0040:$0065;
  29.       VideoBuffer : INTEGER;
  30. (* ----------------------------------------------------------------------- *)
  31. PROCEDURE Where_Cursor (VAR x, y: INTEGER);
  32. VAR  Active_Page : BYTE ABSOLUTE $0040:$0062;          (* Video Page Index *)
  33.      Crt_Pages   : ARRAY[0..7] OF INTEGER ABSOLUTE $0040:$0050 ;
  34. BEGIN
  35.    x := Crt_Pages[active_page];                (* absolute Cursor-Position *)
  36.    y := Hi(x)+1;  x := Lo(x)+1;
  37. END;
  38. (* ----------------------------------------------------------------------- *)
  39. PROCEDURE Video (On: BOOLEAN);
  40. BEGIN
  41.   IF On THEN Port[Adapter+4] := (VideoMode OR VideoEnable)
  42.   ELSE Port[Adapter+4] := (VideoMode - VideoEnable)
  43. END;
  44. (* ----------------------------------------------------------------------- *)
  45. PROCEDURE InitWindow;
  46. BEGIN
  47.   IF ScreenMode = Monochrom THEN VideoBuffer := MonoScreen
  48.   ELSE VideoBuffer := ColorScreen;
  49.   WITH Win.Dim DO BEGIN  x1 := 1;  y1 := 1;  x2 := 80;  y2 := 25  END;
  50.   Win.Tiefe := 0;  WinInit := TRUE;
  51. END;
  52. (* ----------------------------------------------------------------------- *)
  53. PROCEDURE WinFrame (x1, y1, x2, y2, Style, TxtColor, BckColor: INTEGER);
  54. VAR x, y, i, Ver, Hor, Elo, Ero, Elu, Eru: INTEGER;
  55. BEGIN
  56.   IF ScreenMode = Monochrom THEN BEGIN  TxtColor := 7;  BckColor := 0;  END;
  57.   Window(x1,y1,x2,y2);
  58.   TextColor(TxtColor) ;                       (* Style = 0 ==> kein Rahmen *)
  59.   TextBackground(BckColor);                (* Style = 1 ==> einfache Linie *)
  60.   IF Style=1 THEN                          (* Style = 2 ==> doppelte Linie *)
  61.     BEGIN
  62.       Ver := 196;  Hor := 179;           (* Ecken links/rechts/oben/unten: *)
  63.       Elo := 218;  Ero := 191;  Elu := 192;  Eru := 217;
  64.     END
  65.   ELSE
  66.     BEGIN
  67.       Ver := 205; Hor := 186; Elo := 201; Ero := 187; Elu := 200; Eru := 188;
  68.     END;
  69.   IF Style <> 0 THEN
  70.     BEGIN
  71.       GotoXY(1,1);  Write(Chr(Elo));
  72.       FOR i := 2 TO x2-x1 DO Write(Chr(Ver));
  73.       Write(Chr(Ero));
  74.       FOR i := 2 TO y2-y1 DO
  75.         BEGIN
  76.           GotoXY(1,i); Write(Chr(Hor)); GotoXY(x2-x1+1,i); Write(Chr(Hor));
  77.         END;
  78.       GotoXY(1,y2-y1+1);  Write(Chr(Elu));
  79.       FOR i := 2 TO x2-x1 DO Write(Chr(Ver));
  80.       Window(x1+1,y1+1,x2-1,y2-1);  Write(Chr(Eru));
  81.     END;
  82. END;
  83. (* ----------------------------------------------------------------------- *)
  84. PROCEDURE MkWindow (x1, y1, x2, y2, Style:INTEGER;
  85.                     TxtColor:BYTE; BckColor, BrdColor:INTEGER);
  86. VAR dummy: INTEGER;
  87. BEGIN
  88.   IF NOT WinInit THEN InitWindow;
  89.   WITH Win DO Tiefe := Tiefe+1;
  90.   IF Win.Tiefe > MaxWin THEN         (* zuviel Fenster! Programm abbrechen *)
  91.     BEGIN
  92.       WriteLn('FEHLER: Zuviele Fenster offen! ');  Halt;
  93.     END;
  94.   Video(Off);
  95.   WITH Win DO
  96.     BEGIN
  97.       New(Keller[Tiefe]);          (* alten Bildinhalt auf Keller schieben *)
  98.       IF ScreenMode = 7 THEN Keller[Tiefe]^.Bild := MonoBuffer
  99.       ELSE Keller[Tiefe]^.Bild := ColorBuffer;
  100.       Keller[Tiefe]^.Dim := Dim;   (* Groesse u. Cursor auf Keller sichern *)
  101.       Keller[Win.Tiefe]^.x := wherex;
  102.       Keller[Win.Tiefe]^.y := wherey;
  103.     END ;
  104.   Video(On) ;
  105.   IF (x2 > 80) THEN                              (* Koordinatenkorrekturen *)
  106.     BEGIN  dummy := x2-80;  x1 := x1-dummy;  x2 := x2-dummy;  END;
  107.   IF (y2 > 25) THEN
  108.     BEGIN  dummy := y2-25;  y1 := y1-dummy;  y2 := y2-dummy;  END;
  109.   WinFrame(x1, y1, x2, y2, Style, TxtColor, BrdColor);
  110.   GotoXY(1,1); TextColor(TxtColor); TextBackground(BckColor); ClrScr;
  111.   Win.Dim.x1 := x1+1;  Win.Dim.y1 := y1+1;
  112.   Win.Dim.x2 := x2-1;  Win.Dim.y2 := y2-1;
  113. END;
  114. (* ----------------------------------------------------------------------- *)
  115. PROCEDURE RmWindow;
  116. VAR act_color: BYTE;  x, y: INTEGER;
  117. BEGIN
  118.   Video(Off);
  119.   WITH Win DO
  120.     BEGIN                 (* alter Bildinhalt zurueck und Keller freigeben *)
  121.       IF ScreenMode = 7 THEN MonoBuffer := Keller[Tiefe]^.Bild
  122.       ELSE ColorBuffer := Keller[Tiefe]^.Bild;
  123.       Dispose(Keller[Tiefe]);
  124.       Video(On);            (* altes Fenster u. Cursor-Position reaktiven: *)
  125.       Dim := Keller[Tiefe]^.Dim;
  126.       Window(Dim.x1,Dim.y1,Dim.x2,Dim.y2);
  127.       GotoXY(Keller[Tiefe]^.x,Keller[Tiefe]^.y);
  128.       Where_Cursor(x,y);
  129.       act_color:= Mem[VideoBuffer:((x-1+(y-1)*80)*2)+1];
  130.       TextColor(act_color AND $0F);   TextBackground(act_color DIV 16);
  131.       Tiefe := Tiefe-1;
  132.     END ;
  133. END;
  134. (* ----------------------------------------------------------------------- *)
  135.