a*

Vragen en suggesties over het programmeren van spelletjes, sprites en dergelijke in Liberty BASIC

Moderator: anthonio

a*

Berichtdoor bluatigro » do dec 15, 2011 1:59 pm

met dit a* algoritme
hoef je n NPC alleen te vertellen waar t heen moet
en t zoek zelf de weg

de code heeft nog een error :
de gevonden weg is niet altijd de kortste
Code: Selecteer alles

WindowWidth  = DisplayWidth
WindowHeight = DisplayHeight

nomainwin

global maxx , maxy , source , target , cut$ , o$ , c$ , nx , ny
global false , true , pi , sorted , show

maxx  = 10
maxy  = 10
cut$  = "|"
false = 0
true  = not( false ) ' or ANY NON-ZERO value
pi    = atn( 1 ) * 4
sorted = false 'sort lookat-cels on distance target
show = true  'show red seartch patern
''                        parent
dim maze( maxx * maxy + 10 ) , p( maxx * maxy + 10 )

for y = 0 to 10
  read q$
  for x = 1 to len( q$ )
    a =val( mid$( q$ , x , 1 ) )
    if a = 2 then source = index( x , y )
    if a = 3 then target = index( x , y )
    maze( index( x , y ) ) = a
  next x
next y

data "1111111111"
data "1........1"
data "1........1"
data "1...111..1"
data "1...1....1"
data "1.2.1..3.1"
data "1...1....1"
data "1..11....1"
data "1........1"
data "1........1"
data "1111111111"

open "A*" for graphics_nsb as #m

  #m "trapclose [quit]"
  #m "goto 120 100 ; down ; fill cyan"
  for i = 1 to maxx
    for j = 0 to maxy
      call point i , j , maze( index( i , j ) )
    next j
  next i

  #m "flush"

  ny = int( source / maxx )
  nx = source - ny * maxx
  o$ = push$( o$ , str$( source ) , 0 )
  ty = int( target / maxx )
  tx = source - ty * maxx

  while o$ <>"" and now <>target
    tel = 0
    for q = 0 to 7 / 4 * pi step pi / 4
      now     = index( nx , ny )
      lookat  = index( nx + sign( sin( q ) ) , ny + sign( cos( q ) ) )
      if maze( lookat ) <> 1 _
      and not( element( c$ , str$( lookat ) ) ) _
      and not( element( o$ , str$( lookat ) ) ) then
        if p( lookat ) = 0 then p( lookat )  = now
        mem( tel ) = lookat
        ly = int( lookat / maxx )
        lx = lookat - ly * maxx
        af( tel ) = sqr( ( lx - tx ) ^ 2 + ( ly - ty ) ^ 2 )

        if lookat = target then now = target '<< this line has no efect why ?
        tel = tel + 1
        if show then
          t$ = time$()
          while t$ = time$()
          wend
          call point lx , ly , 5
        end if
        if not( sorted ) then
            o$ = push$( o$, str$( lookat ) , false )
        end if
      end if
    next q
    if sorted then
      for h = 0 to tel - 1
        for l = 1 to h - 1
          if af( h ) > af( l ) then
            q = af( h )
            af( h ) = af( l )
            af( l ) = q
            q = mem( h )
            mem( h ) = mem( l )
            mem( l ) = q
          end if
        next l
      next h
      if tel > 0 then
        for i = 0 to tel - 1
          o$ = push$( o$ , str$( mem( i ) ) , false )
        next i
      end if
    end if
    c$   = push$( c$ , str$( now ) , true )
    o$   = pop$( o$ )
    now  = val( top$( o$ ) )
    ny   = int( now / maxx )
    nx   = now - ny * maxx

    scan

  wend

  if o$ = "" then
    notice "No path found !!"
  else
    t =target
    while t <> source
      t = p( t )
      ny = int( t / maxx )
      nx = t -ny * maxx
      call point nx , ny , 4
    wend
  end if

wait

sub point x , y , no
  select case no
    case 1
      '#m "color darkred"
      #m "backcolor darkred"
    case 2
      '#m "color blue"
      #m "backcolor blue"
    case 3
      '#m "color green"
      #m "backcolor green"
    case 4
      '#m "color yellow"
      #m "backcolor yellow"
    case 5
      #m "backcolor red"
    case else
      '#m "color black"
      #m "backcolor darkgray"
  end select

  #m "place " ; x * 40 + 100 ; " " ; y * 40 + 100

  select case no
    case 4
      #m "circlefilled 7"
    case 5
      #m "circlefilled 10"
    case else
      #m "circlefilled 20"
  end select

end sub

[quit]
  close #m
end

function sign( x )
  sign = 0
  if x < 0 then sign = -1
  if x > 0 then sign = 1
end function

function index( x , y )
  index = x + y * maxx
end function

''                                 stack stuff
function push$( stack$ , object$ , l )
''store object$ on left side stack
  if l <> 0 then '   <<<<<<<<<<<<<<<<<<<<,,
    push$ = object$ + cut$ + stack$
  else
    'push$ =stack$ +object$ +cut$
    push$ = stack$ + cut$ + object$    '   <<<<<<<<<<<<<<<<
  end if
end function

function pop$( stack$ )
''delete last object$
  i = instr( stack$ , cut$ )
  if stack$ = "" then pop$ = ""
''get right side of stack
  pop$ = mid$( stack$ , i + 1 , len( stack$ ) -i )
end function

function top$( stack$)
''read last object$
  i = instr( stack$ , cut$ )
  if stack$ = "" then
    top$ = ""
  else
    top$ = mid$( stack$ , 1 , i - 1 ) '   <<<<<<<<
  end if
end function

function element( stack$ , e$ )
  fl = 0
  i  = 1
  do
    jf$ = word$( stack$ , i , cut$ )
    if jf$ = e$ then fl = true
    i = i + 1
  loop until jf$ = ""
  element = fl
end function

'function element( stack$, e$)
 ' fl =0
 ' i  =1
 ' while val( word$( stack$, i, cut$)) <>0
    'if word$( stack$, i ) =e$ then f1 =not( 0)
'    if word$( stack$, i ) =e$ then fl =not( 0)
'    i =i +1
'  wend
'  element =fl
'end function
bluatigro
 
Berichten: 306
Geregistreerd: za sep 27, 2008 6:01 pm

Keer terug naar Games

Wie is er online

Gebruikers op dit forum: Geen geregistreerde gebruikers. en 1 gast

cron