Home

Add

Edit

Without Linenumbers

Code in Textfield

Download

  1. 'Funzt nur mit 32Bit Plane
    
  2. 
    
  3. 
    
  4. 'Modus
    
  5. Dim Shared G_Modus As Uinteger
    
  6. '1 = Normal
    
  7. '2 = Abstrakt Sinus Lava
    
  8. '3 = Psycho
    
  9. 
    
  10. G_Modus = 2
    
  11. 
    
  12. 'Bildshirm-dimension (und feuerbreite)
    
  13. Dim Shared G_Width As Uinteger = 800
    
  14. Dim Shared G_Height As Uinteger = 600
    
  15. 
    
  16. 'Feuer bild-puffer
    
  17. Dim G_FireImg As Any Ptr
    
  18. Dim G_FirePtr As Uinteger Ptr
    
  19. 'Hilfspuffer
    
  20. Dim G_TempImg As Any Ptr
    
  21. Dim G_TempPtr As Uinteger Ptr
    
  22. 
    
  23. 'Bildschirm, FeuerPuffer, TempPuffer init
    
  24. Screenres G_Width, G_Height, 32
    
  25. G_FireImg = Imagecreate(G_Width, G_Height)
    
  26. ImageInfo(G_FireImg, , , , , G_FirePtr)
    
  27. Line G_FireImg, (0, 0)-(G_Width - 1, G_Height - 1), &H00000000, BF
    
  28. G_TempImg = Imagecreate(G_Width, G_Height)
    
  29. ImageInfo(G_TempImg, , , , , G_TempPtr)
    
  30. Line G_TempImg, (0, 0)-(G_Width - 1, G_Height - 1), &H00000000, BF
    
  31. 
    
  32. 'Temp-var
    
  33. Dim X As Uinteger
    
  34. Dim Y As Uinteger
    
  35. Dim TNum As Uinteger
    
  36. Dim TPos As Uinteger
    
  37. Dim TCol As Uinteger
    
  38. Dim TPixelFrom As Uinteger
    
  39. Dim TPixelTo As Uinteger
    
  40. Dim TOK1 As Ubyte
    
  41. Dim TOK2 As Ubyte
    
  42. Dim TBlitTimer As Double
    
  43. Dim TX As Integer
    
  44. Dim TY As Integer
    
  45. Dim TZ As Integer
    
  46. Dim TC As Integer
    
  47. Dim TX2 As Integer
    
  48. Dim TMaxImgL As Uinteger = G_Width * G_Height
    
  49. 
    
  50. 'Bestimmt, wie schnell von einer Farbe zur nächsten gewechselt wird
    
  51. Dim TFaktorWeisGelb As Uinteger = &H0000004
    
  52. Dim TFaktorGelbRot As Uinteger = &H00000200 '&H00001000
    
  53. Dim TFaktorRotSchwarz As Uinteger = &H00020000
    
  54. 
    
  55. Dim PI180 As Double = (3.141593 / 180)
    
  56. 
    
  57. 'Hauptschleife
    
  58. Do Until Inkey() = Chr(27)
    
  59.     'Bild um eine Zeile nach oben verschieben und farbwert minimieren
    
  60.     TC = 0
    
  61.     For Y = 1 To G_Height - 1
    
  62.         Select Case G_Modus
    
  63.             Case 3
    
  64.                 TY += 1
    
  65.                 TY Mod= G_Height
    
  66.                 TX = (1 * Sin((180 + Y * 2) * 3.14 / 180))
    
  67.             Case 4
    
  68.                 TX = (3 * Sin((180 + Y * 2) * 3.14 / 180))
    
  69.                 
    
  70.         End Select
    
  71.         For X = 0 To G_Width - 1
    
  72.             TC += 1
    
  73.             'Die Quelle ist das aktuelle Pixel. Das Ziel ist das selbe, jedoch eine Zeile weiter oben
    
  74.             TPixelFrom = Y * G_Width + X
    
  75.             Select Case G_Modus
    
  76.                 Case 1
    
  77.                     TPixelTo = (Y - 1) * G_Width + X
    
  78.                     
    
  79.                 Case 2
    
  80.                     TX = X + 1 * Sin((180 + (Y * 3)) * PI180)
    
  81.                     TY = Y + 1 * Cos((180 + X) * PI180)
    
  82.                     If TX >= G_Width Then TX = G_Width - 1
    
  83.                     If TX < 0 Then TX = 0
    
  84.                     If TY >= G_Height Then TY = G_Height - 1
    
  85.                     If TY < 0 Then TY = 0
    
  86.                     TPixelTo = (TY - 1) * G_Width + TX
    
  87.                     
    
  88.                 Case 3
    
  89.                     TX2 = X + TX
    
  90.                     If TX2 >= G_Width Then TX2 = G_Width - 1
    
  91.                     If TX2 < 0 Then TX2 = 0
    
  92.                     TPixelTo = (TY - 1) * G_Width + TX2
    
  93.                     
    
  94.                 Case 4
    
  95.                     TZ = Y + (10 * Cos(X * 3.14 / 180)) / 50
    
  96.                     TPixelTo = (TZ - 1) * G_Width + X + TX
    
  97.                     
    
  98.             End Select
    
  99.             If TPixelTo >= TMaxImgL Then TPixelTo = TMaxImgL - 1
    
  100.             'Hier wird geprüft, welcher Farbwert anliegt und entsprechend gehandelt
    
  101.             If (G_FirePtr[TPixelFrom] And &H000000FF) > 0 Then                          'weißanteil zu gelb mischen
    
  102.                 If (G_FirePtr[TPixelFrom] And &H000000FF) > TFaktorWeisGelb Then
    
  103.                     G_TempPtr[TPixelTo] = G_FirePtr[TPixelFrom] - TFaktorWeisGelb
    
  104.                 Else: G_TempPtr[TPixelTo] = G_FirePtr[TPixelFrom] And &H00FFFF00
    
  105.                 End If
    
  106.             Elseif (G_FirePtr[TPixelFrom] And &H0000FF00) > 0 Then                      'gelbanteil zu rot mischen
    
  107.                 If (G_FirePtr[TPixelFrom] And &H0000FF00) > TFaktorGelbRot Then
    
  108.                     G_TempPtr[TPixelTo] = G_FirePtr[TPixelFrom] - TFaktorGelbRot
    
  109.                 Else: G_TempPtr[TPixelTo] = G_FirePtr[TPixelFrom] And &H00FF0000
    
  110.                 End If
    
  111.             Elseif (G_FirePtr[TPixelFrom] And &H00FF0000) > 0 Then                      'rotanteil zu schwarz mischen
    
  112.                 If (G_FirePtr[TPixelFrom] And &H00FF0000) > TFaktorRotSchwarz Then
    
  113.                     G_TempPtr[TPixelTo] = G_FirePtr[TPixelFrom] - TFaktorRotSchwarz
    
  114.                 Else: G_TempPtr[TPixelTo] = 0
    
  115.                 End If
    
  116.             End If
    
  117.             
    
  118.             'quelle und ziel tauschen
    
  119.             swap TPixelTo, TPixelFrom
    
  120.             
    
  121.             'hier wird das selbe rechenmodel angewendet. allerdings wird hier das ergebniss in die quelle kopiert,
    
  122.             'so das das feuerpixel auch nach unten hin abnimmt.
    
  123.             If (G_TempPtr[TPixelFrom] And &H000000FF) > 0 Then                          'weißanteil zu gelb mischen
    
  124.                 If (G_TempPtr[TPixelFrom] And &H000000FF) > TFaktorWeisGelb Then
    
  125.                     G_FirePtr[TPixelTo] = G_TempPtr[TPixelFrom] - TFaktorWeisGelb
    
  126.                 Else: G_FirePtr[TPixelTo] = G_TempPtr[TPixelFrom] And &H00FFFF00
    
  127.                 End If
    
  128.             Elseif (G_TempPtr[TPixelFrom] And &H0000FF00) > 0 Then                      'gelbanteil zu rot mischen
    
  129.                 If (G_TempPtr[TPixelFrom] And &H0000FF00) > TFaktorGelbRot Then
    
  130.                     G_FirePtr[TPixelTo] = G_TempPtr[TPixelFrom] - TFaktorGelbRot
    
  131.                 Else: G_FirePtr[TPixelTo] = G_TempPtr[TPixelFrom] And &H00FF0000
    
  132.                 End If
    
  133.             Elseif (G_TempPtr[TPixelFrom] And &H00FF0000) > 0 Then                      'rotanteil zu schwarz mischen
    
  134.                 If (G_TempPtr[TPixelFrom] And &H00FF0000) > TFaktorRotSchwarz Then
    
  135.                     G_FirePtr[TPixelTo] = G_TempPtr[TPixelFrom] - TFaktorRotSchwarz
    
  136.                 Else: G_FirePtr[TPixelTo] = 0
    
  137.                 End If
    
  138.             End If
    
  139.         Next
    
  140.     Next
    
  141.     'Selbes spiel mit der letzten zeile, allerdings wird diese hier nicht nach oben hin kopiert
    
  142.     For X = 0 To G_Width - 1
    
  143.         TPixelFrom = (G_Height - 1) * G_Width + X
    
  144.         TPixelTo = TPixelFrom
    
  145.         If (G_FirePtr[TPixelFrom] And &H000000FF) > 0 Then                          'weißanteil zu gelb mischen
    
  146.             If (G_FirePtr[TPixelFrom] And &H000000FF) > TFaktorWeisGelb Then
    
  147.                 G_TempPtr[TPixelTo] = G_FirePtr[TPixelFrom] - TFaktorWeisGelb
    
  148.             Else: G_TempPtr[TPixelTo] = G_FirePtr[TPixelFrom] And &H00FFFF00
    
  149.             End If
    
  150.         Elseif (G_FirePtr[TPixelFrom] And &H0000FF00) > 0 Then                      'gelbanteil zu rot mischen
    
  151.             If (G_FirePtr[TPixelFrom] And &H0000FF00) > TFaktorGelbRot Then
    
  152.                 G_TempPtr[TPixelTo] = G_FirePtr[TPixelFrom] - TFaktorGelbRot
    
  153.             Else: G_TempPtr[TPixelTo] = G_FirePtr[TPixelFrom] And &H00FF0000
    
  154.             End If
    
  155.         Elseif (G_FirePtr[TPixelFrom] And &H00FF0000) > 0 Then                      'rotanteil zu schwarz mischen
    
  156.             If (G_FirePtr[TPixelFrom] And &H00FF0000) > TFaktorRotSchwarz Then
    
  157.                 G_TempPtr[TPixelTo] = G_FirePtr[TPixelFrom] - TFaktorRotSchwarz
    
  158.             Else: G_TempPtr[TPixelTo] = 0
    
  159.             End If
    
  160.         End If
    
  161.     Next
    
  162.     If Int(Rnd * 2) = 0 Then
    
  163.     'For X = 1 to 1 '3
    
  164.         'Zufällig neue Feuerpunkte erzeugen (Von hieraus gehen die "wellen seitlich "auseinander)
    
  165.         TPos = Int(Rnd * G_Width - 1)
    
  166.         TPixelFrom = (G_Height - 2) * G_Width + TPos
    
  167.         TPixelTo = (G_Height - 1) * G_Width + TPos
    
  168.         If (G_FirePtr[TPixelFrom] And &H00FFFFFF) > 0 Then
    
  169.             If (G_FirePtr[TPixelFrom] And &H00FFFFFF) >= (&H00FF0000 - (TFaktorRotSchwarz * 4)) Then
    
  170.                 If (G_FirePtr[TPixelFrom] And &H00FFFFFF) >= &H00FFFF00 Then
    
  171.                     If (G_FirePtr[TPixelFrom] And &H00FFFFFF) >= (&H00FFFF00 - (TFaktorGelbRot * 4)) Then
    
  172.                         TCol = &H00FFFFFF
    
  173.                     Else: TCol = (G_FirePtr[TPixelFrom] And &H00FFFFFF) + TFaktorGelbRot * 4
    
  174.                     End If
    
  175.                 Else: TCol = &H00FFFF00
    
  176.                 End If
    
  177.             Else: TCol = (G_FirePtr[TPixelFrom] And &H00FFFFFF) + TFaktorRotSchwarz * 4
    
  178.             End If
    
  179.         Else: TCol = &H00FFFFFF 'TFaktorRotSchwarz * 4
    
  180.         End If
    
  181.         
    
  182.         'den Feuerpixel setzen
    
  183.         G_TempPtr[TPixelTo] = TCol
    
  184.         
    
  185.         'Die Wellen dieses Feuerpixels errechnen und prüfen, ob ein nachbarpixel bereits ""heiser ist, als das neu berechnete
    
  186.         TOK1 = 0
    
  187.         TOK2 = 0
    
  188.         For Y = 1 To 255 * 3 'wellenbreite ist maximal 3x 255 -> weisgelb -> gelbrot -> rotschwarz
    
  189.             If (TCol And &H000000FF) > 0 Then                           'weißanteil zu gelb mischen
    
  190.                 If (TCol And &H000000FF) > TFaktorWeisGelb Then
    
  191.                     TCol = TCol - TFaktorWeisGelb
    
  192.                 Else: TCol = TCol And &H00FFFF00
    
  193.                 End If
    
  194.             Elseif (TCol And &H0000FF00) > 0 Then                       'gelbanteil zu rot mischen
    
  195.                 If (TCol And &H0000FF00) > TFaktorGelbRot Then
    
  196.                     TCol = TCol - TFaktorGelbRot
    
  197.                 Else: TCol = TCol And &H00FF0000
    
  198.                 End If
    
  199.             Elseif (TCol And &H00FF0000) > 0 Then                       'rotanteil zu schwarz mischen
    
  200.                 If (TCol And &H00FF0000) > TFaktorRotSchwarz Then
    
  201.                     TCol = TCol - TFaktorRotSchwarz
    
  202.                 Else: TCol = 0
    
  203.                 End If
    
  204.             End If
    
  205.             If TCol = 0 Then Exit For
    
  206.             If TOK1 = 0 Then
    
  207.                 If (TPos + Y) < G_Width Then
    
  208.                     If (G_FirePtr[(G_Height - 1) * G_Width + TPos + Y] And &H00FFFFFF) < TCol Then
    
  209.                         G_TempPtr[(G_Height - 1) * G_Width + TPos + Y] = TCol
    
  210.                     Else: TOK1 = 1
    
  211.                     End If
    
  212.                 Else: TOK1 = 1
    
  213.                 End If
    
  214.             End If
    
  215.             If TOK2 = 0 Then
    
  216.                 If (TPos - Y) >= 0 Then
    
  217.                     If (G_FirePtr[(G_Height - 1) * G_Width + TPos - Y] And &H00FFFFFF) < TCol Then
    
  218.                         G_TempPtr[(G_Height - 1) * G_Width + TPos - Y] = TCol
    
  219.                     Else: TOK2 = 1
    
  220.                     End If
    
  221.                 Else: TOK2 = 1
    
  222.                 End If
    
  223.             Else: If TOK1 = 1 Then Exit For
    
  224.             End If
    
  225.         Next
    
  226.     'Next
    
  227.     End If
    
  228.     
    
  229.     'Die temporäre rechenmatrix zur aktuellen kopieren, um für den nächsten durchlauf die neue berechnungsgrudnlage zu besitzen.
    
  230.     Put G_FireImg, (0, 0), G_TempImg, Pset
    
  231.     
    
  232.     'feuerbild auf screen blitten
    
  233. '   If TBlitTimer < Timer() Then 'Alle 20ms Bild-Update + Sleep
    
  234.         Screenlock()
    
  235.         Put (0, 0), G_FireImg, Pset
    
  236.         Screenunlock()
    
  237.         TBlitTimer = Timer() + 0.02
    
  238.         Sleep 1, 1
    
  239. '       Sleep 10, 1
    
  240. '   End If
    
  241. Loop
    
  242. Screen 0
    
  243. End 0
    
  244.