PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

Hab ErstelleSpiel-Procedure gecodet! *grins* in 5 min. :-)

https://www.purebasic.fr/german/viewtopic.php?t=1567

Seite 1 von 1

Hab ErstelleSpiel-Procedure gecodet! *grins* in 5 min. :-)

Verfasst: 09.01.2005 01:35
von AndyX
:D Mir is mal wieder fad und ich hab mir gedacht, ich muss mal wieder nen blödsinn posten... <) Einfach mal durchlesen.
Aber bitte nicht ernst nehmen. :lol:

Code: Alles auswählen

Procedure ErstelleSpiel (meineIdeen$)
 
 text$ = "Deine Vorstellungen waren: "
 title$ = "ErstelleSpiel"
 spiel$ = "So! Da hast du dein blödes Spiel! Und jetzt SPIEL ES zum Teufel nochmal!!! :-)"
 datei$ = OpenFileRequester("In welcher Datei speichern?","","PB Code|*.pb",0)
 If CreateFile(0,datei$)
  writestringn("meineIdeen$ = "+chr(34)+meineIdeen$+chr(34))
  writestringn("text$ = "+chr(34)+text$+chr(34))
  writestringn("title$ = "+chr(34)+title$+chr(34))
  writestringn("spiel$ = "+chr(34)+spiel$+chr(34))
  WriteStringN("MessageRequester(title$,text$+meineIdeen$,0)")
  WriteStringN("MessageRequester(title$,spiel$,0)")
 Else
  End
 Endif
 CloseFile(0)

EndProcedure



; kleines Prog dazu ;-)

MessageRequester("AndyX´s GameMaker","Das ist der GameMaker von AndyX!",0)
Ideen$ = InputRequester("Ideen","GameMaker braucht deine Spielideen! Gib sie ein!","Sooo viele Ideen...")
ErstelleSpiel(Ideen$)
Mfg,
AndyX

Verfasst: 09.01.2005 01:51
von Laurin
Naja, nett gemeint, aber... zu billig.

Verfasst: 09.01.2005 01:55
von AndyX
:lol: Diese Procedure war doch nurn witz. /:->

Mfg,
AndyX

Verfasst: 09.01.2005 01:57
von Laurin
Ja, sicher, aber so lustig finde ich das nicht.

Verfasst: 09.01.2005 02:05
von Deeem2031
So geht das ;)

Code: Alles auswählen

Procedure ErstelleSpiel(beschreibung.s)
  InitSprite()
  InitKeyboard()
  OpenScreen(1024,768,32,beschreibung)
  Text.s = "Loading..."
  Repeat
    For i = 1 To Len(Text)
      ClearScreen(0,0,0)
      StartDrawing(ScreenOutput())
      FrontColor(0,0,200)
      Locate(512-TextLength(Text)/2,384-10)
      DrawingMode(1)
      DrawText(Left(Text,i-1))
      FrontColor(0,0,255)
      DrawText(Mid(Text,i,1))
      FrontColor(0,0,200)
      DrawText(Right(Text,Len(Text)-i))
      StopDrawing()
      FlipBuffers()
      Delay(200)
      ExamineKeyboard()
      If KeyboardPushed(#PB_Key_Escape):End:EndIf
    Next
  ForEver
EndProcedure

ErstelleSpiel("Das ultimative Spiel")

Verfasst: 09.01.2005 09:57
von DarkDragon
:mrgreen: :lol: :lol: :lol: :lol: :lol: :lol: :lol: :lol: :mrgreen:

Code: Alles auswählen

Procedure BilligesNetzwerkSpiel()
InitNetwork()

Enumeration
  #CONTAINER
  #SERVER
  #CLIENT
  #HOST
  #START
  #FRAME
  #PROCESSINFO
EndEnumeration

Enumeration
  #BALLPOS
  #BATPOS
  #QUIT
EndEnumeration

Structure SendData
  CMD.b
  Data_.POINT
EndStructure

Structure POINTF
  X.f
  Y.f
EndStructure

Me.POINT
You.POINT
Ball.POINTF
BallSpeed.POINTF

Buffer.SendData

#BAT_WIDTH = 32
#BAT_HEIGHT = 128
#BALL_WIDTH = 16
#BALL_HEIGHT = 16

#WindowWidth  = 640
#WindowHeight = 480
#WindowFlags  = #PB_Window_MinimizeGadget | #PB_Window_TitleBar | #PB_Window_ScreenCentered

CreateImage(0, #WindowWidth, #WindowHeight)
hWnd = OpenWindow(0, 0, 0, #WindowWidth, #WindowHeight, #WindowFlags, "PingPong")

CreateGadgetList(WindowID())
ContainerGadget(#CONTAINER, 0, 0, WindowWidth(), WindowHeight())
OptionGadget(#SERVER, 170, 200, 90, 20, "Server")
SetGadgetState(#SERVER, 1)
OptionGadget(#CLIENT, 170, 230, 90, 20, "Client")
StringGadget(#HOST, 270, 215, 200, 20, "Port")
ButtonGadget(#START, 160, 260, 320, 30, "Start", #PB_Button_Default)
TextGadget(#PROCESSINFO, 150, 320, 340, 20, "Created by Daniel B. http://www.bradan.net/", #PB_Text_Center | #PB_Text_Border)
Frame3DGadget(#FRAME, 150, 180, 340, 120, "Connection")
CloseGadgetList()

Me\Y = WindowHeight()/2

BallSpeed\X = Random(8)/4-1
BallSpeed\Y = Random(8)/4-1
If BallSpeed\X = 0 : BallSpeed\X = 0.5 : EndIf

Ball\X = WindowWidth()/2
Ball\Y = WindowHeight()/2

Repeat
  Event = WindowEvent()
  If ConnectionID <> 0
    Select NEvent
      Case 2
        ReceiveNetworkData(ConnectionID, @Buffer, SizeOf(SendData))
        Select Buffer\CMD
          Case #BALLPOS
            CopyMemory(@Buffer\Data_, @Ball, SizeOf(POINT))
          Case #BATPOS
            CopyMemory(@Buffer\Data_, @You, SizeOf(POINT))
          Case #QUIT
            ConnectionID = 0
        EndSelect
    EndSelect
    
    StartDrawing(ImageOutput())
    Box(0, 0, ImageWidth(), ImageHeight(), 0)
    FrontColor(255, 255, 255)
    Box(Me\X-#BAT_WIDTH/2, Me\Y-#BAT_HEIGHT/2, #BAT_WIDTH, #BAT_HEIGHT)
    Box(You\X-#BAT_WIDTH/2, You\Y-#BAT_HEIGHT/2, #BAT_WIDTH, #BAT_HEIGHT)
    Ellipse(Ball\X, Ball\Y, #BALL_WIDTH, #BALL_HEIGHT)
    StopDrawing()
    
    StartDrawing(WindowOutput())
    DrawImage(ImageID(), 0, 0, WindowWidth(), WindowHeight())
    StopDrawing()
    
    m - 1
    
    If GetForegroundWindow_() = WindowID()
    If GetAsyncKeyState_(#VK_UP)
      Started = 1
      Me\Y - 1
      Buffer\CMD = #BATPOS
      If m <= 0
      CopyMemory(@Me, @Buffer\Data_, SizeOf(POINT))
      SendNetworkData(ConnectionID, @Buffer, SizeOf(SendData))
      k = 2
      EndIf
    ElseIf GetAsyncKeyState_(#VK_DOWN)
      Started = 1
      Me\Y + 1
      Buffer\CMD = #BATPOS
      If m <= 0
      CopyMemory(@Me, @Buffer\Data_, SizeOf(POINT))
      SendNetworkData(ConnectionID, @Buffer, SizeOf(SendData))
      k = 2
      EndIf
    EndIf
    EndIf
    
    If GetGadgetState(#SERVER) = 1
      If KeyboardPushed(#PB_KEY_ESCAPE)
        Buffer\CMD = #QUIT
        SendNetworkData(ConnectionID, @Buffer, SizeOf(SendData))
        CloseNetworkConnection(ConnectionID)
      EndIf
      
      If Started = 1
      Ball\X + BallSpeed\X
      Ball\Y + BallSpeed\Y
      If Ball\Y <= #BALL_HEIGHT/2 Or Ball\Y >= ImageHeight()-(#BALL_HEIGHT/2)
        BallSpeed\Y * -1
      EndIf
      If Abs(Ball\X-Me\X) < #BAT_WIDTH/2 And Abs(Ball\Y-Me\Y) < #BAT_HEIGHT/2
        BallSpeed\X * -1
      EndIf
      If Abs(Ball\X-You\X) < #BAT_WIDTH/2 And Abs(Ball\Y-You\Y) < #BAT_HEIGHT/2
        BallSpeed\X * -1
      EndIf
      If Ball\X < 0 Or Ball\X > ImageWidth()
        Ball\X = WindowWidth()/2
        Ball\Y = WindowHeight()/2
      EndIf
      Buffer\CMD = #BALLPOS
      If m <= 0
      CopyMemory(@Ball, @Buffer\Data_, SizeOf(POINT))
      SendNetworkData(ConnectionID, @Buffer, SizeOf(SendData))
      k = 2
      EndIf
      EndIf
      
      If k <> 0 : m = k : k = 0 : EndIf
      
      NEvent = NetworkServerEvent()
      If NEvent = 4
        MessageRequester("ERROR", "Client has disconnected")
        CloseNetworkServer()
        ConnectionID = 0
        Started = 0
      EndIf
    Else
      NEvent = NetworkClientEvent(ConnectionID)
    EndIf
  Else
    Select Event
      Case #WM_KEYUP
        If EventwParam() = #VK_RETURN
            Host.s = GetGadgetText(#HOST)
            If GetGadgetState(#SERVER) = 1
              Me\X = #BAT_WIDTH/2
              If CreateNetworkServer(Val(Host))
                t = ElapsedMilliseconds()
                Repeat : Delay(10) : WindowEvent() : SetGadgetText(#PROCESSINFO, StrF((ElapsedMilliseconds()-t)/1000)+" seconds til timeout") : Until NetworkServerEvent() = 1 Or ElapsedMilliseconds()-t >= 5000
                
                If ElapsedMilliseconds()-t < 5000
                ConnectionID = NetworkClientID()
                Else
                CloseNetworkServer()
                EndIf
              EndIf
            Else
              Me\X = ImageWidth()-#BAT_WIDTH/2
              ConnectionID = OpenNetworkConnection(StringField(Host, 1, ":"), Val(StringField(Host, 2, ":")))
            EndIf
        EndIf
      Case #PB_Event_Gadget
        Select EventGadgetID()
          Case #SERVER
            SetGadgetText(#HOST, "Port")
          Case #CLIENT
            SetGadgetText(#HOST, "IP:Port")
          Case #START
            Host.s = GetGadgetText(#HOST)
            If GetGadgetState(#SERVER) = 1
              Me\X = #BAT_WIDTH/2
              If CreateNetworkServer(Val(Host))
                t = ElapsedMilliseconds()
                Repeat : Delay(10) : WindowEvent() : SetGadgetText(#PROCESSINFO, StrF(5.0-(ElapsedMilliseconds()-t)/1000, 3)+" seconds til timeout") : Until NetworkServerEvent() = 1 Or ElapsedMilliseconds()-t >= 5000
                
                If ElapsedMilliseconds()-t < 5000
                ConnectionID = NetworkClientID()
                Else
                CloseNetworkServer()
                EndIf
                SetGadgetText(#PROCESSINFO, "Created by Daniel B. http://www.bradan.net/")
              EndIf
            Else
              Me\X = ImageWidth()-#BAT_WIDTH/2
              ConnectionID = OpenNetworkConnection(StringField(Host, 1, ":"), Val(StringField(Host, 2, ":")))
            EndIf
            If ConnectionID
              Buffer\CMD = #BATPOS
              CopyMemory(@Me, @Buffer\Data_, SizeOf(POINT))
              SendNetworkData(ConnectionID, @Buffer, SizeOf(SendData))
            EndIf
        EndSelect
    EndSelect
    Delay(10)
  EndIf
Until Event = #PB_Event_CloseWindow
FreeImage(0)
End
EndProcedure


BilligesNetzwerkSpiel()

Naja

Verfasst: 25.04.2006 10:52
von Xaby
Wenn ihr kräftig mithelft, wird es vielleicht bald soweit sein.

Man gibt dem Computer nur noch einen Sprachbefehl und der macht los ...
Und wenn er selbst keine Idee hat, kann man ja sowas sagen wie:

Es soll cool werden, so mit springen und so
und Frauen sollen drin auftauchen
achja und schießen soll man können
und besser als Halflife soll es werden

...

naja und mit diesen Informationen setzt sich dann das Rechnerprogramm ran und generiert ein neues Spiel. :?

Ähnlich wie der MusikGenerator im MusicMaker.
Wo man das Genre einstellt und noch ein paar Optionen und der dann die Musik spielt.

Nur halt für alles, oder man macht einen Gamemaker, wo man bestimmte Komponenten auswählen kann. Aber ich weiß nicht, ob das dann noch so cool ist.

Was meint ihr? :roll:

Verfasst: 25.04.2006 17:07
von Karl
Du meinst so eine Art Cafeteria-System. Hiervon ein paar Waffen. Davon ein paar Trolle. Fertig! Das ist was für Kinder, die noch nicht schreiben können. Ansonsten wird das vielleicht ziemlich schnell öde, denn die Engine läuft ja im Prinzip gleich für alle Arten von Spielen. OK, wenn ich ein paar Regeln eingeben kann, mag es gehen. Aber sowas gibt es doch schon, oder? Jedenfalls war es kein Durchbruch.

Na ja, vielleicht gibt es irgendwann künstliche Intelligenzen, die kreativ genug sind, das selbst herzustellen. Aber wozu braucht man dann noch den Typen vor dem Schirm?

Gruß Karl

Verfasst: 25.04.2006 17:11
von Kaeru Gaman
> Aber wozu braucht man dann noch den Typen vor dem Schirm?

yo genau.. :mrgreen:
Humans are not longer born, they are grown.

Verfasst: 25.04.2006 17:49
von ZeHa
Da hilft dann wohl nur noch eins...

Code: Alles auswählen

Procedure PlayTheGame(GameID.l)
  ;[...]
EndProcedure
Alle Zeiten sind UTC+02:00
Seite 1 von 1

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de