REM modèle @Cassiope34 0417

Fn.def v(c$,p)    % convert characters to value  p=1 -> x, p=2 -> y
  Fn.rtn ASCII(c$,p)-64
Fn.end

Fn.def v$(x,y)    % convert x,y values to characters
  Fn.rtn chr$(64+x, 64+y)
Fn.end

Fn.def LastPtr(ptr)  % put the graphic pointer 'ptr' UP to all other.
  gr.getDL ndl[],1
  array.length sz, ndl[]
  if !ptr | sz=1 | ndl[sz] =ptr then array.delete ndl[] : Fn.rtn 0
  array.search ndl[],ptr,n
  if n
    for nn=n to sz-1 : ndl[nn] =ndl[nn+1] : next
    ndl[sz] =ptr : gr.newDL ndl[]
  endif
  array.delete ndl[]
Fn.end

FN.DEF RRect(x,y, c, lx,ly, fill)
GR.ARC nul, x,     y,     x+c,   y+c,  -90, -90, fill  % top left
GR.ARC nul, x+lx-c,y,     x+lx,  y+c,  -90,  90, fill  % top right
GR.ARC nul, x,     y+ly-c,x+c,   y+ly, -180,-90, fill  % bottom left
GR.ARC nul, x+lx-c,y+ly-c,x+lx,  y+ly, 0,    90, fill  % bottom right
if !fill
  GR.LINE r1, x+c/2, y,     x+lx-c/2,y          % left
  GR.LINE r2, x,     y+c/2, x,       y+ly-c/2   % up
  GR.LINE r3, x+c/2, y+ly,  x+lx-c/2,y+ly       % right
  GR.LINE r4, x+lx,  y+c/2, x+lx,    y+ly-c/2   % down
else
  c*=0.4
  gr.rect nul, x+c, y, x+lx-c, y+ly
  gr.rect nul, x, y+c, x+lx, y+ly-c
endif
FN.END

gr.open 255,255,255,255,0,0    % white & landscape
gr.screen w,h
scx =1280
scy =800
sx =w/scx : sy =h/scy
gr.scale sx, sy

File.Root tmp$
IstandAlone =Is_In("rfo-basic",tmp$)    % to know if it's an APK for the way to exit
path$ =""
filename$ ="AntSystem.sav"
segmax =80
antmax =400

DIM seg$[segmax], seg[segmax,2], ant$[antmax], ant[antmax,6]
ptr =1   %  pointeur graphique pour les segments & pour les fourmis.
phe =2   %  phéromones du segment, en fait c'est l'alpha de la couleur du trait de 15 à 255.
eta =2   %  état des fourmis, 1 =en recherche de la nourriture, 2 =retournant au nid et déposant des phéromones.
nps =3   %  nbre de 'pas' nécessaire pour franchir le segment.
npc =4   %  nbre de 'pas' courant.
ixx =5   %  incrément en 'x' pour le segment courant.
iyy =6   %  incrément en 'y' pour le segment courant.

GOSUB makeBmp
start =1
pas   =ec/2   % 'pas' d'une fourmis en pixel  ( ec =50 pixels  l'écart entre les points )

DO
  
  new    =0
  graph$ =""
  nseg   =0
  tns    =0
  action =6   % stop
  GOSUB init
  start  =0
  ants   =100
  tphe   =8
  
  Do
    
    do
      gr.touch touched, x, y
      if !background() then gr.render
    until touched | new | quit
    if new | quit then D_U.break
    x/=sx : y/=sy
    
    do
      gr.touch touched, tx, ty
    until !touched | new | quit
    tx/=sx : ty/=sy
    px =int(tx/ec)+1 : py =int(ty/ec)
    
    if px<23 & py     % stay into the graph.
      if action =3      % make the graph (action's field of the ants)
        gr.color 18,255,0,0,2 : gr.set.stroke 12
        if !prem
          gr.modify curs, "x", (px-0.5)*ec, "y", ec+(py-0.5)*ec : gr.show curs : prem =1
          oldpx =px : oldpy =py : ox =tx : oy =ty
        else
          if px<>oldpx | py<>oldpy
            seg$ =v$(oldpx,oldpy)+"-"+v$(px,py) : iseg$ =v$(px,py)+"-"+v$(oldpx,oldpy)   % segment ds les 2 sens.
            array.search seg$[], seg$, r1
            array.search seg$[], iseg$, r2
            if !r1 & !r2
              nseg++ : seg$[nseg] =seg$ : tns++  % nbre réel de segment dessinés.
              gr.line seg[nseg,ptr], (oldpx-0.5)*ec, ec+(oldpy-0.5)*ec, (px-0.5)*ec, ec+(py-0.5)*ec : seg[nseg,phe] =15
                                  
            else
              if r1 then gr.hide seg[r1,ptr] : seg$[r1]=""
              if r2 then gr.hide seg[r2,ptr] : seg$[r2]=""
              tns--
              
            endif
            gr.hide curs : prem =0
            
           ! nettoyer seg$[] & seg[] des segments vides (effacés)
          
          endif
        endif
        LastPtr( curs )

      elseif action =4       % set the Nest position
        as =0 : pt$ =v$(px,py)
        for s=1 to nseg
          if is_in(pt$,seg$[s]) then as =s : f_n.break
        next
        if as & (px<>FoodX | py<>FoodY)
          NestX =px : NestY =py : gr.modify nest, "x", (px-0.5)*ec, "y", ec+(py-0.5)*ec : LastPtr( nest )
          gosub init : gosub GraphDraw
        endif
        
      elseif action =5       % set the Food position
        as =0 : pt$ =v$(px,py)
        for s=1 to nseg
          if is_in(pt$,seg$[s]) then as =s : f_n.break
        next
        if as & (px<>NestX | py<>NestY)
          FoodX =px : FoodY =py : gr.modify food, "x", (px-0.5)*ec, "y", ec+(py-0.5)*ec : LastPtr( food )
          gosub init : gosub GraphDraw
        endif
          
      endif
    
    elseif py>1      % button selection for the action to do...
      by =hex(mid$("122446688AACCEE",py,1))
      gr.modify actb, "y", 10+by*ec : gr.render
      action =by/2
      ch$ =" Set the Ants number ; Set evaporation rate of pheromones ; Make the graph ;"+~
           " Set the Nest position ; Set the food position ; Stop the simulator ; Start the simulator"
      popup word$(ch$,action,";")
      gr.hide curs
      
      if action =1         % ajust the number of ants working.
        tmp =Ants
        input "Set the number of participating ants from 10 to 100", tmp, tmp, no
        if !no
          Ants =tmp : Ants =max(Ants,10) : Ants =min(Ants,antmax)
          gosub init : gosub GraphDraw : gr.modify actb, "y", 10+12*ec
        endif
        
      elseif action =2     % ajust the evaporation rate of the pheromones on all segments.
        tmp =tphe
        input "Set the evaporation of the pheromones from 2 to 40", tmp, tmp, no
        if !no
          tphe =tmp : tphe =max(tphe,2) : tphe =min(tphe,40)
        endif
          
      elseif action =7     %  start animation
        ! si il y a assez de segments... et que le nid et la nourriture ont été placés.
        GOSUB AntsAlgo      %   action =6   ( stop animation )  est géré ds AntsAlgo
          
      endif
    endif

  Until new
UNTIL quit
GOSUB SaveGraph
if IstandAlone then END "Bye...!"
EXIT

OnBackKey:
 gr.modify actb, "y", 10+12*ec : action =6 : gr.render : GOSUB BoiteMenu
back.resume

BoiteMenu:
  Dialog.message win$,"       What do you want ?", ok, " Exit ", " New Graph ", " Cancel "
  new  =(ok=2) : quit =(ok=1)
return

AntsAlgo:       %  ants management.
if !ants then return
gr.hide grille
gr.color 255,0,0,0,1    % black ant.
t1 =clock() : tick =0 : phero =0
DO
 FOR a=1 TO ants
  ! si elle n'existe pas (n'a pas de pointeur graphique): on la crée et on la place sur le nid bien sûr...
  if !ant[a,ptr]
    gr.circle ant[a,ptr], (NestX-0.5)*ec, ec+(NestY-0.5)*ec, 8
    ant[a,eta] =1
  endif
  
  if ant[a,npc]=ant[a,nps]     % nbre de 'pas' atteind => elle est pratiquement sur un point...
     ! définir le point apt$ sur lequel est la fourmis...
     gr.get.position ant[a,ptr], fx,fy : px =int(fx/ec)+1 : py =int(fy/ec) : apt$ =v$(px,py)
     gr.modify ant[a,ptr], "x", (px-0.5)*ec, "y", ec+(py-0.5)*ec    % place la fourmis exactement sur le point.
     if len(ant$[a])
       dseg = val(right$(ant$[a],2)) : i =is_in(apt$,seg$[dseg])
       if i=1 then dpt$ =right$(seg$[dseg],2) else dpt$ =left$(seg$[dseg],2)    % point de départ du segment
     else
       dpt$ ="--"
     endif
      
     ! si le point est le nid on efface son parcours mémorisé.
     if px=NestX & py=NestY then ant$[a] ="" : ant[a,eta] =1 : gr.modify ant[a,ptr], "alpha", 255
      
     ! si le point est la nourriture on change son etat ( ant[a,eta] =2 )
     if px=FoodX & py=FoodY then ant[a,eta] =2 : gr.modify ant[a,ptr], "alpha", 80
     
     if ant[a,eta] =1        % searching food
      ! choisir un segment partant de ce point...  c'est là que tout se passe !!!!!
      !   chercher tous les segments qui contiennent ce point
      !   en choisir 1 (sauf celui d'ou on vient) qui a le plus de phéromones ou au hasard.
      
       GOSUB antChoice     % donne sgc = n° du segment choisi.

       if IS_IN(apt$,seg$[sgc])=1 then npt$ =right$(seg$[sgc],2) else npt$ =left$(seg$[sgc],2)  % l'autre point du segment
       ant$[a]+=right$(int$(100+sgc),2)   %  mémorise le n° du segment choisi dans ant$[a].
      
     elseif ant[a,eta] =2    % coming back to the nest and deposit pheromones.
      !   prend le dernier segment de son parcours mémorisé et dépose des phéromones sur ce segment.
       sgc  =val(right$(ant$[a],2))
       if is_in(apt$,seg$[sgc])=1 then npt$ =right$(seg$[sgc],2) else npt$ =left$(seg$[sgc],2)  % l'autre point du segment

       ant$[a] =left$(ant$[a],len(ant$[a])-2)   %  on supprime ce segment de son parcours mémorisé.

       if seg[sgc,phe]<253 then seg[sgc,phe]+=1 : gr.modify seg[sgc,ptr], "alpha", seg[sgc,phe]  % increase phero.
      
     endif
     
    !  calcule l'incrément ixx,iyy pour ce segment... et le nombre de 'pas' nécessaire pour le parcourrir.
     dx  =(v(apt$,1)-0.5)*ec : dy =(v(apt$,2)+0.5)*ec   % point de départ du segment en pixels
     ax  =(v(npt$,1)-0.5)*ec : ay =(v(npt$,2)+0.5)*ec   % point d'arrivée du segment     "     
     d   =HYPOT((ax-dx),(ay-dy))      % distance en pixels
     an  =ACOS((ax-dx)/d)             % angle
     ant[a,ixx] =pas*cos(an)
     ant[a,iyy] =pas*sin(an)
     if dy>ay then ant[a,iyy] =-ant[a,iyy]
     ant[a,nps] =int(d/pas)    % n'arrivera pas forcément exactement sur le point...!
     ant[a,npc] =0
     
  else
  !   elle avance sur son segment
    GR.MOVE ant[a,ptr], ant[a,ixx], ant[a,iyy]
    ant[a,npc]++    % incrémente le nbre de pas depuis le point de départ du segment.

  endif
   
  gr.touch tch, x,y       %  to stop the simulator
  if tch
    x/=sx : y/=sy : xx =int(x/ec)+1 : yy =int(y/ec) : by =hex(mid$("122446688AACCEE",yy,1))
    if xx>22 & by=12 then gr.modify actb, "y", 10+by*ec : action =6 : popup " Stop the simulator " : f_n.break
  endif
  
 NEXT
 
  tick++
  if clock()-t1>1000
    gr.modify mess, "text", "Ants : "+int$(ants)+"      Pheromone evaporation rate : "+int$(tphe)+"         ( "+int$(tick)+" fps )"
    tick =0 : t1 =clock()
  endif

  phero++         % maybe here to find the good way to decrease segments pheromones...
  if phero>=tphe     % ???  best 5  ?  depend of the number of ants ?
    for s=1 to nseg
      if seg[s,phe]>16 then seg[s,phe]-=1 : gr.modify seg[s,ptr], "alpha", seg[s,phe]
    next
    phero =0
  endif

  GR.RENDER
  
UNTIL action =6   % stop
gr.show grille
return

antChoice:    % depuis un point apt$
sgs$ ="" : vphe =0
for s=1 to nseg
  if IS_IN(apt$,seg$[s]) & !IS_IN(dpt$,seg$[s])   % tous les segments qui contiennent ce point, sauf le point d'oú elle vient...
    if seg[s,phe]>vphe
      sgs$ =right$(int$(100+s),2)+" " : vphe =seg[s,phe]
    elseif seg[s,phe]=vphe            % et qui contiennent le + de phéromones...
      sgs$+=right$(int$(100+s),2)+" "
    endif
  endif
next
lc  =len(sgs$)/3
if lc then sgc =val(word$(sgs$,int(rnd()*lc)+1))   % n° d'un segment choisit au hasard parmis les segments sélectionnés.
return

makeBmp:
gr.set.stroke 2
gr.color 255, 190, 190, 190, 1 : ec =50
gr.bitmap.create fond, 22*ec, 15*ec   % un seul bitmap pour la grille de points.
gr.bitmap.drawinto.start fond
for y=1 to 15 : for x=1 to 22 : gr.circle nul, (x-0.5)*ec, (y-0.5)*ec, 6 : next : next
gr.bitmap.create act,150,60     % le creux gris du bouton appuyé.
gr.bitmap.drawinto.start act
gr.color 255, 240,240,240,1
RRect(0,0, 20, 150,60, 1)
gr.bitmap.drawinto.end
return

init:    % init the graph & all arrays
array.fill seg[],0 : array.fill ant$[],"" : array.fill ant[],0
gr.cls
gr.set.stroke 2
gr.bitmap.draw grille, fond,0,ec

gr.set.stroke 1
gr.color 255,220,240,240,1
RRect(22*ec-4,2*ec-4, 35, 178, 3.5*ec+14, 1)
RRect(22*ec-4,6*ec-4, 35, 178, 5.5*ec+14, 1)
RRect(22*ec-4,12*ec-4, 35, 178, 3.5*ec+14, 1)

gr.color 255, 220,220,220,1         % buttons
for b=1 to 7 : RRect(22*ec,2*b*ec, 30, 170,80, 1) : next

gr.bitmap.draw actb, act, 22*ec+10, action*2*ec+10    % actual button selected.

gr.text.size 42 : gr.text.align 2     % buttons text.
gr.color 255,0,150,255,2
for b=1 to 7
  gr.text.draw nul, 23.7*ec, 4+((2*b)+1)*ec, word$("Ants Phero. Graph Nest Food Stop Start",b)
next

gr.color 255,0,180,255,0            %  small blue circle cursor for graph construction.
gr.circle curs, 0.5*ec, 1.5*ec, 12 : gr.hide curs

gr.color 255,255,162,0,1            %  orange Nest
gr.circle nest, 1.5*ec, 1.5*ec, 14

gr.color 255,156,254,142,1          %  green Food
gr.circle food, 2.5*ec, 1.5*ec, 14

gr.text.size 22 : gr.text.align 1 : gr.color 255,0,50,255,1
gr.text.draw mess, ec, ec-10, ""

gr.set.stroke 2 : gr.text.size 44 : gr.color 255,255,168,0,2 : gr.text.underline 1
gr.text.draw nul, scx-500, 48, "Ants  System  Simulator"
gr.text.underline 0

if start then GOSUB LoadGraph    %  last graph drawing if exists
return

GraphDraw:
gr.color 15,255,0,0,2 : gr.set.stroke 12
for s=1 to nseg
  dx =v(left$(seg$[s],2),1)  : dy =v(left$(seg$[s],2),2)
  ax =v(right$(seg$[s],2),1) : ay =v(right$(seg$[s],2),2)
  gr.line seg[s,ptr], (dx-0.5)*ec, ec+(dy-0.5)*ec, (ax-0.5)*ec, ec+(ay-0.5)*ec : seg[s,phe] =15
next
gr.color 255
gr.modify nest, "x", (NestX-0.5)*ec, "y", ec+(NestY-0.5)*ec : LastPtr( nest )
gr.modify food, "x", (FoodX-0.5)*ec, "y", ec+(FoodY-0.5)*ec : LastPtr( food )
return

SaveGraph:
array.length ns, seg$[]
if ns
  cls : graph$ =""
  for s=1 to ns
    if len(seg$[s]) then graph$+=seg$[s]+" "
  next
  if len(graph$) then ?v$(NestX,NestY)+v$(FoodX,FoodY)+" "+graph$ : Console.save path$+filename$ : cls
endif
return

LoadGraph:
File.exists fe, path$+filename$
if fe
  grabfile graph$, path$+filename$
  split sg$[], graph$
  array.length ns, sg$[] : nseg =ns-1 : tns =ns-1
  NestX =v(left$(sg$[1],2),1)  : NestY =v(left$(sg$[1],2),2)
  FoodX =v(right$(sg$[1],2),1) : FoodY =v(right$(sg$[1],2),2)
  for s=2 to ns : seg$[s-1] =sg$[s] : next
  array.delete sg$[]
  GOSUB GraphDraw
endif
return