home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / pmos2002.zip / SRC / GRAPHICS.MOD < prev    next >
Text File  |  1998-01-26  |  15KB  |  402 lines
  1. IMPLEMENTATION MODULE Graphics;
  2.  
  3.         (****************************************************************)
  4.         (*                                                              *)
  5.         (*                   Screen graphics output                     *)
  6.         (*                                                              *)
  7.         (*  Programmer:         P. Moylan                               *)
  8.         (*  Last edited:        8 November 1996                         *)
  9.         (*  Status:             Mostly working                          *)
  10.         (*                      Some functions still missing            *)
  11.         (*                                                              *)
  12.         (*      The procedures in this module assume that the caller    *)
  13.         (*      has control of the entire graphics output region.       *)
  14.         (*      For multi-window graphics, see module GWindows.         *)
  15.         (*                                                              *)
  16.         (****************************************************************)
  17.  
  18. FROM SYSTEM IMPORT
  19.     (* type *)  ADDRESS, CARD8;
  20.  
  21. FROM ScreenGeometry IMPORT
  22.     (* type *)  Rectangle;
  23.  
  24. IMPORT Graph;
  25.  
  26. FROM Strings IMPORT
  27.     (* proc *)  Extract;
  28.  
  29. (************************************************************************)
  30.  
  31. VAR
  32.     GraphicsScreenOpen: BOOLEAN;
  33.  
  34.     (* Current graphics mode is XM x YM x NumColours. *)
  35.  
  36.     XM, YM, YM1, NumColours: CARDINAL;
  37.  
  38. (************************************************************************)
  39.  
  40. PROCEDURE SetMode (newmode: CARDINAL;  ClearScreen: BOOLEAN);
  41.  
  42.     (* Sets the video mode. *)
  43.  
  44.     BEGIN
  45.         IF GraphicsScreenOpen THEN Graph.Exit END(*IF*);
  46.  
  47.         CASE newmode OF
  48.            |  4, 5, 13, 19, 269, 270, 271:
  49.                     XM := 320;  YM := 200;
  50.            |  6, 14:
  51.                     XM := 640;  YM := 200;
  52.            |  15, 16:
  53.                     XM := 640;  YM := 350;
  54.            |  97, 256:
  55.                     XM := 640;  YM := 400;
  56.            |  17, 18, 98, 257, 272, 273, 274:
  57.                     XM := 640;  YM := 480;
  58.            |  83, 84, 99, 106, 258, 259, 275, 276, 277:
  59.                     XM := 800;  YM := 600;
  60.            |  85, 100, 101, 260, 261, 278, 279, 280:
  61.                     XM := 1024;  YM := 768;
  62.            |  262, 263, 281, 282, 283:
  63.                     XM := 1280;  YM := 1024;
  64.         ELSE
  65.                 XM := 320;  YM := 200;
  66.         END (*CASE*);
  67.         YM1 := YM - 1;
  68.  
  69.         CASE newmode OF
  70.            |  5, 6, 15, 17:
  71.                     NumColours := 2;
  72.            |  4:
  73.                     NumColours := 4;
  74.            |  13, 14, 16, 18, 83, 84, 85, 101, 106, 258, 260, 262:
  75.                     NumColours := 16;
  76.            |  19, 97, 98, 99, 100, 256, 257, 259, 261, 263:
  77.                     NumColours := 256;
  78.            |  269, 272, 275, 278, 281:
  79.                     NumColours := 32768;
  80.            |  270, 273, 276, 279, 282:
  81.                     NumColours := 65536;
  82.            |  271, 274, 277, 280, 283:
  83.                     NumColours := 1000000H;
  84.         ELSE
  85.                     NumColours := 16;
  86.         END (*CASE*);
  87.  
  88.         GraphicsScreenOpen := Graph.Init (10, 10, XM, YM);
  89.         IF ClearScreen THEN Graph.ClearScreen (0) END(*IF*);
  90.  
  91.     END SetMode;
  92.  
  93. (************************************************************************)
  94.  
  95. PROCEDURE SetDefaultMode;
  96.  
  97.     (* Sets the video mode to (our opinion of) the "best" graphics mode *)
  98.     (* supported by the hardware.                                       *)
  99.  
  100.     BEGIN
  101.         SetMode (18, TRUE);
  102.     END SetDefaultMode;
  103.  
  104. (************************************************************************)
  105.  
  106. PROCEDURE GraphicsOff (ClearScreen: BOOLEAN);
  107.  
  108.     (* Sets the video mode to a default text mode. *)
  109.  
  110.     BEGIN
  111.         SetMode (7, TRUE);
  112.     END GraphicsOff;
  113.  
  114. (************************************************************************)
  115.  
  116. PROCEDURE GetScreenShape (VAR (*OUT*) xmax, ymax: CARDINAL;
  117.                                 VAR (*OUT*) maxcolour: ColourType;
  118.                                 VAR (*OUT*) CharHeight: CARDINAL);
  119.  
  120.     (* Returns the maximum values permitted by the current mode for     *)
  121.     (* x, y, and colour; and the number of rows in a character.         *)
  122.  
  123.     BEGIN
  124.         xmax := XM - 1;  ymax := YM1;
  125.         maxcolour := NumColours - 1;
  126.         CharHeight := 16;
  127.     END GetScreenShape;
  128.  
  129. (************************************************************************)
  130.  
  131. PROCEDURE SetFont (height, width: CARDINAL;  TablePtr: ADDRESS);
  132.  
  133.     (* Specifies the font that will be used from now on (until the      *)
  134.     (* next mode setting) for drawing characters.  The first two        *)
  135.     (* parameters are the character size, and TablePtr points to the    *)
  136.     (* bitmap that defines the font.  This procedure is normally        *)
  137.     (* optional, since SetMode sets up a default font.                  *)
  138.  
  139.     (* Implementation restriction: in the present version the 'width'   *)
  140.     (* parameter is ignored, and all characters are assumed to be       *)
  141.     (* eight pixels wide.                                               *)
  142.  
  143.     BEGIN
  144.         (* NOT YET IMPLEMENTED *)
  145.     END SetFont;
  146.  
  147. (************************************************************************)
  148.  
  149. PROCEDURE SetPaletteColour (Palette_Index, Red, Green, Blue: CARD8);
  150.  
  151.     (* Sets the colour for one palette register.  Applicable only to    *)
  152.     (* VGA or better.  The three colour codes are 6-bit numbers.        *)
  153.  
  154.     VAR dummy: CARDINAL;
  155.  
  156.     BEGIN
  157.         dummy := Graph.RemapPalette (Palette_Index, Red + 32*Green + 1024*Blue);
  158.     END SetPaletteColour;
  159.  
  160. (************************************************************************)
  161.  
  162. PROCEDURE PlotDot (x, y: CARDINAL;  colour: ColourType);
  163.  
  164.     (* Writes a dot at screen position (x, y).  *)
  165.  
  166.     BEGIN
  167.         IF BLorigin THEN
  168.             Graph.Plot (x, YM1-y, colour);
  169.         ELSE
  170.             Graph.Plot (x, y, colour);
  171.         END (*IF*);
  172.     END PlotDot;
  173.  
  174. (************************************************************************)
  175.  
  176. PROCEDURE PlotMark (x, y: CARDINAL;
  177.                         colour: ColourType;  pointtype: CARDINAL);
  178.  
  179.     (* Writes a mark at screen position (x, y).  Currently, the options *)
  180.     (* for pointtype are:                                               *)
  181.     (*          0       dot                                             *)
  182.     (*          1       X                                               *)
  183.     (*          2       box                                             *)
  184.  
  185.     BEGIN
  186.         CASE pointtype OF
  187.             1:  PlotLine (x-1,y-1,x+1,y+1, colour);     (*  X   *)
  188.                 PlotLine (x+1,y-1,x-1,y+1, colour);
  189.           |
  190.             2:  PlotLine (x-2,y-1,x+2,y-1, colour);     (* box  *)
  191.                 PlotLine (x+2,y-1,x+2,y+1, colour);
  192.                 PlotLine (x+2,y+1,x-2,y+1, colour);
  193.                 PlotLine (x-2,y+1,x-2,y-1, colour);
  194.           |
  195.             ELSE
  196.                 PlotDot (x, y, colour);                 (* point *)
  197.         END (*CASE*);
  198.     END PlotMark;
  199.  
  200. (************************************************************************)
  201.  
  202. PROCEDURE PlotLine (x0, y0, x1, y1: CARDINAL;  colour: ColourType);
  203.  
  204.     (* Plots a straight line from (x0,y0) to (x1,y1).  It is the        *)
  205.     (* caller's responsibility to ensure that the coordinates are in    *)
  206.     (* range for the current video mode.                                *)
  207.  
  208.     BEGIN
  209.         IF BLorigin THEN
  210.             Graph.Line(x0, YM1-y0, x1, YM1-y1, colour);
  211.         ELSE
  212.             Graph.Line(x0, y0, x1, y1, colour);
  213.         END (*IF*);
  214.     END PlotLine;
  215.  
  216. (************************************************************************)
  217.  
  218. PROCEDURE PlotRectangle (R: Rectangle;  colour: ColourType);
  219.  
  220.     (* Plots a rectangle, with clipping if necessary to keep the        *)
  221.     (* points within the screen boundary.                               *)
  222.  
  223.     BEGIN
  224.         WITH R DO
  225.             IF BLorigin THEN
  226.                 Graph.Rectangle (left, YM1-VAL(CARDINAL,top), right,
  227.                                 YM1-VAL(CARDINAL,bottom), colour, FALSE);
  228.             ELSE
  229.                 Graph.Rectangle (left, top, right, bottom, colour, FALSE);
  230.             END (*IF*);
  231.         END (*WITH*);
  232.     END PlotRectangle;
  233.  
  234. (************************************************************************)
  235.  
  236. PROCEDURE ClippedLine (x0, y0, x1, y1: CARDINAL;  colour: ColourType;
  237.                         left, right, ymin, ymax: CARDINAL);
  238.  
  239.     (* Like PlotLine, but plots only that part of the line which lies   *)
  240.     (* in the rectangle (left <= x <= right), (ymin <= y <= ymax).      *)
  241.     (* The caller is expected to ensure, by appropriate definition of   *)
  242.     (* the rectangle, that all plotted points are in range for the      *)
  243.     (* current video mode.                                              *)
  244.  
  245.     BEGIN
  246.         IF BLorigin THEN
  247.             Graph.SetClipRgn (left, YM1-ymax, right, YM1-ymin);
  248.             Graph.Line (x0, YM1-y0, x1, YM1-y1, colour);
  249.         ELSE
  250.             Graph.SetClipRgn (left, ymin, right, ymax+1);
  251.             Graph.Line (x0, y0, x1, y1, colour);
  252.         END (*IF*);
  253.         Graph.CancelClipRgn ();
  254.     END ClippedLine;
  255.  
  256. (************************************************************************)
  257.  
  258. PROCEDURE Fill (x0, y0, x1, y1: CARDINAL;  colour: ColourType);
  259.  
  260.     (* Fills a rectangle with the indicated colour.  The rectangle is   *)
  261.     (* specified by giving two opposite corners (x0,y0) and (x1,y1).    *)
  262.  
  263.     BEGIN
  264.         IF BLorigin THEN
  265.             Graph.Rectangle (x0, YM1-y0, x1, YM1-y1, colour, TRUE);
  266.         ELSE
  267.             Graph.Rectangle (x0, y0, x1, y1, colour, TRUE);
  268.         END (*IF*);
  269.     END Fill;
  270.  
  271. (************************************************************************)
  272.  
  273. PROCEDURE ACopy (xs, ys, width, height: CARDINAL;  dx, dy: INTEGER);
  274.  
  275.     (* Copies a rectangular region by an offset (dx, dy).  The pair     *)
  276.     (* (xs,ys) gives the coordinates of the top left of the source      *)
  277.     (* rectangle.  Restrictions: this procedure is restricted to the    *)
  278.     (* case where distance to move the data is an integral number of    *)
  279.     (* bytes (i.e. if you want it to work for all modes then dx should  *)
  280.     (* be a multiple of 8); and in the case where the source and        *)
  281.     (* destination rectangles overlap then the move has to be upwards   *)
  282.     (* on the screen.  Thus we do not have a completely general "block  *)
  283.     (* copy" operation, but we do have something sufficient to support  *)
  284.     (* "scroll up" and similar operations.                              *)
  285.  
  286.     VAR handle: Graph.HBITMAP;
  287.  
  288.     BEGIN
  289.         IF BLorigin THEN
  290.             ys := YM1 - ys;  dy := -dy;
  291.         END (*IF*);
  292.         Graph.GetImage (xs, ys, xs+width-1, ys+height-1, handle);
  293.         Graph.PutImage (VAL(INTEGER,xs)+dx, VAL(INTEGER,ys)+dy, handle, Graph._GPSET);
  294.         Graph.DelImage (handle);
  295.     END ACopy;
  296.  
  297. (************************************************************************)
  298.  
  299. PROCEDURE DrawChar (ch: CHAR;  x, y: CARDINAL;  colour: ColourType);
  300.  
  301.     (* Draws the single character ch.  The coordinates (x,y) are the    *)
  302.     (* location of the bottom left of the character.                    *)
  303.  
  304.     VAR buffer: ARRAY [0..0] OF CHAR;
  305.  
  306.     BEGIN
  307.         buffer[0] := ch;
  308.         IF BLorigin THEN
  309.             Graph.RawOutText (x, YM1-y, colour, buffer);
  310.         ELSE
  311.             Graph.RawOutText (x, y, colour, buffer);
  312.         END (*IF*);
  313.     END DrawChar;
  314.  
  315. (************************************************************************)
  316.  
  317. PROCEDURE PlotString (VAR (*IN*) text: ARRAY OF CHAR;
  318.                         x, y, length: CARDINAL;  colour: ColourType);
  319.  
  320.     (* Draws a string of "length" characters starting at location (x,y) *)
  321.     (* It is the caller's responsibility to ensure that the string will *)
  322.     (* not run off the screen edges.                                    *)
  323.  
  324.     <* m2extensions+ *>
  325.     <* storage+ *>
  326.  
  327.     VAR bufptr: POINTER TO ARRAY OF CHAR;
  328.  
  329.     BEGIN
  330.         NEW (bufptr, length);
  331.         Extract (text, 0, length, bufptr^);
  332.         IF BLorigin THEN
  333.             Graph.RawOutText (x, YM-1-y, colour, bufptr^);
  334.         ELSE
  335.             Graph.RawOutText (x, y, colour, bufptr^);
  336.         END (*IF*);
  337.         DISPOSE (bufptr);
  338.     END PlotString;
  339.  
  340.     <* m2extensions- *>
  341.     <* storage- *>
  342.  
  343. (************************************************************************)
  344.  
  345. PROCEDURE ClippedString (VAR (*IN*) text: ARRAY OF CHAR;
  346.                         x, y, length: CARDINAL;  colour: ColourType;
  347.                         left, right, ymin, ymax: CARDINAL);
  348.  
  349.     (* Like PlotString, but excludes any points which fall outside the  *)
  350.     (* clip rectangle defined by (left,right,ymin,ymax).                *)
  351.  
  352.     BEGIN
  353.         IF BLorigin THEN
  354.             Graph.SetClipRgn (left, YM1-ymax, right, YM1-ymin);
  355.         ELSE
  356.             Graph.SetClipRgn (left, ymin, right, ymax);
  357.         END (*IF*);
  358.         PlotString (text, x, y, length, colour);
  359.         Graph.CancelClipRgn();
  360.     END ClippedString;
  361.  
  362. (************************************************************************)
  363.  
  364. PROCEDURE PlotStringUp (VAR (*IN*) text: ARRAY OF CHAR;
  365.                         x, y, length: CARDINAL;  colour: ColourType);
  366.  
  367.     (* Like PlotString, but with text written in the +Y direction       *)
  368.  
  369.     BEGIN
  370.         (* NOT YET IMPLEMENTED *)
  371.     END PlotStringUp;
  372.  
  373. (************************************************************************)
  374.  
  375. PROCEDURE ClippedUpString (VAR (*IN*) text: ARRAY OF CHAR;
  376.                         x, y, length: CARDINAL;  colour: ColourType;
  377.                         left, right, ymin, ymax: CARDINAL);
  378.  
  379.     (* Like ClippedString, but with text written in the +Y direction.   *)
  380.  
  381.     BEGIN
  382.         IF BLorigin THEN
  383.             Graph.SetClipRgn (left, YM1-ymax, right, YM1-ymin);
  384.         ELSE
  385.             Graph.SetClipRgn (left, ymin, right, ymax);
  386.         END (*IF*);
  387.         PlotStringUp (text, x, y, length, colour);
  388.         Graph.CancelClipRgn();
  389.     END ClippedUpString;
  390.  
  391. (************************************************************************)
  392.  
  393. BEGIN
  394.     GraphicsScreenOpen := FALSE;
  395.     XM := 320;  YM := 200;  NumColours := 16;
  396. FINALLY
  397.     IF GraphicsScreenOpen THEN
  398.         Graph.Exit;
  399.     END (*IF*);
  400. END Graphics.
  401.  
  402.