home *** CD-ROM | disk | FTP | other *** search
/ World of Shareware - Software Farm 2 / wosw_2.zip / wosw_2 / CPROG / PGRAPH.ZIP / PASCAL.ZIP / DEMO.PAS < prev    next >
Pascal/Delphi Source File  |  1991-10-14  |  7KB  |  232 lines
  1. program PGraph_Demo;
  2.  
  3. {*******************************************************************
  4.  *                                                                  *
  5.  *  'Printer Graphics Interface' Demonstration Program              *
  6.  *                                                                  *
  7.  *  This program demonstrates how to use various functions          *
  8.  *  available in the PGRAPH library.                                *
  9.  *                                                                  *
  10.  *  Author: F van der Hulst                                         *
  11.  *                                                                  *
  12.  * Revisions:                                                       *
  13.  * 27 March   1991: Initial release (Turbo C v2.0 only)             *
  14.  * 07 April   1991: Ported to MicroSoft C v5.1                      *
  15.  * 15 October 1991: Rewritten in Turbo-Pascal                       *
  16.  *                                                                  *
  17.  *******************************************************************}
  18.  
  19. uses demo_sub, demo_scr, pgraph, pgrafbuf, various;
  20.  
  21. const MAX_WIDTH = 801;            { Maximum width of any PGRAPH viewport defined in the program }
  22.  
  23. type page_size_type = record
  24.     x, y: integer;
  25. end;
  26.  
  27. const page_size: array[1..5] of page_size_type = (
  28. { Page sizes in 1/100 of an inch available on various printers }
  29.     (x:800; y:1100),                    { STAR }
  30.     (x:780; y:1088),              { LaserJet }
  31.     (x:800; y:1100),                    { Epson LX400 }
  32.     (x:800; y:1100),                    { USER1 }
  33.     (x:800; y:1100) );                { USER2 }
  34.  
  35.  
  36. {*******************************************************************
  37.  Process command line arguments. }
  38. procedure strupr(var str: string);
  39. var i: integer;
  40. begin
  41.     for i := 1 to length(str) do str[i] := upcase(str[i]);
  42. end;
  43.  
  44. procedure get_args(var driver: integer;
  45.                          var mode: integer;
  46.                          var dev_name: string;
  47.                          var demos: string);
  48.  
  49. var i, code, low, high: integer;
  50. var param: string;
  51.  
  52. begin
  53.     for i := 1 to paramcount do begin
  54.         param := paramstr(i);
  55.         strupr(param);
  56.         if (param[1] <> '/') and (param[1] <> '-') then begin
  57.             writeln('Invalid command line switch:', param);
  58.             writeln('(Must start with "-" or "/")');
  59.             writeln('Use /? to get help');
  60.             halt(1);
  61.         end;
  62.         if (param[2] = '?') or (param[2] = 'H') then begin
  63.             writeln('Command syntax:');
  64.             writeln(paramstr(0), '[/O=outputdevice][/P=printer][/M=mode][/D=demos]');
  65.             writeln;
  66.             writeln('outputdevice may be PRN, or a filename');
  67.             writeln('printer may be STAR, LASERJET, LX-400, USER1, or USER2');
  68.             writeln('   If you use LX-400, USER1, USER2, the corresponding .PGI file');
  69.             writeln('   must be in the current directory');
  70.             writeln('mode is an integer in the range 0 to the maximum mode for the selected printer');
  71.             writeln('demos is a series of letters (A-L), identifying which demos to print');
  72.             writeln;
  73.             writeln('Default values are PRN and STAR, and a mode better than 120dpi)');
  74.             writeln;
  75.             halt(0);
  76.         end;
  77.         if (param[3] <> '=') then begin
  78.             writeln('Invalid command line switch: ', param);
  79.             writeln('(Must be /', param[2], '=VALUE)');
  80.             writeln('Use /? to get help\n');
  81.             halt(1);
  82.         end;
  83.         case param[2] of
  84.         'O': begin
  85.             delete(param, 1, 3);
  86.             dev_name := param;
  87.         end;
  88.         'P': begin
  89.             delete(param, 1, 3);
  90.             if param = 'STAR'                then driver := STAR
  91.             else if param = 'LX-400'     then driver := LX400
  92.             else if param = 'LASERJET'    then driver := LASERJET
  93.             else if param = 'USER1'        then driver := USER1
  94.             else if param = 'USER2'        then driver := USER2
  95.             else begin
  96.                 writeln('Unknown printer type: ', param);
  97.                 writeln('Use /? to get help');
  98.                 halt(1);
  99.             end;
  100.         end;
  101.         'M': begin
  102.             delete(param, 1, 3);
  103.             val(param, mode, code);
  104.             p_getmoderange(driver, low, high);
  105.             if (mode > high) or (mode < low) then begin
  106.                 writeln('Invalid mode: ', mode, ' (should be ', low, ' - ', high);
  107.                 halt(1);
  108.             end;
  109.         end;
  110.         'D': begin
  111.             delete(param, 1, 3);
  112.             demos := param;
  113.         end;
  114.         else begin
  115.             writeln('Invalid command line switch: ', param);
  116.             writeln('(Must be /D, /O, /P, or /M)');
  117.             writeln('Use /? to get help');
  118.             halt(1);
  119.         end;
  120.         end;
  121.     end;
  122. end;
  123.  
  124. {*******************************************************************
  125.  Find the best mode (the worst X resolution that will display
  126.  MAX_WIDTH bits) for the selected printer. }
  127.  
  128. function best_mode: integer;
  129. var i: integer;
  130. var xres, yres, best_x, best_y: integer;
  131. var mode: integer;
  132.  
  133. begin
  134.     mode := 0;
  135.     best_y := 1000;
  136.     best_x := 1000;
  137.     for i := 0 to p_getmaxmode do begin
  138.         p_setgraphmode(i);
  139.         p_getresolution(xres, yres);
  140.         if longint(xres) * page_width div 100 >= MAX_WIDTH+7
  141.         then if (xres < best_x) or ((xres = best_x) and (yres < best_y)) then begin
  142.                 best_y := yres;
  143.                 best_x := xres;
  144.                 mode := i;
  145.         end;
  146.     end;
  147.     best_mode :=  mode;
  148. end;
  149.  
  150. var driver, mode, dummy_mode, errorcode: integer;
  151. var xres, yres: integer;
  152. var filename: string;
  153. var selection: string;
  154. var BGI_path: string;
  155. const printer_ID: array[1..5] of string = ('STAR', 'LASERJET', 'LX-400', 'USER1', 'USER2' );
  156.  
  157. begin  { Main block }
  158.     driver := 1;
  159.     mode := -1;
  160.     filename := 'PRN';
  161.     selection := 'ABCDEFGHIJKL';
  162.     BGI_path := '';
  163.  
  164.     screen_echo := false;
  165.     init_buffering;
  166.     __p_putpixel_screen := nil;
  167.  
  168.     errorcode := p_registerbgidriver(@LASERJET_DRIVER);
  169.     if errorcode < 0 then begin
  170.         writeln('Couldn''t register LASERJET PGI driver: ', errorcode);
  171.         halt(2);
  172.     end;
  173.  
  174.     errorcode := p_registerfarbgidriver(@STAR_DRIVER);
  175.     if errorcode < 0 then begin
  176.         writeln('Couldn''t register STAR PGI driver: ', errorcode);
  177.         halt(2);
  178.     end;
  179.  
  180.  
  181.     get_args(driver, mode, filename, selection);
  182.  
  183.     writeln('Selection is:');
  184.     writeln('   Output to ', filename);
  185.     writeln('   Printer type is ', printer_ID[driver]);
  186.     writeln('   Demo selection is ', selection);
  187.     writeln;
  188.  
  189. { REMOVED TO ALLOW RUNNING FROM BATCH FILE
  190.     write('Is this OK (Y/N)? ');
  191.     if ((getch & 0x0df) <> 'Y') halt(1);
  192.     write('\n\n');
  193. }
  194.  
  195.     assign(prn, filename);
  196.     rewrite(prn);
  197.  
  198.     if mode = -1
  199.     then dummy_mode := 0
  200.     else dummy_mode := mode;
  201.  
  202.     p_initgraph(driver, dummy_mode, BGI_path);
  203.     errorcode := p_graphresult;             { preserve error return }
  204.     if (errorcode <> 0) then begin                    { error? }
  205.         writeln('Graphics error: ', errorcode {grapherrormsg(errorcode)});
  206.         halt(1);
  207.     end;
  208.     page_height := page_size[driver].y;
  209.     page_width := page_size[driver].x;
  210.     if (mode < 0) or (mode > p_getmaxmode)    then    mode := best_mode;
  211.     p_setgraphmode(mode);
  212.     p_getresolution(xres, yres);
  213.     writeln('Currently set to mode ', mode, ' (', xres, ' by ', yres, 'dpi).');
  214.     if pos('A', selection) > 0 then shapes_demo;
  215.     if pos('B', selection) > 0 then stroked_fonts_demo;
  216.     if pos('C', selection) > 0 then default_font_demo;
  217.     if pos('D', selection) > 0 then horiz_text_demo;
  218.     if pos('E', selection) > 0 then vert_text_demo;
  219.     if pos('F', selection) > 0 then text_scaling_demo;
  220.     if pos('G', selection) > 0 then shape_fill_demo;
  221.     if pos('H', selection) > 0 then flood_fill_demo;
  222.     if pos('I', selection) > 0 then lines_demo;
  223.     if pos('J', selection) > 0 then pie_demo;
  224.     if pos('K', selection) > 0 then image_demo;
  225.     if pos('L', selection) > 0 then view_demo;
  226.  
  227.     writeln('Closing PGRAPH down.');
  228.     p_closegraph;
  229.     writeln('Closing output file.');
  230.     close(prn);
  231. end.
  232.