Playing Card Object

[bcohio2001]

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]

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]

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]

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]

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]

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]

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]

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]

'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]

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]

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]

I see the Callocate was what I was missing.
Out of curiousity, why go that route and not just an array of ptrs?

[bcohio2001]

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]

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]

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.