Hi Guys, this a fairly new project, I've decided to convert from a personal project to a community one.
The Project:
Name: RPG World ONE
Ver: N/A
Notes:
I will try to keep the code as modular as possible. The intention here is to focus on the rpg genre.
As I have already written an immense amount of code, when I add to the todo list here I will also add to the code. I simply wouldn't mind some feedback on ways to improve the state of the current code.
Everything posted here, by me, is free for your personal use
Key:
Testing
Complete
In development stage
Not Started
Todo List:
Bag system
Stats system
Bag System Construct:
Rem ***** Bag Construct *****
Rem the entire bag and inventory library construct is located here.
Remstart
**********************************************************
This constuct will include a base array system, sorting, ui's access and modifications.
Version info:
Current build v1.0b
Start- 12/08/14
Last Update By Blackchaos o n 20/08/2014
Notes:
More updates and link on the way. The goal is to make a system the does not take too much time
away from the processor thus lesser impacting the frame rate.
I've written this in a style that mimics most addons to dbpro, if there are any clashes in variable names,
please feel free to change them, but dont change if you do not know what you are doing, as some
functions my rely on the values that others return in order for the Bag system to properly run.
Remember this was written by BlackChaos, tgc forum link:
Enjoy!
**********************************************************
Remend
Backdrop On : Sync On : Set Window Position 10,10
Rem Something for the backdrop
Make Object CUBE 1,100
Rem to start the system by setting it up
Gosub BGC_START
Rem initilize system
//add item to global internal list of items
Global EquiptGroup,UseGroup,ShowAllGroups
Rem Initialization
ShowAllGroups = 0
UseGroup = 1 `Useable items Group ids
EquiptGroup = 2 `Equiptable items Group ids
Rem add some items to all items list
PotionItemID = BGC_Add_Item_To_ItemsList("Potion",UseGroup) `aDD MY Bag TO FUCNTION STRUCTURE for Bag id
SwordItemID = BGC_Add_Item_To_ItemsList("Sword",EquiptGroup)
ShieldItemID = BGC_Add_Item_To_ItemsList("Shield",EquiptGroup)
HelmItemID = BGC_Add_Item_To_ItemsList("Helm",EquiptGroup)
PantsItemID = BGC_Add_Item_To_ItemsList("Pants",EquiptGroup)
ShoesItemID = BGC_Add_Item_To_ItemsList("Shoes",EquiptGroup)
//Add a items to your Bag list
PotionItemID = BGC_Add_Item_To_Bag(PotionItemID)
PotionItemID = BGC_Add_Item_To_Bag(PotionItemID)
SwordItemID = BGC_Add_Item_To_Bag(SwordItemID)
SwordItemID = BGC_Add_Item_To_Bag(SwordItemID)
ShieldItemID = BGC_Add_Item_To_Bag(ShieldItemID)
PantsItemID = BGC_Add_Item_To_Bag(PantsItemID)
HelmItemID = BGC_Add_Item_To_Bag(HelmItemID)
ShoesItemID = BGC_Add_Item_To_Bag(ShoesItemID)
//Allow object to be equiptable on different parts
BGC_Head_Equipt(HelmItemID)
BGC_RArm_Equipt(SwordItemID)
BGC_LArm_Equipt(ShieldItemID)
BGC_pants_Equipt(PantsItemID)
BGC_shoes_Equipt(ShoesItemID)
//Set this part as activly equipted
BGC_Set_Active_Equipt(HelmItemID)
BGC_Set_Active_Equipt(SwordItemID)
BGC_Set_Active_Equipt(ShieldItemID)
BGC_Set_Active_Equipt(PantsItemID)
BGC_Set_Active_Equipt(ShoesItemID)
Rem debug main
Do
Rem update object
Yrotate Object 1,Object Angle Y(1)+1
Rem Show list of items in bag anywhere on screen, filter modes alow you to show specific item groups
Rem show menu list for all
Print at(10,0),"Show All"
BGC_Show_Items(10,15,ShowAllGroups)
Rem show menu list for all use group
Print at(120,0),"Show Use All"
BGC_Show_Items(120,15,UseGroup)
Rem show menu list for all equipt group
Print at(240,0),"Show Equipt All"
BGC_Show_Items(240,15,EquiptGroup)
Rem get last selected
GetLastClicked$ = BGC_Get_Last_Clicked()
Print at(0,100),"Last clicked "+GetLastClicked$
Rem ui for usage
Print at(0,110),"Space to use "
If Spacekey() > 0 Then sk = 1
If sk = 1 Then If GetLastClicked$ <> "" Then getsel = BGC_Show_Yes_No(200,200,"Would you like to use "+GetLastClicked$)
Rem If yes is clicked
If getsel = 1 : BGC_Clear_Last_Clicked() : getsel = 0:sk = 0 : Endif
Rem if no is clicked
If getsel = 4 : getsel = 0:sk = 0:Endif
Rem to check if item can be equipted to the head
If BGC_Head_Get_Equiptable() = 1 Then Print "Can equip"
Rem to check if item IS equipted to the head
gquip$ = BGC_Get_Active_Equipt()
If gquip$ <> "" Then Print "Is equip to "+gquip$
Rem show refresh rate
print "FPS "+str$(screen fps())
Print "BGCReturnClikedID"
Print BGCReturnClikedID
Rem sync
Sync
Loop
end
Rem add an equiptable item to sections
Function BGC_Head_Equipt(ItemId)
Rem instate this one
Bag(ItemId).item.part.head = 1
Bag(ItemId).item.part.LArm = 0
Bag(ItemId).item.part.RArm = 0
Bag(ItemId).item.part.body = 0
Bag(ItemId).item.part.pants = 0
Bag(ItemId).item.part.shoes = 0
Endfunction
Function BGC_Head_None_Equipt(ItemId)
Rem instate this one
Bag(ItemId).item.part.head = 0
Endfunction
Rem add an equiptable item to sections
Function BGC_LArm_Equipt(ItemId)
Rem instate this one
Bag(ItemId).item.part.LArm = 1
Bag(ItemId).item.part.Head = 0
Bag(ItemId).item.part.RArm = 0
Bag(ItemId).item.part.body = 0
Bag(ItemId).item.part.pants = 0
Bag(ItemId).item.part.shoes = 0
Endfunction
Function BGC_LArm_None_Equipt(ItemId)
Rem instate this one
Bag(ItemId).item.part.LArm = 0
Endfunction
Rem add an equiptable item to sections
Function BGC_RArm_Equipt(ItemId)
Rem instate this one
Bag(ItemId).item.part.RArm = 1
Bag(ItemId).item.part.LArm = 0
Bag(ItemId).item.part.Head = 0
Bag(ItemId).item.part.body = 0
Bag(ItemId).item.part.pants = 0
Bag(ItemId).item.part.shoes = 0
Endfunction
Function BGC_RArm_None_Equipt(ItemId)
Rem instate this one
Bag(ItemId).item.part.RArm = 0
Endfunction
Rem add an equiptable item to sections
Function BGC_body_Equipt(ItemId)
Rem instate this one
Bag(ItemId).item.part.body = 1
Bag(ItemId).item.part.LArm = 0
Bag(ItemId).item.part.RArm = 0
Bag(ItemId).item.part.head = 0
Bag(ItemId).item.part.pants = 0
Bag(ItemId).item.part.shoes = 0
Endfunction
Function BGC_body_None_Equipt(ItemId)
Rem instate this one
Bag(ItemId).item.part.body = 0
Endfunction
Rem add an equiptable item to sections
Function BGC_pants_Equipt(ItemId)
Rem instate this one
Bag(ItemId).item.part.pants = 1
Bag(ItemId).item.part.LArm = 0
Bag(ItemId).item.part.RArm = 0
Bag(ItemId).item.part.body = 0
Bag(ItemId).item.part.head = 0
Bag(ItemId).item.part.shoes = 0
Endfunction
Function BGC_pants_None_Equipt(ItemId)
Rem instate this one
Bag(ItemId).item.part.pants = 0
Endfunction
Rem add an equiptable item to sections
Function BGC_shoes_Equipt(ItemId)
Rem instate this one
Bag(ItemId).item.part.shoes = 1
Bag(ItemId).item.part.LArm = 0
Bag(ItemId).item.part.RArm = 0
Bag(ItemId).item.part.body = 0
Bag(ItemId).item.part.pants = 0
Bag(ItemId).item.part.head = 0
Endfunction
Function BGC_shoes_None_Equipt(ItemId)
Rem instate this one
Bag(ItemId).item.part.shoes = 0
Endfunction
Rem deactivate as equiptable
Function BGC_Set_DeActive_Equipt(ItemId)
Rem instate this one
Bag(ItemId).item.part.active = 0
Endfunction
Rem set active
Function BGC_Set_Active_Equipt(ItemId)
Rem instate this one
Bag(ItemId).item.part.active = 1
Endfunction
Rem immediate return functions
Function BGC_Get_Active_Equipt()
If Bag(BGCReturnClikedID).item.part.active = 1
If BGC_Head_Get_Equiptable() > 0 Then ReturnPart$ = "Head"
If BGC_larm_Get_Equiptable() > 0 Then ReturnPart$ = "l arm"
If BGC_rarm_Get_Equiptable() > 0 Then ReturnPart$ = "r arm"
If BGC_body_Get_Equiptable() > 0 Then ReturnPart$ = "body"
If BGC_pants_Get_Equiptable() > 0 Then ReturnPart$ = "pants"
If BGC_shoes_Get_Equiptable() > 0 Then ReturnPart$ = "shoes"
Endif
Rem returns the part equpted to
Endfunction ReturnPart$
Rem get equi[ptable to head and all other parts
Function BGC_Head_Get_Equiptable()
returnthis = Bag(BGCReturnClikedID).item.part.head
Endfunction returnthis
Function BGC_Larm_Get_Equiptable()
returnthis = Bag(BGCReturnClikedID).item.part.larm
Endfunction returnthis
Function BGC_Rarm_Get_Equiptable()
returnthis = Bag(BGCReturnClikedID).item.part.rarm
Endfunction returnthis
Function BGC_body_Get_Equiptable()
returnthis = Bag(BGCReturnClikedID).item.part.body
Endfunction returnthis
Function BGC_pants_Get_Equiptable()
returnthis = Bag(BGCReturnClikedID).item.part.pants
Endfunction returnthis
Function BGC_shoes_Get_Equiptable()
returnthis = Bag(BGCReturnClikedID).item.part.shoes
Endfunction returnthis
Rem add item to list of items
Function BGC_Add_Item_To_ItemsList(Name as String , group )
Rem get the next empty space available
For n = 0 to BGC_bag_rng_max
If _Items_List(n).Name = ""
_Items_List(n).Name = Name
`Inc Bag(n).item.quantity#,1
_Items_List(n).group = group
returnitemindex = n
Exitfunction returnitemindex
Exit
Endif
Next n
Endfunction returnitemindex
Rem add an existing item to bag
Function BGC_Add_Item_To_Bag(ItemID)
For n = 0 to BGC_bag_rng_max
If Bag(n).item.name$ = ""
Bag(n).item.name$ = _Items_List(ItemID).Name
Bag(n).item.group = _Items_List(ItemID).group
Inc Bag(n).item.quantity#,1
index = n
Exit
Endif
Next n
lastAddedItem$ = _Items_List(ItemID).Name
Rem sort the bag by truncating to quantity
Newindex = BGC_Sort(index) `return the new sorted index
Endfunction Newindex
Rem sort array so duplicate items are added as quantity instead of being aingular
Function BGC_Sort(index)
Rem
NameFind$ = Bag(index).Item.Name$
Rem
For n = 0 to BGC_bag_rng_max
If Bag(n).Item.Name$ <> ""
//Look for exact name
For s = 0 to BGC_bag_rng_max
If s <> n and Bag(s).Item.Name$ = Bag(n).Item.Name$
Inc Bag(n).Item.quantity#,1
Rem remove found copy
Bag(s).Item.Name$ = ""
// Exit
Exit
Endif
Next s
`Exit
Endif
Next n
For n = 0 to BGC_bag_rng_max
If Bag(n).Item.Name$ = NameFind$
NewIndex = n
Exit
Endif
Next n
Endfunction NewIndex
Rem the native ui stuff
Rem buttons
Function BGC_Text_Button(x,y,text$)
Rem get mouse data
mx = Mousex() : my = Mousey() : mc = Mouseclick()
Rem mouse over detections
If mx > x and mx < (x + Text Width(text$)) and my > y and my < (y + Text Height(text$)) Then MouseOverText = 1
Rem When mouse is over the text what to do?
If MouseOverText = 1
Rem change the text color
`INK RGB(0,0,255),Rgb(0,0,0)
Rem indicator is prob faster than changing the entire background
Text x+text width(text$)+2,y,"<"
Rem Adjusts the text size
`Set Text Size 16
Endif
Rem show the text
Text x,y,text$
Rem Return mouse over and clicked `thanks to input by luskos
if mc = 0 then Button_State_Returned = 0
If MouseOverText = 1 and mc = 1 and Button_State_Returned = 0
Return_Button_State = 1
Button_State_Returned = 1
endif
Endfunction Return_Button_State
Rem outlined box manually
Function BGC_Box_Outline(x,y,w,h)
Line x,y,x+w,y
Line x+w,y,x+w,y+h
Line x+w,y+h,x,y+h
Line x,y+h,x,y
Endfunction
Rem Yes no window
Function BGC_Show_Yes_No(x,y,text$)
Rem ui
Nice Wait 50
Repeat
`cls
maxlinechar = 15
textlen = Len(text$)
width = 130
height = 100
Rem bg
`BGC_Box_Outline(x,y,width,height) `Outline th eedges of the list, eats frames
`Box Outline x,y,x+width,y+height,Rgb(rnd(192),0,0)
Rem text question
If textlen > maxlinechar
Text x+5,y+5,Left$(text$,maxlinechar)
Text x+5,y+15,Left$(Right$(text$,textlen-maxlinechar),maxlinechar)
Text x+5,y+25,Left$(Right$(Right$(text$,maxlinechar),textlen-maxlinechar),maxlinechar)
Else
Text x+5,y+5,text$
Endif
Rem options
`BGC_Box_Outline(x,y+(height/4)+(height/2),(width/2),height)
`Box Outline x,y+(height/4)+(height/2),x+(width/2),y+height,Rgb(rnd(192),0,0)
yeb = Bgc_text_button( x+(width/4),y+(height/3)+(height/2),"Yes")
`BGC_Box_Outline(x,y+(height/4)+(height/2),width,height)
`Box Outline x+(width/2),y+(height/4)+(height/2),x+width,y+height,Rgb(rnd(192),0,0)
nob = Bgc_text_button( x+(width/2)+(width/4),y+(height/3)+(height/2),"No")
If yeb = 1
ReturnAns = 1
Endif
If nob = 1
ReturnAns = 4
Endif
sync
Until ReturnAns > 0
Endfunction ReturnAns
Rem us internally stored array index to determin the last clicked item
Function BGC_Get_Last_Clicked()
If BGCReturnClikedID > -1 and BGCReturnClikedID < BGC_bag_rng_max Then BGC_Get_Last_Clicked_Has$ = Bag(BGCReturnClikedID).item.name$
Endfunction BGC_Get_Last_Clicked_Has$
Rem Remove internally stored index
Function BGC_Clear_Last_Clicked()
BGCReturnClikedID = -1
Endfunction
Rem Show a sorted list
Function BGC_Show_Items(x,y,group)
Rem show 10 items at a time
yoffset = 0
maxshowitem = 10
c = Rgb(192,72,0)
w = 80
h = 70
`BGC_BOX_OUTLINE(x,y,w,h)
`Box x,y,x+w,y+h,c,c,c,c-(c/2)
x = x + 2 ` offset text
Rem i have removed the for loop and now instead using and form of array offsetting
n = 0
If Bag(n).item.group = group or group = 0 : If Bag(n).item.name$ <> "" : Button = BGC_Text_Button(x,y+(yoffset*10), Bag(n).item.name$+ " x"+str$(Bag(n).item.quantity#))
If Button = 1 : BGCReturnClikedID = n :Button = 0 :Nice Wait 50 :Endif : yoffset = yoffset + 1 : Endif
Endif
n = 1
If Bag(n).item.group = group or group = 0 : If Bag(n).item.name$ <> "" : Button = BGC_Text_Button(x,y+(yoffset*10), Bag(n).item.name$+ " x"+str$(Bag(n).item.quantity#))
If Button = 1 : BGCReturnClikedID = n :Button = 0 :Nice Wait 50 :Endif : yoffset = yoffset + 1 : Endif
Endif
n = 2
If Bag(n).item.group = group or group = 0 : If Bag(n).item.name$ <> "" : Button = BGC_Text_Button(x,y+(yoffset*10), Bag(n).item.name$+ " x"+str$(Bag(n).item.quantity#))
If Button = 1 : BGCReturnClikedID = n :Button = 0 :Nice Wait 50 :Endif : yoffset = yoffset + 1 : Endif
Endif
n = 3
If Bag(n).item.group = group or group = 0 : If Bag(n).item.name$ <> "" : Button = BGC_Text_Button(x,y+(yoffset*10), Bag(n).item.name$+ " x"+str$(Bag(n).item.quantity#))
If Button = 1 : BGCReturnClikedID = n :Button = 0 :Nice Wait 50 :Endif : yoffset = yoffset + 1 : Endif
Endif
n = 4
If Bag(n).item.group = group or group = 0 : If Bag(n).item.name$ <> "" : Button = BGC_Text_Button(x,y+(yoffset*10), Bag(n).item.name$+ " x"+str$(Bag(n).item.quantity#))
If Button = 1 : BGCReturnClikedID = n :Button = 0 :Nice Wait 50 :Endif : yoffset = yoffset + 1 : Endif
Endif
n = 5
If Bag(n).item.group = group or group = 0 : If Bag(n).item.name$ <> "" : Button = BGC_Text_Button(x,y+(yoffset*10), Bag(n).item.name$+ " x"+str$(Bag(n).item.quantity#))
If Button = 1 : BGCReturnClikedID = n :Button = 0 :Nice Wait 50 :Endif : yoffset = yoffset + 1 : Endif
Endif
Endfunction
Rem start bag system
BGC_START:
Rem Constants
//Maximum storable Bag items + 1 in arrays
#Constant BGC_bag_rng_max 100
Rem Globals
Global LastName$,BGCReturnClikedID,Button_State_Returned
Rem Types
//Used for basic access and storage of axis data
Type axis_ x y Endtype
//Equiptable
Type _PEqp Active as Boolean Head as boolean LArm as boolean RArm as boolean body as boolean pants as boolean shoes as boolean Endtype
//Bag data
Type _Data name$ quantity# part as _PEqp group as Integer EquipAble as Boolean Endtype
//The Bag
Type Bag_Con Name as String as _Data item as _Data position as axis_ angle as axis_ size as axis_ Endtype
//Internal items list
Type In_All_Items Name as string Group Endtype
Rem Your bag items data
Dim Bag(BGC_bag_rng_max) as Bag_Con
Rem internal items list
Dim _Items_List(BGC_bag_rng_max) as In_All_Items
Rem load or create any assets and reserve their id's
Return
