home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / OS2BAS.ZIP / ARCMOD.BAS next >
BASIC Source File  |  1989-08-13  |  9KB  |  250 lines
  1. '│*****************************************************************
  2. '│
  3. '│ Module:       ArcMod.bas
  4. '│
  5. '│ Subprograms:  DemoGpiPointArc
  6. '│               DemoGpiFullArc
  7. '│               DemoGpiPartialArc
  8. '│               DemoGpiPolyFilletSharp
  9. '│               DemoGpiPolySpline
  10. '│               DemoGpiPolyFillet
  11. '│
  12. '│               SetArcParamaters  -- Used by several of the Demo Subs
  13. '│                                    to initialize arc paramaters
  14. '│
  15. '│ Description:  This SUBprogram is identical to the example program
  16. '│               GpiArc.BAS, except it has been broken up into separate
  17. '│               SUBprograms that can be executed separately, and color
  18. '│               has been added.  All subprograms take an agrgument called
  19. '│               "mode%".  This is a flag that signals whether all the Arc
  20. '│               routines are begin executed sequentially or if only a
  21. '│               Arc routine is to be exectued.  If mode% = 1, then the
  22. '│               selected Arc routine fills the entire window with its
  23. '│               specific Arc type.  If mode% = 0 then all Arc types are
  24. '│               drawn together, and each takes up approximately 1/6th of
  25. '│               the Client Window.  For the best picture when "Display all"
  26. '│               is selected, the Window should be maxized.
  27. '│
  28. '│        Note:  Since these routines are virtually identical to the
  29. '│               routines in GpiArc.BAS, documentation has not been added
  30. '│               to this module for the individual SUBprograms.  Refer to
  31. '│               GpiArc.BAS for documented code.
  32. '│          
  33. REM $INCLUDE: 'os2def.bi'
  34. REM $INCLUDE: 'pmbase.bi'
  35. REM $INCLUDE: 'gpiline.bi'
  36. REM $INCLUDE: 'gpiarea.bi'
  37. REM $INCLUDE: 'gpicolor.bi'
  38. REM $INCLUDE: 'gpiarc.bi'
  39.  
  40. DECLARE SUB SetArcParamaters()
  41. DECLARE FUNCTION MakeFixed&(realnum#)
  42.  
  43. COMMON /Gdemo/ cxClient%, cyClient%
  44.  
  45.  
  46. '│***************************************************************************
  47. SUB DemoGpiPointArc(hps&,mode%)
  48. SHARED arcp AS ARCPARAMS, cxClient%, cyClient%
  49. DIM ptl(2) AS POINTL
  50.  
  51.   If mode% = 1 THEN
  52.     ptl(0).x = 0 : ptl(0).y = 0
  53.     ptl(1).x = cxClient% / 2
  54.     ptl(2).x = cxClient% : ptl(2).y = 0
  55.     Ystart&  = cyClient% / 4 * 3
  56.     Yend&    = 0
  57.   ELSE
  58.     ptl(0).x = cxClient% / 3 * 2 : ptl(0).y = cyClient% / 3 * 2
  59.     ptl(1).x = cxClient% / 6 * 5
  60.     ptl(2).x = cxClient% : ptl(2).y = ptl(0).y
  61.     Ystart&  = cyClient%
  62.     Yend&    = ptl(0).y
  63.   END IF
  64.   colorcntr% = 1
  65.   FOR Y& = Ystart& TO Yend& STEP -5
  66.     bool% = GpiSetColor(hps&, colorcntr%)
  67.     bool% = GpiBeginArea(hps&,(BAALTERNATE OR BABOUNDARY))
  68.     ptl(1).y = Y&
  69.     bool% = GpiMove(hps&, MakeLong(VARSEG(ptl(0)), VARPTR(ptl(0))))
  70.     bool% = GpiPointArc(hps&, MakeLong(VARSEG(ptl(1)), VARPTR(ptl(1))))
  71.     bool% = GpiEndArea(hps&)
  72.     colorcntr% = colorcntr% + 1
  73.     if colorcntr% = 16 then colorcntr% = 1
  74.   NEXT Y&
  75. END SUB
  76.  
  77.  
  78. '│***************************************************************************
  79. SUB DemoGpiFullArc(hps&,mode%)
  80. SHARED arcp AS ARCPARAMS, cxClient%, cyClient%
  81. DIM ptl AS POINTL
  82.  
  83.   IF mode% = 1 THEN
  84.     ptl.x = cxClient% / 2     : ptl.y = cyClient% / 2
  85.     max% = 216
  86.   ELSE
  87.     ptl.x = cxClient% / 2 - 7 : ptl.y = cyClient% / 4 * 3
  88.     max% = 106
  89.   END IF
  90.   bool% = GpiMove(hps&, MakeLong(VARSEG(ptl), VARPTR(ptl)))
  91.   colorcntr% = 1
  92.   FOR I# = max% to 1 step -5
  93.     bool% = GpiSetColor(hps&, colorcntr%)
  94.     bool% = GpiFullArc(hps&, DROOUTLINEFILL, MakeFixed(I#))
  95.     colorcntr% = colorcntr% + 1
  96.     if colorcntr% = 16 then colorcntr% = 1
  97.   NEXT
  98. END SUB
  99.  
  100.  
  101. '│***************************************************************************
  102. SUB DemoGpiPartialArc(hps&,mode%)
  103. SHARED arcp AS ARCPARAMS, cxClient%, cyClient%
  104. DIM ptl AS POINTL
  105.  
  106.   IF mode% = 1 THEN
  107.     ptl.x = cxClient% / 3 : ptl.y = cyClient% / 2
  108.     mult% = 259
  109.   ELSE
  110.     ptl.x = 0 : ptl.y = cyClient% / 4 * 3
  111.     mult% = 210
  112.   END IF
  113.   startA& = MakeFixed(315)
  114.   colorcntr% = 1
  115.   FOR I% = 1 to 24
  116.     bool% = GpiSetColor(hps&, colorcntr%)
  117.     bool% = GpiBeginArea(hps&,(BAALTERNATE OR BABOUNDARY))
  118.     multiplier& = MakeFixed(mult% - I% * 4)
  119.     sweepA& = MakeFixed(99 - I% * 4)
  120.     bool% = GpiMove(hps&, MakeLong(VARSEG(ptl), VARPTR(ptl)))
  121.     bool% = GpiPartialArc(hps&, MakeLong(VARSEG(ptl), VARPTR(ptl)),_
  122.     multiplier&, startA&, sweepA&)
  123.     bool% = GpiEndArea(hps&)
  124.     colorcntr% = colorcntr% + 1
  125.     if colorcntr% = 16 then colorcntr% = 1
  126.   NEXT I%
  127. END SUB
  128.  
  129.  
  130. '│***************************************************************************
  131. SUB DemoGpiPolyFilletSharp(hps&,mode%)
  132. SHARED cxClient%, cyClient%
  133. DIM ptl(2) AS POINTL
  134.  
  135.   IF mode% = 1 THEN
  136.     ptl(0).x = 0         : ptl(0).y = 0
  137.     ptl(1).x = 0         : ptl(1).y = cyClient%
  138.     ptl(2).x = cxClient% : ptl(2).y = cyClient% / 3 * 2
  139.   ELSE
  140.     ptl(0).x = cxClient% / 3 * 2 : ptl(0).y = 0
  141.     ptl(1).x = ptl(0).x          : ptl(1).y = cyClient% / 3 * 2
  142.     ptl(2).x = cxClient%         : ptl(2).y = cxClient% / 3
  143.   END IF
  144.   sharpness# = 6
  145.   colorcntr% = 1
  146.   FOR I% = 1 to 30
  147.     bool% = GpiSetColor(hps&, colorcntr%)
  148.     bool% = GpiBeginArea(hps&,(BAALTERNATE OR BABOUNDARY))
  149.     sharp& = MakeFixed(sharpness#)
  150.     bool% = GpiMove(hps&, MakeLong(VARSEG(ptl(0)), VARPTR(ptl(0))))
  151.     bool% = GpiPolyFilletSharp(hps&, 2&,_
  152.                                MakeLong(VARSEG(ptl(1)),VARPTR(ptl(1))),_
  153.                                MakeLong(VARSEG(sharp&), VARPTR(sharp&)))
  154.     bool% = GpiEndArea(hps&)
  155.     colorcntr% = colorcntr% + 1
  156.     if colorcntr% = 16 then colorcntr% = 1
  157.     sharpness# = sharpness# - .2#
  158.   NEXT
  159. END SUB
  160.  
  161.  
  162. '│***************************************************************************
  163. SUB DemoGpiPolySpline(hps&,mode%)
  164. SHARED cxClient%, cyClient%
  165. DIM ptl(3) AS POINTL, lastptl(3) AS POINTL
  166.  
  167.   IF mode% = 1 THEN
  168.     ptl(0).x = 0                 : ptl(0).y = 0
  169.     ptl(1).x = cxClient% / 6     : ptl(1).y = cyClient% * 2.08
  170.     ptl(2).x = cxClient% / 4 * 3 : ptl(2).y = 0
  171.     ptl(3).x = cxClient%         : ptl(3).y = cyClient% / 4 * 3
  172.     max% = 40
  173.   ELSE
  174.     ptl(0).x = 0                  : ptl(0).y = 0
  175.     ptl(1).x = cxClient% / 18     : ptl(1).y = cyClient% * 1.08
  176.     ptl(2).x = cxClient% / 12 * 3 : ptl(2).y = 0
  177.     ptl(3).x = cxClient% / 3      : ptl(3).y = CyClient% / 8 * 3
  178.     max% = 20
  179.   END IF
  180.   colorcntr% = 1
  181.   FOR I% = 1 to max%
  182.     IF I% <> 1 THEN
  183.       bool% = GpiSetColor(hps&, colorcntr%)
  184.       bool% = GpiBeginArea(hps&,(BAALTERNATE OR BABOUNDARY))
  185.     END IF
  186.     bool% = GpiMove(hps&, MakeLong(VARSEG(ptl(0)), VARPTR(ptl(0))))
  187.     bool% = GpiPolySpline(hps&, 3&, MakeLong(VARSEG(ptl(1)),VARPTR(ptl(1))))
  188.     IF I% <> 1 THEN
  189.       bool% = GpiPolySpline(hps&, 3&, MakeLong(VARSEG(lastptl(1)), VARPTR(lastptl(1))))
  190.       bool% = GpiEndArea(hps&)
  191.       colorcntr% = colorcntr% + 1
  192.       if colorcntr% = 16 then colorcntr% = 1
  193.     END IF
  194.     M% = 3
  195.     FOR N% = 0 to 3
  196.       lastptl(N%) = ptl(M%)
  197.       M% = M% - 1
  198.     NEXT N%
  199.     ptl(1).y = ptl(1).y - 9
  200.     ptl(2).y = ptl(2).y - 9
  201.   NEXT I%
  202. END SUB
  203.  
  204.  
  205. '│***************************************************************************
  206. SUB DemoGpiPolyFillet(hps&,mode%)
  207. SHARED cxClient%, cyClient%
  208. DIM ptl(3) AS POINTL
  209.  
  210.   IF mode% = 1 THEN
  211.     ptl(0).x = 0         : ptl(0).y = cyClient%
  212.     ptl(1).x = cxClient% : ptl(1).y = cyClient%
  213.     ptl(2).x = cxClient% : ptl(2).y = 0
  214.     ptl(3).x = 0         : ptl(3).y = 0
  215.     max% = 50
  216.   ELSE
  217.     ptl(0).x = cxClient% / 3     : ptl(0).y = cyClient% / 2
  218.     ptl(1).x = cxClient% / 3 * 2 : ptl(1).y = cyClient% / 2
  219.     ptl(2).x = cxClient% / 3 * 2 : ptl(2).y = 0
  220.     ptl(3).x = cxClient% / 3     : ptl(3).y = 0
  221.     max% = 30
  222.   END IF
  223.   colorcnt% = 1
  224.   FOR I% = 1 to max%
  225.     bool% = GpiSetColor(hps&, colorcntr%)
  226.     bool% = GpiBeginArea(hps&,(BAALTERNATE OR BABOUNDARY))
  227.     bool% = GpiMove(hps&, MakeLong(VARSEG(ptl(3)), VARPTR(ptl(3))))
  228.     bool% = GpiPolyFillet(hps&, 4&, MakeLong(VARSEG(ptl(0)), VARPTR(ptl(0))))
  229.     bool% = GpiEndArea(hps&)
  230.     colorcntr% = colorcntr% + 1
  231.     if colorcntr% = 16 then colorcntr% = 1
  232.     ptl(0).y = ptl(0).y - 6
  233.     ptl(1).x = ptl(1).x - 6
  234.     ptl(1).y = ptl(1).y - 6
  235.     ptl(2).x = ptl(2).x - 6
  236.   NEXT
  237. END SUB
  238.  
  239.  
  240. '│***************************************************************************
  241. SUB SetArcParamaters
  242. SHARED arcp AS ARCPARAMS
  243.   arcp.LP = 1
  244.   arcp.LQ = 1
  245.   arcp.LR = 0
  246.   arcp.LS = 0
  247.   bool% = GpiSetArcParams(hps&, MakeLong(Varseg(arcp), Varptr(arcp)))
  248. END SUB
  249.  
  250.