home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / spezial / 13 / tsr / tsrwind.inc < prev    next >
Encoding:
Text File  |  1988-03-30  |  6.3 KB  |  177 lines
  1. (* ------------------------------------------------------ *)
  2. (*                       TSRWIND.INC                      *)
  3. (*           einfache Window-Management-Routinen          *)
  4. (*                   fuer die TSR-Toolbox                 *)
  5. (* ------------------------------------------------------ *)
  6. CONST WinInit: BOOLEAN = FALSE;
  7.       On = TRUE;  Off = FALSE;
  8.       VideoEnable = $08;
  9.       MonoScreen = $B000;  ColorScreen = $B800;
  10.       Monochrom = 7;
  11.       MaxWin = 5;
  12.  
  13. TYPE  ScrInhalt = ARRAY [1..4000] OF CHAR;
  14.       WinType   = RECORD  x1, y1, x2, y2: INTEGER; END;
  15.       Screens   = RECORD
  16.                     Bild: ScrInhalt;
  17.                     Dim : WinType;     (* Fenstergroesse  *)
  18.                     x, y: INTEGER;     (* Cursor-Position *)
  19.                     Shape : INTEGER;   (* Cursorform      *)
  20.                   END;
  21.  
  22.  VAR  Win: RECORD
  23.              Dim   : WinType;  (* aktuelle Fenstergroesse *)
  24.              Tiefe : INTEGER;
  25.              Keller: ARRAY[1..MaxWin] OF ^Screens;
  26.            END;
  27.       ScreenMode  : BYTE      ABSOLUTE $0040:$0049;
  28.       MonoBuffer  : ScrInhalt ABSOLUTE MonoScreen:$0000;
  29.       ColorBuffer : ScrInhalt ABSOLUTE ColorScreen:$0000;
  30.       Adapter     : INTEGER   ABSOLUTE $0040:$0063;
  31.       VideoMode   : BYTE      ABSOLUTE $0040:$0065;
  32.       VideoBuffer : INTEGER;
  33. (* ------------------------------------------------------ *)
  34. PROCEDURE Where_Cursor (VAR x, y: INTEGER);
  35.  
  36. VAR  Active_Page : BYTE ABSOLUTE $0040:$0062;
  37.                                       (* Video Page Index *)
  38.      Crt_Pages   : ARRAY[0..7] OF
  39.                    INTEGER ABSOLUTE $0040:$0050 ;
  40. BEGIN
  41.    x := Crt_Pages[active_page];
  42.                               (* absolute Cursor-Position *)
  43.    y := Hi(x)+1;  x := Lo(x)+1;
  44. END;
  45. (* ------------------------------------------------------ *)
  46. PROCEDURE Video (On: BOOLEAN);
  47.                  (* Video-Adapter aktivieren/deaktivieren *)
  48. BEGIN
  49.   IF On THEN Port[Adapter+4] := (VideoMode OR VideoEnable)
  50.   ELSE Port[Adapter+4] := (VideoMode - VideoEnable)
  51. END;
  52. (* ------------------------------------------------------ *)
  53. PROCEDURE InitWindow;
  54. (* Bibliothek initialisieren. Wird von "MkWindow" einmal  *)
  55. (* aufgerufen                                             *)
  56. BEGIN
  57.   IF ScreenMode = Monochrom THEN VideoBuffer := MonoScreen
  58.   ELSE VideoBuffer := ColorScreen;
  59.   WITH Win.Dim DO BEGIN
  60.     x1 := 1;  y1 := 1;  x2 := 80;  y2 := 25;
  61.   END;
  62.   Win.Tiefe := 0;  WinInit := TRUE;
  63. END;
  64. (* ------------------------------------------------------ *)
  65. PROCEDURE WinFrame (x1, y1, x2, y2, Style, TxtColor,
  66.                     BckColor: INTEGER);
  67.                                        (* Rahmen zeichnen *)
  68. VAR x, y, i, Ver,
  69.     Hor, Elo, Ero, Elu, Eru: INTEGER;
  70.  
  71. BEGIN
  72.   IF ScreenMode = Monochrom THEN BEGIN
  73.     TxtColor := 7;  BckColor := 0;
  74.   END;
  75.   Window(x1, y1, x2, y2);
  76.   TextColor(TxtColor) ;
  77.   TextBackground(BckColor);
  78.   IF Style=1 THEN BEGIN
  79.     Ver := 196;  Hor := 179;
  80.     Elo := 218;  Ero := 191;  Elu := 192;  Eru := 217; END
  81.   ELSE BEGIN            (* Ecken links/rechts/oben/unten: *)
  82.     Ver := 205; Hor := 186;
  83.      Elo := 201; Ero := 187; Elu := 200; Eru := 188;
  84.   END;
  85.   IF Style <> 0 THEN BEGIN
  86.     GotoXY(1,1);  Write(Chr(Elo));
  87.     FOR i := 2 TO x2-x1 DO Write(Chr(Ver));
  88.     Write(Chr(Ero));
  89.     FOR i := 2 TO y2-y1 DO BEGIN
  90.       GotoXY(1,i); Write(Chr(Hor));
  91.       GotoXY(x2-x1+1,i); Write(Chr(Hor));
  92.     END;
  93.     GotoXY(1,y2-y1+1);  Write(Chr(Elu));
  94.     FOR i := 2 TO x2-x1 DO Write(Chr(Ver));
  95.     Window(1,1,80,25); GotoXY(x2,y2); Write(Chr(Eru));
  96.     Window(x1+1,y1+1,x2-1,y2-1);
  97.   END;
  98. END;
  99. (* ------------------------------------------------------ *)
  100. PROCEDURE MkWindow (x1, y1, x2, y2, Style:INTEGER;
  101.                     TxtColor:BYTE;
  102.                     BckColor, BrdColor:INTEGER);
  103. (* neues Fenster erzeugen: x1,y1 Ecke links oben,
  104.                            x2,y2 Ecke rechts unten,
  105.                            Style Rahmenzeichen,
  106.                            BrdColor Fenster-Hintergrund   *)
  107. VAR dummy: INTEGER;
  108.     Regs : Regs8088_;
  109.  
  110. BEGIN
  111.   IF NOT WinInit THEN InitWindow;
  112.   WITH Win DO Tiefe := Tiefe+1;
  113.   IF Win.Tiefe > MaxWin THEN BEGIN
  114.     WriteLn('FEHLER: Zuviele Fenster offen! ');  Halt;
  115.   END;
  116.   Video(Off);
  117.   WITH Win DO BEGIN
  118.     New(Keller[Tiefe]);
  119.                   (* alten Bildinhalt auf Keller schieben *)
  120.     IF ScreenMode = 7 THEN Keller[Tiefe]^.Bild := MonoBuffer
  121.     ELSE Keller[Tiefe]^.Bild := ColorBuffer;
  122.     Keller[Tiefe]^.Dim := Dim;
  123.                   (* Groesse u. Cursor auf Keller sichern *)
  124.     Where_Cursor(Keller[Win.Tiefe]^.x,Keller[Win.Tiefe]^.y);
  125.     Regs.AH:=3;
  126.     Intr($10,Regs);
  127.     Keller[Win.Tiefe]^.Shape:=Regs.CX;
  128.   END ;
  129.   Video(On) ;
  130.   IF (x2 > 80) THEN BEGIN       (* Koordinatenkorrekturen *)
  131.     dummy := x2-80;  x1 := x1-dummy;  x2 := x2-dummy;
  132.   END;
  133.   IF (y2 > 25) THEN BEGIN
  134.     dummy := y2-25;  y1 := y1-dummy;  y2 := y2-dummy;
  135.   END;
  136.   WinFrame(x1, y1, x2, y2, Style, TxtColor, BrdColor);
  137.   GotoXY(1,1); TextColor(TxtColor);
  138.   TextBackground(BckColor); ClrScr;
  139.   Win.Dim.x1 := x1+1;  Win.Dim.y1 := y1+1;
  140.   Win.Dim.x2 := x2-1;  Win.Dim.y2 := y2-1;
  141. END;
  142. (* ------------------------------------------------------ *)
  143. PROCEDURE RmWindow;
  144.                             (* oberstes Fenster entfernen *)
  145. VAR act_color: BYTE;  x, y: INTEGER;
  146.     Regs : Regs8088_;
  147.  
  148. BEGIN
  149.   Video(Off);
  150.   WITH Win DO BEGIN
  151.          (* alter Bildinhalt zurueck und Keller freigeben *)
  152.       IF ScreenMode = 7 THEN
  153.         MonoBuffer := Keller[Tiefe]^.Bild
  154.       ELSE ColorBuffer := Keller[Tiefe]^.Bild;
  155.       Dispose(Keller[Tiefe]);
  156.       Video(On);
  157.            (* altes Fenster u. Cursor-Position reaktiven: *)
  158.       Dim := Keller[Tiefe]^.Dim;
  159.       Window(Dim.x1,Dim.y1,Dim.x2,Dim.y2);
  160.       Regs.AH := 2;
  161.       Regs.BH := Mem[$40:$62];
  162.       Regs.DL := Pred(Keller[Tiefe]^.x);
  163.       Regs.DH := Pred(Keller[Tiefe]^.y);
  164.       Intr($10, Regs);
  165.       Regs.AH := 1;
  166.       Regs.CX := Keller[Tiefe]^.Shape;
  167.       Intr($10, Regs);
  168.       Where_Cursor(x,y);
  169.       act_color:= Mem[VideoBuffer:((x-1+(y-1)*80)*2)+1];
  170.       TextColor(act_color AND $0F);
  171.       TextBackground(act_color DIV 16);
  172.       Tiefe := Tiefe-1;
  173.   END ;
  174. END;
  175. (* ------------------------------------------------------ *)
  176. (*                 Ende von TSRWIND.PAS                   *)
  177.