Challenge:
Winner?:
No
Code Snippet:
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(Use right mousebutton),Remove magnet),Filings(Amount(250,500,1000,1500,2000),Length( 1, 2, 3, 4),Rescatter),Help(Controls,About)" makemenu(menudata$) type filingtype x as float y 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 `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 `determine 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)) `rotate 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 direction of filing resultantdirection#=get_resultant_direction(repulsionforce#,repulsionbearing#,attractionforce#,attractionbearing#,repulsionforce2#,repulsionbearing2#,attractionforce2#,attractionbearing2#) `rotate filing accordingly rotate object n,0,0,resultantdirection# next n 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_direction(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 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) rotate object n,0,0,rnd(360) `exclude object on n next n 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 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$="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