ASCII-Shooter

Übersicht Sonstiges Projekte

Gehe zu Seite Zurück  1, 2

Neue Antwort erstellen

Vincent

BeitragMo, Jan 10, 2005 18:12
Antworten mit Zitat
Benutzer-Profile anzeigen
also das mit dem random map genarator hatte ich schonmal reinprogrammiert, mir aber dann gedacht, dass das spiel mit selbstgemachten lvl besser aussehen würde ... man kann ja die wände und den boden theoretisch auch verändern (beim boden müsste man das dann im programm wegen der kollision verändern)

Code: [AUSKLAPPEN]

;initialisierungen
Global Xres = 400 , Yres = 300
Global Zeichengroesse = 15
Global Xsize = Int( Xres / Zeichengroesse ) , Ysize = Int( Yres / Zeichengroesse ) - 1
Dim feld$( Xsize , Ysize ) ;spielfeld für kollisionsprüfung erstellen
Global c

SeedRnd MilliSecs()
;lvlrand erstellen
For b = 0 To Ysize
   For a = 0 To Xsize
      Select b
      Case 0 :   feld$( a , b ) = Mid$("##########################",a+1,1)
      Case 1 :   feld$( a , b ) = Mid$("#  # #                   #",a+1,1)   
      Case 2 :   feld$( a , b ) = Mid$("#  # #    #####    #######",a+1,1)
      Case 3 :   feld$( a , b ) = Mid$("#    #    #              #",a+1,1)
      Case 4 :   feld$( a , b ) = Mid$("#### #    #              #",a+1,1)
      Case 5 :   feld$( a , b ) = Mid$("#    #    ################",a+1,1)
      Case 6 :   feld$( a , b ) = Mid$("#    #                   #",a+1,1)
      Case 7 :   feld$( a , b ) = Mid$("#    ##########          #",a+1,1)
      Case 8 :   feld$( a , b ) = Mid$("#             #          #",a+1,1)
      Case 9 :  feld$( a , b ) = Mid$("###  ####     #    #     #",a+1,1)
      Case 10 :  feld$( a , b ) = Mid$("#       #     #    #     #",a+1,1)
      Case 11 :  feld$( a , b ) = Mid$("#       #     #          #",a+1,1)
      Case 12 :  feld$( a , b ) = Mid$("#       #     #          #",a+1,1)
      Case 13 :  feld$( a , b ) = Mid$("#       #     #    #######",a+1,1)
      Case 14 :  feld$( a , b ) = Mid$("#########     #          #",a+1,1)
      Case 15 :  feld$( a , b ) = Mid$("#             #          #",a+1,1)
      Case 16 :  feld$( a , b ) = Mid$("#  ################      #",a+1,1)
      Case 17 :  feld$( a , b ) = Mid$("#                        #",a+1,1)
      Case 18 :  feld$( a , b ) = Mid$("##########################",a+1,1)
      End Select
   Next
Next

game_timer = CreateTimer( 10 )

;grafikinitialisierung
Graphics Xres , Yres , 16 , 2
SetBuffer BackBuffer ()
SetFont LoadFont( "Courier new" , Zeichengroesse + 0)
ClsColor 0,40,0

;sinnfreier startbildschirm
startbild()

;types
Type Sch  ;schusstype
   Field x
   Field y
   Field dir
   Field typ
End Type
Global schuss.sch

Type effe ; Effekttype
   Field x
   Field y
   Field status
End Type
Global effekt.effe

;ZielPosition erstellen:
Global Ziel_X=23
Global Ziel_Y=4

Type gegn ;gegnertype
   Field x
   Field y
   Field lp ; lebenspunkte
   Field typ$ ;zeichen
   Field sichtweite ; in zeichenfeldern
   Field geschwindigkeit ;zeit von einem schritt zum nächsten in ms
   Field bewegt ; nur vom programm genutzt
End Type
Global gegner.gegn

;spielstarteinstellungen
Global timer
Global PLAYER_dir = 2  ;spielerblickrichtung 0=oben 1=rechts 2=unten 3=links
Global PLAYER_x = 2
Global PLAYER_y = 2
feld$( PLAYER_x , PLAYER_y ) = "M"
Global PLAYER_munition = 200

;gegnererstellung
gegnererstellung(30)

;main
Repeat
   ;Bewegen
   bewegen()
   
   ;Schüsse
   If KeyHit( 57 ) And timer < MilliSecs() And PLAYER_munition > 0 Then
   schiessen()
   EndIf
   ;Gewinnfunktion
   gewinnen()
   ;Zeichnen + KI
   update()
   Flip
   WaitTimer (game_timer) ; auf timer warten ... sinnvollste lösung meiner meinung nach ... wegen der blockbewegung
   Cls
Until KeyHit(1)

End






; funktionen %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

Function startbild()
Cls
Text Xres / 2 , Yres / 2 , "Willkommen zu ASCII-Shooter!" , 1 , 1
Flip : WaitKey : Cls
Text 9 , 1 * (Zeichengroesse + 2 ) , "Vor vielen Jahren gab es kluge Manschen,"
Text 9 , 2 * (Zeichengroesse + 2 ) , "die die Computer erfanden."
Text 9 , 3 * (Zeichengroesse + 2 ) , "Sie entwickelten einen Zeichensatz,"
Text 9 , 4 * (Zeichengroesse + 2 ) , "der sich ASCII nannte."
Text 9 , 5 * (Zeichengroesse + 2 ) , "Nun, viele Jahre später, "
Text 9 , 6 * (Zeichengroesse + 2 ) , "soll dieser ASCII-Zeichensatz"
Text 9 , 7 * (Zeichengroesse + 2 ) , "durch undefinierbare Zeichen"
Text 9 , 8 * (Zeichengroesse + 2 ) , "vernichtet werden."
Text 9 , 9 * (Zeichengroesse + 2 ) , "Nur SIE, ein unschuldiges Zeichen,"
Text 9 , 10 * (Zeichengroesse + 2 ) , "können die Vernichtung noch aufhalten."
Text 9 , 12 * (Zeichengroesse + 2 ) , "Retten sie die Schönheit der ASCII-Codes."
Flip : FlushKeys : WaitKey
End Function

Function gegnererstellung( a ) ;anzahl
For i = 1 To a
   gegner.gegn = New gegn

   gegner\sichtweite = 8
   gegner\geschwindigkeit = 700
   gegner\lp = 1
   gegner\typ$ = Chr(164)
   
   Repeat
      gegner\x = Rand( 1 , Xsize - 1 )
      gegner\y = Rand( 1 , Ysize - 1 )
   Until feld$( gegner\x , gegner\y ) = " " And  Sqr( (gegner\x-PLAYER_x) * (gegner\x-PLAYER_x) + (gegner\y-PLAYER_y) * (gegner\y-PLAYER_y) ) > gegner\sichtweite
   
   feld$(gegner\x , gegner\y ) = gegner\typ$
Next
End Function

Function bewegen()
   If KeyDown( 200 ) And feld$( PLAYER_x , PLAYER_y - 1 ) = " " Then feld$(PLAYER_x,PLAYER_y)=" " : PLAYER_y = Player_y - 1 : PLAYER_dir = 0 : feld$(PLAYER_x,PLAYER_y)="W"
   If KeyDown( 205 ) And feld$( PLAYER_x + 1 , PLAYER_y ) = " " Then feld$(PLAYER_x,PLAYER_y)=" " : PLAYER_x = Player_x + 1 : PLAYER_dir = 1 : feld$(PLAYER_x,PLAYER_y)="E"
   If KeyDown( 208 ) And feld$( PLAYER_x , PLAYER_y + 1 ) = " " Then feld$(PLAYER_x,PLAYER_y)=" " : PLAYER_y = Player_y + 1 : PLAYER_dir = 2 : feld$(PLAYER_x,PLAYER_y)="M"   
   If KeyDown( 203 ) And feld$( PLAYER_x - 1 , PLAYER_y ) = " " Then feld$(PLAYER_x,PLAYER_y)=" " : PLAYER_x = Player_x - 1 : PLAYER_dir = 3 : feld$(PLAYER_x,PLAYER_y)="3"
End Function



Function update()
   ;lvl malen
   For a = 0 To Xsize
   For b = 0 To Ysize
      Color 200,200,200
   If feld$( a , b ) = Chr(164)  Color 255,0,0
   If feld$( a , b ) = "M" Or feld$( a , b ) = "E" Or feld$( a , b ) = "W" Or feld$( a , b ) = "3" Color 0,255,0
   
      Text a * Zeichengroesse , b * zeichengroesse , feld$( a , b )
   Next
   Next

   ;gegner zeichnen + auf schusstreffer überprüfen
    For gegner=Each gegn
   Color 255,0,0
   
   For schuss=Each sch
      If gegner\x = schuss\x And gegner\y = schuss\y Then gegner\lp = gegner\lp - 1 : Delete schuss : Exit
   Next     

   If gegner\lp > 0
      If Sqr( (gegner\x-PLAYER_x) * (gegner\x-PLAYER_x) + (gegner\y-PLAYER_y) * (gegner\y-PLAYER_y) ) < gegner\sichtweite And gegner\bewegt < MilliSecs()
         feld$(gegner\x , gegner\y ) = " "
      gegner\x = gegner\x - (PLAYER_x + 0 < gegner\x And feld$(gegner\x -1 , gegner\y) = " ") + (PLAYER_x - 0 > gegner\x And feld$(gegner\x +1 , gegner\y) = " ")
         gegner\y = gegner\y - (PLAYER_y + 0 < gegner\y And feld$(gegner\x , gegner\y - 1) = " ") + (PLAYER_y - 0 > gegner\y And feld$(gegner\x , gegner\y + 1) = " ")
         gegner\bewegt = MilliSecs() + gegner\geschwindigkeit
   feld$(gegner\x , gegner\y ) = gegner\typ$
      EndIf
   Else
      neueffekt(gegner\x, gegner\y)
   feld$(gegner\x , gegner\y ) = " "
      Delete gegner
   EndIf
   Next

   ;schüsse auf kollision überprüfen
   For schuss=Each sch
   If feld$( schuss\x , schuss\y ) = " "
      Color 0,255,255
            Text schuss\x * zeichengroesse , schuss\y * zeichengroesse , "*"
      schuss\x = schuss\x - ( schuss\dir = 3 ) + ( schuss\dir = 1 )
      schuss\Y = schuss\y - ( schuss\dir = 0 ) + ( schuss\dir = 2 )
   Else
      Delete schuss
   EndIf
   Next
   Color 255,255,0
   Text ziel_x * zeichengroesse , ziel_y * zeichengroesse ,"!"

   ;Effekte Zeichnen:
   draweffekt
End Function

Function schiessen()
   ;munition abziehen
     PLAYER_munition = PLAYER_munition - 1

    ;neuen schuss erstellen
   schuss.sch = New sch
   schuss\typ = typ ; das hat noch keinen sinn ... also typ = 0

         ;positionieren des schusses neben/über/unter dem spieler je nach blickrichtung
   schuss\x = PLAYER_x - ( PLAYER_dir = 3 ) + ( PLAYER_dir = 1 )
   schuss\Y = PLAYER_y - ( PLAYER_dir = 0 ) + ( PLAYER_dir = 2 )
   schuss\dir = PLAYER_dir
   
   ;zeitspanne bis der nächste schuss erlaubt ist in ms
   timer = MilliSecs() + 300
End Function


Function Gewinnen()
   ;Abfrage der Spieler-Koordinaten
   If Player_X = Ziel_x And Player_Y = Ziel_y
      ;gewinnbildschirm einblenden
      ClsColor 0, 200, 0
      Cls
      Text Xres/2, Yres/2,"Sie haben gewonnen!",1,1
      Flip
      FlushKeys
      WaitKey
      End
   EndIf
End Function

Function neueffekt(x, y)
   effekt.effe=New effe
   effekt\x=x
   effekt\y=y
   effekt\status=1
End Function

Function initeffekt()
   For effekt=Each effe
      effekt\status=effekt\status+1
      If effekt\status=5 Then Delete effekt
   Next
End Function

Function draweffekt()
   initeffekt()
   For effekt=Each effe
      Select effekt\status
         Case 1
            Text effekt\x*zeichengroesse, effekt\y*zeichengroesse, "#"
         Case 2
            Text effekt\x*zeichengroesse, effekt\y*zeichengroesse, "*"
         Case 3
            Text effekt\x*zeichengroesse, effekt\y*zeichengroesse, "+"
         Case 4
            Text effekt\x*zeichengroesse, effekt\y*zeichengroesse, "."
      End Select
   Next
End Function


Neuerungen:
Arrow Gegner können nicht mehr aufeinander laufen
Arrow Gegner können nicht mehr auf Spieler laufen
Arrow Spieler kann nicht auf Gegner laufen
Gott ist nicht mit uns ... weil er mit Idioten keine Gnade kennt !
 

ke^kx

BeitragMo, Jan 10, 2005 18:38
Antworten mit Zitat
Benutzer-Profile anzeigen
Funktioniert bei mir nicht (bleibt beim 2ten Teil des "Startbildschirms" hängen und wenn ich ihn rausnehme geht garnichts. Und da ich jetzt keinen Bock habe den Fehler zu suchen erzähl ich es einfach euch^^

Jiriki
http://i3u8.blogspot.com
Asus Striker II
Intel Core2Quad Q9300 @ 2,5 GHz (aber nur zwei Kerne aktiv aufgrund der Instabilität -.-)
Geforce 9800 GTX
2GB RAM

Vincent

BeitragMo, Jan 10, 2005 18:45
Antworten mit Zitat
Benutzer-Profile anzeigen
mh .. das war bei mir auch eben passiert, nachdem ich die schriftgrösse um ein vielfaches erhöht habe ;/

edit: ah fehler gefunden ... debugte version kommt gleich ... dann gleich mit neuen specials
edit2:
Code: [AUSKLAPPEN]


;initialisierungen -----------
Global Xres = 400 , Yres = 300
Global Zeichengroesse = 26
Global Xsize = 26, Ysize = 19
Dim feld$( Xsize - 1 , Ysize - 1 ) ;spielfeld für kollisionsprüfung erstellen
Global c

;--------------------------
Global Xversch = (Xres / Zeichengroesse / 2) , Yversch = (Yres / Zeichengroesse / 2)

SeedRnd MilliSecs()

;lvlrand erstellen
For b = 1 To Ysize
   For a = 1 To Xsize
      Select b
      Case 1 :   feld$( a-1 , b-1 ) = Mid$("??????????????????????????",a,1)
      Case 2 :   feld$( a-1 , b-1 ) = Mid$("?..|.|...................?",a,1)
      Case 3 :   feld$( a-1 , b-1 ) = Mid$("?..‡.|....•————‡...‡—————?",a,1)
      Case 4 :   feld$( a-1 , b-1 ) = Mid$("?....|....|..............?",a,1)
      Case 5 :   feld$( a-1 , b-1 ) = Mid$("?——‡.|....|..............?",a,1)
      Case 6 :   feld$( a-1 , b-1 ) = Mid$("?....|....•——————————————?",a,1)
      Case 7 :   feld$( a-1 , b-1 ) = Mid$("?....|...................?",a,1)
      Case 8 :   feld$( a-1 , b-1 ) = Mid$("?....•————————•....[——]..?",a,1)
      Case 9 :   feld$( a-1 , b-1 ) = Mid$("?.............|....[«»]..?",a,1)
      Case 10 :   feld$( a-1 , b-1 ) =  Mid$("?——‡.‡——•.....|....[«»]..?",a,1)
      Case 11 :  feld$( a-1 , b-1 ) = Mid$("?»]...[«|.....|....[——]..?",a,1)
      Case 12 :  feld$( a-1 , b-1 ) = Mid$("?»]...[«|.....|..........?",a,1)
      Case 13 :  feld$( a-1 , b-1 ) = Mid$("?»]...[«|.....|..........?",a,1)
      Case 14 :  feld$( a-1 , b-1 ) = Mid$("?»]...[«|.....|....•—————?",a,1)
      Case 15 :  feld$( a-1 , b-1 ) = Mid$("?———————•.....|..........?",a,1)
      Case 16 :  feld$( a-1 , b-1 ) = Mid$("?.............|.......•—.?",a,1)
      Case 17 :  feld$( a-1 , b-1 ) = Mid$("?..•——————————•———•...|..?",a,1)
      Case 18 :  feld$( a-1 , b-1 ) = Mid$("?.....................|..?",a,1)
      Case 19 :  feld$( a-1 , b-1 ) = Mid$("??????????????????????????",a,1)
      End Select
   If feld$( a-1 , b-1 ) ="." Then feld$( a-1 , b-1 )= " "
   Next
Next

game_timer = CreateTimer( 10 )

;grafikinitialisierung
Graphics Xres , Yres , 16 , 2
SetBuffer BackBuffer ()
SetFont LoadFont( "Courier new" , 16)
ClsColor 0,40,0

;sinnfreier startbildschirm
;startbild()
SetFont LoadFont( "Courier new" , Zeichengroesse)
zeichengroesse = zeichengroesse - zeichengroesse / 3
;types
Type Sch  ;schusstype
   Field x
   Field y
   Field dir
   Field typ
End Type
Global schuss.sch

Type effe ; Effekttype
   Field x
   Field y
   Field status
End Type
Global effekt.effe

;ZielPosition erstellen:
Global Ziel_X=23
Global Ziel_Y=4

Type gegn ;gegnertype
   Field x
   Field y
   Field lp ; lebenspunkte
   Field typ$ ;zeichen
   Field sichtweite ; in zeichenfeldern
   Field geschwindigkeit ;zeit von einem schritt zum nächsten in ms
   Field bewegt ; nur vom programm genutzt
End Type
Global gegner.gegn

;spielstarteinstellungen
Global timer
Global PLAYER_dir = 2  ;spielerblickrichtung 0=oben 1=rechts 2=unten 3=links
Global PLAYER_x = 2
Global PLAYER_y = 2
feld$( PLAYER_x , PLAYER_y ) = "M"
Global PLAYER_munition = 200

;gegnererstellung
gegnererstellung(30)

;main
Repeat
   ;Bewegen
   bewegen()
   
   ;Schüsse
   If KeyHit( 57 ) And timer < MilliSecs() And PLAYER_munition > 0 Then
   schiessen()
   EndIf
   ;Gewinnfunktion
   gewinnen()
   ;Zeichnen + KI
   update()
   Flip
   WaitTimer (game_timer) ; auf timer warten ... sinnvollste lösung meiner meinung nach ... wegen der blockbewegung
   Cls
Until KeyHit(1)

End






; funktionen %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

Function startbild()
Cls
Text Xres / 2 , Yres / 2 , "Willkommen zu ASCII-Shooter!" , 1 , 1
Flip : WaitKey : Cls
Text 9 , 1 * (Zeichengroesse + 2 ) , "Vor vielen Jahren gab es kluge Manschen,"
Text 9 , 2 * (Zeichengroesse + 2 ) , "die die Computer erfanden."
Text 9 , 3 * (Zeichengroesse + 2 ) , "Sie entwickelten einen Zeichensatz,"
Text 9 , 4 * (Zeichengroesse + 2 ) , "der sich ASCII nannte."
Text 9 , 5 * (Zeichengroesse + 2 ) , "Nun, viele Jahre später, "
Text 9 , 6 * (Zeichengroesse + 2 ) , "soll dieser ASCII-Zeichensatz"
Text 9 , 7 * (Zeichengroesse + 2 ) , "durch undefinierbare Zeichen"
Text 9 , 8 * (Zeichengroesse + 2 ) , "vernichtet werden."
Text 9 , 9 * (Zeichengroesse + 2 ) , "Nur SIE, ein unschuldiges Zeichen,"
Text 9 , 10 * (Zeichengroesse + 2 ) , "können die Vernichtung noch aufhalten."
Text 9 , 12 * (Zeichengroesse + 2 ) , "Retten sie die Schönheit der ASCII-Codes."
Flip : FlushKeys : WaitKey
End Function

Function gegnererstellung( a ) ;anzahl
For i = 1 To a
   gegner.gegn = New gegn

   gegner\sichtweite = 8
   gegner\geschwindigkeit = 300
   gegner\lp = 1
   gegner\typ$ = Chr(164)
   
   Repeat
      gegner\x = Rand( 0 , Xsize - 1 )
      gegner\y = Rand( 0 , Ysize - 1 )
   Until feld$( gegner\x , gegner\y ) = " " And  Sqr( (gegner\x-PLAYER_x) * (gegner\x-PLAYER_x) + (gegner\y-PLAYER_y) * (gegner\y-PLAYER_y) ) > gegner\sichtweite
   
   feld$(gegner\x , gegner\y ) = gegner\typ$
Next
End Function

Function bewegen()
   If KeyDown( 200 ) And feld$( PLAYER_x , PLAYER_y - 1 ) = " " Then feld$(PLAYER_x,PLAYER_y)=" " : PLAYER_y = Player_y - 1 : PLAYER_dir = 0 : feld$(PLAYER_x,PLAYER_y)="W"
   If KeyDown( 205 ) And feld$( PLAYER_x + 1 , PLAYER_y ) = " " Then feld$(PLAYER_x,PLAYER_y)=" " : PLAYER_x = Player_x + 1 : PLAYER_dir = 1 : feld$(PLAYER_x,PLAYER_y)="E"
   If KeyDown( 208 ) And feld$( PLAYER_x , PLAYER_y + 1 ) = " " Then feld$(PLAYER_x,PLAYER_y)=" " : PLAYER_y = Player_y + 1 : PLAYER_dir = 2 : feld$(PLAYER_x,PLAYER_y)="M"   
   If KeyDown( 203 ) And feld$( PLAYER_x - 1 , PLAYER_y ) = " " Then feld$(PLAYER_x,PLAYER_y)=" " : PLAYER_x = Player_x - 1 : PLAYER_dir = 3 : feld$(PLAYER_x,PLAYER_y)="3"
End Function



Function update()
   ;lvl malen
   For a = 0 To Xsize-1
   For b = 0 To Ysize-1
      Color 200,200,200
   If feld$( a , b ) = Chr(164)  Color 255,0,0
   If feld$( a , b ) = "M" Or feld$( a , b ) = "E" Or feld$( a , b ) = "W" Or feld$( a , b ) = "3" Color 0,255,0
   
      Text (a - PLAYER_x + Xversch) * Zeichengroesse , (b-PLAYER_y + Yversch) * zeichengroesse, feld$( a , b )
   Next
   Next

   ;gegner zeichnen + auf schusstreffer überprüfen
    For gegner=Each gegn
   Color 255,0,0
   
   For schuss=Each sch
      If gegner\x = schuss\x And gegner\y = schuss\y Then gegner\lp = gegner\lp - 1 : Delete schuss : Exit
   Next     

   If gegner\lp > 0
      If Sqr( (gegner\x-PLAYER_x) * (gegner\x-PLAYER_x) + (gegner\y-PLAYER_y) * (gegner\y-PLAYER_y) ) < gegner\sichtweite And gegner\bewegt < MilliSecs()
         feld$(gegner\x , gegner\y ) = " "
      gegner\x = gegner\x - (PLAYER_x + 0 < gegner\x And feld$(gegner\x -1 , gegner\y) = " ") + (PLAYER_x - 0 > gegner\x And feld$(gegner\x +1 , gegner\y) = " ")
         gegner\y = gegner\y - (PLAYER_y + 0 < gegner\y And feld$(gegner\x , gegner\y - 1) = " ") + (PLAYER_y - 0 > gegner\y And feld$(gegner\x , gegner\y + 1) = " ")
         gegner\bewegt = MilliSecs() + gegner\geschwindigkeit
   feld$(gegner\x , gegner\y ) = gegner\typ$
      EndIf
   Else
      neueffekt(gegner\x, gegner\y)
   feld$(gegner\x , gegner\y ) = " "
      Delete gegner
   EndIf
   Next

   ;schüsse auf kollision überprüfen
   For schuss=Each sch
   If feld$( schuss\x , schuss\y ) = " "
      Color 0,255,255
            Text (schuss\x- PLAYER_x + Xversch) * zeichengroesse , (schuss\y- PLAYER_y + Yversch) * zeichengroesse , "*"
      schuss\x = schuss\x - ( schuss\dir = 3 ) + ( schuss\dir = 1 )
      schuss\Y = schuss\y - ( schuss\dir = 0 ) + ( schuss\dir = 2 )
   Else
      Delete schuss
   EndIf
   Next
   Color 255,255,0
   Text (ziel_x- PLAYER_x + Xversch) * zeichengroesse , (ziel_y- PLAYER_y + Yversch) * zeichengroesse ,"!"

   ;Effekte Zeichnen:
   draweffekt
End Function

Function schiessen()
   ;munition abziehen
     PLAYER_munition = PLAYER_munition - 1

    ;neuen schuss erstellen
   schuss.sch = New sch
   schuss\typ = typ ; das hat noch keinen sinn ... also typ = 0

         ;positionieren des schusses neben/über/unter dem spieler je nach blickrichtung
   schuss\x = PLAYER_x - ( PLAYER_dir = 3 ) + ( PLAYER_dir = 1 )
   schuss\Y = PLAYER_y - ( PLAYER_dir = 0 ) + ( PLAYER_dir = 2 )
   schuss\dir = PLAYER_dir
   
   ;zeitspanne bis der nächste schuss erlaubt ist in ms
   timer = MilliSecs() + 300
End Function


Function Gewinnen()
   ;Abfrage der Spieler-Koordinaten
   If Player_X = Ziel_x And Player_Y = Ziel_y
      ;gewinnbildschirm einblenden
      ClsColor 0, 40, 0
      Cls
      Text Xres/2, Yres/2,"Gewonnen!",1,1
      Flip
      FlushKeys
      WaitKey
      End
   EndIf
End Function

Function neueffekt(x, y)
   effekt.effe=New effe
   effekt\x=x
   effekt\y=y
   effekt\status=1
End Function

Function initeffekt()
   For effekt=Each effe
      effekt\status=effekt\status+1
      If effekt\status=5 Then Delete effekt
   Next
End Function

Function draweffekt()
   initeffekt()
   For effekt=Each effe
      Select effekt\status
         Case 1
            Text (effekt\x- PLAYER_x + Xversch)*zeichengroesse, (effekt\y- PLAYER_y + Yversch)*zeichengroesse, "#"
         Case 2
            Text (effekt\x- PLAYER_x + Xversch)*zeichengroesse, (effekt\y- PLAYER_y + Yversch)*zeichengroesse, "*"
         Case 3
            Text (effekt\x- PLAYER_x + Xversch)*zeichengroesse, (effekt\y- PLAYER_y + Yversch)*zeichengroesse, "+"
         Case 4
            Text (effekt\x- PLAYER_x + Xversch)*zeichengroesse, (effekt\y- PLAYER_y + Yversch)*zeichengroesse, "."
      End Select
   Next
End Function


Neuerungen:
Arrow tolles neues Umgebungsdesign
Arrow Scrollmap
Gott ist nicht mit uns ... weil er mit Idioten keine Gnade kennt !

Lumne

BeitragFr, Jan 14, 2005 0:48
Antworten mit Zitat
Benutzer-Profile anzeigen
Nobel! Die neuste Version hat sogar ein Spielprinzip: Lass dich bloß nicht in die Ecke drängen, denn dann kannst du dich nicht mehr in bewegen!
So genial wie simpel.

Ich verneige mich in Ehrfurcht vor den Erschaffern dieses "Spiels".

(Das ist nicht ironisch gemeint, ich bin einfach nur baff, auf was für einen Kram die Leute heutzutage kommen... Schöne neue Welt!)
 

ke^kx

BeitragFr, Jan 14, 2005 14:36
Antworten mit Zitat
Benutzer-Profile anzeigen
Nicht schlecht! Auch das neue Leveldesign ist klasse. Weiter so, jetzt eine Story und mehr Level.

Jiriki

F.S. (Forum Scriptum)
Wie macht man eigentlich die ganzen Ascii-Zeichen (im Code)?
http://i3u8.blogspot.com
Asus Striker II
Intel Core2Quad Q9300 @ 2,5 GHz (aber nur zwei Kerne aktiv aufgrund der Instabilität -.-)
Geforce 9800 GTX
2GB RAM
 

getlose

BeitragFr, Jan 14, 2005 17:03
Antworten mit Zitat
Benutzer-Profile anzeigen
was für eine story soll den bitte zu dem spiel passen ?
und meinst die liest sich auch nur eine sau durch !?

Vincent

BeitragSa, Jan 15, 2005 13:52
Antworten mit Zitat
Benutzer-Profile anzeigen
joar ... so eine absolut sinnlose wie: aliens haben dein schiff gekapert, deine gesammte mannschaft gegessen, und dich eingesperrt ... mit .. eehr ... einer waffe ;/ ...

töte alle aliens ... schiess dich zu ihrem anfüher durch .. denn der is der einzige, der in der lage ist logisch zu denken .. der brainbug sozusagen ... wenn der tot is .. dann is gewonnen
Gott ist nicht mit uns ... weil er mit Idioten keine Gnade kennt !
 

ke^kx

BeitragSa, Jan 15, 2005 17:54
Antworten mit Zitat
Benutzer-Profile anzeigen
Hauptsache mehr und schwerere Level und auch bessere Gegener.

Jiriki
http://i3u8.blogspot.com
Asus Striker II
Intel Core2Quad Q9300 @ 2,5 GHz (aber nur zwei Kerne aktiv aufgrund der Instabilität -.-)
Geforce 9800 GTX
2GB RAM

Vincent

BeitragSo, Jan 16, 2005 14:34
Antworten mit Zitat
Benutzer-Profile anzeigen
hallo !

das ist ein öffentliches projekt ... das heisst, dass ihr selber solche neuen lvl und schwerere gegner programmieren sollt, wenn ihr welche haben wollt !

neue version:
Code: [AUSKLAPPEN]


;initialisierungen -----------
Global Xres = 400 , Yres = 300
Global Zeichengroesse = 26
Global Xsize = 26, Ysize = 19
Global PLAYER_munition = 50

Dim feld$( Xsize - 1 , Ysize - 1 ) ;spielfeld für kollisionsprüfung erstellen
Global c , lvl = 1

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



game_timer = CreateTimer( 10 )

;grafikinitialisierung
Graphics Xres , Yres , 16 , 1

SetFont LoadFont( "Courier new" , 16)
ClsColor 0,40,0

;sinnfreier startbildschirm
startbild() ;<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< AUSKOMMENTIEREN !!!

SetBuffer BackBuffer ()
SetFont LoadFont( "Courier new" , Zeichengroesse)
Global zg = zeichengroesse
zeichengroesse = zeichengroesse - zeichengroesse / 3
Global Xversch = (Xres / Zeichengroesse / 2) , Yversch = (Yres / Zeichengroesse / 2)
;types
Type Sch  ;schusstype
   Field x
   Field y
   Field dir
   Field typ
End Type
Global schuss.sch

Type effe ; Effekttype
   Field x
   Field y
   Field status
End Type
Global effekt.effe

Type gegn ;gegnertype
   Field x
   Field y
   Field lp ; lebenspunkte
   Field typ$ ;zeichen
   Field sichtweite ; in zeichenfeldern
   Field geschwindigkeit ;zeit von einem schritt zum nächsten in ms
   Field bewegt ; nur vom programm genutzt
End Type
Global gegner.gegn

Global timer
Global PLAYER_dir
Global PLAYER_x
Global PLAYER_y
 

loadlvl( lvl )

;main
Repeat
   ;Bewegen
   bewegen()
   
   ;Schüsse
   If KeyHit( 57 ) And timer < MilliSecs() And PLAYER_munition > 0 Then
   schiessen()
   EndIf
   ;Gewinnfunktion
   gewinnen()
   ;Zeichnen + KI
   update()
   Flip
   WaitTimer (game_timer) ; auf timer warten ... sinnvollste lösung meiner meinung nach ... wegen der blockbewegung
   Cls
Until KeyHit(1)

End


; funktionen %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

Function startbild()
Cls
Text Xres / 2 , Yres / 2 , "Willkommen zu ASCII-Shooter!" , 1 , 1
Delay 2000  : Cls
c = 1600
Text 2 , 0 * (14 ) , "Du bist ein toller Alienkiller auf Urlaubsreise !"
Delay c
Text 2 , 2 * (14  ) , "Auf halbem Wege wird ..." 
Delay c
Text 2 , 3 * (14  ) , "dein Raumschiff von Aliens gekapert ..."
Delay c
Text 2 , 4 * (14  ) , "... sie fraßen alle Mitglieder der Besatzung ..."
Delay c
Text 2 , 5 * (14  ) , "... sie fraßen deinen Hamster `Gommels`"
Delay c
Text 2 , 6 * (14  ) , "... aber am schlimmsten ist: ... "
Delay c
Text 2 , 7 * (14  ) , "... sie fraßen deine Kekse von Mutti !!!"
Delay c
Text 2 , 9 * (14  ) , "Dich haben sie mit all deinen Waffen eingesperrt."
Delay c
Text 2 , 10 * (14  ) , "Dummer Fehler...denkst du dir...und brichst aus !"
Delay c
Text 2 , 12 * (14  ) , "Jetzt willst du nur noch eins: "
Delay c * 2
SetFont LoadFont( "Courier new" , 35, 1 , 0 , 1)

c = 0
FlushKeys
While Not GetKey()
Color c,255-c,0
Text Xres/2 , Yres - 80 , "ALIENS PLÄTTEN !!!" , 1 , 0
c = (c + 1) Mod 255
Delay 1
Wend
Cls
End Function

Function gegnererstellung( a ) ;anzahl
If First gegn <> Null
   For gegner.gegn=Each gegn
      Delete gegner
   Next
EndIf


For i = 1 To a
   gegner.gegn = New gegn

   gegner\sichtweite = 8
   gegner\geschwindigkeit = 300
   gegner\lp = 1
   gegner\typ$ = Chr(164)
   
   Repeat
      gegner\x = Rand( 0 , Xsize - 1 )
      gegner\y = Rand( 0 , Ysize - 1 )
   Until feld$( gegner\x , gegner\y ) = " " And  Sqr( (gegner\x-PLAYER_x) * (gegner\x-PLAYER_x) + (gegner\y-PLAYER_y) * (gegner\y-PLAYER_y) ) > gegner\sichtweite
   
   feld$(gegner\x , gegner\y ) = gegner\typ$
Next
End Function

Function bewegen()
   If KeyDown( 200 ) And feld$( PLAYER_x , PLAYER_y - 1 ) = " " Or feld$( PLAYER_x , PLAYER_y - 1 ) = "!" Then feld$(PLAYER_x,PLAYER_y)=" "  : PLAYER_y = Player_y - 1 : gewinnen() : PLAYER_dir = 0 : feld$(PLAYER_x,PLAYER_y)="W"
   If KeyDown( 205 ) And feld$( PLAYER_x + 1 , PLAYER_y ) = " " Or feld$( PLAYER_x + 1, PLAYER_y ) = "!" Then feld$(PLAYER_x,PLAYER_y)=" "  : PLAYER_x = Player_x + 1 : gewinnen() : PLAYER_dir = 1 : feld$(PLAYER_x,PLAYER_y)="E"
   If KeyDown( 208 ) And feld$( PLAYER_x , PLAYER_y + 1 ) = " " Or feld$( PLAYER_x , PLAYER_y + 1 ) = "!" Then feld$(PLAYER_x,PLAYER_y)=" " : PLAYER_y = Player_y + 1 : gewinnen() : PLAYER_dir = 2 : feld$(PLAYER_x,PLAYER_y)="M"   
   If KeyDown( 203 ) And feld$( PLAYER_x - 1 , PLAYER_y ) = " " Or feld$( PLAYER_x - 1 , PLAYER_y ) = "!" Then feld$(PLAYER_x,PLAYER_y)=" " : PLAYER_x = Player_x - 1 : gewinnen() : PLAYER_dir = 3 : feld$(PLAYER_x,PLAYER_y)="3"
End Function



Function update()
   ;lvl malen
   For a = 0 To Xsize-1
   For b = 0 To Ysize-1
      Color 200,200,200
   If feld$( a , b ) = Chr(164)  Color 255,0,0
   If feld$( a , b ) = "M" Or feld$( a , b ) = "E" Or feld$( a , b ) = "W" Or feld$( a , b ) = "3" Color 0,255,0
   If feld$( a , b ) = "!" Color 255,255,0
   Text (a - PLAYER_x + Xversch) * Zeichengroesse , (b-PLAYER_y + Yversch) * zeichengroesse, feld$( a , b )
   Next
   Next
   Color 255,255,0
   Text 1 , Yres - zeichengroesse - 2 , "Muni: "+PLAYER_munition
   ;gegner zeichnen + auf schusstreffer überprüfen
    For gegner=Each gegn
   Color 255,0,0
   
   For schuss=Each sch
      If gegner\x = schuss\x And gegner\y = schuss\y Then gegner\lp = gegner\lp - 1 : Delete schuss : Exit
   Next     

   If gegner\lp > 0
      If Sqr( (gegner\x-PLAYER_x) * (gegner\x-PLAYER_x) + (gegner\y-PLAYER_y) * (gegner\y-PLAYER_y) ) < gegner\sichtweite And gegner\bewegt < MilliSecs()
         feld$(gegner\x , gegner\y ) = " "
      gegner\x = gegner\x - (PLAYER_x + 0 < gegner\x And feld$(gegner\x -1 , gegner\y) = " ") + (PLAYER_x - 0 > gegner\x And feld$(gegner\x +1 , gegner\y) = " ")
         gegner\y = gegner\y - (PLAYER_y + 0 < gegner\y And feld$(gegner\x , gegner\y - 1) = " ") + (PLAYER_y - 0 > gegner\y And feld$(gegner\x , gegner\y + 1) = " ")
         gegner\bewegt = MilliSecs() + gegner\geschwindigkeit
   feld$(gegner\x , gegner\y ) = gegner\typ$
      EndIf
   Else
      neueffekt(gegner\x, gegner\y)
   feld$(gegner\x , gegner\y ) = " "
      Delete gegner
   EndIf
   Next

   ;schüsse auf kollision überprüfen
   For schuss=Each sch
   If feld$( schuss\x , schuss\y ) = " "
      Color 0,255,255
            Text (schuss\x- PLAYER_x + Xversch) * zeichengroesse , (schuss\y- PLAYER_y + Yversch) * zeichengroesse , "*"
      schuss\x = schuss\x - ( schuss\dir = 3 ) + ( schuss\dir = 1 )
      schuss\Y = schuss\y - ( schuss\dir = 0 ) + ( schuss\dir = 2 )
   Else
      Delete schuss
   EndIf
   Next


   ;Effekte Zeichnen:
   draweffekt
End Function

Function schiessen()
   ;munition abziehen
     PLAYER_munition = PLAYER_munition - 1

    ;neuen schuss erstellen
   schuss.sch = New sch
   schuss\typ = typ ; das hat noch keinen sinn ... also typ = 0

         ;positionieren des schusses neben/über/unter dem spieler je nach blickrichtung
   schuss\x = PLAYER_x - ( PLAYER_dir = 3 ) + ( PLAYER_dir = 1 )
   schuss\Y = PLAYER_y - ( PLAYER_dir = 0 ) + ( PLAYER_dir = 2 )
   schuss\dir = PLAYER_dir
   
   ;zeitspanne bis der nächste schuss erlaubt ist in ms
   timer = MilliSecs() + 300
End Function


Function Gewinnen()
   ;Abfrage der Spieler-Koordinaten
   If feld$( PLAYER_x , PLAYER_y ) = "!"
      lvl = lvl + 1
   loadlvl(lvl)
   Cls
   Color 255,0,0
   SetFont LoadFont( "Courier new" , 50,1)
   Text Xres/2 , Yres/2 , "STAGE "+lvl,1,1
   Flip
   Delay 1000
   WaitKey
   SetFont LoadFont( "Courier new" , zg )
   EndIf
End Function

Function neueffekt(x, y)
   effekt.effe=New effe
   effekt\x=x
   effekt\y=y
   effekt\status=1
End Function

Function initeffekt()
   For effekt=Each effe
      effekt\status=effekt\status+1
      If effekt\status=5 Then Delete effekt
   Next
End Function

Function draweffekt()
   initeffekt()
   For effekt=Each effe
      Select effekt\status
         Case 1
            Text (effekt\x- PLAYER_x + Xversch)*zeichengroesse, (effekt\y- PLAYER_y + Yversch)*zeichengroesse, "#"
         Case 2
            Text (effekt\x- PLAYER_x + Xversch)*zeichengroesse, (effekt\y- PLAYER_y + Yversch)*zeichengroesse, "*"
         Case 3
            Text (effekt\x- PLAYER_x + Xversch)*zeichengroesse, (effekt\y- PLAYER_y + Yversch)*zeichengroesse, "+"
         Case 4
            Text (effekt\x- PLAYER_x + Xversch)*zeichengroesse, (effekt\y- PLAYER_y + Yversch)*zeichengroesse, "."
      End Select
   Next
End Function

Function loadlvl( lvl )
Select lvl

Case 1
;-------------------------------------------------------------
   ;lvlrand erstellen
PLAYER_x = 2
PLAYER_y = 2
   For b = 1 To Ysize
   For a = 1 To Xsize
      Select b
      Case 1 :   feld$( a-1 , b-1 ) = Mid$("??????????????????????????",a,1)
      Case 2 :   feld$( a-1 , b-1 ) = Mid$("?..|.|...................?",a,1)
      Case 3 :   feld$( a-1 , b-1 ) = Mid$("?..‡.|....•————‡...‡—————?",a,1)
      Case 4 :   feld$( a-1 , b-1 ) = Mid$("?....|....|..............?",a,1)
      Case 5 :   feld$( a-1 , b-1 ) = Mid$("?——‡.|....|...........!..?",a,1)
      Case 6 :   feld$( a-1 , b-1 ) = Mid$("?....|....•——————————————?",a,1)
      Case 7 :   feld$( a-1 , b-1 ) = Mid$("?....|...................?",a,1)
      Case 8 :   feld$( a-1 , b-1 ) = Mid$("?....•————————•....[——]..?",a,1)
      Case 9 :   feld$( a-1 , b-1 ) = Mid$("?.............|....[«»]..?",a,1)
      Case 10 :   feld$( a-1 , b-1 ) =  Mid$("?——‡.‡——•.....|....[«»]..?",a,1)
      Case 11 :  feld$( a-1 , b-1 ) = Mid$("?»]...[«|.....|....[——]..?",a,1)
      Case 12 :  feld$( a-1 , b-1 ) = Mid$("?»]...[«|.....|..........?",a,1)
      Case 13 :  feld$( a-1 , b-1 ) = Mid$("?»]...[«|.....|..........?",a,1)
      Case 14 :  feld$( a-1 , b-1 ) = Mid$("?»]...[«|.....|....•—————?",a,1)
      Case 15 :  feld$( a-1 , b-1 ) = Mid$("?———————•.....|..........?",a,1)
      Case 16 :  feld$( a-1 , b-1 ) = Mid$("?.............|.......•—.?",a,1)
      Case 17 :  feld$( a-1 , b-1 ) = Mid$("?..•——————————•———•...|..?",a,1)
      Case 18 :  feld$( a-1 , b-1 ) = Mid$("?.....................|..?",a,1)
      Case 19 :  feld$( a-1 , b-1 ) = Mid$("??????????????????????????",a,1)
      End Select
   If feld$( a-1 , b-1 ) ="." Then feld$( a-1 , b-1 )= " "
   Next
   Next
SeedRnd 2
gegnererstellung( 30 )
PLAYER_dir = 2
feld$( PLAYER_x , PLAYER_y ) = "M"
;-------------------------------------------------------------
Case 2
;-------------------------------------------------------------
   ;lvlrand erstellen
PLAYER_x = 2
PLAYER_y = 2
   For b = 1 To Ysize
   For a = 1 To Xsize
      Select b
      Case 1 :   feld$( a-1 , b-1 ) = Mid$("?????&&&&&&&&&&&&&&&&&&&&&",a,1)
      Case 2 :   feld$( a-1 , b-1 ) = Mid$("?...?&&&&&&&&&&&&&&&&&&&&&",a,1)
      Case 3 :   feld$( a-1 , b-1 ) = Mid$("?...?&&&&&&&&&&&&&&&&&&&&&",a,1)
      Case 4 :   feld$( a-1 , b-1 ) = Mid$("?-•.?&&&&&&&&&&&&&&&&&&&&&",a,1)
      Case 5 :   feld$( a-1 , b-1 ) = Mid$("?...?&&&&&&&&&&&&&&&&&&&&&",a,1)
      Case 6 :   feld$( a-1 , b-1 ) = Mid$("?...?&&&&&&&&&&&&&&&&&&&&&",a,1)
      Case 7 :   feld$( a-1 , b-1 ) = Mid$("?...?&&&&&&&&&&&&&&&&&&&&&",a,1)
      Case 8 :   feld$( a-1 , b-1 ) = Mid$("?...??????????????????????",a,1)
      Case 9 :   feld$( a-1 , b-1 ) = Mid$("?........................?",a,1)
      Case 10 :   feld$( a-1 , b-1 ) =  Mid$("?--•-----•.•-•-------•...?",a,1)
      Case 11 :  feld$( a-1 , b-1 ) = Mid$("?!.|.....|...|...........?",a,1)
      Case 12 :  feld$( a-1 , b-1 ) = Mid$("?..|.....•---•-•.?????????",a,1)
      Case 13 :  feld$( a-1 , b-1 ) = Mid$("?..|...........|.?&&&&&&&&",a,1)
      Case 14 :  feld$( a-1 , b-1 ) = Mid$("?..‡..????????.|.?&&&&&&&&",a,1)
      Case 15 :  feld$( a-1 , b-1 ) = Mid$("?.....?&&&&&&?.|.?&&&&&&&&",a,1)
      Case 16 :  feld$( a-1 , b-1 ) = Mid$("?..‡..?&&&&&&?.|.?????????",a,1)
      Case 17 :  feld$( a-1 , b-1 ) = Mid$("?..|..?&&&&&&?.•......[««?",a,1)
      Case 18 :  feld$( a-1 , b-1 ) = Mid$("?..|..?&&&&&&?........[««?",a,1)
      Case 19 :  feld$( a-1 , b-1 ) = Mid$("???????&&&&&&?????????????",a,1)
      End Select
   If feld$( a-1 , b-1 ) ="." Then feld$( a-1 , b-1 )= " "
   Next
   Next
SeedRnd 3
gegnererstellung( 20 )
   For b = 1 To Ysize
   For a = 1 To Xsize
   If feld$( a-1 , b-1 ) ="&" Then feld$( a-1 , b-1 )= " "
   Next
   Next
PLAYER_dir = 2
feld$( PLAYER_x , PLAYER_y ) = "M"
;-------------------------------------------------------------
Case 3
;-------------------------------------------------------------
   ;lvlrand erstellen
PLAYER_x = 2
PLAYER_y = 2
   For b = 1 To Ysize
   For a = 1 To Xsize
      Select b
      Case 1 :   feld$( a-1 , b-1 ) = Mid$("?????????&&&???????????&&&",a,1)
      Case 2 :   feld$( a-1 , b-1 ) = Mid$("?.......?????..‡......?&&&",a,1)
      Case 3 :   feld$( a-1 , b-1 ) = Mid$("?...................•.?&&&",a,1)
      Case 4 :   feld$( a-1 , b-1 ) = Mid$("?.......?????..‡....|.????",a,1)
      Case 5 :   feld$( a-1 , b-1 ) = Mid$("?????????&&&?????????..[«?",a,1)
      Case 6 :   feld$( a-1 , b-1 ) = Mid$("&&&&&&&&&&&&&&&&&&&&?..[«?",a,1)
      Case 7 :   feld$( a-1 , b-1 ) = Mid$("&&&&&&&&&&&&&&&&&&&&?..[«?",a,1)
      Case 8 :   feld$( a-1 , b-1 ) = Mid$("&&&&&&&&&&&&&&&&&&&&?..[«?",a,1)
      Case 9 :   feld$( a-1 , b-1 ) = Mid$("&&&&&&&&&&&&&&&&&&&&?..[«?",a,1)
      Case 10 :   feld$( a-1 , b-1 ) =  Mid$("???????&&&&&&&&&&&&&?..[«?",a,1)
      Case 11 :  feld$( a-1 , b-1 ) = Mid$("?..|..?&&&&&&&&&&&&&?..[«?",a,1)
      Case 12 :  feld$( a-1 , b-1 ) = Mid$("?..‡..?&&&&&&&&&&&&&?..[«?",a,1)
      Case 13 :  feld$( a-1 , b-1 ) = Mid$("?.....??????&&&&&&&&?..[«?",a,1)
      Case 14 :  feld$( a-1 , b-1 ) = Mid$("?..‡.......??????????..[«?",a,1)
      Case 15 :  feld$( a-1 , b-1 ) = Mid$("?..???????.|...........[_?",a,1)
      Case 16 :  feld$( a-1 , b-1 ) = Mid$("?..?&&&&&?.|..???????....?",a,1)
      Case 17 :  feld$( a-1 , b-1 ) = Mid$("?..?&&&&&?.•..?&&&&&?....?",a,1)
      Case 18 :  feld$( a-1 , b-1 ) = Mid$("?!.?&&&&&?....?&&&&&?....?",a,1)
      Case 19 :  feld$( a-1 , b-1 ) = Mid$("????&&&&&??????&&&&&??????",a,1)
      End Select
   If feld$( a-1 , b-1 ) ="." Then feld$( a-1 , b-1 )= " "
   Next
   Next
SeedRnd 1
gegnererstellung( 20 )
   For b = 1 To Ysize
   For a = 1 To Xsize
   If feld$( a-1 , b-1 ) ="&" Then feld$( a-1 , b-1 )= " "
   Next
   Next
PLAYER_dir = 1
feld$( PLAYER_x , PLAYER_y ) = "E"
;-------------------------------------------------------------



;--------------------------------------------------------------
Default
   ;gewinnbildschirm einblenden
   Cls
   Color 255,0,0
   SetFont LoadFont( "Courier new" , 50,1)
   Text Xres/2 , Yres/2 , "GEWONNEN",1,1
   SetFont LoadFont( "Courier new" , 16)
   Color 255,255,255
   Text Xres/2 , Yres/2 + 40 , "Die Story endet sinnloserweise hier !",1,1
      Flip
      FlushKeys
      WaitKey
      End


End Select
End Function


Neuerungen:

Arrow 2 neue lvl
Arrow neues intro
Arrow begrenzte munition

P.S. es gibt ein neues spielprinzip: man muss alle 3 lvl schaffen, und dabei mit 50 schuss munition auskommen ( ich hab es mit einem schuss über geschafft), indem man die gegner einfach umläuft, und sich nicht von ihnen einschliessen lässt !!
Gott ist nicht mit uns ... weil er mit Idioten keine Gnade kennt !
 

Sebe

BeitragSa, Jan 22, 2005 2:37
Antworten mit Zitat
Benutzer-Profile anzeigen
Mal sehen ob sich das nicht nach BMX portieren lässt. Wenn ich mal Zeit hab... Very Happy
Dann wäre sogar ein Maploader drin. Aber respekt für das Projekt Wink Das ist ja schon fast 0ldsk00l 8) Wolfenstein und Nethack in einem, echt geil!

Kabelbinder

Sieger des WM-Contest 2006

BeitragDi, Jan 25, 2005 15:25
Antworten mit Zitat
Benutzer-Profile anzeigen
Und was wird jetzt aus dem KI Wettbewerb?
<Wing Avenger Download> ◊◊◊ <Macrophage Download>

Vincent

BeitragDi, Jan 25, 2005 17:42
Antworten mit Zitat
Benutzer-Profile anzeigen
... es gab hie nie einen KI wettbewerb .. aber man könnte einen machen !

dieser shooter war eigentlich als offenes forum-projekt gedacht ... am ende haben wammer und ich jedoch alles alleine gamacht ;-/

jetzt, da der grundstein gelegt ist könnt ihr z.B. einen lvl generator oder ne anständige KI basteln
Gott ist nicht mit uns ... weil er mit Idioten keine Gnade kennt !
 

feider

ehemals "Decelion"

BeitragSo, Apr 29, 2007 18:52
Antworten mit Zitat
Benutzer-Profile anzeigen
Es ist Zeit, diesen Thread wieder hervorzuholen... schliesslich ist unser armer Held immer noch Gefangener von Aliens!

Code: [AUSKLAPPEN]

;initialisierungen -----------
Global Xres = 400 , Yres = 300
Global Zeichengroesse = 26
Global Xsize = 26, Ysize = 19
Global PLAYER_munition = 40

Dim feld$( Xsize - 1 , Ysize - 1 ) ;spielfeld für kollisionsprüfung erstellen
Global c , lvl = 1

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



game_timer = CreateTimer( 10 )

;grafikinitialisierung
Graphics Xres , Yres , 16 , 1

SetFont LoadFont( "Courier new" , 16)
ClsColor 0,40,0

;sinnfreier startbildschirm
startbild() ;<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< AUSKOMMENTIEREN !!!

SetBuffer BackBuffer ()
SetFont LoadFont( "Courier new" , Zeichengroesse)
Global zg = zeichengroesse
zeichengroesse = zeichengroesse - zeichengroesse / 3
Global Xversch = (Xres / Zeichengroesse / 2) , Yversch = (Yres / Zeichengroesse / 2)
;types
Type Sch  ;schusstype
   Field x
   Field y
   Field dir
   Field typ
End Type
Global schuss.sch

Type effe ; Effekttype
   Field x
   Field y
   Field status
End Type
Global effekt.effe

Type gegn ;gegnertype
   Field x
   Field y
   Field lp ; lebenspunkte
   Field typ$ ;zeichen
   Field sichtweite ; in zeichenfeldern
   Field geschwindigkeit ;zeit von einem schritt zum nächsten in ms
   Field bewegt ; nur vom programm genutzt
End Type
Global gegner.gegn

Global timer
Global PLAYER_dir
Global PLAYER_x
Global PLAYER_y
 

loadlvl( lvl )

;main
Repeat
   ;Bewegen
   bewegen()
   
   ;Schüsse
   If KeyHit( 57 ) And timer < MilliSecs() And PLAYER_munition > 0 Then
   schiessen()
   EndIf
   ;Gewinnfunktion
   gewinnen()
   ;Zeichnen + KI
   update()
   Flip
   WaitTimer (game_timer) ; auf timer warten ... sinnvollste lösung meiner meinung nach ... wegen der blockbewegung
   Cls
Until KeyHit(1)

End


; funktionen %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

Function startbild()
Cls
Text Xres / 2 , Yres / 2 , "Willkommen zu ASCII-Shooter!" , 1 , 1
Delay 2000  : Cls
c = 1600
Text 2 , 0 * (14 ) , "Du bist ein toller Alienkiller auf Urlaubsreise !"
Delay c
Text 2 , 2 * (14  ) , "Auf halbem Wege wird ..."
Delay c
Text 2 , 3 * (14  ) , "dein Raumschiff von Aliens gekapert ..."
Delay c
Text 2 , 4 * (14  ) , "... sie fraßen alle Mitglieder der Besatzung ..."
Delay c
Text 2 , 5 * (14  ) , "... sie fraßen deinen Hamster `Gommels`"
Delay c
Text 2 , 6 * (14  ) , "... aber am schlimmsten ist: ... "
Delay c
Text 2 , 7 * (14  ) , "... sie fraßen deine Kekse von Mutti !!!"
Delay c
Text 2 , 9 * (14  ) , "Dich haben sie mit all deinen Waffen eingesperrt."
Delay c
Text 2 , 10 * (14  ) , "Dummer Fehler...denkst du dir...und brichst aus !"
Delay c
Text 2 , 12 * (14  ) , "Jetzt willst du nur noch eins: "
Delay c * 2
SetFont LoadFont( "Courier new" , 35, 1 , 0 , 1)

c = 0
FlushKeys
While Not GetKey()
Color c,255-c,0
Text Xres/2 , Yres - 80 , "ALIENS PLÄTTEN !!!" , 1 , 0
c = (c + 1) Mod 255
Delay 1
Wend
Cls
End Function

Function gegnererstellung( a ) ;anzahl
If First gegn <> Null
   For gegner.gegn=Each gegn
      Delete gegner
   Next
EndIf


For i = 1 To a
   gegner.gegn = New gegn

   gegner\sichtweite = 8
   gegner\geschwindigkeit = 300
   gegner\lp = 1
   gegner\typ$ = Chr(164)
   
   Repeat
      gegner\x = Rand( 0 , Xsize - 1 )
      gegner\y = Rand( 0 , Ysize - 1 )
   Until feld$( gegner\x , gegner\y ) = " " And  Sqr( (gegner\x-PLAYER_x) * (gegner\x-PLAYER_x) + (gegner\y-PLAYER_y) * (gegner\y-PLAYER_y) ) > gegner\sichtweite
   
   feld$(gegner\x , gegner\y ) = gegner\typ$
Next
End Function

Function bewegen()
   If KeyDown( 200 ) And feld$( PLAYER_x , PLAYER_y - 1 ) = " " Or feld$( PLAYER_x , PLAYER_y - 1 ) = "!" Or feld$( PLAYER_x , PLAYER_y) = "*"Then feld$(PLAYER_x,PLAYER_y)=" "  : PLAYER_y = Player_y - 1 : gewinnen() : PLAYER_dir = 0 : feld$(PLAYER_x,PLAYER_y)="W"
   If KeyDown( 205 ) And feld$( PLAYER_x + 1 , PLAYER_y ) = " " Or feld$( PLAYER_x + 1, PLAYER_y ) = "!" Or feld$( PLAYER_x+1 , PLAYER_y) = "*" Then feld$(PLAYER_x,PLAYER_y)=" "  : PLAYER_x = Player_x + 1 : gewinnen() : PLAYER_dir = 1 : feld$(PLAYER_x,PLAYER_y)="E"
   If KeyDown( 208 ) And feld$( PLAYER_x , PLAYER_y + 1 ) = " " Or feld$( PLAYER_x , PLAYER_y + 1 ) = "!" Or feld$( PLAYER_x , PLAYER_y + 1) = "*" Then feld$(PLAYER_x,PLAYER_y)=" " : PLAYER_y = Player_y + 1 : gewinnen() : PLAYER_dir = 2 : feld$(PLAYER_x,PLAYER_y)="M"   
   If KeyDown( 203 ) And feld$( PLAYER_x - 1 , PLAYER_y ) = " " Or feld$( PLAYER_x - 1 , PLAYER_y ) = "!" Or feld$( PLAYER_x-1 , PLAYER_y) = "*" Then feld$(PLAYER_x,PLAYER_y)=" " : PLAYER_x = Player_x - 1 : gewinnen() : PLAYER_dir = 3 : feld$(PLAYER_x,PLAYER_y)="3"
End Function



Function update()
   ;lvl malen
   For a = 0 To Xsize-1
   For b = 0 To Ysize-1
      Color 200,200,200
   If feld$( a , b ) = Chr(164)  Color 255,0,0
   If feld$( a , b ) = "M" Or feld$( a , b ) = "E" Or feld$( a , b ) = "W" Or feld$( a , b ) = "3" Color 0,255,0
   If feld$( a , b ) = "!" Color 255,255,0
   Text (a - PLAYER_x + Xversch) * Zeichengroesse , (b-PLAYER_y + Yversch) * zeichengroesse, feld$( a , b )
   Next
   Next
   Color 255,255,0
   Text 1 , Yres - zeichengroesse - 2 , "Muni: "+PLAYER_munition
   ;gegner zeichnen + auf schusstreffer überprüfen
    For gegner=Each gegn
   Color 255,0,0
   
   For schuss=Each sch
      If gegner\x = schuss\x And gegner\y = schuss\y Then gegner\lp = gegner\lp - 1 : Delete schuss : Exit
   Next     

   If gegner\lp > 0
      If Sqr( (gegner\x-PLAYER_x) * (gegner\x-PLAYER_x) + (gegner\y-PLAYER_y) * (gegner\y-PLAYER_y) ) < gegner\sichtweite And gegner\bewegt < MilliSecs()
         feld$(gegner\x , gegner\y ) = " "
      gegner\x = gegner\x - (PLAYER_x + 0 < gegner\x And feld$(gegner\x -1 , gegner\y) = " ") + (PLAYER_x - 0 > gegner\x And feld$(gegner\x +1 , gegner\y) = " ")
         gegner\y = gegner\y - (PLAYER_y + 0 < gegner\y And feld$(gegner\x , gegner\y - 1) = " ") + (PLAYER_y - 0 > gegner\y And feld$(gegner\x , gegner\y + 1) = " ")
         gegner\bewegt = MilliSecs() + gegner\geschwindigkeit
   feld$(gegner\x , gegner\y ) = gegner\typ$
      EndIf
   Else
      neueffekt(gegner\x, gegner\y)
   feld$(gegner\x , gegner\y ) = " "
      Delete gegner
   EndIf
   Next

   ;schüsse auf kollision überprüfen
   For schuss=Each sch
   If feld$( schuss\x , schuss\y ) = " "
      Color 0,255,255
            Text (schuss\x- PLAYER_x + Xversch) * zeichengroesse , (schuss\y- PLAYER_y + Yversch) * zeichengroesse , "*"
      schuss\x = schuss\x - ( schuss\dir = 3 ) + ( schuss\dir = 1 )
      schuss\Y = schuss\y - ( schuss\dir = 0 ) + ( schuss\dir = 2 )
   Else
      Delete schuss
   EndIf
   Next


   ;Effekte Zeichnen:
   draweffekt
End Function

Function ammo()
   ;Abfrage der Spieler-Koordinaten
   If feld$( PLAYER_x , PLAYER_y ) = "*"
      PLAYER_munition = PLAYER_munition + 10
   EndIf

End Function

Function schiessen()
   ;munition abziehen
     PLAYER_munition = PLAYER_munition - 1

    ;neuen schuss erstellen
   schuss.sch = New sch
   schuss\typ = typ ; das hat noch keinen sinn ... also typ = 0

         ;positionieren des schusses neben/über/unter dem spieler je nach blickrichtung
   schuss\x = PLAYER_x - ( PLAYER_dir = 3 ) + ( PLAYER_dir = 1 )
   schuss\Y = PLAYER_y - ( PLAYER_dir = 0 ) + ( PLAYER_dir = 2 )
   schuss\dir = PLAYER_dir
   
   ;zeitspanne bis der nächste schuss erlaubt ist in ms
   timer = MilliSecs() + 300
End Function


Function Gewinnen()
   ;Abfrage der Spieler-Koordinaten
   If feld$( PLAYER_x , PLAYER_y ) = "!"
      lvl = lvl + 1
   loadlvl(lvl)
   Cls
   Color 255,0,0
   SetFont LoadFont( "Courier new" , 50,1)
   Text Xres/2 , Yres/2 , "STAGE "+lvl,1,1
   Flip
   Delay 1000
   WaitKey
   SetFont LoadFont( "Courier new" , zg )
   EndIf
End Function

Function neueffekt(x, y)
   effekt.effe=New effe
   effekt\x=x
   effekt\y=y
   effekt\status=1
End Function

Function initeffekt()
   For effekt=Each effe
      effekt\status=effekt\status+1
      If effekt\status=5 Then Delete effekt
   Next
End Function

Function draweffekt()
   initeffekt()
   For effekt=Each effe
      Select effekt\status
         Case 1
            Text (effekt\x- PLAYER_x + Xversch)*zeichengroesse, (effekt\y- PLAYER_y + Yversch)*zeichengroesse, "#"
         Case 2
            Text (effekt\x- PLAYER_x + Xversch)*zeichengroesse, (effekt\y- PLAYER_y + Yversch)*zeichengroesse, "*"
         Case 3
            Text (effekt\x- PLAYER_x + Xversch)*zeichengroesse, (effekt\y- PLAYER_y + Yversch)*zeichengroesse, "+"
         Case 4
            Text (effekt\x- PLAYER_x + Xversch)*zeichengroesse, (effekt\y- PLAYER_y + Yversch)*zeichengroesse, "."
      End Select
   Next
End Function

Function loadlvl( lvl )
Select lvl

Case 1
;-------------------------------------------------------------
   ;lvlrand erstellen
PLAYER_x = 2
PLAYER_y = 2
   For b = 1 To Ysize
   For a = 1 To Xsize
      Select b
      Case 1 :   feld$( a-1 , b-1 ) = Mid$("??????????????????????????",a,1)
      Case 2 :   feld$( a-1 , b-1 ) = Mid$("?..|.|...................?",a,1)
      Case 3 :   feld$( a-1 , b-1 ) = Mid$("?..‡.|....•————‡...‡—————?",a,1)
      Case 4 :   feld$( a-1 , b-1 ) = Mid$("?....|....|..............?",a,1)
      Case 5 :   feld$( a-1 , b-1 ) = Mid$("?——‡.|....|...........!..?",a,1)
      Case 6 :   feld$( a-1 , b-1 ) = Mid$("?....|....•——————————————?",a,1)
      Case 7 :   feld$( a-1 , b-1 ) = Mid$("?....|...................?",a,1)
      Case 8 :   feld$( a-1 , b-1 ) = Mid$("?....•————————•....[——]..?",a,1)
      Case 9 :   feld$( a-1 , b-1 ) = Mid$("?.............|....[«»]..?",a,1)
      Case 10 :   feld$( a-1 , b-1 ) =  Mid$("?——‡.‡——•.....|....[«»]..?",a,1)
      Case 11 :  feld$( a-1 , b-1 ) = Mid$("?»]...[«|.....|....[——]..?",a,1)
      Case 12 :  feld$( a-1 , b-1 ) = Mid$("?»]...[«|.....|..........?",a,1)
      Case 13 :  feld$( a-1 , b-1 ) = Mid$("?»]...[«|.....|..........?",a,1)
      Case 14 :  feld$( a-1 , b-1 ) = Mid$("?»]...[«|.....|....•—————?",a,1)
      Case 15 :  feld$( a-1 , b-1 ) = Mid$("?———————•.....|..........?",a,1)
      Case 16 :  feld$( a-1 , b-1 ) = Mid$("?.............|.......•—.?",a,1)
      Case 17 :  feld$( a-1 , b-1 ) = Mid$("?..•——————————•———•...|*.?",a,1)
      Case 18 :  feld$( a-1 , b-1 ) = Mid$("?.....................|..?",a,1)
      Case 19 :  feld$( a-1 , b-1 ) = Mid$("??????????????????????????",a,1)
      End Select
   If feld$( a-1 , b-1 ) ="." Then feld$( a-1 , b-1 )= " "
   Next
   Next
SeedRnd 2
gegnererstellung( 30 )
PLAYER_dir = 2
feld$( PLAYER_x , PLAYER_y ) = "M"
;-------------------------------------------------------------
Case 2
;-------------------------------------------------------------
   ;lvlrand erstellen
PLAYER_x = 2
PLAYER_y = 2
   For b = 1 To Ysize
   For a = 1 To Xsize
      Select b
      Case 1 :   feld$( a-1 , b-1 ) = Mid$("?????&&&&&&&&&&&&&&&&&&&&&",a,1)
      Case 2 :   feld$( a-1 , b-1 ) = Mid$("?...?&&&&&&&&&&&&&&&&&&&&&",a,1)
      Case 3 :   feld$( a-1 , b-1 ) = Mid$("?...?&&&&&&&&&&&&&&&&&&&&&",a,1)
      Case 4 :   feld$( a-1 , b-1 ) = Mid$("?-•.?&&&&&&&&&&&&&&&&&&&&&",a,1)
      Case 5 :   feld$( a-1 , b-1 ) = Mid$("?...?&&&&&&&&&&&&&&&&&&&&&",a,1)
      Case 6 :   feld$( a-1 , b-1 ) = Mid$("?...?&&&&&&&&&&&&&&&&&&&&&",a,1)
      Case 7 :   feld$( a-1 , b-1 ) = Mid$("?...?&&&&&&&&&&&&&&&&&&&&&",a,1)
      Case 8 :   feld$( a-1 , b-1 ) = Mid$("?...??????????????????????",a,1)
      Case 9 :   feld$( a-1 , b-1 ) = Mid$("?........................?",a,1)
      Case 10 :   feld$( a-1 , b-1 ) =  Mid$("?--•-----•.•-•-------•...?",a,1)
      Case 11 :  feld$( a-1 , b-1 ) = Mid$("?!.|.....|...|...........?",a,1)
      Case 12 :  feld$( a-1 , b-1 ) = Mid$("?..|.....•---•-•.?????????",a,1)
      Case 13 :  feld$( a-1 , b-1 ) = Mid$("?..|...........|.?&&&&&&&&",a,1)
      Case 14 :  feld$( a-1 , b-1 ) = Mid$("?..‡..????????.|.?&&&&&&&&",a,1)
      Case 15 :  feld$( a-1 , b-1 ) = Mid$("?.....?&&&&&&?.|.?&&&&&&&&",a,1)
      Case 16 :  feld$( a-1 , b-1 ) = Mid$("?..‡..?&&&&&&?.|.?????????",a,1)
      Case 17 :  feld$( a-1 , b-1 ) = Mid$("?..|..?&&&&&&?.•......[««?",a,1)
      Case 18 :  feld$( a-1 , b-1 ) = Mid$("?..|..?&&&&&&?.......*[««?",a,1)
      Case 19 :  feld$( a-1 , b-1 ) = Mid$("???????&&&&&&?????????????",a,1)
      End Select
   If feld$( a-1 , b-1 ) ="." Then feld$( a-1 , b-1 )= " "
   Next
   Next
SeedRnd 3
gegnererstellung( 20 )
   For b = 1 To Ysize
   For a = 1 To Xsize
   If feld$( a-1 , b-1 ) ="&" Then feld$( a-1 , b-1 )= " "
   Next
   Next
PLAYER_dir = 2
feld$( PLAYER_x , PLAYER_y ) = "M"
;-------------------------------------------------------------
Case 3
;-------------------------------------------------------------
   ;lvlrand erstellen
PLAYER_x = 2
PLAYER_y = 2
   For b = 1 To Ysize
   For a = 1 To Xsize
      Select b
      Case 1 :   feld$( a-1 , b-1 ) = Mid$("?????????&&&???????????&&&",a,1)
      Case 2 :   feld$( a-1 , b-1 ) = Mid$("?*......?????..‡......?&&&",a,1)
      Case 3 :   feld$( a-1 , b-1 ) = Mid$("?...................•.?&&&",a,1)
      Case 4 :   feld$( a-1 , b-1 ) = Mid$("?.......?????..‡....|.????",a,1)
      Case 5 :   feld$( a-1 , b-1 ) = Mid$("?????????&&&?????????..[«?",a,1)
      Case 6 :   feld$( a-1 , b-1 ) = Mid$("&&&&&&&&&&&&&&&&&&&&?..[«?",a,1)
      Case 7 :   feld$( a-1 , b-1 ) = Mid$("&&&&&&&&&&&&&&&&&&&&?..[«?",a,1)
      Case 8 :   feld$( a-1 , b-1 ) = Mid$("&&&&&&&&&&&&&&&&&&&&?..[«?",a,1)
      Case 9 :   feld$( a-1 , b-1 ) = Mid$("&&&&&&&&&&&&&&&&&&&&?..[«?",a,1)
      Case 10 :   feld$( a-1 , b-1 ) =  Mid$("???????&&&&&&&&&&&&&?..[«?",a,1)
      Case 11 :  feld$( a-1 , b-1 ) = Mid$("?..|..?&&&&&&&&&&&&&?..[«?",a,1)
      Case 12 :  feld$( a-1 , b-1 ) = Mid$("?..‡..?&&&&&&&&&&&&&?..[«?",a,1)
      Case 13 :  feld$( a-1 , b-1 ) = Mid$("?.....??????&&&&&&&&?..[«?",a,1)
      Case 14 :  feld$( a-1 , b-1 ) = Mid$("?..‡.......??????????..[«?",a,1)
      Case 15 :  feld$( a-1 , b-1 ) = Mid$("?..???????.|...........[_?",a,1)
      Case 16 :  feld$( a-1 , b-1 ) = Mid$("?..?&&&&&?.|..???????....?",a,1)
      Case 17 :  feld$( a-1 , b-1 ) = Mid$("?..?&&&&&?.•..?&&&&&?..*.?",a,1)
      Case 18 :  feld$( a-1 , b-1 ) = Mid$("?!.?&&&&&?....?&&&&&?....?",a,1)
      Case 19 :  feld$( a-1 , b-1 ) = Mid$("????&&&&&??????&&&&&??????",a,1)
      End Select
   If feld$( a-1 , b-1 ) ="." Then feld$( a-1 , b-1 )= " "
   Next
   Next
SeedRnd 1
gegnererstellung( 20 )
   For b = 1 To Ysize
   For a = 1 To Xsize
   If feld$( a-1 , b-1 ) ="&" Then feld$( a-1 , b-1 )= " "
   Next
   Next
PLAYER_dir = 1
feld$( PLAYER_x , PLAYER_y ) = "E"
;-------------------------------------------------------------



;--------------------------------------------------------------
Default
   ;gewinnbildschirm einblenden
   Cls
   Color 255,0,0
   SetFont LoadFont( "Courier new" , 50,1)
   Text Xres/2 , Yres/2 , "GEWONNEN",1,1
   SetFont LoadFont( "Courier new" , 16)
   Color 255,255,255
   Text Xres/2 , Yres/2 + 40 , "Die Story endet sinnloserweise hier !",1,1
      Flip
      FlushKeys
      WaitKey
      End


End Select
End Function
 


Arrow Munitionskisten hinzugefügt
Die Ammo ist trotzdem knapp!

cu
Decelion

Gehe zu Seite Zurück  1, 2

Neue Antwort erstellen


Übersicht Sonstiges Projekte

Gehe zu:

Powered by phpBB © 2001 - 2006, phpBB Group