home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 01 / grdlagen / screen.mod < prev    next >
Encoding:
Modula Implementation  |  1989-09-29  |  12.8 KB  |  557 lines
  1. (**********************************************************)
  2. (*                    SCREEN.MOD                          *)
  3. (*            Bildschirmsteuerung per Bios                *)
  4. (*          (c) 1989 by Ulrich Mök & toolbox              *)
  5. (**********************************************************)
  6.  
  7. IMPLEMENTATION MODULE Screen;
  8.  
  9. (* ---------- Import der Bibliotheksroutinen ------------ *)
  10.  
  11. FROM SYSTEM IMPORT
  12.      ADDRESS, SEG, OFS, WORD;
  13.  
  14. FROM System IMPORT
  15.      AX, BX, CX, DX, Trap, Move;
  16.  
  17. FROM Storage IMPORT
  18.      ALLOCATE, DEALLOCATE, Available;
  19.  
  20. FROM Strings IMPORT Length;
  21.  
  22. (* ----------- Typen - Deklaration ---------------------- *)
  23.  
  24. TYPE
  25.   Register = RECORD
  26.                CASE b : BOOLEAN OF
  27.                  TRUE   :    w : CARDINAL;
  28.                | FALSE : l, h : CHAR;
  29.                END;
  30.              END;
  31.  
  32.   ScreenTyp = RECORD
  33.                 CASE b : BOOLEAN OF
  34.                   TRUE  :     p : WORD;
  35.                 | FALSE : ch, a : CHAR;
  36.                 END;
  37.               END;
  38.  
  39.   BsArray = ARRAY [0..1999] OF WORD;
  40.   GlobTyp = RECORD
  41.     WinX1, WinY1, WinX2, WinY2,
  42.     WinCurX, WinCurY,
  43.     WinAttr          : CARDINAL;
  44.   END;
  45.  
  46.   ScrStack = POINTER TO Kopf;
  47.   Kopf     = RECORD
  48.                Bs   : BsArray;
  49.                prev : ScrStack;
  50.              END;
  51.  
  52.  
  53.   RahmenTyp = ARRAY [einfach..doppelt] OF
  54.               ARRAY [0..5] OF CHAR;
  55.  
  56. (* ----------- Variablen - Deklaration ------------------ *)
  57.  
  58. VAR
  59.   RegAX, RegBX,
  60.   RegCX, RegDX : Register;
  61.   BsStack      : ScrStack;
  62.   ScrAdr       : ADDRESS;
  63.   Punkt        : ScreenTyp;
  64.   BsRahmen     : RahmenTyp;
  65.   Glob         : GlobTyp;
  66.   c            : CHAR;
  67.  
  68.  
  69. (* ----------- Bios - Routinen -------------------------- *)
  70.  
  71.  
  72. PROCEDURE VideoKarte;
  73. BEGIN
  74.   RegAX.h := CHR( 15 );          (* Funktionsnummer in AH *)
  75.   AX := RegAX.w;
  76.   Trap( 10H );
  77.   RegAX.w := AX;
  78.   IF ORD( RegAX.l ) = 7 THEN
  79.     ScrAdr.SEG := 0B000H;
  80.     Mono := TRUE;
  81.   ELSE
  82.     ScrAdr.SEG := 0B800H;
  83.     Mono := FALSE;
  84.   END;
  85.   ScrAdr.OFS := 0H;
  86. END VideoKarte;
  87.  
  88.  
  89. PROCEDURE CursorGroesse( Start, Ende : CARDINAL );
  90. (*                 mögliche Werte : für Start ab 0, für   *)
  91. (*                 Ende bei CGA 7 und bei Hercules 13     *)
  92.  
  93. BEGIN
  94.   RegAX.h := CHR( 1 );           (* Funktionsnummer in AH *)
  95.   RegCX.h := CHR( Start );
  96.   RegCX.l := CHR( Ende );
  97.   AX := RegAX.w;
  98.   CX := RegCX.w;
  99.   Trap( 10H );
  100. END CursorGroesse;
  101.  
  102.  
  103. PROCEDURE CursorNorm;
  104. BEGIN
  105.   IF Mono
  106.     THEN CursorGroesse( 11, 12 )
  107.     ELSE CursorGroesse( 6, 7 )
  108.   END;
  109. END CursorNorm;
  110.  
  111.  
  112. PROCEDURE CursorBlock;
  113. BEGIN
  114.   IF Mono
  115.     THEN CursorGroesse( 0, 13 )
  116.     ELSE CursorGroesse( 0, 7 )
  117.   END;
  118. END CursorBlock;
  119.  
  120.  
  121. PROCEDURE CursorOff;
  122. BEGIN
  123.   IF Mono
  124.     THEN CursorGroesse( 13, 0 )
  125.     ELSE CursorGroesse( 7, 0 )
  126.   END;
  127. END CursorOff;
  128.  
  129.  
  130. PROCEDURE Goto( x, y : CARDINAL );
  131. BEGIN
  132.   RegAX.h := CHR( 2 );           (* Funktionsnummer in AH *)
  133.   RegBX.h := CHR( 0 );                  (* Bs-Seite in BH *)
  134.   RegDX.h := CHR( y );
  135.   RegDX.l := CHR( x );
  136.   AX := RegAX.w;
  137.   BX := RegBX.w;
  138.   DX := RegDX.w;
  139.   Trap( 10H );
  140. END Goto;
  141.  
  142.  
  143. PROCEDURE GotoXY( x, y : CARDINAL );
  144. BEGIN
  145. (*       Werte auf Fenster umrechnen und Window-Grenzen   *)
  146. (*       prüfen; dann ggf. CursorPos setzen               *)
  147.  
  148.   IF ( x > 0 ) AND ( y > 0 ) THEN
  149.     x := x + Glob.WinX1 - 2;
  150.     y := y + Glob.WinY1 - 2;
  151.     IF ( x <= Glob.WinX2 ) AND ( y <= Glob.WinY2 ) THEN
  152.       Goto( x, y );
  153.     END;
  154.   END;
  155. END GotoXY;
  156.  
  157.  
  158. PROCEDURE WhereX() : CARDINAL;
  159. BEGIN
  160.   RegAX.h := CHR( 3 );           (* Funktionsnummer in AH *)
  161.   RegBX.h := CHR( 0 );                  (* Bs-Seite in BH *)
  162.   AX := RegAX.w;
  163.   BX := RegBX.w;
  164.   Trap( 10H );
  165.   RETURN ORD( RegDX.l ) + 2 - Glob.WinX1;
  166. END WhereX;
  167.  
  168.  
  169. PROCEDURE WhereY() : CARDINAL;
  170. BEGIN
  171.   RegAX.h := CHR( 3 );           (* Funktionsnummer in AH *)
  172.   RegBX.h := CHR( 0 );                  (* Bs-Seite in BH *)
  173.   AX := RegAX.w;
  174.   BX := RegBX.w;
  175.   Trap( 10H );
  176.   RETURN  ORD( RegDX.h ) + 2 - Glob.WinY1;
  177. END WhereY;
  178.  
  179.  
  180. PROCEDURE Scroll( x1,y1,x2,y2, Richtung,
  181.                   ZeilenZahl, Attribut : CARDINAL );
  182.                              (* Richtung / Up = 6, Dn = 7 *)
  183. BEGIN
  184.  
  185.   (*        Assemblernotation des Fensters = 0,0,79,24 !  *)
  186.   (*        also alle Groessen dekrementieren             *)
  187.  
  188.   DEC( x1 ); DEC( y1 ); DEC( x2 ); DEC( y2 );
  189.  
  190.   RegAX.h := CHR( Richtung );
  191.   RegAX.l := CHR( ZeilenZahl );
  192.   RegBX.h := CHR( Attribut );
  193.   RegCX.h := CHR( y1 );
  194.   RegCX.l := CHR( x1 );
  195.   RegDX.h := CHR( y2 );
  196.   RegDX.l := CHR( x2 );
  197.   AX := RegAX.w;
  198.   BX := RegBX.w;
  199.   CX := RegCX.w;
  200.   DX := RegDX.w;
  201.   Trap( 10H );
  202. END Scroll;
  203.  
  204.  
  205. PROCEDURE InsLine;
  206. BEGIN
  207.   Scroll( WhereX(), WhereY(), Glob.WinX2, Glob.WinY2,
  208.           7, 1, Glob.WinAttr );
  209. END InsLine;
  210.  
  211.  
  212. PROCEDURE DelLine;
  213. BEGIN
  214.   Scroll( WhereX(), WhereY(), Glob.WinX2, Glob.WinY2,
  215.           6, 1, Glob.WinAttr );
  216. END DelLine;
  217.  
  218.  
  219. PROCEDURE ClrScr;
  220.                       (* Bildschirm löschen unter         *)
  221.                       (* Beachtung des aktuellen Fensters *)
  222. BEGIN
  223.   WITH Glob DO
  224.     Scroll( WinX1, WinY1, WinX2, WinY2,
  225.             6, WinY2 - WinY1 + 1, CARDINAL( WinAttr ));
  226.   END;
  227.   CursorGroesse( 6, 7 );
  228.   GotoXY( 1, 1 );
  229. END ClrScr;
  230.  
  231.  
  232. PROCEDURE ClrEol;
  233.                       (* Bildschirm löschen unter         *)
  234.                       (* Beachtung des aktuellen Fensters *)
  235.  
  236.   VAR
  237.     x, y : CARDINAL;
  238.  
  239. BEGIN
  240.   x := WhereX() + Glob.WinX1 - 1;
  241.   y := WhereY() + Glob.WinY1 - 1;
  242.   Scroll( x, y, Glob.WinX2, y,
  243.           6, 0, CARDINAL( Glob.WinAttr ));
  244. END ClrEol;
  245.  
  246.  
  247. PROCEDURE RepChar( Ch : CHAR; Anzahl, Attr : CARDINAL );
  248. BEGIN
  249.   (*   Fensterbreite berücksichtigen; dazu aktuelle       *)
  250.   (*   XPosition feststellen und ggf.Ausgabebreite kappen *)
  251.  
  252.   IF ( WhereX() + Anzahl ) > Glob.WinX2 THEN
  253.     Anzahl := Glob.WinX2 - WhereX();
  254.   END;
  255.  
  256.   RegAX.h := CHR( 9 );
  257.   RegAX.l := Ch;
  258.   RegBX.h := CHR( 0 );
  259.   RegBX.l := CHR( Attr );
  260.   RegCX.w := Anzahl;
  261.   AX := RegAX.w;
  262.   BX := RegBX.w;
  263.   CX := RegCX.w;
  264.   Trap( 10H );
  265. END RepChar;
  266.  
  267. (* ----------- Schreiben in BS-Speicher ----------------- *)
  268.  
  269. (*  Die Routinen Disp... schreiben ohne Berücksichtigung  *)
  270. (*  des aktuellen Fensters in den Bildschirmspeicher      *)
  271.  
  272. PROCEDURE DispChr( x, y : CARDINAL; Ch : CHAR );
  273. BEGIN
  274.   DEC( x ); DEC( y );
  275.   ScrAdr.OFS := ( y * 160 ) + ( x * 2 );
  276.   Punkt.ch := Ch;
  277.   Punkt.a  := CHR( Glob.WinAttr );
  278.   ScrAdr^  := Punkt.p;
  279.   Goto( x + 1, y );
  280.   ScrAdr.OFS := 0H;
  281. END DispChr;
  282.  
  283. PROCEDURE DispStr( x, y : CARDINAL; S : String );
  284.   VAR
  285.     Zaehler : CARDINAL;
  286.  
  287. BEGIN
  288.   DEC( x ); DEC( y );
  289.   Punkt.a  := CHR( Glob.WinAttr );
  290.   ScrAdr.OFS := ( y * 160 ) + ( x * 2 );
  291.   FOR Zaehler:= 0 TO Length( S ) DO
  292.     Punkt.ch := S [Zaehler];
  293.     ScrAdr^  := Punkt.p;
  294.     INC( ScrAdr.OFS, 2 );
  295.   END;
  296.   Goto( x + Length( S ), y );
  297.   ScrAdr.OFS := 0H;
  298. END DispStr;
  299.  
  300. (* ------------------------------------------------------ *)
  301.  
  302. (* Die Routinen Wr... schreiben mit Berücksichtigung     *)
  303. (* des aktuellen Fensters in den Bildschirmspeicher.     *)
  304. (* Durch den Prüfaufwand etwas langsamer als Disp...!!   *)
  305.  
  306. PROCEDURE WrChr( x, y : CARDINAL; Ch : CHAR );
  307. BEGIN
  308. (*      Werte auf Fenster umrechnen und Window-Grenzen   *)
  309. (*      prüfen; dann Charakter schreiben                 *)
  310.  
  311.   IF ( x > 0 ) AND ( y > 0 ) THEN
  312.     x := x + Glob.WinX1 - 1;
  313.     y := y + Glob.WinY1 - 1;
  314.     IF ( x <= Glob.WinX2 ) AND ( y <= Glob.WinY2 ) THEN
  315.       DispChr( x, y, Ch );
  316.       IF x + 1 >= Glob.WinX2 THEN
  317.         GotoXY( 1, y - Glob.WinY1 + 2 );
  318.       END;
  319.     END;
  320.   END;
  321.  
  322. END WrChr;
  323.  
  324.  
  325. PROCEDURE WrStr( x, y : CARDINAL; S : String );
  326.   VAR
  327.     P : CARDINAL;
  328.  
  329. BEGIN
  330. (*      Werte auf Fenster umrechnen und Window-Grenzen    *)
  331. (*      prüfen; dann Charakterweise schreiben             *)
  332.  
  333.   IF ( x > 0 ) AND ( y > 0 ) THEN
  334.     x := x + Glob.WinX1 - 1;
  335.     y := y + Glob.WinY1 - 1;
  336.     P := 0;
  337.  
  338.     WHILE P < Length( S ) DO
  339.  
  340.       IF x <= Glob.WinX2 THEN
  341.         DispChr( x, y, S [P] );
  342.         INC( x ); INC( P );
  343.       ELSE
  344.         x := Glob.WinX1;    INC( y );
  345.  
  346.         IF y > Glob.WinY2 THEN
  347.           Scroll( Glob.WinX1, Glob.WinY1,
  348.                   Glob.WinX2, Glob.WinY2,
  349.                   6, 1, Glob.WinAttr );
  350.           DEC( y );
  351.         END;
  352.  
  353.       END;
  354.  
  355.     END;
  356.  
  357.     IF x + 1 >= Glob.WinX2 THEN
  358.       GotoXY( 1, y - Glob.WinY1 + 2 );
  359.     END;
  360.  
  361.   END;
  362.  
  363. END WrStr;
  364.  
  365.  
  366. (* ------------ Farb - Routinen ------------------------- *)
  367.  
  368.  
  369. PROCEDURE HighVideo;
  370. BEGIN
  371.   Glob.WinAttr := 0FH;
  372. END HighVideo;
  373.  
  374.  
  375. PROCEDURE LowVideo;
  376.   VAR
  377.     c : CARDINAL;
  378. BEGIN
  379.   Glob.WinAttr := 07H;
  380. END LowVideo;
  381.  
  382.  
  383. PROCEDURE TextAttr( fg, bg : CARDINAL );
  384. BEGIN
  385.   IF ( bg < 8 ) AND ( fg < 16 ) THEN
  386.     Glob.WinAttr := ( bg MOD 10H ) * 10H + fg MOD 10H;
  387.   END;
  388. END TextAttr;
  389.  
  390.  
  391. PROCEDURE TextColor( fg: CARDINAL );
  392.   VAR
  393.     bg : CARDINAL;
  394.  
  395. BEGIN
  396.   bg := Glob.WinAttr DIV 10H;
  397.   TextAttr( fg, bg );
  398. END TextColor;
  399.  
  400.  
  401. PROCEDURE TextBackground( bg: CARDINAL );
  402.   VAR
  403.     fg : CARDINAL;
  404.  
  405. BEGIN
  406.   fg := Glob.WinAttr MOD 10H;
  407.   TextAttr( fg, bg );
  408. END TextBackground;
  409.  
  410.  
  411. (* ------------ Window - Routinen ----------------------- *)
  412.  
  413.  
  414. PROCEDURE OpenWindow( x1,y1,x2,y2 : CARDINAL;
  415.                       Header : String;
  416.                       Frame : FrameTyp );
  417.   VAR
  418.     S : ScrStack;
  419.     i : CARDINAL;
  420.  
  421.  
  422.   PROCEDURE WerteAktualisieren;
  423.   BEGIN
  424.                               (* Neue global-Werte setzen *)
  425.     WITH Glob DO
  426.       WinX1 := x1;    WinY1 := y1;
  427.       WinX2 := x2;    WinY2 := y2;
  428.     END;
  429.  
  430.   END WerteAktualisieren;
  431.  
  432.  
  433.   PROCEDURE RahmenZeichnen;
  434.   BEGIN
  435.  
  436.     IF (( Frame = einfach ) OR ( Frame = doppelt )) AND
  437.        (( x1 > 1 ) AND ( y1 > 1 ) AND
  438.         ( x2 < 80 ) AND ( y2 < 25 ))
  439.     THEN
  440.       DispChr( x1 - 1, y1 - 1, BsRahmen [Frame, 0]);
  441.       DispChr( x2 + 1, y1 - 1, BsRahmen [Frame, 1]);
  442.       DispChr( x1 - 1, y2 + 1, BsRahmen [Frame, 2]);
  443.       DispChr( x2 + 1, y2 + 1, BsRahmen [Frame, 3]);
  444.       FOR i:=x1 TO x2 DO
  445.         DispChr( i, y1 - 1, BsRahmen [Frame, 4]);
  446.         DispChr( i, y2 + 1, BsRahmen [Frame, 4]);
  447.       END;
  448.       FOR i:=y1 TO y2 DO
  449.         DispChr( x1 - 1, i, BsRahmen [Frame, 5]);
  450.         DispChr( x2 + 1, i, BsRahmen [Frame, 5]);
  451.       END;
  452.     END;
  453.  
  454.   END RahmenZeichnen;
  455.  
  456.  
  457.   PROCEDURE Ueberschriftschreiben;
  458.   BEGIN
  459.  
  460.     IF (( x2 - x1 ) >= ( Length( Header ) + 2 )) AND
  461.        ( Length( Header ) # 0 )
  462.     THEN
  463.       i := ( x2 - x1 - Length( Header )) DIV 2;
  464.       DispStr( x1 + i, y1 - 1, Header );
  465.     END;
  466.  
  467.   END Ueberschriftschreiben;
  468.  
  469.  
  470. BEGIN                                       (* OpenWindow *)
  471.             (* !!! Heap-Prüfung & Speicher allokieren !!! *)
  472.  
  473.   IF Available( SIZE( Kopf )) THEN
  474.     ALLOCATE( S, SIZE( Kopf ));
  475.               (* Screen & global-Werte in Liste schreiben *)
  476.  
  477.     WerteAktualisieren;
  478.     Move( ScrAdr, S, SIZE( Kopf ));
  479.     S^.prev := BsStack;
  480.     BsStack := S;
  481.     RahmenZeichnen;
  482.     Ueberschriftschreiben;
  483.     ClrScr;                      (* Screenbereich löschen *)
  484.  
  485.   END;                  (* !!! FehlerMeldung einbauen !!! *)
  486.  
  487. END OpenWindow;
  488.  
  489.  
  490. PROCEDURE LastWindow() : BOOLEAN;
  491. BEGIN
  492.   RETURN  BsStack = NIL;
  493. END LastWindow;
  494.  
  495.  
  496. PROCEDURE CloseWindow;
  497.   VAR
  498.     S : ScrStack;
  499.  
  500. BEGIN
  501.   IF BsStack # NIL THEN
  502.                                    (* Screen restaurieren *)
  503.     Move( BsStack, ScrAdr, SIZE( Kopf ));
  504.  
  505.           (* StackElement auskoppeln & Speicher freigeben *)
  506.     S := BsStack;
  507.     BsStack := BsStack^.prev;
  508.     DEALLOCATE( S, SIZE( Kopf ));
  509.  
  510.   END;
  511. END CloseWindow;
  512.  
  513.  
  514. PROCEDURE RemoveAllWindows;
  515.   VAR
  516.     S : ScrStack;
  517.  
  518. BEGIN
  519.          (* StackElemente auskoppeln & Speicher freigeben *)
  520.          (*   !!! Letztes Window bleibt erhalten !!!      *)
  521.  
  522.   WHILE BsStack^.prev # NIL DO
  523.     S := BsStack;
  524.     BsStack := BsStack^.prev;
  525.     DEALLOCATE( S, SIZE( Kopf ));
  526.   END;
  527.  
  528. END RemoveAllWindows;
  529.  
  530. (* ------------ Initialisieren der Werte ---------------- *)
  531.  
  532. BEGIN                 (* Modul-Körper & Initialisierungen *)
  533.   VideoKarte;                 (* Screen-Adresse ermitteln *)
  534.   BsStack := NIL;                 (* Liste initialisieren *)
  535.  
  536.                        (* initialisieren der Rahmen-Werte *)
  537.   BsRahmen [einfach, 0] := '┌';
  538.   BsRahmen [einfach, 1] := '┐';
  539.   BsRahmen [einfach, 2] := '└';
  540.   BsRahmen [einfach, 3] := '┘';
  541.   BsRahmen [einfach, 4] := '─';
  542.   BsRahmen [einfach, 5] := '│';
  543.   BsRahmen [doppelt, 0] := '╔';
  544.   BsRahmen [doppelt, 1] := '╗';
  545.   BsRahmen [doppelt, 2] := '╚';
  546.   BsRahmen [doppelt, 3] := '╝';
  547.   BsRahmen [doppelt, 4] := '═';
  548.   BsRahmen [doppelt, 5] := '║';
  549.  
  550.                                   (* erstes Window setzen *)
  551.   OpenWindow( 1,1,80,25, "", ohne );
  552.  
  553.   Glob.WinAttr := 7;          (* Screen-Attribut HellGrau *)
  554. END Screen.
  555.  
  556. (* ------------- Ende von SCREEN.MOD -------------------- *)
  557.