SHARE
TWEET

Physic Sandbox r0001

a guest Jan 26th, 2014 4 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. If InitKeyboard() = 0 XOr InitSprite() = 0 XOr InitMouse() = 0
  2.   MessageRequester("Fehler","Kein DirectX installiert")
  3.   End
  4. EndIf
  5.  
  6. #World_Width = 300
  7. #World_Height = 200
  8.  
  9. OpenWindow(0,0,0,#World_Width,#World_Height,"Physic Sandbox r0001",#PB_Window_ScreenCentered)
  10. If OpenWindowedScreen(WindowID(0),0,0,801,601) = 0
  11.   MessageRequester("Fehler","Kein DirectX installiert")
  12.   End
  13. EndIf
  14.  
  15. OpenWindow(1,0,0,200,300,"Physic Sandbox Debug")
  16.  
  17. Structure object
  18.   ObjektArt.i
  19.   Type.i
  20.   Temperatur.i
  21.   x.i
  22.   y.i
  23. EndStructure
  24.  
  25. Structure object_temp
  26.   Type.i ;0=Fest 1=Partikel 2=Flüssig 3=Gas
  27.   Temperatur.i
  28.   Mass.i
  29.   Fraction.i
  30.   R.i
  31.   G.i
  32.   B.i
  33.   MeltTemp.i
  34.   MeltType.i
  35. EndStructure
  36.  
  37. Structure GUIobject
  38.   GUIArt.i
  39.   x.i
  40.   y.i
  41. EndStructure
  42.  
  43. Global Dim world.object(0)
  44. Global Dim objects.object_temp(0)
  45.  
  46. Global Dim GUI.GUIobject(0)
  47.  
  48. Global quit = 0
  49. Global engine_break = 0
  50. Global engine_particle_deleted = 0
  51.  
  52. Global actual_object = 0
  53. Global brush_size = 1
  54. Global Dim objects_gui.s(0)
  55.  
  56. If ExamineDirectory(0,"data","*.part")
  57.   While NextDirectoryEntry(0)
  58.     If ReadFile(0,"data\"+DirectoryEntryName(0))
  59.       ReDim objects(ArraySize(objects())+1)
  60.       objects(ArraySize(objects()))\Type.i = Val(ReadString(0))
  61.       objects(ArraySize(objects()))\Temperatur.i = Val(ReadString(0))
  62.       objects(ArraySize(objects()))\R.i = Val(ReadString(0))
  63.       objects(ArraySize(objects()))\G.i = Val(ReadString(0))
  64.       objects(ArraySize(objects()))\B.i = Val(ReadString(0))
  65.       Select objects(ArraySize(objects()))\Type.i ;0=Fest 1=Partikel 2=Flüssig 3=Gas
  66.         Case 0
  67.           objects(ArraySize(objects()))\MeltTemp.i = Val(ReadString(0))
  68.           objects(ArraySize(objects()))\MeltType.i = Val(ReadString(0))
  69.          
  70.         Case 1
  71.          
  72.         Case 2
  73.          
  74.         Case 3
  75.       EndSelect
  76.       ReDim objects_gui.s(ArraySize(objects_gui.s())+1)
  77.       objects_gui.s(ArraySize(objects_gui.s())) = RemoveString(DirectoryEntryName(0),".part")
  78.       Debug "Add Object"
  79.     EndIf
  80.   Wend
  81. EndIf
  82.  
  83. objects_gui.s(0) = "Sand"
  84.  
  85. Global mouse_x = 0
  86. Global mouse_y = 0
  87.  
  88. Procedure help_list_add(List thelist.s(),item.s)
  89.   AddElement(thelist.s())
  90.   thelist.s() = item.s
  91. EndProcedure
  92.  
  93. Procedure particle_empty(x,y)
  94.   For i=0 To ArraySize(world())
  95.     If world(i)\x = x And world(i)\y = y
  96.        ProcedureReturn 0
  97.     EndIf
  98.   Next
  99.   ProcedureReturn 1
  100. EndProcedure
  101.  
  102. Procedure particle_collison_free(x,y,own_x,own_y)
  103.   For i=0 To ArraySize(world())
  104.     If world(i)\x = x And world(i)\y = y And world(i)\x <> own_x And world(i)\y <> own_y
  105.       Debug "Nope"
  106.       ProcedureReturn 0
  107.     EndIf
  108.   Next
  109.   ProcedureReturn 1
  110. EndProcedure
  111.  
  112. Procedure particle_create(x,y)
  113.   ;For bs = 0 To brush_size-1
  114.     If particle_empty(x,y)
  115.       ReDim world(ArraySize(world())+1)
  116.       world(ArraySize(world()))\x = x
  117.       world(ArraySize(world()))\y = y
  118.       world(ArraySize(world()))\ObjektArt = actual_object
  119.     EndIf
  120.   ;Next
  121. EndProcedure
  122.  
  123. Procedure particle_delete(particle_id,x = 0,y = 0)
  124.   If particle_id > -1
  125.     world(particle_id)\x = -1
  126.     world(particle_id)\y = -1
  127.     world(particle_id)\ObjektArt = -1
  128.     engine_particle_deleted + 1
  129.   ElseIf x <> -1 And y <> -1
  130.     For i=0 To ArraySize(world())
  131.       If world(i)\x = x And world(i)\y = y
  132.         world(i)\x = -1
  133.         world(i)\y = -1
  134.         world(i)\ObjektArt = -1
  135.         engine_particle_deleted + 1
  136.         Break
  137.       EndIf
  138.     Next
  139.   Else
  140.     ProcedureReturn 0
  141.   EndIf
  142. EndProcedure
  143.  
  144. Procedure RandomEx(max,min)
  145.   rand = Random(2,1)
  146.   Select rand
  147.     Case 1
  148.       ProcedureReturn -Random(max,min)
  149.     Case 2
  150.       ProcedureReturn Random(max,min)
  151.   EndSelect
  152. EndProcedure
  153.  
  154. Procedure particle_clear()
  155.   SortStructuredArray(world(),#PB_Sort_Descending,OffsetOf(object\objektart),TypeOf(object\objektart))
  156.   Debug "EPD"+Str(engine_particle_deleted)
  157.   ReDim world(ArraySize(world())-engine_particle_deleted)
  158.   engine_particle_deleted = 0
  159. EndProcedure
  160.  
  161. Procedure particle_update(particle_id)
  162.   ;Update - Partikel Physik
  163.   x = world(particle_id)\x
  164.   y = world(particle_id)\y
  165.   ObjektArt = world(particle_id)\ObjektArt
  166.   If ObjektArt > -1
  167.   If ObjektArt = 0
  168.     x_new = x+RandomEx(1,0)
  169.     y_new = y+Random(1,0)
  170.     ObjektArt_new = ObjektArt
  171.   Else
  172.     Select objects(ObjektArt)\Type ;0=Fest 1=Partikel 2=Flüssig 3=Gas
  173.       Case 0
  174.         ObjektArt_new = ObjektArt
  175.        
  176.       Case 1
  177.         x_new = x+RandomEx(1,0)
  178.         y_new = y+Random(1,0)
  179.         If world(particle_id)\Temperatur >= objects(ObjektArt)\MeltTemp
  180.           ObjektArt_new = objects(ObjektArt)\MeltType
  181.         EndIf
  182.        
  183.     EndSelect
  184.   EndIf
  185.   If particle_empty(x,y) = 1
  186.     x_new = x
  187.     y_new = y
  188.   EndIf
  189.   If x_new > #World_Width Or y_new > #World_Height Or x_new < 0 Or y_new < 0
  190.     particle_delete(particle_id)
  191.   Else
  192.     world(particle_id)\x = x_new
  193.     world(particle_id)\y = y_new
  194.     world(particle_id)\ObjektArt = ObjektArt_new
  195.   EndIf
  196.   EndIf
  197. EndProcedure
  198.  
  199. Procedure particle_draw()
  200.   ;Draw - Partikel zeichnen
  201.   For i=0 To ArraySize(world())
  202.     If world(i)\x < 801 And world(i)\x > -1 And world(i)\y < 601 And world(i)\y > -1
  203.       If world(i)\ObjektArt > -1
  204.         If world(i)\ObjektArt = 0
  205.           Plot(world(i)\x,world(i)\y,RGB(255,255,24))
  206.         Else
  207.           Plot(world(i)\x,world(i)\y,RGB(objects(world(i)\ObjektArt)\R,objects(world(i)\ObjektArt)\G,objects(world(i)\ObjektArt)\B))
  208.         EndIf
  209.       EndIf
  210.     EndIf
  211.   Next
  212. EndProcedure
  213.  
  214. Procedure engine_update()
  215.   ;Update - Physik
  216.   Debug ArraySize(world())
  217.   For engine_update_repeat=0 To 1
  218.     If engine_break = 0
  219.       For i=1 To ArraySize(world())
  220.         particle_update(i)
  221.       Next
  222.     EndIf
  223.   For engine_update_mouse=0 To 3
  224.   ExamineMouse()
  225.   mouse_x = MouseX()
  226.   mouse_y = MouseY()
  227.   ExamineKeyboard()
  228.   If MouseWheel() < 0 XOr KeyboardReleased(#PB_Key_P)
  229.     If actual_object > 0
  230.       actual_object - 1
  231.     EndIf
  232.   ElseIf MouseWheel() > 0 XOr KeyboardReleased(#PB_Key_O)
  233.     If actual_object < ArraySize(objects_gui())
  234.       actual_object + 1
  235.     EndIf
  236.   EndIf
  237.   If MouseButton(#PB_MouseButton_Left)
  238.     particle_create(mouse_x,mouse_y)
  239.   EndIf
  240.   If MouseButton(#PB_MouseButton_Right)
  241.     particle_delete(-1,mouse_x,mouse_y)
  242.   EndIf
  243.   If MouseButton(#PB_MouseButton_Middle)
  244.     actual_object = 0
  245.   EndIf
  246.   Next
  247.   Next
  248.   If KeyboardPushed(#PB_Key_Escape)
  249.     quit = 1
  250.   EndIf
  251.   If KeyboardPushed(#PB_Key_Add)
  252.     brush_size + 1
  253.   EndIf
  254.   If KeyboardPushed(#PB_Key_Subtract)
  255.     If brush_size > 1
  256.       brush_size - 1
  257.     EndIf
  258.   EndIf
  259.   If KeyboardReleased(#PB_Key_Space)
  260.     If engine_break
  261.       engine_break = 0
  262.     Else
  263.       engine_break = 1
  264.     EndIf
  265.   EndIf
  266.   If engine_particle_deleted
  267.     particle_clear()
  268.   EndIf
  269. EndProcedure
  270.  
  271. Procedure engine_gui()
  272.   ;GUI Events
  273. EndProcedure
  274.  
  275. Procedure engine_draw()
  276.   ClearScreen(RGB(0,0,0))
  277.   StartDrawing(ScreenOutput())
  278.   Circle(mouse_x,mouse_y,brush_size)
  279.   If brush_size > 1
  280.     Circle(mouse_x,mouse_y,brush_size-1,RGB(0,0,0))
  281.   EndIf
  282.   particle_draw()
  283.   DrawText(10,10,"Auswahl: "+objects_gui.s(actual_object))
  284.   If engine_break
  285.     DrawText(10,25,"Break")
  286.   EndIf
  287.   StopDrawing()
  288.   FlipBuffers()
  289. EndProcedure
  290.  
  291. Repeat
  292.   WEvent = WindowEvent()
  293.   Select WEvent
  294.     Case #PB_Event_CloseWindow
  295.       quit = 1
  296.      
  297.     Case #PB_Event_Gadget
  298.       GEvent = EventGadget()
  299.       Select GEvent
  300.         Case 0
  301.          
  302.       EndSelect
  303.      
  304.   EndSelect
  305.  
  306.   engine_update()
  307.  
  308.   engine_gui()
  309.  
  310.   engine_draw()
  311.  
  312.   Delay(20)
  313. Until quit = 1
  314. FreeArray(objects_gui())
  315. FreeArray(GUI())
  316. FreeArray(world())
  317. ; IDE Options = PureBasic 5.20 LTS (Windows - x86)
  318. ; CursorPosition = 70
  319. ; FirstLine = 48
  320. ; Folding = AC-
  321. ; EnableXP
  322. ; Executable = C:\Users\Rebooz\Desktop\psbox_r0001.exe
  323. ; DisableDebugger
  324. ; CompileSourceDirectory
  325. ; IncludeVersionInfo
  326. ; VersionField0 = 0.0.0.0
  327. ; VersionField1 = 0.0.0.0
  328. ; VersionField2 = Games-Table
  329. ; VersionField3 = Physic Sandbox
  330. ; VersionField4 = r0001
  331. ; VersionField5 = r0001
  332. ; VersionField6 = WOOOOOOW Paritkel :D
  333. ; VersionField7 = Physic Sandbox
  334. ; VersionField8 = psbox_r0001.exe
  335. ; VersionField9 = (c)2013 by Steffen K.
  336. ; VersionField10 = (c)2013 by Steffen K.
  337. ; VersionField13 = games-table@web.de
  338. ; VersionField14 = games-table.de.tl
RAW Paste Data
Top