home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / modu1096.zip / sample / pmdemo / spincube.mod < prev    next >
Text File  |  1995-03-13  |  33KB  |  862 lines
  1. (****************************************************************)
  2. (*                                                              *)
  3. (*       GPM example for OS/2 Presentation Manager              *)
  4. (*         Custom Control Implementation Module                 *)
  5. (*                                                              *)
  6. (****************************************************************)
  7.  
  8. IMPLEMENTATION MODULE SpinCube;
  9.  
  10.   FROM SYSTEM   IMPORT CAST;
  11.   FROM Storage  IMPORT ALLOCATE, DEALLOCATE;
  12.   FROM ProgArgs IMPORT Assert;
  13.   FROM Random   IMPORT Random;
  14.   FROM RealMath IMPORT sin, cos;
  15.  
  16.   FROM OS2   IMPORT
  17.     HWND, HAB, HPS, HDC, HRGN, LONG, ULONG, USHORT, BOOL, NULL, NULLHANDLE,
  18.     MPARAM, MRESULT, HBITMAP, HMF, RECTL, POINTL, SIZEL, PSZ, MakePSTR,
  19.     MPFROM2SHORT, SHORT1FROMMP, SHORT2FROMMP, CREATESTRUCT, PCREATESTRUCT,
  20.     CLR_BLACK, CLR_BLUE, CLR_GREEN, CLR_RED, CLR_CYAN, CLR_PINK,
  21.     CLR_YELLOW, CLR_DARKBLUE, CLR_DARKRED, CLR_DARKPINK, CLR_PALEGRAY,
  22.     WM_PAINT, WM_TIMER, WM_SIZE, WM_BUTTON1DBLCLK, WM_BUTTON2DBLCLK,
  23.     WM_CREATE, WM_DESTROY, DEVOPENSTRUC, DevOpenDC, DevCloseDC, OD_MEMORY,
  24.     GpiCreatePS, PU_PELS, GPIA_ASSOC, GPIT_MICRO, GpiDestroyPS,
  25.     GpiCreateBitmap, GpiQueryDeviceBitmapFormats, BITMAPINFOHEADER,
  26.     GpiSetBitmap, GpiDeleteBitmap, GpiBitBlt, ROP_SRCCOPY, BBO_IGNORE,
  27.     GpiSetClipRegion, GpiCreateRegion, GpiSetClipRegion, GpiDestroyRegion,
  28.     GpiMove, GpiLine, GpiPolyLine, GpiBox, DRO_OUTLINE,
  29.     GpiSetColor, GpiBeginArea, GpiEndArea, BA_BOUNDARY,
  30.     WinBeginPaint, WinEndPaint, WinGetPS, WinReleasePS,
  31.     WinRegisterClass, CS_SIZEREDRAW, CS_CLIPSIBLINGS,
  32.     WinQueryWindowRect, WinInvalidateRect, WinEqualRect, WinFillRect,
  33.     WinUpdateWindow, WinStartTimer, WinStopTimer, WinDefWindowProc,
  34.     WinSendMsg, WinQueryWindowULong, WinSetWindowULong, QWL_STYLE, QWL_USER;
  35.  
  36.  
  37.  
  38.   TYPE SPINCUBEINFO = RECORD
  39.     hdc : HDC;               (* PS & DC that contain our off-screen image *)
  40.     hps : HPS;               (* we will always do our drawing on this bmp *)
  41.                              (*       & then blt the result to the screen *)
  42.  
  43.     fCurrentXRotation,       (* Angle (in radians) to rotate cube about *)
  44.     fCurrentYRotation,       (*   x, y, z axis                          *)
  45.     fCurrentZRotation    : REAL;
  46.  
  47.     fCurrentXRotationInc,    (* Amount to inc rotation angle each       *)
  48.     fCurrentYRotationInc,    (*   time we repaint (and are in motion)   *)
  49.     fCurrentZRotationInc : REAL;
  50.  
  51.     iCurrentXTranslation,    (* Distance (in pels) to translate cube    *)
  52.     iCurrentYTranslation,
  53.     iCurrentZTranslation : INTEGER;
  54.  
  55.     iCurrentXTranslationInc, (* Amount to inc translation distance each *)
  56.     iCurrentYTranslationInc, (*   time we repaint (and are in motion)   *)
  57.     iCurrentZTranslationInc : INTEGER;
  58.  
  59.     rcCubeBoundary : RECTL;  (* Bounding rectangle (in 2D) of the last
  60.                                   cube drawn.  We invalidate only this
  61.                                   region when we're doing animation
  62.                                   and get the WM_TIMER- it's alot more
  63.                                   efficient that invalidating the whole
  64.                                   control (there's less screen flashing *)
  65.  
  66.     iOptions : BITSET;       (* Contains the current options for this
  67.                                   ctrl, i.e. erase background.          *)
  68.   END;
  69.   PSPINCUBEINFO = POINTER TO SPINCUBEINFO;
  70.  
  71.   VAR hab : HAB;
  72.  
  73.  
  74.   CONST SPINCUBE_REPAINT_BKGND = 1;
  75.  
  76.         SPIN_EVENT             = 1;   (* timer event id to repaint control *)
  77.         SPIN_INTERVAL          = 75;  (* milliseconds between repaints.    *)
  78.  
  79.  
  80. (***************************************************************************\
  81. *
  82. *  Initialisation
  83. *
  84. ****************************************************************************)
  85. PROCEDURE SpinCubeInit(habInstance : HAB);
  86.   VAR b  : BOOL;
  87. BEGIN
  88.   hab := habInstance;
  89.  
  90.  (* Register the control window class *)
  91.   b := WinRegisterClass(habInstance, MakePSTR(SPINCUBECLASS),
  92.                         SpincubeWndProc,
  93.                         CS_SIZEREDRAW + CS_CLIPSIBLINGS, 4);
  94.  
  95.   Assert(b, "SpinCube: WinRegisterClass failed");
  96. END SpinCubeInit;
  97.  
  98.  
  99. (***************************************************************************\
  100. *
  101. *  SpincubeWndProc
  102. *
  103. *        This is the window procedure for our custom control. At
  104. *        creation we alloc a SPINCUBEINFO struct, initialize it,
  105. *        and associate it with this particular control. We also
  106. *        start a timer which will invalidate the window every so
  107. *        often; this causes a repaint, and the cube gets drawn in
  108. *        a new position. Left button clicks will toggle the
  109. *        erase option, causing a "trail" of cubes to be left when
  110. *        off. Right button clicks will toggle the motion state of
  111. *        the control (by turning the timer on/off).
  112. *
  113. ****************************************************************************)
  114. PROCEDURE SpincubeWndProc(hwnd : HWND; msg : ULONG;
  115.                                        mp1 : MPARAM; mp2 : MPARAM) : MRESULT;
  116.   VAR  pcs  : PCREATESTRUCT;
  117.        pSCI : PSPINCUBEINFO;
  118.        hbm  : HBITMAP;
  119.        bm   : BITMAPINFOHEADER;
  120.        sizl : SIZEL;
  121.        rc   : RECTL;
  122.        u    : ULONG;
  123.        b    : BOOL;
  124.        h    : HMF;
  125.        mr   : MRESULT;
  126.        lFormats : ARRAY [0 .. 1] OF LONG;
  127.        dop  : DEVOPENSTRUC;
  128.  
  129. BEGIN
  130.   CASE msg OF
  131.  
  132.   | WM_CREATE :
  133.       (*
  134.        * Alloc & init a SPINCUBEINFO struct for this particular control
  135.        *)
  136.        NEW(pSCI);
  137.        pcs := CAST(PCREATESTRUCT, mp2);
  138.  
  139.      (*
  140.       * Create a memory device context and PS for drawing the cube into
  141.       *)
  142.       dop := DEVOPENSTRUC{NULL, MakePSTR("DISPLAY"),
  143.                           NULL, NULL, NULL, NULL, NULL, NULL, NULL};
  144.       pSCI^.hdc := DevOpenDC(hab, OD_MEMORY, MakePSTR("*"), 5, dop, NULLHANDLE);
  145.       Assert(pSCI^.hdc <> NULLHANDLE,"SpinCube: DevOpenDC failed");
  146.  
  147.       sizl := SIZEL{0, 0};
  148.       pSCI^.hps := GpiCreatePS(hab, pSCI^.hdc, sizl,
  149.                                PU_PELS + GPIA_ASSOC + GPIT_MICRO);
  150.       Assert(pSCI^.hps <> NULLHANDLE,"SpinCube: GpiCreatePS failed");
  151.  
  152.      (*
  153.       * Initialize this instance structure
  154.       *)
  155.       pSCI^.fCurrentXRotation := 0.0;
  156.       pSCI^.fCurrentYRotation := 0.0;
  157.       pSCI^.fCurrentZRotation := 0.0;
  158.  
  159.       pSCI^.fCurrentXRotationInc := 0.2617; (* random # (15 degrees) *)
  160.       pSCI^.fCurrentYRotationInc := 0.2617;
  161.       pSCI^.fCurrentZRotationInc := 0.2617;
  162.  
  163.       pSCI^.iOptions := BITSET{SPINCUBE_REPAINT_BKGND};
  164.  
  165.       b := WinSetWindowULong(hwnd, QWL_USER, CAST(ULONG, pSCI));
  166.  
  167.       IF SS_INMOTION <= CAST(BITSET,WinQueryWindowULong(hwnd,QWL_STYLE)) THEN
  168.         u := WinStartTimer(hab, hwnd, SPIN_EVENT, SPIN_INTERVAL);
  169.       END;
  170.  
  171.      (*
  172.       *   Rest of create is as for WM_SIZE processing
  173.       *)
  174.       IF (pcs^.cx <> 0) AND (pcs^.cy <> 0) THEN
  175.         mr := WinSendMsg(hwnd, WM_SIZE, NULL, MPFROM2SHORT(pcs^.cx, pcs^.cy));
  176.       END;
  177.  
  178.   | WM_PAINT :
  179.       Paint(hwnd);
  180.  
  181.   | WM_TIMER :
  182.       IF SHORT1FROMMP(mp1) = SPIN_EVENT THEN
  183.         pSCI := CAST(PSPINCUBEINFO,WinQueryWindowULong(hwnd,QWL_USER));
  184.         b := WinInvalidateRect(hwnd, pSCI^.rcCubeBoundary, FALSE);
  185.       END;
  186.  
  187.   | WM_BUTTON1DBLCLK :
  188.      (*
  189.       *  Toggle the erase state of the control
  190.       *)
  191.       IF SS_ERASE <= CAST(BITSET,WinQueryWindowULong(hwnd,QWL_STYLE)) THEN
  192.         b := WinSetWindowULong(hwnd, QWL_STYLE, CAST(ULONG,CAST(BITSET,
  193.                             WinQueryWindowULong(hwnd, QWL_STYLE)) - SS_ERASE));
  194.       ELSE
  195.        (*
  196.         *  Repaint the entire control to get rid of the (cube trails) mess
  197.         *)
  198.         pSCI := CAST(PSPINCUBEINFO,WinQueryWindowULong(hwnd,QWL_USER));
  199.         b := WinSetWindowULong(hwnd, QWL_STYLE, CAST(ULONG,CAST(BITSET,
  200.                             WinQueryWindowULong(hwnd, QWL_STYLE)) + SS_ERASE));
  201.         INCL(pSCI^.iOptions, SPINCUBE_REPAINT_BKGND);
  202.  
  203.        (*  The C'ish trick of passing NULL instead of &rc to
  204.         *  invalidate the whole window is kind of difficult in Modula.
  205.         *)
  206.         b := WinQueryWindowRect(hwnd, rc);
  207.         b := WinInvalidateRect(hwnd, rc, FALSE);
  208.         b := WinUpdateWindow(hwnd);
  209.       END;
  210.  
  211.   | WM_BUTTON2DBLCLK :
  212.      (*
  213.       *  Toggle the motion state of the control
  214.       *)
  215.       IF SS_INMOTION <= CAST(BITSET,WinQueryWindowULong(hwnd,QWL_STYLE)) THEN
  216.         b := WinStopTimer(hab, hwnd, SPIN_EVENT);
  217.         b := WinSetWindowULong(hwnd, QWL_STYLE, CAST(ULONG,CAST(BITSET,
  218.                           WinQueryWindowULong(hwnd, QWL_STYLE)) - SS_INMOTION));
  219.       ELSE
  220.         u := WinStartTimer(hab, hwnd, SPIN_EVENT, SPIN_INTERVAL);
  221.         b := WinSetWindowULong(hwnd, QWL_STYLE, CAST(ULONG,CAST(BITSET,
  222.                           WinQueryWindowULong(hwnd, QWL_STYLE)) + SS_INMOTION));
  223.       END;
  224.  
  225.   | WM_SIZE:
  226.       pSCI := CAST(PSPINCUBEINFO,WinQueryWindowULong(hwnd,QWL_USER));
  227.  
  228.      (*
  229.       *  Get a new bitmap which is the new size of our window
  230.       *)
  231.       b := GpiQueryDeviceBitmapFormats(pSCI^.hps, 2, lFormats);
  232.       bm.cbFix     := SIZE(BITMAPINFOHEADER);
  233.       bm.cx        := SHORT1FROMMP(mp2);
  234.       bm.cy        := SHORT2FROMMP(mp2);
  235.       bm.cPlanes   := VAL(USHORT,lFormats[0]);
  236.       bm.cBitCount := VAL(USHORT,lFormats[1]);
  237.  
  238.       hbm := GpiCreateBitmap(pSCI^.hps, bm, 0, NULL, NULL);
  239.       Assert(hbm <> NULLHANDLE, "SpinCube: GpiCreateBitmap failed");
  240.  
  241.       hbm := GpiSetBitmap(pSCI^.hps, hbm);
  242.       IF hbm <> NULLHANDLE THEN
  243.          b := GpiDeleteBitmap(hbm);  (* Delete previous version *)
  244.       END;
  245.  
  246.      (*
  247.       *  Reset the translation so the cube doesn't go spinning off into
  248.       *    space somewhere- we'd never see it again!
  249.       *)
  250.       pSCI^.iCurrentXTranslation := 0;
  251.       pSCI^.iCurrentYTranslation := 0;
  252.       pSCI^.iCurrentZTranslation := 0;
  253.  
  254.      (*
  255.       *  All these calculations so the cube starts out with random movements,
  256.       *)
  257.       pSCI^.iCurrentXTranslationInc := INT(Random() * 10.0) + 2;
  258.       pSCI^.iCurrentYTranslationInc := INT(Random() * 10.0) + 2;
  259.       pSCI^.iCurrentZTranslationInc := INT(Random() * 10.0) + 2;
  260.       IF pSCI^.iCurrentXTranslationInc  > 7 THEN
  261.         pSCI^.iCurrentXTranslationInc := -pSCI^.iCurrentXTranslationInc;
  262.       END;
  263.       IF pSCI^.iCurrentYTranslationInc <= 7 THEN
  264.         pSCI^.iCurrentYTranslationInc := -pSCI^.iCurrentYTranslationInc;
  265.       END;
  266.       IF pSCI^.iCurrentZTranslationInc  > 7 THEN
  267.         pSCI^.iCurrentZTranslationInc := -pSCI^.iCurrentZTranslationInc;
  268.       END;
  269.  
  270.       pSCI^.rcCubeBoundary := RECTL{0, 0, VAL(LONG, SHORT1FROMMP(mp2)),
  271.                                           VAL(LONG, SHORT2FROMMP(mp2))};
  272.  
  273.       INCL(pSCI^.iOptions, SPINCUBE_REPAINT_BKGND);
  274.  
  275.       b := WinQueryWindowRect(hwnd, rc);
  276.       b := WinInvalidateRect(hwnd, rc, FALSE);
  277.  
  278.   | WM_DESTROY :
  279.       pSCI := CAST(PSPINCUBEINFO,WinQueryWindowULong(hwnd,QWL_USER));
  280.  
  281.      (*
  282.       *  Clean up all the resources used for this control
  283.       *)
  284.       IF SS_INMOTION <= CAST(BITSET,WinQueryWindowULong(hwnd,QWL_STYLE)) THEN
  285.         b := WinStopTimer(hab, hwnd, SPIN_EVENT)
  286.       END;
  287.       hbm := GpiSetBitmap(pSCI^.hps, NULLHANDLE);
  288.       IF hbm <> NULLHANDLE THEN
  289.         b := GpiDeleteBitmap(hbm)
  290.       END;
  291.       b := GpiDestroyPS(pSCI^.hps);
  292.       h := DevCloseDC(pSCI^.hdc);
  293.  
  294.       DISPOSE(pSCI);
  295.  
  296.   ELSE RETURN WinDefWindowProc(hwnd, msg, mp1, mp2)
  297.   END;
  298.  
  299.   RETURN NULL;
  300. END SpincubeWndProc;
  301.  
  302.  
  303. (****************************************************************************\
  304.  *
  305.  *  PAINT
  306.  *
  307.  *  PURPOSE:     This procedure is responsible for painting the SPINCUBE
  308.  *               custom control. When Paint() is called we retrieve a
  309.  *               pointer to a SPINCUBEINFO structure, and then use it's
  310.  *               current rotation & translation values to transform the
  311.  *               polyhedron described by gNormalizedVertices & gaiFacets.
  312.  *               Once we've transformed the vertices, we draw the
  313.  *               background, which consists of a grey rectangle and a few
  314.  *               black lines (a crass attempt to render a perspective
  315.  *               view into a "room"), on the offscreen bitmap associated
  316.  *               with the control (i.e. pSCI->hbmCompat). Then we walk the
  317.  *               facet list of the transformed polyhedron (gXformedVertices
  318.  *               & gaiFacets), drawing only those facets whose outward
  319.  *               normal faces us (again, drawing on pSCI->hbmCompat).
  320.  *               Finally, we BitBlt the appropriate rectangle from our
  321.  *               offscreen bitmap to the screen itself.
  322.  *
  323.  *               Drawing to the offscreen bitmap has two advantages over
  324.  *               drawing straight to the screen:
  325.  *
  326.  *                 1. The actual drawing the user sees consists of only
  327.  *                    a single BitBlt. Otherwise, the user would see us
  328.  *                    both erase the polyhedron in it's old position and
  329.  *                    draw it in it's new position (alot of flashing- not
  330.  *                    very smooth animation).
  331.  *
  332.  *                 2. When a spincube control with the SS_ERASE style
  333.  *                    is brought to the foreground, all it's contents
  334.  *                    i.e. the cube trails) are saved & can be re-Blted
  335.  *                    to the screen. Otherwise, all this info would be
  336.  *                    lost & there'd be a big blank spot in the middle
  337.  *                    of the control!
  338.  *
  339.  *               Interested persons should consult a text on 3 dimensional
  340.  *               graphics for more information (i.e. "Computer Graphics:
  341.  *               Principles and Practice", by Foley & van Dam).
  342.  *
  343.  *               Notes:
  344.  *
  345.  *               - A 3x2 tranformation matrix  is used instead of a  3x3
  346.  *                 matrix, since the transformed z-values aren't needed.
  347.  *                 (Normally these would be required for use in depth
  348.  *                 sorting  [for hidden surface removal], but  since we
  349.  *                 draw  only  a single convex polyhedron this  is not
  350.  *                 necessary.)
  351.  *
  352.  *               - A simplified perspective viewing transformation
  353.  *                 (which also  precludes the need for the transformed z
  354.  *                 coordinates). In a nutshell, the perspective  scale
  355.  *                 is as follows:
  356.  *
  357.  *                                    p' = S    x  p
  358.  *                                          per
  359.  *
  360.  *                 where:
  361.  *                        S    = WindowDepth /
  362.  *                         per      (WindowDepth + fCurrentZTranslation)
  363.  *
  364.  *                 (WindowDepth is  the greater of the  control's window
  365.  *                 height or window width.)
  366.  *
  367.  *
  368.  *  FUNCTIONS:   TransformVertices()             - transforms vertices
  369.  *               ComputeRotationTransformation() - computes xformation
  370.  *                                                 based on current x, y
  371.  *                                                 and z rotation angles
  372.  *
  373.  *
  374.  *                                  Dan Knudson
  375.  *                           Microsoft Developer Support
  376.  *                  Copyright (c) 1992, 1993 Microsoft Corporation
  377.  *
  378.  ****************************************************************************)
  379.  
  380.   CONST
  381.     MAXVERTEX  = 7;    (* polyhedron vertices [0..7]  *)
  382.     NUMFACETS  = 6;    (* number of polyhedron facets *)
  383.  
  384.   TYPE
  385.     POINT3D    = RECORD x, y, z : LONG END;
  386.     VERTICES   = ARRAY [0 .. MAXVERTEX] OF POINT3D;
  387.     FACETS     = ARRAY [0 .. 29] OF INTEGER;
  388.     CLRS       = ARRAY [0 .. 5]  OF LONG;
  389.  
  390. (*
  391.  *  This particular set of vertices "gNormalizedVertices" and corresponding
  392.  *    facets "gaiFacets" describe a normalized cube centered about the
  393.  *    origin ([0,0,0] in 3-space). The gaiFacet array is made up of a series
  394.  *    of indices into the array of vertices, each describing an individual
  395.  *    facet (eg. a polygon), and are separated by -1. Note that the facets
  396.  *    are described in COUNTERCLOCKWISE (relative to the viewer) order so we
  397.  *    can consistently find the normal to any given facet. (The normal
  398.  *    is used to determine facet visibilty.)
  399.  *)
  400.   CONST
  401.     gaiFacets   = FACETS{ 3, 2, 1, 0, -1,
  402.                           4, 5, 6, 7, -1,
  403.                           0, 1, 5, 4, -1,
  404.                           6, 2, 3, 7, -1,
  405.                           7, 3, 0, 4, -1,
  406.                           5, 1, 2, 6, -1 };
  407.  
  408.     gNormalizedVertices = VERTICES{{ 1, 1, 1}, { 1,-1, 1},
  409.                                    {-1,-1, 1}, {-1, 1, 1},
  410.                                    { 1, 1,-1}, { 1,-1,-1},
  411.                                    {-1,-1,-1}, {-1, 1,-1} };
  412.  
  413.     acrColor   = CLRS{CLR_BLUE, CLR_GREEN, CLR_RED, CLR_CYAN,
  414.                       CLR_PINK, CLR_YELLOW};
  415.  
  416.   VAR
  417.     gXformedVertices  : VERTICES;
  418.     gM                : ARRAY [0 .. 1],[0 .. 2] OF REAL;
  419.                           (* the transformation matrix *)
  420.  
  421.  
  422. PROCEDURE Paint(hwnd : HWND);
  423.  
  424.   TYPE PAINT = RECORD
  425.          hps : HPS;
  426.          CASE : INTEGER OF
  427.          | 0 :
  428.             rc   : RECTL;
  429.          | 1 :
  430.             rgn  : ARRAY [0 .. 0] OF RECTL;
  431.          | 2 :
  432.             aptl : ARRAY [0 .. 2] OF POINTL;
  433.          END;
  434.        END;
  435.  
  436.   VAR
  437.     pSCI         : PSPINCUBEINFO;
  438.     l            : LONG;
  439.     b            : BOOL;
  440.     rect         : RECTL;
  441.     paint        : PAINT;
  442.     hrgn         : HRGN;
  443.     numPoints    : ULONG;
  444.     points       : ARRAY [0 .. 3] OF POINTL;
  445.     i, iX, iY    : INTEGER;
  446.     lScaleFactor : LONG;
  447.     facetIndex   : INTEGER;
  448.     vector1, vector2, ptl : POINTL;
  449.  
  450. BEGIN
  451.   pSCI := CAST(PSPINCUBEINFO,WinQueryWindowULong(hwnd,QWL_USER));
  452.  
  453.   paint.hps := WinBeginPaint(hwnd, NULLHANDLE, paint.rc);
  454.  
  455.   IF NOT ((SPINCUBE_REPAINT_BKGND IN pSCI^.iOptions) OR
  456.            WinEqualRect(hab, paint.rc, pSCI^.rcCubeBoundary)) THEN
  457.    (*
  458.     * We're not here because it's time to animate (i.e. this paint isn't
  459.     *   the result of a WM_TIMER), so just do the Blt & blow out of here...
  460.     *)
  461.     paint.aptl[2] := paint.aptl[0];
  462.     l := GpiBitBlt(paint.hps, pSCI^.hps, 3, paint.aptl, ROP_SRCCOPY, BBO_IGNORE);
  463.     b := WinEndPaint(paint.hps);
  464.     RETURN;
  465.   END;
  466.  
  467.  (*
  468.   *  Determine a "best fit" scale factor for our polyhedron
  469.   *)
  470.   b := WinQueryWindowRect(hwnd, rect);
  471.   IF rect.xRight > rect.yTop THEN lScaleFactor := rect.yTop / 12;
  472.   ELSE                            lScaleFactor := rect.xRight  / 12;
  473.   END;
  474.   IF lScaleFactor = 0 THEN lScaleFactor := 1 END;
  475.  
  476.   TransformVertices(hwnd, rect, pSCI, lScaleFactor);
  477.  
  478.  (*
  479.   *  Draw the window frame & background
  480.   *
  481.   *  Note: The chances are that we are coming through here because we
  482.   *    got a WM_TIMER message & it's time to redraw the cube to simulate
  483.   *    animation. In that case all we want to erase/redraw is that small
  484.   *    rectangle which bounded the polyhedron the last time. The less
  485.   *    drawing that actually gets done the better, since we want to
  486.   *    minimize the flicker on the screen.
  487.   *)
  488.   IF (SS_ERASE <= CAST(BITSET,WinQueryWindowULong(hwnd,QWL_STYLE))) OR
  489.      (SPINCUBE_REPAINT_BKGND IN pSCI^.iOptions) THEN
  490.  
  491.     b := WinFillRect(pSCI^.hps, paint.rc, CLR_PALEGRAY);
  492.  
  493.     l := GpiSetClipRegion(pSCI^.hps,
  494.                           GpiCreateRegion(pSCI^.hps, 1, paint.rgn), hrgn);
  495.     iX := rect.xRight / 4;
  496.     iY := rect.yTop   / 4;
  497.  
  498.     ptl := POINTL{0, 0};
  499.     b := GpiMove(pSCI^.hps, ptl);
  500.     b := GpiSetColor(pSCI^.hps, CLR_BLACK);
  501.     ptl.x := rect.xRight - 1;
  502.     ptl.y := rect.yTop   - 1;
  503.     l := GpiBox(pSCI^.hps, DRO_OUTLINE, ptl, 0, 0);
  504.  
  505.     ptl.x := 0;
  506.     b := GpiMove(pSCI^.hps, ptl);
  507.     ptl.x := iX;
  508.     ptl.y := rect.yTop - iY;
  509.     l := GpiLine(pSCI^.hps, ptl);
  510.     ptl.y := iY;
  511.     l := GpiLine(pSCI^.hps, ptl);
  512.     ptl := POINTL{0, 0};
  513.     l := GpiLine(pSCI^.hps, ptl);
  514.  
  515.     ptl.x := rect.xRight;
  516.     ptl.y := rect.yTop;
  517.     b := GpiMove(pSCI^.hps, ptl);
  518.     ptl.x := rect.xRight - iX;
  519.     ptl.y := rect.yTop   - iY;
  520.     l := GpiLine(pSCI^.hps, ptl);
  521.     ptl.y := iY;
  522.     l := GpiLine(pSCI^.hps, ptl);
  523.     ptl.x := rect.xRight;
  524.     ptl.y := 0;
  525.     l := GpiLine(pSCI^.hps, ptl);
  526.  
  527.     ptl.x := iX;
  528.     ptl.y := rect.yTop - iY;
  529.     b := GpiMove(pSCI^.hps, ptl);
  530.     ptl.x := rect.xRight - iX;
  531.     l := GpiLine(pSCI^.hps, ptl);
  532.  
  533.     ptl.x := iX;
  534.     ptl.y := iY;
  535.     b := GpiMove(pSCI^.hps, ptl);
  536.     ptl.x := rect.xRight - iX;
  537.     l := GpiLine(pSCI^.hps, ptl);
  538.  
  539.     l := GpiSetClipRegion(pSCI^.hps, NULLHANDLE, hrgn);
  540.     b := GpiDestroyRegion(pSCI^.hps, hrgn);
  541.  
  542.     EXCL(pSCI^.iOptions, SPINCUBE_REPAINT_BKGND);
  543.   END;
  544.  
  545.  (*
  546.   *  Draw the polyhedron. We'll walk through the facets list and compute
  547.   *    the normal for each facet- if the normal has z > 0, then the facet
  548.   *    faces us and we'll draw it. Note that this algorithim is ONLY valid
  549.   *    for scenes with a single, convex polyhedron.
  550.   *
  551.   *  Note: Use WinGetPS here because the above call to BeginPaint will
  552.   *    probably not give us a PS with access to as much real estate as
  553.   *    we'd like (we wouldn't be able to draw outside of the invalid
  554.   *    region). We can party on the entire control window with the PS
  555.   *    returned by WinGetPS.
  556.   *)
  557.   facetIndex := 0;
  558.   FOR i := 0 TO NUMFACETS - 1 DO
  559.     vector1.x := gXformedVertices[gaiFacets[facetIndex + 1]].x -
  560.                  gXformedVertices[gaiFacets[facetIndex]].x;
  561.     vector1.y := gXformedVertices[gaiFacets[facetIndex + 1]].y -
  562.                  gXformedVertices[gaiFacets[facetIndex]].y;
  563.     vector2.x := gXformedVertices[gaiFacets[facetIndex + 2]].x -
  564.                  gXformedVertices[gaiFacets[facetIndex + 1]].x;
  565.     vector2.y := gXformedVertices[gaiFacets[facetIndex + 2]].y -
  566.                  gXformedVertices[gaiFacets[facetIndex + 1]].y;
  567.  
  568.     ptl.x := gXformedVertices[gaiFacets[facetIndex]].x;
  569.     ptl.y := gXformedVertices[gaiFacets[facetIndex]].y;
  570.     INC(facetIndex);
  571.     numPoints := 0;
  572.     WHILE gaiFacets[facetIndex] <> -1 DO
  573.       points[numPoints].x := gXformedVertices[gaiFacets[facetIndex]].x;
  574.       points[numPoints].y := gXformedVertices[gaiFacets[facetIndex]].y;
  575.       INC(facetIndex);
  576.       INC(numPoints);
  577.     END;
  578.  
  579.     INC(facetIndex);   (* skip over the -1's in the facets list *)
  580.     IF (vector1.x * vector2.y - vector1.y * vector2.x) > 0 THEN
  581.       b := GpiSetColor(pSCI^.hps, acrColor[i]);
  582.       b := GpiBeginArea(pSCI^.hps, BA_BOUNDARY);
  583.       b := GpiMove(pSCI^.hps, ptl);
  584.       l := GpiPolyLine(pSCI^.hps, numPoints, points);
  585.       l := GpiEndArea(pSCI^.hps);
  586.     END;
  587.   END;
  588.  
  589.   IF pSCI^.rcCubeBoundary.xLeft < paint.rc.xLeft THEN
  590.     paint.rc.xLeft := pSCI^.rcCubeBoundary.xLeft;
  591.   END;
  592.  
  593.   IF pSCI^.rcCubeBoundary.yTop > paint.rc.yTop THEN
  594.     paint.rc.yTop := pSCI^.rcCubeBoundary.yTop;
  595.   END;
  596.  
  597.   IF pSCI^.rcCubeBoundary.xRight > paint.rc.xRight THEN
  598.     paint.rc.xRight := pSCI^.rcCubeBoundary.xRight;
  599.   END;
  600.  
  601.   IF pSCI^.rcCubeBoundary.yBottom < paint.rc.yBottom THEN
  602.     paint.rc.yBottom := pSCI^.rcCubeBoundary.yBottom;
  603.   END;
  604.  
  605.   b := WinEndPaint(paint.hps);
  606.  
  607.   paint.hps     := WinGetPS(hwnd);
  608.   paint.aptl[2] := paint.aptl[0];
  609.   l := GpiBitBlt(paint.hps, pSCI^.hps, 3, paint.aptl, ROP_SRCCOPY, BBO_IGNORE);
  610.   b := WinReleasePS(paint.hps);
  611. END Paint;
  612.  
  613.  
  614. (******************************************************************************\
  615. *
  616. *  FUNCTION:     TransformVertices
  617. *
  618. *  INPUTS:       hwnd         - control window handle
  619. *                ctrlRect     - pointer to RECT describing control's dimensions
  620. *                pSCI         - pointer to control's SPINCUBEINFO structure
  621. *                fScaleFactor - scale factor for use in this window
  622. *
  623. ******************************************************************************)
  624. PROCEDURE TransformVertices(hwnd : HWND; VAR ctrlRect : RECTL;
  625.                             pSCI : PSPINCUBEINFO; lScaleFactor : LONG);
  626.   VAR
  627.       i, iWindowDepth    : INTEGER;
  628.       WindowRect         : RECTL;
  629.       fDepthScale        : REAL;
  630.       fNewRotationInc    : REAL;
  631.       iNewTranslationInc : INTEGER;
  632.       tempX              : LONG;
  633.  
  634.   BEGIN
  635.     iNewTranslationInc := INT(Random() * 10.0) + 2;
  636.     fNewRotationInc    := Random() * 0.3 + 0.02;
  637.     IF ctrlRect.xRight > ctrlRect.yTop THEN
  638.       iWindowDepth := ctrlRect.xRight;
  639.     ELSE
  640.       iWindowDepth := ctrlRect.yTop;
  641.     END;
  642.     WindowRect.xRight  := ctrlRect.xRight / 2;
  643.     WindowRect.xLeft   := - WindowRect.xRight;
  644.     WindowRect.yTop    := ctrlRect.yTop / 2;
  645.     WindowRect.yBottom := - WindowRect.yTop;
  646.  
  647.  (*
  648.   * Initialize the bounding rectangle with max/min vals
  649.   *)
  650.   pSCI^.rcCubeBoundary := RECTL{ 100000, 100000,-100000,-100000 };
  651.  
  652.  (*
  653.   *  Copy the static vertices into a temp array
  654.   *)
  655.   gXformedVertices := gNormalizedVertices;
  656.  
  657.  (*
  658.   *  First scale, then rotate, then translate each vertex.
  659.   *    Keep track of the maximum & minimum values bounding the
  660.   *    vertices in the x,y plane for use later in bounds checking.
  661.   *
  662.   *  Note: we don't bother computing z values after the scale,
  663.   *    as they are only really necessary for the rotation. If we
  664.   *    were doing real bounds checking we'd need it, but this code
  665.   *    simply uses the pSCI^.iCurrentZTranslation to determine
  666.   *    the z-boundaries.
  667.   *)
  668.   FOR i := 0 TO MAXVERTEX DO
  669.    (*
  670.     *  The scale...
  671.     *)
  672.     gXformedVertices[i].x := gXformedVertices[i].x * lScaleFactor;
  673.     gXformedVertices[i].y := gXformedVertices[i].y * lScaleFactor;
  674.     gXformedVertices[i].z := gXformedVertices[i].z * lScaleFactor;
  675.  
  676.    (*
  677.     *  The rotation...
  678.     *)
  679.     ComputeRotationTransformation(pSCI^.fCurrentXRotation,
  680.                                   pSCI^.fCurrentYRotation,
  681.                                   pSCI^.fCurrentZRotation);
  682.  
  683.     tempX  :=                VAL(LONG,gM[0][0] * FLOAT(gXformedVertices[i].x) +
  684.                                       gM[0][1] * FLOAT(gXformedVertices[i].y) +
  685.                                       gM[0][2] * FLOAT(gXformedVertices[i].z));
  686.  
  687.     gXformedVertices[i].y := VAL(LONG,gM[1][0] * FLOAT(gXformedVertices[i].x) +
  688.                                       gM[1][1] * FLOAT(gXformedVertices[i].y) +
  689.                                       gM[1][2] * FLOAT(gXformedVertices[i].z));
  690.     gXformedVertices[i].x := tempX;
  691.  
  692.    (*
  693.     *  The translation...
  694.     *)
  695.     INC(gXformedVertices[i].x, pSCI^.iCurrentXTranslation);
  696.     INC(gXformedVertices[i].y, pSCI^.iCurrentYTranslation);
  697.  
  698.    (*
  699.     *  Check if we have new max or min vals
  700.     *)
  701.     IF pSCI^.rcCubeBoundary.xLeft > gXformedVertices[i].x THEN
  702.       pSCI^.rcCubeBoundary.xLeft := gXformedVertices[i].x;
  703.     END;
  704.  
  705.     IF pSCI^.rcCubeBoundary.xRight < gXformedVertices[i].x THEN
  706.       pSCI^.rcCubeBoundary.xRight := gXformedVertices[i].x;
  707.     END;
  708.  
  709.     IF pSCI^.rcCubeBoundary.yTop < gXformedVertices[i].y THEN
  710.       pSCI^.rcCubeBoundary.yTop := gXformedVertices[i].y;
  711.     END;
  712.  
  713.     IF pSCI^.rcCubeBoundary.yBottom > gXformedVertices[i].y THEN
  714.       pSCI^.rcCubeBoundary.yBottom := gXformedVertices[i].y;
  715.     END;
  716.   END;
  717.  
  718.  (*
  719.   *  Now for some bounds checking,
  720.   *    change translation & rotation increments if we hit a "wall".
  721.   *)
  722.   IF pSCI^.rcCubeBoundary.xLeft < WindowRect.xLeft THEN
  723.     pSCI^.iCurrentXTranslationInc := iNewTranslationInc;
  724.     pSCI^.fCurrentZRotationInc    := fNewRotationInc;
  725.  
  726.   ELSIF pSCI^.rcCubeBoundary.xRight > WindowRect.xRight THEN
  727.     pSCI^.iCurrentXTranslationInc := -iNewTranslationInc;
  728.     pSCI^.fCurrentZRotationInc    := -fNewRotationInc;
  729.   END;
  730.  
  731.   IF pSCI^.rcCubeBoundary.yTop > WindowRect.yTop THEN
  732.     pSCI^.iCurrentYTranslationInc := -iNewTranslationInc;
  733.     pSCI^.fCurrentXRotationInc    := -fNewRotationInc;
  734.  
  735.   ELSIF pSCI^.rcCubeBoundary.yBottom < WindowRect.yBottom THEN
  736.     pSCI^.iCurrentYTranslationInc := iNewTranslationInc;
  737.     pSCI^.fCurrentXRotationInc    := fNewRotationInc;
  738.   END;
  739.  
  740.   IF pSCI^.iCurrentZTranslation < (lScaleFactor * 2) THEN
  741.     pSCI^.iCurrentZTranslationInc := iNewTranslationInc;
  742.     pSCI^.fCurrentYRotationInc    := fNewRotationInc;
  743.  
  744.   ELSIF pSCI^.iCurrentZTranslation > (iWindowDepth - lScaleFactor) THEN
  745.     pSCI^.iCurrentZTranslationInc := -iNewTranslationInc;
  746.     pSCI^.fCurrentYRotationInc    := -fNewRotationInc;
  747.   END;
  748.  
  749.  (*
  750.   *  Now a kludgy scale based on depth (iCurrentZTranslation) of the center
  751.   *    point of the polyhedron
  752.   *)
  753.   fDepthScale := FLOAT(iWindowDepth) /
  754.                  FLOAT(iWindowDepth + pSCI^.iCurrentZTranslation);
  755.  
  756.   pSCI^.rcCubeBoundary.xLeft   := VAL(LONG,fDepthScale *
  757.                                           FLOAT(pSCI^.rcCubeBoundary.xLeft));
  758.   pSCI^.rcCubeBoundary.xRight  := VAL(LONG,fDepthScale *
  759.                                           FLOAT(pSCI^.rcCubeBoundary.xRight));
  760.   pSCI^.rcCubeBoundary.yTop    := VAL(LONG,fDepthScale *
  761.                                           FLOAT(pSCI^.rcCubeBoundary.yTop));
  762.   pSCI^.rcCubeBoundary.yBottom := VAL(LONG,fDepthScale *
  763.                                           FLOAT(pSCI^.rcCubeBoundary.yBottom));
  764.  
  765.   FOR i := 0 TO MAXVERTEX DO
  766.     gXformedVertices[i].x := VAL(LONG,fDepthScale *
  767.                                       FLOAT(gXformedVertices[i].x));
  768.     gXformedVertices[i].y := VAL(LONG,fDepthScale *
  769.                                       FLOAT(gXformedVertices[i].y));
  770.   END;
  771.  
  772.  (*
  773.   *  If currently in motion then increment the current rotation & translation
  774.   *)
  775.   IF SS_INMOTION <= CAST(BITSET,WinQueryWindowULong(hwnd,QWL_STYLE)) THEN
  776.     pSCI^.fCurrentXRotation := pSCI^.fCurrentXRotation + pSCI^.fCurrentXRotationInc;
  777.     pSCI^.fCurrentYRotation := pSCI^.fCurrentYRotation + pSCI^.fCurrentYRotationInc;
  778.     pSCI^.fCurrentZRotation := pSCI^.fCurrentZRotation + pSCI^.fCurrentZRotationInc;
  779.  
  780.     INC(pSCI^.iCurrentXTranslation, pSCI^.iCurrentXTranslationInc);
  781.     INC(pSCI^.iCurrentYTranslation, pSCI^.iCurrentYTranslationInc);
  782.     INC(pSCI^.iCurrentZTranslation, pSCI^.iCurrentZTranslationInc);
  783.   END;
  784.  
  785.  (*
  786.   *  Up to this point all coordinates are relative to a window whose
  787.   *    center is at (0,0). Now we'll translate appropriately...
  788.   *)
  789.   INC(pSCI^.rcCubeBoundary.xLeft,   ctrlRect.xRight  / 2);
  790.   INC(pSCI^.rcCubeBoundary.xRight,  ctrlRect.xRight  / 2);
  791.   INC(pSCI^.rcCubeBoundary.yTop,    ctrlRect.yTop / 2);
  792.   INC(pSCI^.rcCubeBoundary.yBottom, ctrlRect.yTop / 2);
  793.  
  794.   FOR i := 0 TO MAXVERTEX DO
  795.     INC(gXformedVertices[i].x, ctrlRect.xRight / 2);
  796.     INC(gXformedVertices[i].y, ctrlRect.yTop / 2);
  797.   END;
  798.  
  799.  (*
  800.   *  Since FillRect's are inclusive-exclusive (there'll be leftovers
  801.   *    from the last cube we drew otherwise)...
  802.   *)
  803.   INC(pSCI^.rcCubeBoundary.xRight);
  804.   INC(pSCI^.rcCubeBoundary.yTop);
  805.  
  806.  (*
  807.   *  Finally, adjust the rcCubeBoundary such that it fits entirely within
  808.   *    the actual control window. The reason for this is that when calling
  809.   *    InvalidateRect from SpincubeWndProc\case_WM_TIMER we may get
  810.   *    a different paint.rc (since InvalidateRect clips the passed
  811.   *    in rect to the window bounds)
  812.   *)
  813.   IF pSCI^.rcCubeBoundary.xLeft   < 0 THEN
  814.     pSCI^.rcCubeBoundary.xLeft := 0
  815.   END;
  816.   IF pSCI^.rcCubeBoundary.yBottom < 0 THEN 
  817.     pSCI^.rcCubeBoundary.yBottom := 0
  818.   END;
  819.   IF pSCI^.rcCubeBoundary.xRight > ctrlRect.xRight THEN
  820.     pSCI^.rcCubeBoundary.xRight := ctrlRect.xRight
  821.   END;
  822.   IF pSCI^.rcCubeBoundary.yTop > ctrlRect.yTop THEN
  823.     pSCI^.rcCubeBoundary.yTop := ctrlRect.yTop
  824.   END;
  825.  
  826. END TransformVertices;
  827.  
  828.  
  829. (******************************************************************************\
  830. *
  831. *  FUNCTION:    ComputeRotationTransformation
  832. *
  833. *  INPUTS:      fRotationX - Angle to rotate about X axis.
  834. *               fRotationY - Angle to rotate about Y axis.
  835. *               fRotationZ - Angle to rotate about Z axis.
  836. *
  837. *  COMMENTS:    Computes a 3x2 tranformation matrix which rotates about
  838. *               the Z axis, the Y axis, and the X axis, respectively.
  839. *
  840. ******************************************************************************)
  841. PROCEDURE ComputeRotationTransformation(fRotationX : REAL;
  842.                                         fRotationY : REAL;
  843.                                         fRotationZ : REAL);
  844.   VAR sinX, cosX, sinY, cosY, sinZ, cosZ : REAL;
  845. BEGIN
  846.   sinX := sin(fRotationX);
  847.   cosX := cos(fRotationX);
  848.   sinY := sin(fRotationY);
  849.   cosY := cos(fRotationY);
  850.   sinZ := sin(fRotationZ);
  851.   cosZ := cos(fRotationZ);
  852.  
  853.   gM[0][0] :=  cosY * cosZ;
  854.   gM[0][1] := -cosY * sinZ;
  855.   gM[0][2] :=  sinY;
  856.   gM[1][0] :=  sinX * sinY * cosZ + cosX * sinZ;
  857.   gM[1][1] := -sinX * sinY * sinZ + cosX * cosZ;
  858.   gM[1][2] := -sinX * cosY;
  859. END ComputeRotationTransformation;
  860.  
  861. END SpinCube.
  862.