PurePunch Contest #4 - Snake in 20 Zeilen

Spiele, Demos, Grafikzeug und anderes unterhaltendes.
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 »

Ahja, so funktioniert's. Die Steuerung ist etwas hakelig und reagiert nicht so schnell wie ich es gerne hätte, aber es funktioniert. Witzige Idee übrigens die Schlange kacken zu lassen, sodass neue Hindernisse entstehen. Das habe ich so auch noch nicht gesehen. Ich dachte erst ich kann das einsammeln. :lol:
Bild
Benutzeravatar
diceman
Beiträge: 347
Registriert: 06.07.2017 12:24
Kontaktdaten:

Re: PurePunch Contest #4 - Snake in 20 Zeilen

Beitrag von diceman »

Wirklich sehr cooles Spiel (und vor allem cooler Code). :mrgreen: :allright:
Bin beim ersten Mal nur bis 28 Segmente gekommen, da geht noch mehr! /:->
Now these points of data make a beautiful line,
And we're out of Beta, we're releasing on time.
Mr.L
Beiträge: 51
Registriert: 05.02.2011 21:04

Re: PurePunch Contest #4 - Snake in 20 Zeilen

Beitrag von Mr.L »

Hier, nur so Spaß - eine etwas komprimiertere Version :)

Code: Alles auswählen

InitKeyboard():InitSprite():Macro K(a,u,v):If KeyboardPushed(a):dx=u:dy=v; SNAKE 
EndIf:EndMacro:w=29:h=19:s=25:g=#Green:b=#Gray:Dim f(w,h):m=10:n=10;  _____|  _
OpenWindowedScreen(OpenWindow(0,0,0,w*s+s,h*s+s,""),0,0,w*s+s,h*s+s);|__   __| |
Repeat:ExamineKeyboard():K(200,0,-1):K(208,0,1):K(203,-1,0):K(205,1,0); |_| __ |
e=ElapsedMilliseconds():If e>t:t=e+200-lv*10:StartDrawing(ScreenOutput()); |___|
x+dx:y+dy:For v=0 To h:f(0,v)=b:f(w,v)=b:For u=0 To w:f(u,1)=b:f(u,h)=b:c=f(u,v)
d=Bool(u=x And v=y):If c:If c=g:If d:l+1:m=Random(w-2,1):n=Random(h-2,2); _2022_
If(l%5)=0:k=b:lv+1:EndIf:EndIf:ElseIf c=b:z=d:Else:z=d:f(u,v)-1:If c=1:f(u,v)=k;
k=0:EndIf:c=200+Cos(c)*55:EndIf:EndIf:If z:z=0:l=5:x=1:y=2:dx=1:dy=0:lv=1:EndIf;
Box(u*s,v*s,s-2,s-2,c):Next:Next:DrawText(s+2,2,"Size: "+Str(l)+"  Level: "+; _
Str(lv),#White):StopDrawing():FlipBuffers():f(x,y)=l:f(m,n)=g:EndIf:Delay(5);| |
Until WindowEvent()=#PB_Event_CloseWindow; MR.L______________________________| |
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 »

Wow cool. Sehr gut, du hast die Listen wegrationalisiert.
Erstaunlich, dass die Dynamik trotzdem erhalten blieb.

Aber ich denke da geht noch was, da ist so viel Platz in deinen oberen Zeilen :-P
Hier deine Version noch eine Zeile kürzer und Linux-Kompatible (ohne Farbkonstanten)^^

Code: Alles auswählen

InitKeyboard():InitSprite():Macro K(a,u,v):If KeyboardPushed(a):dx=u:dy=v: EndIf
EndMacro:w=29:h=19:s=25:OpenWindowedScreen(OpenWindow(0,0,0,w*s+s,h*s+s,""),0,0,
w*s+s,h*s+s):g=$FF00: Dim f(w,h):m=10:n=10: Repeat:ExamineKeyboard():K(200,0,-1)
K(208,0,1):K(203,-1,0):K(205,1,0): e=ElapsedMilliseconds(): If e>t:t=e+200-lv*10
StartDrawing(ScreenOutput()):b=$808080:x+dx:y+dy: For v=0 To h:f(0,v)=b:f(w,v)=b
For u=0 To w:f(u,1)=b:f(u,h)=b:c=f(u,v):d=Bool(u=x And v=y):If c:If c=g:If d:l+1
m=Random(w-2,1):n=Random(h-2,2): If(l%5)=0:k=b:lv+1:EndIf: EndIf: ElseIf c=b:z=d
Else:z=d:f(u,v)-1:If c=1:f(u,v)=k:k=0:EndIf:c=200+Cos(c)*55:EndIf:EndIf:If z:z=0
l=5:x=1:y=2:dx=1:dy=0:lv=1:EndIf:Box(u*s,v*s,s-2,s-2,c):Next:Next: DrawText(s+2,
2,"Size: "+Str(l)+"  Level: "+Str(lv),$FFFFFF): StopDrawing():FlipBuffers():f(x,
y)=l:f(m,n)=g:EndIf:Delay(5) : Until WindowEvent()=#PB_Event_CloseWindow ;-MR.L-
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
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 »

Blöde Frage sicherlich, aber wie kann ich steuern? Er läuft immer nur nach rechts durch Bild, aber ich scheine keinen Fokus darauf kriegen zu können. Weder Pfeiltasten, noch WASD funktionieren.
Bild
Mr.L
Beiträge: 51
Registriert: 05.02.2011 21:04

Re: PurePunch Contest #4 - Snake in 20 Zeilen

Beitrag von Mr.L »

NicTheQuick hat geschrieben: 24.01.2022 00:04 Blöde Frage sicherlich, aber wie kann ich steuern? Er läuft immer nur nach rechts durch Bild, aber ich scheine keinen Fokus darauf kriegen zu können. Weder Pfeiltasten, noch WASD funktionieren.
Kann es sein, dass bei dir die Konstanten für die Pfeiltasten anders sind, als bei mir?

Meine Werte (Windows 10) lauten:
#PB_Key_Up = 200
#PB_Key_Down = 208
#PB_Key_Left = 203
#PB_Key_Right = 205

Zeile 3 bis 4:

Code: Alles auswählen

K(200,0,-1):K(208,0,1):K(203,-1,0):K(205,1,0)
Benutzeravatar
#NULL
Beiträge: 2235
Registriert: 20.04.2006 09:50

Re: PurePunch Contest #4 - Snake in 20 Zeilen

Beitrag von #NULL »

Für die Linux keys siehe mein code auf Seite 1:

Code: Alles auswählen

K(273,0,-1)
:K(274,0,1):K(276,-1,0):K(275,1,0)
Leider sehe ich nur einen schwarzen Bildschrim. Ich glaube unter Linux reicht es nicht, nur ein Event pro FlipBuffers zu verarbeiten.
my pb stuff..
Bild..jedenfalls war das mal so.
Mr.L
Beiträge: 51
Registriert: 05.02.2011 21:04

Re: PurePunch Contest #4 - Snake in 20 Zeilen

Beitrag von Mr.L »

#NULL hat geschrieben: 24.01.2022 10:05 Leider sehe ich nur einen schwarzen Bildschrim
Vielleicht liegt es auch an den unterschiedlichen Farbkonstanten unter Windows/Linux.
Versuchs mal mit dieser Version:

Code: Alles auswählen

InitKeyboard():InitSprite():Macro K(a,u,v):If KeyboardPushed(a):dx=u:dy=v: EndIf
EndMacro:w=29:h=19:s=25:OpenWindowedScreen(OpenWindow(0,0,0,w*s+s,h*s+s,""),0,0,
w*s+s,h*s+s):g=#Green:Dim f(w,h):m=10:n=10: Repeat:ExamineKeyboard():K(273,0,-1)
K(274,0,1):K(276,-1,0):K(275,1,0): e=ElapsedMilliseconds(): If e>t:t=e+200-lv*10
StartDrawing(ScreenOutput()):b=#Gray: x+dx:y+dy: For v=0 To h: f(0,v)=b:f(w,v)=b
For u=0 To w:f(u,1)=b:f(u,h)=b:c=f(u,v):d=Bool(u=x And v=y):If c:If c=g:If d:l+1
m=Random(w-2,1):n=Random(h-2,2): If(l%5)=0:k=b:lv+1:EndIf: EndIf: ElseIf c=b:z=d
Else:z=d:f(u,v)-1:If c=1:f(u,v)=k:k=0:EndIf:c=RGB(0,0,200+Cos(c)*55):EndIf:EndIf
If z:z=0:l=5:x=1:y=2:dx=1:dy=0:lv=1: EndIf:Box(u*s,v*s,s-2,s-2,c):Next:Next:f(m,
n)=g : DrawText(s+2,2,"Size: "+Str(l)+"  Level: "+Str(lv),#White): StopDrawing()
f(x,y)=l:FlipBuffers():EndIf:Delay(25):Until WindowEvent()=#PB_Event_CloseWindow
Benutzeravatar
#NULL
Beiträge: 2235
Registriert: 20.04.2006 09:50

Re: PurePunch Contest #4 - Snake in 20 Zeilen

Beitrag von #NULL »

Code: Alles auswählen

.. While WindowEvent():Wend:Until KeyboardPushed(27)
Auch mit hex farben und dem obigen Ende sehe ich leider trotzdem nichts. Weiß nicht woran es liegt.
my pb stuff..
Bild..jedenfalls war das mal so.
Benutzeravatar
#NULL
Beiträge: 2235
Registriert: 20.04.2006 09:50

Re: PurePunch Contest #4 - Snake in 20 Zeilen

Beitrag von #NULL »

Scheinbar ist ein ClearScreen() notwendig.

Code: Alles auswählen

InitKeyboard():InitSprite():Macro K(a,u,v):If KeyboardPushed(a):dx=u:dy=v: EndIf
EndMacro:w=29:h=19:s=25:OpenWindowedScreen(OpenWindow(0,0,0,w*s+s,h*s+s,""),0,0,
w*s+s,h*s+s):g=$FF00: Dim f(w,h):m=10:n=10: Repeat:ExamineKeyboard():K(273,0,-1)
:K(274,0,1):K(276,-1,0):K(275,1,0): e=ElapsedMilliseconds(): If e>t:t=e+200-lv*10:ClearScreen(0)
StartDrawing(ScreenOutput()):b=$808080:x+dx:y+dy: For v=0 To h:f(0,v)=b:f(w,v)=b
For u=0 To w:f(u,1)=b:f(u,h)=b:c=f(u,v):d=Bool(u=x And v=y):If c:If c=g:If d:l+1
m=Random(w-2,1):n=Random(h-2,2): If(l%5)=0:k=b:lv+1:EndIf: EndIf: ElseIf c=b:z=d
Else:z=d:f(u,v)-1:If c=1:f(u,v)=k:k=0:EndIf:c=200+Cos(c)*55:EndIf:EndIf:If z:z=0
l=5:x=1:y=2:dx=1:dy=0:lv=1:EndIf:Box(u*s,v*s,s-2,s-2,c):Next:Next: DrawText(s+2,
2,"Size: "+Str(l)+"  Level: "+Str(lv),$FFFFFF): StopDrawing():FlipBuffers():f(x,
y)=l:f(m,n)=g:EndIf:Delay(5) :Debug "aa":While WindowEvent():Wend:Until KeyboardPushed(27)
my pb stuff..
Bild..jedenfalls war das mal so.
Antworten