home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 10 Tools
/
10-Tools.zip
/
modu1096.zip
/
sample
/
pmdemo
/
spincube.mod
< prev
next >
Wrap
Text File
|
1995-03-13
|
33KB
|
862 lines
(****************************************************************)
(* *)
(* GPM example for OS/2 Presentation Manager *)
(* Custom Control Implementation Module *)
(* *)
(****************************************************************)
IMPLEMENTATION MODULE SpinCube;
FROM SYSTEM IMPORT CAST;
FROM Storage IMPORT ALLOCATE, DEALLOCATE;
FROM ProgArgs IMPORT Assert;
FROM Random IMPORT Random;
FROM RealMath IMPORT sin, cos;
FROM OS2 IMPORT
HWND, HAB, HPS, HDC, HRGN, LONG, ULONG, USHORT, BOOL, NULL, NULLHANDLE,
MPARAM, MRESULT, HBITMAP, HMF, RECTL, POINTL, SIZEL, PSZ, MakePSTR,
MPFROM2SHORT, SHORT1FROMMP, SHORT2FROMMP, CREATESTRUCT, PCREATESTRUCT,
CLR_BLACK, CLR_BLUE, CLR_GREEN, CLR_RED, CLR_CYAN, CLR_PINK,
CLR_YELLOW, CLR_DARKBLUE, CLR_DARKRED, CLR_DARKPINK, CLR_PALEGRAY,
WM_PAINT, WM_TIMER, WM_SIZE, WM_BUTTON1DBLCLK, WM_BUTTON2DBLCLK,
WM_CREATE, WM_DESTROY, DEVOPENSTRUC, DevOpenDC, DevCloseDC, OD_MEMORY,
GpiCreatePS, PU_PELS, GPIA_ASSOC, GPIT_MICRO, GpiDestroyPS,
GpiCreateBitmap, GpiQueryDeviceBitmapFormats, BITMAPINFOHEADER,
GpiSetBitmap, GpiDeleteBitmap, GpiBitBlt, ROP_SRCCOPY, BBO_IGNORE,
GpiSetClipRegion, GpiCreateRegion, GpiSetClipRegion, GpiDestroyRegion,
GpiMove, GpiLine, GpiPolyLine, GpiBox, DRO_OUTLINE,
GpiSetColor, GpiBeginArea, GpiEndArea, BA_BOUNDARY,
WinBeginPaint, WinEndPaint, WinGetPS, WinReleasePS,
WinRegisterClass, CS_SIZEREDRAW, CS_CLIPSIBLINGS,
WinQueryWindowRect, WinInvalidateRect, WinEqualRect, WinFillRect,
WinUpdateWindow, WinStartTimer, WinStopTimer, WinDefWindowProc,
WinSendMsg, WinQueryWindowULong, WinSetWindowULong, QWL_STYLE, QWL_USER;
TYPE SPINCUBEINFO = RECORD
hdc : HDC; (* PS & DC that contain our off-screen image *)
hps : HPS; (* we will always do our drawing on this bmp *)
(* & then blt the result to the screen *)
fCurrentXRotation, (* Angle (in radians) to rotate cube about *)
fCurrentYRotation, (* x, y, z axis *)
fCurrentZRotation : REAL;
fCurrentXRotationInc, (* Amount to inc rotation angle each *)
fCurrentYRotationInc, (* time we repaint (and are in motion) *)
fCurrentZRotationInc : REAL;
iCurrentXTranslation, (* Distance (in pels) to translate cube *)
iCurrentYTranslation,
iCurrentZTranslation : INTEGER;
iCurrentXTranslationInc, (* Amount to inc translation distance each *)
iCurrentYTranslationInc, (* time we repaint (and are in motion) *)
iCurrentZTranslationInc : INTEGER;
rcCubeBoundary : RECTL; (* Bounding rectangle (in 2D) of the last
cube drawn. We invalidate only this
region when we're doing animation
and get the WM_TIMER- it's alot more
efficient that invalidating the whole
control (there's less screen flashing *)
iOptions : BITSET; (* Contains the current options for this
ctrl, i.e. erase background. *)
END;
PSPINCUBEINFO = POINTER TO SPINCUBEINFO;
VAR hab : HAB;
CONST SPINCUBE_REPAINT_BKGND = 1;
SPIN_EVENT = 1; (* timer event id to repaint control *)
SPIN_INTERVAL = 75; (* milliseconds between repaints. *)
(***************************************************************************\
*
* Initialisation
*
****************************************************************************)
PROCEDURE SpinCubeInit(habInstance : HAB);
VAR b : BOOL;
BEGIN
hab := habInstance;
(* Register the control window class *)
b := WinRegisterClass(habInstance, MakePSTR(SPINCUBECLASS),
SpincubeWndProc,
CS_SIZEREDRAW + CS_CLIPSIBLINGS, 4);
Assert(b, "SpinCube: WinRegisterClass failed");
END SpinCubeInit;
(***************************************************************************\
*
* SpincubeWndProc
*
* This is the window procedure for our custom control. At
* creation we alloc a SPINCUBEINFO struct, initialize it,
* and associate it with this particular control. We also
* start a timer which will invalidate the window every so
* often; this causes a repaint, and the cube gets drawn in
* a new position. Left button clicks will toggle the
* erase option, causing a "trail" of cubes to be left when
* off. Right button clicks will toggle the motion state of
* the control (by turning the timer on/off).
*
****************************************************************************)
PROCEDURE SpincubeWndProc(hwnd : HWND; msg : ULONG;
mp1 : MPARAM; mp2 : MPARAM) : MRESULT;
VAR pcs : PCREATESTRUCT;
pSCI : PSPINCUBEINFO;
hbm : HBITMAP;
bm : BITMAPINFOHEADER;
sizl : SIZEL;
rc : RECTL;
u : ULONG;
b : BOOL;
h : HMF;
mr : MRESULT;
lFormats : ARRAY [0 .. 1] OF LONG;
dop : DEVOPENSTRUC;
BEGIN
CASE msg OF
| WM_CREATE :
(*
* Alloc & init a SPINCUBEINFO struct for this particular control
*)
NEW(pSCI);
pcs := CAST(PCREATESTRUCT, mp2);
(*
* Create a memory device context and PS for drawing the cube into
*)
dop := DEVOPENSTRUC{NULL, MakePSTR("DISPLAY"),
NULL, NULL, NULL, NULL, NULL, NULL, NULL};
pSCI^.hdc := DevOpenDC(hab, OD_MEMORY, MakePSTR("*"), 5, dop, NULLHANDLE);
Assert(pSCI^.hdc <> NULLHANDLE,"SpinCube: DevOpenDC failed");
sizl := SIZEL{0, 0};
pSCI^.hps := GpiCreatePS(hab, pSCI^.hdc, sizl,
PU_PELS + GPIA_ASSOC + GPIT_MICRO);
Assert(pSCI^.hps <> NULLHANDLE,"SpinCube: GpiCreatePS failed");
(*
* Initialize this instance structure
*)
pSCI^.fCurrentXRotation := 0.0;
pSCI^.fCurrentYRotation := 0.0;
pSCI^.fCurrentZRotation := 0.0;
pSCI^.fCurrentXRotationInc := 0.2617; (* random # (15 degrees) *)
pSCI^.fCurrentYRotationInc := 0.2617;
pSCI^.fCurrentZRotationInc := 0.2617;
pSCI^.iOptions := BITSET{SPINCUBE_REPAINT_BKGND};
b := WinSetWindowULong(hwnd, QWL_USER, CAST(ULONG, pSCI));
IF SS_INMOTION <= CAST(BITSET,WinQueryWindowULong(hwnd,QWL_STYLE)) THEN
u := WinStartTimer(hab, hwnd, SPIN_EVENT, SPIN_INTERVAL);
END;
(*
* Rest of create is as for WM_SIZE processing
*)
IF (pcs^.cx <> 0) AND (pcs^.cy <> 0) THEN
mr := WinSendMsg(hwnd, WM_SIZE, NULL, MPFROM2SHORT(pcs^.cx, pcs^.cy));
END;
| WM_PAINT :
Paint(hwnd);
| WM_TIMER :
IF SHORT1FROMMP(mp1) = SPIN_EVENT THEN
pSCI := CAST(PSPINCUBEINFO,WinQueryWindowULong(hwnd,QWL_USER));
b := WinInvalidateRect(hwnd, pSCI^.rcCubeBoundary, FALSE);
END;
| WM_BUTTON1DBLCLK :
(*
* Toggle the erase state of the control
*)
IF SS_ERASE <= CAST(BITSET,WinQueryWindowULong(hwnd,QWL_STYLE)) THEN
b := WinSetWindowULong(hwnd, QWL_STYLE, CAST(ULONG,CAST(BITSET,
WinQueryWindowULong(hwnd, QWL_STYLE)) - SS_ERASE));
ELSE
(*
* Repaint the entire control to get rid of the (cube trails) mess
*)
pSCI := CAST(PSPINCUBEINFO,WinQueryWindowULong(hwnd,QWL_USER));
b := WinSetWindowULong(hwnd, QWL_STYLE, CAST(ULONG,CAST(BITSET,
WinQueryWindowULong(hwnd, QWL_STYLE)) + SS_ERASE));
INCL(pSCI^.iOptions, SPINCUBE_REPAINT_BKGND);
(* The C'ish trick of passing NULL instead of &rc to
* invalidate the whole window is kind of difficult in Modula.
*)
b := WinQueryWindowRect(hwnd, rc);
b := WinInvalidateRect(hwnd, rc, FALSE);
b := WinUpdateWindow(hwnd);
END;
| WM_BUTTON2DBLCLK :
(*
* Toggle the motion state of the control
*)
IF SS_INMOTION <= CAST(BITSET,WinQueryWindowULong(hwnd,QWL_STYLE)) THEN
b := WinStopTimer(hab, hwnd, SPIN_EVENT);
b := WinSetWindowULong(hwnd, QWL_STYLE, CAST(ULONG,CAST(BITSET,
WinQueryWindowULong(hwnd, QWL_STYLE)) - SS_INMOTION));
ELSE
u := WinStartTimer(hab, hwnd, SPIN_EVENT, SPIN_INTERVAL);
b := WinSetWindowULong(hwnd, QWL_STYLE, CAST(ULONG,CAST(BITSET,
WinQueryWindowULong(hwnd, QWL_STYLE)) + SS_INMOTION));
END;
| WM_SIZE:
pSCI := CAST(PSPINCUBEINFO,WinQueryWindowULong(hwnd,QWL_USER));
(*
* Get a new bitmap which is the new size of our window
*)
b := GpiQueryDeviceBitmapFormats(pSCI^.hps, 2, lFormats);
bm.cbFix := SIZE(BITMAPINFOHEADER);
bm.cx := SHORT1FROMMP(mp2);
bm.cy := SHORT2FROMMP(mp2);
bm.cPlanes := VAL(USHORT,lFormats[0]);
bm.cBitCount := VAL(USHORT,lFormats[1]);
hbm := GpiCreateBitmap(pSCI^.hps, bm, 0, NULL, NULL);
Assert(hbm <> NULLHANDLE, "SpinCube: GpiCreateBitmap failed");
hbm := GpiSetBitmap(pSCI^.hps, hbm);
IF hbm <> NULLHANDLE THEN
b := GpiDeleteBitmap(hbm); (* Delete previous version *)
END;
(*
* Reset the translation so the cube doesn't go spinning off into
* space somewhere- we'd never see it again!
*)
pSCI^.iCurrentXTranslation := 0;
pSCI^.iCurrentYTranslation := 0;
pSCI^.iCurrentZTranslation := 0;
(*
* All these calculations so the cube starts out with random movements,
*)
pSCI^.iCurrentXTranslationInc := INT(Random() * 10.0) + 2;
pSCI^.iCurrentYTranslationInc := INT(Random() * 10.0) + 2;
pSCI^.iCurrentZTranslationInc := INT(Random() * 10.0) + 2;
IF pSCI^.iCurrentXTranslationInc > 7 THEN
pSCI^.iCurrentXTranslationInc := -pSCI^.iCurrentXTranslationInc;
END;
IF pSCI^.iCurrentYTranslationInc <= 7 THEN
pSCI^.iCurrentYTranslationInc := -pSCI^.iCurrentYTranslationInc;
END;
IF pSCI^.iCurrentZTranslationInc > 7 THEN
pSCI^.iCurrentZTranslationInc := -pSCI^.iCurrentZTranslationInc;
END;
pSCI^.rcCubeBoundary := RECTL{0, 0, VAL(LONG, SHORT1FROMMP(mp2)),
VAL(LONG, SHORT2FROMMP(mp2))};
INCL(pSCI^.iOptions, SPINCUBE_REPAINT_BKGND);
b := WinQueryWindowRect(hwnd, rc);
b := WinInvalidateRect(hwnd, rc, FALSE);
| WM_DESTROY :
pSCI := CAST(PSPINCUBEINFO,WinQueryWindowULong(hwnd,QWL_USER));
(*
* Clean up all the resources used for this control
*)
IF SS_INMOTION <= CAST(BITSET,WinQueryWindowULong(hwnd,QWL_STYLE)) THEN
b := WinStopTimer(hab, hwnd, SPIN_EVENT)
END;
hbm := GpiSetBitmap(pSCI^.hps, NULLHANDLE);
IF hbm <> NULLHANDLE THEN
b := GpiDeleteBitmap(hbm)
END;
b := GpiDestroyPS(pSCI^.hps);
h := DevCloseDC(pSCI^.hdc);
DISPOSE(pSCI);
ELSE RETURN WinDefWindowProc(hwnd, msg, mp1, mp2)
END;
RETURN NULL;
END SpincubeWndProc;
(****************************************************************************\
*
* PAINT
*
* PURPOSE: This procedure is responsible for painting the SPINCUBE
* custom control. When Paint() is called we retrieve a
* pointer to a SPINCUBEINFO structure, and then use it's
* current rotation & translation values to transform the
* polyhedron described by gNormalizedVertices & gaiFacets.
* Once we've transformed the vertices, we draw the
* background, which consists of a grey rectangle and a few
* black lines (a crass attempt to render a perspective
* view into a "room"), on the offscreen bitmap associated
* with the control (i.e. pSCI->hbmCompat). Then we walk the
* facet list of the transformed polyhedron (gXformedVertices
* & gaiFacets), drawing only those facets whose outward
* normal faces us (again, drawing on pSCI->hbmCompat).
* Finally, we BitBlt the appropriate rectangle from our
* offscreen bitmap to the screen itself.
*
* Drawing to the offscreen bitmap has two advantages over
* drawing straight to the screen:
*
* 1. The actual drawing the user sees consists of only
* a single BitBlt. Otherwise, the user would see us
* both erase the polyhedron in it's old position and
* draw it in it's new position (alot of flashing- not
* very smooth animation).
*
* 2. When a spincube control with the SS_ERASE style
* is brought to the foreground, all it's contents
* i.e. the cube trails) are saved & can be re-Blted
* to the screen. Otherwise, all this info would be
* lost & there'd be a big blank spot in the middle
* of the control!
*
* Interested persons should consult a text on 3 dimensional
* graphics for more information (i.e. "Computer Graphics:
* Principles and Practice", by Foley & van Dam).
*
* Notes:
*
* - A 3x2 tranformation matrix is used instead of a 3x3
* matrix, since the transformed z-values aren't needed.
* (Normally these would be required for use in depth
* sorting [for hidden surface removal], but since we
* draw only a single convex polyhedron this is not
* necessary.)
*
* - A simplified perspective viewing transformation
* (which also precludes the need for the transformed z
* coordinates). In a nutshell, the perspective scale
* is as follows:
*
* p' = S x p
* per
*
* where:
* S = WindowDepth /
* per (WindowDepth + fCurrentZTranslation)
*
* (WindowDepth is the greater of the control's window
* height or window width.)
*
*
* FUNCTIONS: TransformVertices() - transforms vertices
* ComputeRotationTransformation() - computes xformation
* based on current x, y
* and z rotation angles
*
*
* Dan Knudson
* Microsoft Developer Support
* Copyright (c) 1992, 1993 Microsoft Corporation
*
****************************************************************************)
CONST
MAXVERTEX = 7; (* polyhedron vertices [0..7] *)
NUMFACETS = 6; (* number of polyhedron facets *)
TYPE
POINT3D = RECORD x, y, z : LONG END;
VERTICES = ARRAY [0 .. MAXVERTEX] OF POINT3D;
FACETS = ARRAY [0 .. 29] OF INTEGER;
CLRS = ARRAY [0 .. 5] OF LONG;
(*
* This particular set of vertices "gNormalizedVertices" and corresponding
* facets "gaiFacets" describe a normalized cube centered about the
* origin ([0,0,0] in 3-space). The gaiFacet array is made up of a series
* of indices into the array of vertices, each describing an individual
* facet (eg. a polygon), and are separated by -1. Note that the facets
* are described in COUNTERCLOCKWISE (relative to the viewer) order so we
* can consistently find the normal to any given facet. (The normal
* is used to determine facet visibilty.)
*)
CONST
gaiFacets = FACETS{ 3, 2, 1, 0, -1,
4, 5, 6, 7, -1,
0, 1, 5, 4, -1,
6, 2, 3, 7, -1,
7, 3, 0, 4, -1,
5, 1, 2, 6, -1 };
gNormalizedVertices = VERTICES{{ 1, 1, 1}, { 1,-1, 1},
{-1,-1, 1}, {-1, 1, 1},
{ 1, 1,-1}, { 1,-1,-1},
{-1,-1,-1}, {-1, 1,-1} };
acrColor = CLRS{CLR_BLUE, CLR_GREEN, CLR_RED, CLR_CYAN,
CLR_PINK, CLR_YELLOW};
VAR
gXformedVertices : VERTICES;
gM : ARRAY [0 .. 1],[0 .. 2] OF REAL;
(* the transformation matrix *)
PROCEDURE Paint(hwnd : HWND);
TYPE PAINT = RECORD
hps : HPS;
CASE : INTEGER OF
| 0 :
rc : RECTL;
| 1 :
rgn : ARRAY [0 .. 0] OF RECTL;
| 2 :
aptl : ARRAY [0 .. 2] OF POINTL;
END;
END;
VAR
pSCI : PSPINCUBEINFO;
l : LONG;
b : BOOL;
rect : RECTL;
paint : PAINT;
hrgn : HRGN;
numPoints : ULONG;
points : ARRAY [0 .. 3] OF POINTL;
i, iX, iY : INTEGER;
lScaleFactor : LONG;
facetIndex : INTEGER;
vector1, vector2, ptl : POINTL;
BEGIN
pSCI := CAST(PSPINCUBEINFO,WinQueryWindowULong(hwnd,QWL_USER));
paint.hps := WinBeginPaint(hwnd, NULLHANDLE, paint.rc);
IF NOT ((SPINCUBE_REPAINT_BKGND IN pSCI^.iOptions) OR
WinEqualRect(hab, paint.rc, pSCI^.rcCubeBoundary)) THEN
(*
* We're not here because it's time to animate (i.e. this paint isn't
* the result of a WM_TIMER), so just do the Blt & blow out of here...
*)
paint.aptl[2] := paint.aptl[0];
l := GpiBitBlt(paint.hps, pSCI^.hps, 3, paint.aptl, ROP_SRCCOPY, BBO_IGNORE);
b := WinEndPaint(paint.hps);
RETURN;
END;
(*
* Determine a "best fit" scale factor for our polyhedron
*)
b := WinQueryWindowRect(hwnd, rect);
IF rect.xRight > rect.yTop THEN lScaleFactor := rect.yTop / 12;
ELSE lScaleFactor := rect.xRight / 12;
END;
IF lScaleFactor = 0 THEN lScaleFactor := 1 END;
TransformVertices(hwnd, rect, pSCI, lScaleFactor);
(*
* Draw the window frame & background
*
* Note: The chances are that we are coming through here because we
* got a WM_TIMER message & it's time to redraw the cube to simulate
* animation. In that case all we want to erase/redraw is that small
* rectangle which bounded the polyhedron the last time. The less
* drawing that actually gets done the better, since we want to
* minimize the flicker on the screen.
*)
IF (SS_ERASE <= CAST(BITSET,WinQueryWindowULong(hwnd,QWL_STYLE))) OR
(SPINCUBE_REPAINT_BKGND IN pSCI^.iOptions) THEN
b := WinFillRect(pSCI^.hps, paint.rc, CLR_PALEGRAY);
l := GpiSetClipRegion(pSCI^.hps,
GpiCreateRegion(pSCI^.hps, 1, paint.rgn), hrgn);
iX := rect.xRight / 4;
iY := rect.yTop / 4;
ptl := POINTL{0, 0};
b := GpiMove(pSCI^.hps, ptl);
b := GpiSetColor(pSCI^.hps, CLR_BLACK);
ptl.x := rect.xRight - 1;
ptl.y := rect.yTop - 1;
l := GpiBox(pSCI^.hps, DRO_OUTLINE, ptl, 0, 0);
ptl.x := 0;
b := GpiMove(pSCI^.hps, ptl);
ptl.x := iX;
ptl.y := rect.yTop - iY;
l := GpiLine(pSCI^.hps, ptl);
ptl.y := iY;
l := GpiLine(pSCI^.hps, ptl);
ptl := POINTL{0, 0};
l := GpiLine(pSCI^.hps, ptl);
ptl.x := rect.xRight;
ptl.y := rect.yTop;
b := GpiMove(pSCI^.hps, ptl);
ptl.x := rect.xRight - iX;
ptl.y := rect.yTop - iY;
l := GpiLine(pSCI^.hps, ptl);
ptl.y := iY;
l := GpiLine(pSCI^.hps, ptl);
ptl.x := rect.xRight;
ptl.y := 0;
l := GpiLine(pSCI^.hps, ptl);
ptl.x := iX;
ptl.y := rect.yTop - iY;
b := GpiMove(pSCI^.hps, ptl);
ptl.x := rect.xRight - iX;
l := GpiLine(pSCI^.hps, ptl);
ptl.x := iX;
ptl.y := iY;
b := GpiMove(pSCI^.hps, ptl);
ptl.x := rect.xRight - iX;
l := GpiLine(pSCI^.hps, ptl);
l := GpiSetClipRegion(pSCI^.hps, NULLHANDLE, hrgn);
b := GpiDestroyRegion(pSCI^.hps, hrgn);
EXCL(pSCI^.iOptions, SPINCUBE_REPAINT_BKGND);
END;
(*
* Draw the polyhedron. We'll walk through the facets list and compute
* the normal for each facet- if the normal has z > 0, then the facet
* faces us and we'll draw it. Note that this algorithim is ONLY valid
* for scenes with a single, convex polyhedron.
*
* Note: Use WinGetPS here because the above call to BeginPaint will
* probably not give us a PS with access to as much real estate as
* we'd like (we wouldn't be able to draw outside of the invalid
* region). We can party on the entire control window with the PS
* returned by WinGetPS.
*)
facetIndex := 0;
FOR i := 0 TO NUMFACETS - 1 DO
vector1.x := gXformedVertices[gaiFacets[facetIndex + 1]].x -
gXformedVertices[gaiFacets[facetIndex]].x;
vector1.y := gXformedVertices[gaiFacets[facetIndex + 1]].y -
gXformedVertices[gaiFacets[facetIndex]].y;
vector2.x := gXformedVertices[gaiFacets[facetIndex + 2]].x -
gXformedVertices[gaiFacets[facetIndex + 1]].x;
vector2.y := gXformedVertices[gaiFacets[facetIndex + 2]].y -
gXformedVertices[gaiFacets[facetIndex + 1]].y;
ptl.x := gXformedVertices[gaiFacets[facetIndex]].x;
ptl.y := gXformedVertices[gaiFacets[facetIndex]].y;
INC(facetIndex);
numPoints := 0;
WHILE gaiFacets[facetIndex] <> -1 DO
points[numPoints].x := gXformedVertices[gaiFacets[facetIndex]].x;
points[numPoints].y := gXformedVertices[gaiFacets[facetIndex]].y;
INC(facetIndex);
INC(numPoints);
END;
INC(facetIndex); (* skip over the -1's in the facets list *)
IF (vector1.x * vector2.y - vector1.y * vector2.x) > 0 THEN
b := GpiSetColor(pSCI^.hps, acrColor[i]);
b := GpiBeginArea(pSCI^.hps, BA_BOUNDARY);
b := GpiMove(pSCI^.hps, ptl);
l := GpiPolyLine(pSCI^.hps, numPoints, points);
l := GpiEndArea(pSCI^.hps);
END;
END;
IF pSCI^.rcCubeBoundary.xLeft < paint.rc.xLeft THEN
paint.rc.xLeft := pSCI^.rcCubeBoundary.xLeft;
END;
IF pSCI^.rcCubeBoundary.yTop > paint.rc.yTop THEN
paint.rc.yTop := pSCI^.rcCubeBoundary.yTop;
END;
IF pSCI^.rcCubeBoundary.xRight > paint.rc.xRight THEN
paint.rc.xRight := pSCI^.rcCubeBoundary.xRight;
END;
IF pSCI^.rcCubeBoundary.yBottom < paint.rc.yBottom THEN
paint.rc.yBottom := pSCI^.rcCubeBoundary.yBottom;
END;
b := WinEndPaint(paint.hps);
paint.hps := WinGetPS(hwnd);
paint.aptl[2] := paint.aptl[0];
l := GpiBitBlt(paint.hps, pSCI^.hps, 3, paint.aptl, ROP_SRCCOPY, BBO_IGNORE);
b := WinReleasePS(paint.hps);
END Paint;
(******************************************************************************\
*
* FUNCTION: TransformVertices
*
* INPUTS: hwnd - control window handle
* ctrlRect - pointer to RECT describing control's dimensions
* pSCI - pointer to control's SPINCUBEINFO structure
* fScaleFactor - scale factor for use in this window
*
******************************************************************************)
PROCEDURE TransformVertices(hwnd : HWND; VAR ctrlRect : RECTL;
pSCI : PSPINCUBEINFO; lScaleFactor : LONG);
VAR
i, iWindowDepth : INTEGER;
WindowRect : RECTL;
fDepthScale : REAL;
fNewRotationInc : REAL;
iNewTranslationInc : INTEGER;
tempX : LONG;
BEGIN
iNewTranslationInc := INT(Random() * 10.0) + 2;
fNewRotationInc := Random() * 0.3 + 0.02;
IF ctrlRect.xRight > ctrlRect.yTop THEN
iWindowDepth := ctrlRect.xRight;
ELSE
iWindowDepth := ctrlRect.yTop;
END;
WindowRect.xRight := ctrlRect.xRight / 2;
WindowRect.xLeft := - WindowRect.xRight;
WindowRect.yTop := ctrlRect.yTop / 2;
WindowRect.yBottom := - WindowRect.yTop;
(*
* Initialize the bounding rectangle with max/min vals
*)
pSCI^.rcCubeBoundary := RECTL{ 100000, 100000,-100000,-100000 };
(*
* Copy the static vertices into a temp array
*)
gXformedVertices := gNormalizedVertices;
(*
* First scale, then rotate, then translate each vertex.
* Keep track of the maximum & minimum values bounding the
* vertices in the x,y plane for use later in bounds checking.
*
* Note: we don't bother computing z values after the scale,
* as they are only really necessary for the rotation. If we
* were doing real bounds checking we'd need it, but this code
* simply uses the pSCI^.iCurrentZTranslation to determine
* the z-boundaries.
*)
FOR i := 0 TO MAXVERTEX DO
(*
* The scale...
*)
gXformedVertices[i].x := gXformedVertices[i].x * lScaleFactor;
gXformedVertices[i].y := gXformedVertices[i].y * lScaleFactor;
gXformedVertices[i].z := gXformedVertices[i].z * lScaleFactor;
(*
* The rotation...
*)
ComputeRotationTransformation(pSCI^.fCurrentXRotation,
pSCI^.fCurrentYRotation,
pSCI^.fCurrentZRotation);
tempX := VAL(LONG,gM[0][0] * FLOAT(gXformedVertices[i].x) +
gM[0][1] * FLOAT(gXformedVertices[i].y) +
gM[0][2] * FLOAT(gXformedVertices[i].z));
gXformedVertices[i].y := VAL(LONG,gM[1][0] * FLOAT(gXformedVertices[i].x) +
gM[1][1] * FLOAT(gXformedVertices[i].y) +
gM[1][2] * FLOAT(gXformedVertices[i].z));
gXformedVertices[i].x := tempX;
(*
* The translation...
*)
INC(gXformedVertices[i].x, pSCI^.iCurrentXTranslation);
INC(gXformedVertices[i].y, pSCI^.iCurrentYTranslation);
(*
* Check if we have new max or min vals
*)
IF pSCI^.rcCubeBoundary.xLeft > gXformedVertices[i].x THEN
pSCI^.rcCubeBoundary.xLeft := gXformedVertices[i].x;
END;
IF pSCI^.rcCubeBoundary.xRight < gXformedVertices[i].x THEN
pSCI^.rcCubeBoundary.xRight := gXformedVertices[i].x;
END;
IF pSCI^.rcCubeBoundary.yTop < gXformedVertices[i].y THEN
pSCI^.rcCubeBoundary.yTop := gXformedVertices[i].y;
END;
IF pSCI^.rcCubeBoundary.yBottom > gXformedVertices[i].y THEN
pSCI^.rcCubeBoundary.yBottom := gXformedVertices[i].y;
END;
END;
(*
* Now for some bounds checking,
* change translation & rotation increments if we hit a "wall".
*)
IF pSCI^.rcCubeBoundary.xLeft < WindowRect.xLeft THEN
pSCI^.iCurrentXTranslationInc := iNewTranslationInc;
pSCI^.fCurrentZRotationInc := fNewRotationInc;
ELSIF pSCI^.rcCubeBoundary.xRight > WindowRect.xRight THEN
pSCI^.iCurrentXTranslationInc := -iNewTranslationInc;
pSCI^.fCurrentZRotationInc := -fNewRotationInc;
END;
IF pSCI^.rcCubeBoundary.yTop > WindowRect.yTop THEN
pSCI^.iCurrentYTranslationInc := -iNewTranslationInc;
pSCI^.fCurrentXRotationInc := -fNewRotationInc;
ELSIF pSCI^.rcCubeBoundary.yBottom < WindowRect.yBottom THEN
pSCI^.iCurrentYTranslationInc := iNewTranslationInc;
pSCI^.fCurrentXRotationInc := fNewRotationInc;
END;
IF pSCI^.iCurrentZTranslation < (lScaleFactor * 2) THEN
pSCI^.iCurrentZTranslationInc := iNewTranslationInc;
pSCI^.fCurrentYRotationInc := fNewRotationInc;
ELSIF pSCI^.iCurrentZTranslation > (iWindowDepth - lScaleFactor) THEN
pSCI^.iCurrentZTranslationInc := -iNewTranslationInc;
pSCI^.fCurrentYRotationInc := -fNewRotationInc;
END;
(*
* Now a kludgy scale based on depth (iCurrentZTranslation) of the center
* point of the polyhedron
*)
fDepthScale := FLOAT(iWindowDepth) /
FLOAT(iWindowDepth + pSCI^.iCurrentZTranslation);
pSCI^.rcCubeBoundary.xLeft := VAL(LONG,fDepthScale *
FLOAT(pSCI^.rcCubeBoundary.xLeft));
pSCI^.rcCubeBoundary.xRight := VAL(LONG,fDepthScale *
FLOAT(pSCI^.rcCubeBoundary.xRight));
pSCI^.rcCubeBoundary.yTop := VAL(LONG,fDepthScale *
FLOAT(pSCI^.rcCubeBoundary.yTop));
pSCI^.rcCubeBoundary.yBottom := VAL(LONG,fDepthScale *
FLOAT(pSCI^.rcCubeBoundary.yBottom));
FOR i := 0 TO MAXVERTEX DO
gXformedVertices[i].x := VAL(LONG,fDepthScale *
FLOAT(gXformedVertices[i].x));
gXformedVertices[i].y := VAL(LONG,fDepthScale *
FLOAT(gXformedVertices[i].y));
END;
(*
* If currently in motion then increment the current rotation & translation
*)
IF SS_INMOTION <= CAST(BITSET,WinQueryWindowULong(hwnd,QWL_STYLE)) THEN
pSCI^.fCurrentXRotation := pSCI^.fCurrentXRotation + pSCI^.fCurrentXRotationInc;
pSCI^.fCurrentYRotation := pSCI^.fCurrentYRotation + pSCI^.fCurrentYRotationInc;
pSCI^.fCurrentZRotation := pSCI^.fCurrentZRotation + pSCI^.fCurrentZRotationInc;
INC(pSCI^.iCurrentXTranslation, pSCI^.iCurrentXTranslationInc);
INC(pSCI^.iCurrentYTranslation, pSCI^.iCurrentYTranslationInc);
INC(pSCI^.iCurrentZTranslation, pSCI^.iCurrentZTranslationInc);
END;
(*
* Up to this point all coordinates are relative to a window whose
* center is at (0,0). Now we'll translate appropriately...
*)
INC(pSCI^.rcCubeBoundary.xLeft, ctrlRect.xRight / 2);
INC(pSCI^.rcCubeBoundary.xRight, ctrlRect.xRight / 2);
INC(pSCI^.rcCubeBoundary.yTop, ctrlRect.yTop / 2);
INC(pSCI^.rcCubeBoundary.yBottom, ctrlRect.yTop / 2);
FOR i := 0 TO MAXVERTEX DO
INC(gXformedVertices[i].x, ctrlRect.xRight / 2);
INC(gXformedVertices[i].y, ctrlRect.yTop / 2);
END;
(*
* Since FillRect's are inclusive-exclusive (there'll be leftovers
* from the last cube we drew otherwise)...
*)
INC(pSCI^.rcCubeBoundary.xRight);
INC(pSCI^.rcCubeBoundary.yTop);
(*
* Finally, adjust the rcCubeBoundary such that it fits entirely within
* the actual control window. The reason for this is that when calling
* InvalidateRect from SpincubeWndProc\case_WM_TIMER we may get
* a different paint.rc (since InvalidateRect clips the passed
* in rect to the window bounds)
*)
IF pSCI^.rcCubeBoundary.xLeft < 0 THEN
pSCI^.rcCubeBoundary.xLeft := 0
END;
IF pSCI^.rcCubeBoundary.yBottom < 0 THEN
pSCI^.rcCubeBoundary.yBottom := 0
END;
IF pSCI^.rcCubeBoundary.xRight > ctrlRect.xRight THEN
pSCI^.rcCubeBoundary.xRight := ctrlRect.xRight
END;
IF pSCI^.rcCubeBoundary.yTop > ctrlRect.yTop THEN
pSCI^.rcCubeBoundary.yTop := ctrlRect.yTop
END;
END TransformVertices;
(******************************************************************************\
*
* FUNCTION: ComputeRotationTransformation
*
* INPUTS: fRotationX - Angle to rotate about X axis.
* fRotationY - Angle to rotate about Y axis.
* fRotationZ - Angle to rotate about Z axis.
*
* COMMENTS: Computes a 3x2 tranformation matrix which rotates about
* the Z axis, the Y axis, and the X axis, respectively.
*
******************************************************************************)
PROCEDURE ComputeRotationTransformation(fRotationX : REAL;
fRotationY : REAL;
fRotationZ : REAL);
VAR sinX, cosX, sinY, cosY, sinZ, cosZ : REAL;
BEGIN
sinX := sin(fRotationX);
cosX := cos(fRotationX);
sinY := sin(fRotationY);
cosY := cos(fRotationY);
sinZ := sin(fRotationZ);
cosZ := cos(fRotationZ);
gM[0][0] := cosY * cosZ;
gM[0][1] := -cosY * sinZ;
gM[0][2] := sinY;
gM[1][0] := sinX * sinY * cosZ + cosX * sinZ;
gM[1][1] := -sinX * sinY * sinZ + cosX * cosZ;
gM[1][2] := -sinX * cosY;
END ComputeRotationTransformation;
END SpinCube.