home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / OS2BAS.ZIP / GPIPATH.BAS < prev    next >
BASIC Source File  |  1989-08-26  |  13KB  |  393 lines
  1. '**************************************************************************
  2. '*
  3. '* Program Name: GpiPath.BAS
  4. '*
  5. '* Include File: GpiPath.BI, GpiLine.BI
  6. '*
  7. '* Functions:    GpiSetGraphicsField
  8. '*               GpiQueryGraphicsField
  9. '*               GpiSetViewingLimits
  10. '*               GpiQueryViewingLimits
  11. '*               GpiBeginPath%
  12. '*               GpiBeginPath%
  13. '*               GpiCloseFigure
  14. '*               GpiModifyPath
  15. '*               GpiFillPath
  16. '*               GpiSetClipPath
  17. '*               GpiStrokePath
  18. '*
  19. '*            The following functions are from GpiLine.BI:
  20. '*
  21. '*               GpiSetLineWidthGeom
  22. '*               GpiQueryLineWidthGeom
  23. '*               GpiSetLineEnd
  24. '*               GpiQueryLineEnd
  25. '*               GpiSetLineJoin
  26. '*               GpiQueryLineJoin
  27. '*
  28. '* Description:  All the routines contained in GpiPath.BI and some
  29. '*               routines contained in GpiLine.BI are demonstrated
  30. '*               in this program.  A predefined design is displayed
  31. '*               using the current parameters set.  Path and line
  32. '*               geometry parameters are set by selecting desired
  33. '*               items from the various menus.  The "Clip Path"
  34. '*               menu option takes quite a bit longer than the
  35. '*               other menu selections to complete the display.
  36. '*               so be aware of it.
  37. '*
  38. '*               The "LineEnd" option only visually affects the short
  39. '*               line segments on either side of the screen.  The
  40. '*               RED lines are drawn to show actual figured before
  41. '*               modified with geometric line parameters.
  42. '*
  43. '*               The "LineJoin" option only visually affects the
  44. '*               continuous line design in the middle of the screen.
  45. '*
  46. '*               The "LineWidth" option only allows for widths of
  47. '*               10, 20, 30, and 40 pixels, however, the geometric
  48. '*               line width can be set to any value from 1 to
  49. '*               whatever the device will support.
  50. '*
  51. '*               Return values from routines that do no have a visual
  52. '*               affect are written out to the file GpiPath.OUT.
  53. '***************************************************************************
  54.  
  55. '*********         Initialization section        ***********
  56.  
  57. REM $INCLUDE: 'OS2Def.BI'
  58. REM $INCLUDE: 'PMBase.BI'
  59. REM $INCLUDE: 'WinMan1.BI'
  60. REM $INCLUDE: 'WinMsgs.BI'
  61. REM $INCLUDE: 'GpiCont.BI'
  62. REM $INCLUDE: 'GpiChar.BI'
  63. REM $INCLUDE: 'GpiColor.BI'
  64. REM $INCLUDE: 'GpiLine.BI'
  65. REM $INCLUDE: 'GpiPath.BI'
  66.                   
  67. DECLARE SUB ScreenPaint(hwnd&)
  68. DECLARE SUB MarkActualPathWithRedLines(xdiv%, ydiv%)
  69. DECLARE SUB DrawShortLineSegments(xdiv%, ydiv%)
  70. DECLARE SUB FillClipPathWithText()  
  71.  
  72. CONST IDRESOURCE   = 1
  73. CONST IDEXIT       = 10
  74. CONST IDLINEEND    = 20
  75. CONST IDLINEJOIN   = 30
  76. CONST IDLINEWIDTH  = 40
  77. CONST IDSTROKEPATH = 50
  78. CONST IDFILLPATH   = 60
  79. CONST IDCLIPPATH   = 70
  80.  
  81. DIM aqmsg AS QMSG
  82. DIM SHARED aptl(7) AS POINTL
  83.  
  84. OPEN "GpiPath.OUT" FOR OUTPUT AS #1
  85.  
  86. flFrameFlags& =  FCFTITLEBAR      OR  FCFSYSMENU  OR_
  87.                  FCFSIZEBORDER    OR  FCFMINMAX   OR_
  88.                  FCFSHELLPOSITION OR  FCFTASKLIST OR_
  89.                  FCFMENU
  90.  
  91. szClientClass$ = "ClassName" + CHR$(0)
  92.  
  93. hab&  = WinInitialize    (0)
  94. hmq&  = WinCreateMsgQueue(hab&, 0)
  95.  
  96. bool% = WinRegisterClass(_
  97.         hab&,_
  98.         MakeLong(VARSEG(szClientClass$), SADD(szClientClass$)),_
  99.         RegBas,_
  100.         0,_
  101.         0)
  102.  
  103. hwndFrame& = WinCreateStdWindow (_
  104.              HWNDDESKTOP,_
  105.              WSINVISIBLE,_
  106.              MakeLong (VARSEG(flFrameFlags&),  VARPTR(flFrameFlags&)),_
  107.              MakeLong (VARSEG(szClientClass$), SADD(szClientClass$)),_
  108.              0,_
  109.              0,_
  110.              0,_
  111.              IDRESOURCE,_
  112.              MakeLong (VARSEG(hwndClient&), VARPTR(hwndClient&)))
  113.  
  114.   bool% = WinSetWindowPos(hwndFrame&, 0, 0, 0, 0, 0, SWPSHOW OR SWPMAXIMIZE)
  115.  
  116. '**************         Message loop         ***************
  117.  
  118. WHILE WinGetMsg(hab&, MakeLong(VARSEG(aqmsg), VARPTR(aqmsg)), 0, 0, 0)
  119.     bool% = WinDispatchMsg(hab&, MakeLong(VARSEG(aqmsg), VARPTR(aqmsg)))
  120. WEND
  121.  
  122. '***********         Finalize section        ***************
  123.  
  124. bool% = WinDestroyWindow   (hwndFrame&)
  125. bool% = WinDestroyMsgQueue (hmq&)
  126. bool% = WinTerminate       (hab&)
  127. CLOSE #1
  128. END
  129.  
  130. '***********         Window procedure        ***************
  131.  
  132. FUNCTION ClientWndProc& (hwnd&, msg%, mp1&, mp2&) STATIC
  133. SHARED cxClient%, cyClient%, lineend&, linewidth&, linejoin&, path%
  134.  
  135.   ClientWndProc&=0
  136.   SELECT CASE msg%
  137.     '*
  138.     '* Set default values for Line Width, End, and Join
  139.     '*
  140.     CASE WMCREATE
  141.       lineend&   = LINEENDROUND
  142.       linewidth& = 10
  143.       linejoin&  = LINEJOINROUND
  144.     '*
  145.     '* Obtain new size of Client Window
  146.     '*
  147.     CASE WMSIZE
  148.       CALL BreakLong(mp2&, cyClient%, cxClient%)
  149.       bool% = WinInvalidateRect(hwnd&, 0, 0)
  150.  
  151.     CASE WMPAINT
  152.       CALL ScreenPaint(hwnd&)
  153.     '*
  154.     '* Determine which menu item was selected, set corresponding
  155.     '* flag or parameter, then invalidate the Client Window, so
  156.     '* a WMPAINT message will be posted, which will cause the
  157.     '* window to be redrawn with the new parameters
  158.     '*
  159.     CASE WMCOMMAND
  160.       CALL BreakLong(mp1&, dummy%, menuselection%)
  161.       SELECT CASE menuselection%
  162.  
  163.         CASE IDEXIT
  164.           bool% = WinPostMsg(hwnd&, WMQUIT, 0&, 0&)
  165.       '*
  166.       '* Obtain LineEnd type
  167.       '*
  168.         CASE IDLINEEND+1 TO IDLINEEND+4
  169.           lineend&   = menuselection% - IDLINEEND - 1
  170.       '*
  171.       '* Obtain LineJoin type
  172.       '*
  173.         CASE IDLINEJOIN+1 TO IDLINEJOIN+4
  174.           linejoin&  = menuselection% - IDLINEJOIN - 1
  175.       '*
  176.       '* Obtain LineWidth
  177.       '*
  178.         CASE IDLINEWIDTH+1 TO IDLINEWIDTH+4
  179.           linewidth& = (menuselection% - IDLINEWIDTH) * 10
  180.       '*
  181.       '* StrokePath simply draws the path with the current
  182.       '* line geometry parameters
  183.       '*
  184.         CASE IDSTROKEPATH
  185.           path% = 0
  186.       '*
  187.       '* FillPath either fills the interior of the path, or the
  188.       '* path itself.
  189.       '*
  190.         CASE IDFILLPATH+1 TO IDFILLPATH+2
  191.           path% = menuselection% - IDFILLPATH
  192.       '*
  193.       '* ClipPath either clips all output to within the path itself
  194.       '* or to within the interior of the path
  195.       '*
  196.         CASE IDCLIPPATH+1, IDCLIPPATH+2
  197.           path% = menuselection% - IDCLIPPATH + 2
  198.  
  199.       END SELECT
  200.       bool% = WinInvalidateRect(hwnd&, 0, 0)
  201.  
  202.     CASE ELSE  
  203.       ClientWndProc& = WinDefWindowProc(hwnd&, msg%, mp1&, mp2&)
  204.  
  205.   END SELECT
  206.  
  207. END FUNCTION
  208.  
  209.  
  210. '************************************************************************
  211. '*
  212. '* SUBprogram ScreenPaint:  Called from ClientWndProc& when a WMPAINT
  213. '*                          message is received.
  214. '*
  215. SUB ScreenPaint(hwnd&)
  216. SHARED hps&, cxClient%, cyClient%, lineend&, linewidth&, linejoin&, path%
  217. DIM rect AS RECTL
  218.  
  219.   hps&  = WinBeginPaint(hwnd&, 0, 0)
  220.   bool% = GpiErase     (hps&)
  221. '*
  222. '* The following four CALLs set viewing limits and graphics field limits.
  223. '* For simplicity, both are set to the entire Client Window, so there will
  224. '* be no visible affect.  To see the affect of setting a clipping region,
  225. '* select the "ClipPath" menu item.
  226. '*
  227.   rect.xRight  = cxClient% + 1
  228.   rect.xLeft   = 0
  229.   rect.yTop    = cyClient% + 1
  230.   rect.yBottom = 0
  231. '*
  232. '* Set Viewing Limits and Graphics Field equal to entire Client Window.
  233. '* Adding one to the right and top limits is needed since the fields
  234. '* set by the following to CALLs include the left and bottom edges specified
  235. '* in the RECTL structure, but the top and right limits are not, so to
  236. '* set fields to entire Client Window, 1 must be added to the top and
  237. '* bottom values.
  238. '*
  239.   bool% = GpiSetViewingLimits(hps&, MakeLong(VARSEG(rect), VARPTR(rect)))
  240.   bool% = GpiSetGraphicsField(hps&, MakeLong(VARSEG(rect), VARPTR(rect)))
  241. '*
  242. '* Query Values just set above, and then write the return values out
  243. '* the the file GpiPath.OUT
  244. '*
  245.   bool% = GpiQueryViewingLimits(hps&, MakeLong(VARSEG(rect), VARPTR(rect)))
  246.   PRINT #1,"GpiQueryViewingLimits:", bool%
  247.   PRINT #1,"("; rect.xLeft;  ","; rect.yBottom;")-(";_
  248.                 rect.xRight; ","; rect.yTop;   ")"
  249.   bool% = GpiQueryGraphicsField(hps&, MakeLong(VARSEG(rect), VARPTR(rect)))
  250.   PRINT #1,"GpiQueryGraphicsField:", bool%
  251.   PRINT #1,"("; rect.xLeft;  ","; rect.yBottom;")-(";_
  252.                 rect.xRight; ","; rect.yTop;   ")"
  253. '*
  254. '* Divide Client Window into divisions of 10, to be used to set values
  255. '* for design
  256. '*
  257.   xdiv% = cxClient% \ 10
  258.   ydiv% = cyClient% \ 10
  259. '*
  260. '* Calculate points for design to be proportional to Client window
  261. '*
  262.   aptl(0).x = xdiv%     :  aptl(0).y = ydiv%
  263.   aptl(1).x = xdiv% * 9 :  aptl(1).y = ydiv% * 9
  264.   aptl(2).x = xdiv% * 6 :  aptl(2).y = ydiv% * 9
  265.   aptl(3).x = xdiv% * 6 :  aptl(3).y = ydiv%
  266.   aptl(4).x = xdiv% * 9 :  aptl(4).y = ydiv%
  267.   aptl(5).x = xdiv%     :  aptl(5).y = ydiv% * 9
  268.   aptl(6).x = xdiv% * 4 :  aptl(6).y = ydiv% * 9
  269.   aptl(7).x = xdiv% * 4 :  aptl(7).y = ydiv%
  270. '*
  271. '* Set Line End, Join, and Width to selected values
  272. '*
  273.   bool% = GpiSetLineEnd      (hps&, lineend&)
  274.   bool% = GpiSetLineJoin     (hps&, linejoin&)
  275.   bool% = GpiSetLineWidthGeom(hps&, linewidth&)     
  276. '*
  277. '* Query Line End, Join, and Width values and write out to GpiPath.OUT
  278. '*
  279.   PRINT #1,"GpiSetLineEnd:       "; GpiQueryLineEnd      (hps&)
  280.   PRINT #1,"GpiSetLineJoin:      "; GpiQueryLineJoin     (hps&)
  281.   PRINT #1,"GpiSetLineWidthGeom: "; GpiQueryLineWidthGeom(hps&) 
  282. '*
  283. '* Mark beginning of Path, move to first point of design.  Display
  284. '* design using points store in aptl(), then close figure conecting
  285. '* the last and first points drawn.  If this is not done, GpiStrokePath
  286. '* or GpiFillPath will do this for you
  287. '*
  288.   bool% = GpiBeginPath  (hps&, 1)
  289.   bool% = GpiMove       (hps&,    MakeLong(VARSEG(aptl(0)), VARPTR(aptl(0))))
  290.   bool% = GpiPolyLine   (hps&, 7, MakeLong(VARSEG(aptl(1)), VARPTR(aptl(1))))
  291.   bool% = GpiCloseFigure(hps&)
  292. '*
  293. '* Draw three short line segments on either side of main design.  These
  294. '* lines are used to show the "LineEnd" type selected.
  295. '*
  296.   CALL DrawShortLineSegments(xdiv%, ydiv%)
  297. '*
  298. '* Mark end of path
  299. '*
  300.   bool% = GpiEndPath(hps&)
  301. '*
  302. '* Draw path, using one of the following methods, depending on which
  303. '* menu item was selected.  "ModifyPath" causes the path itself to
  304. '* be filled or used as the clipping region, instead of the interior
  305. '* of the path.
  306. '*
  307.   SELECT CASE path%
  308.     CASE 0
  309.       bool% = GpiStrokePath(hps&, 1, 0)
  310.     CASE 1, 2
  311.       IF path% = 1 THEN bool% = GpiModifyPath(hps&, 1, MPATHSTROKE)
  312.       bool% = GpiFillPath(hps&, 1, FPATHALTERNATE)
  313.     CASE 3, 4
  314.       IF path% = 3 THEN bool% = GpiModifyPath(hps&, 1, MPATHSTROKE)  
  315.       bool% = GpiSetClipPath(hps&, 1, SCPAND)
  316.     '*
  317.     '* Display text to show clipping
  318.     '*
  319.       CALL FillClipPathWithText
  320.  
  321.   END SELECT
  322.  
  323.   CALL MarkActualPathWithRedLines(xdiv%, ydiv%)
  324.  
  325.   bool% = WinEndPaint(hps&)
  326.  
  327. END SUB
  328.  
  329.  
  330. '**************************************************************************
  331. '* This routine simply draws the the path defined above, in RED and only
  332. '* one pixel wide, using the standard line drawing routine of GpiPolyline
  333. '* and GpiLine.
  334. '*
  335. SUB MarkActualPathWithRedLines(xdiv%, ydiv%)
  336. SHARED hps&
  337.  
  338.   bool% = GpiSetColor(hps&, CLRRED)
  339.   bool% = GpiMove    (hps&,    MakeLong(VARSEG(aptl(7)), VARPTR(aptl(7))))
  340.   bool% = GpiPolyLine(hps&, 8, MakeLong(VARSEG(aptl(0)), VARPTR(aptl(0))))
  341.   CALL DrawShortLineSegments(xdiv%, ydiv%)
  342.  
  343. END SUB
  344.  
  345.  
  346. '**************************************************************************
  347. '* This routine draws the three short line segments on either side of the
  348. '* main design.  This routine is CALLed twice, once from within the PATH
  349. '* and once from outside the path.  The SUB "MarkActualPathWithRedLines"
  350. '* CALLs this routine from outside the PATH to show actual PATH, on one
  351. '* pixel wide.
  352. '*
  353. SUB DrawShortLineSegments(xdiv%, ydiv%)
  354. SHARED hps&
  355. DIM ptl(1) AS POINTL
  356.  
  357.   ptl(0).x = xdiv%
  358.   ptl(1).x = xdiv% * 2
  359.   FOR N%   = 1 TO 2
  360.     ptl(0).y = ydiv% * 3
  361.     FOR I%   = 1 TO 3
  362.       ptl(0).y = ptl(0).y + ydiv%
  363.       ptl(1).y = ptl(0).y
  364.       bool%    = GpiMove(hps&, MakeLong(VARSEG(ptl(0)), VARPTR(ptl(0))))
  365.       bool%    = Gpiline(hps&, MakeLong(VARSEG(ptl(1)), VARPTR(ptl(1))))
  366.     NEXT I%
  367.     ptl(0).x = xdiv% * 8
  368.     ptl(1).x = xdiv% * 9
  369.   NEXT N%
  370.  
  371. END SUB
  372.  
  373.  
  374. '**************************************************************************
  375. '* This routine displays text as to fill the entire Client Window, however
  376. '* only the text that falls within the clipped region is visible.
  377. '*
  378. SUB FillClipPathWithText
  379. SHARED hps&, cyClient%
  380. DIM ptl AS POINTL
  381.  
  382.   text$   = "This is the text that is only diplayed within the clipped path"
  383.   text$   = text$ + text$ + CHR$(0)
  384.   ptl.x   = 0
  385.   FOR Y%  = 0 TO cyClient% STEP 16
  386.     ptl.y = Y%
  387.     bool% = GpiCharStringAt(hps&,_
  388.             MakeLong(VARSEG(ptl),   VARPTR(ptl)), 124,_
  389.             MakeLong(VARSEG(text$), SADD(text$)))
  390.   NEXT Y%
  391. END SUB
  392.   
  393.