LB Booster
« bluatigro termites »

Welcome Guest. Please Login or Register.
Apr 1st, 2018, 03:28am



ATTENTION MEMBERS: Conforums will be closing it doors and discontinuing its service on April 15, 2018.
We apologize Conforums does not have any export functions to migrate data.
Ad-Free has been deactivated. Outstanding Ad-Free credits will be reimbursed to respective payment methods.

Thank you Conforums members.
Speed up Liberty BASIC programs by up to ten times!
Compile Liberty BASIC programs to compact, standalone executables!
Overcome many of Liberty BASIC's bugs and limitations!
LB Booster Resources
LB Booster documentation
LB Booster Home Page
LB Booster technical Wiki
Just BASIC forum
BBC BASIC Home Page
Liberty BASIC forum (the original)

« Previous Topic | Next Topic »
Pages: 1  Notify Send Topic Print
 thread  Author  Topic: bluatigro termites  (Read 223 times)
tsh73
Full Member
ImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 210
xx bluatigro termites
« Thread started on: May 5th, 2017, 6:28pm »

somewhat sped-up,
and somewhat udapted for being faster in LBB
Code:
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy , qt , qw
winx = 400'WindowWidth
winy = 300'WindowHeight
'winx = WindowWidth/1.1
'winy = WindowHeight/1.1

qt = 30 '100
qw = 300    '1000
dim t.x( qt ) , t.y( qt ) , t.st( qt ) , t.dir( qt )
dim w.x( qw ) , w.y( qw )
nomainwin
open "termites" for graphics as #m
  #m "trapclose [quit]"
  #m "size 5"
  #m "font 50 bold"
  for t = 0 to qt
    t.x( t ) = rnd( 0 ) * winx
    t.y( t ) = rnd( 0 ) * winy
    t.dir( t ) = rnd( 0 ) * atn( 1 ) * 8
'    print t,   t.dir( t )
  next t
  for t = 0 to qw
    w.x( t ) = rnd( 0 ) * winx
    w.y( t ) = rnd( 0 ) * winy
  next t
  #m "backcolor black"
    #m "down"

  for tijd = 0 to 10000
    #m "discard"  
    #m "color yellow"
    #m "fill black"
    #m "place 0 50"
    #m  "\ " ; tijd
    s$=""
    for w = 0 to qt
      s$= s$;";"; "set ";int(t.x(w));" ";int(t.y(w))
      '#m "set ";int(t.x(w));" ";int(t.y(w))
    next w
    #m mid$(s$,2)
    #m "color blue"

    s$=""
    for w = 0 to qw
      s$= s$;";"; "set ";int(w.x(w));" ";int(w.y(w))
      '#m "set ";int(w.x(w));" ";int(w.y(w))
    next w
    #m mid$(s$,2)
    
    for t = 0 to qt
    SCAN
      dx = 4
      dy = 0
      t.dir( t ) = t.dir( t ) + rnd( 0 ) - .5
      'call rotate dx , dy , t.dir( t )
      dx = 4 * cos(t.dir( t ))
      dy = 4 * sin(t.dir( t ))

'print t, dx , dy , t.dir( t )
      t.y( t ) = t.y( t ) + dy
      t.x( t ) = t.x( t ) + dx

      if t.x( t ) < 0 then t.x( t ) = winx
      if t.x( t ) > winx then t.x( t ) = 0
      if t.y( t ) < 0 then t.y( t ) = winy
      if t.y( t ) > winy then t.y( t ) = 0

      if t.st( t ) then
        w.x( t.st( t ) ) = t.x( t ) + dx
        w.y( t.st( t ) ) = t.y( t ) + dy
        t.st( t ) = 0
        t.dir( t ) = t.dir( t ) + atn( 1 ) * 4
      else
        hit = 0
        for w = 1 to qw
'if dist( t.x(t) , t.y(t) , w.x(w) , w.y(w) ) < 5 then
if abs( t.x(t) - w.x(w) ) + abs( t.y(t) - w.y(w) ) < 5 then
            hit = w
            exit for
end if
        next w
        if hit then t.st( t ) = hit
      end if
    next t
  next tijd
wait
[quit]
  close #m
end

sub rotate byref k , byref l , r
  s = sin( r )
  c = cos( r )
  hk = k * c - l * s
  hl = k * s + l * c
  k = hk
  l = hl
end sub

function dist( a , b , c , d )
  scan
  dist = abs( a - c ) + abs( b - d )
end function 
User IP Logged

Pages: 1  Notify Send Topic Print
« Previous Topic | Next Topic »

| |

This forum powered for FREE by Conforums ©
Terms of Service | Privacy Policy | Conforums Support | Parental Controls