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: