Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- 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
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement