Physic Sandbox r0001

If InitKeyboard() = 0 XOr InitSprite() = 0 XOr InitMouse() = 0
  MessageRequester("Fehler","Kein DirectX installiert")
  End
EndIf

#World_Width = 300
#World_Height = 200

OpenWindow(0,0,0,#World_Width,#World_Height,"Physic Sandbox r0001",#PB_Window_ScreenCentered)
If OpenWindowedScreen(WindowID(0),0,0,801,601) = 0
  MessageRequester("Fehler","Kein DirectX installiert")
  End
EndIf

OpenWindow(1,0,0,200,300,"Physic Sandbox Debug")

Structure object
  ObjektArt.i
  Type.i
  Temperatur.i
  x.i
  y.i
EndStructure

Structure object_temp
  Type.i ;0=Fest 1=Partikel 2=Flüssig 3=Gas
  Temperatur.i
  Mass.i
  Fraction.i
  R.i
  G.i
  B.i
  MeltTemp.i
  MeltType.i
EndStructure

Structure GUIobject
  GUIArt.i
  x.i
  y.i
EndStructure

Global Dim world.object(0)
Global Dim objects.object_temp(0)

Global Dim GUI.GUIobject(0)

Global quit = 0
Global engine_break = 0
Global engine_particle_deleted = 0

Global actual_object = 0
Global brush_size = 1
Global Dim objects_gui.s(0)

If ExamineDirectory(0,"data","*.part")
  While NextDirectoryEntry(0)
    If ReadFile(0,"data\"+DirectoryEntryName(0))
      ReDim objects(ArraySize(objects())+1)
      objects(ArraySize(objects()))\Type.i = Val(ReadString(0))
      objects(ArraySize(objects()))\Temperatur.i = Val(ReadString(0))
      objects(ArraySize(objects()))\R.i = Val(ReadString(0))
      objects(ArraySize(objects()))\G.i = Val(ReadString(0))
      objects(ArraySize(objects()))\B.i = Val(ReadString(0))
      Select objects(ArraySize(objects()))\Type.i ;0=Fest 1=Partikel 2=Flüssig 3=Gas
        Case 0
          objects(ArraySize(objects()))\MeltTemp.i = Val(ReadString(0))
          objects(ArraySize(objects()))\MeltType.i = Val(ReadString(0))

        Case 1

        Case 2

        Case 3
      EndSelect
      ReDim objects_gui.s(ArraySize(objects_gui.s())+1)
      objects_gui.s(ArraySize(objects_gui.s())) = RemoveString(DirectoryEntryName(0),".part")
      Debug "Add Object"
    EndIf
  Wend
EndIf

objects_gui.s(0) = "Sand"

Global mouse_x = 0
Global mouse_y = 0

Procedure help_list_add(List thelist.s(),item.s)
  AddElement(thelist.s())
  thelist.s() = item.s
EndProcedure

Procedure particle_empty(x,y)
  For i=0 To ArraySize(world())
    If world(i)\x = x And world(i)\y = y
       ProcedureReturn 0
    EndIf
  Next
  ProcedureReturn 1
EndProcedure

Procedure particle_collison_free(x,y,own_x,own_y)
  For i=0 To ArraySize(world())
    If world(i)\x = x And world(i)\y = y And world(i)\x <> own_x And world(i)\y <> own_y
      Debug "Nope"
      ProcedureReturn 0
    EndIf
  Next
  ProcedureReturn 1
EndProcedure

Procedure particle_create(x,y)
  ;For bs = 0 To brush_size-1
    If particle_empty(x,y)
      ReDim world(ArraySize(world())+1)
      world(ArraySize(world()))\x = x
      world(ArraySize(world()))\y = y
      world(ArraySize(world()))\ObjektArt = actual_object
    EndIf
  ;Next
EndProcedure

Procedure particle_delete(particle_id,x = 0,y = 0)
  If particle_id > -1
    world(particle_id)\x = -1
    world(particle_id)\y = -1
    world(particle_id)\ObjektArt = -1
    engine_particle_deleted + 1
  ElseIf x <> -1 And y <> -1
    For i=0 To ArraySize(world())
      If world(i)\x = x And world(i)\y = y
        world(i)\x = -1
        world(i)\y = -1
        world(i)\ObjektArt = -1
        engine_particle_deleted + 1
        Break
      EndIf
    Next
  Else
    ProcedureReturn 0
  EndIf
EndProcedure

Procedure RandomEx(max,min)
  rand = Random(2,1)
  Select rand
    Case 1
      ProcedureReturn -Random(max,min)
    Case 2
      ProcedureReturn Random(max,min)
  EndSelect
EndProcedure

Procedure particle_clear()
  SortStructuredArray(world(),#PB_Sort_Descending,OffsetOf(object\objektart),TypeOf(object\objektart))
  Debug "EPD"+Str(engine_particle_deleted)
  ReDim world(ArraySize(world())-engine_particle_deleted)
  engine_particle_deleted = 0
EndProcedure

Procedure particle_update(particle_id)
  ;Update - Partikel Physik
  x = world(particle_id)\x
  y = world(particle_id)\y
  ObjektArt = world(particle_id)\ObjektArt
  If ObjektArt > -1
  If ObjektArt = 0
    x_new = x+RandomEx(1,0)
    y_new = y+Random(1,0)
    ObjektArt_new = ObjektArt
  Else
    Select objects(ObjektArt)\Type ;0=Fest 1=Partikel 2=Flüssig 3=Gas
      Case 0
        ObjektArt_new = ObjektArt

      Case 1
        x_new = x+RandomEx(1,0)
        y_new = y+Random(1,0)
        If world(particle_id)\Temperatur >= objects(ObjektArt)\MeltTemp
          ObjektArt_new = objects(ObjektArt)\MeltType
        EndIf

    EndSelect
  EndIf
  If particle_empty(x,y) = 1
    x_new = x
    y_new = y
  EndIf
  If x_new > #World_Width Or y_new > #World_Height Or x_new < 0 Or y_new < 0
    particle_delete(particle_id)
  Else
    world(particle_id)\x = x_new
    world(particle_id)\y = y_new
    world(particle_id)\ObjektArt = ObjektArt_new
  EndIf
  EndIf
EndProcedure

Procedure particle_draw()
  ;Draw - Partikel zeichnen
  For i=0 To ArraySize(world())
    If world(i)\x < 801 And world(i)\x > -1 And world(i)\y < 601 And world(i)\y > -1
      If world(i)\ObjektArt > -1
        If world(i)\ObjektArt = 0
          Plot(world(i)\x,world(i)\y,RGB(255,255,24))
        Else
          Plot(world(i)\x,world(i)\y,RGB(objects(world(i)\ObjektArt)\R,objects(world(i)\ObjektArt)\G,objects(world(i)\ObjektArt)\B))
        EndIf
      EndIf
    EndIf
  Next
EndProcedure

Procedure engine_update()
  ;Update - Physik
  Debug ArraySize(world())
  For engine_update_repeat=0 To 1
    If engine_break = 0
      For i=1 To ArraySize(world())
        particle_update(i)
      Next
    EndIf
  For engine_update_mouse=0 To 3
  ExamineMouse()
  mouse_x = MouseX()
  mouse_y = MouseY()
  ExamineKeyboard()
  If MouseWheel() < 0 XOr KeyboardReleased(#PB_Key_P)
    If actual_object > 0
      actual_object - 1
    EndIf
  ElseIf MouseWheel() > 0 XOr KeyboardReleased(#PB_Key_O)
    If actual_object < ArraySize(objects_gui())
      actual_object + 1
    EndIf
  EndIf
  If MouseButton(#PB_MouseButton_Left)
    particle_create(mouse_x,mouse_y)
  EndIf
  If MouseButton(#PB_MouseButton_Right)
    particle_delete(-1,mouse_x,mouse_y)
  EndIf
  If MouseButton(#PB_MouseButton_Middle)
    actual_object = 0
  EndIf
  Next
  Next
  If KeyboardPushed(#PB_Key_Escape)
    quit = 1
  EndIf
  If KeyboardPushed(#PB_Key_Add)
    brush_size + 1
  EndIf
  If KeyboardPushed(#PB_Key_Subtract)
    If brush_size > 1
      brush_size - 1
    EndIf
  EndIf
  If KeyboardReleased(#PB_Key_Space)
    If engine_break
      engine_break = 0
    Else
      engine_break = 1
    EndIf
  EndIf
  If engine_particle_deleted
    particle_clear()
  EndIf
EndProcedure

Procedure engine_gui()
  ;GUI Events
EndProcedure

Procedure engine_draw()
  ClearScreen(RGB(0,0,0))
  StartDrawing(ScreenOutput())
  Circle(mouse_x,mouse_y,brush_size)
  If brush_size > 1
    Circle(mouse_x,mouse_y,brush_size-1,RGB(0,0,0))
  EndIf
  particle_draw()
  DrawText(10,10,"Auswahl: "+objects_gui.s(actual_object))
  If engine_break
    DrawText(10,25,"Break")
  EndIf
  StopDrawing()
  FlipBuffers()
EndProcedure

Repeat
  WEvent = WindowEvent()
  Select WEvent
    Case #PB_Event_CloseWindow
      quit = 1

    Case #PB_Event_Gadget
      GEvent = EventGadget()
      Select GEvent
        Case 0

      EndSelect

  EndSelect

  engine_update()

  engine_gui()

  engine_draw()

  Delay(20)
Until quit = 1
FreeArray(objects_gui())
FreeArray(GUI())
FreeArray(world())
; IDE Options = PureBasic 5.20 LTS (Windows - x86)
; CursorPosition = 70
; FirstLine = 48
; Folding = AC-
; EnableXP
; Executable = C:\Users\Rebooz\Desktop\psbox_r0001.exe
; DisableDebugger
; CompileSourceDirectory
; IncludeVersionInfo
; VersionField0 = 0.0.0.0
; VersionField1 = 0.0.0.0
; VersionField2 = Games-Table
; VersionField3 = Physic Sandbox
; VersionField4 = r0001
; VersionField5 = r0001
; VersionField6 = WOOOOOOW Paritkel :D
; VersionField7 = Physic Sandbox
; VersionField8 = psbox_r0001.exe
; VersionField9 = (c)2013 by Steffen K.
; VersionField10 = (c)2013 by Steffen K.
; VersionField13 = games-table@web.de
; VersionField14 = games-table.de.tl