Graphics Fun 2

[Rod]

Blah.. mazes and AI... sometimes some mindless fun is just as entertaining. To get the best from this move your mouse slowly round the screen and from time to time towards the lead ball.


   nomainwin
   WindowWidth=DisplayWidth
   WindowHeight=DisplayHeight
   graphicbox #1.g 0,0,DisplayWidth,DisplayHeight
   open "" for window_popup as #1
   #1.g "when characterInput [key] ; setfocus"
   #1.g "when mouseMove [mouse]"


   ' make sprites
   #1.g "down ; backcolor white ; color white"
   #1.g "place 0 0 ; boxfilled 64 64"
   #1.g "place 32 32 ; size 2"

   #1.g "backcolor black ; circlefilled 32"

   for m= 1 to 100
       'random 24 bit color choice
       r=int(rnd(0)*256)
       g=int(rnd(0)*256)
       b=int(rnd(0)*256)
       'color fades from centre but not to 0
       rr=r/300
       gg=g/300
       bb=b/300

       #1.g "size 1"
       #1.g "backcolor black ; color black"
       #1.g "place 0 64 ; boxfilled 64 128"
       #1.g "place 32 96 ; size 2"
       'draw an ever increasing circle with decreasing color
       for n= 8 to 255
           #1.g "color ";r;" ";g;" ";b
           #1.g "circle ";n/8
           r=r-rr
           g=g-gg
           b=b-bb
       next n
       #1.g "getbmp b";m;" 0 0 64 128"
       #1.g "addsprite s";m;" b";m
   next

   #1.g "fill black"
   #1.g "getbmp bg 0 0 600 600"
   #1.g "background bg"

   'position 100 sprites
   dim starPos(100, 5) 'x,y,dx,dy,dz
   x=1
   y=2
   dx=3
   dy=4
   dz=5
   #1.g "home ; posxy midX midY"
   midX=midX-32
   midY=midY-32
   for n = 1 to 100
       starPos(n,x)=midX
       starPos(n,y)=midY
       starPos(n,z)=100
       starPos(n,dx)=20-rnd(0)*80+20
       starPos(n,dy)=10-rnd(0)*40+10
       starPos(n,dz)=rnd(0)*10+2
   next




   xdelta=rnd(0)*4
   ydelta=rnd(0)*4

   degreex=180
   degreey=270

   d=DisplayHeight/3

   [draw]
       scan
       #1.g "drawsprites"

       xx=Int((sin(degreex/57.29577951)*d)+midX)
       degreex=degreex+xdelta
       if degreex>359 then degreex=0 : xdelta=rnd(0)*4

       yy=Int((sin(degreey/57.29577951)*d)+midY)
       degreey=degreey+ydelta
       if degreey>359 then degreey=0 : ydelta=rnd(0)*4

       'move the sprites
       for n=1 to 100
           starPos(n,x)=starPos(n,x)+starPos(n,dx)+(XX-starPos(n,x))/10
           starPos(n,y)=starPos(n,y)+starPos(n,dy)+(YY-starPos(n,y))/10
           starPos(n,z)=starPos(n,z)+starPos(n,dz)
           'start the sprite again if it is over the limit
           if starPos(n,z)>200 then
               starPos(n,x)=xx
               starPos(n,y)=yy
               starPos(n,z)=100
               starPos(n,dx)=20-rnd(0)*80+20
               starPos(n,dy)=10-rnd(0)*40+10
               starPos(n,dz)=rnd(0)*10+2
           end if

           'scale the sprites, takes time!
           #1.g "spritescale s";n;" ";starPos(n,z)
           #1.g "spritexy s";n;" ";starPos(n,x);" ";starPos(n,y)
       next
   goto [draw]

   [mouse]
   XX=MouseX
   YY=MouseY
   goto [draw]


   [key]
   'drop to quit

   [quit]
   timer 0
   close #1
   end



[plus]

What is old is new again, specially if fun!
''Mouse school critter attract or repell.txt for JB 2.0 B+ 2018-04-26

'from: star mouse chaser.bas 01 - back to JB
'from: star mouse chaser.bas for SmallBASIC 0.12.0 2015-11-09 MGA/B+
'from: code is based on code: mouse chaser by tsh73
'for the Just Basic contest, November 2008, I am 7 years late
'AND Combined with
'Arrow test.txt for Just Basic v1.01 [B+=MGA] 2017-05-09
' Thanks to STxAxTIC at QB64 for method to separate particles
' Give critters constant radius

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

WindowWidth = xmax + 8
WindowHeight = ymax + 32
UpperLeftX = 100
UpperLeftY = 40
Open "Mouse school -       left click mouse to toggle mouse as predator / attractor" 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 blue"
#g "color yellow"

na = 30
dim x(na), y(na), v(na), r(na)
for i = 1 to na
   x(i) = rand(0, xmax)
   y(i) = rand(0, ymax)
   v(i) = rand(5, 20)
   r(i) = rand(5, 20)
next
predatorMode = 0
while 1
   scan
   #g "cls"
   #g "fill blue"
   if predatorMode then
       #g "color brown"
       #g "backcolor darkred"
   else
       #g "color white"
       #g "backcolor green"
   end if
   #g "place ";mx;" ";my;"; circlefilled ";40
   for i = 1 to na
       'radian angle to mouse
       ra = atan2(my - y(i), mx - x(i)) '  + pi kind of interesting too
       'draw it
       call critter x(i), y(i), ra, r(i)

       'separate critters for next frame and further down i line
       FOR j = i + 1 TO na
           scan

           ' 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 < 10 + 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 < 10 + r(i) +r(j)
                   scan
                   flub = 10 '  massively increased for JB to speed up code

                   x(j) = x(j) + flub * nx
                   y(j) = y(j) + flub * ny

                   x(i) = x(i) - flub * nx
                   y(i) = y(i) - flub * 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
       next
       if predatorMode then
           x(i) = x(i) +  v(i) * cos(ra+pi)
           y(i) = y(i) +  v(i) * sin(ra+pi)
       else
           x(i) = x(i) +  v(i) * cos(ra)
           y(i) = y(i) +  v(i) * sin(ra)
       end if
   next
   #g "flush"
   call pause 100
wend
wait

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

sub quit H$
   close #H$
   end
end sub

sub lButtonUp H$, mx, my  'must have handle and mouse x,y
   if predatorMode then predatorMode = 0 else predatorMode = 1
end sub

sub charIn H$, c$
   call quit H$
end sub

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

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

sub critter x, y, ra, s
   #g "color black"
   #g "backcolor darkgreen"
   #g "place ";x;" ";y;"; circlefilled ";s
   if predatorMode then
       x1 = x + .75*s * cos(ra - pi/9 + pi)
       y1 = y + .75*s * sin(ra - pi/9 + pi)
       x2 = x + .75*s * cos(ra + pi/9 + pi)
       y2 = y + .75*s * sin(ra + pi/9 + pi)
   else
       x1 = x + .75*s * cos(ra - pi/9)
       y1 = y + .75*s * sin(ra - pi/9)
       x2 = x + .75*s * cos(ra + pi/9)
       y2 = y + .75*s * sin(ra + pi/9)
   end if
   #g "color white"
   #g "backcolor white"
   #g "place ";x1;" ";y1;"; circlefilled ";.25*s
   #g "place ";x2;" ";y2;"; circlefilled ";.25*s
   if predatorMode then
       x3 = x1 + .125 * s * cos(ra + pi)
       y3 = y1 + .125 * s * sin(ra + pi)
       x4 = x2 + .125 * s * cos(ra + pi)
       y4 = y2 + .125 * s * sin(ra + pi)
   else
       x3 = x1 + .125 * s * cos(ra)
       y3 = y1 + .125 * s * sin(ra)
       x4 = x2 + .125 * s * cos(ra)
       y4 = y2 + .125 * s * sin(ra)
   end if
   #g "color black"
   #g "backcolor black"
   #g "place ";x3;" ";y3;"; circlefilled ";.125*s
   #g "place ";x4;" ";y4;"; circlefilled ";.125*s
end sub

sub arrow x0, y0, rAngle, distance
   x2 = x0 - .1 * distance * cos(rAngle - .25 * pi)
   y2 = y0 - .1 * distance * sin(rAngle - .25 * pi)
   #g "line ";x0;" ";y0;" ";x2;" ";y2
   x2 = x0 - .1 * distance * cos(rAngle + .25 * pi)
   y2 = y0 - .1 * distance * sin(rAngle + .25 * pi)
   #g "line ";x0;" ";y0;" ";x2;" ";y2
   x2 = x0 - distance * cos(rAngle)
   y2 = y0 - distance * sin(rAngle)
   #g "line ";x0;" ";y0;" ";x2;" ";y2
   for i = .8 * distance to distance step 3
       x1 = x0 - i * cos(rAngle)
       y1 = y0 - i * sin(rAngle)
       x2 = x1 - .1 * distance * cos(rAngle - .25 * pi)
       y2 = y1 - .1 * distance * sin(rAngle - .25 * pi)
       #g "line ";x1;" ";y1;" ";x2;" ";y2
       x2 = x1 - .1 * distance * cos(rAngle + .25 * pi)
       y2 = y1 - .1 * distance * sin(rAngle + .25 * pi)
       #g "line ";x1;" ";y1;" ";x2;" ";y2
   next
end sub

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
End Function

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

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


[code]

Both verry nice! Thx for sharing!
Regards,
code

[tsh73]

mousey things make me feel warm inside :))