PureBasic Forums - English

Code: Select all

; Plotter PB

; https://www.purebasic.fr/german/viewtopic.php?t=12189
; modified to work on PB6.04 2024/07/07

EnableExplicit

UsePNGImageDecoder()
UseJPEGImageDecoder()
UsePNGImageEncoder()

; If Not GetPathPart(ProgramFilename()) = #PB_Compiler_Home+"Compilers\"
;   SetCurrentDirectory( GetPathPart(ProgramFilename()) )
; EndIf

Structure winS
  x.l
  y.l
  w.l
  h.l
  xMid.l
  yMid.l
  num.l
  hnd.l
  title.s
  style.l
EndStructure

Structure pS
  x.l
  y.l
  c.l
  cOrig.l
  h.l
EndStructure

Macro inScreen(_x,_y) ; <<NOT USED>>
  (1 And (_x>=0 And _x<win\w And _y>=0 And _y<win\h )    )
EndMacro

Macro load()
  If IsImage(0)
    FreeImage(0)
  EndIf
  
  If Not LoadImage(0,openfile)
    MessageRequester("error", "!")
    End
  EndIf
  
  Dim p.pS(max,max)
  ResizeImage(0,max+1,max+1, #PB_Image_Smooth)
  hmax=0
  hmin=$FFFFFF
  StartDrawing( ImageOutput(0) )
    For i=0 To max
      For k=0 To max
        temp_=Point(i,k)
        p(i,k)\cOrig=temp_
        p(i,k)\h = (temp_ & $FF) + (temp_ & $FF00)>>8 + (temp_ & $FF0000)>>16   / 3  ; << color to height
        If p(i,k)\h<hmin
          hmin=p(i,k)\h
        EndIf
        If p(i,k)\h>hmax
          hmax=p(i,k)\h
        EndIf
      Next
    Next
  StopDrawing()
  For i=0 To max
    For k=0 To max
      p(i,k)\h-hmin; << just cut off base height
    Next
  Next
  win\title=">< .."+GetFilePart(openfile)
  SetWindowTitle(win\num, win\title)
EndMacro

Macro getPositions()
  For i=0 To max
    For k=0 To max
      p(i,k)\x = win\xMid + (i-k)*2*zoom
      p(i,k)\y = win\yMid + (i+k)*zoom  -max*zoom -scale*p(i,k)\h
    Next
  Next
EndMacro

Macro getColors()
  For i=0 To max
    For k=0 To max
      If c<0
        p(i,k)\c = p(i,k)\cOrig
      Else
        p(i,k)\c = ( 10+245*p(i,k)\h/(hmax-hmin) )<<c
      EndIf
    Next
  Next
EndMacro


Define max.l=100
Define i.l, k.l
Dim p.pS(max,max)

Define win.winS
Define event.l
Define em.l
Define quit.l
Define ems.l
Define timer.l
Define mx.l
Define my.l
Define xOff.l
Define yOff.l
Define hmax.l
Define hmin.l
Define zoom.f=3.0
Define scale.f=0.1
Define openfile.s=".\map02.png"
Define savefile.s=".\plotter_screenshot.png"
Define temp_.l
Define bg.l=16 ; background-color shift
Define bgm.l  ; bg mode
Define c.l=-8 ; line-color shift
Define lines.l=1; toggle 0~1
Define knots.l=1; toggle 0~1
Define rm.l      ; release mouse (toggle 0~1)
Define showpanel.l; (return) toggle 0~1
Define FR.l, FRt.l, FR$; framerate

Declare openGUI(*p.winS)
Declare sd( s.s="", startdrawing=1) 

; ------------
InitSprite()
InitMouse()
InitKeyboard()
; ------------
openGUI(win)
openfile = OpenFileRequester("load image", openfile, "bmp; jpg; jpeg; png|*.bmp;*.png;*.jpg;*.jpeg", 0)

If openfile = #Null$  
  End
EndIf

load()
getPositions()
getColors()
; ------------
MouseLocate(win\xMid,win\yMid)

;################ MAIN #################
Repeat
  event=WaitWindowEvent(50)
  ExamineKeyboard()
  ExamineMouse()

  ;{-INPUT
  mx=MouseX()
  my=MouseY()
  If MouseWheel()
    If KeyboardPushed(#PB_Key_LeftControl)
      temp_=max
      max+MouseWheel() : If max<1 : max=1 : EndIf
      zoom = temp_*zoom/max
      load()
      getPositions()
      getColors()
    ElseIf KeyboardPushed(#PB_Key_LeftShift)
      scale+MouseWheel()*0.02
      getPositions()
      getColors()
    Else
      zoom+MouseWheel() : If zoom<1 : zoom=1 : EndIf
      getPositions()
    EndIf
  EndIf

  If      KeyboardReleased(#PB_Key_Up)   
    bg+8
    If bg>16 
      bg=16
    EndIf
    
  ElseIf KeyboardReleased(#PB_Key_Down)
    bg-8 
    If bg<0  : bg=0 : EndIf
    
  ElseIf KeyboardReleased(#PB_Key_Left) 
    c+8 
    If c>16  : c=16 : EndIf 
    getColors()
    
  ElseIf KeyboardReleased(#PB_Key_Right)
    c-8 
    If c<-8  : c=-8  : EndIf  
    getColors()
  EndIf

  If KeyboardReleased(#PB_Key_L) :: lines!1 :: EndIf
  If KeyboardReleased(#PB_Key_K) :: knots!1 :: EndIf
  If KeyboardReleased(#PB_Key_M) :: rm!1 : ReleaseMouse(rm) :: EndIf
  If KeyboardReleased(#PB_Key_B) :: bgm!1 :: EndIf

  If KeyboardReleased(#PB_Key_F2); screenshot
    GrabSprite(0,0,0,win\w,win\h)
    ReleaseMouse(1)
    savefile=SaveFileRequester("save screenshot", savefile, "png|*.png", 0)
    If savefile
      SaveSprite(0,savefile,#PB_ImagePlugin_PNG)
    EndIf
    FreeSprite(0)
    ReleaseMouse(0)
  EndIf

  If KeyboardReleased(#PB_Key_F3); load
    ReleaseMouse(1)
    openfile=OpenFileRequester("load image", openfile, "bmp; jpg; jpeg; png|*.bmp;*.png;*.jpg;*.jpeg", 0)
    ReleaseMouse(0)
    If openfile
      max=100
      zoom=3.0
      scale=0.1
      xOff=0
      yOff=0
      load()
      getPositions()
      getColors()
    EndIf
    MouseLocate(win\xMid,win\yMid)
  EndIf
  
  If KeyboardReleased(#PB_Key_Return)
    showpanel!1
  EndIf
  ;}-INPUT end
  
  ems=ElapsedMilliseconds()
  Select event
    Case #PB_Event_CloseWindow
      quit=1
    Case #PB_Event_Menu
      em=EventMenu()
      Select em
        Case 0;esc
          quit=1
      EndSelect
    Default
      ;{-RENDER
      ; -------------
      ClearScreen($33<<bg);$441111)
      If Not showpanel
        xOff-MouseDeltaX()*2
        yOff-MouseDeltaY()*2
        sd("              FR            "+FR$)
        sd("              knots         "+Str((max+1)*(max+1)))
        sd("[esc]         quit")
        sd("[M]           release mouse")
        sd("[L]           toggle lines")
        sd("[K]           toggle knots")
        sd("[B]           toggle bg mode")
        sd("[up/down]     bg color")
        sd("[left/right]  line color")
        sd("[f3]          load image")
        sd("[f2]       ;) schirm-schuß")
        sd("[wheel]       hor-scale     "+StrF(zoom,2))
        sd("[shift+wheel] ver-scale     "+StrF(scale,2))
        sd("[cntrl+wheel] density       "+Str(max+1))
      EndIf

      StartDrawing( ScreenOutput() )
        If bgm
          For i=0 To win\h Step 20
            Box(0,i, win\w, 20, (i*100/win\h)<<bg )
          Next
        EndIf
        For i=0 To max
          For k=0 To max
            If lines
              If k<max
                LineXY( xOff+p(i,k)\x,  yOff+p(i,k)\y,   xOff+p(i,k+1)\x,  yOff+p(i,k+1)\y,   p(i,k)\c)
              EndIf
              If i<max
                LineXY(  xOff+p(i,k)\x,  yOff+p(i,k)\y,   xOff+p(i+1,k)\x,  yOff+p(i+1,k)\y,   p(i,k)\c)
              EndIf
            EndIf
            If knots
              ;Circle( xOff+p(i,k)\x, yOff+p(i,k)\y, 2, p(i,k)\c)
              Box( xOff+p(i,k)\x-1, yOff+p(i,k)\y-1, 3,3, p(i,k)\c)
            EndIf
          Next
        Next
        DrawImage(ImageID(0),20,win\h-max-20)
        DrawingMode(#PB_2DDrawing_Transparent)
        sd("",0)
      StopDrawing()
      If showpanel
        DisplayTransparentSprite(1,100,100)
        DisplayTransparentSprite(2,mx,my)
      EndIf
      FlipBuffers()
      Delay(30)
      ; -------------
      ;}-RENDER end

      FR+1 ;{-framerate
      If ElapsedMilliseconds()>FRt
        FR$=Str(FR) 
        FR=0
        FRt=ElapsedMilliseconds()+1000
      EndIf
      ;}-

  EndSelect
  ;Delay(10)
Until quit Or KeyboardPushed(#PB_Key_Escape)
;############## MAIN end ###############

Procedure openGUI(*p.winS)
  *p\num=0
  *p\title="><"
  *p\style=#PB_Window_SystemMenu
  *p\style|#PB_Window_ScreenCentered
  *p\w=1024
  *p\h=800
  *p\xMid=*p\w/2
  *p\yMid=*p\h/2
  *p\hnd=OpenWindow(*p\num, 0,0, *p\w,*p\h, *p\title, *p\style)
  OpenWindowedScreen(*p\hnd, 0,0, *p\w,*p\h, 0,0,0)
  AddKeyboardShortcut(*p\num, #PB_Shortcut_Escape, 0)

  If #PB_Compiler_OS = #PB_OS_Linux
      LoadFont(0,"Monospace",8,0*#PB_Font_Bold)
  ElseIf #PB_Compiler_OS = #PB_OS_Windows
      LoadFont(0,"Lucida Console",8,0*#PB_Font_Bold)
  EndIf
  
  CreateSprite(1, 600, 400);menu
  StartDrawing( SpriteOutput(1) )
    DrawingMode(#PB_2DDrawing_Outlined)
    Box(0,0, 600,400, $555555)
  StopDrawing()

  CreateSprite(2, 12, 12); cursor
  StartDrawing( SpriteOutput(2) )
    Line(0,0, 8,12, $999999)
    Line(0,0, 12,8, $bbbbbb)
  StopDrawing()
EndProcedure


Procedure sd( s.s="", startdrawing=1)  ;##### screen debug
  Static NewList outtext.s()
  Protected y
  If s
    AddElement(outtext())
    outtext()=s
  Else
    If startdrawing
      StartDrawing( ScreenOutput() )
      DrawingMode(#PB_2DDrawing_Transparent)
      DrawingFont(FontID(0))
    EndIf
    y=15
    DrawingFont(FontID(0))
    ForEach outtext()
      DrawText(15,y,outtext(),$777777)
      y+15
    Next
    If startdrawing
      StopDrawing()
    EndIf
    ClearList(outtext())
  EndIf
EndProcedure

Code: Select all

; Image rooling 360° View
; Made from 
; https://www.purebasic.fr/english/viewtopic.php?t=84613

InitEngine3D()
InitSprite()
InitKeyboard()
InitMouse()

ExamineDesktops()
OpenWindow(0, 0, 0, DesktopWidth(0) * 0.8, DesktopHeight(0) * 0.8, "CreateShader - [Esc] quit", #PB_Window_ScreenCentered)
OpenWindowedScreen(WindowID(0), 0, 0, WindowWidth(0), WindowHeight(0), 0, 0, 0)

image.s="D:\PureBasic\PbFrameWork\Brainstorming\Image\Image_Panorama1.jpg"

If FileSize(image) <= 0
  MessageRequester("!", "enter 360 panoramic image path (above)")
  ;CallDebugger
  End
EndIf

;Parse3DScripts()
Add3DArchive(GetPathPart(image), #PB_3DArchive_FileSystem)

LoadTexture(0, GetFilePart(image))

CreateCamera(0, 0, 0, 100, 100)
MoveCamera(0, 0, 30 , -400)
CameraLookAt(0, 0, 0, 0)

CreateLight(0, RGB(255,255,255), 300,300,-1000, #PB_Light_Spot)
CreateMaterial(0, TextureID(0))
DisableMaterialLighting(0,1)
;MaterialCullingMode(0, #PB_Material_AntiClockWiseCull)
MaterialFilteringMode(0, #PB_Material_Anisotropic)

;CreateSphere(0,1000,64,64)
CreateCylinder(0, 100, 100, 32, 32, #True)
;CreateCube(0,100)
CreateEntity(0, MeshID(0), MaterialID(0))

; We have to rotate the Enity or we have to flip the image
; becauese 0,0 is top left what flips the image!
RotateEntity(0,0,0,180,#PB_Relative) 

Define.f MouseX,Mousey

Repeat
  
  While WindowEvent()
  Wend
  
  ExamineKeyboard()
  ExamineMouse()
  
	MouseX = -MouseDeltaX() *  0.05
  MouseY = -MouseDeltaY() *  0.05
  ;RotateCamera(0, MouseY, MouseX, 0, #PB_Relative)	
  RotateEntity(0, 0, MouseX, 0, #PB_Relative)	

	RenderWorld()
	FlipBuffers()    
	
Until KeyboardReleased(#PB_Key_Escape) Or MouseButton(3)

Code: Select all

Procedure.l cola(col,a=$ff)
  ProcedureReturn col|(a<<24)
EndProcedure

InitEngine3D():InitSprite():InitKeyboard():InitMouse()
OpenWindow(0, 0, 0, 0,0, "[F1]: Change shape - [F12]: Wireframe - [Esc]: Quit - MouseWheel: Zoom",#PB_Window_Maximize)
ex=WindowWidth (0,#PB_Window_InnerCoordinate)
ey=WindowHeight(0,#PB_Window_InnerCoordinate)
OpenWindowedScreen(WindowID(0), 0, 0, ex, ey, 0, 0, 0)

CreateCamera(0, 0, 0, 100, 100)
CreateLight(0,$888888, 10000, 5000, 2000)
CameraBackColor(0,$ff8888) 
AmbientColor($aaaaaa)

Global n=256,n1=n-1
;------------------------ image creation
CreateImage(0,n,n,32)
StartVectorDrawing(ImageVectorOutput(0))
For i=0 To n Step 20
  For j=0 To n Step 20
    x=i+Random(20)
    y=j+Random(20)
    r=5+Random(30)
    c=Random($ffffff)
    VectorSourceCircularGradient(x, y, r)
    VectorSourceGradientColor(cola(c,128),0.0)
    VectorSourceGradientColor(cola(c,64),0.8)
    VectorSourceGradientColor(cola(c,0 ),1.0)     
    AddPathCircle(x,y,r)
    FillPath()
  Next
Next    
StopVectorDrawing()

;------------------------ entity / mesh creation
Procedure meshtype(type)
Protected .f ray,ai,aj
Dim t.MeshVertex(n,n)
StartDrawing(ImageOutput(0))
For j=0 To n
  For i=0 To n
    With t(j,i)      
      color=Point(i & n1,j & n1)
      \color=color
      Select type
        Case 0
          \x=(i-n/2)
          \z=(n/2-j)
          \y=Red(color)/5
        Case 1
          ray=50+Red(color)/10
          ai=i/n*2*#PI
          \x=Cos(ai)*ray
          \z=Sin(ai)*ray
          \y=-(j/n-0.5)*100
        Case 2
          ray=50+Red(color)/20
          ai=i/n*2*#PI
          aj=j/n*#PI
          \x=Cos(ai)*ray*Sin(aj)
          \z=Sin(ai)*ray*Sin(aj)
          \y=        ray*Cos(aj)
      EndSelect
    EndWith 
  Next
Next
StopDrawing()
CreateDataMesh(0,t(),#PB_Mesh_DiagonalClosestNormal +8)
CreateMaterial(0,0)
SetMaterialColor(0,#PB_Material_AmbientColor|#PB_Material_DiffuseColor,-1)
MaterialCullingMode(0,#PB_Material_NoCulling)
CreateEntity(0,MeshID(0),MaterialID(0))
EndProcedure

;------------------------

dist=150
mtype=2
meshtype(mtype)
Repeat
  ExamineMouse()
  ExamineKeyboard()
  dist+(Bool(KeyboardPushed(#PB_Key_Down)<>0)-Bool(KeyboardPushed(#PB_Key_Up   )<>0))*1-MouseWheel()*10
  If KeyboardReleased(#PB_Key_F1):mtype=(mtype+1)%3:meshtype(mtype):EndIf
  If KeyboardReleased(#PB_Key_F12):fdf=1-fdf:If fdf:CameraRenderMode(0,#PB_Camera_Wireframe):Else:CameraRenderMode(0,#PB_Camera_Textured):EndIf:EndIf
  a.f+0.004
  MoveCamera(0,Cos(a)*dist,dist*0.7,Sin(a)*dist,0)
  CameraLookAt(0,0,0,0)
  RenderWorld()
  FlipBuffers()    
  While WindowEvent():Wend
Until KeyboardReleased(#PB_Key_Escape) Or MouseButton(3)