| Suchrakete in 2D von Markus |
| Kleines Beispiel einer Suchrakete (2D) die von einem Schiff abgeschossen werden kann und ein anderes Schiff hinterher fliegt bis sie trifft oder der Treibstoff alle geht . Wer Probleme mit Types hat kann da auch mal reingucken ;-) [code:1:8e7ed9d103] ;Rakete Ziel Blitz2D Example von Markus Rauch ;Tasten Links/Rechts steuert Schiff 1 ;Maus Left schieß immer auf Schiff 2 ;Maus Rechts schieß auf das Schiff wo cursor drüber ist ;MR 12.05.2003 Graphics 640,480,16,0 SetBuffer BackBuffer() Type RaketeType Field px# Field py# Field dx# Field dy# Field speed# Field speedmax# Field w# Field range# Field TargetSchiff.SchiffType Field Staerke# End Type Type SchiffType Field Name$ Field px# Field py# Field dx# Field dy# Field speed# Field speedmax# Field w# Field FarbeR Field FarbeG Field FarbeB Field Staerke# Field Sinkt End Type Type BumType Field x#,y# Field TargetSchiff.SchiffType Field TimeOut End Type Global Schiff.SchiffType Global Rakete.RaketeType Global Bum.BumType SchiffNeu "1",320,300,260,1,200,0,255,0 ;Von hier wird geballert SchiffNeu "2",320,100,200,2,200,255,0,0 ;Ziel SchiffNeu "3",220,100,100,2,200,0,0,255 ;Ziel ;------------------------------------------------------------------- MainLoop End ;------------------------------------------------------------------- Function MainLoop() Local PlayerSchiff1.SchiffType=SchiffFind("1") Local PlayerSchiff2.SchiffType=SchiffFind("2") Local mx,my While Not KeyHit(1) mx=MouseX() my=MouseY() Cls ;--------------------------------------------- Schiff 1 lenken If KeyDown(203) Then If PlayerSchiff1<>Null Then If PlayerSchiff1Sinkt=False Then PlayerSchiff1w=PlayerSchiff1w+2 If PlayerSchiff1w>360 Then PlayerSchiff1w=PlayerSchiff1w-360 PlayerSchiff1dx=Sin(PlayerSchiff1w) PlayerSchiff1dy=Cos(PlayerSchiff1w) EndIf EndIf EndIf If KeyDown(205) Then If PlayerSchiff1<>Null Then If PlayerSchiff1Sinkt=False Then PlayerSchiff1w=PlayerSchiff1w-2 If PlayerSchiff1w<0 Then PlayerSchiff1w=PlayerSchiff1w+360 PlayerSchiff1dx=Sin(PlayerSchiff1w) PlayerSchiff1dy=Cos(PlayerSchiff1w) EndIf EndIf EndIf ;--------------------------------------------- SchiffeUpdate SchiffeZeigen BumUpdate BumZeigen RaketenUpdate RaketenZeigen ;--------------------------------------------- ;Immer auf Schiff 2 If MouseHit(1) Then RaketeNeu SchiffFind("1"),SchiffFind("2"),50 EndIf ;Auf Schiff wo Maus ist If MouseHit(2) Then RaketeNeu SchiffFind("1"),SchiffFindXY(mx,my,40),50 EndIf ;--------------------------------------------- Color 255,255,255 Oval mx-5,my-5,10,10,False ;--------------------------------------------- Delay 20 Flip Wend Delete Each SchiffType Delete Each RaketeType Delete Each BumType End Function Function SchiffNeu(Name$,px#,py#,winkel#,speed#,staerke#,r,g,b) ;Neues Schiff bauen Schiff.SchiffType=New SchiffType SchiffName$=Name$ Schiffpx=px Schiffpy=py Schiffdx=Sin(winkel) Schiffdy=Cos(winkel) Schiffw=winkel Schiffspeed=speed Schiffstaerke=staerke SchiffFarbeR=R SchiffFarbeG=G SchiffFarbeB=B SchiffSinkt=False End Function Function SchiffeUpdate() ;Schiffe bewegen For Schiff.SchiffType =Each SchiffType If SchiffSinkt=False Then If SchiffSpeed<SchiffSpeedMax Then SchiffSpeed=SchiffSpeed+0.1 Schiffpx=Schiffpx+Schiffdx*Schiffspeed Schiffpy=Schiffpy+Schiffdy*Schiffspeed If Schiffpx<0 Then Schiffpx=Schiffpx+GraphicsWidth() If Schiffpy<0 Then Schiffpy=Schiffpy+GraphicsHeight() If Schiffpx>GraphicsWidth() -1 Then Schiffpx=Schiffpx-GraphicsWidth() If Schiffpy>GraphicsHeight()-1 Then Schiffpy=Schiffpy-GraphicsHeight() EndIf Next End Function Function SchiffFind.SchiffType(Name$) ;Schiffnamen suchen und SchiffType zurück geben For Schiff.SchiffType =Each SchiffType If SchiffName$=Name$ Then Return Schiff Next Return Null End Function Function SchiffFindXY.SchiffType(px#,py#,ra#) ;Schiffnamen suchen und SchiffType zurück geben For Schiff.SchiffType =Each SchiffType If Entf(px,py,Schiffpx,Schiffpy)<=ra Then Return Schiff Next Return Null End Function Function RaketeNeu(SS.SchiffType,SZ.SchiffType,staerke#) ;Neue Rakete starten , erstmal mit Winkel wie Schiff :-) If ss=Null Or sz=Null Then Return 0 If ss=sz Then Return 0 ;auf sich selber schießen wäre doof ;-) Rakete.RaketeType=New RaketeType Raketepx=sspx Raketepy=sspy Raketew=ssw Raketedx=ssdx Raketedy=ssdy Raketespeed=0 Raketespeedmax=10 Rakete ange=200 Raketestaerke=staerke RaketeTargetSchiff=sz Return True End Function Function RaketenUpdate() ;Beschleunig die Rakete und bewegt sie bis der Treibstoff alle ist ;Dann wird sie langsamer und verschwindet Local Weg For Rakete.RaketeType =Each RaketeType Weg=0 RaketeZielUpdate Rakete If RaketeSpeed<RaketeSpeedMax Then RaketeSpeed=RaketeSpeed+0.1:If RaketeSpeed>RaketeSpeedMax Then RaketeSpeed=RaketeSpeedMax Raketepx=Raketepx+Raketedx*Raketespeed Raketepy=Raketepy+Raketedy*Raketespeed If RaketeTargetSchiff<>Null Then If Entf(Raketepx,Raketepy,RaketeTargetSchiffpx,RaketeTargetSchiffpy)<10 Then BumNew Raketepx,Raketepy,RaketeTargetSchiff,RaketeStaerke Weg=True EndIf EndIf If Rakete ange>0 Then Rakete ange=Rakete ange-RaketeSpeed ;Flugdauer begrenzen If Rakete ange<=0 Then If RaketeSpeed>0 Then RaketeSpeed=RaketeSpeed-0.25 ;kein Treibstoff mehr If RaketeSpeed<=0 Then Weg=True ;Hokus Pokus EndIf If Weg=True Then RaketeFree Rakete Next End Function Function RaketeFree(R.RaketeType) ;Rakete freigeben Delete R End Function Function RaketeZielUpdate(R.RaketeType) If rTargetSchiff=Null Then Return ;Schiff gibt es nicht mehr dann einfach weiter fliegen lassen mit letztem Kurs ;neuen Kurs für die Rakete ausrechnen Local dx#,dy# dx=rTargetSchiffpx-rpx dy=rTargetSchiffpy-rpy Local wneu# Local walt# Local wd# walt=RW wneu=ATan2(dx,dy) Local inc#=(rspeedmax/rspeed)*2.0+5.0 RW=curveangle#( wneu,walt,inc) rdx=Sin(RW) rdy=Cos(RW) ;Richtung zum Ziel ;Local l=300 ;Color 128,128,128 ;Line rpx,rpy,rpx+(l*rdx) , rpy+(l*rdy) End Function Function RaketenZeigen() ;Alle Raketen zeigen For Rakete.RaketeType =Each RaketeType RaketeZeigen Rakete Next End Function Function RaketeZeigen(R.RaketeType) Local l#=10 ;Länge Rakete Color 255,255,0 ;Schweif in die entgegengesetzte Richtung ! Line rpx, rpy , rpx-(l*rdx) , rpy-(l*rdy) ;Punkt alt Raketenkopf :-) Color 255,0,0 Plot rpx,rpy End Function Function SchiffeZeigen() ;Zeigt alle Schiffe For Schiff.SchiffType =Each SchiffType SchiffZeigen Schiff Next End Function Function SchiffZeigen(S.SchiffType) ;zeichnet das Schiff Local l=20 ;Schiff länge If SSinkt=False Then Color sFarbeR,sFarbeG,sFarbeB Else Color 128,128,128 EndIf Line spx,spy,spx-sdx*l,spy-sdy*l ;Kopf des Schiffes Color 255,255,255 Plot spx,spy End Function Function BumNew(x,y,S.SchiffType,Staerke#) ;Neuen Treffer zeigen und Ziel an Staerke abziehen , wenn Ziel kaputt dann wird SchiffSinkt=True Bum.BumType=New BumType BumTimeOut=100 Bumx=x Bumy=y BumTargetSchiff=s If BumTargetSchiffStaerke>0 Then BumTargetSchiffStaerke=BumTargetSchiffStaerke-Staerke If BumTargetSchiffStaerke<=0 Then BumTargetSchiffStaerke=0:BumTargetSchiffSinkt=True EndIf End Function Function BumUpdate() ;Treffer sollen nicht ewig sichtbar sein For Bum.BumType=Each BumType If BumTimeOut>0 Then BumTimeOut=BumTimeOut-1 Else Delete Bum EndIf Next End Function Function BumZeigen() ;Treffer zeigen Local x#,y# For Bum.BumType=Each BumType Color 255,255,0 x=Bumx y=Bumy Oval x-4,y-4,8,8 Next End Function Function curveangle#(newangle#,oldangle#,increments#) ;Elegante Lösung um die Winkel differenz heraus zu bekommen ;Mit increments kann man die gesamt Winkeldifferenz teilen das kleine Schritte möglich sind If (oldangle+360)-newangle<NEWANGLE-OLDANGLE Then OLDANGLE=360+OLDANGLE If (newangle+360)-oldangle<OLDANGLE-NEWANGLE Then NEWANGLE=360+NEWANGLE oldangle=oldangle-(oldangle-newangle)/increments Return oldangle End Function Function Entf#(x1#,y1#,x2#,y2#) ;Entfernung zwischen Punkt 1 und 2 Local dx#,dy# dx=x2-x1 dy=y2-y1 Return Sqr(dx*dx+dy*dy) End Function [/code:1:8e7ed9d103] |