home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / UTILITY / PRINTER / PGRAF130.ZIP / PASCAL.ZIP / DEMO_SUB.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-10-14  |  24.3 KB  |  797 lines
  1. unit demo_sub;
  2.  
  3. {*******************************************************************
  4.  *                                                                  *
  5.  *  'Printer Graphics Interface' Demonstration Program              *
  6.  *  Demonstration Subrotuines Module                                *
  7.  *                                                                  *
  8.  *  Main program: DEMO.PAS                                                        *
  9.  *  Author: F van der Hulst                                         *
  10.  *                                                                  *
  11.  * Revisions:                                                       *
  12.  * 27 March   1991: Initial release (Turbo C v2.0 only)             *
  13.  * 07 April   1991: Ported to MicroSoft C v5.1                      *
  14.  * 15 October 1991: Rewritten in Turbo-Pascal                       *
  15.  *                                                                  *
  16.  *******************************************************************}
  17. interface
  18. uses graph, pgraph, dos, various;
  19.  
  20. procedure shapes_demo;
  21. procedure stroked_fonts_demo;
  22. procedure Default_Font_demo;
  23. procedure horiz_text_demo;
  24. procedure vert_text_demo;
  25. procedure text_scaling_demo;
  26. procedure shape_Fill_demo;
  27. procedure flood_Fill_demo;
  28. procedure lines_demo;
  29. procedure pie_demo;
  30.  
  31. procedure end_slice;
  32.  
  33. var page_height, page_width: integer;    { Size of page in pixels }
  34. var prn: file of char;                        { Output device }
  35. var screen_echo: boolean;
  36.  
  37. implementation
  38. const MAX_WIDTH = 801;        { Maximum width of any PGRAPH viewport defined in the program }
  39.  
  40. function min(x, y: integer): integer;
  41. begin
  42.     if (x < y)
  43.     then min := x
  44.     else min := y;
  45. end;
  46.  
  47. function max(x, y: integer): integer;
  48. begin
  49.     if (x > y)
  50.     then max := x
  51.     else max := y;
  52. end;
  53.  
  54. var line_num: integer;
  55. var FF: char;
  56.  
  57.  
  58. {*******************************************************************
  59.  End of outputting a slice to the buffer. Check to see whether it will
  60.  fit on the current page. If not skip to the top of the next page }
  61.  
  62. procedure end_slice;
  63. var
  64.     xres, yres: integer;
  65.     height: integer;
  66.  
  67. begin
  68.     p_getresolution(xres, yres);
  69.     xres := p_getmaxx;
  70.     height := p_getmaxy + 1;
  71.     line_num := line_num + height;
  72.     if (line_num > longint(yres) * page_height div 100) then begin
  73.         line_num := height;
  74.         write(prn, FF);
  75.     end;
  76.  
  77.     if not screen_echo then write('Printing...');
  78.     p_print(filerec(prn).handle);
  79.     if not screen_echo then writeln;
  80.     p_cleardevice;
  81. end;
  82.  
  83. {********************************************************************
  84.  Draw lines, ellipses, polygons, move graphics cursor }
  85.  
  86. procedure shapes_demo;
  87. var
  88.     xasp, yasp: integer;
  89.     xres, yres: integer;
  90.     error_code: integer;
  91.     width, height: integer;
  92.     free_space: longint;
  93.     arccoords: arccoordstype;
  94.  
  95. const polypoints: array[0..13] of integer = (
  96.     500, 160,
  97.     500, 340,
  98.     450, 250,
  99.     400, 250,
  100.     350, 330,
  101.     360, 170,
  102.     500, 160);
  103.  
  104. begin
  105.     writeln; writeln;
  106.     writeln('SHAPES DEMO');
  107.     writeln;
  108.     p_getresolution(xres, yres);
  109.     p_setviewport(0, 0, 0, 0, 0);
  110.     free_space := memavail - $4000;       { Leave room for other graph memory uses }
  111.     width := trunc((longint(xres) * longint(page_width)) / 100);
  112.     height := integer(free_space * 8 div width);
  113.     height := min(height, integer(longint(yres) * page_height div 100));
  114.     writeln('Setting ', width, ' by ', height, ' pixel (', width div xres,
  115.     '*', height div yres, ' inches) viewport');
  116.     p_setviewport(0, 0, width - 1, height - 1, 0);
  117.     error_code := p_graphresult;
  118.     if (error_code <> 0) or (height < 340) then writeln('Failed... Insufficient memory')
  119.     else begin
  120.         p_setlinestyle(4, $8080, 1);
  121.         p_rectangle(0, 0, p_getmaxx, p_getmaxy);
  122.         p_setlinestyle(2, 0, 1);
  123.         writeln('p_drawpoly(7, polypoints);');
  124.         p_drawpoly(7, polypoints);
  125.         writeln('p_rectangle(220, 140, 270, 10);');
  126.         p_rectangle(220, 240, 270, 110);
  127.         writeln('p_circle(p_getmaxx - 120, 100, 100);');
  128.         p_circle(p_getmaxx - 120, 100, 100);
  129.         writeln('p_arc(p_getmaxx - 220, 100, 45, 135, 100);');
  130.         p_arc(p_getmaxx - 220, 100, 45, 135, 100);
  131.         p_getarccoords(arccoords);
  132.         writeln('Last arc centred at (', arccoords.x, ', ', arccoords.y,
  133.             '), from (', arccoords.xstart, ', ', arccoords.ystart,
  134.             ') to (', arccoords.xend, ', ', arccoords.yend, ')');
  135.         writeln('p_ellipse(90, 10, 0, 360, 30, 10);');
  136.         p_ellipse(90, 10, 0, 360, 30, 10);
  137.         writeln('p_ellipse(160, 10, 0, 360, 5, 10);');
  138.         p_ellipse(160, 10, 0, 360, 5, 10);
  139.         writeln('p_ellipse(200, 10, 45, 135, 30, 10);');
  140.         p_ellipse(200, 10, 45, 135, 30, 10);
  141.         writeln('p_ellipse(240, 10, 45, 135, 5, 10);');
  142.         p_ellipse(240, 10, 45, 135, 5, 10);
  143.         writeln('p_ellipse(280, 10, 45, 225, 30, 10);');
  144.         p_ellipse(280, 10, 45, 225, 30, 10);
  145.         writeln('p_getaspectratio(xasp, yasp);');
  146.         writeln('p_setaspectratio(xasp, yasp div 3);');
  147.         p_getaspectratio(xasp, yasp);
  148.         p_setaspectratio(xasp, yasp div 3);
  149.         writeln('Same circle and arc as above, but Ycentre at 390');
  150.         p_circle(p_getmaxx - 120, 390, 100);
  151.         p_arc(p_getmaxx - 220, 390, 45, 135, 100);
  152.         writeln('Width = ', p_getmaxx, ', Height = ', p_getmaxy);
  153.         writeln('Current position = (', p_getx, ', ', p_gety, ')');
  154.         writeln('p_moveto(40, 50);');
  155.         p_moveto(40, 50);
  156.         writeln('Current position = (', p_getx, ', ', p_gety, ')');
  157.         writeln('p_moverel(+20, -10);');
  158.         p_moverel(+20, -10);
  159.         writeln('Current position = (', p_getx, ', ', p_gety, ')');
  160.  
  161.         writeln('Various ellipse fragments');
  162.         p_ellipse(450, 60,   0,  20, 100, 50);
  163.         p_ellipse(450, 60,  30,  60, 100, 50);
  164.         p_ellipse(450, 60,  70,  90, 100, 50);
  165.         p_ellipse(450, 60,  90, 110, 100, 50);
  166.         p_ellipse(450, 60, 120, 150, 100, 50);
  167.         p_ellipse(450, 60, 160, 180, 100, 50);
  168.         p_ellipse(450, 60, 180, 200, 100, 50);
  169.         p_ellipse(450, 60, 210, 240, 100, 50);
  170.         p_ellipse(450, 60, 250, 270, 100, 50);
  171.         p_ellipse(450, 60, 270, 290, 100, 50);
  172.         p_ellipse(450, 60, 300, 330, 100, 50);
  173.         p_ellipse(450, 60, 340, 360, 100, 50);
  174.         p_ellipse(100, 140, 20, 340, 100, 50);
  175.  
  176.         writeln('Lines');
  177.         p_setlinestyle(3, 0, 1);
  178.         p_line(100, 140, 200, 140);
  179.         p_line(100, 140, 100, 90);
  180.         p_line(0, 200, 10, 250);
  181.         p_line(0, 200, 50, 210);
  182.         p_line(50, 210, 0, 220);
  183.         p_line(50, 210, 40, 250);
  184.         p_moveto(450, 60);
  185.         p_linerel(100, 0);
  186.         p_lineto(450, 110);
  187.  
  188.         writeln('Pixels');
  189.         p_putpixel(319, 0, 1);
  190.         p_putpixel(319, 1, 1);
  191.         p_putpixel(319, 1, 0);
  192.         end_slice;
  193.     end;
  194. end;
  195.  
  196. {*******************************************************************
  197.  Register stroked fonts, and print them in different sizes and
  198.  orientations }
  199.  
  200. procedure stroked_fonts_demo;
  201. var goth_height, next_line: integer;
  202. var errorcode: integer;
  203.  
  204. begin
  205.     writeln; writeln;
  206.     writeln('STROKED FONTS DEMO');
  207.     writeln;
  208.     p_setviewport(0, 0, 719, 170, 0);
  209.     errorcode := p_registerbgifont(@Gothic_Font);
  210.     if errorcode < 0 then begin
  211.         writeln('Couldn''t register Gothic font: ', errorcode);
  212.         halt(2);
  213.     end;
  214.     errorcode := p_registerfarbgifont(@Script_Font_far);
  215.     if errorcode < 0 then begin
  216.         writeln('Couldn''t register Script font: ', errorcode);
  217.         halt(2);
  218.     end;
  219.     writeln('Printing text size 1, horizontally');
  220.     p_settextstyle(GothicFont, HorizDir, 1);
  221.     p_outtextxy(0, 0, 'Gothic 1');
  222.     goth_height := p_textheight('Gothic 1');
  223.     p_settextstyle(ScriptFont, HorizDir, 1);
  224.     p_outtextxy(200, 0, 'Script 1');
  225.     next_line := max(p_textheight('Script 1'), goth_height);
  226.  
  227.     writeln('Printing text size 1, vertically');
  228.     p_settextstyle(GothicFont, VertDir, 1);
  229.     p_outtextxy(360, 0, 'Gothic 1');
  230.     p_settextstyle(ScriptFont, VertDir, 1);
  231.     p_outtextxy(380, 0, 'Script 1');
  232.  
  233.     writeln('Printing text size 2, horizontally');
  234.     p_settextstyle(GothicFont, HorizDir, 2);
  235.     p_outtextxy(0, next_line, 'Gothic 2');
  236.     goth_height := p_textheight('Gothic 2');
  237.     p_settextstyle(ScriptFont, HorizDir, 2);
  238.     p_outtextxy(200, next_line, 'Script 2');
  239.     next_line := next_line + max(p_textheight('Script 2'), goth_height);
  240.  
  241.     writeln('Printing text size 2, vertically');
  242.     p_settextstyle(GothicFont, VertDir, 2);
  243.     p_outtextxy(410, 0, 'Gothic 2');
  244.     p_settextstyle(ScriptFont, VertDir, 2);
  245.     p_outtextxy(430, 0, 'Script 2');
  246.  
  247.     writeln('Printing text size 3, horizontally');
  248.     p_settextstyle(GothicFont, HorizDir, 3);
  249.     p_outtextxy(0, next_line, 'Gothic 3');
  250.     goth_height := p_textheight('Gothic 3');
  251.     p_settextstyle(ScriptFont, HorizDir, 3);
  252.     p_outtextxy(200, next_line, 'Script 3');
  253.     next_line := next_line + max(p_textheight('Script 3'), goth_height);
  254.  
  255.     writeln('Printing text size 3, vertically');
  256.     p_settextstyle(GothicFont, VertDir, 3);
  257.     p_outtextxy(465, 0, 'Gothic 3');
  258.     p_settextstyle(ScriptFont, VertDir, 3);
  259.     p_outtextxy(500, 0, 'Script 3');
  260.  
  261.     writeln('Printing text size 4, horizontally');
  262.     p_settextstyle(GothicFont, HorizDir, 4);
  263.     p_outtextxy(0, next_line, 'Gothic 4');
  264.     goth_height := p_textheight('Gothic 4');
  265.     p_settextstyle(ScriptFont, HorizDir, 4);
  266.     p_outtextxy(200, next_line, 'Script 4');
  267.     next_line := next_line + max(p_textheight('Script 4'), goth_height);
  268.  
  269.     writeln('Printing text size 4, vertically');
  270.     p_settextstyle(GothicFont, VertDir, 4);
  271.     p_outtextxy(540, 0, 'Gothic 4');
  272.     p_settextstyle(ScriptFont, VertDir, 4);
  273.     p_outtextxy(580, 0, 'Script 4');
  274.  
  275.     writeln('Printing text size 5, horizontally');
  276.     p_settextstyle(GothicFont, HorizDir, 5);
  277.     p_outtextxy(0, next_line, 'Gothic 5');
  278.     p_settextstyle(ScriptFont, HorizDir, 5);
  279.     p_outtextxy(200, next_line, 'Script 5');
  280.  
  281.     writeln('Printing text size 5, vertically');
  282.     p_settextstyle(GothicFont, VertDir, 5);
  283.     p_outtextxy(620, 0, 'Gothic 5');
  284.     p_settextstyle(ScriptFont, VertDir, 5);
  285.     p_outtextxy(660, 0, 'Script 5');
  286.  
  287.     end_slice;
  288.  
  289.     p_setviewport(0, 0, 550, 240, 0);
  290.     writeln('Printing text size 9, horizontally');
  291.     p_settextstyle(GothicFont, HorizDir, 9);
  292.     p_outtextxy(0, 0, 'Gothic 9');
  293.     next_line := p_textheight('Gothic 9');
  294.  
  295.     writeln('Printing text size 10, horizontally');
  296.     p_settextstyle(GothicFont, HorizDir, 10);
  297.     p_outtextxy(0, next_line, 'Gothic 10');
  298.  
  299.     end_slice;
  300. end;
  301.  
  302. {*******************************************************************
  303.  Print default font in various sizes and orientations }
  304. procedure Default_Font_demo;
  305. begin
  306.     writeln; writeln;
  307.     writeln('DEFAULT FONT DEMO');
  308.     writeln;
  309.     p_setviewport(0, 0, 680, 199, 0);
  310.     writeln('Printing text size 1, horizontally');
  311.     p_settextstyle(DefaultFont, HorizDir, 1);
  312.     p_outtextxy(0, 0, 'Default 1');
  313.     writeln('Printing text size 1, vertically');
  314.     p_settextstyle(DefaultFont, VertDir, 1);
  315.     p_outtextxy(360, 0, 'Default 1');
  316.  
  317.     writeln('Printing text size 2, horizontally');
  318.     p_settextstyle(DefaultFont, HorizDir, 2);
  319.     p_outtextxy(0, 18, 'Default 2');
  320.     writeln('Printing text size 2, vertically');
  321.     p_settextstyle(DefaultFont, VertDir, 2);
  322.     p_outtextxy(378, 0, 'Default 2');
  323.  
  324.     writeln('Printing text size 3, horizontally');
  325.     p_settextstyle(DefaultFont, HorizDir, 3);
  326.     p_outtextxy(0, 40, 'Default 3');
  327.     writeln('Printing text size 3, vertically');
  328.     p_settextstyle(DefaultFont, VertDir, 3);
  329.     p_outtextxy(416, 0, 'Default 3');
  330.  
  331.     writeln('Printing text size 4, horizontally');
  332.     p_settextstyle(DefaultFont, HorizDir, 4);
  333.     p_outtextxy(0, 65, 'Default 4');
  334.     writeln('Printing text size 4, vertically');
  335.     p_settextstyle(DefaultFont, VertDir, 4);
  336.     p_outtextxy(468, 0, 'Default 4');
  337.  
  338.     writeln('Printing text size 5, horizontally');
  339.     p_settextstyle(DefaultFont, HorizDir, 5);
  340.     p_outtextxy(0, 100, 'Default 5');
  341.     writeln('Printing text size 5, vertically');
  342.     p_settextstyle(DefaultFont, VertDir, 5);
  343.     p_outtextxy(520, 0, 'Default 5');
  344.  
  345.     writeln('Printing text size 6, horizontally');
  346.     p_settextstyle(DefaultFont, HorizDir, 6);
  347.     p_outtextxy(0, 150, 'Default 6');
  348.     writeln('Printing text size 6, vertically');
  349.     p_settextstyle(DefaultFont, VertDir, 6);
  350.     p_outtextxy(620, 0, 'Default 6');
  351.  
  352.     end_slice;
  353.  
  354.     p_setviewport(0, 0, 800, 89, 0);
  355.     writeln('Printing text size 10, horizontally');
  356.     p_settextstyle(DefaultFont, HorizDir, 10);
  357.     p_outtextxy(0, 0, 'Default 10');
  358.  
  359.     end_slice;
  360. end;
  361.  
  362. {*******************************************************************
  363.  Print stroked and default font horizontally, using various
  364.  justification settings }
  365.  
  366. procedure horiz_text_demo;
  367. var i: integer;
  368. begin
  369.  
  370.     writeln; writeln; writeln('HORIZONTAL JUSTIFICATION DEMO');
  371.     writeln;
  372.     p_setviewport(0, 0, 760, 175, 0);
  373.     p_setlinestyle(DOTTEDLN, 0, NormWidth);
  374.     for i := 1 to 150 div 25 do
  375.         p_line(0,  i * 25, p_getmaxx,  i * 25);
  376.     for i := 1 to p_getmaxx div 100 do
  377.         p_line( i * 100, 0,  i * 100, p_getmaxy);
  378.  
  379.     writeln('Printing Triplex');
  380.     p_settextstyle(TriplexFont, HorizDir, 1);
  381.     p_settextjustify(LeftText, TopText);
  382.     p_outtextxy(100, 50, 'Triplex left top');
  383.  
  384.     p_settextjustify(LeftText, CenterText);
  385.     p_outtextxy(300, 50, 'Triplex left centre');
  386.  
  387.     p_settextjustify(LeftText, BottomText);
  388.     p_outtextxy(500, 50, 'Triplex left bottom');
  389.  
  390.     p_settextjustify(CenterText, TopText);
  391.     p_outtextxy(100, 100, 'Triplex centre top');
  392.  
  393.     p_settextjustify(CenterText, CenterText);
  394.     p_outtextxy(300, 100, 'Triplex centre centre');
  395.  
  396.     p_settextjustify(CenterText, BottomText);
  397.     p_outtextxy(500, 100, 'Triplex centre bottom');
  398.  
  399.     p_settextjustify(RightText, TopText);
  400.     p_outtextxy(100, 150, 'Triplex right top');
  401.  
  402.     p_settextjustify(RightText, CenterText);
  403.     p_outtextxy(300, 150, 'Triplex right centre');
  404.  
  405.     p_settextjustify(RightText, BottomText);
  406.     p_outtextxy(500, 150, 'Triplex right bottom');
  407.  
  408.     writeln('Printing Default');
  409.     p_settextstyle(DefaultFont, HorizDir, 1);
  410.     p_settextjustify(LeftText, TopText);
  411.     p_outtextxy(200, 25, 'Default left top');
  412.  
  413.     p_settextjustify(LeftText, CenterText);
  414.     p_outtextxy(400, 25, 'Default left centre');
  415.  
  416.     p_settextjustify(LeftText, BottomText);
  417.     p_outtextxy(600, 25, 'Default left bottom');
  418.  
  419.     p_settextjustify(CenterText, TopText);
  420.     p_outtextxy(200, 75, 'Default centre top');
  421.  
  422.     p_settextjustify(CenterText, CenterText);
  423.     p_outtextxy(400, 75, 'Default centre centre');
  424.  
  425.     p_settextjustify(CenterText, BottomText);
  426.     p_outtextxy(600, 75, 'Default centre bottom');
  427.  
  428.     p_settextjustify(RightText, TopText);
  429.     p_outtextxy(200, 125, 'Default right top');
  430.  
  431.     p_settextjustify(RightText, CenterText);
  432.     p_outtextxy(400, 125, 'Default right centre');
  433.  
  434.     p_settextjustify(RightText, BottomText);
  435.     p_outtextxy(600, 125, 'Default right bottom');
  436.  
  437.     end_slice;
  438. end;
  439.  
  440. {*******************************************************************
  441.  Print stroked and default font vertically, using various
  442.  justification settings }
  443.  
  444. procedure vert_text_demo;
  445. var i: integer;
  446. begin
  447.  
  448.     writeln; writeln;
  449.     writeln('VERTICAL JUSTIFICATION DEMO');
  450.     writeln;
  451.     p_setviewport(0, 0, 642, 180, 0);
  452.     p_setlinestyle(DottedLn, 0, NormWidth);
  453.     for i := 1 to 150 div 25 do
  454.         p_line(0,  i * 25, p_getmaxx,  i * 25);
  455.     for i := 1 to p_getmaxx div 20 do
  456.         p_line( i * 20, 0,  i * 20, p_getmaxy);
  457.  
  458.     writeln('Printing Triplex');
  459.     p_settextstyle(TriplexFont, VertDir, 1);
  460.     p_settextjustify(LeftText, TopText);
  461.     p_outtextxy(100, 50, 'Triplex left top');
  462.  
  463.     p_settextjustify(LeftText, CenterText);
  464.     p_outtextxy(300, 50, 'Triplex left centre');
  465.  
  466.     p_settextjustify(LeftText, BottomText);
  467.     p_outtextxy(500, 50, 'Triplex left bottom');
  468.  
  469.     p_settextjustify(CenterText, TopText);
  470.     p_outtextxy(120, 100, 'Triplex centre top');
  471.  
  472.     p_settextjustify(CenterText, CenterText);
  473.     p_outtextxy(320, 100, 'Triplex centre centre');
  474.  
  475.     p_settextjustify(CenterText, BottomText);
  476.     p_outtextxy(520, 100, 'Triplex centre bottom');
  477.  
  478.     p_settextjustify(RightText, TopText);
  479.     p_outtextxy(140, 150, 'Triplex right top');
  480.  
  481.     p_settextjustify(RightText, CenterText);
  482.     p_outtextxy(340, 150, 'Triplex right centre');
  483.  
  484.     p_settextjustify(RightText, BottomText);
  485.     p_outtextxy(540, 150, 'Triplex right bottom');
  486.  
  487.     writeln('Printing Default');
  488.     p_settextstyle(DefaultFont, VertDir, 1);
  489.     p_settextjustify(LeftText, TopText);
  490.     p_outtextxy(200, 25, 'Default left top');
  491.  
  492.     p_settextjustify(LeftText, CenterText);
  493.     p_outtextxy(400, 25, 'Default left centre');
  494.  
  495.     p_settextjustify(LeftText, BottomText);
  496.     p_outtextxy(600, 25, 'Default left bottom');
  497.  
  498.     p_settextjustify(CenterText, TopText);
  499.     p_outtextxy(220, 75, 'Default centre top');
  500.  
  501.     p_settextjustify(CenterText, CenterText);
  502.     p_outtextxy(420, 75, 'Default centre centre');
  503.  
  504.     p_settextjustify(CenterText, BottomText);
  505.     p_outtextxy(620, 75, 'Default centre bottom');
  506.  
  507.     p_settextjustify(RightText, TopText);
  508.     p_outtextxy(240, 125, 'Default right top');
  509.  
  510.     p_settextjustify(RightText, CenterText);
  511.     p_outtextxy(440, 125, 'Default right centre');
  512.  
  513.     p_settextjustify(RightText, BottomText);
  514.     p_outtextxy(640, 125, 'Default right bottom');
  515.  
  516.     end_slice;
  517. end;
  518.  
  519. {*******************************************************************
  520.  Print stroked font, using various scaling factors }
  521.  
  522. procedure text_scaling_demo;
  523. var texttypeinfo: textsettingstype;
  524. var lomode, himode: integer;
  525. var x, y: string;
  526. begin
  527.  
  528.     writeln; writeln;
  529.     writeln('TEXT SCALING DEMO');
  530.     writeln;
  531.     writeln('Current graph mode    = ', p_getgraphmode);
  532.     writeln('Maximum graph mode    = ', p_getmaxmode);
  533.     writeln('Printer name          = ', p_getdrivername);
  534.     writeln('Graph mode name       = ', p_getmodename(p_getgraphmode));
  535.     p_getmoderange(STAR, lomode, himode);
  536.     writeln('Star NX-10 mode range = ', lomode, ' -- ', himode);
  537.  
  538.     p_setviewport(0, 0, 660, 190, 0);
  539.     p_settextstyle(TriplexFont, VertDir, 1);
  540.     p_settextjustify(LeftText, TopText);
  541.  
  542.     p_gettextsettings(texttypeinfo);
  543.     write('Text set to font no. ', texttypeinfo.font,
  544.               ', direction = ');
  545.     if texttypeinfo.direction = HorizDir
  546.     then write('Horizontal')
  547.     else write('Vertical');
  548.     writeln(', size = %d', texttypeinfo.charsize);
  549.     write('Text justification is ');
  550.     if texttypeinfo.horiz = LeftText
  551.     then write('Left, ')
  552.     else if texttypeinfo.horiz = CenterText
  553.     then write('Centre, ')
  554.     else write('Right, ');
  555.     if texttypeinfo.vert = TopText
  556.     then writeln('Top')
  557.     else if texttypeinfo.vert = CenterText
  558.     then writeln('Centre')
  559.     else writeln('Bottom');
  560.  
  561.     p_settextstyle(DefaultFont, HorizDir, 2);
  562.     p_settextjustify(CenterText, BottomText);
  563.  
  564.     p_gettextsettings(texttypeinfo);
  565.     write('Text set to font no. ', texttypeinfo.font,
  566.               ', direction = ');
  567.     if texttypeinfo.direction = HorizDir
  568.     then write('Horizontal')
  569.     else write('Vertical');
  570.     writeln(', size = %d', texttypeinfo.charsize);
  571.     writeln('Text justification is ');
  572.     if texttypeinfo.horiz = LeftText
  573.     then write('Left, ')
  574.     else if texttypeinfo.horiz = CenterText
  575.     then write('Centre, ')
  576.     else write('Right, ');
  577.     if texttypeinfo.vert = TopText
  578.     then writeln('Top')
  579.     else if texttypeinfo.vert = CenterText
  580.     then writeln('Centre')
  581.     else writeln('Bottom');
  582.  
  583.  
  584.     p_setusercharsize(3, 2, 1, 2);
  585.     p_settextstyle(TriplexFont, HorizDir, 0);
  586.     p_settextjustify(LeftText, TopText);
  587.     p_outtextxy(0, 0, 'Treble width, Normal height');
  588.     p_setusercharsize(1, 2, 1, 2);
  589.     p_outtextxy(0, 15, 'Normal width, Normal height');
  590.     p_setusercharsize(1, 2, 3, 2);
  591.     p_outtextxy(0, 25, 'Normal width, Treble height');
  592.     p_setusercharsize(3, 2, 3, 2);
  593.     p_outtextxy(0, 60, 'Treble width, Treble height');
  594.     p_setusercharsize(1, 6, 1, 2);
  595.     p_outtextxy(0, 110, '1/3 width, Normal height');
  596.     p_setusercharsize(1, 2, 1, 6);
  597.     p_outtextxy(0, 140, 'Normal width, 1/3 height');
  598.     p_setusercharsize(1, 6, 1, 6);
  599.     p_outtextxy(0, 170, '1/3 width, 1/3 height');
  600.  
  601.     p_settextstyle(TriplexFont, HorizDir, 1);
  602.     writeln('Width, height of ''ABC'' in Triplex size  1 = ',
  603.                 p_textwidth('ABC'), ', ', p_textheight('ABC'));
  604.     p_settextstyle(TriplexFont, HorizDir, 10);
  605.     writeln('Width, height of ''ABC'' in Triplex size 10 = ',
  606.                 p_textwidth('ABC'), ', ', p_textheight('ABC'));
  607.  
  608.     p_settextstyle(DefaultFont, HorizDir, 1);
  609.     writeln('Width, height of ''ABC'' in Default size  1 = ',
  610.               p_textwidth('ABC'), ', ', p_textheight('ABC'));
  611.     p_settextstyle(DefaultFont, HorizDir, 10);
  612.     writeln('Width, height of ''ABC'' in Default size 10 = ',
  613.               p_textwidth('ABC'), ', ', p_textheight('ABC'));
  614.  
  615.     end_slice;
  616. end;
  617.  
  618. {*******************************************************************
  619.  Fill various shapes with various patterns }
  620.  
  621. procedure shape_Fill_demo;
  622. const polypoints: array[1..22] of integer = (
  623.     500, 10,
  624.     500, 190,
  625.     450, 100,
  626.     400, 100,
  627.     350, 180,
  628.     360, 20,
  629.     400, 20,
  630.     420, 70,
  631.     370, 100,
  632.     450, 20,
  633.     500, 10 );
  634. const user_pattern: fillpatterntype =  (
  635.     $f0, $0f, $f0, $0f, $f0, $0f, $f0, $0f);
  636. var i, xasp, yasp: integer;
  637.     fillinfo: fillsettingstype;
  638. var user_pattern2: fillpatterntype;
  639.  
  640. begin
  641.     writeln; writeln;
  642.     writeln('SHAPE FILLING DEMO');
  643.     writeln;
  644.     writeln('Printing in default viewport');
  645.     p_graphdefaults;
  646.     p_getaspectratio(xasp, yasp);
  647.     for i := 0 to 6 do begin
  648.         p_setfillstyle(i, 1);
  649.         p_getfillsettings(fillinfo);
  650.         writeln('Fill style set to ', fillinfo.pattern, ', colour ', fillinfo.color);
  651.         p_fillellipse(i * 40 + 20, 20, 20, (longint(20) * xasp) div yasp);
  652.     end;
  653.  
  654.     p_setfillpattern(user_pattern, 1);
  655.     p_getfillpattern(user_pattern2);
  656.     p_getfillsettings(fillinfo);
  657.     writeln('Fill style set to ', fillinfo.pattern, ', colour ', fillinfo.color);
  658.     p_fillellipse( 7 * 40 + 20, 20, 20, (longint(20) * xasp) div yasp);
  659.  
  660.     p_setfillstyle(LtSlashFill, 1);
  661.     writeln('p_fillpoly(11, polypoints);');
  662.     p_fillpoly(11, polypoints);
  663.  
  664.     writeln('p_bar(370, 100, 500, 170)');
  665.     p_bar(570, 100, 600, 170);
  666.     writeln('p_bar3d(0, 100, 50, 150, 25, 1)');
  667.     p_bar3d(0, 100, 50, 150, 25, 1);
  668.     writeln('p_bar3d(70, 100, 120, 150, 25, 0)');
  669.     p_bar3d(70, 100, 120, 150, 25, 0);
  670.     end_slice;
  671. end;
  672.  
  673. {*******************************************************************
  674.  Fill an arbitrary shape }
  675.  
  676. procedure flood_Fill_demo;
  677. const polypoints: array [1..22] of integer = (
  678.     200, 10,
  679.     200, 190,
  680.     150, 100,
  681.     100, 100,
  682.      50, 180,
  683.      60, 20,
  684.     100, 20,
  685.     120, 70,
  686.      70, 100,
  687.     150, 20,
  688.     200, 10);
  689.  
  690. begin
  691.     writeln; writeln;
  692.     writeln('FLOOD FILLING DEMO');
  693.     writeln;
  694.     p_setviewport(0, 0, 719, 199, 0);
  695.     p_setcolor(1);
  696.     writeln('Drawing polygon');
  697.     p_drawpoly(11, polypoints);
  698.     writeln('Including a circle');
  699.     p_circle(150, 80, 10);
  700.     writeln('Filling polygon');
  701.     p_floodfill(165, 80, 1);
  702.  
  703.     end_slice;
  704. end;
  705.  
  706. {*******************************************************************
  707.  Draw various lines in different directions, with a user-defined
  708.  pattern }
  709.  
  710. procedure lines_demo;
  711. var i: integer;
  712. var linetypeinfo: linesettingstype;
  713.  
  714. begin
  715.  
  716.     writeln; writeln;
  717.     writeln('LINE DRAWING DEMO'); writeln;
  718.     p_setviewport(0, 0, 719, 199, 0);
  719.     p_setlinestyle(UserbitLn, $fc02, ThickWidth);
  720.     for i := 0 to 100 div 20 do begin
  721.         p_line(0, 0, 100, i * 20);
  722.         p_line(319, 0, 200, i * 20);
  723.         p_line(i * 20, 199, 100, 100);
  724.         p_line(200, 199, 319-(i * 20), 100);
  725.     end;
  726.     p_getlinesettings(linetypeinfo);
  727.     writeln('Current line settings:');
  728.     writeln('   Line type = ', linetypeinfo.linestyle);
  729.     writeln('   User pattern = ', linetypeinfo.pattern);
  730.     writeln('   Thickness = ', linetypeinfo.thickness);
  731.  
  732.     end_slice;
  733. end;
  734.  
  735. {*******************************************************************
  736.  Draw an elliptical pie chart on the printer. }
  737.  
  738. procedure draw_elliptical_pie;
  739. begin
  740.     p_setviewport(0, 0, 500, 120, 0);
  741.     p_outtextxy(300, 50, 'Elliptical Pie chart');
  742.     p_setlinestyle(SolidLn, 0, NormWidth);
  743.     p_setfillstyle(CLOSEDOTFILL, 1);
  744.     p_sector(150, 50, 0, 50, 75, 30);
  745.     p_setfillstyle(HATCHFILL, 1);
  746.     p_sector(150, 50, 50, 120, 75, 30);
  747.     p_setfillstyle(XHATCHFILL, 1);
  748.     p_sector(150, 50, 120, 190, 75, 30);
  749.     p_setfillstyle(WIDEDOTFILL, 1);
  750.     p_sector(150, 50, 190, 290, 75, 30);
  751.     p_setlinestyle(SOLIDLN, 0, THICKWIDTH);
  752.     p_setfillstyle(INTERLEAVEFILL, 1);
  753.     p_sector(160, 60, 290, 360, 75, 30);
  754. end;
  755.  
  756. {*******************************************************************
  757.  Draw a circular pie chart on the printer. }
  758.  
  759. procedure pie_demo;
  760. begin
  761.     writeln; writeln;
  762.     writeln('PIE CHART DRAWING DEMO'); writeln;
  763.     p_setviewport(0, 0, 500, 200, 0);
  764.     writeln('Circular pie chart, various fill patterns');
  765.     p_outtextxy(300, 100, 'Circular Pie chart');
  766.     writeln('Slice 1, CLOSE DOT FILL.');
  767.     p_setlinestyle(SolidLn, 0, NormWidth);
  768.     p_setfillstyle(CLOSEDOTFill, 1);
  769.     p_pieslice(150, 100, 0, 50, 75);
  770.     writeln('Slice 2, HATCH FILL.');
  771.     p_setfillstyle(HATCHFill, 1);
  772.     p_pieslice(150, 100, 50, 120, 75);
  773.     writeln('Slice 3, XHATCH FILL.');
  774.     p_setfillstyle(XHATCHFill, 1);
  775.     p_pieslice(150, 100, 120, 190, 75);
  776.     writeln('Slice 4, WIDE DOT FILL.');
  777.     p_setfillstyle(WIDEDOTFill, 1);
  778.     p_pieslice(150, 100, 190, 290, 75);
  779.     writeln('Slice 5, INTERLEAVE FILL.');
  780.     p_setlinestyle(SolidLn, 0, THICKWIDTH);
  781.     p_setfillstyle(INTERLEAVEFill, 1);
  782.     p_pieslice(160, 110, 290, 360, 75);
  783.  
  784.     end_slice;
  785.  
  786.     writeln('Elliptical pie chart, various fill patterns');
  787.     draw_elliptical_pie;
  788.     end_slice;
  789. end;
  790.  
  791. begin
  792.     line_num := 0;
  793.     FF := #$0c;
  794.     screen_echo := true;
  795. end.
  796.  
  797.