Crap! Wrong file type! It's in BlitzMax!!!
Code archives/Graphics/zoomable clickable scrollable starfield!
This code has been declared by its author to be Public Domain code.
Download source code
| Here's some code from someone in the forums (I spaced on who posted it originally) and the Chris Camacho added the clickability. OK this lets you plot some objects, scroll around with the arrow keys, soom with either the mousewheel or the "+" or "-" keys on the NUMPAD. When you click, the object lights up in yellow. |
SuperStrict Global objList:TList=CreateList() Graphics 640,480 Global theZoomFactor:Float=1.0 Global oldZoomFactor:Float=0.0 For Local i:Int=1 To 5 Local o:obj=New obj o.x=Rand(-GraphicsWidth(),GraphicsWidth()) o.y=Rand(-GraphicsHeight(),GraphicsHeight()) Next Global youX:Float,youY:Float Global line:Int While KeyHit(KEY_ESCAPE)=0 Cls line=50 If KeyDown(KEY_NUMADD) Then theZoomFactor:+0.01 If KeyDown(KEY_NUMSUBTRACT) Then theZoomFactor:-0.01 ' If theZoomFactor<0.1 Then theZoomFactor=0.1 ' If theZoomFactor>4 Then theZoomFactor=4 If KeyDown(KEY_UP) Then youY:-1.0*theZoomFactor If KeyDown(KEY_DOWN) Then youY:+1.0*theZoomFactor If KeyDown(KEY_LEFT) Then youX:-1.0*theZoomFactor If KeyDown(KEY_RIGHT) Then youX:+1.0*theZoomFactor If MouseZ() And oldZoomFactor<>MouseZ() If oldZoomFactor<MouseZ() theZoomFactor:+0.1 Else theZoomFactor:-0.1 EndIf If theZoomFactor>4.0 theZoomFactor=4.0 End If If theZoomFactor<0.2 theZoomFactor=0.2 End If oldZoomFactor=MouseZ() EndIf SetColor 255,255,255;DrawText theZoomFactor,0,0 updateObjs(MouseDown(1)) SetColor 0,255,0 DrawRect (GraphicsWidth()/2)-3,(GraphicsHeight()/2)-3,7*theZoomFactor,7*theZoomFactor SetColor 255,255,255;DrawText theZoomFactor,0,0 DrawText "Press +/- on the numpad to zoom. Cursors to move",0,10 Flip Wend End Type obj Field x:Int Field y:Int Field dist:Float Method New() ListAddLast(objList,Self); End Method Method Update() Local dx:Int=(youX*theZoomFactor)-GraphicsWidth()/2 'here you have forgotten the scalefactor Local dy:Int=(youY*theZoomFactor)-GraphicsHeight()/2 'here you have forgotten the scalefactor SetScale 1,1 SetColor 255,0,0 If dist<50*thezoomfactor Then SetColor 255,255,0 DrawRect Int((x*theZoomFactor-3)-dx),Int((y*theZoomFactor-3)-dy),Int(7*theZoomFactor),Int(7*theZoomFactor) DrawText dist,10,line line:+20 End Method End Type Function updateObjs(checkmouse:Int) Local mx:Float=MouseX() Local my:Float=MouseY() Local dx:Int=(youX*theZoomFactor)-GraphicsWidth()/2 Local dy:Int=(youY*theZoomFactor)-GraphicsHeight()/2 For Local i:obj=EachIn objList i.Update() If checkmouse Then Local xdiff:Float,ydiff:Float xdiff=(mx)-(i.x*thezoomfactor-dx) ydiff=(my)-(i.y*thezoomfactor-dy) i.dist=Sqr((xdiff*xdiff)+(ydiff*ydiff)) Else i.dist=1000 endif Next End Function |
Comments
thanks this is great!
Crap! Wrong file type! It's in BlitzMax!!!
A good excuse for a B3D version.
I'll wait here.
ok, here is a translation to blitz3d.
;zoomable clickable scrollable starfield!, in blitz3d Graphics 640,480,0,2 Global theZoomFactor#=1.0,oldZoomFactor#=0.0 For i=1 To 5 o.obj=New obj o\x=Rand(-GraphicsWidth(),GraphicsWidth()) o\y=Rand(-GraphicsHeight(),GraphicsHeight()) Next Global youX#,youY# Global lineInt While KeyHit(1)=0 ;KEY_ESCAPE Cls lineInt=50 If KeyDown(78) Then theZoomFactor=theZoomFactor+0.01 ;KEY_NUMADD If KeyDown(74) Then theZoomFactor=theZoomFactor-0.01 ;KEY_NUMSUBTRACT ; If theZoomFactor<0.1 Then theZoomFactor=0.1 ; If theZoomFactor>4 Then theZoomFactor=4 If KeyDown(200) Then youY=youY-1.0*theZoomFactor ;KEY_UP If KeyDown(208) Then youY=youY+1.0*theZoomFactor ;KEY_DOWN If KeyDown(203) Then youX=youX-1.0*theZoomFactor ;KEY_LEFT If KeyDown(205) Then youX=youX+1.0*theZoomFactor ;KEY_RIGHT If MouseZ() And oldZoomFactor<>MouseZ() If oldZoomFactor<MouseZ() theZoomFactor=theZoomFactor+0.1 Else theZoomFactor=theZoomFactor-0.1 EndIf If theZoomFactor>4.0 theZoomFactor=4.0 End If If theZoomFactor<0.2 theZoomFactor=0.2 End If oldZoomFactor=MouseZ() EndIf Color 255,255,255:Text 0,0,theZoomFactor updateObjs(MouseDown(1)) Color 0,255,0 Rect (GraphicsWidth()/2)-3,(GraphicsHeight()/2)-3,7*theZoomFactor,7*theZoomFactor Color 255,255,255:Text 0,0,theZoomFactor Text 0,10,"Press +/- on the numpad to zoom. Cursors to move" Flip Wend End Type obj Field x Field y Field dist# End Type Function Update(x,y,dist#) Local dx=(youX*theZoomFactor)-GraphicsWidth()/2 ;here you have forgotten the scalefactor Local dy=(youY*theZoomFactor)-GraphicsHeight()/2 ;here you have forgotten the scalefactor ;SetScale 1,1 Color 255,0,0 If dist<50*theZoomFactor Then Color 255,255,0 Rect ((x*theZoomFactor-3)-dx),((y*theZoomFactor-3)-dy),(7*theZoomFactor),(7*theZoomFactor) Text 10,lineInt,dist lineInt=lineInt+20 End Function Function updateObjs(checkmouse) Local mx#=MouseX() Local my#=MouseY() Local dx=(youX*theZoomFactor)-GraphicsWidth()/2 Local dy=(youY*theZoomFactor)-GraphicsHeight()/2 Local xdiff#,ydiff# For i.obj=Each obj Update(i\x,i\y,i\dist#) If checkmouse Then xdiff=(mx)-(i\x*theZoomFactor-dx) ydiff=(my)-(i\y*theZoomFactor-dy) i\dist=Sqr((xdiff*xdiff)+(ydiff*ydiff)) Else i\dist=1000 EndIf Next End Function
Why not change the code above, and post the max one in a new showcase? :)
Dare I say it, erm it's a bit naff...
hehe. yeah it is a bit. i didn't know that until i had translated it. if you increase the scroll speed and number of clickable dots it might be better.