[bb] 3D fileexplorer by OJay [ 1+ years ago ]

Started by BlitzBot, June 29, 2017, 00:28:38

Previous topic - Next topic

BlitzBot

Title : 3D fileexplorer
Author : OJay
Posted : 1+ years ago

Description : this is a simple 3D fileexplorer i found some time ago in the codearchives. however, i couldn't found it anymore so i repost this now.

original author unknown. if it was you, tell us!


Code :
Code (blitzbasic) Select
; 3D File-Explorer

Graphics3D 640,480,16,2
SetBuffer BackBuffer()

Global gw#=GraphicsWidth()
Global gh#=GraphicsHeight()
MoveMouse gw/2,gh/2

cam=CreateCamera()
Global uni=CreateSphere(7,cam)
MoveEntity cam,0,2,-6
li=CreateLight()
RotateEntity li,80,30,30
ScaleEntity uni,100,100,100
FlipMesh uni
EntityOrder uni,1
texname$="space.jpg"
If FileType(texname$)=0
unitex=CreateTexture(128,128)
SetBuffer TextureBuffer(unitex)
For i=0 To 10000
  Color Rand(255), Rand(255), Rand(255)
  Plot  Rand(128), Rand(128)
Next
SetBuffer BackBuffer()
Else
unitex=LoadTexture(texname$)
EndIf
EntityTexture uni,unitex

Global fls#=25000 ;max 25000 Files in one Folder
Dim fb_icon(fls),fb_name$(fls),fb_type(fls),fb_tex(fls),fb_sel(fls)

Global rheight#=4 ; x space between icons
Global rwidth#=5  ; y space between icons
Global fperline#=3 ; number of icon columns

Global iconw#=2.0 ; icon scaling
Global iconh#=1.0
Global icond#=.5
Global stexx#=1.0 ; texure scaling
Global stexy#=2.0
ClearTextureFilters

font=LoadFont("Tahoma",17)
SetFont font


mx100#=(gw/2)*.9
my100#=(gh/2)*.9
Global camxi#=5
Global camyi#=0
Global camzi#=-9.2
Global camx#=camxi#
Global camy#=camyi#
Global camz#=camzi#

RefreshDir()

; -------------------------------------------MAIN-------------------------------------------
While KeyDown(1)=0
mx#=MouseX()
my#=MouseY()

If my<my100
  If camy<1
   sty#=((my100-my)/150)^2
   camy=camy+sty
   If camy>1 Then camy=1
  EndIf
EndIf
If my>gh-my100
  If camy>(0-(Floor(fls/fperline)*rheight))
   sty#=((my100-(gh-my))/150)^2
   camy=camy-sty
   If camy<(0-(Floor(fls/fperline)*rheight)) Then camy=(0-(Floor(fls/fperline)*rheight))
  EndIf
EndIf

If mx>gw-mx100
  If camx<(fperline)*rwidth
   stx#=(mx100-(gw-mx))/500
   camx=camx+stx
   If camx>(fperline)*rwidth Then camx=(fperline)*rwidth
  EndIf
EndIf
If mx<mx100
  If camx>-rwidth
   stx#=(mx100-mx)/500
   camx=camx-stx
   If camx<-rwidth Then camx=-rwidth
  EndIf
EndIf

If MouseHit(1)
  oldmhitt=mhitt
  mhitt=MilliSecs()
  If (mhitt-oldmhitt)<300 Then
   ; -----------------------------is dooubleclick!
   p=CameraPick(cam,mx,my)
   If p<>0
    picked_i=-1
    For i=0 To fls
     If fb_icon(i)=p
      picked_i=i
      Exit
     EndIf
    Next
    If picked_i>-1
    For roro=0 To 1000
     dx#=(EntityX(fb_icon(picked_i),1)-EntityX(cam))/10.0;-EntityX(cam)
     dy#=(EntityY(fb_icon(picked_i),1)-EntityY(cam))/10.0;-EntityY(cam)
     dz#=(EntityZ(fb_icon(picked_i),1)-EntityZ(cam))/10.0;-EntityZ(cam)
     PositionEntity cam,EntityX(cam,1)+dx,EntityY(cam,1)+dy,EntityZ(cam,1)+dz,1
     TurnEntity uni,.1,.1,.1
     RenderWorld()
     PathInfo()
     Flip
     If dx<.1 And dy<.1 And dz<.1 Then Exit
    Next
    placebo=CopyEntity(fb_icon(picked_i))
;    FreeEntity fb_icon(picked_i)
    If fb_type(picked_i)=2
     ChangeDir(fb_name$(picked_i))
    EndIf
    EntityParent placebo,cam
    camx#=camxi#
    camy#=camyi#
    camz#=camzi#
    MoveMouse gw/2,gh/2
    PositionEntity cam,camx,camy,camz,1
   
    If Instr(fb_name$(picked_i),".")<>0 And fb_name$(picked_i)<>".." And fb_type(picked_i)=1
     ; check Media Type and probably do something (some examples)
     ext$=Right$(fb_name$(picked_i), Len(fb_name$(picked_i))-Instr(fb_name$(picked_i),"."))
;Print
;Color 255,0,0
;     Print ext$
;     WaitKey()
     Select Upper$(ext$)
      Case "TXT"
       ExecFile "notepad.exe "+fb_name$(picked_i)
      Case "EXE"
       ExecFile fb_name$(picked_i)
      Case "HTM",".HTML"
       ExecFile fb_name$(picked_i)
      Case "BB"
       ExecFile fb_name$(picked_i)
     End Select
    EndIf

    RemoveAll()
    RefreshDir()


    For al#=1.0 To 0.0 Step -.05
     EntityAlpha placebo,al#
     TurnEntity uni,.1,.1,.1
     RenderWorld()
     PathInfo()
     Flip
    Next
    FreeEntity placebo
    EndIf
   EndIf    
   Goto done
  Else
   ; -----------------------------is single click
   p=CameraPick(cam,mx,my)
   If p<>0
    picked_i=-1
    For i=0 To fls
     If fb_icon(i)=p
      picked_i=i
      Exit
     EndIf
    Next
    If picked_i>-1
     For i=0 To fls
      If fb_sel(i)<>0
       If i<>picked_i
        fb_sel(i)=0
        EntityColor fb_icon(i),255,255,255
       EndIf
      EndIf
     Next
     fb_sel(picked_i)=fb_sel(picked_i)Xor 1
     If fb_sel(picked_i)=1
      EntityColor fb_icon(picked_i),75,75,255
     Else
      EntityColor fb_icon(picked_i),255,255,255
     EndIf
    EndIf
   EndIf
  EndIf
  .done
EndIf


If KeyDown(200)
  camz=camz+.1
EndIf
If KeyDown(208)
  camz=camz-.1
EndIf
PositionEntity cam,camx,camy,camz,1
TurnEntity uni,.1,.1,.1
RenderWorld()
PathInfo()
Flip
Wend
;--------------------------------------------eo main ------------------------------------

End

Function RefreshDir()


; Define what folder to start with ...
folder$=CurrentDir$()
myDir=ReadDir(folder$)
fls=0
Repeat
fb_name$(fls)=NextFile$(myDir)
If fb_name$(fls)<>"."
  If fb_name$(fls)="" Then Exit
   folder2$=folder$
   If Right$(folder2$,1)<>""
    folder2$=folder2$+""
   EndIf
   If FileType(folder2$+fb_name$(fls)) = 2 Then
    fb_type(fls)=2
   Else
    fb_type(fls)=1
   End If
  fls=fls+1
EndIf
Forever
CloseDir myDir
fls=fls-1





;fls#=Rand(10,100)
;Dim fb_icon(fls),fb_name$(fls),fb_type(fls),fb_tex(fls),fb_sel(fls)

For i=0 To fls
fb_icon(i)=CreateCube()
y=Floor(i/fperline)
x=i-(y*fperline)
PositionEntity fb_icon(i),x*rwidth,-(y*rheight),0
fb_tex(i)=CreateTexture(128,128)
SetBuffer TextureBuffer(fb_tex(i))
If fb_type(i)=2
  Color 127,127,0
  Rect 0,0,256,256,1
Else
  Color 127,127,127
  Rect 0,0,256,256,1
EndIf
If StringWidth(fb_name$(i))<=126
Color 255,255,255
Text 64,0,fb_name$(i),1,0
Color 0,0,0
Text 65,1,fb_name$(i),1,0
Else
lin$=""
wchar=1
ycount=0
While wchar<=Len(fb_name$(i))
  While StringWidth(lin$)<=122 And wchar<=Len(fb_name$(i))
   lin$=lin$+Mid$(fb_name$(i),wchar,1)
   wchar=wchar+1
  Wend
  If wchar<Len(fb_name$(i))
   lin$=Left$(lin$,Len(lin$)-1)
   wchar=wchar-1
  EndIf
  Color 255,255,255
  Text 64,0+ycount*StringHeight(fb_name$(i)),lin$,1,0
  Color 0,0,0
  Text 65,1+ycount*StringHeight(fb_name$(i)),lin$,1,0
  lin$=""
  ycount=ycount+1
Wend
EndIf
SetBuffer BackBuffer()
ScaleTexture fb_tex(i),stexx,stexy
EntityTexture fb_icon(i),fb_tex(i)
EntityPickMode fb_icon(i),2
ScaleEntity fb_icon(i),iconw,iconh,icond
EntityFX fb_icon(i),16
fb_sel(i)=0
Next

End Function

Function RemoveAll()
For i=0 To fls
  FreeEntity fb_icon(i)
  FreeTexture fb_tex(i)
Next
End Function

Function PathInfo()
Color 127,127,127
Text 0,0,CurrentDir$()
Color 255,255,255
Text 1,1,CurrentDir$()
End Function


Comments :


John Blackledge(Posted 1+ years ago)

 I really like this!


degac(Posted 1+ years ago)

 never seen before! incredible!thanks for re-posting...a milestone I think


Perturbatio(Posted 1+ years ago)

 Just a thought, if it was there before but it isn't now, that could be because they never wanted it declared as public domain.


big10p(Posted 1+ years ago)

 Dunno. There's been a few peeps who have left in a huff and taken all there code arc entries with them. This entry is nice but hardly rocket science.


OJay(Posted 1+ years ago)

 <div class="quote"> ...because they never wanted it declared as public domain. </div>then he/she/it could have left a comment in the source...but there isn't. its really the original code, i haven't changed or deleted even one line...be that as it may i've posted it just because someone asked about something like that.so, just sit back and enjoy :)


Blitzplotter(Posted 1+ years ago)

 A very good example of how powerful Blitz is.  I have been a fan of Blitz since it's initial development on the Amiga.  Well done to Mark Sibly and his team.


jfk EO-11110(Posted 1+ years ago)

 It was me. Posted on a german Blitz forum some years ago (blitzforum.de). Their forum then crashed fulminantely one day and the entire content including their code archive was lost. OJay, remember? (I was named "norc").It's ok, use it.


Ked(Posted 1+ years ago)

 Really cool... I once tried to make a 2D version something similar to this but it went horribly wrong....


Blitz3dCoder(Posted 1+ years ago)

 THIS IS SWEET!


Danny(Posted 1+ years ago)

 iPhone eat your heart out! LOL :D


Darkseid2.0(Posted 1+ years ago)

 With a little more development, this could become a new trend in file browsing. I love this it's awesome beyond belief.


Guy Fawkes(Posted 1+ years ago)

 It's already happened. Lol. It's called Three.js :P