home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / OS2BAS.ZIP / GPITRANS.BAS < prev    next >
BASIC Source File  |  1989-08-26  |  12KB  |  352 lines
  1. '***********************************************************************
  2. '* 
  3. '* Program Name: GpiTrans.BAS
  4. '*
  5. '* Include File: GpiTrans.BI
  6. '*
  7. '* Functions   :
  8. '*               GpiConvert
  9. '*               GpiCallSegmentMatrix
  10. '*               GpiQueryDefaultViewMatrix
  11. '*               GpiQueryViewingTransformMatrix
  12. '*               GpiQueryModelTransformMatrix
  13. '*               GpiQuerySegmentTransformMatrix
  14. '*               GpiQueryPageViewport
  15. '*               GpiSetDefaultViewMatrix
  16. '*               GpiSetViewingTransformMatrix
  17. '*               GpiSetModelTransformMatrix
  18. '*               GpiSetSegmentTransformMatrix
  19. '*               GpiSetPageViewport
  20. '*
  21. '* Description : This program demonstrates the transformation matrix
  22. '*               functions.  These functions allow a given coordinate
  23. '*               space to display a drawing with a given rotation,
  24. '*               scale, translation or shear.  This program illustrates
  25. '*               rotation and scaling.  Virtually all calls are in the
  26. '*               ClientWndProc and are triggered by keyboard or mouse
  27. '*               input.
  28. '*
  29. '*               These calls are just example calls.  This program
  30. '*               does not give a full discussion of coordinate spaces
  31. '*               or transformation matrices.  For more information on
  32. '*               these topics, see Chapter 31 of "OS/2 Programmer's
  33. '*               Reference, Volume 1."
  34. '***********************************************************************
  35.  
  36. '*********         Initialization section        ***********
  37.  
  38. REM $INCLUDE: 'PMBase.BI'
  39. REM $INCLUDE: 'GpiTrans.BI'
  40. REM $INCLUDE: 'GpiSeg.BI'         Needed to illustrate GpiSet/QuerySegmentTM
  41. REM $INCLUDE: 'GpiCont.BI'        Needed for Create/DestroyPS
  42. REM $INCLUDE: 'WinInput.BI'       Needed for messages
  43. REM $INCLUDE: 'OS2Def.BI'         Needed for POINTL type
  44. CONST  DROFILL        =  1
  45. DECLARE FUNCTION GpiMove%(BYVAL hps AS LONG, BYVAL pptl AS LONG)
  46. DECLARE FUNCTION GpiFullArc%(BYVAL hps AS LONG,_
  47.                              BYVAL flFlags AS LONG,_
  48.                              BYVAL fxMult AS LONG)
  49. DECLARE FUNCTION GpiSetColor%(BYVAL hps AS LONG, BYVAL clr AS LONG)
  50. DECLARE FUNCTION WinOpenWindowDC&(BYVAL hwnd AS LONG)
  51.  
  52. CONST FirstSeg = 1
  53. CONST LastSeg  = 10
  54.  
  55. 'Global anchor block and presentation space
  56. COMMON SHARED /Handles/ hab&, hps&
  57.  
  58. OPEN "GpiTrans.OUT" FOR OUTPUT AS #1
  59.  
  60. DIM aqmsg AS QMSG
  61.  
  62. flFrameFlags& =  FCFTITLEBAR      OR FCFSYSMENU OR _
  63.                  FCFSIZEBORDER    OR FCFMINMAX  OR _
  64.                  FCFSHELLPOSITION OR FCFTASKLIST
  65.  
  66. szClientClass$ = "ClassName" + CHR$(0)
  67.  
  68. hab&  = WinInitialize    (0)
  69. hmq&  = WinCreateMsgQueue(hab&, 0)
  70.  
  71. bool% = WinRegisterClass(_
  72.         hab&,_
  73.         MakeLong(VARSEG(szClientClass$), SADD(szClientClass$)),_
  74.         RegBas,_
  75.         0,_
  76.         0)
  77.  
  78. hwndFrame& = WinCreateStdWindow (_
  79.              HWNDDESKTOP,_
  80.              WSVISIBLE,_
  81.              MakeLong(VARSEG(flFrameFlags&),  VARPTR(flFrameFlags&)),_
  82.              MakeLong(VARSEG(szClientClass$), SADD(szClientClass$)),_
  83.              0,_
  84.              0,_
  85.              0,_
  86.              0,_
  87.              MakeLong(VARSEG(hwndClient&), VARPTR(hwndClient&)))
  88.  
  89. '**************         Message loop         ***************
  90.  
  91. WHILE WinGetMsg(hab&, MakeLong(VARSEG(aqmsg), VARPTR(aqmsg)), 0, 0, 0)
  92.   bool% = WinDispatchMsg(hab&, MakeLong(VARSEG(aqmsg), VARPTR(aqmsg)))
  93. WEND
  94.  
  95. '***********         Finalize section        ***************
  96.  
  97. bool% = WinDestroyWindow   (hwndFrame&)
  98. bool% = WinDestroyMsgQueue (hmq&)
  99. bool% = WinTerminate       (hab&)
  100.  
  101. CLOSE #1
  102.  
  103. END
  104.  
  105. '***********         Window procedure        ***************
  106.  
  107. FUNCTION ClientWndProc& (hwnd&, msg%, mp1&, mp2&) STATIC
  108.      DIM ClientRect AS RECTL
  109.      DIM mtrx AS MATRIXLF
  110.      ClientWndProc&=0
  111.      SELECT CASE msg%
  112.      CASE WMCREATE
  113.     CALL SegmentSetup(hwnd&)
  114.      CASE WMSIZE             'Size causes change in page viewport
  115.         CALL BreakLong(mp2&, Yheight%, Xwidth%)
  116.         bool% = GpiQueryPageViewport(hps&,_
  117.                 MakeLong(VARSEG(ClientRect), VARPTR(ClientRect)))
  118.  
  119.         PRINT #1, "PageViewport: ";
  120.         PRINT #1, "(";ClientRect.xLeft;",";ClientRect.yBottom;")";" - ";
  121.         PRINT #1, "(";ClientRect.xRight;",";ClientRect.yTop;")"
  122.  
  123.         'Set up new ViewPort (origin at center of window)
  124.         deltaY% = Yheight% / 2
  125.         deltaX% = Xwidth% / 2
  126.         ClientRect.yBottom = deltaY%
  127.         ClientRect.yTop    = Yheight%
  128.         ClientRect.xLeft   = deltaX%
  129.         ClientRect.xRight  = Xwidth%
  130.  
  131.         bool% = GpiSetPageViewport(hps&,_
  132.                 MakeLong(VARSEG(ClientRect), VARPTR(ClientRect)))
  133.  
  134.      CASE WMCHAR             'Key press causes scaling to be reset
  135.         IF (mp1& AND KCKEYUP)=0 THEN
  136.           bool% = GpiQueryDefaultViewMatrix(hps&, 9,_
  137.                   MakeLong(VARSEG(mtrx), VARPTR(mtrx)))
  138.  
  139.           'Reset scaling
  140.           mtrx.fxM11 = &H10000
  141.           mtrx.fxM22 = &H10000
  142.  
  143.           bool% = GpiSetDefaultViewMatrix(hps&, 9,_
  144.                   MakeLong(VARSEG(mtrx), VARPTR(mtrx)),_
  145.                   TRANSFORMREPLACE)
  146.  
  147.           'Send WMPAINT to draw chain
  148.           bool% = WinSendMsg(hwnd&, WMPAINT, 0, 0)
  149.         END IF
  150.  
  151.      CASE WMBUTTON1DOWN            '1st Button rotates model transform matrix
  152.         bool% = GpiQueryModelTransformMatrix(hps&, 9,_
  153.                 MakeLong(VARSEG(mtrx), VARPTR(mtrx)))
  154.  
  155.         'Set matrix for 10 degree rotation
  156.         mtrx.fxM11 = &H10000 * COS(3.14/18)
  157.         mtrx.fxM12 = &H10000 * -SIN(3.14/18)
  158.         mtrx.fxM21 = &H10000 * SIN(3.14/18)
  159.         mtrx.fxM22 = &H10000 * COS(3.14/18)
  160.  
  161.         bool% = GpiSetModelTransformMatrix(hps&, 9,_
  162.                 MakeLong(VARSEG(mtrx), VARPTR(mtrx)), TRANSFORMADD)
  163.  
  164.         'Call segment with large radius
  165.         bool% = GpiErase (hps&)
  166.         mtrx.fxM11 = &H10000 * 5
  167.         mtrx.fxM12 = 0
  168.         mtrx.fxM21 = 0
  169.         mtrx.fxM22 = &H10000 * 5
  170.         mtrx.lM33 = 1
  171.         bool% = GpiCallSegmentMatrix(hps&,_
  172.                 LastSeg + 1, 9,_
  173.                 MakeLong(VARSEG(mtrx), VARPTR(mtrx)), TRANSFORMADD)
  174.  
  175.         'Convert points between coordinate spaces
  176.         CALL ConvertPoints
  177.  
  178.         SLEEP 1
  179.  
  180.         'Send WMPAINT to draw chain
  181.     bool% = WinSendMsg(hwnd&, WMPAINT, 0, 0)
  182.         ClientWndProc& = WinDefWindowProc(hwnd&, msg%, mp1&, mp2&)
  183.  
  184.      CASE WMBUTTON2DOWN   '2nd Button changes scaling for default view matrix
  185.         bool% = GpiQueryDefaultViewMatrix(hps&, 9,_
  186.                 MakeLong(VARSEG(mtrx), VARPTR(mtrx)))
  187.  
  188.         'Choose random scaling
  189.         mtrx.fxM11 = &H10000 * 5 * RND
  190.         mtrx.fxM22 = &H10000 * 5 * RND
  191.  
  192.         'Replace DVM
  193.         bool% = GpiSetDefaultViewMatrix(hps&, 9,_
  194.                 MakeLong(VARSEG(mtrx), VARPTR(mtrx)), TRANSFORMREPLACE)
  195.  
  196.         'Send WMPAINT to draw chain
  197.         bool% = WinSendMsg(hwnd&, WMPAINT, 0, 0)
  198.  
  199.      CASE WMPAINT     'Draw chain reflected twice with ViewingTM
  200.         'Reflect ViewingTM through origin
  201.         bool% = GpiQueryViewingTransformMatrix(hps&, 9,_
  202.                 MakeLong(VARSEG(mtrx), VARPTR(mtrx)))
  203.         mtrx.fxM11 = -mtrx.fxM11
  204.         mtrx.fxM22 = -mtrx.fxM22
  205.         bool% = GpiSetViewingTransformMatrix(hps&, 9,_
  206.                 MakeLong(VARSEG(mtrx), VARPTR(mtrx)), TRANSFORMREPLACE)
  207.         bool% = GpiErase    (hps&)
  208.         bool% = GpiDrawChain(hps&)
  209.  
  210.         SLEEP 1
  211.  
  212.         'Reflect ViewingTM again through origin
  213.         bool% = GpiQueryViewingTransformMatrix(hps&, 9,_
  214.                 MakeLong(VARSEG(mtrx), VARPTR(mtrx)))
  215.         mtrx.fxM11 = -mtrx.fxM11
  216.         mtrx.fxM22 = -mtrx.fxM22
  217.         bool% = GpiSetViewingTransformMatrix(hps&, 9,_
  218.                 MakeLong(VARSEG(mtrx), VARPTR(mtrx)), TRANSFORMREPLACE)
  219.         bool% = GpiErase    (hps&)
  220.         bool% = GpiDrawChain(hps&)
  221.  
  222.         hps2& = WinBeginPaint(hwnd&,0,0)    ' WinBegin/EndPaint to
  223.         bool% = WinEndPaint  (hps2&)        ' terminate WMPAINT message.
  224.  
  225.      CASE WMCLOSE
  226.         bool% = GpiDeleteSegments        (hps&, FirstSeg, LastSeg)
  227.         bool% = GpiDestroyPS             (hps&)
  228.         ClientWndProc& = WinDefWindowProc(hwnd&, msg%, mp1&, mp2&)
  229.  
  230.      CASE ELSE        'Pass control to system for other messages
  231.         ClientWndProc& = WinDefWindowProc(hwnd&, msg%, mp1&, mp2&)
  232.      END SELECT
  233. END FUNCTION
  234.  
  235. SUB SegmentSetup(hwnd&) STATIC
  236.  
  237.    'Get device context for window to use with GpiCreatePS
  238.    hdcWin& = WinOpenWindowDC(hwnd&)
  239.  
  240.    'Define size of presentation space for GpiCreatePS
  241.    DIM szl AS SIZEL
  242.    szl.cx = 640 : szl.cy = 480
  243.  
  244.    'Create a presentation space because segments can not be
  245.    'used with micro presentation spaces.
  246.    hps& = GpiCreatePS(hab&, hdcWin&,_
  247.           MakeLong(VARSEG(szl), VARPTR(szl)),_
  248.           PUPELS OR GPIAASSOC)
  249.  
  250.    'Set drawing mode and initial attributes
  251.    bool% = GpiSetDrawingMode (hps&, DMRETAIN)
  252.    IF (ATTROFF  = GpiQueryInitialSegmentAttrs(hps&, ATTRCHAINED)) THEN
  253.      bool%      = GpiSetInitialSegmentAttrs  (hps&, ATTRCHAINED, ATTRON)
  254.    END IF
  255.  
  256.    'Make a segment to be copied into each new segment
  257.    radius& = 25 * &H10000          'radius for GpiFullArc (fixed type in C)
  258.    bool%   = GpiOpenSegment(hps&, LastSeg+1)
  259.      bool% = GpiFullArc(hps&, DROFILL, radius&)
  260.    bool%   = GpiCloseSegment(hps&)
  261.  
  262.    'Make this segment callable for GpiCallSegmentMatrix
  263.    bool% = GpiSetSegmentAttrs(hps&, LastSeg+1, ATTRCHAINED, ATTROFF)
  264.  
  265.    'Copy commands from above segment into a buffer to be used with GpiPutData
  266.    DIM Buffer AS STRING * 512
  267.    NumBytes& = GpiGetData(hps&, LastSeg + 1,_
  268.                MakeLong(VARSEG(Offset&), VARPTR(Offset&)),_
  269.                DFORMNOCONV, 512,_
  270.                MakeLong(VARSEG(Buffer),  VARPTR(Buffer)))
  271.  
  272.    'Set initial position for segments
  273.    DIM ptl AS POINTL
  274.    ptl.x = 10 : ptl.y = 10
  275.  
  276.    'Set up 10 segments (drawn diagonally)
  277.    FOR s% = FirstSeg TO LastSeg
  278.      bool% = GpiOpenSegment(hps&, s%)
  279.      bool% = GpiSetColor   (hps&, s%)  'Change color to distinguish segments
  280.      bool% = GpiMove       (hps&, MakeLong(VARSEG(ptl), VARPTR(ptl)))
  281.  
  282.      'Copy data from buffer (from original segment) to current segment
  283.      PutBytes& = GpiPutData(hps&, DFORMNOCONV,_
  284.                  MakeLong(VARSEG(NumBytes&), VARPTR(NumBytes&)),_
  285.                  MakeLong(VARSEG(Buffer),    VARPTR(Buffer)))
  286.  
  287.      bool% = GpiCloseSegment(hps&)
  288.  
  289.      '***Rotate each segment 5*s% degrees
  290.      DIM mtrx AS MATRIXLF
  291.      bool% = GpiQuerySegmentTransformMatrix(hps&, s%, 9,_
  292.              MakeLong(VARSEG(mtrx), VARPTR(mtrx)))
  293.      Angle! = s% * 5 * 3.14/180
  294.      mtrx.fxM11 = &H10000 * COS(Angle!)
  295.      mtrx.fxM12 = &H10000 * -SIN(Angle!)
  296.      mtrx.fxM21 = &H10000 * SIN(Angle!)
  297.      mtrx.fxM22 = &H10000 * COS(Angle!)
  298.      bool% = GpiSetSegmentTransformMatrix(hps&, s%, 9,_
  299.              MakeLong(VARSEG(mtrx), VARPTR(mtrx)), TRANSFORMADD)
  300.  
  301.      ptl.x = ptl.x + 15 : ptl.y = ptl.y + 15   'Increment point position
  302.    NEXT s%
  303.  
  304.    bool% = GpiSetDrawingMode (hps&, DMDRAW)  'Reset drawing mode
  305. END SUB
  306.  
  307. '****
  308. '** Convert points computes equivalent points in 4 coordinate spaces using
  309. '** GpiConvert.  Points are written to GpiTrans.OUT in PrintPoints.
  310.  
  311. SUB ConvertPoints
  312.   DIM ptls(3) AS POINTL
  313.   ptls(0).x = 10
  314.   ptls(0).y = 10
  315.   ptls(1).x = 20
  316.   ptls(1).y = 10
  317.   ptls(2).x = 10
  318.   ptls(2).y = 20
  319.   ptls(3).x = 20
  320.   ptls(3).y = 20
  321.   CALL PrintPoints("Default:",ptls())
  322.  
  323.   'Default -> Model
  324.   bool% = GpiConvert(hps&, CVTCDEFAULTPAGE, CVTCMODEL, 4,_
  325.           MakeLong(VARSEG(ptls(0)), VARPTR(ptls(0))))
  326.   CALL    PrintPoints("Model:",ptls())
  327.  
  328.   'Model -> Page
  329.   bool% = GpiConvert(hps&, CVTCMODEL, CVTCPAGE, 4,_
  330.           MakeLong(VARSEG(ptls(0)), VARPTR(ptls(0))))
  331.   CALL PrintPoints("Page:",ptls())
  332.  
  333.   'Page -> World
  334.   bool% = GpiConvert(hps&, CVTCPAGE, CVTCWORLD, 4,_
  335.           MakeLong(VARSEG(ptls(0)), VARPTR(ptls(0))))
  336.   CALL PrintPoints("World:",ptls())
  337.  
  338.   PRINT #1,
  339. END SUB
  340.  
  341. SUB PrintPoints(coord$, ptls() AS POINTL)
  342.   PRINT #1, coord$,
  343.   FOR i% = 0 TO 3
  344.     PRINT #1, "(";
  345.     PRINT #1, ptls(i%).x;
  346.     PRINT #1, ",";
  347.     PRINT #1, ptls(i%).y;
  348.     PRINT #1, ")",
  349.   NEXT
  350.   PRINT #1,
  351. END SUB
  352.