PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Updated: Explore OFF 3d models

https://www.purebasic.fr/english/viewtopic.php?t=48036

Page 1 of 1

Updated: Explore OFF 3d models

Posted: Mon Oct 31, 2011 4:12 am
by einander
Explore OFF 3d models
Updated with Danilo's corrections.

Removed ProgressBar and BlockInput_(), now useless thanks to Danilo super fast loading.
Added node rotations, light and double sliders to better coloring.

Tested only with Windows.
To try with Mac or Linux, comment the procedure RGBrequester() and the menu option CameraBackColor
;-------------------------------------
This project uses the plain ObjectFileFormat, without color and extra information.
OFF is a older polygonal model format used in the 3D viewing program Geomview

Colors can be modified; to plain white, move all the sliders to 255. Colors can be useful te see more details on the models.

The princeton.edu benchmark contains 1,814 free 3D models to download
http://shape.cs.princeton.edu/benchmark/

Here is a single model (dragon face.off) to fast download and try:
http://www.mediafire.com/download.php?u0fns79lyphh4kb

The Princeton database have lots of good models; many of them are very complex an well constructed.

Have fun

Code: Select all

;Load and DisPlay 3d Models ".OFF"  Files
;by einander
;Corrected and improved by Danilo
;
;PB 4.60 RC2
;Enabled Keys:
;   4 Arrows
;   F1 To F8
;   + (Near), - (Far)
;   Insert  , PageUp
;   Delete  , PageDown
;   Home    , End
;
EnableExplicit
Enumeration
  #Load
  #Save
  #Texture
  #Wireframe
  #Plot
  #Multicolor
  #CameraBackColor
  #LightPoint
  #LightDirectional
  #LightSpot
  #Quit
EndEnumeration
;
#DGRAY=$464646
#No=#PB_Ignore    
#ZBLUE=$FF9933
#BKRGB=$121212
#White=$FFFFFF
#Red=$FF
#Green=$FF00
;
Structure L3
  L1.L
  L2.L
  L3.L
EndStructure
;
Structure HighLow
  HiPos.I
  LoPos.I
  HiVal.I
  LoVal.I
EndStructure 
;
Structure Pos  :  X.L  :  Y.L  :  Wi.L  :  He.L  : EndStructure
;
Structure Dslid
  CG.I
  HiCanv.I
  LoCanv.I
  HiVal.I
  LoVal.I
  Link.I
  Po.Pos
  Min.I   
  Max.I   
  SlidRGB.I    
  BkRGB.I 
  Radius.I
  HiInfo.I
  LoInfo.I
EndStructure
;
ExamineDesktops()
Global _MyFont8=FontID(LoadFont(-1,"arial",8,#PB_Font_HighQuality))
Global _X.L=DesktopWidth(0) ,_Y.L=DesktopHeight(0),_Drawing
Global _BkRGB=0,_CamSpeed = 1,_MMk
Global _CamerabackColor=0,_Random=0,_File$
Global Dim __ReqRGB(15)  ; starting Colors for RGBRequester() 
Global Dim _Ds.DSlid(5)
Define I,EntityX.D,EntityY.D,EntityZ.D
Define EV,KeyX.D, KeyY.D, Keyz.D,wTitle$
Define X,Y,Wi,He,Menu1,RGB,Oldmy
For I=0 To 15
  __ReqRGB(I) = Random(#White)
Next
InitKeyboard()
InitEngine3D()
InitSprite()
Define Wi,He, Ev,BtnReset,X,SlidRGB,Gad,Index,TV,LV,OldT,OldL
Global Dim _Ds.DSlid(2)
;
Macro GadgetBottom(Gad)  :  GadgetY(Gad)+GadgetHeight(Gad)  : EndMacro 
;
Macro MMx  :  WindowMouseX(EventWindow())  : EndMacro
;
Macro MMy  :  WindowMouseY(EventWindow())  : EndMacro
; 
Macro CheckMMk()  
  If EventType() = #PB_EventType_LeftButtonDown Or (EventType() = #PB_EventType_MouseMove And GetGadgetAttribute(EventGadget(), #PB_Canvas_Buttons) & #PB_Canvas_LeftButton)
    _MMk=1 
  Else
    _MMk=0
  EndIf  
EndMacro
;
;
Macro StopDraw  ;- StopDraw
  If _DrawING :StopDrawing() :_DrawING=0 :EndIf
EndMacro
;
Macro DrawCanvas(Canvas)
  StopDraw
  _Drawing=StartDrawing(CanvasOutput(Canvas))
EndMacro
;
Macro DrawTexture(Texture)
  StopDraw
  _Drawing=StartDrawing(TextureOutput(Texture))
EndMacro
;
Procedure Lim(A,B,C)
  If A<B :ProcedureReturn B
  ElseIf A>C :ProcedureReturn C
  EndIf
  ProcedureReturn A
EndProcedure     
;
Procedure R3(A,B,C,D,Value) ; IN: Value btw a and b  - OUT proportion btw c and d
  If B=A:ProcedureReturn 0:EndIf
  Define E.D=(D-C)/(B-A)
  ProcedureReturn C+E*(Value-A)
EndProcedure 
;
Procedure InitDSlid(Index,X,Y,Wi,He,Min,Max,BkRGB,SlidRGB,Lo=-1,Hi=-1)
  Protected W3.F=Wi/3,W4=Wi/4
  With _Ds(Index) 
    If Lo=-1:Lo=Min:EndIf
    If Hi=-1:Hi=Max:EndIf
    \Po\X=X     : \Po\Y=Y
    \Po\Wi=Wi   : \Po\He=He
    \Min=Min    : \Max=Max
    \LoVal=Lo   : \HiVal=Hi
    \BkRGB=BkRGB
    \SlidRGB=SlidRGB 
    \Radius=Wi/2-1
    \CG=ContainerGadget(#PB_Any,X-1,Y-1,Wi+2,He+2,#PB_Container_Flat)
      SetGadgetColor(\CG,#PB_Gadget_BackColor,BkRGB)
      ;
      \HiCanv=CanvasGadget(#PB_Any,1, R3(\Min,\Max,0,\Po\He-\PO\Wi*2,\Max-Hi),Wi,Wi)    
      SetGadgetData(\HiCanv,Index+1)
      DrawCanvas(\HiCanv)
      Box(0,0,\Po\Wi,\Po\Wi,BkRGB)
      Circle(\Radius,\Radius,\Radius+1,#Dgray)
      Circle(\Radius,\Radius,\Radius,SlidRGB)
      ;
      \LoCanv=CanvasGadget(#PB_Any,1,R3(\Min,\Max,\Po\Wi,\Po\He-\Po\Wi,\Max-Lo),Wi,Wi)
      SetGadgetData(\LoCanv,-(Index+1))
      DrawCanvas(\LoCanv)
      Box(0,0,\Po\Wi,\Po\Wi,BkRGB)
      Circle(\Radius,\Radius,\Radius+1,#DGray)
      Circle(\Radius,\Radius,\Radius,SlidRGB)
      ;
      \Link=CanvasGadget(#PB_Any,W3,GadgetY(\HiCanv)+\Radius,Wi-W3*2,GadgetY(\LoCanv)-GadgetY(\HiCanv))
      DrawCanvas(\Link)
      Box(0,0,GadgetWidth(\Link),GadgetHeight(\Link),SlidRGB)
    CloseGadgetList()  
    \HiInfo=TextGadget(#PB_Any,GadgetX(\CG),Gadgetbottom(\CG),Wi+2,Wi,Str(Hi))
    \LoInfo=TextGadget(#PB_Any,GadgetX(\CG),Gadgetbottom(\Hiinfo),Wi+2,Wi,Str(Lo))  
    SetGadgetColor(\HiInfo,#PB_Gadget_FrontColor,#White)
    SetGadgetColor(\HiInfo,#PB_Gadget_BackColor,#BkRGB)
    SetGadgetColor(\LoInfo,#PB_Gadget_FrontColor,#White)
    SetGadgetColor(\LoInfo,#PB_Gadget_BackColor,#BkRGB)
    StopDraw  
  EndWith
EndProcedure
;
Procedure MoveSlider(EvGad)
  Protected A=GetGadgetData(EvGad)
  Protected Y,Index=Abs(A)-1
  With _Ds(Index)
    Y=MMy-GadgetY(\CG)-\Radius
    If A>-1
      \Hival=Lim(\Max-R3(0,\Po\He-\PO\Wi*2,\Min,\Max,MMy-GadgetY(\CG)-\Radius),\Loval,\Max)
      SetGadgetText(\HiInfo,Str(\Hival))  
      ResizeGadget(EvGad,#No,R3(\Min,\Max,0,\Po\He-\PO\Wi*2,\Max-\HiVal),#No,#No)    
    Else
      \Loval=Lim(\Max-R3(\Po\Wi,\Po\He-\Po\Wi,\Min,\Max,MMy-GadgetY(\CG)-\Radius),0,\Hival)
      SetGadgetText(\LoInfo,Str(\Loval))  
      ResizeGadget(EvGad,#No,R3(\Min,\Max,\Po\Wi,\Po\He-\Po\Wi,\Max-\LoVal),#No,#No)    
    EndIf
    ResizeGadget(\Link,#No,GadgetY(\HiCanv)+\Radius,#No,GadgetY(\LoCanv)-GadgetY(\HiCanv)) 
    DrawCanvas(\Link)
    Box(0,0,GadgetWidth(\Link),GadgetHeight(\Link),\SlidRGB)
  EndWith
  StopDraw
EndProcedure
;
Procedure RGBrequester(X,Y) 
  Protected Cc.ChooseColor,SelectedColor
  Protected Win=OpenWindow(-1,X,Y,1,1,"",#PB_Window_Invisible) ; invisible window to requester position
  With Cc
    \LStructSize = SizeOf(CHOOSEColor)
    \HwnDowner = WindowID(Win)
    \HInstance = GetModuleHandle_(0)
    \RGBResult = #White ;  Color inicial 
    \LpCustColors = @__ReqRGB()
    \Flags = #CC_ANYCOLOR|#CC_FULLOPEN|#CC_RGBINIT  
    ChooseColor_(Cc.CHOOSEColor)
    SelectedColor=Cc\RGBResult
  EndWith
  CloseWindow(Win)
  ProcedureReturn SelectedColor 
EndProcedure
;
Procedure GetTexture(Index,RGB=0)
  Protected Texture=CreateTexture(Index,1,1)
  If Index>-1:Texture=Index:EndIf
  DrawTexture(Texture)
  Plot(0,0,RGB)
  StopDraw
  ProcedureReturn Texture
EndProcedure
;
Procedure KeyMap()  ; Control  moving and rotating with Keyboard
  ;keys Left,Right,Up,Down,PageUp,PageDown,Insert,Delete,Home,End ,+,-, F1 to F8
  ; -------
  Macro KBP(Key1,Key2)
    (KeyboardPushed(#PB_Key_#Key1) Or KeyboardPushed(#Pb_Key_#Key2))
  EndMacro
  ; -------
  If KBP(Add,F1)         
    MoveCamera(0, 0,0, -_CamSpeed*3)                 ; Absolute move to front
  ElseIf KBP(Subtract,F2)         
    MoveCamera(0, 0, 0,_CamSpeed*3)                  ; Absolute move to rear
    ; ------------------------------
    ; Arrow keys; move camera to 4 absolute directions
  ElseIf KeyboardPushed(#PB_Key_Left)             
    MoveCamera  (0, _CamSpeed, 0, 0)                  ; Move to screen Left
  ElseIf KeyboardPushed(#PB_Key_Right)             
    MoveCamera  (0, -_CamSpeed, 0, 0)                 ; Move to screen Right
  ElseIf KeyboardPushed(#PB_Key_Up)             
    MoveCamera  (0, 0,-_CamSpeed, 0)                  ; Move to screen Top
  ElseIf KeyboardPushed(#PB_Key_Down)             
    MoveCamera  (0, 0,_CamSpeed, 0)                   ; Move to screen Bottom
    ; -------------------
    ;PageUp - Insert : Home - End : Delete - PageDown ; 6 rotations relative to object position
  ElseIf KBP(F3,PageUp)
    RotateNode(0,0,0,_CamSpeed,#PB_Relative)        ; Turn Left
  ElseIf KBP(F4,Insert)
    RotateNode(0,0,0,-_CamSpeed,#PB_Relative)       ; Turn Right
    ; ---------------------
    ;Home / End     
  ElseIf KBP(F5,Home)
    RotateNode(0,-_CamSpeed,0,0,#PB_Relative)       ; Turn back
  ElseIf KBP(F6,End)
    RotateNode(0,_CamSpeed,0,0,#PB_Relative)        ; Turn front
    ; -------------
    ;Delete / PageDown
  ElseIf KBP(F7,Delete)
    RotateNode(0,0, _CamSpeed,0,#PB_Relative)       ; Rotation Left
  ElseIf KBP(F8,PageDown)
    RotateNode(0,0, -_CamSpeed,0,#PB_Relative)      ; Rotation Right
  EndIf
  NodeLookAt(0,0,0,0)  
EndProcedure
;
Procedure Menu1(Win)
  Protected Menu=CreateMenu(#PB_Any, WindowID(Win))
  MenuTitle("File")
  MenuItem( #Load, "&Load off File...")
  MenuBar()
  MenuItem( #Quit,"Quit"+Chr(9)+"Esc")
  MenuTitle("View")
  MenuItem(#Texture,"Show Texture"+Chr(9)+"Ctrl+T")
  MenuItem(#Wireframe,"Show Wireframe"+Chr(9)+"Ctrl+W")
  MenuItem(#Plot,"Show Plots"+Chr(9)+"Ctrl+P")
  MenuTitle("Color")
  MenuItem(#CameraBackColor,"Camera Back Color")
  MenuTitle("Light")
  MenuItem(#LightPoint,"Light point")
  MenuItem(#LightDirectional,"Light directional")
  MenuItem(#LightSpot,"Light spot")
  MenuBar()
MenuItem(#quit,"Quit")
ProcedureReturn Menu
EndProcedure
;
Procedure RenderMode(Menu,Mode=-1)  ; Control Menu item Rendering State
  Static OldMode
  If Mode=-1:Mode=OldMode:EndIf
  Select Mode
    Case 0 : SetMenuItemState(Menu,#Texture,1)
      SetMenuItemState(Menu,#Plot,0)
      SetMenuItemState(Menu,#Wireframe,0)
      CameraRenderMode(0,#PB_Camera_Textured)
    Case 1: SetMenuItemState(Menu,#Wireframe,1)
      SetMenuItemState(Menu,#Plot,0)
      SetMenuItemState(Menu,#Texture,0)
      CameraRenderMode(0,#PB_Camera_Wireframe)
    Case 2 : SetMenuItemState(Menu,#Plot,1)
      SetMenuItemState(Menu,#Wireframe,0)
      SetMenuItemState(Menu,#Texture,0)
      CameraRenderMode(0,#PB_Camera_Plot)   
  EndSelect
  OldMode=Mode
EndProcedure
;
Procedure Off2Mesh(Sel=1)
  Protected A$,B$,Pos=1,Mesh,I,N,RGB,NbTriangles,FirstVertex,NVertex,NFaces,TotalSiz
  Protected.D RR,GG,BB,R1,R2,G1,G2,B1,B2
  Static Path$
  NewList Lines.S() ; ------------------ Linked list for changes by Danilo
  ;Protected start = ElapsedMilliseconds()
  If Sel
    If Path$="":Path$="c:\":EndIf  ; <<< here your preferred starting path <<<<<<<<<<<<<<<<<<
    _File$ = OpenFileRequester("Choose OFF File to open", Path$,"OFF File (*.OFF)|*.OFF",0)
  EndIf
  If ReadFile(0, _File$)
    Select UCase(GetExtensionPart(_File$))
      Case "OFF"
        If Sel 
          Path$=GetPathPart(_File$)  ;preserve subsequent paths
        EndIf
        ; ------------------
        ; changed by Danilo
        ; read all lines To Linked List lines()
        While Not Eof(0)
          Protected Line$ = ReadString(0)
          If AddElement( Lines() )
            Lines() = Line$
          EndIf
        Wend
        CloseFile(0)
        FirstElement( Lines() )
        If UCase( Lines() )="OFF"
          NextElement( Lines() )
          NVertex=Val(StringField(Lines(),1," "))
          NFaces =Val(StringField(Lines(),2," "))
          ; ------------------
          If NFaces>65535
            If Sel
              MessageRequester("Error","Number of faces too high!"+#CRLF$+"Max 65535"+#CRLF$+"NFaces="+Str(Nfaces), #PB_MessageRequester_Ok)
            EndIf
          Else
            Totalsiz=NVertex+NFaces
            CreateMesh(0)
            Pos+1
            NVertex-1
            R1=_Ds(0)\HiVal
            R2=_Ds(0)\LoVal
            G1=_Ds(1)\HiVal
            G2=_Ds(1)\LoVal
            B1=_Ds(2)\HiVal
            B2=_Ds(2)\LoVal
            RR=(R2-R1)/NVertex
            GG=(G2-G1)/NVertex
            BB=(B2-B1)/NVertex
            For N=0 To NVertex
              ; ------------------
              ; changed by Danilo
              NextElement(Lines())
              B$=Lines()
              ; ------------------
              AddMeshVertex(ValD(StringField(B$,1," "))*100,ValD(StringField(B$,2," "))*100,ValD(StringField(B$,3," "))*100)
              MeshVertexColor(RGB(R1,G1,B1))  
              R1+RR      
              G1+GG
              B1+BB
              Pos+1
            Next
            For N=0 To NFaces-1
              ; ------------------
              ; changed by Danilo
              NextElement(Lines())
              B$=Lines()
              ; ------------------
              NbTriangles=Val(StringField(B$,1," "))-1
              FirstVertex=Val(StringField(B$,2," "))
              For I=2 To NbTriangles  ; make FirstVertex
                AddMeshFace(FirstVertex,Val(StringField(B$,I+1," ")),Val(StringField(B$,I+2," ")))
              Next
              Pos+1
            Next
            BuildMeshShadowVolume(0)
            FinishMesh()
            ProcedureReturn #True
          EndIf   
        EndIf
      Default
        MessageRequester("Error","Unknown File Type"+#CRLF$+_File$, #PB_MessageRequester_Ok)
    EndSelect
  EndIf
  ProcedureReturn 0
EndProcedure
;
;<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
wTitle$="  -  Enabled keys : Arrow Keys, F1 To F8, Insert/PageUp, Delete/PageDown, Home/End, +/-"
OpenWindow(0, 0, 0, 800,600,"Off 3D Viewer"+wTitle$,#PB_Window_SystemMenu|#PB_Window_Maximize|#PB_Window_Invisible)
SetWindowColor(0,_BkRGB)
Menu1=Menu1(0)
Wi=WindowWidth(0):He=WindowHeight(0)
;-------------
x=Wi-125
InitDSlid(0,X,10,20,300,0,255,0,#Red,128,128)   ; 3 sliders
InitDSlid(1,X+40,10,20,300,0,255,0,#Green,100,200)
InitDSlid(2,X+80,10,20,300,0,255,0,#ZBlue)
;  ---------------------
AntialiasingMode(#PB_AntialiasingMode_x6)
OpenWindowedScreen(WindowID(0), 0, 0, Wi-130,He, 0, 0, 0,#PB_Screen_SmartSynchronization)
WorldShadows(#PB_Shadow_Additive)
CreateNode(0,0,0,0)
CreateCamera(0,0,0,Wi-130,He)
;
AddKeyboardShortcut(0,#PB_Shortcut_Control|#PB_Shortcut_T,#Texture)
AddKeyboardShortcut(0,#PB_Shortcut_Control|#PB_Shortcut_W,#Wireframe)
AddKeyboardShortcut(0,#PB_Shortcut_Control|#PB_Shortcut_P,#Plot)
AddKeyboardShortcut(0,#PB_Shortcut_Escape,#Quit)
HideWindow(0,0)
Repeat
  Repeat
    EV=WindowEvent()
    If EventType()= #PB_EventType_LeftButtonUp    
      If Off2Mesh(0)   
        GetTexture(0,#White)
        CreateMaterial(0,TextureID(0))
        MaterialAmbientColor(0,#PB_Material_AmbientColors)
        CreateEntity(0,MeshID(0), MaterialID(0))
        AttachNodeObject(0,EntityID(0),#PB_Node_Entity)
        OldT=TV:OldL=LV
        SetActiveWindow(0)
        Break  
      EndIf    
    EndIf
    Select Ev
      Case #WM_KEYUP
        Keyx=0:Keyy=0:Keyz=0
      Case #PB_Event_Gadget
        Select EventGadget()
          Case _Ds(0)\HiCanv ,_Ds(0)\LoCanv,_Ds(1)\HiCanv ,_Ds(1)\LoCanv,_Ds(2)\HiCanv ,_Ds(2)\LoCanv
            CheckMMk()
            If _MMk And MMy<>Oldmy
              MoveSlider(EventGadget()) ;   values for each slider are stored in _Ds(Index)\LoVal and _Ds(Index)\HiVal 
              Oldmy=MMy    
            EndIf    
        EndSelect
      Case #PB_Event_Menu
        Select EventMenu()
          Case #Load
            If Off2Mesh()   
              GetTexture(0,#White)
              CreateMaterial(0,TextureID(0))
              MaterialAmbientColor(0,#PB_Material_AmbientColors)
              CreateEntity(0,MeshID(0), MaterialID(0))
              AttachNodeObject(0,EntityID(0),#PB_Node_Entity)
              CreateCamera(0, 0, 0, 100, 100)
              CameraLocate(0, 0, 0,600)
              CameraLookAt(0,EntityX(0),EntityY(0)-100,EntityZ(0))
              CreateLight(0,#White,EntityX(0)-100,EntityY(0)+100,EntityZ(0),#PB_Light_Point)
              CreateLight(1, RGB(155,155,155),  0, 100, 50,#PB_Light_Point) 
              RenderMode(Menu1)
              CameraBackColor(0,_CamerabackColor)  
            EndIf
          Case #Texture     : RenderMode(Menu1,0)   
          Case #Wireframe   : RenderMode(Menu1,1)   
          Case #Plot        : RenderMode(Menu1,2)   
          Case #CameraBackColor
            _CameraBackColor=RGBrequester(100,100)
            CameraBackColor(0,_CameraBackColor)
          Case #Lightpoint
            CreateLight(0,#White,EntityX(0)-100,EntityY(0)+100,EntityZ(0),#PB_Light_Point)
          Case #LightDirectional
            CreateLight(0,#White,EntityX(0)-100,EntityY(0)+100,EntityZ(0),#PB_Light_Directional)
          Case #LightSpot
            CreateLight(0, RGB(155, 155, 155), 0, 300, 100, #PB_Light_Spot)
            SpotLightRange(0, 25, 65)
          Case #Quit:End   
        EndSelect
    EndSelect
    If Ev=#PB_Event_CloseWindow :End:EndIf
  Until Ev=0 And _MMk=0
  If ExamineKeyboard()
    SetActiveWindow(0)
    KeyMap()
  EndIf
  RenderWorld()
  FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)
End
Please add here your modifications/ improvements/ bug reports/ anything related.
Sorry for my spanglish.
Cheers!

Re: Explore OFF 3d models

Posted: Mon Oct 31, 2011 5:55 pm
by buddymatkona
Interesting! Nice images. :)

Note: check File$ after "File$ = OpenFileRequester" in case of "Cancel". An undefined File$ leads to this:

Code: Select all

 #Load
     Off2Mesh(0,"E:\off Files\")
followed by abort.

Re: Explore OFF 3d models

Posted: Mon Oct 31, 2011 7:32 pm
by einander
Corrected on first post, Thanks!

Re: Explore OFF 3d models

Posted: Mon Oct 31, 2011 8:10 pm
by Danilo
einander wrote:For models bigger than 500 KB, the conversion from OFF to mesh is slow, but the Princeton database have lots of good models smaller than that; many of them are very complex an well constructed.

To do: I'm searching a faster way to convert the faces of the text OFF file to Doubles and Integers, instead of using StringField(), ValD() and Val().
[...]
Please add here your modifications/ improvements/ bug reports/ anything related.
einander, StringField(), ValD() and Val() are not slow in general.

The problem is you use Stringfield() with A$ for every line, so you make a
Stringfield on the whole file input many thousand times.

I made a little modification to Off2Mesh() now. It reads all lines into a linked list
and works with this list.
Loading time for example m1503.off (1,60MB) was 142 seconds here. Now it is 2 seconds.

I marked the little modifications with comments

Code: Select all

;Load and disPlay 3d Models ".OFF"  Files
;by einander
;PB 4.60 RC2
;
;Enabled Keys:
;   4 Arrows
;   F1 To F8
;   + (Near), - (Far)
;   Insert  , PageUp
;   Delete  , PageDown
;   Home    , End
;
EnableExplicit
Global _CamSpeed = 1,_ProgressWin,_Progress
Global _Multicolor=#True
Define EV,KeyX.D, KeyY.D, Keyz.D,A$
InitKeyboard()
InitEngine3D()
InitSprite()
Enumeration
  #Load
  #Save
  #Texture
  #Wireframe
  #Plot
  #Multicolor
  #Quit
EndEnumeration
;
Procedure GetTexture(Index,RGB=0)
  Protected Texture=CreateTexture(Index,1,1)
  If Index>-1:Texture=Index:EndIf
  StartDrawing(TextureOutput(Texture))
  Plot(0,0,RGB)
  StopDrawing()
  ProcedureReturn Texture
EndProcedure
;
;
Procedure KeyMap()  ; Control  moving and rotating with Keyboard
  ;Left,Right,Up,Down,PageUp,PageDown,Insert,Delete,Home,End ,+,-, F1 to F8
  ; -------
  Macro KBP(Key1,Key2)
    (KeyboardPushed(#PB_Key_#Key1) Or KeyboardPushed(#Pb_Key_#Key2)) 
  EndMacro
  ; -------
  If KeyboardPushed(#PB_Key_F1)   ;<<<<< assign on the IFs your own key map <<<<<         
    RotateCamera(0, 0,0,-_CamSpeed, #PB_Relative)     ; Rotation to object Left
  ElseIf KeyboardPushed(#PB_Key_F2)     
    RotateCamera(0, 0,0,_CamSpeed, #PB_Relative)      ; Rotation to object Right
  ElseIf KeyboardPushed(#PB_Key_Subtract)         
    MoveCamera(0, 0,0, _CamSpeed*3)                   ; Absolute move to rear
  ElseIf KeyboardPushed(#PB_Key_Add)         
    MoveCamera(0, 0, 0,-_CamSpeed*3)                  ; Absolute move to front
    ;------------------------------
    ; Arrow keys; move camera to 4 absolute directions
  ElseIf KeyboardPushed(#PB_Key_Left)             
    MoveCamera  (0, _CamSpeed, 0, 0)                  ; Move to screen Left
  ElseIf KeyboardPushed(#PB_Key_Right)             
    MoveCamera  (0, -_CamSpeed, 0, 0)                 ; Move to screen Right
  ElseIf KeyboardPushed(#PB_Key_Up)             
    MoveCamera  (0, 0,-_CamSpeed, 0)                  ; Move to screen Top
  ElseIf KeyboardPushed(#PB_Key_Down)             
    MoveCamera  (0, 0,_CamSpeed, 0)                   ; Move to screen Bottom
    ; ------------------- 
    ;PageUp - Insert : Home - End : Delete - PageDown ; 6 rotations relative to object position
  ElseIf KBP(F3,PageUp)
    RotateEntity(0,0,0,_CamSpeed,#PB_Relative)        ; Turn Left
  ElseIf KBP(F4,Insert)
    RotateEntity(0,0,0,-_CamSpeed,#PB_Relative)       ; Turn Right
    ; --------------------- 
    ;Home / End     
  ElseIf KBP(F5,Home)
    RotateEntity(0,-_CamSpeed,0,0,#PB_Relative)       ; Turn back
  ElseIf KBP(F6,End)
    RotateEntity(0,_CamSpeed,0,0,#PB_Relative)        ; Turn front
    ; -------------
    ;Delete / PageDown
  ElseIf KBP(F7,Delete)
    RotateEntity(0,0, _CamSpeed,0,#PB_Relative)       ; Rotation Left
  ElseIf KBP(F8,PageDown)
    RotateEntity(0,0, -_CamSpeed,0,#PB_Relative)      ; Rotation Right
  EndIf
EndProcedure
;
Procedure Menu1(Win)
  Protected Menu=CreateMenu(#PB_Any, WindowID(Win))
  MenuTitle("File")
  MenuItem( #Load, "&Load off File...")
  MenuBar()
  MenuItem(#Multicolor,"Enable Multicolor Load")
  SetMenuItemState(Menu,#Multicolor,1)
  MenuBar()
  MenuItem( #Quit,"Quit"+Chr(9)+"Esc")
  MenuTitle("View") 
  MenuItem(#Texture,"Show Texture"+Chr(9)+"Ctrl+T")
  MenuItem(#Wireframe,"Show Wireframe"+Chr(9)+"Ctrl+W")
  MenuItem(#Plot,"Show Plots"+Chr(9)+"Ctrl+P")
  ProcedureReturn Menu
EndProcedure
;
Procedure RenderMode(Menu,Mode=-1)  ; Control Menu item Rendering State
  Static OldMode
  If Mode=-1:Mode=OldMode:EndIf
  Select Mode
    Case 0 : SetMenuItemState(Menu,#Texture,1)
      SetMenuItemState(Menu,#Plot,0)
      SetMenuItemState(Menu,#Wireframe,0)
      CameraRenderMode(0,#PB_Camera_Textured) 
    Case 1: SetMenuItemState(Menu,#Wireframe,1)
      SetMenuItemState(Menu,#Plot,0)
      SetMenuItemState(Menu,#Texture,0)
      CameraRenderMode(0,#PB_Camera_Wireframe)
    Case 2 : SetMenuItemState(Menu,#Plot,1)
      SetMenuItemState(Menu,#Wireframe,0)
      SetMenuItemState(Menu,#Texture,0)
      CameraRenderMode(0,#PB_Camera_Plot)   
  EndSelect
  OldMode=Mode 
EndProcedure
;
Procedure Off2Mesh()
  Protected A$,B$,Pos=1,Mesh,I,N,RGB,NbTriangles,FirstVertex
  Static Path$
  NewList lines.s() ;------------------ linked list for changes by Danilo
  ;Protected start = ElapsedMilliseconds()
  If Path$="":Path$="c:\":EndIf
  Protected File$ = OpenFileRequester("Choose File to open", Path$,"OFF File (*.OFF)|*.OFF",0)
  If ReadFile(0, File$)
    Select UCase(GetExtensionPart(File$))
      Case "OFF"
        Path$=GetPathPart(File$)
        HideWindow(_ProgressWin,0)
        BlockInput_(#True)
        SetWindowTitle(_ProgressWin,"Loading "+File$)
        ;------------------
        ; changed by Danilo
        ;
        ; read all lines to linked list lines()
        While Not Eof(0)
            Protected line$ = ReadString(0)
            If AddElement( lines() )
                lines() = line$
            EndIf
        Wend
        CloseFile(0)
        FirstElement( lines() )
        If UCase( lines() )="OFF"
          NextElement( lines() )
          Define NVertex=Val(StringField(lines(),1," "))
          Define NFaces =Val(StringField(lines(),2," "))
        ;------------------

          If NFaces>65535
            HideWindow(_Progresswin,1)
            BlockInput_(0)
            MessageRequester("Error","Number of faces too high!"+#CRLF$+"Max 65535"+#CRLF$+"nFaces="+Str(NFaces), #PB_MessageRequester_Ok)
          Else 
            ShowCursor_(#False)
            Define Totalsiz=NVertex+NFaces
            SetGadgetAttribute(_Progress,#PB_ProgressBar_Maximum,Totalsiz )
            CreateMesh(0)
            Pos+1
            NVertex-1
            For N=0 To NVertex
              ;------------------
              ; changed by Danilo
              NextElement(lines())
              B$=lines()
              ;------------------
              AddMeshVertex(ValD(StringField(B$,1," "))*100,ValD(StringField(B$,2," "))*100,ValD(StringField(B$,3," "))*100)
              If _Multicolor
                RGB= Int(255/NVertex*N) ; Multicolor to see more details (arbitrary Colors)
                MeshVertexColor(RGB(RGB/2,255-RGB,RGB)) ; fast and Dirty : to do: better Coloring
              Else
                MeshVertexColor(#White)   ;<<<<<<<<
              EndIf
              If N%400=0
                If N
                  If GetAsyncKeyState_(27)&$8000 :  End : EndIf
                  SetGadgetState(_Progress,N)
                EndIf 
              EndIf
              Pos+1 
            Next
            For N=0 To NFaces-1
              ;------------------
              ; changed by Danilo
              NextElement(lines())
              B$=lines()
              ;------------------
              NbTriangles=Val(StringField(B$,1," "))-1
              FirstVertex=Val(StringField(B$,2," "))
              For I=2 To NbTriangles  ; make FirstVertex
                AddMeshFace(FirstVertex,Val(StringField(B$,I+1," ")),Val(StringField(B$,I+2," ")))
              Next
              If N%400=0
                If GetAsyncKeyState_(27)&$8000 :  End : EndIf
                SetGadgetState(_Progress,Pos)   
              EndIf
              Pos+1
            Next
            FinishMesh()
            BlockInput_(0)
            HideWindow(_ProgressWin,1)   
            ShowCursor_(#True)
            ;MessageRequester("LoadTime:",Str(ElapsedMilliseconds()-start)+" ms")
            ProcedureReturn #True 
          EndIf   
        EndIf
      Default
        MessageRequester("Error","Unknown File Type"+#CRLF$+File$, #PB_MessageRequester_Ok) 
    EndSelect
  EndIf
  ProcedureReturn 0
EndProcedure
;
;<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
a$="  -  Enabled keys : Arrow Keys, F1 To F8, Insert/PageUp, Delete/PageDown, Home/End, +/-"
OpenWindow(0, 0, 0, 800,600,"Off 3D Viewer"+A$,#PB_Window_SystemMenu|#PB_Window_Maximize)  ;|#PB_Window_BorderLess)
SetWindowColor(0,0)
Define Menu1=Menu1(0)
;  ---------------------
_ProgressWin=OpenWindow(-1,100,100,WindowWidth(0)/2,20,"",#PB_Window_ScreenCentered|#PB_Window_Invisible|#PB_Window_Tool)
_Progress=ProgressBarGadget(-1,0,0,WindowWidth(_ProgressWin),20,0,100,#PB_ProgressBar_Smooth)
AntialiasingMode(#PB_AntialiasingMode_x6)
OpenWindowedScreen(WindowID(0), 0, 0, WindowWidth(0),WindowWidth(0), 0, 0, 0,#PB_Screen_SmartSynchronization)
WorldShadows(#PB_Shadow_Additive)
;
AmbientColor($666666)
AddKeyboardShortcut(0,#PB_Shortcut_Control|#PB_Shortcut_T,#Texture)
AddKeyboardShortcut(0,#PB_Shortcut_Control|#PB_Shortcut_W,#Wireframe)
AddKeyboardShortcut(0,#PB_Shortcut_Control|#PB_Shortcut_P,#Plot)
Repeat
  Repeat
    If GetAsyncKeyState_(27)&$8000 :  End : EndIf
    EV=WindowEvent()
    Select Ev
      Case #WM_KEYUP
        Keyx=0:Keyy=0:Keyz=0
      Case #PB_Event_Menu
        Select EventMenu()
          Case #Load
            If Off2Mesh()   
              GetTexture(0,#White)
              CreateMaterial(0,TextureID(0))
              MaterialAmbientColor(0,#PB_Material_AmbientColors)
              CreateEntity(0,MeshID(0), MaterialID(0))
              CreateCamera(0, 0, 0, 100, 100)
              CameraLocate(0, 0, 0,600)
              CameraLookAt(0,EntityX(0),EntityY(0)-100,EntityZ(0))
              CreateLight(0,#White,EntityX(0)-100,EntityY(0)+100,EntityZ(0),#PB_Light_Point)
              CreateLight(1, #Blue,  0, 100, 50,#PB_Light_Point) ; Creates a Green Light, at the position (0, 100.7, 50)
              RenderMode(Menu1)
            EndIf 
          Case #Texture     : RenderMode(Menu1,0)   
          Case #Wireframe   : RenderMode(Menu1,1)   
          Case #Plot        : RenderMode(Menu1,2)   
          Case #Multicolor
            _Multicolor!1
            SetMenuItemState(Menu1,#Multicolor,_Multicolor)
          Case #Quit:End   
        EndSelect
    EndSelect
    If Ev=#PB_Event_CloseWindow :End:EndIf
  Until Ev=0
  If ExamineKeyboard()
    KeyMap()
  EndIf
  RenderWorld()
  FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)
End
My modifications do not have error checks (if NextElement() fails).
It is just a quick hack to show you how to speed it up little bit.
After my modifications the code works also in unicode mode (didn't work before).

Hope it helps.

Re: Explore OFF 3d models

Posted: Mon Oct 31, 2011 9:28 pm
by einander
Hope it helps.
@Danilo : Sure it helps.
Thanks a lot! :D

Re: Explore OFF 3d models

Posted: Tue Nov 01, 2011 2:45 am
by electrochrisso
Thanks einander, good 3D model link too. :)

Re: Explore OFF 3d models

Posted: Tue Nov 01, 2011 8:43 am
by dige
Thanks einander! That looks like a good start for me. I'm planning to visualize the output of depth sensor from the Kinect camera. But since the big change of the Ogre function I was confused a little how to use it.

Updated: Explore OFF 3d models

Posted: Fri Nov 04, 2011 2:10 pm
by einander
Updated.
See first post.
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited