Seite 1 von 3

PurePunch Contest #4 - Snake in 20 Zeilen

Verfasst: 15.09.2009 16:52
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

Re: PurePunch Contest #4 - Snake in 20 Zeilen

Verfasst: 15.09.2009 18:41
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

Re: PurePunch Contest #4 - Snake in 20 Zeilen

Verfasst: 15.09.2009 18:47
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

Re: PurePunch Contest #4 - Snake in 20 Zeilen

Verfasst: 15.09.2009 19:23
von coder
Ahh...
Ergibt Sinn! Danke! <)

Re: PurePunch Contest #4 - Snake in 20 Zeilen

Verfasst: 15.09.2009 22:52
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.

Re: PurePunch Contest #4 - Snake in 20 Zeilen

Verfasst: 14.04.2021 11:54
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.

Re: PurePunch Contest #4 - Snake in 20 Zeilen

Verfasst: 14.04.2021 12:30
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:

Re: PurePunch Contest #4 - Snake in 20 Zeilen

Verfasst: 14.04.2021 13:10
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.

Re: PurePunch Contest #4 - Snake in 20 Zeilen

Verfasst: 14.04.2021 13:49
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.

Re: PurePunch Contest #4 - Snake in 20 Zeilen

Verfasst: 14.04.2021 14:28
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.