Problem mit Linked Lists

Anfängerfragen zum Programmieren mit PureBasic.
Benutzeravatar
benpicco
Beiträge: 391
Registriert: 01.10.2004 15:32
Wohnort: im Code
Kontaktdaten:

Problem mit Linked Lists

Beitrag von benpicco »

edit:Ich hab den Fehler gefunden!
Ich wollte gerade die Gegner in meinem Spiel auf Linked Lists umstellen, aber irgendwie hat das nicht geklappt, ich verliere unaufhörlich energie, kommen noch Gegner hinzu hört das zwar auf, aber ich und der Gegner können sich nicht bewegen, zudem fehlt dann die Spielergrafik.
weiß zufällig irgendjemand, wo der Fehler liegen könnte? :iamwithstupid:
Hier *fast* alles benötigte (ich habe die Pixeluserlibrary benutzt, aber wenn man das Intro nicht included und die() auskommentiert (hab ich schon gemacht, wegen dem energieverlust), müsste es gehen (naja, tut es hatl trotzdem nicht, ginge es, würde ich ja hier nicht fragen :mrgreen:))
die wichtigen Dtaeien sind conflict_neu.pb und procedures.pb
Die exe datei ist eine alte version, in der gegner unde Spieler noch arrays waren (gab aber Probleme mit der anzahl und der existens...)
Hier der Link

P.S.: Darf ich das eigentlich, was ich da ins intro eingebaut hab (das mit nvidia und Ati)? Gibt es villeicht eine möglichkeit, rauszufinden, von welchem Hersteller die Grafikkarte ist und dann das entsprechende logo anzuzeigen? Oder wird nvidea und/oder ati dann böse :roll:

Danke schonmal für die Hilfe :allright:
Zuletzt geändert von benpicco am 15.07.2005 13:17, insgesamt 1-mal geändert.
Johann Wolfgang von Geothe hat geschrieben:Wie dieses oder jenes Wort geschrieben wird, darauf kommt es doch eigentlich nicht an, sondern darauf, daß die Leser verstehen, was man damit sagen wollte.
Benutzeravatar
unix
Beiträge: 361
Registriert: 15.02.2005 19:25
Wohnort: Zwischen Coburg und Bamberg :-)
Kontaktdaten:

Beitrag von unix »

Wenn du mir ein Teil denes Codes zeigen würdest wäre das nett


Es kann daran liegen das du foreach evt. falsch verwendest
Hier steht normalerweise die Putzfrau drin,
die hat aber Urlaub.
MfG : Unix
Benutzeravatar
benpicco
Beiträge: 391
Registriert: 01.10.2004 15:32
Wohnort: im Code
Kontaktdaten:

codeschnippel

Beitrag von benpicco »

Ich wollt euch den code eigentlich duurch den link zum code ersparen, naja, du hast es so gewollt ^^

Hauptdatei:

Code: Alles auswählen

;OpenFile(1,"screenshots.dat")
;WriteWord(1000)
;WriteWord(1000)
;WriteByte(5)
;CloseFile(1)
Programmstartzeit.f=ElapsedMilliseconds()
OnErrorGoto(?error)
reload:
If ReadFile(1,"intro")
  introex=ReadLong()
  CloseFile(1)
  DeleteFile("intro")
Else
  introex=1
EndIf
If ExamineDirectory(1,"Screenshots\","*.bmp")=0
  CreateDirectory("Screenshots")
EndIf
screenshots=0
Repeat
  screenshots=screenshots+1
Until NextDirectoryEntry() <> 1
#raster=13
OpenFile(1,"screensots.dat")
WriteWord(screenshots)
CloseFile(1)
If InitSprite()=0
  MessageRequester("Error001","DirectX 7 or higher requestet!",#MB_OK|#MB_ICONERROR):End
EndIf
If InitKeyboard()=0 Or InitMouse()=0
  MessageRequester("Error002","How to hell got you these Application running?!? You don´t have any kind of mouse or keyboard, do you?",#MB_OK|#MB_ICONERROR):End
EndIf
If InitSound()=0
  MessageRequester("Error003","Unable to initialize DirectX sound. Soundcard needed?",#MB_OK|#MB_ICONERROR):End
EndIf
If InitMovie()=0
  MessageRequester("Error005","Unabl to inizialize DirectX Movie support.",#MB_OK|#MB_ICONERROR):End
EndIf
If InitSprite3D()=0
  MessageRequester("Error004","3d able Hardware requestet! Graphic card needed!!!",#MB_OK|#MB_ICONERROR):End
EndIf

Global delay.b
Global speed.b
Global pan.f
Global max.w
Global stars.w
Global live.b
Global Points.l
Global maxe.w
Global shotspeed.b
Global shild.f
Global shildmax.b
Global shots.b
Global kills.f
;Global live.b
Global diff.b
Global s.b
Global played.b
Global spread.b
Global maximalgegner.w
Global sini.w
Global wait.w
Global wait2.w
Global spark.b
Global spark2.b
Global msx.w
Global msy.w
Global color.b
Global waiting.b
Global g.w
Global daempf.b
Global vers.s
Global verb.b
Global bugreport.b
Global wave.b
Global verz.b

#ki=#False
ReadFile(1,"sc.conf")
max=ReadWord()
stars=ReadWord()
speed=ReadByte()
CloseFile(1)
;-Variablenbelegung
Points=0

live=3

;maxe=1
maximalgegner=100
explo=400
shildmax=10
shots=2
diff=50
spread=2




Dim starX.f(stars)
Dim StarY.f(stars)
Dim color.l(stars)
Dim shotX_a.f(max)
Dim shotY_a.f(max)
Dim richtung.b(max)
Dim EnemyX.f(maximalgegner+1)
Dim EnemyY.f(maximalgegner+1)
Dim e_exist.b(maximalgegner+1)
Dim shild.f(maximalgegner+1)
Dim ex_exist.b(explo)
Dim exploX.w(explo)
Dim exploY.w(explo)
Dim hit.b(max)
Dim hitX.w(maximalgegner+1)
Dim hitY.w(maximalgegner+1)
Dim e_shotX.f(max,maximalgegner+1)
Dim e_shotY.f(max,maximalgegner+1)
Dim eshot_exist.b(max,maximalgegner+1)
Dim shotrichtung.f(max,maximalgegner+1)
Dim raster.b(1024,768+2)
Dim abst.f(max)
Dim flucht.b(maximalgegner)
Dim moveX.f(maximalgegner)
Dim moveY.f(maximalgegner)
Dim zielX.f(maximalgegner)
Dim zielY.f(maximalgegner)
Dim target.b(maximalgegner)

Dim spread.b(maximalgegner)



Structure shot
shotX.f
shotY.f
shotspeedX.f
shotspeedY.f
EndStructure

NewList shots.shot()



bugreport=#False
#grafikkarten=#True
#satelite=#False
IncludeFile "partikel.pb"
Sprite3DQuality(1)



IncludeFile "procedures.pb"
ResetList(ships())
;
;ships()\shild=shildmax
;ships()\ShipX=Random(600)+200
;ships()\ShipY=700
;ships()\shotspeed=-5

For x=1 To stars
  starX(x)=Random(1022)+1
  StarY(x)=Random(763)+1
Next 

ReadFile(1,"readme.txt")
headline$=ReadString()
vers=Trim(ReadString())
vers=RSet(vers,Len(vers)-1)
CloseFile(1)
OpenScreen(1024,768,32,"Space conflict")
memory.f=AvailableScreenMemory()/1024
UseOGGSoundDecoder()
UseJPEGImageDecoder()
UseTIFFImageDecoder()
LoadFont(1,"Comic Sans MS",14,#PB_Font_HighQuality)
LoadFont(2,"Comic Sans MS",72,#PB_Font_HighQuality)
LoadFont(3,"Arial",30,#PB_Font_Bold )
LoadSound(1,"sound\zip.wav")
LoadSound(2,"sound\hit.wav")
LoadSound(3,"sound\explode.wav")
LoadSound(4,"sound\danger.wav")
LoadSound(5,"sound\shild.wav")
LoadSound(6,"sound\n_shild.wav")
LoadSound(7,"sound\shot.wav")
LoadSound(8,"sound\life.wav")
LoadSound(40,"sound\enertional.ogg")
LoadSound(41,"sound\click.wav")
LoadSound(10,"sound\clap.wav")
LoadSound(11,"sound\fire.wav")
LoadMovie(1,"sound\Battle Theme 1.mid")
LoadMovie(2,"sound\game_over.mid")
LoadMovie(3,"sound\intro1.mid")
LoadMovie(4,"sound\Orbital Battle.mid")
LoadSprite(1,"Grafic\ship.bmp",#PB_Sprite_Texture)
LoadSprite(2,"Grafic\ship_l.bmp",#PB_Sprite_Texture)
LoadSprite(3,"Grafic\ship_r.bmp",#PB_Sprite_Texture)
LoadSprite(4,"Grafic\target.bmp")
LoadSprite(5,"Grafic\Bullet.bmp",#PB_Sprite_Texture)
LoadSprite(6,"Grafic\live.bmp",#PB_Sprite_Texture)
LoadSprite(7,"Grafic\enemy1.bmp" ,#PB_Sprite_Texture)
LoadSprite(8,"Grafic\ptcl_gelb.bmp" ,#PB_Sprite_Texture)
LoadSprite(9,"Grafic\ptcl_blau.bmp" ,#PB_Sprite_Texture)
LoadSprite(10,"Grafic\spark_grn.bmp",#PB_Sprite_Texture)
LoadSprite(11,"Grafic\SpaceConflict.tif")
LoadSprite(21,"grafic\enemy2.bmp",#PB_Sprite_Texture)
LoadSprite(23,"grafic\ally.bmp",#PB_Sprite_Texture)

LoadSprite(#raster,"grafic\gitter.bmp")
TransparentSpriteColor(#raster,0,0,0)
TransparentSpriteColor(11,255,255,255)
TransparentSpriteColor(4,255,0,255)
Pixel_CreateFont("text","Arial",30,#PB_Font_Bold,RGB(255,255,255),RGB(100,100,255))
Pixel_LoadFont(0,"grafic\text.png")
ChangeGamma(0,0,0,1)
For x=5 To 9
  CreateSprite3D(x,x)
  TransparentSpriteColor(x,0,0,0)
Next
CreateSprite3D(10,8)
CreateSprite3D(11,9)
CreateSprite3D(12,10)
CreateSprite3D(21,21)
CreateSprite3D(23,23)
;Start3D()
For x=1 To 3
  CreateSprite3D(x,x)
  TransparentSpriteColor(x,0,0,0)
  ;ZoomSprite3D(x,SpriteWidth(x),SpriteHeight(x))
Next
;Stop3D()
MouseLocate(500,500)
StartDrawing(ScreenOutput())
DrawingMode(1)
DrawingFont(UseFont(2))
Locate(100,100)
FrontColor(100,100,100)
DrawText("Loading...")
StopDrawing()
FlipBuffers()
For x=1 To stars
  color(x)=Random(100)+156
  color(x)=RGB(color(x),color(x),color(x))
Next
;Gosub reset_sparks
If introex=0
  Goto nointro
EndIf
PlayMovie(3,ScreenID())
IncludeFile "feuerwerk.pb"
StopMovie()
nointro:
;Repeat
;  star()
;  FlipBuffers()
;  ExamineKeyboard()
;Until KeyboardPushed(#PB_Key_Escape)

IncludeFile "menue.pb"
StopMovie()
;loading(1,100,100,RGB(255,255,255))
AddElement(ships())
ships()\Sprite=1
ships()\daempf=1
ships()\shild=shildmax
ships()\shotspeed=-5
ships()\ShipX=500
ships()\ShipY=700
If bugreport=#True: EnableDebugger:EndIf
SetFrameRate(85)
;ships()\Sprite=1
newwave()
;newEnemy()

;newAlly()
startyp=1

;-start
Repeat
  ;ResetList(ships())
 
  FlipBuffers()
  If IsScreenActive()
    If MovieStatus()=0
      PlayMovie(1,ScreenID())
    EndIf
    If sini<360:sini+1:Else:sini=0:EndIf 
    star(startyp)
  For x=1 To explo 
    If ex_exist(x)>1 
      Gosub update_sparks
      If wait<wait2
        wait+1
      Else
        If spark<spark2
          spark+1
          msx=exploX(x)
          msy=exploY(x)
          count=Random(10)+10
          Gosub create_sparks
        Else
          Gosub reset_sparks
        EndIf
      EndIf  
      Start3D()
      Sprite3DBlendingMode(0,2)
      ResetList(sparks())
      While NextElement(sparks())      
        ZoomSprite3D(sparks()\fcolor,sparks()\fsize,sparks()\fsize)
        RotateSprite3D(sparks()\fcolor,sparks()\fangle,1)
        DisplaySprite3D(sparks()\fcolor,sparks()\fx,sparks()\fy,255)
      Wend
      Stop3D()    
    EndIf
  Next      
  
  ExamineMouse()
  ExamineKeyboard()
   spread(0)=spread(0)+MouseWheel()
  If spread(0)<0
    spread(0)=0
  EndIf
  For y=768 To 0 Step -2;Step 10
    For x=0 To 1024  Step 2
      If raster(x,y)=-1
        DisplayTransparentSprite(#raster,x,y)
        raster(x,y+2)=raster(x,y)
        raster(x,y)=0
        If y+2>768
          raster(x,y+2)=0
        EndIf
        z=0
        ResetList(ships())
        While NextElement(ships())
           If SpriteCollision(ships()\Sprite,ships()\ShipX-SpriteWidth(ships()\Sprite)/2,ships()\ShipY,#raster,x,y)=1
            ships()\shild-0.01
          EndIf

          
        Wend
      EndIf
    Next
  Next
  create_level()
  If waiting > -120
    waiting-1
  EndIf
  Start3D()
  update_ptclemitter()
  update_ptcl()
  Stop3D()
  ResetList(ships())
  While NextElement(ships())
    If ships()\Sprite>0 And ships()\Sprite<4
    ships()\Sprite= 1 
    If MouseButton(1)=1 And waiting <0
      waiting=10
      If ships()\ShipX>512
        pan=(ships()\ShipX/1024)*100
      Else
        pan=-((512-ships()\ShipX)/512)*100
      EndIf
      SoundPan(1,pan)
      For s=-(shots/2)*spread(0) To (shots/2)*spread(0) 
        s=s+spread(0)
        shot(x,MouseX()+s,MouseY())
      Next
      SoundPan(1,0)
    EndIf
    ;ships()\sprite=1
    move()
  ElseIf ships()\Sprite=7
    If Random(diff)=1
      shot(x,ships()\ShipX,ships()\ShipY)
    EndIf
    If Random(diff/4)=1
      move.f=ki("X",ships()\ShipX,ships()\ShipY,x,ships()\ShipX,ships()\ShipY)
      ships()\MoveX+move
      move.f=ki("Y",ships()\ShipX,ships()\ShipY,x,ships()\ShipX,ships()\ShipY)
      ships()\MoveY+move
    EndIf
  ElseIf ships()\Sprite=21
    move.f=kamikaze_ki("X",ships()\ShipX,ships()\ShipY,x)
    ships()\MoveX+move 
    move.f=kamikaze_ki("Y",ships()\ShipX,ships()\ShipY,x)
    ships()\MoveY+move
  ElseIf ships()\Sprite=23
    move.f=ki("X",ships()\ShipX,ships()\ShipY,x,ships()\TargetX,ships()\TargetY)
    ships()\MoveX+move
    move.f=ki("Y",ships()\ShipX,ships()\ShipY,x,ships()\TargetX,ships()\TargetY)
    ships()\MoveY+move
    If Random(diff)=1
      shot(x,ships()\TargetX,ships()\TargetY)
    EndIf
    If e_exist(ships()\TargetID)=0
      SearchTarget(x)
    EndIf
   EndIf
   ResetList(shots())
    While NextElement(shots())
      If SpritePixelCollision(8,shots()\shotX ,shots()\shotY,ships()\Sprite,ships()\ShipX-SpriteWidth(ships()\Sprite)/2,ships()\ShipY)
        PlaySound(2)
        ships()\shild-1
        DeleteElement(shots())
        StartDrawing(ScreenOutput())
        DrawingMode(4)
        Circle(ships()\ShipX,ships()\ShipY+25,30,RGB(0,(40*ships()\shild),0))
        StopDrawing()
      EndIf
     
    Wend
    
  moverech(x)
  If SpriteCollision(sprite(0),shipX(0)-SpriteWidth(sprite(0))/2,shipY(0),ships()\Sprite,ships()\ShipX-SpriteWidth(ships()\Sprite)/2,ships()\ShipY) And x<>0
    ships()\shild-1
    ships()\shild-1
  EndIf
  If x=0
    create_ptclemitter(ships()\ShipX-SpriteWidth(ships()\Sprite)/2,ships()\ShipY+SpriteWidth(ships()\Sprite)/2,1,1,1,8)
  EndIf
  create_ptcl(ships()\ShipX-SpriteWidth(ships()\Sprite)/2 ,ships()\ShipY,5,SpriteWidth(ships()\Sprite),SpriteHeight(ships()\Sprite),0,-5,-1,-1,0,0,0,ships()\Sprite)
  DisplayTransparentSprite(ships()\Sprite,ships()\ShipX-SpriteWidth(ships()\Sprite)/2,ships()\ShipY)

If ships()\shild<0
  If ships()\Sprite<4 And ships()\Sprite>0
    msx=ships()\ShipX
    msy=ships()\ShipY
    wait2=50
    count=Random(10)+10
    ;Gosub reset_sparks
    Gosub create_sparks
   ; die()
    Gosub update_sparks
  Else
    
    msx=ships()\ShipX
    msy=ships()\ShipY
    If ships()\Sprite=7
    wait2=50
    count=Random(10)+10
  ElseIf ships()\Sprite=21
    wait2=50
    count=Random(5)+5
    EndIf
    ;Gosub reset_sparks
    Gosub create_sparks
    destroy(x)
    Gosub update_sparks
  EndIf
EndIf
Wend
ResetList(shots())

While NextElement(shots())

  shots()\shotX+shots()\shotspeedX
  shots()\shotY+shots()\shotspeedY
  ;DisplayTransparentSprite(5,shotX(),shotY())
  
  create_ptcl( shots()\shotX ,shots()\shotY,10,20,20,120,-5,-1,-1,-shots()\shotspeedX,-shots()\shotspeedY,0,8)
  
  If shots()\shotX>1030 Or shots()\shotX<-10 Or shots()\shotY>775 Or shots()\shotY<-10
    DeleteElement(shots())
  EndIf
Wend
drawInterface(current)
;drawing("Schüsse:"+Str(CountList(shots())),20,20,RGB(200,255,200))
If KeyboardPushed(#PB_Key_Add) And current<CountList(ships())
  current+1
  If  current < CountList(ships())
    current+1
  EndIf
ElseIf KeyboardPushed(#PB_Key_Subtract) And current > 0
  current-1
  If current >0
    current-1
  EndIf
EndIf
If KeyboardPushed(#PB_Key_1)
  startyp=1
ElseIf KeyboardPushed(#PB_Key_2)
  startyp=2
ElseIf KeyboardPushed(#PB_Key_3)
  startyp=3
ElseIf KeyboardPushed(#PB_Key_4)
  startyp=4
ElseIf KeyboardPushed(#PB_Key_5)
  startyp=5
ElseIf KeyboardPushed(#PB_Key_0)
  startyp=0
EndIf
items()
;-schwirigkeit
If Points/10>maxe*10 And Points/10>(100-diff)+10
  If Random(2)=1
    If diff>2
      diff=diff-5
    EndIf
  Else
    ;newEnemy()
  EndIf 
EndIf     
delay=delay-1
For x=1 To explo
  If ex_exist(x)>1
    ex_exist(x)=ex_exist(x)-1
    create_ptcl(exploX(x),exploY(x),49,30,30,150,-2,-1,-1,rnd(-4,4),0,0,8)
  EndIf
Next
If kills=5 And played=0
  StopSound(3)
  PlaySound(5) 
  played=1
ElseIf kills=7 And played=0
  StopSound(3)
  PlaySound(40) 
  played=1
ElseIf kills=10 And played=0
  StopSound(3)
  PlaySound(6)
  played=1
ElseIf kills=15 And played=0
  StopSound(3)
  PlaySound(7)
  played=1
ElseIf kills=20 And played=0
  StopSound(3)
  PlaySound(8)
  played=1
ElseIf kills <> 5 And kills <> 7 And kills <> 10 And kills <> 15 And kills <> 20
  played=0
EndIf
If KeyboardReleased(#PB_Key_P)
  pause()
EndIf  
If KeyboardReleased(#PB_Key_F4)
  End
EndIf 
If KeyboardPushed(#PB_Key_F12)
  screenshotter()
EndIf
drawing(Str(verb),10,10,RGB(255,255,255))
If verb<=0
  ;newwave()
  ;newEnemy()
  ;newAlly()
EndIf
Else
  StopSound(-1)
  Delay(10)  
EndIf
no:
Until KeyboardPushed(#PB_Key_Escape)
Goto Endgame
End
error:
If ScreenID()
  CloseScreen()
EndIf
MessageRequester("ERROR","Das Programm hat einen Fehler festgestellt und muss beendet werden. Bitte leiten sie disen Fehler an den Entwickler weiter. Das wird helfen, die Qualität von SpaceConflict zu verbessern (sie können auch Verbesserungsvorschläge in die e-mail Schreiben, aber bitte unter dem Bugreport, sonst weiß ich ja nicht, was pasiert ist. Wenn sie möchten könnten sie auch eine kleine situationsbeschreibung afügen, das könnte mir helfen)",#MB_OK|#MB_ICONERROR)
RunProgram("mailto:benpicco@compuserve.de?subject=Bugreport SpaceConflict&body=Bugreport%0AOS="+GetOS()+"%0AGrafikspeicher="+StrF(memory)+"kb%0AFehler "+Str(GetErrorNumber())+" von "+Str(GetErrorCounter())+"%0a"+GetErrorDescription()+" at Line"+Str(GetErrorLineNR())+" in File "+GetErrorModuleName()+"%0AVersion:"+vers+"%0AVergangene Zeit:"+Str(ElapsedMilliseconds()-Programmstartzeit)+"ms%0A PlayerX="+StrF(ships()\ShipX)+"%0A PlayerY="+StrF(ships()\ShipY))
End

DataSection
invader:
IncludeBinary "Invader\INVADER.EXE"
save:
IncludeBinary "invader\SAV.sav"
control:
IncludeBinary "invader\control.txt"
endinclude:
EndDataSection
death:
StopMovie()
PlayMovie(2,ScreenID())
StopSound(4)
Start3D()
update_ptcl()
Stop3D()
GrabSprite(0,0,0,1024,768)
UseJPEGImageEncoder() 
SaveSprite(0,"screenshots\death.bmp" )
LoadImage(0,"screenshots\death.bmp")
SaveImage(0,"screenshots\death.jpg", #PB_ImagePlugin_JPEG ,10)
DeleteFile("screenshots\death.bmp")
FreeImage(0)
For x=255 To 0 Step -1
  ClearScreen(0,0,0)
  ChangeGamma(x,x,x,0)
  DisplaySprite(0,0,0)
  StartDrawing(ScreenOutput())
  DrawingMode(1)
  Locate(200,300)
  FrontColor(255,10,10)
  DrawingFont(UseFont(2))
  DrawText("GameOver")
  StopDrawing()
  FlipBuffers()
  ExamineKeyboard()
  If KeyboardPushed(#PB_Key_Escape)
    Goto highcheck
  EndIf
Next
Delay(1400)
highcheck:
StopMovie()
ClearScreen(10,10,10)
FlipBuffers()
For x=1 To 255
  ChangeGamma(x,x,x,0)
Next
OpenFile(1,"high.score")
highscore.l=ReadLong()
best$=ReadString()
CloseFile(1)
For x=1 To Points
  Delay(10)
  ClearScreen(10,10,10)
  Pixel_DisplayTransparentFont(0,120,200,"Your scrore:"+Str(x))
  PlaySound(41)
  ExamineKeyboard()
  If KeyboardPushed(#PB_Key_Escape)
    Goto auswert
  EndIf
  FlipBuffers()
Next
auswert:
ClearScreen(255,255,255)
FlipBuffers()
If Points>500
  createinvader("Invader")
EndIf
Delay(10)
If Points>highscore
  msx=130
  msy=210
  newh.b=1
  wait2=100
  Gosub reset_sparks
  spark2=30
  count=Random(10)+10
  Gosub create_sparks
EndIf
For x=1 To 360
  ClearScreen(10,10,10)
  If sini<359:sini+1:Else:sini=0:EndIf 
  If newh=1:Gosub update_sparks:EndIf
  Pixel_DisplayTransparentFont(0,120,200,"Your scrore:"+Str(Points))
  Pixel_DisplayTransparentFont(0,120+(Gsin(sini)*100),300+(Gsin(sini)*30),"Highscore:"+Str(highscore))
  FlipBuffers()
Next
CloseScreen()

MessageRequester("Info","Highscore:"+Str(highscore)+" by "+best$+Chr(10)+"Your Score:"+Str(Points))
If Points>highscore
  PlaySound(10)
  MessageRequester("Congratulation!","You have a new Highscore!")
  best$=InputRequester("Highscore","Enter your name.Your Score:"+Str(Points), "Your name")
  OpenFile(1,"high.score")
  WriteLong(Points)
  WriteString(best$)
  CloseFile(1)
  
EndIf
End
IncludeFile "sparks.pb"
procedures

Code: Alles auswählen

Structure ships
  ShipX.f
  ShipY.f
  MoveX.f
  MoveY.f
  shild.b
  TargetX.f
  TargetY.f
  TargetID.b
  daempf.b
  shotspeed.b
  Sprite.b
EndStructure
NewList ships.ships()
Procedure shipX(id)
  Protected merk.w
  merk=ListIndex(ships())
  SelectElement(ships(), id)
  ShipX=ships()\ShipX
  SelectElement(ships(), merk)
  ProcedureReturn ShipX
EndProcedure
Procedure shipY(id)
  Protected merk.w
  merk=ListIndex(ships())
  SelectElement(ships(), id)
  ShipY=ships()\ShipY
  SelectElement(ships(), merk)
  ProcedureReturn ShipY
EndProcedure
Procedure shotspeed(id)
  Protected merk.w
  merk=ListIndex(ships())
  SelectElement(ships(), id)
  shotspeed=ships()\shotspeed
  SelectElement(ships(), merk)
  ProcedureReturn shotspeed
EndProcedure
Procedure sprite(id)
  Protected merk.w
  merk=ListIndex(ships())
  SelectElement(ships(), id)
  Sprite=ships()\Sprite
  SelectElement(ships(), merk)
  ProcedureReturn Sprite
EndProcedure
Procedure drawing(text$,x,y,drawingcolor)
  StartDrawing(ScreenOutput())
  DrawingMode(1):Locate(x,y)
  FrontColor(Red(drawingcolor),Green(drawingcolor),Blue(drawingcolor))
  DrawText(text$)
  StopDrawing()
EndProcedure
Procedure.s GetAppDir() 
  FullPath.s = Space(360) 
  DLL = OpenLibrary(#PB_Any, "Kernel32") 
  CallFunction(DLL, "GetModuleFileNameA", CallFunction(DLL, "GetModuleHandleA", 0), @FullPath, 360) 
  CloseLibrary(DLL)
  ProcedureReturn FullPath  
EndProcedure 
Procedure.f Gsin(winkel.f) 
  preturn.f=Sin(winkel*(5*3.14159265/360)) 
  ProcedureReturn preturn 
EndProcedure 
Procedure.f Gcos(winkel.f) 
  preturn.f=Cos(winkel*(5*3.14159265/360)) 
  ProcedureReturn preturn 
EndProcedure 
Procedure rnd(min.w,maxi.w)
  a.w = maxi - Random (maxi-min)
  ProcedureReturn a
EndProcedure
Procedure star(typ)
ClearScreen(10,10,10)
StartDrawing(ScreenOutput())
For x=1 To stars
  If typ=1
  StarY(x)=StarY(x)+(Abs(512-starX(x))/500)*2+1
  starX(x)=starX(x)-(512-starX(x))/500
  ElseIf typ=0
    StarY(x)=StarY(x)+1
  ElseIf typ=2
    StarY(x)=StarY(x)+(Abs(512-starX(x))/500)*2
  ElseIf typ=3
    StarY(x)=StarY(x)+Random(10)-20
    starX(x)=starX(x)+Random(10)-20
  ElseIf typ=4
    starX(x)=starX(x)
    StarY(x)=StarY(x)
  ElseIf typ=5
    starX(x)=starX(x)+Gcos(sini)*10
    StarY(x)=StarY(x)+Gsin(sini)*10
  EndIf
  If StarY(x)>768 Or StarY(x)<0 Or starX(x)>1024 Or starX(x)<0
    starX(x)=Random(1022)+1
    StarY(x)=Random(768)-100
    color(x)=Random(100)+156
    color(x)=RGB(color(x),color(x),color(x))
  EndIf
  If starX(x)<1023 And starX(x)>1 And StarY(x)<767 And StarY(x)>1
    Plot(starX(x),StarY(x),color(x))
  EndIf
Next
StopDrawing()
EndProcedure
Procedure newwave()
  wave=60-diff
  ;ResetList(ships())
  For x=1 To wave
    AddElement(ships())
    ships()\Sprite=21
    ships()\shild=1
    ships()\ShipX=1+30*x
    ships()\ShipY=1+x
    ships()\MoveX=1
    ships()\daempf=1
  Next
  maxe+wave
  verb+wave
EndProcedure
Procedure moverech(x)
  SelectElement(ships(),x)
  ships()\ShipX=ships()\ShipX+ships()\MoveX/verz
  ships()\ShipY=ships()\ShipY+ships()\MoveY/verz
  If ships()\ShipX>1024-SpriteWidth(ships()\Sprite)
    ships()\ShipX=1024-SpriteWidth(ships()\Sprite)
    ships()\MoveX=-ships()\MoveX/10
  ElseIf ships()\ShipX<0
    ships()\ShipX=10
    ships()\MoveX=-ships()\MoveX/10
  EndIf
  If ships()\ShipY>768-SpriteHeight(ships()\Sprite)
    ships()\ShipY=768-SpriteHeight(ships()\Sprite)
    ships()\MoveY=-MoveY/10
  ElseIf ships()\ShipY<0
    ships()\ShipY=10
    ships()\MoveY=-ships()\MoveY/10
  EndIf
EndProcedure
Procedure SearchTarget(ally)
  ResetList(ships())
  For x=1 To CountList(ships())
    SelectElement(ships(),x)
    If ships()\Sprite<>23 And ships()\Sprite>3
    ships()\TargetX=shipX(x)
    ships()\TargetY=shipY(x)
    ships()\TargetID=x
    Break
    EndIf
  Next
EndProcedure
Procedure newAlly()
  ;Protected x.w


    retry:
    testX.w=Random(1000)+1
    testY.w=Random(300)+400
    ResetList(ships())
    While NextElement(ships())
      
       
      If SpriteCollision(ships()\Sprite,ships()\ShipX,ships()\ShipY,23,testX.w,testY.w)
        Goto retry
      Else
        ships()\Sprite=23
        ships()\ShipX=testX
        ships()\ShipY=testY 
        shild(Allyneu)=shildmax
        ships()\shotspeed=shotspeed(0)
       ; If Allyneu+1=maxe
          
       ; EndIf
       EndIf

      Break
    Wend
    SearchTarget(ListIndex(ships()))
  
EndProcedure
Procedure move()
  verz=1
  Protected speedx,speedy
  ;ResetList(ships())
  ;SelectElement(ships(),0)
  If KeyboardPushed(#PB_Key_Left) Or KeyboardPushed(#PB_Key_A)
    If ships()\daempf>2
    ships()\MoveX-speed
  Else
    ships()\MoveX-(speed/10)
    EndIf
  ;ships()\ShipX0)=ships()\ShipX0) -speed
  ;speedx=-speed
  ships()\Sprite=2
ElseIf KeyboardPushed(#PB_Key_Right) Or KeyboardPushed(#PB_Key_D)
  ;ships()\ShipX0)=ships()\ShipX0) +speed
  If ships()\daempf>2
    ships()\MoveX+speed
  Else
    ships()\MoveX+(speed/10)
  EndIf
  
  ships()\Sprite=3
EndIf
If KeyboardPushed(#PB_Key_Up) Or KeyboardPushed(#PB_Key_W)
  ;ships()\ShipY0)=ships()\ShipY0) -speed
  If ships()\daempf>2
    ships()\MoveY-speed
  Else
    ships()\MoveY-(speed/10)
  EndIf
  
ElseIf KeyboardPushed(#PB_Key_Down) Or KeyboardPushed(#PB_Key_S)
  ;ships()\ShipY0)=ships()\ShipY0) +speed
  If ships()\daempf>2
    ships()\MoveY+speed
  Else
    ships()\MoveY+(speed/10)
  EndIf
  
EndIf

If ships()\daempf<3
  verz=3-ships()\daempf
EndIf
If ships()\daempf>2
speedx=ships()\MoveX
speedy=ships()\MoveY

  ships()\MoveX=speedx/ships()\daempf
  ships()\MoveY=speedy/ships()\daempf
Else

EndIf
If MouseY()>ships()\ShipY-10
  MouseLocate(MouseX(),ships()\ShipY-10)
EndIf
EndProcedure
Procedure items()
  If MouseButton(2)=1
    If kills>=5 And kills<7
      ships()\shild=shildmax
      kills=kills-5
      Points=Points+kills
    ElseIf kills>=7 And kills<10
      kills=kills-7
      Points=Points+kills
      ships()\daempf=ships()\daempf+1  
    ElseIf kills>=10 And kills<15  
      shildmax=shildmax+5
      ships()\shild=shildmax
      kills=kills-10
      Points=Points+kills
    ElseIf kills>=15 And kills<20
      shots=shots+1
      kills=kills-15
      Points=Points+kills
    ElseIf kills>=20
      live=live+1
      kills=kills-20
      Points=Points+kills
    EndIf
  EndIf
  spread(0)=spread(0)+MouseWheel()
  If spread<0
    spread=0
  EndIf
EndProcedure

Procedure createinvader(dir$)
  Restore invader
  OpenFile(1,dir$+"Invader.exe")
  WriteData(?invader,?save-?invader)
  CloseFile(1)
  OpenFile(1,dir$+"sav.sav")
  WriteData(?save,?control-?save)
  CloseFile(1)
  OpenFile(1,dir$+"control.txt")
  WriteData(?control,?endinclude-?control)
  CloseFile(1)
EndProcedure

Procedure newEnemy()
  Protected x.w
    retry_g:
    testX.w=Random(1000)+1
    testY.w=Random(300)+1
    ResetList(ships())
    While NextElement(ships())
      If SpriteCollision(ships()\Sprite,ships()\ShipX,ships()\ShipY,7,testX.w,testY.w)<>0
        Goto retry_g
      Else
        AddElement(ships())
        ships()\Sprite=7
        ships()\ShipX=testX
        ships()\ShipY=testY 
        ships()\shild=6
        ships()\daempf=1
        verb+1
        ;SelectElement(ships(),0)
        ;*First=@ships()
        ;SelectElement(ships(),1)
        ;*Second=@ships()
        ;SwapElements(ships(),*First,*Second)
        ;ResetList(ships())
      EndIf
      Break
    Wend
 
EndProcedure 
Procedure destroy(enemy.w)

  ResetList(ships())
  SelectElement(ships(),enemy)
  Repeat
  y=y+1
  Until ex_exist(y)=0
  ex_exist(y)=50
  exploX(y)=ships()\ShipX
  exploY(y)=ships()\ShipY

  
  If ships()\Sprite=7
    Points=Points+10
    kills=kills+1
    ;ships()\shildenemy)=6
    verb-1
  EndIf
  If ships()\Sprite=21
    wave-1
    Points=Points+5
    kills=kills+0.5
    verb-1
  EndIf
    DeleteElement(ships())
   ;If verb=0 
    ;verb=maxe
    ;For enemy=1 To maxe
      ;newEnemy(enemy)
    ;Next
  ;EndIf
  
  
EndProcedure 
Procedure drawInterface(e)
    SelectElement(ships(),e)
    DisplayTransparentSprite(4,MouseX()-32,MouseY()-32)
    StartDrawing(ScreenOutput())
    LineXY(ships()\ShipX,ships()\ShipY,MouseX(),MouseY(),RGB(100,150,100))
    DrawingMode(1)
    DrawingFont(UseFont(1))
    FrontColor(255,100,100)
    Locate(10,10)
    DrawText("Lives:")
    Locate(900,10)
    DrawText("Score:"+Str(Points))
    Box(10,55,(ships()\shild*10),25,RGB(255,200,100))
    DrawingMode(1)
    FrontColor(255,255,255)
    Locate(11,56)
    DrawText("Shilds")
    Box(10,80,(ships()\daempf*10),25,RGB(100,255,100))
    Locate(11,86)
    DrawText("inertialsoftener")
    Box(10,200,25,kills*5,RGB(100,10,255))
    FrontColor(255,255,255)
    Locate(10,210)
    DrawText("kills")
    Locate(10,235)
    DrawText(Str(kills))
    If shots>1
      Locate(820,100)
      DrawText("Spread of Shots:"+Str(spread(e)))
    EndIf
    StopDrawing()
    drawing(Str(ListIndex(ships())),10,10,RGB(255,255,255))
    If kills>=5
      Start3D()
      create_ptcl(10,190+(Gsin(sini)*kills*5),10,10,20,300,30,kills/2,kills/2,-1,-1,100,9)
      Stop3D()
    EndIf  
    For x=1 To live
      DisplayTransparentSprite(6,x*24,30)
    Next
    For x=1 To live
      create_ptcl( MouseX()-32+(Gcos(sini)*30)+x*10, MouseY()-32+(Gsin(sini)*30),20,20,50,120,1,-1,-1,0,0,0,9)
    Next
  EndProcedure
Procedure waitingtime()
  For w=399 To 0 Step -1
    If sini<359:sini+1:Else:sini=0:EndIf 
      If IsScreenActive()
        star(1)
        For y=0 To 768 Step 2
          For x=0 To 1024 Step 2
            If raster(x,y)=-1
              DisplayTransparentSprite(#raster,x,y)
            EndIf
          Next
        Next
        If trans.w=0 And z=0
          trans.w=255
        ElseIf trans.w=255
          z=10
          trans.w=0
        EndIf
        z-1
        Sprite=1
        ExamineKeyboard()
        ExamineMouse()
        move()
        moverech(0)
        If raster(Int(ships()\ShipX),Int(ships()\ShipY))=-1
          speedx=speed
          speedy=speed
          flucht=1
        EndIf
        If flucht=1 And raster(Int(ships()\ShipX),Int(ships()\ShipY))<>-1
          flucht=0
          speedx=1
          speedy=1
        EndIf
        Start3D()
        ResetList(ships())
        While NextElement(ships())
          ;DisplayTransparentSprite(ships()\sprite,ships()\ShipXy)-SpriteWidth(ships()\sprite),ships()\ShipYy))
          DisplaySprite3D(ships()\Sprite,ships()\ShipX-SpriteWidth(ships()\Sprite)/2,ships()\ShipY,trans.w)
        Wend
        
        update_ptcl()
        update_ptclemitter()
        Stop3D()
        drawInterface(0)
        StartDrawing(ScreenOutput())
        DrawingMode(1)
        DrawingFont(UseFont(2))
        Locate(300,200)
        FrontColor(25,255,25)
        DrawText(Str(w/100))
        StopDrawing()
      Else
        StopSound(-1)
        Delay(10)  
      EndIf 
      FlipBuffers()
    Next
  EndProcedure    
Procedure Playershot()
  If MouseButton(1)=1 And delay<=0
    If ships()\ShipX>512
      pan=(ships()\ShipX/1024)*100
    Else
      pan=-((512-ships()\ShipX)/512)*100
    EndIf
    SoundPan(1,pan)
    For s=-(shots/2)*spread(0) To (shots/2)*spread(0) 
      s=s+spread
      PlaySound(1)
      delay=10
      x=0
      Repeat
        x=x+1
      Until eshot_exist(x,0)=0 Or x=max
      e_shotX(x,0)=ships()\ShipX+s
      shotX_a(x)=(ships()\ShipX+s-MouseX())
      shotY_a(x)=(ships()\ShipY-MouseY())
      e_shotY(x,0)=ships()\ShipY
      eshot_exist(x,0)=1
      ships()\TargetX=MouseX()
      ships()\TargetY=MouseY()
      If e_shotX(x,0)>ships()\TargetX
        richtung(x)=1
      ElseIf e_shotX(x,0)<ships()\TargetX
        richtung(x)=2
      EndIf 
      ships()\ShipX=ships()\ShipX+(((shotX_a(x)/shotY_a(x))*ships()\shotspeed)/ships()\daempf)
      ships()\ShipY=ships()\ShipY+(ships()\shotspeed/ships()\daempf)
      ships()\MoveX=ships()\MoveX-(((shotX_a(x)/shotY_a(x))*ships()\shotspeed)/ships()\daempf)
      ships()\MoveY=ships()\MoveY-(ships()\shotspeed/ships()\daempf)
    Next
  EndIf
EndProcedure
Procedure die()
         live=live-1
         PlaySound(3)
         ResetList(ships())
        SelectElement(ships(),0)
         ships()\ShipX=Random(1000)+1
         ships()\ShipY=Random(140)+600
         If live<1
           For x=1 To explo
           ex_exist(x)=0
           Next
           For x=1 To maximalgegner
           For y=1 To max
           eshot_exist(y,x)=0
           Next
           hit(x)=0
           hitX(x)=-10
           hitY(x)=-10
           Next
           hitX=-10
           hitY=-10
           hit=0
           Goto death
         EndIf   
         ships()\shild=shildmax
         ;kills=0
         StopSound(4)
         free_ptcl()
         waitingtime()
EndProcedure  
Procedure screenshotter()
OpenFile(1,"screensots.dat")
screenshots.w=ReadWord()
WriteWord(screenshots.w+1)
CloseFile(1)
GrabSprite(0,0,0,1024,768)
DisplaySprite(0,0,0)
StartDrawing(ScreenOutput())
DrawingMode(1)
DrawingFont(UseFont(1))
FrontColor(200,200,200)
Locate(100,100)
DrawText("Screenshotting, Please wait!")
StopDrawing()
FlipBuffers()
SaveSprite(0,"Screenshots\Screenshot "+Str(screenshots)+".bmp")
FreeSprite(0)
EndProcedure

Procedure pause()
GrabSprite(0,0,0,1024,768)
Repeat
If IsScreenActive()
DisplaySprite(0,0,0)
StartDrawing(SpriteOutput(0))
DrawingMode(1)
DrawingFont(UseFont(2))
FrontColor(100,50,60)
Locate(300,200)
DrawText("-Paused-")
DrawingFont(UseFont(1))
Locate(250,350)
DrawText("Press -P- To Continue")
StopDrawing()
FlipBuffers()
ExamineKeyboard()
Else
StopSound(-1)
Delay(10)  
EndIf 
Until KeyboardReleased(#PB_Key_P)
FreeSprite(0)
EndProcedure
Procedure multitask()
Repeat
Delay(1)
FlipBuffers()
Delay(1)
Until IsScreenActive()<>0
Delay(1000)
EndProcedure

Procedure loading(level,x,y,col)
  Protected progress,x,y,col
  boxX=x
  boxY=y+40
  noshow=0
  OpenFile(1,"level\level"+Str(level)+".scl")
  ResetList(ships())
  For y=0 To 768 Step 10
    For x=0 To 1024 Step 10
      progress+1
      proz.f=(100/((1024/10)*(768/10)))*progress
       raster(x,y)=Val(ReadString())
      If IsScreenActive() And Int(proz)<>merk And noshow=0
      merk=Int(proz)
      ClearScreen(10,10,10)
      StartDrawing(ScreenOutput())
      DrawingMode(1)
      DrawingFont(UseFont(1))
      Locate(boxX,boxY-40)
      FrontColor(Red(col),Green(col),Blue(col))
      DrawText("loading, please wait... "+Str(proz)+"%")
      Box(boxX,boxY,proz*2,20)
      StopDrawing()
      FlipBuffers()
      EndIf
      If raster(x,y)=4
        AddElement(ships())
        ships()\Sprite=1
        ships()\daempf=1
        ships()\shild=shildmax
        ships()\shotspeed=-5
        ships()\ShipX=x
        ships()\ShipY=y
      ElseIf raster(x,y)=1
        AddElement(ships())
        ships()\ShipX=x
        ships()\ShipY=y
        ships()\daempf=1
        ships()\shotspeed=5
        ships()\shild=6
        ships()\Sprite=7
        ships()\TargetX=shipX(0)
        ships()\TargetY=shipY(0)
        ships()\TargetID=0
        EndIf
      ExamineKeyboard()
        If KeyboardReleased(#PB_Key_Escape)
          noshow=1
        EndIf
        
      Next
    Next
    verb=maxe
  CloseFile(1)
  
EndProcedure  
Procedure.f ki(axis$,xpos,ypos,id,gegnerX,gegnerY)
  ;ResetList(ships())
  SelectElement(ships(),id)
  abst=1000
  Protected x.w,y.w,z.w,move.f
  ;move=6
  ;If flucht(id)=0
   ; flucht(id)=Random(2)
  ;EndIf
  
    ResetList(shots())
    While NextElement(shots())
      abst(z) = Sqr(Pow(xpos-shots()\shotX,2) + Pow(ypos-shots()\shotY,2)) 
        x+1
       
        If abst>abst(z)
        abst=abst(z)
        posx=shots()\shotX
        posY=shots()\shotY
        EndIf

  Wend
  If axis$="X"
    If abst<100
      If x <> 0 And Abs(ships()\MoveX<speed)
      If posx<xpos
      move=speed/10
    ElseIf posx>xpos
      move=-speed/10
    EndIf
    If xpos+move > 1000
      move=-(speed/10)
    EndIf
    If xpos+move<10
      move=speed/10
    EndIf
    EndIf
  Else
    If xpos<gegnerX
      move=speed/10
    ElseIf xpos>gegnerX
      move=-(speed/10)
    EndIf
  EndIf
  If Sqr(Pow(xpos-gegnerX,2) + Pow(ypos-gegnerY,2))<250
    If gegnerX>ypos
      move=-speed/10
    ElseIf gegnerX<ypos
      move=speed/10
    EndIf
  EndIf
  If ships()\shild<2
    If xpos<gegnerX
      move=speed/10
    ElseIf xpos>gegnerX
      move=-(speed/10)
    EndIf
  EndIf
  For x=0 To 20 
    yber=Int(ships()\ShipY+ships()\MoveY*10)
    xber1=Int(ships()\ShipX)+x
    xber2=Int(ships()\ShipX)+x+10
    If yber < 768 And yber > 0 And xber1<1024 And xber1>0 And xber2<1024 And xber2>0
      If raster(xber1,yber)=-1
        move=-speed/10
      ElseIf raster(xber1,yber)=-1
        move=speed/10 
      EndIf
    EndIf
  Next
ElseIf axis$="Y"
  If abst<100 
    If xpos<posx And Abs(ships()\MoveY<speed)
      move=speed/10
    ElseIf xpos>posx
      move=-(speed/10)
    EndIf
  EndIf
  If Sqr(Pow(xpos-gegnerX,2) + Pow(ypos-gegnerY,2))>550
    If gegnerY>ypos
      move=speed/10
    ElseIf gegnerY<ypos
      move=-speed/10
    EndIf
  EndIf
  If gegnerY<ypos
    move=-speed/10
  EndIf
  If gegnerY-ypos<150
    move=-speed/10
  EndIf
  If Sqr(Pow(xpos-gegnerX,2) + Pow(ypos-gegnerY,2))<250
    If gegnerY>ypos
      move=-speed/10
    ElseIf gegnerY<ypos
      move=speed/10
    EndIf
  EndIf
  If ships()\shild<2
    If ypos<gegnerY
      move=speed/10
    ElseIf ypos>gegnerY
      move=-speed/10
    EndIf
  EndIf 
  For y=0 To 20
    xber=Int(ships()\ShipX+ships()\MoveX*10)
    yber1=Int(ships()\ShipY)+y
    yber2=Int(ships()\ShipY)+y+10
    If xber < 1024 And xber > 0 And yber1<768 And yber1>0 And yber2<768 And yber2>0
    If raster(xber,yber1)=-1
      move=-speed/10
    ElseIf raster(xber,yber2)=-1
      move=speed/10 
    EndIf
  EndIf
  Next
  
EndIf
If bugreport=#True
  Debug "********"
  If FindString(StrF(ships()\MoveX+move), "#", 0)<>0
    Debug "#ERROR#"
  EndIf
  Debug "move:"+StrF(ships()\MoveX+move)
  Debug "abst:"+StrF(abst)
  Debug "abst2:"+StrF(Sqr(Pow(xpos-gegnerX,2) + Pow(ypos-gegnerY,2)))
  Debug "ships()\ShipX0):"+StrF(gegnerX)
  Debug "ships()\ShipY0):"+StrF(gegnerY)
  Debug "EnemyX:"+StrF(ships()\ShipX)
  Debug "EnemyY:"+StrF(ships()\ShipY)
  Debug "Shild:"+Str(ships()\shild)
EndIf
    ProcedureReturn move.f
  
  EndProcedure
Procedure.f kamikaze_ki(axis$,xpos.f,ypos.f,id)
  Protected xpos.f,ypos.f,move.f
  ;ResetList(ships())
  SelectElement(ships(),id)
    Select axis$
      Case "X"
        If xpos<1000 And ships()\MoveX>0 
          move=speed/10
        ElseIf xpos>10 And ships()\MoveX<0 
          move=-speed/10
        Else
         If xpos>1000
          move=-speed/10
        ElseIf xpos<10
          move=speed/10
        EndIf
        EndIf
      Case"Y"
        If ships()\MoveY<2
          move=speed/10
        Else
          move=-speed/10
        EndIf
    EndSelect
    If ypos>739
      e_exist(id)=0
      ships()\ShipX=-100
      ships()\ShipY=-100
      ships()\MoveX=0
      ships()\MoveY=0
      wave-1
    EndIf
    ProcedureReturn move
  EndProcedure
Procedure shot(id,TargetX.f,TargetY.f)
    PlaySound(1)
    AddElement(shots())
    shots()\shotX=ships()\ShipX+SpriteWidth(ships()\Sprite)/2
    shots()\shotY=ships()\ShipY
    shots()\shotspeedX=((ships()\ShipX-TargetX)/(ships()\ShipY-TargetY))*ships()\shotspeed
    shots()\shotspeedY=ships()\shotspeed
    ships()\MoveX=ships()\MoveX-(shots()\shotspeedX/ships()\daempf)
    ships()\MoveY=ships()\MoveY-(shots()\shotspeedY/ships()\daempf)
    Repeat
    shots()\shotX=shots()\shotX+shots()\shotspeedX
    shots()\shotY=shots()\shotY+shots()\shotspeedY
  Until SpriteCollision(ships()\Sprite,ships()\ShipX+SpriteWidth(ships()\Sprite)/2,ships()\ShipY,8,shots()\shotX,shots()\shotY)=0
  
  EndProcedure
Procedure.s GetOS()
    os.s="Fehler"
    Select OSVersion()
      Case #PB_OS_Windows_NT3_51
        os="Windows NT 3.51"
      Case #PB_OS_Windows_95
        os="Windows 95"
      Case #PB_OS_Windows_NT_4
        os="NT 4"
      Case #PB_OS_Windows_98
        os="Windows 98"
      Case #PB_OS_Windows_ME
        os="Windows ME"
      Case #PB_OS_Windows_2000
        os="Windows 2000"
        
      Case #PB_OS_Windows_XP
        os="Windows XP"
      Case #PB_OS_Windows_Server_2003
        os="Windows Server 2003"
      Case #PB_OS_AmigaOS
        os="AmigaOS"
      Case #PB_OS_Linux
        os="Linux"
      Case #PB_OS_Windows_Future
        os="Windows Version vorhanden, die zum beim Entwicklungszeitpunkt noch nicht existierte. (Longhorn?) bitte Manuell wählen"
      Default
        os="Betriebssystem wird nicht unterstützt"    
    EndSelect
    ProcedureReturn os
  EndProcedure
Procedure create_level()
    For x=1 To 1024/2 ;Step 2
      If Random(x*diff)=1
        raster(x,0)=-1
      EndIf
      If Random(x*diff)=1
        raster(1024-x,0)=-1
      EndIf
    Next
  EndProcedure

;-sparks
Structure fireworks
  fx.f
  fy.f
  fxx.f
  fyy.f
  fsize.f
  fangle.l
  fangleinc.l
  fcolor.l
EndStructure
NewList sparks.fireworks()
Goto jump
Endgame:
GrabSprite(0,0,0,1024,768)
ChangeGamma(200,200,200,0)
Repeat

StartSpecialFX()
DisplaySprite(0,0,0)
DisplayRGBFilter(0,0,1024,768,100,50,70)
StopSpecialFX()

Pixel_DisplayTransparentFont(0,400,300,"Really quit?")
Pixel_DisplayTransparentFont(0,400,350,"Y/N")
FlipBuffers()
ExamineKeyboard()
If KeyboardPushed(#PB_Key_N)
For x=200 To 255
ChangeGamma(x,x,x,0)
Next
Goto no
EndIf
Until KeyboardPushed(#PB_Key_Y) Or KeyboardPushed(#PB_Key_Z)
StopMovie()
StopSound(-1)
introex=0
OpenFile(1,"intro")
WriteLong(introex)
CloseFile(1)
CloseScreen()
RunProgram(GetAppDir())
End
jump:
Johann Wolfgang von Geothe hat geschrieben:Wie dieses oder jenes Wort geschrieben wird, darauf kommt es doch eigentlich nicht an, sondern darauf, daß die Leser verstehen, was man damit sagen wollte.
Benutzeravatar
Batze
Beiträge: 1492
Registriert: 03.06.2005 21:58
Wohnort: Berlin
Kontaktdaten:

Beitrag von Batze »

Wie wär's mit Zip? Ich benutz kein rar. :wink:
Hier sind meine Codes (aber die Seite geht gerade nicht):
http://www.basicpure.de.vu
Benutzeravatar
AndyX
Beiträge: 1272
Registriert: 17.12.2004 20:10
Wohnort: Niederösterreich
Kontaktdaten:

Beitrag von AndyX »

hol dir WinRAR oder IZarc oder mit Winzip sollten RARs auch gehen... :?
Benutzeravatar
Batze
Beiträge: 1492
Registriert: 03.06.2005 21:58
Wohnort: Berlin
Kontaktdaten:

Beitrag von Batze »

Dacht ich auch, aber irgendwie kennt der das Format nicht.
Da muss ich mir halt doch noch ein Programm besorgen. :(
Hier sind meine Codes (aber die Seite geht gerade nicht):
http://www.basicpure.de.vu
Benutzeravatar
Ynnus
Beiträge: 855
Registriert: 29.08.2004 01:37
Kontaktdaten:

Beitrag von Ynnus »

WinZip ist insofern Müll, da es nicht RAR unterstützt, was neben Zip das weitverbreitetste Archiv-Format ist. WinRAR hingegen unterstützt beides, auch Zip, und kann somit alles. (Auch ACE und andere Formate). WIchtig ist eben nur, dass Winrar auch Zip kann, WinZIP aber kein Rar. (Was ich ziemlich beschränkt finde).
Benutzeravatar
NicTheQuick
Ein Admin
Beiträge: 8809
Registriert: 29.08.2004 20:20
Computerausstattung: Ryzen 7 5800X, 64 GB DDR4-3200
Ubuntu 24.04.2 LTS
GeForce RTX 3080 Ti
Wohnort: Saarbrücken

Beitrag von NicTheQuick »

In vielen Fällen packt RAR auch besser als ZIP, aber das sind normalerweise nur ein paar kB, die nicht weiter ins Gewicht fallen, wenn man nicht gerade ein 32 kB-Demo proggen will. :wink:
Benutzeravatar
benpicco
Beiträge: 391
Registriert: 01.10.2004 15:32
Wohnort: im Code
Kontaktdaten:

Beitrag von benpicco »

Naja, manchmal können diese "paar Kilobyte" viel außmachen, wenn man z.B. ein Modem hat :roll: oder das Ganze auf ne Diskette bekommen möchte (hier sind es z.B. ca. 200kb Unterschied!!!)
Johann Wolfgang von Geothe hat geschrieben:Wie dieses oder jenes Wort geschrieben wird, darauf kommt es doch eigentlich nicht an, sondern darauf, daß die Leser verstehen, was man damit sagen wollte.
Benutzeravatar
benpicco
Beiträge: 391
Registriert: 01.10.2004 15:32
Wohnort: im Code
Kontaktdaten:

Fehler gefunden!

Beitrag von benpicco »

)Ich hab den Fehler gefunden, er stak im Detail:

Code: Alles auswählen

moverech(0)
musste durch

Code: Alles auswählen

 moverech(ListIndex(ships()))
ersetz werden (ich weiß nur nicht, wie die 0 dahinkam...)
Der Enerhieverlust lag daran, das an der Stelle noch ein X stand, es hätte aber ships()\sprite heißen sollen (es war aber nicht gut, als ich suchen/ erseltzen "sprite(" eingegeben hatte... :roll: )
Jetzt geht wieder *fast* alles.
Eine Frage noch:
Dar ich das mit den Garfikkarten machen oder hatt Ati und/oder nvidea da wa dagegen :roll: ?
Kann man den überhaupt rausfinden, von welchem Hersteller die GraKa ist? Also ich fänd das doch mal lustig... :wink: [/code]
Johann Wolfgang von Geothe hat geschrieben:Wie dieses oder jenes Wort geschrieben wird, darauf kommt es doch eigentlich nicht an, sondern darauf, daß die Leser verstehen, was man damit sagen wollte.
Antworten