Playing Card Object

User contributed sources that have become inactive, deprecated, or generally unusable. But ... we don't really want to throw them away either.
bcohio2001
Posts: 556
Joined: Mar 10, 2007 15:44
Location: Ohio, USA
Contact:

Re: Playing Card Object

Post by bcohio2001 »

datwill310 wrote:This is great! Thanks a lot!
Welcome! Positive and negative feedback is always great!

Minor/Major error in code just found.
In AllGroups.bas, line 117.
Should be:

Code: Select all

If T > Groups(L)->AddY * Groups(L)->Count Then
And NOT:

Code: Select all

If T > Groups(L)->AddX * Groups(L)->Count Then
This section deals with arranging a card in a top down group.

I plan on rewriting the arranging code for Version 0.6 anyway so not going to upload this change.
bcohio2001
Posts: 556
Joined: Mar 10, 2007 15:44
Location: Ohio, USA
Contact:

Re: Playing Card Object

Post by bcohio2001 »

Version 0.6.0 April 16, 2016

Added:
-- Drag and drop into/onto groups.
---- Initial location of card(s) being 'dragged' could be better.
-- Global settings for CardGroups.
-- Implimented CardGroup.SetDDrop() sub.
-- Function CardGroup.CanTake()
---- Using the enum DropRestrict.
---- Not all situations are handled.
-- Sub CardGroup.ToggleEnable()
-- Function CardGroup.IsRoom
-- User variable declared in CardGroup.bi, "Dim As CardGroup Ptr GroupActivated".
---- For calls to Scan(ByRef Gr As CardGroup Ptr, ByRef Inx As Integer, ByRef UserMouseX As Integer, ByRef UserMouseY As Integer)

Changes:
-- CardGroup.SetAll()
---- Only the "required" settings are used. Eliminated the optional settings.
-- CardGroup.SetSize(NewSize As Integer)
---- Changed to a function.
---- Accepts a negative parameter to make it dynamic, on first call.
---- Accept a zero to reset back to starting size if dynamic.
-- CardGroup.MoveSelCards()
---- Second parameter removed.
---- Changed to a function.

Reworked:
-- Arrangement of cards in group using drag and drop.
-- CardGroup.UpdateScr()
---- Instead of clearing old data on screen, saving and redrawing what was on screen.

Distribution of files:
-- Cards_x_xx_xx.zip
---- Source code and documentation for library.
-- CD1Jpg.zip
---- "card-deck-01.jpg", "CD1Jpg.ini" and "Test_Cards_2.bas"
---- This is optional download. More of a 'proof of concept'.
-- FBImage.zip
---- D.J. Peter's 'FBImage' library, without the test programs and images.
---- Only required if inital download of library as a whole, already included in versions 0.5.0 and 0.5.1

Future plans:
-- Clean up 'ugly' 64 bit hacks.
-- Find and impliment a "rotation" algorhythm.
---- Groups displayed in any direction.
-- Make into a library.
datwill310
Posts: 355
Joined: May 29, 2015 20:37

Re: Playing Card Object

Post by datwill310 »

Hi again!

I've got this error which I don't understand, in AllGroups.bas:

Code: Select all

'drag card from one group to another
Sub AllGroups.DragDrop(Grp As Integer, ByRef Mx As Integer, ByRef My As Integer)
	Dim As Integer CC, x
	Dim As Integer CardIndex(Groups(Grp)->NumSelected()-1)
	Dim As CardGroup DragThis
	'
	'if aborted, return DragThis back to Groups(Grp)
	'store indexes for possible return to group
	For x = 0 To Groups(Grp)->Count
		If Groups(Grp)->Group[x]->Selected Then 'this is the line
			CardIndex(CC) = x
			CC += 1
		EndIf
	Next
	'copy needed values, some are not needed or will be changed.
	DragThis.MaxCount = Groups(Grp)->NumSelected()
	DragThis.MyCardObj = Groups(Grp)->MyCardObj
	DragThis.Attr = Groups(Grp)->Attr
	'Location of lowest selected card? <- may 'jump'
	DragThis.StartScrX = Mx 'current location of mouse
	DragThis.StartScrY = My 'current location of mouse
	DragThis.Dragging = 1 'not used yet, but set anyway ....
	DragThis.MoveSelCards(*Groups(Grp))
	Groups(Grp)->UpdateScr()
	DragThis.UpdateScr()
End Sub
And here is what I get:

Code: Select all

error 28: Expected pointer, before '->' in 'If Groups(Grp)->Group[x]->Selected Then'
I am especially confused as Groups is used before like this (within and without that scope), and it compiles fine (up to that point).
Do you know what's happening?
sancho2
Posts: 547
Joined: May 17, 2015 6:41

Re: Playing Card Object

Post by sancho2 »

There is something wrong with the way you are accessing the member pointer Group.
Here is how it is defined in the class

Code: Select all

As CardGroupItem Ptr Group
So group is a pointer to the type/class CardGroupItem which is defined as three integers:

Code: Select all

Type CardGroupItem
	'a group may or may not all be showing
	As Integer Show 'Front or back
	As Integer Selected
	As Integer CardVal
End Type
In your code you are trying to access the Selected member variable, but using the square brackets offsets the pointer and screw everything.
You can only get to 'Selected' by

Code: Select all

Groups(grp)->Group->Selected
.
Here is how it is used in the code authors AllGroups.bas:

Code: Select all

If Groups(Grp)->Group[x].Selected
Using the dot operator and not the pointer '->'.
I don't really understand what is happing in this code, or even if/how his code could possibly work. But assuming it works, this is likely the change you need to make.
datwill310
Posts: 355
Joined: May 29, 2015 20:37

Re: Playing Card Object

Post by datwill310 »

sancho2 wrote:I don't really understand what is happing in this code, or even if/how his code code work. But assuming it works, this is likely the change you need to make.
Thanks. It was a file which came with this library and is part of it. Sorry for making that a bit ambiguous.
Maybe the developer should be aware of this ;D *wink**wink*!
sancho2
Posts: 547
Joined: May 17, 2015 6:41

Re: Playing Card Object

Post by sancho2 »

Yeah I have been looking at this and I think the author needs to look at this as well. Here is a stripped down version using his code and how to access 'Selected' member.

Code: Select all

Type CardGroupItem
	'a group may or may not all be showing
	As Integer Show 'Front or back
	As Integer Selected
	As Integer CardVal
End Type
Type CardGroup
	As CardGroupItem Ptr Group
End Type
Type AllGroups
	As CardGroup Ptr Groups(20)
End Type
'--------------------------------------
Dim As AllGroups testGroup
Dim As CardGroup cg
Dim As CardGroupItem cgi

cgi.show = 12
cgi.selected = 15
cgi.cardval = 20

cg.Group = @cgi
testGroup.Groups(1)= @cg

Print testGroup.Groups(1)->Group->Selected
Print testGroup.Groups(1)->Group[0].Selected
Sleep
Edit:
I added an offset method of getting to 'Selected' member.
Once you go past memory offset [0] the results are incorrect. So he is doing something that I don't understand.
I read the posts in this thread and I think he is still developing this. So this is probably already on his radar.
bcohio2001
Posts: 556
Joined: Mar 10, 2007 15:44
Location: Ohio, USA
Contact:

Re: Playing Card Object

Post by bcohio2001 »

Do you have V0.6.0?

Here is the correct sub from the zip file:

Code: Select all

'drag card(s) from one group to another or internally .....
'click and HOLD on previously selected card
Sub AllGroups.DragDrop(Grp As Integer)
	Dim As Integer CC, x 'general
	Dim As Integer Mx, My, Mc, oMx, oMy, oMc 'mouse
	Dim As Integer Over, Arr 'arranging
	Dim As Integer GrpRealCount 'original number of cards
	'
	GetMouse Mx, My,,Mc
	If Mc = 1 Then
		'do only once!
		If DragThis.CommonVar.CardObj = 0 Then DragThis.CommonVar = Groups(Grp)->CommonVar
		'store any drag/drop restrictions for this group and set to any card!
		Dim As DropRestrict Hold = Groups(Grp)->DDRestrict
		Groups(Grp)->DDRestrict = DropRestrict.AnyCard
		'NEED BETTER POSITIONING? But the "jump" would signify DD active????
		'chances of exactly clicking on (3,3) offset of card is small
		'TODO: CALC DragX and DragY
		'Dim As Integer DragX = -3
		'Dim As Integer DragY = -3
		'DragThis.SetAll(Mx + DragX, My + DragY, Groups(Grp)->NumSelected(), Groups(Grp)->Attr)
		DragThis.SetAll(Mx - 3, My - 3, Groups(Grp)->NumSelected(), Groups(Grp)->Attr)
		DragThis.Count = Groups(Grp)->NumSelected()
		'
		'might be arranging
		If Groups(Grp)->Movable > 0 And Groups(Grp)->NumSelected() = 1 Then
			Arr = Groups(Grp)->MouseInGroup()
		EndIf
		'if aborted or receiving group DD values reject, return DragThis back to Groups(Grp)
		'possible return to group, leave space for them
		For x = 0 To Groups(Grp)->Count - 1
			If Groups(Grp)->Group[x].Selected Then
				DragThis.Group[CC] = Groups(Grp)->Group[x]
				CC += 1
				Groups(Grp)->Group[x].CardVal = -1 'make it 'empty' for now
				Groups(Grp)->Group[x].Selected = 0
			Else
				GrpRealCount = x + 1 'index of "last" card to be shown
			EndIf
		Next
		'adjust the count
		Swap Groups(Grp)->Count, GrpRealCount
		Groups(Grp)->UpdateScr()
		'
		While (Mc And 1)
			DragThis.StartScrX = Mx - 3' + DragX
			DragThis.StartScrY = My - 3' + DragY
			DragThis.SetAddXY()
			If Arr Then
				Over = Groups(Grp)->MouseInGroup() 'only check original
				'if Over or Arr is last card, graphical glitch!
				If Over > 0 And Over <> Arr Then
					'move "empty" space
					If Over > Arr Then
						'swap (all cards are .Selected = 0)
						For x = Arr - 1 To Over - 2
							Swap Groups(Grp)->Group[x].Show, Groups(Grp)->Group[x + 1].Show
							'Swap Groups(Grp)->Group[x].Selected, Groups(Grp)->Group[x + 1].Selected
							Swap Groups(Grp)->Group[x].CardVal, Groups(Grp)->Group[x + 1].CardVal
						Next
					Else
						'swap
						For x = Arr - 1 To Over Step -1
							Swap Groups(Grp)->Group[x].Show, Groups(Grp)->Group[x - 1].Show
							'Swap Groups(Grp)->Group[x].Selected, Groups(Grp)->Group[x - 1].Selected
							Swap Groups(Grp)->Group[x].CardVal, Groups(Grp)->Group[x - 1].CardVal
						Next
					EndIf
					'adjust count?
					If Over = GrpRealCount Then
						Groups(Grp)->Count = GrpRealCount - 1 'placing at end
					Else
						Groups(Grp)->Count = GrpRealCount 'middle or first
					EndIf
					Arr = Over
				EndIf
			EndIf
			DDUpdateScr(0)
			'identify other affected groups
			AffCount = 0
			For x = 0 To TotGroups - 1
				If DragThis.OverlapRect(Groups(x)->NewRect) Then
					Affected(AffCount) = x
					AffCount += 1
				EndIf
			Next
			DDUpdateScr(1)
			'wait for mouse
			oMx = Mx
			oMy = My
			oMc = Mc
			Do
				GetMouse Mx, My,,Mc
				Sleep 10
			Loop While (oMx = Mx And oMy = My And oMc = Mc)
		Wend
		'
		If Groups(Grp)->CommonVar.DDropFlag > 1 Then
			'loop to find out where dropped
			CC = 0
			While CC < TotGroups
				If Groups(CC)->MouseInGroup() Then
					If CC = Grp Then
						'dropped on original group
						CC = TotGroups
					ElseIf Groups(CC)->CanTake(DragThis.Group[0].CardVal) > 0 And Groups(CC)->IsRoom(DragThis.Count) = 1 Then
						'move
						While DragThis.Count
							Groups(CC)->AddCard(DragThis.Group[0].CardVal, DragThis.Group[0].Show)
							x = DragThis.TakeCard(0)
						Wend
						Groups(CC)->SetAddXY()
						'DragThis.SetAddXY()
						'update
						DDUpdateScr(0)
					EndIf
					Exit While
				EndIf
				CC += 1
			Wend
		Else
			'arrange only allowed
			CC = TotGroups
		EndIf
		'
		Groups(Grp)->Count = GrpRealCount
		If CC = TotGroups Then
			'not dropped on group, rejected by another group or dropped back on original group
			CC = 0
			For x = 0 To Groups(Grp)->Count - 1
				If Groups(Grp)->Group[x].CardVal = -1 Then
					Groups(Grp)->Group[x] = DragThis.Group[CC]
					DragThis.Group[CC].CardVal = -1
					CC += 1
				EndIf
			Next
			DDUpdateScr(0)
		Else
			'Was moved, finalize
			For x = 0 To Groups(Grp)->Count - 1
				If Groups(Grp)->Group[x].CardVal = -1 Then CC = Groups(Grp)->TakeCard(x)
			Next
		EndIf
		Groups(Grp)->UpdateScr()
		Groups(Grp)->DDRestrict = Hold
		DragThis.Destroy()
	EndIf 'initial mouse click test
End Sub
sancho2
Posts: 547
Joined: May 17, 2015 6:41

Re: Playing Card Object

Post by sancho2 »

I have been looking at ver .6
I can't test that code because there is an error in test_allgroup_1.bas

Code: Select all

#Include "Allgroups.bi"
That file does not exist. And Allgroups.bas is not it either.

I don't understand how you can access a member of a udt by pointer using an offset as you do. And I don't see that the '[' is overloaded anywhere.
For example in this line:

Code: Select all

Groups(Grp)->Group[x].CardVal = -1 'make it 'empty' for now
What value for 'x' besides 0 would be valid?

If you correct the include I will run the code and try to understand whats happening.
bcohio2001
Posts: 556
Joined: Mar 10, 2007 15:44
Location: Ohio, USA
Contact:

Re: Playing Card Object

Post by bcohio2001 »

'test_allgroup_1.bas' is a remnant from v0.5 and should be deleted. Replaced with 'Solitare.bas'
When increasing to a new version, I normally just copy the old version and rename it to the new. Then replace the changed files.
This time changed the file name, and deleted my local copy.

Code: Select all

Type CardGroupItem
	'a group may or may not all be showing
	As Integer Show 'Front or back
	As Integer Selected
	As Integer CardVal
End Type

Type CardGroup
	.....
	Declare Function AddCard(CardVal As Integer, Show As Integer) As Integer
	.....
	As CardGroupItem Ptr Group
	.....
End Type

Type AllGroups
	......
	As CardGroup Ptr Groups(20)
	......
End Type
Then if you look at:

Code: Select all

Function CardGroup.AddCard(CardVal As Integer, Show As Integer) As Integer
	If this.Count < this.MaxCount Then
		'can add
		this.Group[Count].CardVal = CardVal
		this.Group[Count].Show = Show
		this.Group[Count].Selected = 0
		this.Count += 1
		Return this.Count
	Else
		Return 0
	EndIf
End Function
The value of 'x' is valid for however many you put in.
sancho2
Posts: 547
Joined: May 17, 2015 6:41

Re: Playing Card Object

Post by sancho2 »

Solitaire.bas reports 3 errors:

Code: Select all

FbTemp.bas(74) error 1: Argument count mismatch, found ')' in 'AllGr.Scan(GroupActivated, Sel, Mx, My)'
FbTemp.bas(95) error 1: Argument count mismatch in 'Gr(L).MoveSelCards(Gr(FromG),1)'
FbTemp.bas(112) error 1: Argument count mismatch in 'Gr(L).MoveSelCards(Gr(FromG),1)
You are using a pointer offset operator as an indexer for some kind of psuedo array, as far as I can tell. But a pointer is not an array.
Here is an example of why I am so confused. This is your code simplified and ignoring the Groups array. Simply adding a card to the group 'array' ptr thing.

Code: Select all

Type CardGroupItem
   'a group may or may not all be showing
   As Integer Show 'Front or back
   As Integer Selected
   As Integer CardVal
End Type

Type CardGroup
   Declare Function AddCard(CardVal As Integer, Show As Integer) As Integer
   As CardGroupItem Ptr Group
   As Integer count
End Type

Type AllGroups
   As CardGroup Ptr Groups(20)
End Type
Function CardGroup.AddCard(CardVal As Integer, Show As Integer) As Integer
      'can add
      count += 1
      this.Group[Count].CardVal = CardVal
      this.Group[Count].Show = Show
      this.Group[Count].Selected = 0
      this.Count += 1
      Return this.Count
End Function
Dim cg As CardGroup
cg.AddCard(12,0)
cg.AddCard(13,0)
Print cg.Group[1].CardVal
sleep
I may be missing something, but in my opinion all that code that indexes the pointer 'group' is invalid and should not work (the example I posted does not work).
bcohio2001
Posts: 556
Joined: Mar 10, 2007 15:44
Location: Ohio, USA
Contact:

Re: Playing Card Object

Post by bcohio2001 »

Quick fix for 'Solitare.bas'
Line 20, need to add the mouse button variable:

Code: Select all

Dim As Integer Mx, My, Mb 'main prg does not need to check for these, but need to pass to .Scan()
Line 73 and 74:

Code: Select all

GetMouse Mx, My,, Mb
AllGr.Scan(GroupActivated, Sel, Mx, My, Mb)
Lines 95 and 112: Just remove second parameter.

A pointer is returned from a 'Callocate', 'Allocate' or 'Reallocate'. Which is probably how regular arrays are created and stored 'behind the scenes'.

Code: Select all

'return error code -- 0 = no error
Function CardGroup.SetSize(NewSize As Integer) As Integer
	Dim As Integer IsNeg, S
	If NewSize < 0 Then IsNeg = 1
	S = Abs(NewSize)
	If this.Group <> 0 Then
		're-size
		'do not care if parameter was negative
		If S = 0 Then
			If This.StartCount > 0 Then
				S = This.StartCount 'set size back to starting size
			Else
				Return 1 'invalid parameter at this time, not dynamic
			EndIf
		EndIf
		Dim As CardGroupItem Ptr NewGI = Reallocate(this.Group, S)
		If NewGI <> 0 Then
			this.Group = NewGI
			this.MaxCount = S
			If this.Count > S Then
				this.Count = S 'DATA LOSS
				Return 3
			EndIf
		Else
			Return 2 'not reallocated
		EndIf
	Else
		'init
		'non-zero only permitted here
		If S = 0 Then Return 1 'invalid parameter at this time, not created.
		this.MaxCount = S
		If IsNeg Then this.StartCount = S 'otherwise leave at zero to indicate fixed size
		this.Count = 0
		this.Group = Callocate(S, SizeOf(CardGroupItem))
		If this.Group = 0 Then Return 2 'not allocated
		SetAddXY
	EndIf
	Return 0
End Function
Your posted code would not work because your pointer is zero.
sancho2
Posts: 547
Joined: May 17, 2015 6:41

Re: Playing Card Object

Post by sancho2 »

I see the Callocate was what I was missing.
Out of curiousity, why go that route and not just an array of ptrs?
bcohio2001
Posts: 556
Joined: Mar 10, 2007 15:44
Location: Ohio, USA
Contact:

Re: Playing Card Object

Post by bcohio2001 »

sancho2 wrote:Out of curiousity, why go that route and not just an array of ptrs?
Not sure at the moment why I thought to do it that way. Maybe just doing it at a 'lower' level and not relying on Redim (Preserve).
bcohio2001
Posts: 556
Joined: Mar 10, 2007 15:44
Location: Ohio, USA
Contact:

Re: Playing Card Object

Post by bcohio2001 »

Version 0.6.1 May 17, 2016

Non-library related:
-- Removed sample program "Test_AllGroups.bas" from distibution zip file.
---- Legacy from V0.5, reworked and renamed to "Solitare.bas" in V0.6.0.
-- Modified "Ini Creator.bas" to be mouse driven instead of keyboard driven.

Added:
-- Suits Enum to 'Cards.bi'.
-- Rotation of cards.
---- Minor test program "Test_Cards_3.bas".
---- Actual rotation is limited to less than 180 degrees, because cards are symetrical. Except the aces.
---- Radians not implimented.
bcohio2001
Posts: 556
Joined: Mar 10, 2007 15:44
Location: Ohio, USA
Contact:

Re: Playing Card Object

Post by bcohio2001 »

Version 0.7.0 Nov. 23, 2019

MUST BE COMPILED WITH AT LEAST COMPILER VERSION 1.07.0
See Cards.txt for complete listing of 'usable' subs and functions.
There are many changes that are not noted here.

Added:
-- Use of radians or degrees for rotation.
-- Rotational defines.
-- Constructor for AllGroups.
---- Two required: Specify how many groups and a pointer to the user's Card object
---- Optional: for 'Aces High' (default 0).
-- Sub CardGroup.SelectBoxed(BoxColor As UInteger = rgbGray)
-- Sub AllGroups.SelectCard(Gr As CardGroup Ptr, Num As Long, SelMode As Long=0)
-- 'Radomize Timer' in Card constructor.

Fix:
-- Rotation of single card is now 'correct'. Upper left corner is the pivot point.
-- Dragging cards will no longer go off screen.

Modified:
-- CardGroup.SetEmpty(What As Long, border As UInteger = rgbWhite, backg As UInteger = rgbGray)
---- Added the two optional color parameters for a drawn box.
-- Card.DrawImg(ByVal XLoc As Long, ByVal YLoc As Long, ByVal GetCard As Long, ByVal Selected As Long, ByVal Rot As Single=0, BoxColor As UInteger = rgbGray)
---- Optional 'BoxColor' parameter for a selected card.
-- Both deck creation functions return a Boolean for success/failure.
-- Card.SameVal(), Card.SameSuit() and Card.SameColor() all return Boolean.
-- Most of the parameters and return codes that were Integer are now Long.
-- Renamed CardGroup.ToggleEnable() to CardGroup.Enable(Active As Boolean)

Removed:
-- "Ugly" 64 bit hacks.
Post Reply