PlayBasic V1.64k WIP Gallery

[kevin]

 PlayBASIC V1.64k  Beta 9 - Array operators / Assignments.

    Currently working my way through adding some more array functionality in the way of operators.   So far this beta has some (limited) support for array handle assignments.    In case you didn't know (if so, you might want to read the Helps->About tutorials at some point!),  when we use handle in PB we're talking about about the entire array, be it a Integer array,  Float array ,String array, Typed array or Typed variable .    The container is basically the housing the around the elements inside the array structure.  So these operations are not applied upon individual elements inside the array, but the entire arrays contents.

    So far, all we can do is copy the right side to the left.   Ie.   DestArray() = SrcArray(),  which at this point is really only a short cut for CopyArray command.    I've a few other ideas that might be handy also, but it'll keep those under wraps for the time being.     

    Anyway, here's a example. 

Code:

// dim two 1d arrays
Dim Array(1)
Dim Array2(20)

// fill array2 with some random values
For lp=1 to 20
Array2(lp)=rnd(100)
next

// show the current state of both arrays
print "Arrays Before Assignment"
print ShowArray(Array())
print ShowArray(Array2())


// __COPY___ Array2 into Array()
Array() = Array2()

// show the current state of both arrays
print "Arrays After Assignment"
print ShowArray(Array())
print ShowArray(Array2())


// refresh display and wait for keypress
Sync
WaitKey

Function ShowArray(Me())
for lp=1 to getarrayelements(me(),1)
s$=s$+digits$(me(lp),3)+","
next
s$=trimright$(s$,",")
EndFunction s$

   Outputs

Code:

Arrays Before Assignment
000
078,099,042,026,083,064,094,028,081,088,005,031,086,046,084,099,084,024,042,087
Arrays After Assignment
078,099,042,026,083,064,094,028,081,088,005,031,086,046,084,099,084,024,042,087
078,099,042,026,083,064,094,028,081,088,005,031,086,046,084,099,084,024,042,087

  See blog for more on new features concerning arrays

[kevin]

 PlayBASIC V1.64k  Beta 10 - Returning UDT's from Functions.

   Today I've been looking into the best way to insert such functionality into PlayBasic V1.64k.  Implementing this today is basically about bridging the gaps, and trying not to leak memory in the process.   While it's not currently working, I'm reasonably sure that VM1 includes enough control to wedge such an ability into it.  Might not be most elegant solution internally, but it should work ok.
 
    I should point out here, that we're talking about returning a single UDT pointer instance, not a container (array/list etc).. 

Code:

Type Vector2D
x#,y#
stuff(20000)
Endtype

Dim Cool as Vector2D

Cool = TestUDTFunction(4444,555)
print Cool.x#
print Cool.y#

Sync
WaitKey


Function TestUDTFunction(x#,y#)

LocalType = new Vector2D
LocalType.x#=x#
LocalType.y#=y#

print LocalType.x#
print LocalType.y#
print "This:"+STR$(Int(LocalType))

EndFunction LocalType as Vector2D

[kevin]

 PlayBASIC V1.64k  Beta 10b - Returning UDT's from Functions (Continued) .

     It's been a pretty creative and productive couple of days code wise. Thus far, every thing seems to have come together to fairly well, which is  surprising.  It hasn't all gone to script with the odd WTF moment,   but  most things on my to do are getting ticked off fairly quickly this time, and i'm happy to say that  Returning User Defined Types  is now one of them.     
 
     Lets not get too far ahead ourselves though,  currently you can only return a single new instance of TYPE from a FUNCTION (NOT a PSUB).  This type is accessible through a UDT pointer inside the function,  then exported as new type bank from the function.   So what's returned from the function call is virtually the same as what the NEW operator returns.   Which is the 'buffer' this type structure is stored within, and not an array/list container.   Therefore PB will expect you to write this buffer handle into a container such as typed variable/array or list.  If you don't, you'll leak this memory !

     Now since the return type is a UDT pointer inside the function, we actually need to initialize this using the NEW operator. If you don't do this, it'll crash anytime you read/write to the field.   I could possibly do this for you (init it as the types declared parent type), but then you'd lose some control, since types can be inherited in PB. So what you could is  Dim the return type as the general parent, but actually allocate one of it's siblings.  Which is perfectly legal.

     Anyway, here's a bit of a working example..     

Code:

setfps 60

// declare our type structure
Type MyObject
x#,y#
radius
deathtime
colour
EndType


// declare & create our global LIST conatiner to hold all our ships 
Dim Ship as MyObject list


// ==========================================
// main loop
// ==========================================

  Do

  Cls 0

lockbuffer
  CurrentTime=Timer()
for each  Ship()
if CurrentTime<Ship.DeathTime
circlec Ship.x#,Ship.y#,Ship.Radius,true,ship.colour
else
Ship=Null
endif
next
unlockbuffer 


if  Rnd(1000)>250
// add 5 to the list container
for lp=1 to 5
Ship= SpawnNewObject()
next
endif
 
  Sync

  loop


Function SpawnNewObject()

// NOTE!! - You MUST NEW the return type prior to reading or writing to it
This = New MyObject

This.x#=rnd#(getscreenwidth())
This.y#=rnd#(getscreenHeight())
This.Radius=rndrange(10,50)
This.Colour =rndrgb()
This.DeathTime=Timer()+rndrange(1000,2000)

EndFunction  This as MyObject

[kevin]

 PlayBASIC V1.64k  Beta 11 - Improving 'As Datatype' support in function declarations.

     I don't really see this as a feature, it's one of those additions that will make declarations a little more uniform with the outside world.  Currently, I've only added 'As integer" trapping in EndFunction declarations (see example bellow).    But will extend this to Floats and Strings also at least.   It's here we start to run into some problems.   PlayBASIC, like traditional BASIC languages is Multi instance.  Where as the majority of modern languages (including most modern BASICs) are single instance.

    What does this mean ?  - Well it means that each keyword is unique and always associated with a particular object/data type regardless.  In multi instances dialects, the same keyword can be used to represent various data types, the language differentiates between the instances by looking at the postfix symbols.   So in PlayBASIC we can the have a variables (and even arrays) called   XPOS,  XPOS#, XPOS$ etc etc.   

    Now in most declarations in PB we can generally use the postfix shortcuts,  Local/Static/Global/Declaration/EndDeclaration blocks ie     Local A, B#  (declares A an integer and B# as float)

   The same applies to type declarations, for example you can create a pair of float fields in two ways..

   #1 - Using post fix as short cuts

Code:

Type Vector2D
   X#
   y#
EndType

  #2 or as data type method (long hand)

Code:

Type Vector2D
   X as float
   y as float
EndType

 
   You'll notice that X & Y "as float"  overrides the fields X & Y from integers (default) to become floats.   Which is the same as if you use dim to declare a float long hand.

   ie.

Code:

Explicit on

Dim X as float

X# = 123.456
Print X#
   
Sync
Waitkey
 

   However, just because the declaration doesn't use the postfix, that doesn't mean you can drop it during operations upon this variable. If you do, the parser with assume you mean the Integer instance.  So If you're running  in explicit mode,  you'll get the a declaration error.  Like so,

 

Code:

Explicit on

Dim X as float

X = 123.456
Print X#
   
Sync
Waitkey

     Notice the dropped # when accessing the X variable.  Since no integer X  has been previously declared this will pop a compile time error.  This is the intended behavior !

     The point i'm getting at here, is that this same behavior will occur in Function/EndFunction & Psub/EndPsub  declarations.   
     
     Anyway, here's a sample of what's currently running..

Code:

explicit on

   Dim a as integer
   Dim b as integer
 
   a,b=Cool()

print a
print b

Sync
waitkey

Function Cool()

result=45.4
dude=666
EndFunction Result as integer,dude as integer

[kevin]

 PlayBASIC V1.64k  Beta 11 - Improving 'As Datatype' support in function declarations (continued).

     The success of yesterdays initial session implementing such parser changes, was soon soured upon running into a rather awkward logical issue to resolve.  In fact, it's taken most of the day to come up with something that even works.. grrrr

      Anyway,  so what this all means is that you can use the as datatype declarations in your Function/EndFunction headers. (They'll also work in Psub/EndPSub too) .

    Here's today's (Thrilling )example...

Code:

explicit on

   Dim a as integer
   Dim b as integer
   Dim c as float   
   
   
;   a,b=Cool()
; print a
; print b
Dim MyPtr as pointer

   a,c#=Cool_Floats(MyPtr)
   
print a
print c#

Sync
waitkey


Function Cool()
result=45.4
dude=666
EndFunction Result as integer,dude as integer


Psub Yeah()

EndPsub Testing as float



Function Cool_Floats(x as pointer)
result=45.4
dude#=int(666.4)
EndFunction Result as integer,dude as float


Function Cool_Floats2(X)
result=45.4
; dude#=666.66
EndFunction Result as integer,dude$ as string


Function Cool_Strings(X)
result=45.4
dude$="Yeah"
EndFunction dude$,Result as integer

 And here's some more test code with AS Datatype screen in FUNCTION/PSUB headers.   Equally thrilling, but it's there if you want it..

Code:

explicit on

   Dim a as integer
   Dim b as integer
   Dim c as float   
   
   
;   a,b=Cool()
; print a
; print b
Dim MyPtr as pointer

   a,c#=Cool_Floats(MyPtr)
   
print a
print c#

Sync
waitkey


Function Cool()
result=45.4
dude=666
EndFunction Result as integer,dude as integer


Psub Yeah()

EndPsub Testing as float



Function Cool_Floats(x as pointer)
result=45.4
dude#=int(666.4)
EndFunction Result as integer,dude as float


Function Cool_Floats2(X)
result=45.4
; dude#=666.66
EndFunction Result as integer,dude$ as string


Function Cool_Strings_Input(InputString$ as string,SecondInputString as string)
result$="45.4"
dude$="Yeah"
EndFunction dude$,Result$ as string




Function Cool_Floats_Input(InputFloat# as float,AnotherInputFloat as float)
result$="45.4"
dude$="Yeah"
EndFunction dude$,Result$ as string

   

[Makeii Runoru]

I like it. It's not really necessary, but you have to fill in all the holes if you intend to make a solid programming language, right?

I look forward to this new release, as it hardens the core of the code's syntax.

[kevin]

I like it. It's not really necessary

    Well, that depends upon who you ask.   
 

but you have to fill in all the holes if you intend to make a solid programming language, right?

     Support for the optional "as datatype"  syntax,  is due to this convention becoming common place over the past years, so it makes sense to adopt such things into PlayBasic also.     So there's some universal similarities for people who come from a programming background.   

I look forward to this new release, as it hardens the core of the code's syntax.

      Rather than waiting for the finally upgrade to be released, you should be running the beta's as they're posted.   Other wise the final, will be a beta!

[kevin]

  PlayBASIC V1.64k  Beta 12 - Passing Individual User Defined Types Into Functions .

       With the addition of being able to return individual UDT's from functions, then it makes sense to add the ability to pass Individual User Defined Types into Functions also.   This gives us two methods to move data between scopes.   You have the original container methods and now you can pass individual type buffers. 

       To declare an input param as individual UDT we use the VARIABLE as UDT declaration.   When you call this function, PB  expects this field to be a UDT bank.  The bank is then resolved to a pointer and pass through to the function internally.   So the UDT variable inside the function is actually UDT pointer.   So the local UDT has no container.  You're writing directly into this type data.   However,  When you pass a Typed array/Typed variable in,  your moving the entire array/list structure.

Code:

Type SomeObject
x#,y#
name$
Endtype

Dim Cool as SomeObject

Cool = TestReturnUDTFromFunction(4444,555,"Bill")


print "------------------------------"
print "Show returned contents"
print "------------------------------"
print Cool.x#
print Cool.y#
print Cool

Test_Pass_UDT_To_Function(Cool)


Sync
WaitKey



Function TestReturnUDTFromFunction(x#,y#,name$)

LocalType = new SomeObject
LocalType.x#=x#
LocalType.y#=y#
LocalType.name=Name$

print "------------------------------"
print "Created Data"
print "------------------------------"
print LocalType.x#
print LocalType.y#
print LocalType.Name$
print "This:"+STR$(Int(LocalType))

EndFunction LocalType as SomeObject




Function Test_Pass_UDT_To_Function(LocalType as SomeObject)

// Manually chekc if this thing exists or not..
if int(LocalType)

;  Yep so,  display the fields
print "------------------------------"
print "passed UDT bank"
print "------------------------------"
print int(localType)
print LocalType.x#
print LocalType.y#
print LocalType.Name
endif


EndFunction

    Here's a quick reworking of the previous example,  this version features passing indivual types in and out of user defined functions. 
 

Code:

setfps 60

// declare our type structure
Type MyObject
x#,y#
radius
deathtime
colour
EndType

// declare & create our global LIST container to hold all our ships 
Dim Ship as MyObject list


// ==========================================
// main loop
// ==========================================

  Do

  Cls 0

lockbuffer
  CurrentTime=Timer()
for each  Ship()
if CurrentTime<Ship.DeathTime
DrawShip(ship)
else
Ship=Null
endif
next
unlockbuffer 


if  spacekey() ;Rnd(1000)>250
// add 5 to the list container
for lp=1 to 5
Ship= SpawnNewObject()
next
endif


print "Object count:"+Str$(getListSize(Ship()))

  Sync
  loop



Function DrawShip(ThisShip as MyObject)
circlec ThisShip.x#,ThisShip.y#,ThisShip.Radius,true,Thisship.colour
EndFunction


Function SpawnNewObject()

// NOTE!! - You MUST NEW the return type prior to reading or writing to it
This = New MyObject

This.x#=rnd(getscreenwidth())
This.y#=rnd(getscreenHeight())
This.Radius=rndrange(10,50)
This.Colour =rndrgb()
This.DeathTime=Timer()+rndrange(1000,2000)

EndFunction  This as MyObject

   Here a version that uses array handles/containers.  This is functionally the same as the version above, expect one Key difference.  The version above is passing the individual TYPEs in and OUT of the functions,  so inside the SpawnNewObject/drawMe functions, we can only access stuff in this stucture, we can't acccess the list that came from.   

    However in the  version bellow, we're passing the entire array (LIST) container.   This allows us to perform operations upon the passed LIST inside the , rather than just upon the single passed instance.   

Code:

setfps 60

// declare our type structure
Type MyObject
x#,y#
radius
deathtime
colour
EndType

// declare & create our global LIST container to hold all our ships 
Dim Ship as MyObject list


// ==========================================
// main loop
// ==========================================

  Do

  Cls 0

lockbuffer
  CurrentTime=Timer()
for each  Ship()
  // pass the SHIP list into the function as well as the death time
UpdateAndDrawShip(Ship(),CurrentTime)
next
unlockbuffer 


if  spacekey() ;Rnd(1000)>250
// add 5 to the list container
for lp=1 to 5
// pass the Ship LIST into this function, so we can add stuff to it
SpawnNewObject(Ship())
next
endif


print "Object count:"+Str$(getListSize(Ship()))

  Sync
  loop



Function UpdateAndDrawShip(ThisShip.MyObject,CurrentTime)
if CurrentTime<ThisShip.DeathTime
circlec ThisShip.x#,ThisShip.y#,ThisShip.Radius,true,Thisship.colour
else
ThisShip=Null
endif
EndFunction




Function SpawnNewObject(This.MyObject)

This = New MyObject

This.x#=rnd(getscreenwidth())
This.y#=rnd(getscreenHeight())
This.Radius=rndrange(10,50)
This.Colour =rndrgb()
This.DeathTime=Timer()+rndrange(1000,2000)

EndFunction

[kevin]

  PlayBASIC V1.64k  Beta 12b - Returning Local Arrays from Functions (Maybe).

       This afternoon I've been continuing my work on the Function Parser.   Now that most of the big issues are resolved, it should be possible to export a locally created array (an array dimmed inside a function), and return and assign it to another array().   Those with a keen eye will no doubt see why I was messing around with Array() operators a few days back   -  Anyway,  while it doesn't currently work,  ideally this could mean that you can dynamically create arrays.

       However, there's a catch (isn't there always),  exported arrays will be returned as their underlying bank handles,  these are use plain integer values.  Since the return isn't strongly typed (for flexibility here), it's going to be possible for you to leak arrays if you're not careful.

      Anyway, here's the current WIP snippet.  So far this parses correctly, but doesn't generate the runtime code for the array exporting.

Code:

Dim Table(0)

; Table() = MakeTable(Size)

print "Yep, i'm not dead"
Sync
waitkey


Function MakeTable(Size)
// Declare and create our local array.  You'll need to DIM this manually
Dim LocalArray(Size)

EndFunction LocalArray() ;  Export local array from function

[kevin]

  PlayBASIC V1.64k  Beta 12c - Returning Local Arrays from Functions (continued).

     Well, we can tick off another feature.  I thought this might take a little longer to get working, but it's really gone fairly seamlessly this time.  The implementation isn't complete mind you (only currently supports return integer arrays)  but the frame work is in now working.  Hopefully, there's no hidden drama's awaiting the implementation of the other array types.   But, anyway..


     So here's a basic functionality example... Not too exciting, but it shows the concept.

Code:

Dim Table(0)

// show the initial array state
print ConvertArrayToString(Table())

// Make and return a array 15 elements in size.. The returned array
// is written back into the Table() array.  When you make and assignment
// like this,  it first undims the data in the destination array, then
// stores the arrays bank in the dest.
Table()=MakeTable(15)

// show the initial array state
print ConvertArrayToString(Table())

// Make and return a array 25 elements in size.. The returned array
// is written back into the Table() array.

Table()=MakeTable(25)
print ConvertArrayToString(Table())

Sync
waitkey



Function MakeTable(Size)
// Declare and create our local array.  You'll need to DIM this manually
Dim LocalArray(Size)

for lp =0 to size
LocalArray(lp)=rnd(50)
next

EndFunction LocalArray() ;  Export local array from function


Function ConvertArrayToString(Me())
for lp=0 to getarrayelements(Me(),1)
s$=s$+digits$(me(lp),2)+","
next
s$=trimright$(S$,",")
EndFunction s$

 Outputs..

Code:

00
19,14,06,19,44,17,35,47,49,47,48,19,33,22,33,01
07,45,45,46,39,22,29,20,33,46,01,45,06,46,37,06,00,46,05,50,49,40,31,40,00,03

[kevin]

  Here's another example.  This one is using a 1D array, to store 1D array handles in.   So we're conceptually creating functionality to resembles the  'arrays within arrays'.    To access the dynamically created arrays here we're using a manually declared redirection array via MakeArray.   So before we can access any array handles within TABLE() we need to, copy the array bank into our redirect array.   Once that's done, the array appears like any other.

Code:

setfps 100


// ----------------------------------
   // Conceptual Array of Arrays
   // ----------------------------------


Dim Table(100)

// make a redirection array.  We'll use this it access the 'array banks' stored
// with the TABLE() array.    We need this in this example since, Table is just
// an integer array.
MakeArray ints()

EndTime=timer()+1000*10

do
Cls 0


if spacekey() or (rnd(100)>20)  and (Timer()<EndTime)
Index=GetFreeCell(Table())
Table(Index)=MakeTable(rndRange(10,20))
; Flushkeys
endif


// press enter to randomly create an array and then store it's bank
// table() array.  So we're making an 'lose' associate
if EnterKey()=true or (rnd(100)>10)
//
index=Rndrange(1,GetArrayElements(Table(),1))
if Table(Index)

ints()=Table(index)
Table(index) = 0  ;clear this handle from the array we used to remember them in

Ints()=0 ; free this array buffer

; Flushkeys
endif
endif


// Display the arrays
for Index=1 to getarrayelements(Table(),1)
if Table(Index)
ints()=Table(index)
print ConvertArrayToString(Ints())
endif
next

Sync
loop


Sync
waitkey




Function MakeTable(Size)
// Declare and create our local array.  You'll need to DIM this manually
Dim LocalArray(Size)

// Fill it full of stuff
for lp =0 to size
LocalArray(lp)=rnd(50)
next

EndFunction LocalArray() ;  Export local array from function


// Convert array to

Function ConvertArrayToString(Me())
for lp=0 to getarrayelements(Me(),1)
s$=s$+digits$(me(lp),2)+","
next
s$=trimright$(S$,",")
EndFunction s$

[kevin]

    It now supports returning Integer/Float and String Arrays

Code:

print "Integers -----------------------------------------------"

Dim Table(0)
// show the
print ConvertArrayToString(Table())

Table()=MakeIntegerTable(15)
print ConvertArrayToString(Table())


print "Floats -----------------------------------------------"
Dim Table#(0)
// show the
print ConvertArrayToStringF(Table#())

Table#()=MakeFloatTable(5)
print ConvertArrayToStringF(Table#())


print "Strings -----------------------------------------------"
Dim Table$(0)
// show the
print ConvertArrayToStringS(Table$())

Table$()=MakeStringTable(7)
print ConvertArrayToStringS(Table$())


Sync
waitkey




Function MakeIntegerTable(Size)

// Declare and create our local array.  You'll need to DIM this manually
Dim LocalArray(Size)

for lp =0 to size
LocalArray(lp)=rnd(50)
next

EndFunction LocalArray() ;  Export local array from function



Function ConvertArrayToString(Me())
for lp=0 to getarrayelements(Me(),1)
s$=s$+str$(me(lp))+","
next
s$=trimright$(S$,",")
EndFunction s$


 
 
Function MakeFloatTable(Size)
// Declare and create our local array.  You'll need to DIM this manually
Dim LocalArray#(Size)

for lp =0 to size
LocalArray#(lp)=rnd#(50)
next

EndFunction LocalArray#() ;  Export local array from function




Function ConvertArrayToStringF(Me#())
for lp=0 to getarrayelements(Me#(),1)
s$=s$+str$(me#(lp))+","
next
s$=trimright$(S$,",")
EndFunction s$




Function MakeStringTable(Size)
// Declare and create our local array.  You'll need to DIM this manually
Dim LocalArray$(Size)

for lp =0 to size
LocalArray$(lp)="Text:"+Str$(rnd(50))
next

EndFunction LocalArray$() ;  Export local array from function




Function ConvertArrayToStringS(Me$())
for lp=0 to getarrayelements(Me$(),1)
s$=s$+(me$(lp))+","
next
s$=trimright$(S$,",")
EndFunction s$

[kevin]

  PlayBASIC V1.64k  Beta 13 - Returning Typed Arrays & Lists from Functions.

     Well well,   this is getting a lot more interesting than just being able to return integer arrays dynamically.  Now we can return locally created float/string/ typed arrays and even Typed lists from within functions also. 

    When an local array is exported it's exported as the databank that represents this item in memory.    We can assign the bank indexes to a receiver array (MyArray() = SomeFunction() ),  or we can store them in an integer fields (as per the example above).

   If we do this, we can't access the data directly, we need to first create an array stub using MakeArray.  Then any time we want to access the data, we assign the array stub our bank index and hey presto, we're able to read write to the array.   It's not the prettiest solution, but it's something that works today!

     Here's a simple example.

Code:

Type Vector2D
x#,y#
EndType

print "[Pass Typed Array============================]"
Dim Dude(0) as vector2D
MakeVectorTable2(Dude(),200)

print "[Return Typed Array============================]"
Dim Dude2(0) as vector2D
Dude2().vector2d= MakeNewVectorTable(45)

print "[Return Link List==============================]"

Dim MyList as vector2D list
MyList()= MakeNewVectorList(10)
for each MyList()
s$=str$(mylist.x#) +", " +str$(mylist.y)
print s$
next


Sync
Waitkey




Function MakeNewVectorTable(Size)
// Declare and create our local array.  You'll need to DIM this manually
Dim LocalArray(Size) as Vector2D

for lp =0 to size
LocalArray(lp).x=rnd(50)
LocalArray(lp).y=rnd(50)
next

EndFunction LocalArray().Vector2D ;  Export local typed array from function


Function MakeNewVectorList(Size)
// Declare and create our local array.  You'll need to DIM this manually
Dim LocalArray as Vector2D list

for lp =0 to size
LocalArray = new Vector2D
LocalArray.x=rnd(50)
LocalArray.y=rnd(50)
next

EndFunction LocalArray.Vector2D ;  Export local typed array from function




Function MakeVectorTable2(LocalArray().Vector2D,Size)
// Declare and create our local array.  You'll need to DIM this manually

Dim LocalArray(size) as Vector2D

for lp =0 to size
LocalArray(lp).x=rnd(50)
LocalArray(lp).y=rnd(50)
next

EndFunction ;  Export local typed array from function

   

[kevin]

    Here's a much more practical example that uses attached typed lists to store character inventories in.  So each character has it's own typed linked list attached.   This can go as deep as you like really and gets rid of the ugly dereferencing issues mentioned earlier in this thread... 
 

Code:

; PROJECT : Inventory
; AUTHOR  : Kevin Picone
; CREATED : 11/7/2009
; EDITED  : 11/7/2009
; ---------------------------------------------------------------------

SetFps 60

type tInventory
itemname$
EndType


// Declare a game object called of SHIP
type tShip
x#,y#
speedx#,speedy#
radius
colour
InventoryArray
EndType


Dim Ship as tship list

//  throw some ships randomly into the list so we're someting to look at
for lp =1 to 20
ship = new tship
ship.x=rndrange(100,700)
ship.y=rndrange(100,500)
angle#=rnd#(360)
ship.speedx=cos(angle#)
ship.speedy=sin(angle#)
ship.radius =rndrange(10,20)
ship.colour =rndrgb()

// Store the inventory arrays bank index, for later use
Ship.InventoryArray =CreateShipsInventory()
next



// This the items that characters can pick up.
type tItem
x#,y#
Starttime,DeathTime
Name$ ; name of the pick up item characters can pick up
BoundingBoxShape
endtype

Dim Item as tItem list


// create an array to hold the names of the inventory items that game character can pick up
Dim ItemNames$(0)
s$="Gold Bar, Silver Bar, Cricket Bat,20 cents,Commodore 64"
NumberOfItems=SplitToArray(s$,",",ItemNames$(),0)



; ---------------------------------------------------------
Do // game LOOP
; ---------------------------------------------------------

Cls 0

; ---------------------------------------------------------
; Show Items
; ---------------------------------------------------------
CurrentTime=timer()
if CurrentTime>SpawnNewItem
SpawnNewItem=CurrentTime+rndrange(50,250)

Item = new tItem
Item.x = Rnd(GetScreenWidth())
Item.y = Rnd(GetScreenHeight())
Item.StartTime=CurrentTime
Item.DeathTime=CurrentTime+2500

Item.name =ItemNames$(int(rnd#(NumberOfItems-1)))

width=gettextwidth(item.name)
height=gettextheight(item.name)

x1=-(Width/2)
x2=(Width/2)
y1=0
y2=(Height)
Item.BoundingBoxShape =NewBoundingBoxShape(x1,y1,x2,y2)


endif

for each Item()
timepast#=currenttime-item.StartTime
scaler#=(TimePast#/(item.DeathTime-item.StartTime))
Scaler#=1-cliprange#(scaler#,0,1)
ink rgbfade($ffffff, scaler#*100)
centertext item.x, item.y, Item.name
if CurrentTime>Item.DeathTime
item=Null
endif
next
ink $ffffff

; ---------------------------------------------------------
; Move Ships
; ---------------------------------------------------------
for each Ship()
x#=ship.x#+ship.speedx#
y#=ship.y#+ship.speedy#
if x#<10 then  x#=10 : Ship.SpeedX*=-1
if x#>790 then  x#=790 : Ship.SpeedX*=-1
if y#<10 then  y#=10 : Ship.Speedy*=-1
if y#>590 then  y#=590 : Ship.Speedy*=-1

ship.x=x#
ship.y=y#

; chekc if ship hit an inventory item
ShipHitItem(Ship())

circlec x#,y#,ship.radius,true,ship.colour

ShowShipInventory(ship())

next

Sync
loop



Function CreateShipsInventory()
Dim MyInventory as tInventory list
EndFunction  MyInventory.tInventory



Function ShowShipInventory(ThisShip.tship)
Makearray Inventory.tInventory

Inventory() =ThisShip.InventoryArray

x#=thisShip.x#
y#=thisShip.y#
th=gettextheight("Y")
ink $ff0000
for each Inventory()
centertext x#,y#,Inventory.itemname
y#+=th
next
ink $ffffff

EndFunction


// Check if this ship hit any of the inventory items

Function ShipHitItem( ThisShip.tship)
Makearray Inventory.tInventory

x#=thisShip.x#
y#=thisShip.y#
radius#=thisShip.radius

// Seed the Inventory array with this objects List
Inventory.tInventory =ThisShip.InventoryArray

// run through and global ITEMS list and see if this ship hit it
for each item()

if circlehitshape(x#,y#,Radius#,Item.BoundingBoxShape,item.x,item.y)
// Add a new item to this objects inventory
inventory =new tInventory
// set it's name
inventory.itemname$=Item.name$

// release this item
FreeCurrentItem(Item())
continue
endif

next


EndFunction



Function NewBoundingBoxShape(x1,y1,x2,y2)
ThisShape=NewShape(4,4)
SetShapeVertex ThisShape,0,x1,y1
SetShapeVertex ThisShape,1,x2,y1
SetShapeVertex ThisShape,2,x2,y2
SetShapeVertex ThisShape,3,x1,y2

SetShapeEdge ThisShape,0,0,1
SetShapeEdge ThisShape,1,1,2
SetShapeEdge ThisShape,2,2,3
SetShapeEdge ThisShape,3,3,0
refreshshape ThisShape
EndFunction ThisShape




Function FreeCurrentItem(ThisItem.tItem)
if GetshapeStatus(ThisItem.BoundingBoxShape)
deleteshape ThisItem.BoundingBoxShape
endif
ThisItem=null
EndFunction

[kevin]

 PlayBASIC V1.64k  Beta 14 - Post Fix Support On User Defined Functions.

     This additions bring user functions into line with the internally bound & native VM operations.   In other words you can declare a user function name and use the # and $ symbols at the end.    The parser doesn't use this are the return prototype though,  the return type still comes from the what exported after the EndFunction statement.  

Code:

Print Yeah$(45)
print SomeOtherFunction#(11.22)

Sync
waitkey

Function Yeah$(A)
This$="Yeah Function="+str$(a)
EndFunction This$

Function SomeOtherFunction#(ThisFloat#)
Print Thisfloat#
This#=Thisfloat#*10
EndFunction This#

   Note: Function name matching is explicit.  So if the function is declared with the post fix, then you can't just drop it, at least not now anwyay.



   This also works on LinkDLL functions now..

  

Code:

linkDll "Some.Dlll"

       TestFunction#(Param) alias "Something" as float
       TestFunction$(Param) alias "Something" as string

EndlinkDll