Rem Project: Magnetic Field Simulator by Ric
 
set display mode 1024,768,32
load dll "User32.dll",1
color backdrop 0
autocam off
sync on
position camera 0,0,-80
 
menuspritepriority=200
global menucapacity
menucapacity=20
sw#=screen width()
sh#=screen height()
 
global dim handlename$(1000) `menu()
global firstmenuitem$ `menu()
global lastmenuitem$ `menu()
global systementityseed `gethandlenumber(),free_system_entity()
global menuactive `menu_select:, hide_menu_items(), create_entity: - 1 if any menu is dropped down
global menubar
global cloudimage
global menuspritepriority
global dim word$(menucapacity,menucapacity,menucapacity) `menu() used for storing menu items and hierarchy
global width# `menu() sets size of menu items - also used in menu_select: for pick values.
global height#
 
gosub make_frame
gosub make_menu_bar
 menudata$="File(New,Exit),Magnets(Add magnet,Strength A(1,2,3,4,5,6,7,8),Strength B(1 ,2 ,3 ,4 ,5 ,6 ,7 ,8 ),Rotate magnet(Right mousebutton),Remove magnet),Filings(Amount(250,500,1000,1500,2000),Length( 1, 2, 3, 4),Movement on,Movement off,Rescatter),Help(Controls,About)"
 makemenu(menudata$)
 
type filingtype
  x as float
  y as float
  velocityx as float
  velocityy as float
endtype
 
filingimage=freeimage()
create bitmap 1,20,20
ink -1,0
for n=1 to 20
x=rnd(10)
y=rnd(20)
line x,y,x+rnd(8)+2,y+rnd(4)-2
next n
get image filingimage,0,0,20,20
delete bitmap 1
 
filing=1000
numberoffilings=1000
gosub make_filings
 
magnettexture=freeimage()
create bitmap 1,20,6
ink rgb(255,0,0),0
box 0,0,10,6
ink rgb(0,0,255),0
box 10,0,20,6
get image magnettexture,0,0,20,6
delete bitmap 1
 
magnet=free_object()
make object plain magnet,20,6
texture object magnet,magnettexture
set object light magnet,0
position object magnet,0,0,-0.5
disable object zdepth magnet
strength#=1
 
magnet2=free_object()
make object plain magnet2,20,6
texture object magnet2,magnettexture
set object light magnet2,0
position object magnet2,20,0,-0.5
disable object zdepth magnet2
hide object magnet2
strength2#=0
 
 
 
do
 
if mouseclick()=1 then gosub menu_select
 
gosub move_magnets
 
gosub rotate_and_move
 
sync
loop
 
function free_object()
 
  repeat
    inc n
  until object exist(n)=0
 
endfunction n
 
function get_bearing(x1#,y1#,x2#,y2#)
ang#=atanfull((x2#-x1#),(y2#-y1#))
endfunction ang#
 
function get_distance(x1#,y1#,x2#,y2#)
distance#=sqrt(((x2#-x1#)^2)+((y2#-y1#)^2))
endfunction distance#
 
function get_resultant_alignment(rforce#,rdirection#,aforce#,adirection#,rforce2#,rdirection2#,aforce2#,adirection2#)
 
xcomponentr#=rforce#*cos(rdirection#)
ycomponentr#=rforce#*sin(rdirection#)
xcomponenta#=aforce#*cos(adirection#)
ycomponenta#=aforce#*sin(adirection#)
 
xcomponentr2#=rforce2#*cos(rdirection2#)
ycomponentr2#=rforce2#*sin(rdirection2#)
xcomponenta2#=aforce2#*cos(adirection2#)
ycomponenta2#=aforce2#*sin(adirection2#)
 
xresultant#=xcomponentr#+xcomponenta#+xcomponentr2#+xcomponenta2#
yresultant#=ycomponentr#+ycomponenta#+ycomponentr2#+ycomponenta2#
 
resultantangle#=atanfull(xresultant#,yresultant#)
 
endfunction resultantangle#
 
function get_force_x(rforce#,rdirection#,aforce#,adirection#,rforce2#,rdirection2#,aforce2#,adirection2#)
 
xcomponentr#=rforce#*sin(rdirection#)
xcomponenta#=aforce#*sin(adirection#)
 
xcomponentr2#=rforce2#*sin(rdirection2#)
xcomponenta2#=aforce2#*sin(adirection2#)
 
xresultant#=xcomponentr#+xcomponenta#+xcomponentr2#+xcomponenta2#
 
 
endfunction xresultant#
 
function get_force_y(rforce#,rdirection#,aforce#,adirection#,rforce2#,rdirection2#,aforce2#,adirection2#)
 
ycomponentr#=rforce#*cos(rdirection#)
ycomponenta#=aforce#*cos(adirection#)
 
ycomponentr2#=rforce2#*cos(rdirection2#)
ycomponenta2#=aforce2#*cos(adirection2#)
 
yresultant#=ycomponentr#+ycomponenta#+ycomponentr2#+ycomponenta2#
 
 
endfunction yresultant#
 
function freeobject()
   repeat
      inc n
   until object exist(n) = 0
endfunction n
 
function freeimage()
   repeat
      inc n
   until image exist(n) = 0 and sprite exist(n)=0
endfunction n
 
function pick_system_sprite(lower,upper,spritewidth,spriteheight)
`used for system sprites where size is not stored
for spritenumber=lower to upper
if spritenumber>0
if sprite exist(spritenumber)
  if sprite visible(spritenumber)
    if mousex()>=sprite x(spritenumber) and mousex()<=sprite x(spritenumber)+spritewidth and mousey()>=sprite y(spritenumber) and mousey()<=sprite y(spritenumber)+spriteheight
      `if sprite priority(spritenumber)>highestpriority
         `highestpriority=sprite priority(spritenumber)
         picked=spritenumber
      `endif
    endif
  endif
endif
endif
next spritenumber
 
endfunction picked
 
function free_sprite()
 
repeat
inc n
until image exist(n)=0 and sprite exist(n)=0
 
endfunction n
 
make_filings:
 
`make new filings
dim filing(filing+2000) as filingtype
for n=filing to filing+2000
if object exist(n)=0
  make object plain n,4,0.5
  texture object n,filingimage
  position object n,rnd(140)-70,rnd(110)-55,0
  filing(n).x=object position x(n)
  filing(n).y=object position y(n)
  rotate object n,0,0,rnd(360)
  set object light n,0
  ghost object on n,0
  hide object n
  exclude object on n
 
endif
next n
 
gosub update_number_of_filings
 
return
 
adjust_filing_length:
 
for n=filing to filing+2000
 
  scale object n,(filinglength#/2.0)*100,100,100
 
next n
 
return
 
rescatter_filings:
 
for n=filing to filing+2000
  `exclude object off n
  position object n,rnd(140)-70,rnd(110)-55,0
  filing(n).x=object position x(n)
  filing(n).y=object position y(n)
  filing(n).velocityx=0
  filing(n).velocityy=0
  rotate object n,0,0,rnd(360)
  `exclude object on n
next n
 
return
 
rotate_and_move:
`rotate and move filings
for n=filing to filing+numberoffilings-1
`determine resultant vector for North pole of filing:
 
`get bearings away from North poles of magnets (repulsion)
repulsionbearing#=get_bearing(filing(n).x,filing(n).y,magnetnorthx#,magnetnorthy#)
repulsionbearing2#=get_bearing(filing(n).x,filing(n).y,magnet2northx#,magnet2northy#)
 
`get distances from N Poles of magnets
repulsiondistance#=get_distance(filing(n).x,filing(n).y,magnetnorthx#,magnetnorthy#)
repulsiondistance2#=get_distance(filing(n).x,filing(n).y,magnet2northx#,magnet2northy#)
 
`calculate magnetic forces away from N poles
`(inverse square law)
repulsionforce#=-strength#/repulsiondistance#^2
repulsionforce2#=-strength2#/repulsiondistance2#^2
 
`get bearings towards South poles of magnets (attraction)
attractionbearing#=get_bearing(filing(n).x,filing(n).y,magnetsouthx#,magnetsouthy#)
attractionbearing2#=get_bearing(filing(n).x,filing(n).y,magnet2southx#,magnet2southy#)
 
 
`get distances from S Poles of magnets
attractiondistance#=get_distance(filing(n).x,filing(n).y,magnetsouthx#,magnetsouthy#)
attractiondistance2#=get_distance(filing(n).x,filing(n).y,magnet2southx#,magnet2southy#)
 
 
`calculate magnetic forces towards S poles of magnets
attractionforce#=strength#/attractiondistance#^2
attractionforce2#=strength2#/attractiondistance2#^2
 
`calculate the resultant alignment of filing
resultantalignment#=get_resultant_alignment(repulsionforce#,repulsionbearing#,attractionforce#,attractionbearing#,repulsionforce2#,repulsionbearing2#,attractionforce2#,attractionbearing2#)
 
`rotate filing accordingly
rotate object n,0,0,resultantalignment#
 
if movementon=1
 
`calculate the resultant direction of movement of filing
`(this is different from the alignment, as all forces causing movement are attractive)
`resultantdirection#=get_resultant_alignment(-repulsionforce#,repulsionbearing#,attractionforce#,attractionbearing#,-repulsionforce2#,repulsionbearing2#,attractionforce2#,attractionbearing2#)
 
`calculate resultant attractive force on filing
forcex#=get_force_x(-repulsionforce#,repulsionbearing#,attractionforce#,attractionbearing#,-repulsionforce2#,repulsionbearing2#,attractionforce2#,attractionbearing2#)
forcey#=get_force_y(-repulsionforce#,repulsionbearing#,attractionforce#,attractionbearing#,-repulsionforce2#,repulsionbearing2#,attractionforce2#,attractionbearing2#)
 
if resetspeeds=1
  filing(n).velocityx=0
  filing(n).velocityy=0
endif
 
`calculate velocity of filing
inc filing(n).velocityx,forcex#
inc filing(n).velocityy,forcey#
 
if filing(n).velocityx>.3 then filing(n).velocityx=.3
if filing(n).velocityy>.3 then filing(n).velocityy=.3
if filing(n).velocityx<-.3 then filing(n).velocityx=-.3
if filing(n).velocityy<-.3 then filing(n).velocityy=-.3
 
 
`if attractiondistance#<5 or repulsiondistance#<5
  `filing(n).velocityx=0
  `filing(n).velocityy=0
`endif
 
`if strength2#>0
 ` if attractiondistance2#<5 or repulsiondistance2#<5
  `  filing(n).velocityx=0
  `  filing(n).velocityy=0
 ` endif
`endif
 
`move filing
 
inc filing(n).x,filing(n).velocityx
inc filing(n).y,filing(n).velocityy
 
if attractiondistance#<5 or repulsiondistance#<5
  dec filing(n).x,filing(n).velocityx
  dec filing(n).y,filing(n).velocityy
endif
 
if strength2#>0
  if attractiondistance2#<5 or repulsiondistance2#<5
    dec filing(n).x,filing(n).velocityx
    dec filing(n).y,filing(n).velocityy
  endif
endif
 
position object n,filing(n).x,filing(n).y,0
 
endif `(if movementon=1)
 
next n
 
resetspeeds=0
 
return
 
update_number_of_filings:
 
`update number of filings
for n=filing to filing+numberoffilings-1
if object exist(n)=1
  show object n
  exclude object off n
endif
next n
 
for n=filing+numberoffilings to filing+2000
if object exist(n)=1
  hide object n
  exclude object on n
endif
next n
 
return
 
make_frame:
 
create bitmap 1,1,2
ink -1,0
dot 0,0
ink rgb(100,100,100),0
dot 0,1
frametop=free_sprite()
get image frametop,0,0,1,2
delete bitmap 1
sprite frametop,0,0,frametop
size sprite frametop,sw#,2
 
create bitmap 1,1,2
ink -1,0
dot 0,1
ink rgb(100,100,100),0
dot 0,0
framebottom=free_sprite()
get image framebottom,0,0,1,2
delete bitmap 1
sprite framebottom,0,sh#-2,framebottom
size sprite framebottom,sw#,2
 
create bitmap 1,2,1
ink rgb(180,180,180),0
dot 0,0
ink rgb(100,100,100),0
dot 1,0
frameleft=free_sprite()
get image frameleft,0,0,2,1
delete bitmap 1
sprite frameleft,0,0,frameleft
size sprite frameleft,2,sh#
 
frameright=free_sprite()
sprite frameright,sw#-2,0,frameleft
size sprite frameright,2,sh#
 
 
 
 
return
 
 
 
make_menu_bar:
 
 `make menu
  menubar=free_sprite()
 
  create bitmap 1,28,28
    for n=0 to 28
    grey=255-(n*5)
    ink rgb(grey,grey,grey),0
    line 0,n,28,n
    next n
    get image menubar,0,0,28,28
  delete bitmap 1
 
  sprite menubar,0,2,menubar
  size sprite menubar,sw#,sh#*28/768.0
 
 return
 
move_magnets:
`allow magnet to be dragged with mouse
if mouseclick()=1 and picked=0
  pick=pick object(mousex(),mousey(),magnet,magnet2)
  if pick>0 then picked=1
endif
 
if picked=1
    pick screen mousex(),mousey(),100
    x#=get pick vector x()
    y#=get pick vector y()
    position object pick,camera position x()+x#,camera position y()+y#,0
endif
if picked=1 and mouseclick()=0 then picked=0
 
`allow magnet to be rotated with mouse
if mouseclick()=2 and rpicked=0
  rpick=pick object(mousex(),mousey(),magnet,magnet2)
  if rpick>0 then rpicked=1:mx#=mousex()
endif
 
if rpicked=1
    rotate object rpick,0,0,object angle z(rpick)+mx#-mousex()
    mx#=mousex()
endif
if rpicked=1 and mouseclick()=0 then rpicked=0
 
 
 
 
`store coordinates of N ans S pole of magnet
magnetnorthx#=object position x(magnet)-0.4*(object size x(magnet))*cos(object angle z(magnet))
magnetnorthy#=object position y(magnet)-0.4*(object size x(magnet))*sin(object angle z(magnet))
magnetsouthx#=object position x(magnet)+0.4*(object size x(magnet))*cos(object angle z(magnet))
magnetsouthy#=object position y(magnet)+0.4*(object size x(magnet))*sin(object angle z(magnet))
 
`determine coordinates of N ans S pole of magnet2
magnet2northx#=object position x(magnet2)-0.4*(object size x(magnet2))*cos(object angle z(magnet2))
magnet2northy#=object position y(magnet2)-0.4*(object size x(magnet2))*sin(object angle z(magnet2))
magnet2southx#=object position x(magnet2)+0.4*(object size x(magnet2))*cos(object angle z(magnet2))
magnet2southy#=object position y(magnet2)+0.4*(object size x(magnet2))*sin(object angle z(magnet2))
 
 
return
 
 
menu_select:
 
if mouseclick()=1
  menuitem=pick_system_sprite(gethandlenumber(firstmenuitem$),gethandlenumber(lastmenuitem$),width#,height#) `width and height defined in menu()
endif
if menuitem=0 and menuactive=1 then  hide_menu_items() `hides any menus if mouse clicked off the menu, and only if any menus are open
if menuitem>0 `if some menu item is clicked
menuactive=1 `1 if any menu is dropped down
 
  for x=1 to menucapacity `cycle through each menu item
  for y=0 to menucapacity
  for z=0 to menucapacity
 
  if gethandlenumber(word$(x,y,z))=menuitem `if the one tested for is the one clicked on, then do the following series of checks
    menuhandle$=word$(x,y,z)
 
    `process menu clicks here:
      `eg: if menuhandle$="open" then .......
      if menuhandle$="250" then numberoffilings=250:gosub update_number_of_filings
      if menuhandle$="500" then numberoffilings=500:gosub update_number_of_filings
      if menuhandle$="1000" then numberoffilings=1000:gosub update_number_of_filings
      if menuhandle$="1500" then numberoffilings=1500:gosub update_number_of_filings
      if menuhandle$="2000" then numberoffilings=2000:gosub update_number_of_filings
      if menuhandle$="Exit" then end
      if menuhandle$="New"
        hide object magnet2
        position object magnet2,20,0,-0.5
        rotate object magnet2,0,0,0
        strength2#=0
        strength1#=1
        position object magnet,0,0,-0.5
        rotate object magnet,0,0,0
        numberoffilings=1000
        gosub update_number_of_filings
        gosub rescatter_filings
        filinglength#=2
        gosub adjust_filing_length
      endif
      if menuhandle$=" 1" then filinglength#=1:gosub adjust_filing_length
      if menuhandle$=" 2" then filinglength#=2:gosub adjust_filing_length
      if menuhandle$=" 3" then filinglength#=3:gosub adjust_filing_length
      if menuhandle$=" 4" then filinglength#=4:gosub adjust_filing_length
      if menuhandle$="Rescatter" then gosub rescatter_filings
      if menuhandle$="Add magnet" then show object magnet2:strength2#=1
      if menuhandle$="Remove magnet" then hide object magnet2:strength2#=0
      if menuhandle$="1" then strength#=1
      if menuhandle$="2" then strength#=2
      if menuhandle$="3" then strength#=3
      if menuhandle$="4" then strength#=4
      if menuhandle$="5" then strength#=5
      if menuhandle$="6" then strength#=6
      if menuhandle$="7" then strength#=7
      if menuhandle$="8" then strength#=8
      if menuhandle$="1 " then strength2#=1
      if menuhandle$="2 " then strength2#=2
      if menuhandle$="3 " then strength2#=3
      if menuhandle$="4 " then strength2#=4
      if menuhandle$="5 " then strength2#=5
      if menuhandle$="6 " then strength2#=6
      if menuhandle$="7 " then strength2#=7
      if menuhandle$="8 " then strength2#=8
      if menuhandle$="Movement on" then movementon=1:resetspeeds=1
      if menuhandle$="Movement off" then movementon=0
      if menuhandle$="Controls" then call dll 1,"MessageBoxA",0,"Left mouse click and drag: Move magnet.  Right mouse click and drag: Rotate magnet.","Controls",1
      if menuhandle$="About" then call dll 1,"MessageBoxA",0,"Magnetic Field Simulator by Ric.","About",1
 
 
 
 
    if y=0
      hide_menu_items()
      for n=1 to menucapacity
        if sprite exist(gethandlenumber(word$(x,n,0))) then show sprite gethandlenumber(word$(x,n,0)):menuactive=1  `if top level selected then show second level
      next n
    endif
    if y>0 and z=0
      hide_menu_items()
      thirdlevelpresent=0
      for p=1 to menucapacity
        if sprite exist(gethandlenumber(word$(x,y,z+p)))
          show sprite gethandlenumber(word$(x,y,z+p)):menuactive=1 `show third level if selected.
        endif
        if word$(x,y,z+p)<>"" then thirdlevelpresent=1
      next p
      if thirdlevelpresent=1
        for n=1 to menucapacity
          if sprite exist(gethandlenumber(word$(x,n,0))) then show sprite gethandlenumber(word$(x,n,0)):menuactive=1 `if second level selected, then show second level .....
        next n
      endif
    endif
    if z>0 then hide_menu_items()
  endif
 
  next z
  next y
  next x
endif
 
return
 
function gethandlenumber(name$)
`globals used: systementityseed, menucapacity, handlename$(...)
number=systementityseed
repeat
  inc number
  if number>systementityseed+menucapacity*10 then exit `note: - if a match isn't found, the function will return the number 101
until handlename$(number)=name$
 
endfunction number
 
function hide_menu_items
 
`hide all menu sprites
for n=gethandlenumber(firstmenuitem$) to gethandlenumber(lastmenuitem$)
  if sprite exist(n) then hide sprite n
next n
 
`show top level (x=1) sprites
for x=1 to menucapacity
  if sprite exist(gethandlenumber(word$(x,0,0))) then show sprite gethandlenumber(word$(x,0,0))
next n
 
menuactive=0
 
endfunction
 
function makemenu(data$)
`globals used: firstmenuitem$, lastmenuitem$, handlename$(), word$(), width#, height#
 
 
length=len(data$)
 
x=1
for test=1 to length
 
    character$=right$(left$(data$,test),1)
    nonletter=0
    if character$<>"("
    if character$<>","
    if character$<>")"
    nonletter=1
    endif
    endif
    endif
 
    if nonletter=1
      word$=word$+character$
    else
      if character$="," and oldcharacter$=")"
        `do nothing
      else
        word$(x,y,z)=word$:word$=""
      endif
      if character$="("
        inc bracket
        if bracket>oldbracket and bracket=1 then inc y
        if bracket>oldbracket and bracket=2 then inc z
      endif
      if character$=")"
        dec bracket
        if bracket=0 then y=0:z=0
        if bracket=1 then z=0
      endif
      if character$=","
        if bracket=0 then inc x
        if bracket=1 then inc y
        if bracket=2 then inc z
      endif
    endif
    oldbracket=bracket
    oldcharacter$=character$
 
  next test
 
width#=80
height#=28
 
 
for x=0 to menucapacity
for y=0 to menucapacity
for z=0 to menucapacity
 
text$=word$(x,y,z)
`if len(text$)>0
if text$<>""
 
  `length=len(word$(x,y,z))
  length=len(text$)
  `store name of first menu item for pick range later on
 
  lastmenuitem$=text$ `store name of last menu item for pick range later on
  if firsttimethrough=0
    firstmenuitem$=text$
    firsttimethrough=1
  endif
  `create the graphic for the menu item
  create bitmap 1,screen width(),screen height()
  ink rgb(255,255,255),0
  box 0,0,width#,height#
  ink rgb(100,100,100),0
  box 1,1,width#,height#
  ink rgb(224,223,227),0
  box 1,1,width#-1,height#-1
  temp=free_sprite()
  sprite temp,500,500,menubar
  size sprite temp,width#-2,height#-2
  paste sprite temp,1,1
  ink rgb(100,100,100),0
  set text font "arial"
  set text size 14
  text width#/2.0-text width(text$)/2,height#/2.0-text height(text$)/2.0,text$
  `create the sprite
  handlenumber=free_sprite()
  `store the name of the sprite as a string - use gethandlenumber("name") to return the sprite number
  handlename$(handlenumber)=word$(x,y,z)
  get image handlenumber,0,0,width#,height#,1
  delete sprite temp
  delete bitmap 1
 
  if z<2 then sprite handlenumber,(x*width#)-width#+z*width#,y*height#+2,handlenumber
  if z>=2 then sprite handlenumber,(x*width#)-width#+1*width#,y*height#+(z-1)*height#+2,handlenumber
  if y>0 then hide sprite handlenumber
  set sprite priority handlenumber,menuspritepriority  `causes massive slow down when number is too high.  Needed to ensure menu items appear on top of other sprites.  Suggest updating as number of sprites increases.
 
endif
 
next z
next y
next x
 
endfunction