Home

Add

Edit

Without Linenumbers

Code in Textfield

Download

  1. '################################################################################
    
  2. ' TPM - FlowNet - 03.06.2008
    
  3. '################################################################################
    
  4. '################################################################################
    
  5. 'a =  1 Partikel hinzufügen (1x pro tastendruck)
    
  6. 'b =  1 Partikel hinzufügen (solange taste gedrückt)
    
  7. 'm = 10 Partikel hinzufügen (solange taste gedrückt)
    
  8. 'c = Alle Partikel löschen
    
  9. 
    
  10. 'o = Druckfarbe / Zählerfarbe umschalten
    
  11. 'w = Flusswand abschalten / einschalten
    
  12. 
    
  13. 'n = Wand hinzufügen
    
  14. 'Linke masutaste = Wand verschieben
    
  15. 'Rechte Maustaste = Wand löschen
    
  16. 'Mausrad = Wandgrösse ändern
    
  17. '################################################################################
    
  18. 
    
  19. 
    
  20. 
    
  21. 
    
  22. 
    
  23. 
    
  24. 
    
  25. 
    
  26. Dim Shared G_Room_Width As Uinteger = 800 '600
    
  27. Dim Shared G_Room_Height As Uinteger = 600 '400
    
  28. 
    
  29. 
    
  30. Type G_Particle_2D_Type
    
  31.     V_InUse As Ubyte
    
  32.     X As Single
    
  33.     Y As Single
    
  34.     SpeedX As Single
    
  35.     SpeedY As Single
    
  36.     LX As Single
    
  37.     LY As Single
    
  38.     InertiaX As Single
    
  39.     InertiaY As Single
    
  40.     InertiaTime As Single
    
  41.     V_Presure As Single
    
  42.     V_Color As Uinteger
    
  43. End Type
    
  44. Dim Shared G_ParticleD() As G_Particle_2D_Type
    
  45. Dim Shared G_ParticleC As Uinteger
    
  46. Dim Shared G_TColorG As Ubyte
    
  47. Dim Shared G_TColorB As Ubyte
    
  48. Dim Shared G_ShowTColor As Ubyte
    
  49. 
    
  50. 
    
  51. Type G_Obj_2D_Type
    
  52.     V_InUse As Ubyte
    
  53.     X As Integer
    
  54.     Y As Integer
    
  55.     Size As Uinteger
    
  56.     TColor As Uinteger
    
  57. End Type
    
  58. Dim Shared G_ObjD() As G_Obj_2D_Type
    
  59. Dim Shared G_ObjC As Uinteger
    
  60. 
    
  61. 
    
  62. 
    
  63. 
    
  64. 
    
  65. Dim Shared G_Density As Single = 20
    
  66. Dim Shared G_FlowReaction As Single = 0.1
    
  67. Dim Shared G_ChaosReaction As Single = 300
    
  68. Dim Shared G_SubRuntime As Uinteger = 6
    
  69. Dim Shared G_ShowSize As Uinteger = 5
    
  70. Dim Shared G_InertiaTime As Single = 1.2
    
  71. Dim Shared G_FlowOff As Ubyte = 1
    
  72. 
    
  73. 
    
  74. 
    
  75. 
    
  76. 
    
  77. 
    
  78. Sub Particle_Add()
    
  79. Dim XID As Uinteger
    
  80. For X As ULong = 1 To G_ParticleC
    
  81.     If G_ParticleD(X).V_InUse = 0 Then XID = X: Exit For
    
  82. Next
    
  83. If XID = 0 Then
    
  84.     G_ParticleC += 1
    
  85.     XID = G_ParticleC
    
  86.     Redim Preserve G_ParticleD(G_ParticleC) As G_Particle_2D_Type
    
  87. End If
    
  88. If G_TColorG Mod 2 = G_TColorB Mod 2 Then
    
  89.     G_TColorB += 1
    
  90. Else: G_TColorG += 1
    
  91. End If
    
  92. With G_ParticleD(XID)
    
  93.     .V_InUse = 1
    
  94.     .X = 0
    
  95.     .Y = Int((Rnd * G_Room_Height) + 1)
    
  96.     .SpeedX = 0
    
  97.     .SpeedY = 0
    
  98.     .LX = .LX
    
  99.     .LY = .LY
    
  100.     .InertiaX = 0
    
  101.     .InertiaY = 0
    
  102.     .InertiaTime = 0
    
  103.     .V_Presure = 0
    
  104.     .V_Color = Rgb(255,  G_TColorG, G_TColorB)
    
  105. End With
    
  106. End Sub
    
  107. 
    
  108. 
    
  109. 
    
  110. 
    
  111. 
    
  112. Function Obj_Add() As Uinteger
    
  113. Dim XID As Uinteger
    
  114. For X As ULong = 1 To G_ObjC
    
  115.     If G_ObjD(X).V_InUse = 0 Then XID = X: Exit For
    
  116. Next
    
  117. If XID = 0 Then
    
  118.     G_ObjC += 1
    
  119.     XID = G_ObjC
    
  120.     Redim Preserve G_ObjD(G_ObjC) As G_Obj_2D_Type
    
  121. End If
    
  122. With G_ObjD(XID)
    
  123.     .V_InUse = 1
    
  124.     .X = 0
    
  125.     .Y = 0
    
  126.     .Size = 100
    
  127.     .TColor = Rgb(100 + Int((Rnd * 155) + 1), 100 + Int((Rnd * 155) + 1), 100 + Int((Rnd * 155) + 1))
    
  128. End With
    
  129. Return XID
    
  130. End Function
    
  131. 
    
  132. 
    
  133. Function Obj_GetOnMouse(V_X As Integer, V_Y As Integer) As Uinteger
    
  134. For X As ULong = G_ObjC To 1 Step - 1
    
  135.     With G_ObjD(X)
    
  136.         If V_X >= .X And V_X <= .X + .Size And V_Y >= .Y And V_Y <= .Y + .Size Then Return X
    
  137.     End With
    
  138. Next
    
  139. End Function
    
  140. 
    
  141. 
    
  142. 
    
  143. 
    
  144. 
    
  145. 
    
  146. Sub Particle_Calculate_Reorientation()
    
  147. Dim X As ULong
    
  148. Dim Y As ULong
    
  149. Dim RX As Single
    
  150. Dim RY As Single
    
  151. Dim NX As Single
    
  152. Dim NY As Single
    
  153. Dim DX As Ubyte
    
  154. Dim DY As Ubyte
    
  155. For X = 1 To G_ParticleC
    
  156.     With G_ParticleD(X)
    
  157.         If .V_InUse = 1 Then
    
  158.             .InertiaTime += G_InertiaTime
    
  159.             If .InertiaTime >= 3 Then
    
  160.                 .InertiaX /= 2
    
  161.                 .InertiaY /= 2
    
  162.                 .InertiaTime = 0
    
  163.             End If
    
  164.             .X += .InertiaX
    
  165.             .Y += .InertiaY
    
  166.             .V_Presure = 0
    
  167.             For Y = 1 To G_ParticleC
    
  168.                 If G_ParticleD(Y).V_InUse = 1 Then
    
  169.                     If X <> Y Then
    
  170.                         If .X < G_ParticleD(Y).X Then
    
  171.                             If .Y < G_ParticleD(Y).Y Then
    
  172.                                 If G_ParticleD(Y).X - .X < G_Density Then
    
  173.                                     If G_ParticleD(Y).Y - .Y < G_Density Then
    
  174.                                         RX = ((G_Density - (G_ParticleD(Y).X - .X)) * G_FlowReaction) + (Int((Rnd * 10) + 1) / G_ChaosReaction)
    
  175.                                         .X -= RX
    
  176.                                         G_ParticleD(Y).X += RX
    
  177.                                         RY = ((G_Density - (G_ParticleD(Y).Y - .Y)) * G_FlowReaction) + (Int((Rnd * 10) + 1) / G_ChaosReaction)
    
  178.                                         .Y -= RY
    
  179.                                         G_ParticleD(Y).Y += RY
    
  180.                                         .SpeedX = -RX * G_SubRuntime
    
  181.                                         .SpeedY = -RY * G_SubRuntime
    
  182.                                         .V_Presure = 1024 / G_Density * ((Abs(RX) + Abs(RY)) / 2)
    
  183.                                     End If
    
  184.                                 End If
    
  185.                             Else
    
  186.                                 If G_ParticleD(Y).X - .X < G_Density Then
    
  187.                                     If .Y - G_ParticleD(Y).Y < G_Density Then
    
  188.                                         RX = ((G_Density - (G_ParticleD(Y).X - .X)) * G_FlowReaction) + (Int((Rnd * 10) + 1) / G_ChaosReaction)
    
  189.                                         .X -= RX
    
  190.                                         G_ParticleD(Y).X += RX
    
  191.                                         RY = ((G_Density - (.Y - G_ParticleD(Y).Y)) * G_FlowReaction) + (Int((Rnd * 10) + 1) / G_ChaosReaction)
    
  192.                                         .Y += RY
    
  193.                                         G_ParticleD(Y).Y -= RY
    
  194.                                         .SpeedX = -RX * G_SubRuntime
    
  195.                                         .SpeedY = +RY * G_SubRuntime
    
  196.                                         .V_Presure = 1024 / G_Density * ((Abs(RX) + Abs(RY)) / 2)
    
  197.                                     End If
    
  198.                                 End If
    
  199.                             End If
    
  200.                         Else
    
  201.                             If .Y < G_ParticleD(Y).Y Then
    
  202.                                 If .X - G_ParticleD(Y).X < G_Density Then
    
  203.                                     If G_ParticleD(Y).Y - .Y < G_Density Then
    
  204.                                         RX = ((G_Density - (.X - G_ParticleD(Y).X)) * G_FlowReaction) + (Int((Rnd * 10) + 1) / G_ChaosReaction)
    
  205.                                         .X += RX
    
  206.                                         G_ParticleD(Y).X -= RX
    
  207.                                         RY = ((G_Density - (G_ParticleD(Y).Y - .Y)) * G_FlowReaction) + (Int((Rnd * 10) + 1) / G_ChaosReaction)
    
  208.                                         .Y -= RY
    
  209.                                         G_ParticleD(Y).Y += RY
    
  210.                                         .SpeedX = +RX * G_SubRuntime
    
  211.                                         .SpeedY = -RY * G_SubRuntime
    
  212.                                         .V_Presure = 1024 / G_Density * ((Abs(RX) + Abs(RY)) / 2)
    
  213.                                     End If
    
  214.                                 End If
    
  215.                             Else
    
  216.                                 If .X - G_ParticleD(Y).X < G_Density Then
    
  217.                                     If .Y - G_ParticleD(Y).Y < G_Density Then
    
  218.                                         RX = ((G_Density - (.X - G_ParticleD(Y).X)) * G_FlowReaction) + (Int((Rnd * 10) + 1) / G_ChaosReaction)
    
  219.                                         .X += RX
    
  220.                                         G_ParticleD(Y).X -= RX
    
  221.                                         RY = ((G_Density - (.Y - G_ParticleD(Y).Y)) * G_FlowReaction) + (Int((Rnd * 10) + 1) / G_ChaosReaction)
    
  222.                                         .Y += RY
    
  223.                                         G_ParticleD(Y).Y -= RY
    
  224.                                         .SpeedX = +RX * G_SubRuntime
    
  225.                                         .SpeedY = +RY * G_SubRuntime
    
  226.                                         .V_Presure = 1024 / G_Density * ((Abs(RX) + Abs(RY)) / 2)
    
  227.                                     End If
    
  228.                                 End If
    
  229.                             End If
    
  230.                         End If
    
  231.                     End If
    
  232.                 End If
    
  233.             Next
    
  234. 
    
  235.             For Y = 1 To G_ObjC
    
  236.                 If G_ObjD(Y).V_InUse = 1 Then
    
  237.                     If (.X > G_ObjD(Y).X - G_Density) And (.X < G_ObjD(Y).X + G_ObjD(Y).Size + G_Density) Then
    
  238.                         If (.Y > G_ObjD(Y).Y - G_Density) And (.Y < G_ObjD(Y).Y + G_ObjD(Y).Size + G_Density) Then
    
  239.                             If .X - (G_ObjD(Y).X - G_Density) < (G_ObjD(Y).X + G_ObjD(Y).Size + G_Density) - .X Then
    
  240.                                 NX = .X - (G_ObjD(Y).X - G_Density): DX = 1
    
  241.                             Else: NX = (G_ObjD(Y).X + G_ObjD(Y).Size + G_Density) - .X: DX = 2
    
  242.                             End If
    
  243.                             If .Y - (G_ObjD(Y).Y - G_Density) < (G_ObjD(Y).Y + G_ObjD(Y).Size + G_Density) - .Y Then
    
  244.                                 NY = .Y - (G_ObjD(Y).Y - G_Density): DY = 1
    
  245.                             Else: NY = (G_ObjD(Y).Y + G_ObjD(Y).Size + G_Density) - .Y: DY = 2
    
  246.                             End If
    
  247.                             If NX < NY Then
    
  248.                                 If DX = 1 Then
    
  249.                                     .X = G_ObjD(Y).X - G_Density
    
  250.                                 Else: .X = G_ObjD(Y).X + G_ObjD(Y).Size + G_Density
    
  251.                                 End If
    
  252.                             Else
    
  253.                                 If DY = 1 Then
    
  254.                                     .Y = G_ObjD(Y).Y - G_Density
    
  255.                                 Else: .Y = G_ObjD(Y).Y + G_ObjD(Y).Size + G_Density
    
  256.                                 End If
    
  257.                             End If
    
  258.                         End If
    
  259.                     End If
    
  260.                 End If
    
  261.             Next
    
  262.             .InertiaX += (.X - .LX) / 4
    
  263.             .InertiaY += (.Y - .LY) / 4
    
  264.             .LX = .X
    
  265.             .LY = .Y
    
  266.             DY = 0
    
  267.             If .X - G_Density < 0 Then DY = 1:                       .X = G_Density + ((Abs(.X - G_Density) * G_FlowReaction) / 2) + (Int((Rnd * 10) + 1) / G_ChaosReaction)
    
  268.             If .Y - G_Density < 0 Then DY = DY Or 2:                 .Y = G_Density + ((Abs(.Y - G_Density) * G_FlowReaction) / 2) + (Int((Rnd * 10) + 1) / G_ChaosReaction)
    
  269.             If .X + G_Density > G_Room_Width Then
    
  270.                 If G_FlowOff = 1 Then
    
  271.                     DY = DY Or 1
    
  272.                     .X = (G_Room_Width - G_Density) - (Abs((.X + G_Density) - G_Room_Width))' * G_FlowReaction) / 2) + (int((rnd * 10) + 1) / G_ChaosReaction)
    
  273.                 Else: .V_InUse = 0
    
  274.                 End If
    
  275.             End If
    
  276.             If .Y + G_Density > G_Room_Height Then DY = DY Or 2:     .Y = (G_Room_Height - G_Density) - (Abs((.Y + G_Density) - G_Room_Height))' * G_FlowReaction) / 2) + (int((rnd * 10) + 1) / G_ChaosReaction)
    
  277.             If DY And 1 <> 0 Then
    
  278.                 .InertiaX = (.X - .LX) / 4
    
  279.                 .LX = .X
    
  280.             End If
    
  281.             If (DY And 2 <> 0) Then
    
  282.                 .InertiaY = (.Y - .LY) / 4
    
  283.                 .LY = .Y
    
  284.             End If
    
  285. '           If .X - G_Density < 0 Then .X = (((-.X) + G_Density) * G_FlowReaction)) + (int((rnd * 10) + 1) / G_ChaosReaction)
    
  286. '           If .Y - G_Density < 0 Then .Y = G_Density + (int((rnd * 10) + 1) / G_ChaosReaction)
    
  287. '           If .X + G_Density > G_Room_Width Then .V_InUse = 0
    
  288. '           If .Y + G_Density > G_Room_Height Then .Y = G_Room_Height - G_Density - (int((rnd * 10) + 1) / G_ChaosReaction)
    
  289. 
    
  290.         End If
    
  291.     End With
    
  292. Next
    
  293. End Sub
    
  294. 
    
  295. 
    
  296. 
    
  297. Screenres G_Room_Width + 6, G_Room_Height + 6, 24
    
  298. Randomize Timer
    
  299. Dim XTot As Double
    
  300. Dim X As ULong
    
  301. Dim AKey As String
    
  302. Dim LKey As String
    
  303. Dim XCol As Uinteger
    
  304. Dim MX As Integer
    
  305. Dim MY As Integer
    
  306. Dim MZ As Integer
    
  307. Dim MB As Integer
    
  308. Dim MZL As Integer
    
  309. Dim TZ As Integer
    
  310. Dim OBJID As Uinteger
    
  311. Dim LOBJID As Uinteger
    
  312. For X = 1 To 200
    
  313.     Particle_Add()
    
  314. Next
    
  315. Dim XParCount As ULong
    
  316. Do
    
  317.     XParCount = 0
    
  318.     For X = 1 To G_ParticleC
    
  319.         If G_ParticleD(X).V_InUse = 1 Then XParCount += 1
    
  320.     Next
    
  321.     If XParCount < G_ParticleC Then
    
  322.         For X = 1 To G_ParticleC - XParCount
    
  323.             Particle_Add()
    
  324.         Next
    
  325.     End If
    
  326.     Particle_Calculate_Reorientation()
    
  327.     Screenlock
    
  328.     Line (0, 0)-(G_Room_Width + 6, G_Room_Height + 6), Rgb(0, 0, 0), BF
    
  329. 
    
  330.     For X = 1 To G_ObjC
    
  331.         With G_ObjD(X)
    
  332.             If .V_InUse = 1 Then Line (.X, .Y)-(.X + .Size, .Y + .Size), .TColor, BF
    
  333.         End With
    
  334.     Next
    
  335. 
    
  336.     For X = 1 To G_ParticleC
    
  337.         With G_ParticleD(X)
    
  338.             If .V_InUse = 1 Then
    
  339.                 If G_ShowTColor = 0 Then
    
  340.                     MX = .V_Presure * 5
    
  341.                     If MX > 255 Then MX = 255
    
  342.                     If MX < 0 Then MX = 0
    
  343.                     XCol = Rgb(MX, 255 - MX, 0)
    
  344.                 Else: XCol = .V_Color
    
  345.                 End If
    
  346.                 'PSet (3 + .X, 3 + .Y), XCol
    
  347. '               Line (1 + .X - G_ShowSize, 1 + .Y - G_ShowSize)-(1 + G_ShowSize + .X, 1 + G_ShowSize + .Y), XCol, BF
    
  348.                 Circle (1 + .X, 1 + .Y),G_ShowSize, XCol, , , , F
    
  349.             End If
    
  350.         End With
    
  351.     Next
    
  352.     Screenunlock
    
  353.     AKey = Inkey()
    
  354.     If AKey <> LKey Then
    
  355.         Select Case Asc(AKey)
    
  356.             Case 27: Exit Do
    
  357.             Case Asc("a"): Particle_Add()
    
  358.             Case Asc("c")
    
  359.                 G_ParticleC = 0
    
  360.                 Redim G_ParticleD(G_ParticleC) As G_Particle_2D_Type
    
  361.             Case Asc("m")
    
  362.                 For X = 1 To 10
    
  363.                     Particle_Add()
    
  364.                 Next
    
  365.             Case Asc("o"): If G_ShowTColor = 0 Then G_ShowTColor = 1 Else G_ShowTColor = 0
    
  366.             Case Asc("n"): Obj_Add()
    
  367.             Case Asc("w"): If G_FlowOff = 0 Then G_FlowOff = 1 Else G_FlowOff = 0
    
  368.         End Select
    
  369.         LKey = AKey
    
  370.     Else
    
  371.         If AKey = "b" Then Particle_Add()
    
  372.     End If
    
  373.     Getmouse MX, MY, MZ, MB
    
  374.     TZ = (MZ - MZL) * 5
    
  375.     If MB > 0 Or (MB = 0 And TZ <> 0) Then
    
  376.         If LOBJID = 0 Then OBJID = Obj_GetOnMouse(MX, MY)
    
  377.         If OBJID > 0 Then
    
  378.             LOBJID = OBJID
    
  379.             With G_ObjD(OBJID)
    
  380.                 If MB = 1 Then
    
  381.                     .X = MX - (.Size / 2)
    
  382.                     .Y = MY - (.Size / 2)
    
  383.                 End If
    
  384.                 .Size += TZ
    
  385.                 If .Size < 10 Then .Size = 10
    
  386.                 If .Size > 200 Then .Size = 200
    
  387.             End With
    
  388.             If MB = 2 Then G_ObjD(OBJID).V_InUse = 0
    
  389.         End If
    
  390.         MZL = MZ
    
  391.     Else: If MB = 0 Then LOBJID = 0
    
  392.     End If
    
  393.     If XTot < Timer Then
    
  394.         Sleep 1, 1
    
  395.         XTot = Timer + 0.01
    
  396.     End If
    
  397. Loop
    
  398. Screen 0
    
  399. End