2010-07-16 20:48

/*
GUIBEGIN
WINDOW , 33, 94, 475, 93, POPUP|CAPTION|SYSMENU|MINBOX|MAXBOX|THICK, , Cards32.dll demo
	FONT 8, 400, MS Shell Dlg
	MENU
	TEXT 6, 81, 44, 8, GROUP, , ClickToDeal, , Click to deal
DEND

MENU
	HEADING &Card Back
		ITEM CrossHatch
		ITEM Weave 1
		ITEM Weave 2
		ITEM Robot
		ITEM Flowers
		ITEM Vine 1
		ITEM Vine 2
		ITEM Fish 1
		ITEM Fish 2
		ITEM Shells
		ITEM Castle
		ITEM Island
		ITEM Hand
		ITEM
		ITEM E&xit
	<
DEND
GUIEND
*/

/* An example of FUNCDEF'ing various Windows OS functions,
 * and also register the functions in Cards32.DLL, a DLL
 * to draw playing cards.
 *
 * This script is a demo for the various Card32 DLL functions.
 */

LIBRARY rexxgui
DO
	/* Register GetDC and ReleaseDC */
	FUNCDEF("GetDC", "void, void", "user32")
	FUNCDEF("ReleaseDC", ", void, void", "user32")

	/* Register the Windows OS functions BeginPaint() and EndPaint() */
	paintstruct = "32u, 32, 32u, 32u, 32u, 32u, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32"
	FUNCDEF("BeginPaint", "32u, void, struct PAINTSTRUCT stor", "user32")
	FUNCDEF("EndPaint", "32, void, struct PAINTSTRUCT", "user32")
	rect = "32u,32u,32u,32u"
	FUNCDEF("InvalidateRect", "32, void, struct RECT, 32u", "user32")

	/* Register the Cards32 DLL functions we intend to call. */
	FUNCDEF("cdtInit", "32, 32 * stor, 32 * stor", "cards32")
	FUNCDEF("cdtDrawExt", "32, void, 32, 32, 32, 32, 32, 32, 32", "cards32")
	FUNCDEF("cdtDraw", "32, void, 32, 32, 32, 32, 32", "cards32")
	FUNCDEF("cdtTerm", "32,", "cards32")
	
	CATCH FAILURE
		CONDITION("M")
		RETURN
END

DO
	/* Create the window and initialize CARDS32.DLL. NOTE: Reginald
	 * calls our CREATE event handler in this call to GuiCreateWindow().
	 */
	guierr = "SYNTAX"
	guiheading = 1
	guicreatewindow('NORMAL')

	/* Reposition the "Click to Deal" text below the deck of cards. */
	guisetctlplacement('ClickToDeal', cardwidth + 5 + 5 + 4, windowheight - (54 + (cardheight % 2)))

	/* We trap SYNTAX because we have a CREATE event handler
	 * that allocates something -- ie, it opens cards32.dll.
	 * Just in case GuiCreateWindow fails, we want to close
	 * down cards32.dll.
	 */
	CATCH SYNTAX
		CONDITION('M')
	
		/* Unload Cards32.DLL if we loaded it */
		IF EXISTS(cardwidth) THEN cdtterm()

		/* End the script. */
		RETURN
END

/* Message loop. */
again:
DO FOREVER

	guigetmsg()

	CATCH SYNTAX
		CONDITION('M')
		SIGNAL again

	FINALLY
		/* Unload Cards32.DLL if we loaded it */
		IF EXISTS(cardwidth) THEN cdtterm()

		guidestroywindow()	
END

/* ======================= CreateDrawPile() =====================
 * Creates our pile of cards from which we deal cards.
 *
 * CreateDrawPile(pile., numDecks)
 *
 * pile. = The name of the stem variable where the pile is created.
 *         The name must end with a dot. Do not quote.
 * numDecks = The number of decks (of cards) in the pile. ie, A 1
 *         means 1 deck of (52) cards is in the pile.
 */

createdrawpile: PROCEDURE; USE ARG pile., numdecks
	/* Figure out how many total cards in the pile. There will be 52 per deck */
	pile.total = numdecks * 52

	/* Create a pile of how ever many decks desired, with cards numbered 0 to 51 for each deck */
	cardnum = 0
	DO numdecks
		DO j = 1 TO 52
			cardnum = cardnum + 1
			pile.cardnum = j - 1
		END
	END
 
	/* Shuffle those cards */
	DO i = 1 FOR cardnum - 1
		j = RANDOM(i, cardnum)
		IF j > i THEN PARSE VALUE pile.i pile.j WITH pile.j pile.i
	END

	/* Reset to the top of the pile */
	pile.0 = 1

	RETURN

/* ======================= NextCardFromPile() =====================
 * Deals the top card from our pile of cards (ie, returns its value).
 *
 * cardNum = NextCardFromPile(pile.)
 *
 * pile. = The name of the stem variable where the pile was created.
 *         The name must end with a dot. Do not quote.
 *
 * RETURNS: The card's value, which is a number (0 to 51) where:
 *
 * 0 = Ace of Clubs
 * 1 = Ace of Diamonds
 * 2 = Ace of Hearts
 * 3 = Ace of Spades
 * 4 = Two of Clubs
 * 5 = Two of Diamonds
 * 6 = Two of Hearts
 * 7 = Two of Spades
 * 8 = Three of Clubs
 * 9 = Three of Diamonds
 * 10 = Three of Hearts
 * 11 = Three of Spades
 * etc.
 *
 * If there are no more cards in the pile, returns an empty string.
 */

nextcardfrompile: PROCEDURE; USE ARG pile.
	/* See if there are any more cards left in the Deck */
	IF pile.0 > pile.total THEN RETURN ""

	/* Get the next card */
	card = pile.[pile.0]

	/* Move down the deck 1 */
	pile.0 = pile.0 + 1

	/* Return the card number (0 to 51) */
	RETURN card

/* ======================= IsAnotherInPile() =====================
 * Checks if there is another card in our draw pile, and if so,
 * returns the value of the top card.
 *
 * cardNum = IsAnotherInPile(pile.)
 *
 * pile. = The name of the stem variable where the pile was created.
 *         The name must end with a dot. Do not quote.
 *
 * RETURNS: See NextCardFromPile().
 */

isanotherinpile: PROCEDURE; USE ARG pile.
	/* See if there are any more cards left in the Deck */
	IF pile.0 > pile.total THEN RETURN ""

	/* Return the next card number (0 to 51), but don't advance the pointer */
	card = pile.[pile.0]
	RETURN card

/* ========================= DealCard() ========================
 * Deals the next card from the Draw pile to the table.
 *
 * DealCard()
 *
 * "Pile." must be a stem variable where the Draw pile was created,
 * "CardNum" must be the number of cards dealt to the table,
 * CardRow. must be a stem variable containing those dealt cards,
 * and "PileBack" is set to which card back to use for the Draw pile.
 */

dealcard:
	/* If no more cards, do nothing */
	IF isanotherinpile(pile.) == "" THEN RETURN

	/* Another card is being dealt to the table */
	cardnum = cardnum + 1

	/* Get the next card, and put it into our row of cards (ie, deal it to the table) */
	cardrow.cardnum = nextcardfrompile(pile.)

	/* If this is the last card from the pile, set our draw pile to an X */
	IF isanotherinpile(pile.) == "" THEN pileback = 67

	/* Redraw the window (ie, force a PAINT event) */
	SIGNAL forcerepaint








/* ================= Card Back menu items =================== */
cardbackcrosshatch:
	/* Tell our PAINT event handler to use the CrossHatch card back. */
	cardback = 53
	SIGNAL newcardback

cardbackweave1:
	/* ...use the WEAVE 1 card back. */
	cardback = 54
	SIGNAL newcardback

cardbackweave2:
	/* ...use the WEAVE 2 card back. */
	cardback = 55
	SIGNAL newcardback

cardbackrobot:
	/* ...use the Robot card back. */
	cardback = 56
	SIGNAL newcardback

cardbackflowers:
	/* ...use the Flowers card back. */
	cardback = 57
	SIGNAL newcardback

cardbackvine1:
	/* ...use the Vine 1 card back. */
	cardback = 58
	SIGNAL newcardback

cardbackvine2:
	/* ...use the Vine 2 card back. */
	cardback = 59
	SIGNAL newcardback

cardbackfish1:
	/* ...use the Fish 1 card back. */
	cardback = 60
	SIGNAL newcardback

cardbackfish2:
	/* ...use the Fish2 card back. */
	cardback = 61
	SIGNAL newcardback

cardbackshells:
	/* ...use the Shells card back. */
	cardback = 62
	SIGNAL newcardback

cardbackcastle:
	/* ...use the Castle card back. */
	cardback = 63
	SIGNAL newcardback

cardbackisland:
	/* ...use the Island card back. */
	cardback = 64
	SIGNAL newcardback

cardbackcardhand:
	/* ...use the Card Hand card back. */
	cardback = 65
	SIGNAL newcardback

newcardback:
	/* If there is another card in our draw pile, then set its back too. */
	IF isanotherinpile(pile.) \== "" THEN pileback = cardback

forcerepaint:
	/* Force a PAINT event in our window. */
	invalidaterect(guiwindow)
	RETURN

/* ================== "Exit" menu item ====================== */
cardbackexit:
	/* Post a WM_CLOSE message to our main window. */
	guisendmsg(, 'POST CLOSE')
	RETURN

/* ================== WM_PAINT ======================
 * Handles the PAINT event for our window. Reginald
 * calls this when the window itself (ie, not any
 * controls inside it) need to be drawn.
 */

wm_paint:
	/* Get the handle to the Device Context (DC) which we need to pass to Cards32. */
	hdc = beginpaint(guiwindow, paintstruct)

	/* Draw the cards in their current dealt state/positions. */
	paint(hdc)

	/* Done with the DC. */
	endpaint(guiwindow, paintstruct)

	/* If we do our own painting, then don't let REXX GUI handle it. */
	RETURN ""

/* ================== Paint ======================
 * Called by our PAINT event handler to do the real
 * work of drawing our window, putting cards where
 * they are supposed to go.
 *
 * This is passed the Device Context which we need
 * to pass to the Cards32 DLL functions.
 */
paint:
	/* Where to start drawing the cards on the table. We
	 * Start at an X/Y position of 5, 5, and will draw
	 * cards from left to right, which cards overlapping.
	 */
	x = 5

	/* Draw the cards dealt to the table */
	DO i = 1 TO cardnum

		/* Draw the next card on the table */
		cdtdraw(ARG(1), x, 5, cardrow.i)

		/* Next position on the table is over 14 pixels. This
		 * will cause the cards to overlap, since the width of
		 * a card is > 14. If you didn't want the cards to
		 * overlap, you could increment x by CardWidth plus some
		 * space between the cards, such as:
		 *
		 * x = x + CardWidth + 5
		 */
		x = x + 14
	END

	/* Draw the pile (from where cards are dealt) */
	cdtdraw(ARG(1), 5, cardheight + 10, pileback, 1)

	/* Draw the discard pile */
	IF discardedcard == "" THEN cdtdraw(ARG(1), windowwidth - (cardwidth + 14), cardheight + 10, 68, 1)
	ELSE cdtdraw(ARG(1), windowwidth - (cardwidth + 14), cardheight + 10, discardedcard)

	RETURN

/* ================ WM_LBUTTONDBLCLK ================
 * This handles the LBUTTONDBLCLK event for my window.
 *
 * Reginald calls this when the user double-clicks
 * the mouse in the inner part of the window itself (ie,
 * not on the title bar, borders, scroll bar, menu, nor
 * upon any control inside the window).
 *
 * ARG(1) is a value that tells what keys (on the keyboard)
 * were held down while the mouse was moved.
 * ARG(2) is the X position of the mouse.
 * ARG(3) is the Y position of the mouse.
 */

wm_lbuttondblclk:

/* ================== WM_LBUTTONDOWN ==================
 * This handles the LBUTTONDOWN event for my window.
 *
 * Reginald calls this when the user clicks the mouse in
 * the inner part of the window itself (ie, not on the
 * title bar, borders, scroll bar, menu, nor upon any
 * control inside the window).
 *
 * ARG(1) is a value that tells what keys (on the keyboard)
 * were held down while the mouse was moved.
 * ARG(2) is the X position of the mouse.
 * ARG(3) is the Y position of the mouse.
 */

wm_lbuttondown:
	mousedown(hdc, ARG(2), ARG(3))
	RETURN ""

/* ================== MouseDown ======================
 * When our window procedure receives a WM_LBUTTONDOWN
 * message, then we must begin a card dragging operation
 * if he clicked upon some card on the table, or deal
 * another card from the pile if he clicked on the pile
 */

mousedown: USE ARG hdc, x, y

	/* Did he click upon a card on the table? */
	IF y < cardheight + 5 THEN DO

		/* Remove the rightmost card to the Discard pile. */
		IF cardnum > 0 THEN DO
		
			/* Set the card onto the top of the Discard pile. */
			discardedcard = cardrow.cardnum

			/* Remove the card from the table. */
			cardnum = cardnum - 1

			/* Invalidate that part of the window where the Discard pile is, but don't force PAINT event. */
			rect.1 = windowwidth - (cardwidth + 14)
			rect.2 = cardheight + 10
			rect.3 = rect.1 + cardwidth
			rect.4 = rect.2 + cardheight
			invalidaterect(guiwindow, rect)

			/* Get the position where the card was displayed. */
			rect.1 = 5 + 14 * cardnum 
			rect.2 = 5
			rect.3 = rect.1 + cardwidth
			rect.4 = rect.2 + cardheight

			/* Redraw only that part of the window where the card was, and force PAINT event. */
			invalidaterect(guiwindow, rect, 1)
			
		END
		
	END

	/* Did he click upon the Draw pile? */
	ELSE IF y > cardheight + 10 & y < (cardheight * 2) + 10 THEN DO
		IF x > 5 & x < cardwidth + 5 THEN dealcard()
	END

	RETURN

/* ===================== WM_CREATE ========================
 * This handles the CREATE event for our window. Reginald
 * calls this immediately after the window is created, but
 * before any of the controls inside it are created. Here
 * we can do further initialization such as setting the
 * values of the REXX variables associated with the controls.
 *
 * If we return nothing, then our window is destroyed and our
 * GuiGetMsg() will raise SYNTAX (and our program will
 * end). So that's what we do if we have an initialization
 * error. Otherwise, if we return 0, then things continue on.
 */

wm_create:
	/* =================== Initialize Cards32 DLL ================= */

	/* cdtInit must be called once (and only once). It initializes Cards32.DLL.
	 * A 0 return value indicates problems. Also cdtInit returns a card's
	 * width/height to us.
	 */
	i = cdtinit(cardwidth, cardheight)
	IF i == 0 THEN DO
		guisay("Problem initializing Cards32.DLL")
		RETURN
	END

	/* Initial card back = "Weave 1", and no discard pile yet. */
	cardback = 54
	pileback = 54
	discardedcard = ""

	/* No cards dealt to the table yet. */
	cardnum = 0

	/* Create and shuffle 1 deck of cards into our draw pile. */
	createdrawpile(pile., 1)

	/* Let Rexx Gui continue. */
	RETURN 0


/* ==================== WM_INITDIALOG ======================
 * This handles the INITDIALOG event for our window. Reginald
 * calls this immediately after the window and all its controls
 * are created, but before the window is shown. Here we can do
 * further initialization such as sizing the window/controls.
 *
 * If we return nothing, then our the focus is set to the
 * first control in the window.
 */

wm_initdialog:

	/* Now that cdtInit has told us how wide and high a card is, we
	 * need to make sure our window is big enough to display all the
	 * cards in our desired layout. We are going to have 52 cards (at
	 * most) lined in a row. Each overlapped card will be 14 pixels
	 * wide. The last card will be the full width of a card. Plus we
	 * need a little space at the left and right edge of our window,
	 * 5 pixels on each edge.
	 *
	 * For the height, we need two cards worth. Plus we need a little
	 * space at the top and bottom edge of our window, 5 pixels on each edge.
	 * And we need some space between the draw/discard piles and the dealt
	 * cards; 15 pixels. NOTE: We're setting the size of the inner area of
	 * the window.
	 */
	windowwidth = (14 * 51) + cardwidth + 5 + 5
	windowheight = (2 * cardheight) + 5 + 5 + 15
	guisetctlplacement(,,, windowwidth, windowheight, 'INNER')

	RETURN

2010-07-16 20:48