Graphics 640,480,32
Global map=CreateImage(640,480)
SetBuffer ImageBuffer(map)
Color 0,128,0
Rect 0,200,640,280
SetBuffer BackBuffer()
Repeat
 Cls
 DrawImage map,0,0
 If MouseHit(1) Then
  mx=MouseX()
  my=MouseY()
  Einschlag mx,my,30
  Color 255,0,0
  Oval mx-5,my-5,10,10
  Oval mx-30,my-30,30*2,30*2,0 ; 2.
 End If
 Color 255,0,0
 Oval MouseX()-5,MouseY()-5,10,10
 Flip
Until KeyHit(1)
End

Function Einschlag(x,y,radius)
 gb=GraphicsBuffer()
 SetBuffer ImageBuffer(map)
 Color 0,0,0
 Oval x-radius,y-radius,radius*2,radius*2 ; 2.
 hintergrund=-16777216
 For x2=x-radius To x+radius
  cnt=0
  For y2=y To 0 Step -1
   cnt=cnt+(ReadPixel(x2,y2,ImageBuffer(map))<>hintergrund) ; 3.
  Next
  Color 0,0,0
  Rect x2,0,1,y ; 4.
  y_boden=y+Sqr((radius)^2-(x2-x)^2)+6
  Color 0,128,0 ; Bodenfarbe
  Rect x2,y_boden-cnt,1,cnt ; 5.
 Next
 SetBuffer gb
End Function

Graphics 800,600,0,1
SetBuffer BackBuffer()

Dim xyz(799,599,1)

While Not KeyHit(1)

 For z=0 To 1
  For y=0 To 599
   For x=0 To 799
    xyz(x,y,1)=1
   Next
  Next
 Next

 ms=MilliSecs()
 If ms>mt mt=ms+999:fps=frame:frame=0 Else frame=frame+1
 Text 0,0,fps

 Flip 0
 Cls
Wend
End

AppTitle "BlitzBomb"
Graphics3D 800,600,16,1
SetBuffer BackBuffer()
SetFont LoadFont("times new roman",30)
Text 400,300,"Lädt, bitte warten...",1,1
Flip



SeedRnd MilliSecs()













Dim Landschaft#(800,500,1)      ; 3. Dimension: 0 beinhaltet Typ (0=Luft, 1=Erde), 1 beinhaltet Tempo
Dim Landschaft_#(800,500,1)

Global check_x1=0, check_x2=800, check_y1=0, check_y2=500
















Global Landschaftsbild=CreateImage(800,500)           : MaskImage landschaftsbild,255,0,128










Global cam=CreateCamera()   : CameraRange cam,1,9999   : CameraClsMode cam,0,1
Global timer=CreateTimer(50)











createlandschaft





































check_x1=0:check_x2=1:check_y1=0:check_y2=1



While Not KeyHit(1)
   WaitTimer timer
   UpdateWorld()
   Cls









   RenderWorld()



   DrawImage landschaftsbild,0,100
   drawhud



   mx=MouseX()
   my=MouseY()
   Color 255,0,0
   Oval mx-10,my-10,20,20,1


   If MouseHit(1) And my>=100 deletedirt mx,my-100,10




   erde_faellt___dimbackup
   Flip
Wend
End






















































Function createLandschaft(l_rand_links=0,l_rand_rechts=800)
SetBuffer ImageBuffer(landschaftsbild)

hl=Rand(20,470)


Color 255,0,128
Rect l_rand_links,0,l_rand_rechts-l_rand_links,500
Color 0,128,0

l#=hl
f#=0
pm#=0
hoehe#=0
last_f#=0
For crlz=l_rand_links To l_rand_rechts
   
   f=f+Rnd(-.075,.075)+pm/1500
   If f>2 f=2
   If f<-2 f=-2
   If Abs(f-last_f)>.8 f=(f+last_f)/2
   
   hoehe=l+f
   If hoehe>470 hoehe=470
   If hoehe<20 hoehe=20
   
   Rect crlz,hoehe,1,500-Int(hoehe)
   If hoehe<l pm=pm+Rnd(.1,1.5)
   If hoehe>l pm=pm-Rnd(.1,1.5)
   If hoehe>=470 pm=pm-5
   If hoehe<=20 pm=pm+5
   l=hoehe
   last_f=f
Next









LockBuffer
For dx=0 To 800
   For dy=0 To 500
      rgb=ReadPixelFast(dx,dy)
      r=(rgb And $FF0000)/$10000
      g=(rgb And $FF00)/$100
      b=rgb And $FF
      If r=0 And g=128 And b=0 landschaft(dx,dy,0)=1 Else landschaft(dx,dy,0)=0
      landschaft(dx,dy,1)=0
   Next
Next
UnlockBuffer
check_x1=0:check_x2=799:check_y1=0:check_y2=499
erde_faellt___dimbackup
SetBuffer BackBuffer()
End Function




























Function deleteDirt(ddx,ddy,ddradius)
Color 255,0,128

check_x1=ddx-ddradius
check_x2=ddx+ddradius
check_y2=ddy+ddradius
check_y1=0


;SetBuffer ImageBuffer(landschaftsbild):Oval ddx-10,ddy-10,20,20,1:SetBuffer BackBuffer()
For kreiswinkel=0 To 360
   ax=Cos(kreiswinkel)*ddradius
   ay=Sin(kreiswinkel)*-ddradius
   bx=Cos(180-kreiswinkel)*ddradius

   If Sgn(bx-ax)=1 Then
      For lt=ax To bx
         landschaft(ddx+lt,ddy+ay,0)=0
      Next
   Else
      For lt=ax To bx Step -1
         landschaft(ddx+lt,ddy+ay,0)=0
      Next
   End If
Next

End Function



































Function drawHUD()
Color 128,0,128
Rect 0,100,800,500,0


End Function































Function Erde_faellt___DimBackup()
SetBuffer ImageBuffer(landschaftsbild)
LockBuffer
For sdb_y=check_y2 To check_y1 Step -1
   For sdb_x=check_x1 To check_x2
      ;skip_=False
      If landschaft(sdb_x,sdb_y,0)<>0
         If landschaft(sdb_x,sdb_y+1,0)=0
            landschaft(sdb_x,sdb_y,1)=landschaft(sdb_x,sdb_y,1)+.9
            If landschaft(sdb_x,sdb_y,1)>=1 Then
               landschaft(sdb_x,sdb_y+1,1)=landschaft(sdb_x,sdb_y,1)
               landschaft(sdb_x,sdb_y,1)=0
               landschaft(sdb_x,sdb_y+1,0)=landschaft(sdb_x,sdb_y,0)
               landschaft(sdb_x,sdb_y,0)=0
               ;skip_=True
            End If
         Else
            landschaft(sdb_x,sdb_y,1)=0
         End If
      End If
      
;   For plus1=0 To 1
      lsp=landschaft(sdb_x,sdb_y+plus1,0)      
      If lsp<>landschaft_(sdb_x,sdb_y+plus1,0)
         If lsp=0
            r=255
            g=0
            b=128
         End If
         If lsp=1
            r=0
            g=128
            b=0
         End If
         WritePixelFast sdb_x,sdb_y+plus1,255*$1000000 + r*$10000 + g*$100 + b
      End If
;   Next
      
      landschaft_(sdb_x,sdb_y,0)=landschaft(sdb_x,sdb_y,0)
      landschaft_(sdb_x,sdb_y,1)=landschaft(sdb_x,sdb_y,1)
      
      ;If skip_ Exit
   Next
Next
UnlockBuffer
SetBuffer BackBuffer()
End Function

gfx%=640
gfy%=480
rd%=60
Graphics gfx,gfy,0,1
SetBuffer FrontBuffer()

Color 64,64,96
For x=0 To gfx
 Rect x,gfy/4+(Sin(x)+Cos(x*3))*20,1,gfy,1
Next




While Not KeyHit(1)
 mx=MouseX()
 my=MouseY()
 rd=rd-MouseZSpeed()*10
 If rd>200 rd=200
 If rd<10 rd=10

 If MouseDown(1)
  Color 64,64,96
  Oval mx-rd/2,my-rd/2,rd,rd,1
 End If

 If MouseHit(2)
  Color 0,0,0
  Oval mx-rd/2,my-rd/2,rd,rd,1
  x1=mx-1-rd/2
  x2=mx+1+rd/2
  yy=my+4+rd/2
  anim=rd
 End If

 Color 0,0,0
 Rect 0,0,gfx,gfy,0

 Color 255,255,255
 Line mx-rd/2,0,mx+rd/2,0
 Line 0,my-rd/2,0,my+rd/2
 Line mx-rd/2,gfy-1,mx+rd/2,gfy-1
 Line gfx-1,my-rd/2,gfx-1,my+rd/2

 If anim>0
  LockBuffer FrontBuffer()
   For x=x1 To x2 Step 1
    a=0
    For y=yy To 0 Step-1
     If a<>3
      If a=0 If ReadPixelFast(x,y)=$FF000000 a=1
      If a=1 If ReadPixelFast(x,y)=$FF404060 a=2:WritePixelFast x,y+1,$FF404060
      If a=2 If ReadPixelFast(x,y)=$FF000000 a=3:WritePixelFast x,y+1,$FF000000:Exit
     End If
    Next
   Next
   anim=anim-1
  UnlockBuffer FrontBuffer()
 End If

 Color 0,0,0:Rect 0,0,40,32,1:Color 255,255,255:ms=MilliSecs()
 If ms>mt mt=ms+498:fps=frame:frame=0 Else frame=frame+2
 Text 0,0,fps
 Text 0,16,anim

 ;VWait
Wend
End

Const gfx%         = 800
Const gfy%         = 600
Const window       = 1
Const c_useimage   = True
Const c_backcolor  = $FF000000
Const c_expldurchm = 61
Const c_pixelstep  = 3


Dim pix_x(c_expldurchm)
Dim pix_Y(c_expldurchm)

Global img_map


Type t_column

   Field xpos
   Field ypos
   Field height
   Field speed = 1
   Field image

End Type


;-------------------------
AppTitle "BlitzBomb"
Graphics3D gfx,gfy,16,window
SetBuffer BackBuffer()

SeedRnd MilliSecs()


img_map = CreateMap()


While Not KeyHit(1)


SetBuffer ImageBuffer(img_map)

upd_time = MilliSecs()
UpdateMap()
upd_time = MilliSecs()-upd_time


If MouseHit(1) Then BombMap(mx, my, c_expldurchm)



SetBuffer BackBuffer()

Cls
DrawImage img_map,0,0

mx=MouseX()
my=MouseY()
Color 255,0,0
Oval mx-10,my-10,20,20,1



For i = 0 To c_expldurchm-1

   WritePixel pix_x(i), pix_y(i), $FF0000

Next

Text 10, 10, upd_time


Flip
Wend
End

;--------------------------

Function CreateMap()

   Local x, img

   img = CreateImage(gfx, gfy)

   SetBuffer ImageBuffer(img)
   Color 15,152,0
   For x=0 To gfx
      Rect x,gfy/4+(Sin(x)+Cos(x*3))*20,1,gfy,1
   Next
   

   Return img

End Function




Function UpdateMap()

   Local col.t_column
   Local new_ypos


   For col = Each t_column
   
      new_ypos = col\ypos + col\speed
      If new_ypos < gfy And ReadPixel(col\xpos, new_ypos) = c_backcolor Then 

         ;Pixelreihe nach unten bewegen
         If c_useimage Then
            DrawBlock col\image, col\xpos, new_ypos-col\height
         Else
            CopyRect col\xpos, col\ypos-col\height, 1, col\height+1, col\xpos, new_ypos-col\height
         EndIf
         col\ypos = new_ypos

      Else
         If col\image Then FreeImage col\image
         Delete col
      EndIf

   Next


End Function


Function CreateMassMover(p_xpos, p_ypos, p_height)

   Local col.t_column

   Local pix0, pix1

   If p_xpos < 0 Or p_xpos >= gfx% Then Return 0

;  wegen kleinen Ungenauigkeiten bei der Positionsermittlung lieber 2 Pixel prüfen
   pix0 = ReadPixel(p_xpos, p_ypos)
   pix1 = ReadPixel(p_xpos, p_ypos-1)

   If pix0 = c_backcolor And pix1 = c_backcolor Return 0 ;Nichts zu bewegen
   If pix0 = c_backcolor Then p_ypos = p_ypos - 1 ;Reihe muss 1 weiter oben starten

   col = New t_column
   col\xpos   = p_xpos
   col\ypos   = p_ypos
   col\height = p_height
   col\speed  = 1
   col\image  = CreateImage(1, p_height+1)
   GrabImage col\image, p_xpos, p_ypos-p_height

End Function


Function BombMap(p_xpos, p_ypos, p_durchm)

   Local x#, y, height
   Local x_pos, y_pos
   Local x_multi# = 1.0 / (p_durchm-1)
   Local h_radi = p_durchm / 2
   Local h_radi_quad = (h_radi+0.5)^2
 
   If p_durchm = 0 Then Return 0   

   ;Loch erstellen
   Color 0,0,0 
   Oval p_xpos-h_radi,p_ypos-h_radi,p_durchm,p_durchm,1   

   ;MassMover-Reihen erstellen
   For x = -h_radi To h_radi
 
      ;am Explosionskreis positionieren
      y = Sqr(h_radi_quad - x*x)

      xpos = p_xpos + x
      ypos = p_ypos - y

      ;Position der Startpixel anzeigen
      pix_x(x+h_radi) = xpos
      pix_y(x+h_radi) = ypos

      CreateMassMover(xpos, ypos, gfy%-100 )

   Next

End Function