PurePunch Contest #4 - Snake in 20 Zeilen

Spiele, Demos, Grafikzeug und anderes unterhaltendes.
Benutzeravatar
STARGÅTE
Kommando SG1
Beiträge: 6996
Registriert: 01.11.2005 13:34
Wohnort: Glienicke
Kontaktdaten:

PurePunch Contest #4 - Snake in 20 Zeilen

Beitrag von STARGÅTE »

Tachchen,

dank "kurzer" bin ich auch drauf gestoßen und habe mal n Snake-Game geschrieben.

Natürlich innerhalb der Regeln : 20Zeilen á 80Zeichen:

Code: Alles auswählen

;*****************************************************************************
;*
;* PurePunch Contest #4
;*
;* Name     :  Snake
;* Author   :  Martin Guttmann (STARGÅTE)
;* Category :  Game
;* Date     :  9/15/2009, update 4/13/2021 for new PB version
;* Notes    :  The famous Snake game in 20 lines. 
;*             Navigation With arrow keys. 
;*             Objective: To feed the orange squares,
;*                        While Not push against walls Or yourself. 
;*             Special feature: The snake drop sam walls.
;*
;*****************************************************************************
;
InitSprite():InitKeyboard():Macro Q(v,w):(v\x=w\x And v\y=w\y):EndMacro: a.Point
Macro E:ElapsedMilliseconds():EndMacro:Macro LS:ListSize(S()):EndMacro: #b=#Gray
Macro B(x,y,C,u=1):Box(x*25+u,y*25+u,25-u*2,25-u*2,C):EndMacro:NewList G.Point()
OpenWindowedScreen(OpenWindow(0,0,0,800,600,"Snake",13107201),0,0,800,800,0,0,0)
Macro K(k,v,w):If KeyboardPushed(k):a\x=v:a\y=w:EndIf:EndMacro:NewList S.Point()
A: :Delay(D):Gosub Z:ClearList(S()):j.Point\x=10:j\y=9:a\x=1:a\y=0: For i=5 To 9
AddElement(S()):S()\x=i:S()\y=9:Next : *S.Point=@S() : Repeat :ExamineKeyboard()
K(200,0,-1):K(208,0,1):K(203,-1,0):K(205,1,0) : If E-T > 200-ListSize(S()) : T=E
AddElement(S()):S()\x=*S\x+a\x:S()\y=*S\y+a\y:*S=@S():If Q(j,S()): Repeat : OK=1
j\x=Random(29)+1:j\y=Random(20)+2:ForEach S():If Q(S(),j):OK=0:Break:EndIf: Next
ForEach G():If Q(G(),j):OK=0:Break:EndIf:Next:Until OK : Else: FirstElement(S())
If LS > ListSize(G())*5+10 : AddElement(G()) : G()\x=S()\x : G()\y=S()\y : EndIf
DeleteElement(S()):EndIf:ForEach S():ForEach G():If Q(S(),G()):Goto A:EndIf:Next
If (@S()<>*S And Q(S(),*S)) Or (*S\x<1 Or *S\y<2 Or *S\x>30 Or *S\y>22) : Goto A
EndIf:Next:EndIf: ClearScreen(0) : StartDrawing(ScreenOutput()) : DrawingMode(1)
For i = 0 To 32 : B(0,i,#b):B(31,i,#b):B(i,1,#b):B(i,23,#b) : Next : ForEach S()
LI = ListIndex(S()) : B(S()\x,S()\y,RGB(0,128-Sin(LI)*64,191-Sin(LI)*64)) : Next
B(J\x,j\y,$00A0F0):ForEach G():B(G()\x,G()\y,#b): Next : Text$="Length:"+Str(LS)
DrawText(100,5,Text$+" Speed:"+StrF(1000/(200-LS),3)+"Hz",#White): StopDrawing()
FlipBuffers():Until WindowEvent()=13116:End:Z: :ClearList(G()):T=E:D=1500:Return
Viel spaß beim spielen.

Ihr könnt dnan auch eure Rekorde hier posten, meiner liegt leider erst bei Länge:45 :-P

Edit: Code updated für PB 5.73
Zuletzt geändert von STARGÅTE am 13.04.2021 17:03, insgesamt 5-mal geändert.
PB 6.01 ― Win 10, 21H2 ― Ryzen 9 3900X, 32 GB ― NVIDIA GeForce RTX 3080 ― Vivaldi 6.0 ― www.unionbytes.de
Aktuelles Projekt: Lizard - Skriptsprache für symbolische Berechnungen und mehr
Benutzeravatar
coder
Beiträge: 204
Registriert: 25.09.2005 17:53
Computerausstattung: Intel Core2Quad Q8200 @ 2.33GHz
ASUS P5Q3, 2GB DDR3-1066 RAM, ATi Raedeon HD 4850
Wohnort: Deutschland
Kontaktdaten:

Re: PurePunch Contest #4 - Snake in 20 Zeilen

Beitrag von coder »

interressanter Code! :allright:
Ich habs bis auf 41Punkte/Segmente geschafft...

Kannst du mir mal sagen, was du mit der Frequenz anzeigst bzw. wozu diese da ist. Ich blick bei diesen Codes iwie nie wirklich durch.

mfg
Windows 7 x64 | PureBasic 4.60 4.50 4.02
Ja verdammt, meine Eltern wohnen immer noch bei mir!
Benutzeravatar
STARGÅTE
Kommando SG1
Beiträge: 6996
Registriert: 01.11.2005 13:34
Wohnort: Glienicke
Kontaktdaten:

Re: PurePunch Contest #4 - Snake in 20 Zeilen

Beitrag von STARGÅTE »

die Gibt an wie viel schritte sich die Schlange sich in einer Sekunde bewegt.
200ms ist dabei die normale Pause also 5hz, pro segment wird 1ms weggenommen.

Auf gut Deut bei 200 Segmenten ist die schlage Unendlich schnell ^^

Aber auf ein Sinnvolles Spielende wurde ja kein Wert gelegt :-P
PB 6.01 ― Win 10, 21H2 ― Ryzen 9 3900X, 32 GB ― NVIDIA GeForce RTX 3080 ― Vivaldi 6.0 ― www.unionbytes.de
Aktuelles Projekt: Lizard - Skriptsprache für symbolische Berechnungen und mehr
Benutzeravatar
coder
Beiträge: 204
Registriert: 25.09.2005 17:53
Computerausstattung: Intel Core2Quad Q8200 @ 2.33GHz
ASUS P5Q3, 2GB DDR3-1066 RAM, ATi Raedeon HD 4850
Wohnort: Deutschland
Kontaktdaten:

Re: PurePunch Contest #4 - Snake in 20 Zeilen

Beitrag von coder »

Ahh...
Ergibt Sinn! Danke! <)
Windows 7 x64 | PureBasic 4.60 4.50 4.02
Ja verdammt, meine Eltern wohnen immer noch bei mir!
Benutzeravatar
Kurzer
Beiträge: 1614
Registriert: 25.04.2006 17:29
Wohnort: Nähe Hamburg

Re: PurePunch Contest #4 - Snake in 20 Zeilen

Beitrag von Kurzer »

Schönes Ding, Stargate. :allright:
Der September Contest ist eh ein bißchen unterbesetzt, wenn ich das richtig sehe.

Allerdings bin ich auch eher durch Zufall drüber gestolpert.
Die anderen Contests die Monate zuvor gingen alle an mir vorbei.
Aber wenn man sich mal die Beiträger der zurückliegenden 20 lines contests ansieht, da kann man teilweise schon mit den Ohren schlackern.
"Never run a changing system!" | "Unterhalten sich zwei Alleinunterhalter... Paradox, oder?"
PB 6.02 x64, OS: Win 7 Pro x64 & Win 11 x64, Desktopscaling: 125%, CPU: I7 6500, RAM: 16 GB, GPU: Intel Graphics HD 520
Useralter in 2023: 56 Jahre.
Benutzeravatar
NicTheQuick
Ein Admin
Beiträge: 8675
Registriert: 29.08.2004 20:20
Computerausstattung: Ryzen 7 5800X, 32 GB DDR4-3200
Ubuntu 22.04.3 LTS
GeForce RTX 3080 Ti
Wohnort: Saarbrücken
Kontaktdaten:

Re: PurePunch Contest #4 - Snake in 20 Zeilen

Beitrag von NicTheQuick »

Structure not found: Point
War ja klar :lol:

Wir armen Linuxer dürfen leider nicht mitspielen. :(

Hm, aber auch wenn ich die Structure hinzufüge, passiert nichts. Nur eine Warnung, und irgendwas hängt wohl, aber dann kann ich es nur abschießen.
Bild
Derren
Beiträge: 557
Registriert: 23.07.2011 02:08

Re: PurePunch Contest #4 - Snake in 20 Zeilen

Beitrag von Derren »

Hast du grade nen Spam entfernt oder so? Der Beitrag ist ja 11 Jahre alt. Welche PB-Version war denn damals aktuell? :shock:
Signatur und so
Benutzeravatar
NicTheQuick
Ein Admin
Beiträge: 8675
Registriert: 29.08.2004 20:20
Computerausstattung: Ryzen 7 5800X, 32 GB DDR4-3200
Ubuntu 22.04.3 LTS
GeForce RTX 3080 Ti
Wohnort: Saarbrücken
Kontaktdaten:

Re: PurePunch Contest #4 - Snake in 20 Zeilen

Beitrag von NicTheQuick »

Derren hat geschrieben:Hast du grade nen Spam entfernt oder so? Der Beitrag ist ja 11 Jahre alt. Welche PB-Version war denn damals aktuell? :shock:
Siehe hier: viewtopic.php?p=359573#p359573
Stargate hat seinen Code übrigens gestern aktualisiert, wie du sehen kannst.
Bild
Benutzeravatar
STARGÅTE
Kommando SG1
Beiträge: 6996
Registriert: 01.11.2005 13:34
Wohnort: Glienicke
Kontaktdaten:

Re: PurePunch Contest #4 - Snake in 20 Zeilen

Beitrag von STARGÅTE »

Mangels Platz musste ich die PB Konstanten in Zahlen umwandeln, die vermutlich nur im Falle von Windows stimmen.

Guck mal bei "OpenWindow(0,0,0,800,600,"Snake",13107201)" ob die Flags stimmen und in "WindowEvent()=13116".
Es sollte #PB_Window_SystemMenu|#PB_Window_ScreenCentered und #PB_Event_CloseWindow sein.
PB 6.01 ― Win 10, 21H2 ― Ryzen 9 3900X, 32 GB ― NVIDIA GeForce RTX 3080 ― Vivaldi 6.0 ― www.unionbytes.de
Aktuelles Projekt: Lizard - Skriptsprache für symbolische Berechnungen und mehr
Benutzeravatar
#NULL
Beiträge: 2235
Registriert: 20.04.2006 09:50

Re: PurePunch Contest #4 - Snake in 20 Zeilen

Beitrag von #NULL »

Ich hab einfach die Window-Flags weg gelassen und die Keys und das Close-Event angepasst:

Code: Alles auswählen

Structure Point
  x.i
  y.i
EndStructure
InitSprite():InitKeyboard():Macro Q(v,w):(v\x=w\x And v\y=w\y):EndMacro: a.Point
Macro E:ElapsedMilliseconds():EndMacro:Macro LS:ListSize(S()):EndMacro: #b=#Gray
Macro B(x,y,C,u=1):Box(x*25+u,y*25+u,25-u*2,25-u*2,C):EndMacro:NewList G.Point()
OpenWindowedScreen(OpenWindow(0,0,0,800,600,"Snake"),0,0,800,800,0,0,0)
Macro K(k,v,w):If KeyboardPushed(k):a\x=v:a\y=w:EndIf:EndMacro:NewList S.Point()
A: :Delay(D):Gosub Z:ClearList(S()):j.Point\x=10:j\y=9:a\x=1:a\y=0: For i=5 To 9
AddElement(S()):S()\x=i:S()\y=9:Next : *S.Point=@S() : Repeat :ExamineKeyboard()
K(273,0,-1):K(274,0,1):K(276,-1,0):K(275,1,0) : If E-T > 200-ListSize(S()) : T=E
AddElement(S()):S()\x=*S\x+a\x:S()\y=*S\y+a\y:*S=@S():If Q(j,S()): Repeat : OK=1
j\x=Random(29)+1:j\y=Random(20)+2:ForEach S():If Q(S(),j):OK=0:Break:EndIf: Next
ForEach G():If Q(G(),j):OK=0:Break:EndIf:Next:Until OK : Else: FirstElement(S())
If LS > ListSize(G())*5+10 : AddElement(G()) : G()\x=S()\x : G()\y=S()\y : EndIf
DeleteElement(S()):EndIf:ForEach S():ForEach G():If Q(S(),G()):Goto A:EndIf:Next
If (@S()<>*S And Q(S(),*S)) Or (*S\x<1 Or *S\y<2 Or *S\x>30 Or *S\y>22) : Goto A
EndIf:Next:EndIf: ClearScreen(0) : StartDrawing(ScreenOutput()) : DrawingMode(1)
For i = 0 To 32 : B(0,i,#b):B(31,i,#b):B(i,1,#b):B(i,23,#b) : Next : ForEach S()
LI = ListIndex(S()) : B(S()\x,S()\y,RGB(0,128-Sin(LI)*64,191-Sin(LI)*64)) : Next
B(J\x,j\y,$00A0F0):ForEach G():B(G()\x,G()\y,#b): Next : Text$="Length:"+Str(LS)
DrawText(100,5,Text$+" Speed:"+StrF(1000/(200-LS),3)+"Hz",#White): StopDrawing()
FlipBuffers():Until WindowEvent()=2:End:Z: :ClearList(G()):T=E:D=1500:Return
Schönes Ding :allright:

<edit> Achso, und natürlich die Structure.
my pb stuff..
Bild..jedenfalls war das mal so.
Antworten