Object Paradigm

[B+]

I've always wanted to try messing with the parameters / argument list of a procedure with one string parameter that contains all the other info needed to set up a polymorphic procedure. You can call newObject with as many or as few arguments needed using: a Key=Value [,Key=Value] ...  format string for Instructions$ parameter AND you don't have to worry about the order that you list them. You could even list them twice as the procedure will only use the last one, Key=Value, you give it.

Boid Watch 2 is an example of this approach with the newObject procedure.

I have now set up Boid Watching so that you can click in obstacles (blue dots) that cause moving objects to do a 180 in direction.
Setup to handle 5 click in obstacles but if you keep clicking they will move around.

Press space bar and click in Predators ( moving obstacles in function but look like red critters).
Setup to handle up to 3 Predators but again if you keep clicking the predators will move to your clicks (they use same index numbers).

Hit spacebar again you toggle back to clicking in obstacles. The click mode is indicated in top right corner.

The critters are the social ones that flock and move as group. They start out as yellow moving left to right and are recycled on left again as green and a radius 1 more than it was up to limit or 20, predators are same they recycle also at a bigger size up to 25.

Lot's to play around with here either on the object creation level or the Boid Watch application:

'Boid Watch 2.txt for JB 2.0 B+ 2018-05-03 post
'mods on Boid Watching,txt for JB 2.0 B+ 2018-04-28
'!!!!!!!!!!!!!!!!!!! extend object paradigm of critters
' make some not moving predator ie obstacles to avoid
' make some moving predators
' make it so we count all the new critters we create (global creatureCnt) up to (global const = maxCreatures)
' make it so we can create new creatures/obstacles/predators from mouse clicks
' make it so we can custom design a new creature by adding a modString to the newCreature creation sub
'  types of creatures critter greenish, predator redish, obstacle blueish

'''' Some kind of screwy thing is happening to cause all critters to bunch up top right corner
'''' or just the right side (I have since reversed the bunching).
'''' It shows up the worse it seems when spaceMode is ON = 1 ???
''''
'''' OK I give up and will go with the flow!
'''' I will start objects on left, let them flow across screen and exit stage right...
'''' and be recycled back at stage left... works nice! They will be increased in radius (and thus speed)
'''' with each recycle up to a max radius. New critters start as yellow to see how long they remain.

NoMainWin
global xmax, ymax, pi, mx, my, clickObject
xmax = 1200 : ymax = 700 : pi = acs(-1)

''''''''''''''''''''''''''''''''''''''' You control the NeighborBoid Here '''''''''''''''''''''''''

'You can click in a Predator (up to 3 for now) or Obstacle (up to 5 for now) anywhere on screen
' Toggle modes between click in Predator or Obstacle with the Spacebar.
' The Mode you are in is reported in Top Left Corner.
' If you continue to Click in a mode beyond maxMouseObstacles (set at 5) or maxPredators (set at 3)
' you will just start relocating the Obstacles or Predators.

'''''''''''''''''''''  Boid behavior based on several modes

centerMode = 1  ' on / off
cf = .01        'centering factor how strong a pull from 0 to 1  .01 is week .1 pretty strong!

headMode = 1    ' on / off
sway = pi/6     'just turn neighbor towards neighbor
hf = .2         'heading factor how strong an influence  0 to 1

spaceMode = 1   ' on / off
spacing = 2 + 24   '2 pixels + 2 max boid radius space amount approx

noise = 0      'general randomness added to movements individualism

WindowWidth = xmax + 8
WindowHeight = ymax + 32
UpperLeftX = 100
UpperLeftY = 40
Open "Boid Watching v 2018-05-03 by B+ for JB v2,  space bar toggles click mode Obstacle/Predator" For Graphics_nsb_nf As #g
#g "trapclose quit"
#g "setfocus"
#g "when leftButtonUp lButtonUp"
#g "when characterInput charIn"
#g "when mouseMove move"
#g "down"
#g "fill black"


'============ some of these are used in Main code, some just used for reference or calculations in procedures

Global maxBorderObstacles, maxMouseObstacles, maxObstacles, maxCritters, maxPredators, maxMoving, maxObjects
Global borderObstacleCnt, mouseObstacleCnt, critterCnt, predatorCnt, objectCnt  '?objectCnt
Global mouseObstacleOffset, critterOffset, predatorOffset  'index offsets, all objects are referred to by index number


'non moving
maxBorderObstacles = 100  'create up to 100 obstacles to pen moving critters into screen view area
maxMouseObstacles = 5     'create obstacles inside pen, these you click in when in Click Obstacle Mode
maxObstacles = maxBorderObstacles + maxMouseObstacles

'moving
maxCritters = 30  'move away from obstacles and predators
maxPredators = 3  'move away from obstacles, these you click in where ever when in Click Prey mode
maxMoving = maxCritters + maxPredators

'total
maxObjects = maxObstacles + maxMoving

'count current objects loaded
borderObstacleCnt = 0
mouseObstacleCnt = 0
predatorCnt = 0
critterCnt = 0

objectCnt = 0

'starting indexs to control where certain types of objects are placed in arrays
mouseObstacleOffset = maxBorderObstacles
critterOffset = mouseObstacleOffset + maxMouseObstacles
predatorOffset = critterOffset + maxCritters

'for reference
typeBorderObstacle = 0
typeObstacle = 1
typeCritter = 2
typePredator = 3

'psuedo structure for all objects
dim type(maxObjects) 'see types above
dim x(maxObjects)
dim y(maxObjects)
dim r(maxObjects)  'radius
dim a(maxObjects)  'angle in radians
dim p(maxObjects)  'predator/obstacle mode = 1 when around a predator or obstacle else = 0
dim c$(maxObjects) 'color string predators are redish, critters are yellow to start then green up

'setup border objects
for x = 25 to xmax step 50
   call newObject "type=0,c =0 0 255, y=25, r=10, x=";x
   call newObject "type=0,c =0 0 255, y=";ymax -25;", r=10, x=";x
next
'for y = 75 to ymax step 50
'    call newObject "type=0,c =0 0 255, x=25, r=10, y=";y
'    call newObject "type=0,c =0 0 255, x=";xmax -25;", r=10, y=";y
'next
for i = 1 to maxCritters
   'test critter make green coming in from right side
   call newObject "c=0 ";rand(250, 255);" 0"
next
'notice predatorOffset

clickObject = 0  '0 for clicking in a stationary obstacle, 1 for clicking in a moving predator
while 1
   scan
   #g "discard"
   #g "fill black"
   #g "color white"
   if clickObject then M$ = "Click: prey" else M$ = "Click: obstacle"
   #g "place ";10;" ";10;";|";M$

   for m = 1 to maxObstacles
       if x(m)<>0 and y(m)<>0 then
           call drawObject m
       end if
   next
   'draw the predators
   for p = predatorOffset + 1 to predatorOffset + maxPredators
       if x(p) <> 0 and y(p) <> 0 then
           p(p) = 0 'assume not near predator or obstacle
           for o = 1 to 105
               scan
               if x(o) <> 0 and y(o) <> 0 then
                   if distance(x(p), y(p), x(o), y(o)) < 2 * (r(i) + r(o)) then
                   'a(i) = a(i) + sway '* rdir()
                       a(p) = atan2(y(o) - y(p), x(o) - x(p)) - pi
                       p(i) = 1
                   end if
               end if
           next
           for o = predatorOffset + 1 to predatorOffset + maxPredators
               scan
               if x(o) <> 0 and y(o) <> 0 and o <> p then
                   if distance(x(p), y(p), x(o), y(o)) < 2 * (r(i) + r(o)) then
                   'a(i) = a(i) + sway '* rdir()
                       a(p) = atan2(y(o) - y(p), x(o) - x(p)) - pi
                       p(i) = 1
                   end if
               end if
           next
           if p(p) then jump = 4 * r(p) else jump = r(p)
           x(p) = x(p) + r(p) * cos(a(p))
           y(p) = y(p) + r(p) * sin(a(p))
           if x(p) < -1 * r(p) or x(p) > xmax + r(p) + 150 or y(p) < -1 * r(p) or y(p) > ymax + r(p) then 'start new
               if r(p) < 25 then r(p) = r(p) + 1
               call newObject "type=3,i=";p;",c=";c$(p);",r=";r(p)
           end if
           call drawObject p
       end if
   next
   for i = critterOffset + 1 to critterOffset + maxCritters 'big show of points and triangle
       scan
       if a(i) < 0 then a(i) = a(i) + 2 * pi
       if a(i) >= 2 * pi then a(i) = a(i) - 2 * pi
       for j = i + 1 to critterOffset + maxCritters
           scan
           if distance(x(i), y(i), x(j), y(j)) < 3 * (r(i) + r(j)) then

               'sway the neighbors towards each other
               if headMode then
                   if a(i) > a(j) then
                       a(i) = a(i) - sway * hf
                       a(j) = a(j) + sway * hf
                   else
                       a(i) = a(i) + sway * hf
                       a(j) = a(j) - sway * hf
                   end if
               end if

               'stickiness stay close to neighbors, close distance between
               if centerMode then
                   if x(i) > x(j) then
                       x(i) = x(i) - cf * (x(i) - x(j))
                       x(j) = x(j) + cf * (x(i) - x(j))
                   else
                       x(i) = x(i) + cf * (x(j) - x(i))
                       x(j) = x(j) - cf * (x(j) - x(i))
                   end if
                   if y(i) > y(j) then
                       y(i) = y(i) - cf * (y(i) - y(j))
                       y(j) = y(j) + cf * (y(i) - y(j))
                   else
                       y(i) = y(i) + cf * (y(j) - y(i))
                       y(j) = y(j) - cf * (y(j) - y(i))
                   end if
               end if

               'don't let them bunch up
               if spaceMode then
                   ' The following is STATIC's adjustment of ball positions if overlapping
                   ' before calcultion of new positions from collision
                   ' Displacement vector and its magnitude.  Thanks STxAxTIC !
                   nx = x(j) - x(i)
                   ny = y(j) - y(i)
                   nm = SQR(nx ^ 2 + ny ^ 2)
                   IF nm < (r(i) + r(j)) THEN
                       nx = nx / nm
                       ny = ny / nm
                       ' Regardless of momentum exchange, separate the balls along the lone connecting them.
                       WHILE nm < (r(i) + r(j))
                           scan
                           x(j) = x(j) + .1 * spacing * nx
                           y(j) = y(j) + .1 * spacing * ny
                           x(i) = x(i) - .1 * spacing * nx
                           y(i) = y(i) - .1 * spacing * ny
                           nx = x(j) - x(i)
                           ny = y(j) - y(i)
                           nm = SQR(nx ^ 2 + ny ^ 2)
                           nx = nx / nm
                           ny = ny / nm
                       wend
                   end if 'spacer
               end if 'space Mode
           end if 'distance
       next

       'all obstacles are predators as well as predators when close to one do a u-ee
       p(i) = 0 'assume not near predator or obstacle
       for o = 1 to 105
           scan
           if x(o) <> 0 and y(o) <> 0 then
               if distance(x(i), y(i), x(o), y(o)) < 3 * (r(i) + r(o)) then
                   'a(i) = a(i) + sway '* rdir()
                   a(i) = atan2(y(o) - y(i), x(o) - x(i)) - pi
                   p(i) = 1
               end if
           end if
       next
       for o = predatorOffset + 1 to predatorOffset + predatorCnt
           scan
           if x(o) <> 0 and y(o) <> 0 then
               if distance(x(i), y(i), x(o), y(o)) < 3 * (r(i) + r(o)) then
                   'a(i) = a(i) + sway '* rdir()
                   a(i) = atan2(y(o) - y(i), x(o) - x(i)) - pi
                   p(i) = 1
               end if
           end if
       next

       'IF x(i) < 30 OR x(i) > xmax - 30 OR y(i) > ymax - 30 THEN a(i) = a(i) + sway
       'out of sight
       if x(i) < -1 * r(i) or x(i) > xmax + r(i) + 150 or y(i) < -1 * r(i) or y(i) > ymax + r(i) then 'start new
           'if critterCnt >= maxCritters then critterCnt = 0
           if r(i) < 20 then r(i) = r(i) + 1
           call newObject "i=";i;",r=";r(i)
       end if
       'update points
       if p(i) then jump = 4 * r(i) else jump = r(i)
       x(i) = x(i) + jump * cos(a(i)) + rnd(0) * noise - .5 * noise
       y(i) = y(i) + jump * sin(a(i)) + rnd(0) * noise - .5 * noise

       call drawObject i
   next
   #g "flush"
   call pause 150
wend

'---------------- windows setup calls

sub quit H$
   close #H$
   end
end sub

sub lButtonUp H$, mx, my  'must have handle and mouse x,y
   'drop in an obstacle or a prey
   if clickObject then 'prey
       if predatorCnt >= maxPredators then predatorCnt = 0
       call newObject "type=3, c=";rand(30, 160);" 0 0, r=15, x=";mx;", y=";my
   else 'obstacle
       if mouseObstacleCnt >= maxMouseObstacles then mouseObstacleCnt = 0
       call newObject "type=1, c=0 0 255, r=10, x=";mx;", y=";my
   end if
end sub

sub charIn H$, c$
   'toggle clicking in an obstacle or a prey
   if c$ = " " then
       if clickObject then clickObject = 0 else clickObject = 1
   end if
end sub

sub move H$, MouseX, MouseY
   mx = MouseX
   my = MouseY
end sub

'--------------- important subs for this program

sub newObject instructions$   '< psuedo OOP new Object, is Constructer the right term?
   'according to it's type we set the objects index, if no type is instructed then try type 1 as default

   'read in the parameter arguments  instructions$ in form ? "type=1,x=3,r=10... "
   wi = 1
   while word$(instructions$, wi, ",") <> ""
       p$ = trim$(word$(word$(instructions$, wi, ","), 1, "="))
       v$ = trim$(word$(word$(instructions$, wi, ","), 2, "="))
       select case p$
           case "type" : t = val(v$) : tset = 1
           case "r"    : r = val(v$) : rset = 1
           case "x"    : x = val(v$) : xset = 1
           case "y"    : y = val(v$) : yset = 1
           case "a"    : a = val(v$) : aset = 1
           case "c"    : c$ = v$     : cset = 1
           case "i"    : i = val(v$) : iset = 1
       end select
       wi = wi + 1
   wend

   'use defaults if no argument is given
   if tset = 0 then t = 2 'default critter
   if rset = 0 then r = rand(4, 6)
   if xset = 0 then x = rand(xmax-r, xmax + 100 + r)
   if yset = 0 then y = rand(50, ymax - 50)
   if aset = 0 then a = pi/2 + pi * rnd(0)
   if cset = 0 then c$ = "0 ";rand(64, 155);" 0"

   'assign an index number according to type, if find one the up the index cnt for type
   if iset = 0 then
       select case t
           case 0
               if borderObstacleCnt + 1 < maxBorderObstacles then
                   borderObstacleCnt = borderObstacleCnt + 1
                   index = borderObstacleCnt
               end if
           case 1
               if mouseObstacleCnt + 1 <= maxMouseObstacles then
                   mouseObstacleCnt = mouseObstacleCnt + 1
                   index = mouseObstacleOffset + mouseObstacleCnt
               end if
           case 2
               if critterCnt + 1 <= maxCritters then
                   critterCnt = critterCnt + 1
                   index = critterOffset + critterCnt
               end if
           case 3
               if predatorCnt + 1 <= maxPredators then
                   predatorCnt = predatorCnt + 1
                   index = predatorOffset + predatorCnt
               end if
       end select
   else
       index = i
   end if
   if index <> 0 then 'load object values into arrays
       type(index) = t
       r(index) = r
       x(index) = x
       y(index) = y
       a(index) =  a
       c$(index) = c$
   end if

end sub

sub drawObject i
   #g "color ";c$(i)
   #g "backcolor ";c$(i)
   #g "place ";x(i);" ";y(i);"; circlefilled ";r(i)
   if type(i) > 1 then
   if p(i) then
       x1 = x(i) + .75 * r(i) * cos(a(i) - pi/9 + pi)
       y1 = y(i) + .75 * r(i) * sin(a(i) - pi/9 + pi)
       x2 = x(i) + .75 * r(i) * cos(a(i) + pi/9 + pi)
       y2 = y(i) + .75 * r(i) * sin(a(i) + pi/9 + pi)
   else
       x1 = x(i) + .75 * r(i) * cos(a(i) - pi/9)
       y1 = y(i) + .75 * r(i) * sin(a(i) - pi/9)
       x2 = x(i) + .75 * r(i) * cos(a(i) + pi/9)
       y2 = y(i) + .75 * r(i) * sin(a(i) + pi/9)
   end if
   #g "color white"
   #g "backcolor white"
   #g "place ";x1;" ";y1;"; circlefilled ";.25 * r(i)
   #g "place ";x2;" ";y2;"; circlefilled ";.25 * r(i)
   if p(i) then
       x3 = x1 + .125 * r(i) * cos(a(i) + pi)
       y3 = y1 + .125 * r(i) * sin(a(i) + pi)
       x4 = x2 + .125 * r(i) * cos(a(i) + pi)
       y4 = y2 + .125 * r(i) * sin(a(i) + pi)
   else
       x3 = x1 + .125 * r(i) * cos(a(i))
       y3 = y1 + .125 * r(i) * sin(a(i))
       x4 = x2 + .125 * r(i) * cos(a(i))
       y4 = y2 + .125 * r(i) * sin(a(i))
   end if
   #g "color black"
   #g "backcolor black"
   #g "place ";x3;" ";y3;"; circlefilled ";.125 * r(i)
   #g "place ";x4;" ";y4;"; circlefilled ";.125 * r(i)
   end if
end sub

'----------------- supplementary handy subs

Function atan2(y, x) 'thanks Andy Amaya
   'atan2 is a function which determines the angle between points
   'x1, y1 and x2, y2. The angle returned is in radians
   'The angle returned is always in the range of
   '-PI to PI radians (-180 to 180 degrees)
   '==============================================================
   'NOTE the position of Y and X arguments
   'This keeps atan2 function same as other language versions
   '==============================================================
  If x = 0 Then
      If y < 0 Then
           atan2 = -1.5707963267948967
       Else
           atan2 = 1.5707963267948967
       End If
  Else
      chk = atn(y/x)
      If x < 0 Then
          If y < 0 Then
               chk = chk - 3.1415926535897932
           Else
               chk = chk + 3.1415926535897932
           End If
      End If
       atan2 = chk
  End If
  if atan2 < 0 then atan2 = atan2 + 2 * pi
End Function

sub pause mil   'tsh version has scan built-in
   t0 = time$("ms")
   while time$("ms") < t0 + mil : scan : wend
end sub

function rand(lo, hi)
   rand = int((hi - lo + 1) * rnd(0)) + lo
end function

function distance(x1, y1, x2, y2)
   distance = ( (x1 - x2) ^ 2 + (y1 - y2) ^ 2) ^ .5
end function

function rdir()
   if rnd(0) < .5 then rdir = -1 else rdir = 1
end function





[tsh73]

sub newObject is really cool.
I have to digest that.

[B+]

It was allot of work to setup newObject but a dream to CALL newObject.

Reading over code I posted yesterday, I see many details left to fix, for clarity, none look particularly harmful to the code functioning as intended.

[B+]

Makeover the look of Boid Watching and add Obstacle Obliteration and Poison Predators to erase Click in Obstacles and Predators.

'Boid Watch 3.txt for JB 2.0 B+ 2018-05-04 fix up or update some details
'makeover of Boid Watching 2.txt for JB 2.0 B+ 2018-05-03
' posted http://justbasiccom.proboards.com/thread/78/object-paradigm
'makeover of Boid Watching
' posted in thread here: http://justbasiccom.proboards.com/thread/63/boids-floking-swarm-scool?page=2

'!!!!!!!!!!!!!!!!!!! extend object paradigm of critters > Watch 3: now more bird like
' make some not moving predator ie obstacles to avoid
' make some moving predators
' make it so we count all the new critters we create (global creatureCnt) up to (global const = maxCreatures)
' make it so we can create new creatures/obstacles/predators from mouse clicks
' make it so we can custom design a new creature by adding a modString to the newCreature creation sub
'  types of creatures boids now black/brown, predator still redish, obstacle blueish > now dark green tree-like

'''' Some kind of screwy thing is happening to cause all critters to bunch up top right corner
'''' or just the right side (I have since reversed the bunching).
'''' It shows up the worse it seems when spaceMode is ON = 1 ???
''''
'''' OK I give up and will go with the flow!
'''' I will start objects on left, let them flow across screen and exit stage right...
'''' and be recycled back at stage left... works nice! They will be increased in radius (and thus speed)
'''' with each recycle up to a max radius. New critters start as yellow to see how long they remain.

NoMainWin
global xmax, ymax, pi, mx, my, clickObject
xmax = 1200 : ymax = 700 : pi = acs(-1)

''''''''''''''''''''''''''''''''''''''' You control the NeighborBoid Here '''''''''''''''''''''''''

'You can click in a Predator (up to 3 for now) or Obstacle (up to 5 for now) anywhere on screen
' Toggle modes between click in Predator or Obstacle with the Spacebar.
' The Mode you are in, is reported in Top Left Corner.
' If you continue to Click in a mode beyond maxMouseObstacles (set at 5) or maxPredators (set at 3)
' you will just start relocating the Obstacles or Predators.

'''''''''''''''''''''  Boid behavior based on several modes

centerMode = 1  ' on / off
cf = .01        'centering factor how strong a pull from 0 to 1  .01 is week .1 pretty strong!

headMode = 1    ' on / off
sway = pi/6     'just turn neighbor towards neighbor
hf = .2         'heading factor how strong an influence  0 to 1

spaceMode = 1  ' on / off

noise = 0      'general randomness added to movements individualism, applied to critters only

WindowWidth = xmax + 8
WindowHeight = ymax + 32
UpperLeftX = 100
UpperLeftY = 40
Open "Boid Watch 3 Press: space to toggle obstacle/predator, o to obliterate obstacles, p to poison predators" For Graphics_nsb_nf As #g
#g "trapclose quit"
#g "setfocus"
#g "when leftButtonUp lButtonUp"
#g "when characterInput charIn"
#g "when mouseMove move"
#g "down"
#g "fill darkgreen"


'============ some of these are used in Main code, some just used for reference or calculations in procedures

Global maxBorderObstacles, maxMouseObstacles, maxCritters, maxPredators
Global borderObstacleCnt, mouseObstacleCnt, critterCnt, predatorCnt
Global mouseObstacleOffset, critterOffset, predatorOffset  'index offsets, all objects are referred to by index number


'non moving
maxBorderObstacles = 100  'create up to 100 obstacles to pen moving critters into screen view area
maxMouseObstacles = 5     'create obstacles inside pen, these you click in when in Click Obstacle Mode
maxObstacles = maxBorderObstacles + maxMouseObstacles

'moving
maxCritters = 30  'move away from obstacles and predators > now larger red bird-like
maxPredators = 3  'move away from obstacles, these you click in where ever when in Click Prey mode
maxMoving = maxCritters + maxPredators

'total
maxObjects = maxObstacles + maxMoving

'count current objects loaded
borderObstacleCnt = 0
mouseObstacleCnt = 0
predatorCnt = 0
critterCnt = 0

'starting indexs to control where certain types of objects are placed in arrays
mouseObstacleOffset = maxBorderObstacles
critterOffset = mouseObstacleOffset + maxMouseObstacles
predatorOffset = critterOffset + maxCritters

'for reference
'typeBorderObstacle = 0
'typeObstacle = 1
'typeCritter = 2
'typePredator = 3

'psuedo structure for all objects
dim type(maxObjects) 'see types above
dim x(maxObjects)
dim y(maxObjects)
dim r(maxObjects)  'radius
dim a(maxObjects)  'angle in radians
dim p(maxObjects)  'predator/obstacle mode = 1 when around a predator or obstacle else = 0
dim c$(maxObjects) 'color string predators are redish, critters are yellow to start then green up

'setup border objects, > now more natural trees
for x = 25 to xmax step 50
   call newObject "type=0,c=0 ";rand(40, 80);" 0, y=";rand(10,40);", r=";rand(10,40);", x=";rand(x-10, x + 40)
   call newObject "type=0,c=0 ";rand(40, 80);" 0, y=";rand(ymax-40,ymax-10);", r=";rand(10,40);", x=";rand(x-10, x + 40)
next
'for y = 75 to ymax step 50
'    call newObject "type=0,c =0 0 255, x=25, r=10, y=";y
'    call newObject "type=0,c =0 0 255, x=";xmax -25;", r=10, y=";y
'next
for i = 1 to maxCritters
   'test critter make green coming in from right side
   call newObject ""  'use all defaults!
next

clickObject = 0  '0 for clicking in a stationary obstacle, 1 for clicking in a moving predator
while 1
   scan
   #g "discard"
   #g "fill darkgreen"
   for m = 1 to maxObstacles
       if x(m)<>0 and y(m)<>0 then
           call drawObject m
       end if
   next
   #g "color white"
   if clickObject then M$ = "Click: prey" else M$ = "Click: obstacle"
   #g "place ";10;" ";10;";|";M$
   'draw the predators
   for p = predatorOffset + 1 to predatorOffset + maxPredators
       if x(p) <> 0 and y(p) <> 0 then
           p(p) = 0 'assume not near predator or obstacle
           for o = 1 to maxObstacles
               scan
               if x(o) <> 0 and y(o) <> 0 then
                   if distance(x(p), y(p), x(o), y(o)) < 50 then
                       'a(i) = a(i) - 2 * sway '* rdir()
                       a(p) = atan2(y(o) - y(p), x(o) - x(p)) - pi
                       p(i) = 1
                   end if
               end if
           next
           for o = predatorOffset + 1 to predatorOffset + maxPredators
               scan
               if x(o) <> 0 and y(o) <> 0 and o <> p then
                   if distance(x(p), y(p), x(o), y(o)) < 2 * (r(i) + r(o)) then
                       'a(i) = a(i) + 2 * sway '* rdir()
                       a(p) = atan2(y(o) - y(p), x(o) - x(p)) - pi
                       p(i) = 1
                   end if
               end if
           next
           x(p) = x(p) + r(p) * cos(a(p))
           y(p) = y(p) + r(p) * sin(a(p))
           if x(p) < -1 * r(p) or x(p) > xmax + r(p) + 150 or y(p) < -1 * r(p) or y(p) > ymax + r(p) then 'start new
               call newObject "type=3,i=";p;",r=25,c=";rand(180, 255);" 0 0"
           end if
           call drawObject p
       end if
   next
   for i = critterOffset + 1 to critterOffset + maxCritters 'big show of points and triangle
       scan
       if a(i) < 0 then a(i) = a(i) + 2 * pi
       if a(i) >= 2 * pi then a(i) = a(i) - 2 * pi
       for j = i + 1 to critterOffset + maxCritters
           scan
           if distance(x(i), y(i), x(j), y(j)) < 3 * (r(i) + r(j)) then

               'sway the neighbors towards each other
               if headMode then
                   if a(i) > a(j) then
                       a(i) = a(i) - sway * hf
                       a(j) = a(j) + sway * hf
                   else
                       a(i) = a(i) + sway * hf
                       a(j) = a(j) - sway * hf
                   end if
               end if

               'stickiness stay close to neighbors, close distance between
               if centerMode then
                   if x(i) > x(j) then
                       x(i) = x(i) - cf * (x(i) - x(j))
                       x(j) = x(j) + cf * (x(i) - x(j))
                   else
                       x(i) = x(i) + cf * (x(j) - x(i))
                       x(j) = x(j) - cf * (x(j) - x(i))
                   end if
                   if y(i) > y(j) then
                       y(i) = y(i) - cf * (y(i) - y(j))
                       y(j) = y(j) + cf * (y(i) - y(j))
                   else
                       y(i) = y(i) + cf * (y(j) - y(i))
                       y(j) = y(j) - cf * (y(j) - y(i))
                   end if
               end if

               'don't let them bunch up
               if spaceMode then
                   spacing = r(i) + r(j) + 2
                   ' The following is STATIC's adjustment of ball positions if overlapping
                   ' before calculation of new positions from collision
                   ' Displacement vector and its magnitude.  Thanks STxAxTIC !
                   nx = x(j) - x(i)
                   ny = y(j) - y(i)
                   nm = SQR(nx ^ 2 + ny ^ 2)
                   IF nm < spacing THEN
                       nx = nx / nm
                       ny = ny / nm
                       ' Regardless of momentum exchange, separate the balls along the line connecting them.
                       WHILE nm < spacing
                           scan
                           x(j) = x(j) + .3 * spacing * nx
                           y(j) = y(j) + .3 * spacing * ny
                           x(i) = x(i) - .3 * spacing * nx
                           y(i) = y(i) - .3 * spacing * ny
                           nx = x(j) - x(i)
                           ny = y(j) - y(i)
                           nm = SQR(nx ^ 2 + ny ^ 2)
                           nx = nx / nm
                           ny = ny / nm
                       wend
                   end if 'spacer
               end if 'space Mode
           end if 'distance
       next

       'all obstacles are predators as well as predators when close to one do a u-ee
       p(i) = 0 'assume not near predator or obstacle
       for o = 1 to maxObstacles
           scan
           if x(o) <> 0 and y(o) <> 0 then
               if distance(x(i), y(i), x(o), y(o)) < 50 then
                   a(i) = atan2(y(o) - y(i), x(o) - x(i)) - pi
                   p(i) = 1
               end if
           end if
       next
       for o = predatorOffset + 1 to predatorOffset + predatorCnt
           scan
           if x(o) <> 0 and y(o) <> 0 then
               if distance(x(i), y(i), x(o), y(o)) < 2 * (r(i) + r(o)) then
                   a(i) = atan2(y(o) - y(i), x(o) - x(i)) - pi
                   p(i) = 1
               end if
           end if
       next

       'out of sight
       if x(i) < -1 * r(i) or x(i) > xmax + r(i) + 150 or y(i) < -1 * r(i) or y(i) > ymax + r(i) then 'start new
           call newObject "i=";i
       end if

       'update points
       if p(i) then jump = 4 * r(i) else jump = r(i)
       x(i) = x(i) + jump * cos(a(i)) + rnd(0) * noise - .5 * noise
       y(i) = y(i) + jump * sin(a(i)) + rnd(0) * noise - .5 * noise

       call drawObject i
   next
   #g "flush"
   call pause 75
wend

'---------------- windows setup calls

sub quit H$
   close #H$
   end
end sub

sub lButtonUp H$, mx, my  'must have handle and mouse x,y
   'drop in an obstacle or a prey
   if clickObject then 'prey
       if predatorCnt >= maxPredators then predatorCnt = 0
       call newObject "type=3, c=";rand(160, 255);" 0 0, r=25, x=";mx;", y=";my
   else 'obstacle
       if mouseObstacleCnt >= maxMouseObstacles then mouseObstacleCnt = 0
       call newObject "type=1,c=0 ";rand(40, 80);" 0, y=";my;", r=";rand(10, 40);", x=";mx
   end if
end sub

sub charIn H$, c$
   'toggle clicking in an obstacle or a prey
   if c$ = " " then
       if clickObject then clickObject = 0 else clickObject = 1
   end if
   if c$ = "o" then 'obliterate obstacles
       for i = mouseObstacleOffset + 1 to mouseObstacleOffset + maxMouseObstacles
           x(i) = 0 : y(i) = 0
       next
   end if
   if c$ = "p" then 'poison all predators
       for i = predatorOffset + 1 to predatorOffset + maxPredators
           x(i) = 0 : y(i) = 0
       next
   end if
end sub

sub move H$, MouseX, MouseY
   mx = MouseX
   my = MouseY
end sub

'--------------- important subs for this program

sub newObject instructions$   '< psuedo OOP new Object, is Constructer the right term?
   'for reference
   'typeBorderObstacle = 0
   'typeObstacle = 1
   'typeCritter = 2
   'typePredator = 3
   'according to it's type we set the objects index,
   'if no type is instructed then type 2 = critter as default

   'read in the parameter arguments  instructions$ in form ? "type=1,x=3,r=10... "
   wi = 1
   while word$(instructions$, wi, ",") <> ""
       p$ = trim$(word$(word$(instructions$, wi, ","), 1, "="))
       v$ = trim$(word$(word$(instructions$, wi, ","), 2, "="))
       select case p$
           case "type" : t = val(v$) : tset = 1
           case "r"    : r = val(v$) : rset = 1
           case "x"    : x = val(v$) : xset = 1
           case "y"    : y = val(v$) : yset = 1
           case "a"    : a = val(v$) : aset = 1
           case "c"    : c$ = v$     : cset = 1
           case "i"    : i = val(v$) : iset = 1
       end select
       wi = wi + 1
   wend

   'use defaults if no argument is given, basic critter starts small and slow
   if tset = 0 then t = 2 'default critter
   if rset = 0 then r = rand(12, 16)
   if xset = 0 then x = rand(xmax-r, xmax + 100 + r) 'start at far left off screen
   if yset = 0 then y = rand(50, ymax - 50)
   if aset = 0 then a = pi/2 + pi * rnd(0)   'head them left generally onto screen
   b = rand(30, 80)
   if cset = 0 then c$ = b;" ";b*.5;" ";b*.25

   'assign an index number according to type, if find one the up the index cnt for type
   if iset = 0 then
       select case t
           case 0
               if borderObstacleCnt + 1 < maxBorderObstacles then
                   borderObstacleCnt = borderObstacleCnt + 1
                   index = borderObstacleCnt
               end if
           case 1
               if mouseObstacleCnt + 1 <= maxMouseObstacles then
                   mouseObstacleCnt = mouseObstacleCnt + 1
                   index = mouseObstacleOffset + mouseObstacleCnt
               end if
           case 2
               if critterCnt + 1 <= maxCritters then
                   critterCnt = critterCnt + 1
                   index = critterOffset + critterCnt
               end if
           case 3
               if predatorCnt + 1 <= maxPredators then
                   predatorCnt = predatorCnt + 1
                   index = predatorOffset + predatorCnt
               end if
       end select
   else
       index = i
   end if
   if index <> 0 then 'load object values into arrays
       type(index) = t
       r(index) = r
       x(index) = x
       y(index) = y
       a(index) =  a
       c$(index) = c$
   end if
end sub

sub drawObject i  'now more bird like!
   #g "color ";c$(i)
   #g "backcolor ";c$(i)
   if type(i) > 1 then
       'boids
       r = RND(0) * pi * .25 'flapping
       w = pi * .6
       IF p(i) THEN
           x1 = x(i) + r(i) * COS(a(i) + pi)
           y1 = y(i) + r(i) * SIN(a(i) + pi)
           x2 = x(i) + r(i) * COS(a(i) + pi + w + r)
           y2 = y(i) + r(i) * SIN(a(i) + pi + w + r)
           x3 = x(i) + r(i) * COS(a(i) + pi - w - r)
           y3 = y(i) + r(i) * SIN(a(i) + pi - w - r)
       ELSE
           x1 = x(i) + r(i) * COS(a(i))
           y1 = y(i) + r(i) * SIN(a(i))
           x2 = x(i) + r(i) * COS(a(i) + w + r)
           y2 = y(i) + r(i) * SIN(a(i) + w + r)
           x3 = x(i) + r(i) * COS(a(i) - w - r)
           y3 = y(i) + r(i) * SIN(a(i) - w - r)
       END IF
       call filltriangle x(i), y(i), x1, y1, x2, y2
       call filltriangle x(i), y(i), x1, y1, x3, y3
   else
       #g "place ";x(i);" ";y(i);"; circlefilled ";r(i)
   end if
end sub

'----------------- supplementary handy subs

Function atan2(y, x) 'thanks Andy Amaya
   'atan2 is a function which determines the angle between points
   'x1, y1 and x2, y2. The angle returned is in radians
   'The angle returned is always in the range of
   '-PI to PI radians (-180 to 180 degrees)
   '==============================================================
   'NOTE the position of Y and X arguments
   'This keeps atan2 function same as other language versions
   '==============================================================
  If x = 0 Then
      If y < 0 Then
           atan2 = -1.5707963267948967
       Else
           atan2 = 1.5707963267948967
       End If
  Else
      chk = atn(y/x)
      If x < 0 Then
          If y < 0 Then
               chk = chk - 3.1415926535897932
           Else
               chk = chk + 3.1415926535897932
           End If
      End If
       atan2 = chk
  End If
  if atan2 < 0 then atan2 = atan2 + 2 * pi
End Function

sub pause mil   'tsh version has scan built-in
   t0 = time$("ms")
   while time$("ms") < t0 + mil : scan : wend
end sub

function rand(lo, hi)
   rand = int((hi - lo + 1) * rnd(0)) + lo
end function

function distance(x1, y1, x2, y2)
   distance = ( (x1 - x2) ^ 2 + (y1 - y2) ^ 2) ^ .5
end function

function rdir()
   if rnd(0) < .5 then rdir = -1 else rdir = 1
end function


'Fast Filled Triangle Sub by AndyAmaya
Sub filltriangle x1, y1, x2, y2, x3, y3
   'triangle coordinates must be ordered: where x1 < x2 < x3
   If x2 < x1 Then x = x2 : y = y2 : x2 = x1 : y2 = y1 : x1 = x : y1 = y
   'swap x1, y1, with x3, y3
   If x3 < x1 Then x = x3 : y = y3 : x3 = x1 : y3 = y1 : x1 = x : y1 = y
   'swap x2, y2 with x3, y3
   If x3 < x2 Then x = x3 : y = y3 : x3 = x2 : y3 = y2 : x2 = x : y2 = y
   If x1 <> x3 Then slope1 = (y3 - y1) /(x3 - x1)
   'draw the first half of the triangle
   length = x2 - x1
   If length <> 0 Then
       slope2 = (y2 - y1)/(x2 - x1)
       For x = 0 To length
           #g "Line ";int(x + x1);" ";int(x * slope1 + y1);" ";int(x + x1);" ";int(x * slope2 + y1)
       Next
   End If
   'draw the second half of the triangle
   y = length * slope1 + y1 : length = x3 - x2
   If length <> 0 Then
       slope3 = (y3 - y2) /(x3 - x2)
       For x = 0 To length
           #g "Line ";int(x + x2);" ";int(x * slope1 + y);" ";int(x + x2);" ";int(x * slope3 + y2)
       Next
   End If
   #g "line ";x1;" ";y1;" ";x2;" ";y2
   #g "line ";x2;" ";y2;" ";x1;" ";y1
   #g "line ";x2;" ";y2;" ";x3;" ";y3
   #g "line ";x3;" ";y3;" ";x2;" ";y2
   #g "line ";x1;" ";y1;" ";x3;" ";y3
   #g "line ";x3;" ";y3;" ";x1;" ";y1
End Sub



[bluatigro]

i tryed somthing
now there wil be no end on what we can do whit object$


q$ = "x=1,y=2,z=3"
print "object$ = " ; q$
print "get.property( object$ , 'y' ) = " ; get.property$( q$ , "y" )
end
function get.property$( object$ , property$ )
''this wil return a empty string if nothing is found
 zoek$ = word$( object$ , 1 , "," )
 value$ = word$( zoek$ , 1 , "=" )
 i = 1
 while value$ <> property$ and zoek$ <> ""
   zoek$ = word$( object$ , i , "," )
   value$ = word$( zoek$ , 1 , "=" )    
   uit$ = word$( zoek$ , 2 , "=" )
   i = i + 1
 wend
 get.property$ = uit$
end function


[B+]

Jun 22, 2018 10:13:58 GMT bluatigro said:

i tryed somthing
now there wil be no end on what we can do whit object$

...

Good make an array of different objects and move some around according to their type and allow new objects to be created at run time, as I had done.

[bluatigro]

update :
now we can set a proprty of a random object$

do you have any idea what we can do whit this
i can not think of a limit jet



q$ = "x=1,y=2,z=3"
print "object = " ; q$
print "get.property( object , 'y' ) = " _
; get.property$( q$ , "y" )
print "get.property( object , 'a' ) = " _
; get.property$( q$ , "a" )
print "set.property( object , 'y' , '100' ) = " _
; set.property$( q$ , "y" , "100" )
print "set.property( object , 'a' , '?' ) = " _
; set.property$( q$ , "a" , "?" )
end
function get.property$( o$ , p$ )
''o : object
''p : property
''if p is not in o then this returns ""
 zoek$ = word$( o$ , 1 , "," )
 value$ = word$( zoek$ , 1 , "=" )
 i = 1
 while value$ <> p$ and zoek$ <> ""
   zoek$ = word$( o$ , i , "," )
   value$ = word$( zoek$ , 1 , "=" )
   uit$ = word$( zoek$ , 2 , "=" )
   i = i + 1
 wend
 get.property$ = uit$
end function
function set.property$( o$ , p$ , v$ )
''o : object
''p : property
''v : value
''if p is not in o then nothing changes
 uit$ = ""
 zoek$ = word$( o$ , 1 , "," )
 value$ = word$( zoek$ , 1 , "=" )
 i = 1
 while zoek$ <> ""
   zoek$ = word$( o$ , i , "," )
   value$ = word$( zoek$ , 1 , "=" )
   if value$ = p$ then
     uit$ = uit$ + value$ + "=" + v$ + ","
   else
     uit$ = uit$ + zoek$ + ","
   end if
   i = i + 1
 wend
 set.property$ = left$( uit$ , len( uit$ ) - 2 )
end function


[bluatigro]

update :
even better run this and see



q$ = "x=1,y=2,z=3"
print "object = " ; q$
print "get.property( object , 'y' ) = " _
; get.property$( q$ , "y" )
print "get.property( object , 'a' ) = " _
; get.property$( q$ , "a" )
print "set.property( object , 'y' , '100' ) = " _
; set.property$( q$ , "y" , "100" )
print "set.property( object , 'a' , '?' ) = " _
; set.property$( q$ , "a" , "?" )
print "add.property( object , '@' ) = " _
; add.property$( q$ , "@" )
print "remove.proprty( object , 'y' ) = " _
; remove.property$( q$ , "y" )
end
function get.property$( o$ , p$ )
''o : object
''p : property
''if p is not in o then this returns ""
 zoek$ = word$( o$ , 1 , "," )
 value$ = word$( zoek$ , 1 , "=" )
 i = 1
 while value$ <> p$ and zoek$ <> ""
   zoek$ = word$( o$ , i , "," )
   value$ = word$( zoek$ , 1 , "=" )
   uit$ = word$( zoek$ , 2 , "=" )
   i = i + 1
 wend
 get.property$ = uit$
end function
function set.property$( o$ , p$ , v$ )
''o : object
''p : property
''v : value
''if p is not in o then nothing changes
 uit$ = ""
 zoek$ = word$( o$ , 1 , "," )
 value$ = word$( zoek$ , 1 , "=" )
 i = 1
 while zoek$ <> ""
   zoek$ = word$( o$ , i , "," )
   value$ = word$( zoek$ , 1 , "=" )
   if value$ = p$ then
     uit$ = uit$ + value$ + "=" + v$ + ","
   else
     uit$ = uit$ + zoek$ + ","
   end if
   i = i + 1
 wend
 set.property$ = left$( uit$ , len( uit$ ) - 2 )
end function
function add.property$( o$ , p$ )
 add.property$ = o$ + "," + p$ + "=nothing"
end function
function remove.property$( o$ , p$ )
''o : object
''p : property to be removed
''if p is not in o then nothing changes
 uit$ = ""
 zoek$ = word$( o$ , 1 , "," )
 value$ = word$( zoek$ , 1 , "=" )
 i = 1
 while zoek$ <> ""
   zoek$ = word$( o$ , i , "," )
   value$ = word$( zoek$ , 1 , "=" )
   if value$ <> p$ then
     uit$ = uit$ + zoek$ + ","
   end if
   i = i + 1
 wend
 remove.property$ = left$( uit$ , len( uit$ ) - 2 )
end function


[bluatigro]

update :
how to build verry complex object$



q$ = add.property$( q$ , "x" )
q$ = add.property$( q$ , "y" )
q$ = add.property$( q$ , "z" )
print "object init = " ; q$
q$ = set.property$( q$ , "x" , "1" )
q$ = set.property$( q$ , "y" , "2" )
q$ = set.property$( q$ , "z" , "3" )
print "object = " ; q$
print "get.property( object , 'y' ) = " _
; get.property$( q$ , "y" )
print "get.property( object , 'a' ) = " _
; get.property$( q$ , "a" )
print "set.property( object , 'y' , '100' ) = " _
; set.property$( q$ , "y" , "100" )
print "set.property( object , 'a' , '?' ) = " _
; set.property$( q$ , "a" , "?" )
print "add.property( object , '@' ) = " _
; add.property$( q$ , "@" )
print "remove.proprty( object , 'y' ) = " _
; remove.property$( q$ , "y" )
end
function get.property$( o$ , p$ )
''o : object
''p : property
''if p is not in o then this returns ""
 zoek$ = word$( o$ , 1 , "," )
 value$ = word$( zoek$ , 1 , "=" )
 i = 1
 while value$ <> p$ and zoek$ <> ""
   zoek$ = word$( o$ , i , "," )
   value$ = word$( zoek$ , 1 , "=" )
   uit$ = word$( zoek$ , 2 , "=" )
   i = i + 1
 wend
 get.property$ = uit$
end function
function set.property$( o$ , p$ , v$ )
''o : object
''p : property
''v : value
''if p is not in o then nothing changes
 uit$ = ""
 zoek$ = word$( o$ , 1 , "," )
 value$ = word$( zoek$ , 1 , "=" )
 i = 1
 while zoek$ <> ""
   zoek$ = word$( o$ , i , "," )
   value$ = word$( zoek$ , 1 , "=" )
   if value$ = p$ then
     uit$ = uit$ + value$ + "=" + v$ + ","
   else
     uit$ = uit$ + zoek$ + ","
   end if
   i = i + 1
 wend
 set.property$ = left$( uit$ , len( uit$ ) - 2 )
end function
function add.property$( o$ , p$ )
 if o$ = "" then
   uit$ = p$ + "=nothing"
 else
   uit$ = o$ + "," + p$ + "=nothing"
 end if
 add.property$ = uit$
end function
function remove.property$( o$ , p$ )
''o : object
''p : property to be removed
''if p is not in o then nothing changes
 uit$ = ""
 zoek$ = word$( o$ , 1 , "," )
 value$ = word$( zoek$ , 1 , "=" )
 i = 1
 while zoek$ <> ""
   zoek$ = word$( o$ , i , "," )
   value$ = word$( zoek$ , 1 , "=" )
   if value$ <> p$ then
     uit$ = uit$ + zoek$ + ","
   end if
   i = i + 1
 wend
 remove.property$ = left$( uit$ , len( uit$ ) - 2 )
end function




[tsh73]

i can not think of a limit jet

Objects inside objects?

[B+]

If the game is thinking up limits, then creating new object types at run time seems like one.

Oh hey, a challenge?

hmm... yes an object that creates objects, that would be like objects inside objects?

Perhaps objects could be created from a giant list of properties of qualities or behaviors... very simple elements.

[tsh73]

I mean we have say inventory as a top-level container
it contain sword, helmet, whatnot
these are objects - with properties.
Now it all - comma delimited list of name=value
But say we picked up a purse
It is next level container
How do we store it (in a program)?
And if there will be more layers (magic ring withing small purse withing saddle bag)?

[B+]

Trying to think of some use for containers inside containers inside containers...

Maybe some sort of file system?

[bluatigro]

update :
a proprty can only added 1x
object in object in object is posible now
this has a limit the number of chars on keyboard

read the instructions carfully
or you get strange results

if you have questions ask


''bluatigro 26 jun 2018
''super object
''instructions
''never use cut = cut2
''never use cut[2][a] = cut[2][b]
''never use cut[2] = property or cut[2] = value
''use cut[a] <> cut[b] and cut2[a] <> cut[b]
''if you go deeper in object
q$ = add.property$( q$ , "x" , "," , "=" )
q$ = add.property$( q$ , "y" , "," , "=" )
q$ = add.property$( q$ , "z" , "," , "=" )
print "object init = " ; q$
q$ = set.property$( q$ , "x" , "1" , "," , "=" )
q$ = set.property$( q$ , "y" , "2" , "," , "=" )
q$ = set.property$( q$ , "z" , "3" , "," , "=" )
print "object = " ; q$
print "get.property( object , 'y' , ',' , '=' ) = " _
; get.property$( q$ , "y" , "," , "=" )
print "get.property( object , 'a' , ',' , '=' ) = " _
; get.property$( q$ , "a" , "," , "=" )
print "set.property( object , 'y' , '100' , ',' , '=') = " _
; set.property$( q$ , "y" , "100" , "," )
print "set.property( object , 'a' , '?' , ',' , '=' ) = " _
; set.property$( q$ , "a" , "?" , "," , "=" )
print "add.property( object , '@' , ',' , '=' ) = " _
; add.property$( q$ , "@" , "," , "=" )
print "remove.proprty( object , 'y' , ',' , '=' ) = " _
; remove.property$( q$ , "y" , "," , "=" )
end
function get.property$( o$ , p$ , cut$ , cut2$ )
''o : object
''p : property
''if p is not in o then this returns ""
 zoek$ = word$( o$ , 1 , cut$ )
 value$ = word$( zoek$ , 1 , cut2$ )
 i = 1
 while value$ <> p$ and zoek$ <> ""
   zoek$ = word$( o$ , i , cut$ )
   value$ = word$( zoek$ , 1 , cut2$ )
   uit$ = word$( zoek$ , 2 , cut2$ )
   i = i + 1
 wend
 get.property$ = uit$
end function
function set.property$( o$ , p$ , v$ , cut$ , cut2$ )
''o : object
''p : property
''v : value
''if p is not in o then nothing changes
 uit$ = ""
 zoek$ = word$( o$ , 1 , cut$ )
 value$ = word$( zoek$ , 1 , cut2$ )
 i = 1
 while zoek$ <> ""
   zoek$ = word$( o$ , i , cut$  )
   value$ = word$( zoek$ , 1 , cut2$ )
   if value$ = p$ then
     uit$ = uit$ + value$ + cut$ + v$ + cut2$
   else
     uit$ = uit$ + zoek$ + cut$
   end if
   i = i + 1
 wend
 set.property$ = left$( uit$ , len( uit$ ) - 2 )
end function
function add.property$( o$ , p$ , cut$ , cut2$ )
 if instr( o$ , p$ + cut2$ ) = 0 then
   if o$ = "" then
     uit$ = p$ + cut2$ + "nothing"
   else
     uit$ = o$ + "," + p$ + cut2$ + "nothing"
   end if
 else
   uit$ = o$
 end if
 add.property$ = uit$
end function
function remove.property$( o$ , p$ , cut$ , cut2$ )
''o : object
''p : property to be removed
''if p is not in o then nothing changes
 uit$ = ""
 zoek$ = word$( o$ , 1 , cut$ )
 value$ = word$( zoek$ , 1 , cut2$ )
 i = 1
 while zoek$ <> ""
   zoek$ = word$( o$ , i , cut$ )
   value$ = word$( zoek$ , 1 , cut2$ )
   if value$ <> p$ then
     uit$ = uit$ + zoek$ + cut$
   end if
   i = i + 1
 wend
 remove.property$ = left$( uit$ , len( uit$ ) - 2 )
end function


[bluatigro]

update :
example try whit objects in object
object q = vector3D
object a = array( 5 )

between a and q shoot be a '.'
but the code gives a ','



''bluatigro 29 jun 2018
''super object
''instructions
''never use cut = cut2
''never use cut[2][a] = cut[2][b]
''never use cut[2] = property or cut[2] = value
''use cut[a] <> cut[b] and cut2[a] <> cut[b]
''if you go deeper in object
q$ = add.property$( q$ , "x" , "," , "=" )
q$ = add.property$( q$ , "y" , "," , "=" )
q$ = add.property$( q$ , "z" , "," , "=" )
print "object init = " ; q$
q$ = set.property$( q$ , "x" , "1" , "," , "=" )
q$ = set.property$( q$ , "y" , "2" , "," , "=" )
q$ = set.property$( q$ , "z" , "3" , "," , "=" )
print "object = " ; q$
print "get.property( object , 'y' , ',' , '=' ) = " _
; get.property$( q$ , "y" , "," , "=" )
print "get.property( object , 'a' , ',' , '=' ) = " _
; get.property$( q$ , "a" , "," , "=" )
print "set.property( object , 'y' , '100' , ',' , '=') = " _
; set.property$( q$ , "y" , "100" , "," , "=" )
print "set.property( object , 'a' , '?' , ',' , '=' ) = " _
; set.property$( q$ , "a" , "?" , "," , "=" )
print "add.property( object , '@' , ',' , '=' ) = " _
; add.property$( q$ , "@" , "," , "=" )
print "remove.proprty( object , 'y' , ',' , '=' ) = " _
; remove.property$( q$ , "y" , "," , "=" )
a$ = ""
for i = 0 to 5
 a$ = add.property$( a$ , "a" ; i , "," , "=" )
 a$ = set.property$( a$ , "a" ; i , str$( i ) , "," , "=" )
next i
print a$
c$ = add.property$( c$ , "q" , "." , "!" )
c$ = set.property$( c$ , "q" , q$ , "." , "!" )
c$ = add.property$( c$ , "a" , "." , "!" )
c$ = set.property$( c$ , "a" , a$ , "." , "!" )
print c$
d$ = get.property$( c$ , "a" , "." , "!" )
print d$
e$ = get.property$( d$ , "y" , "," , "=" )
print e$
print "[ game over ]"
end
function get.property$( o$ , p$ , cut$ , cut2$ )
''o : object
''p : property
''if p is not in o then this returns ""
 zoek$ = word$( o$ , 1 , cut$ )
 value$ = word$( zoek$ , 1 , cut2$ )
 i = 1
 while value$ <> p$ and zoek$ <> ""
   zoek$ = word$( o$ , i , cut$ )
   value$ = word$( zoek$ , 1 , cut2$ )
   uit$ = word$( zoek$ , 2 , cut2$ )
   i = i + 1
 wend
 get.property$ = uit$
end function
function set.property$( o$ , p$ , v$ , cut$ , cut2$ )
''o : object
''p : property
''v : value
''if p is not in o then nothing changes
 uit$ = ""
 zoek$ = word$( o$ , 1 , cut$ )
 value$ = word$( zoek$ , 1 , cut2$ )
 i = 1
 while zoek$ <> ""
   zoek$ = word$( o$ , i , cut$  )
   value$ = word$( zoek$ , 1 , cut2$ )
   if value$ = p$ then
     uit$ = uit$ + value$ + cut2$ + v$ + cut$
   else
     uit$ = uit$ + zoek$ + cut$
   end if
   i = i + 1
 wend
 set.property$ = left$( uit$ , len( uit$ ) - 2 )
end function
function add.property$( o$ , p$ , cut$ , cut2$ )
 if instr( o$ , p$ + cut2$ ) = 0 then
   if o$ = "" then
     uit$ = p$ + cut2$ + "nothing"
   else
     uit$ = o$ + "," + p$ + cut2$ + "nothing"
   end if
 else
   uit$ = o$
 end if
 add.property$ = uit$
end function
function remove.property$( o$ , p$ , cut$ , cut2$ )
''o : object
''p : property to be removed
''if p is not in o then nothing changes
 uit$ = ""
 zoek$ = word$( o$ , 1 , cut$ )
 value$ = word$( zoek$ , 1 , cut2$ )
 i = 1
 while zoek$ <> ""
   zoek$ = word$( o$ , i , cut$ )
   value$ = word$( zoek$ , 1 , cut2$ )
   if value$ <> p$ then
     uit$ = uit$ + zoek$ + cut$
   end if
   i = i + 1
 wend
 remove.property$ = left$( uit$ , len( uit$ ) - 2 )
end function