home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1989 / 10 / titel / mcga.mod < prev    next >
Encoding:
Modula Implementation  |  1989-09-07  |  7.5 KB  |  330 lines
  1. (* --------------------------------------------------- *)
  2. (*                     MCGA.MOD                        *)
  3. (*                (C) 1989 TOOLBOX                     *)
  4. (*   Dieses Modul liefert die Grundlage für die Pro-   *)
  5. (*   grammierung des Modus 13h (MCGA) der VGA-Karte    *)
  6. (*         Implementation in TopSpeed Modula-2         *)
  7. (* --------------------------------------------------- *)
  8. IMPLEMENTATION MODULE MCGA;
  9.  
  10. FROM SYSTEM IMPORT BYTE, Registers, Seg, Ofs;
  11. IMPORT Lib, Str, FIO;
  12.  
  13. TYPE
  14.   ByteP = POINTER TO BYTE;
  15.  
  16.   (* Setzen eines Punktes in der Farbe color *)
  17.   PROCEDURE plot(x, y, color : CARDINAL);
  18.   BEGIN
  19.     [0A000H:(y*320+x) ByteP]^ := BYTE(color);
  20.   END plot;
  21.  
  22.   (* Alternatives Plot mit Bios Funktion *)
  23.   (*
  24.     PROCEDURE plot(x, y, color : CARDINAL);
  25.     VAR
  26.       R : Registers;
  27.     BEGIN
  28.       WITH R DO
  29.         AH := 12;
  30.         CX := x;
  31.         DX := y;
  32.       END;
  33.       Lib.Intr(R, 10H);
  34.     END plot;
  35.   *)
  36.  
  37.   (* Ermittelt die Farbe des Punktes auf x, y *)
  38.   PROCEDURE getdotcolor (x, y : CARDINAL) : CARDINAL;
  39.   BEGIN
  40.     RETURN CARDINAL([0A000H:(y*320+x) ByteP]^ )
  41.   END getdotcolor;
  42.  
  43.   (* Alternatives getdotcolor mit BIOS-Aufruf *)
  44.   (*
  45.     PROCEDURE getdotcolor(x, y : CARDINAL) : CARDINAL;
  46.     VAR
  47.       R : Registers;
  48.     BEGIN
  49.       WITH R DO
  50.         AH := 14;
  51.         CX := x;
  52.         DX := y;
  53.       END;
  54.       Lib.Intr(R, 10H);
  55.       RETURN CARDINAL(R.AL)
  56.     END getdotcolor;
  57.  *)
  58.  
  59.   (* Setzt MCGA-Modus mit 320*200 Punkte x 256 Farben *)
  60.   PROCEDURE initgraphic;
  61.   VAR
  62.     R : Registers;
  63.   BEGIN
  64.     WITH R DO
  65.       AH := 0;
  66.       AL := 13H;
  67.     END;
  68.     Lib.Intr(R, 10H);
  69.   END initgraphic;
  70.  
  71.   PROCEDURE exitgraphic;
  72.   VAR
  73.     R : Registers;
  74.   BEGIN
  75.     WITH R DO
  76.       AH := 0;
  77.       AL := 3;
  78.     END;
  79.     Lib.Intr(R, 10H);
  80.   END exitgraphic;
  81.  
  82.   (* Schreibt einen String an Cursorposition *)
  83.   PROCEDURE print(line : ARRAY OF CHAR; color : CARDINAL);
  84.   VAR i : CARDINAL;
  85.       R : Registers;
  86.   BEGIN
  87.     FOR i := 0 TO Str.Length(line)-1 DO
  88.       WITH R DO
  89.         AH := 14;
  90.         AL := SHORTCARD(line[i]);
  91.         BL := SHORTCARD(color);
  92.       END;
  93.       Lib.Intr(R, 10H);
  94.     END;
  95.   END print;
  96.  
  97.   (* Setzt den Cursor auf x, y *)
  98.   PROCEDURE setcursor(x, y : CARDINAL);
  99.   VAR
  100.     R : Registers;
  101.   BEGIN
  102.     WITH R DO
  103.       AH := 2;
  104.       BH := 0;
  105.       DH := SHORTCARD(y);
  106.       DL := SHORTCARD(x);
  107.     END;
  108.     Lib.Intr(R, 10H)
  109.   END setcursor;
  110.  
  111.   (* Liest x-Position des Cursors *)
  112.   PROCEDURE cursorx() : CARDINAL;
  113.   VAR
  114.     R : Registers;
  115.   BEGIN
  116.     WITH R DO
  117.       AH := 3;
  118.       BH := 0
  119.     END;
  120.     Lib.Intr(R, 10H);
  121.     RETURN CARDINAL(R.DL);
  122.   END cursorx;
  123.  
  124.   (* Liest y-Position des Cursors *)
  125.   PROCEDURE cursory() : CARDINAL;
  126.   VAR
  127.     R : Registers;
  128.   BEGIN
  129.     WITH R DO
  130.       AH := 3;
  131.       BH := 0
  132.     END;
  133.     Lib.Intr(R, 10H);
  134.     RETURN CARDINAL(R.DH)
  135.   END cursory;
  136.  
  137.   (* Bildschirm mit Farbe color löschen *)
  138.   PROCEDURE clearscreen(color : CARDINAL);
  139.   BEGIN
  140.     Lib.Fill([0A000H:0000], 64000, SHORTCARD(color));
  141.   END clearscreen;
  142.  
  143.   (* Farbige Box zeichnen *)
  144.   PROCEDURE colorbox(x1, y1, x2, y2, color : CARDINAL);
  145.   VAR
  146.     i, d : CARDINAL;
  147.   BEGIN
  148.     d := x2 - x1;
  149.     FOR  i := 1 TO y2 DO
  150.       Lib.Fill([0A000H:i*320+x1], d, SHORTCARD(color));
  151.     END;
  152.   END colorbox;
  153.  
  154. VAR
  155.   Scr[0A000H:0000] : ARRAY[0..63999] OF BYTE;
  156.  
  157.   (* Sichert den Bildschirm in die Datei "filename" *)
  158.   PROCEDURE mcgasave(filename : ARRAY OF CHAR);
  159.   VAR
  160.     f : FIO.File;
  161.   BEGIN
  162.     f := FIO.Create(filename);
  163.     FIO.WrBin(f, Scr, SIZE(Scr));
  164.     FIO.Close(f)
  165.   END mcgasave;
  166.  
  167.   (* Lädt einen gesicherten Bildschirm *)
  168.   PROCEDURE mcgaload(filename : ARRAY OF CHAR);
  169.   VAR
  170.     f   : FIO.File;
  171.     res : CARDINAL;
  172.   BEGIN
  173.     f := FIO.Open(filename);
  174.     res := FIO.RdBin(f, Scr, SIZE(Scr));
  175.     FIO.Close(f)
  176.   END mcgaload;
  177.  
  178.   PROCEDURE line(x1, y1, x2, y2, color : CARDINAL);
  179.   VAR
  180.     deltax, deltay, abweichung,
  181.     zaehler, x, y, temp         : INTEGER;
  182.   BEGIN
  183.     abweichung := 0;
  184.     deltax := x2 - x1;
  185.     deltay := y2 - y1;
  186.     IF deltay < 0 THEN
  187.       temp := x1;  x1 := x2;  x2 := temp;
  188.       temp := y1;  y1 := y2;  y2 := temp;
  189.       deltax := -deltax;
  190.       deltay := -deltay;
  191.     END;
  192.     plot(x1, y1, color);
  193.     x := x1;
  194.     y := y1;
  195.     IF deltax >= 0 THEN
  196.       IF deltax < deltay THEN
  197.         FOR zaehler := 1 TO deltay-1 DO
  198.           IF abweichung < 0 THEN
  199.             x := x + 1;
  200.             y := y + 1;
  201.             plot(x, y, color);
  202.             abweichung := abweichung + deltay - deltax;
  203.           ELSE
  204.             y := y + 1;
  205.             plot(x, y, color);
  206.             abweichung := abweichung + deltay - deltax;
  207.           END;
  208.         END;
  209.       ELSE
  210.         FOR zaehler := 1 TO deltax-1 DO
  211.           IF abweichung <= 0 THEN
  212.             x := x + 1;
  213.             plot(x, y, color);
  214.             abweichung := abweichung + deltay;
  215.           ELSE
  216.             x := x + 1;
  217.             y := y + 1;
  218.             plot(x, y, color);
  219.             abweichung := abweichung + deltay - deltax;
  220.           END;
  221.         END;
  222.       END;
  223.     ELSE
  224.       IF ABS(deltax) >= deltay THEN
  225.         FOR zaehler := 1 TO ABS(deltax)-1 DO
  226.           IF abweichung <= 0 THEN
  227.             x := x - 1;
  228.             plot(x, y, color);
  229.             abweichung := abweichung + deltay;
  230.           ELSE
  231.             x := x - 1;
  232.             y := y + 1;
  233.             plot(x, y, color);
  234.             abweichung := abweichung + deltax + deltay;
  235.           END;
  236.         END;
  237.       ELSE
  238.         FOR zaehler := 1 TO deltay-1 DO
  239.           IF abweichung < 0 THEN
  240.             x := x - 1;
  241.             y := y + 1;
  242.             plot(x, y, color);
  243.             abweichung := abweichung + deltax + deltay;
  244.           ELSE
  245.             y := y + 1;
  246.             plot(x, y, color);
  247.             abweichung := abweichung + deltay;
  248.           END;
  249.         END;
  250.       END;
  251.     END;
  252.     plot(x2, y2, color);
  253.   END line ;
  254.  
  255.   PROCEDURE box(x1, y1, x2, y2, color : CARDINAL);
  256.   BEGIN
  257.     line(x1, y1, x2, y1, color);
  258.     line(x1, y2, x2, y2, color);
  259.     line(x1, y1, x1, y2, color);
  260.     line(x2, y1, x2, y2, color);
  261.   END box;
  262.  
  263.   PROCEDURE setcolor(nr, red, green, blue : CARDINAL);
  264.   VAR
  265.     R : Registers;
  266.   BEGIN
  267.     WITH R DO
  268.       AH := 10H;
  269.       AL := 10H;
  270.       BX := nr;
  271.       DH := SHORTCARD(red);
  272.       CH := SHORTCARD(green);
  273.       CL := SHORTCARD(blue);
  274.     END;
  275.     Lib.Intr(R, 10H);
  276.   END setcolor;
  277.  
  278.   PROCEDURE readcolor(nr : CARDINAL; VAR red, green, blue : CARDINAL);
  279.   VAR
  280.     R : Registers;
  281.   BEGIN
  282.     WITH R DO
  283.       AH := 10H;
  284.       AL := 15H;
  285.       BX := nr;
  286.     END;
  287.     Lib.Intr(R, 10H);
  288.     WITH R DO
  289.       red := CARDINAL(DH);
  290.       green := CARDINAL(CH);
  291.       blue := CARDINAL(CL);
  292.     END;
  293.   END readcolor;
  294.  
  295.   PROCEDURE setcolorblock(StartNr : CARDINAL;
  296.                           CRegBuf : ColorRegBuffer;
  297.                           Nr : CARDINAL);
  298.   VAR
  299.     R : Registers;
  300.   BEGIN
  301.     WITH R DO
  302.       AH := 10H;
  303.       AL := 12H;
  304.       BX := StartNr;
  305.       ES := Seg(CRegBuf);
  306.       DX := Ofs(CRegBuf);
  307.       CX := Nr;
  308.     END;
  309.     Lib.Intr(R, 10H);
  310.   END setcolorblock;
  311.  
  312.   PROCEDURE readcolorblock(StartNr : CARDINAL;
  313.                            VAR CRegBuf : ColorRegBuffer;
  314.                            Nr : CARDINAL);
  315.   VAR
  316.     R : Registers;
  317.   BEGIN
  318.     WITH R DO
  319.       AH := 10H;
  320.       AL := 17H;
  321.       BX := StartNr;
  322.       ES := Seg(CRegBuf);
  323.       DX := Ofs(CRegBuf);
  324.       CX := Nr;
  325.     END;
  326.     Lib.Intr(R, 10H);
  327.   END readcolorblock;
  328.  
  329. END MCGA.
  330.