snake (extrem primitiv...)

Spiele, Demos, Grafikzeug und anderes unterhaltendes.
Benutzeravatar
benpicco
Beiträge: 391
Registriert: 01.10.2004 15:32
Wohnort: im Code
Kontaktdaten:

Beitrag von benpicco »

Ich hab jetzt einen Weg gefunden, das Ganze auch auf dem taschenrechner relativ flüssig zum Laufen zu bringen (ohne Level natürlich)
Anstatt die gesamte Matrix zu durchsuchen, benutze ich jetzt Listen (ist Taschenrechnerbasic, gehört eigentlich nicht hierher...)

Code: Alles auswählen

`Listenlöschen
Locate 3,3,"Loading"
{(21*7),1}->Dim Mat A
Mat->List(A,1)->List 1
List 1->List 2
{1,1}->Dim Mat A

[...]
`Listenaktualisieren
For L->Z To 1 step -1
List 1[Z]->List 1[Z+1]
List 2[Z]->List 2[Z+1]
Next

[...]
`Schlange zeichnen und Kollisionsabfrage
For 1->Z to L
Locate List1[Z],List2[Z],"°"
List 1[Z+1]=X and List 2[Z+1]=Y=>1->O
Next
Locate X,Y,"#"
O=1=>Goto D

[...]
Das geht ganz gut, nur ist die Spielgeschwindiggkeit umkekehrt proportional zur Schwanzlänge :lol: /:->
Johann Wolfgang von Geothe hat geschrieben:Wie dieses oder jenes Wort geschrieben wird, darauf kommt es doch eigentlich nicht an, sondern darauf, daß die Leser verstehen, was man damit sagen wollte.
Nili_Entertainment
Beiträge: 13
Registriert: 16.04.2006 11:49
Wohnort: Sonneberg (96515)

Beitrag von Nili_Entertainment »

hi Leute,

ich bin ein blutiger Anfänger und schreibe hier rein , da ich mich an snake ran getraut habe. nun ist mein erstes problem aufgetreten.
ich bekomme es nicht fertig, dass der kopf mit nur einem tastendruck
von links nach rechts geht.
wenn ich die taste los lasse bleibt der kopf stehen.
und so macht snake doch keinen spaß wenn man anhalten kann <)

bitte helft mir ich würde mich wilklich freuen.
Nili_Entertainment
Beiträge: 13
Registriert: 16.04.2006 11:49
Wohnort: Sonneberg (96515)

Beitrag von Nili_Entertainment »

hi Leute,

ich bin ein blutiger Anfänger und schreibe hier rein , da ich mich an snake ran getraut habe. nun ist mein erstes problem aufgetreten.
ich bekomme es nicht fertig, dass der kopf mit nur einem tastendruck
von links nach rechts geht.
wenn ich die taste los lasse bleibt der kopf stehen.
und so macht snake doch keinen spaß wenn man anhalten kann <)

bitte helft mir ich würde mich wilklich freuen.
Kaeru Gaman
Beiträge: 17389
Registriert: 10.11.2004 03:22

Beitrag von Kaeru Gaman »

Hi Nili,

um da was zu sagen warum das so passiert, müßte man schon sehen, wie du es programmierst.

ABER:
das hier ist der Spiel-Feedback Bereich.

es ist ja lieb, dass du in einen bestehenden Thread posten willst, und das zeigt auch, dass du die Boardsuche benutzt hast.
In diesem Fall würde ich aber doch vorschlagen, einen eigenen thread (thema) im Anfängerbereich zu eröffnen... ;)
Der Narr denkt er sei ein weiser Mann.
Der Weise weiß, dass er ein Narr ist.
Nili_Entertainment
Beiträge: 13
Registriert: 16.04.2006 11:49
Wohnort: Sonneberg (96515)

Beitrag von Nili_Entertainment »

ok gaman !
ich schreib meine frage mal dort rein! :D
Benutzeravatar
#NULL
Beiträge: 2238
Registriert: 20.04.2006 09:50

Beitrag von #NULL »

hab's nur eben auf PB4 gebracht (zum einrücken war ich trotzdem zu faul :mrgreen: ):

Code: Alles auswählen

InitSprite()
InitKeyboard()
InitSprite3D()
MessageRequester("Snake by Benpicco","Special thanks to XP/TRISTAR/SECRETLY for the particle engine")
Procedure.f GCos(winkel.f,speed)
  preturn.f=Cos(winkel*(speed*3.14159265/360))
  ProcedureReturn preturn
EndProcedure
Procedure.f Gsin(winkel.f,speed)
  preturn.f=Sin(winkel*(speed*3.14159265/360))
  ProcedureReturn preturn
EndProcedure
Procedure generate_ptcl(file$,size,color.f,grosse)
grosse=510+grosse
CreateImage(1,grosse,grosse)
;UseImage(1)
StartDrawing(ImageOutput(1))
For x=255 To 1 Step -1
red=Red(color)-x
green=Green(color)-x
blue=Blue(color)-x
If red<0
red=0
EndIf
If green<0
green=0
EndIf
If blue<0
blue=0
EndIf
For w= 0 To 360
Plot((grosse/2)+(gcos(w,1)*x),(grosse/2)+(gsin(w,1)*x),RGB(red,green,blue))
Plot((grosse/2)+(gcos(w,1)*x),(grosse/2)-(gsin(w,1)*x),RGB(red,green,blue))
Next
Next
ResizeImage(1,size,size)
StopDrawing()
SaveImage(1,file$)
FreeImage(1)
EndProcedure
Procedure install()
generate_ptcl("ptcl_rot.bmp",32,RGB(255,0,0),800)
generate_ptcl("ptcl_blau.bmp",32,RGB(0,0,255),800)
generate_ptcl("ptcl_gelb.bmp",32,RGB($FF,$FF,$00),800)
OpenFile(1,"installed.dat")
WriteByte(1,1)
CloseFile(1)
EndProcedure
;-partikelengine
;********************************************
;**********PARTIKEL-ENGINE 1.0***************
;********************************************
;********* BY XP/TRISTAR/SECRETLY ***********
;********************************************


;***typefield
Structure ptcl
  x.w               ;startpositionx
  y.w               ;startpositiony
  image.w           ;das image
  speedx.w          ;bewegungx
  speedy.w          ;bewegungy
  lifetime.w        ;lebenszeit
  rotspeed.w        ;rotationsgeschwindigkeit
  winkel.w
  scalex.w          ;scalierung x
  scaley.w          ;scalierung y
  alpha.w           ;start-alphawert
  fade.w            ;alphawert bei animation
  zoomx.w           ;scalewert bei animation
  zoomy.w           ;scalewert y bei anim
EndStructure
Global NewList ptcl.ptcl()

Structure ptclemitter
  x.w
  y.w
  typ.w
  lifetime.l
  bewegung.l
  sx.l
  sy.l
  wave.l
  part.b
  EndStructure
Global NewList ptclemitter.ptclemitter()

Procedure create_ptcl(x,y,lifetime,scalex,scaley,alpha,fade,zoomx,zoomy,speedx,speedy,rot,image)
AddElement(ptcl())
  ptcl()\x        = x
  ptcl()\y        = y
  ptcl()\image    = image
  ptcl()\speedx   = speedx
  ptcl()\speedy   = speedy
  ptcl()\lifetime = lifetime
  ptcl()\rotspeed = rot
  ptcl()\winkel   = 0
  ptcl()\scalex   = scalex
  ptcl()\scaley   = scaley
  ptcl()\alpha    = alpha
  ptcl()\fade     = fade
  ptcl()\zoomx    = zoomx
  ptcl()\zoomy    = zoomy
  EndProcedure


Procedure update_ptcl()
Sprite3DBlendingMode(5,7)
  ResetList(ptcl())
  While NextElement(ptcl())
    killptcl=0      ;löschbit
    If ptcl()\y < -50 Or ptcl()\y > 768     ;ob noch im bild
      killptcl=1
    EndIf
    If ptcl()\x < -50 Or ptcl()\x > 1024     ;andernfalls sowieso löschen
      killptcl=1   
    EndIf
    ptcl()\lifetime-1
    If  ptcl()\lifetime<0                   ;wenn lebenszeit zu ende dann löschen
      killptcl=1
    EndIf
    ptcl()\x+ptcl()\speedx      ;bewegen x
    ptcl()\y+ptcl()\speedy      ;bewegen y
    ptcl()\scalex+ptcl()\zoomx  ;zoomen x
    ptcl()\scaley+ptcl()\zoomy  ;zoomen y
    ptcl()\alpha+ptcl()\fade    ;faden
   ZoomSprite3D   ( ptcl()\image , ptcl()\scalex , ptcl()\scaley )
   DisplaySprite3D( ptcl()\image , ptcl()\x , ptcl()\y ,ptcl()\alpha )
  If killptcl=1     ;löschen
    killptcl=0
    DeleteElement(ptcl())
  EndIf
  Wend
Sprite3DBlendingMode(0,0)
EndProcedure

Procedure free_ptcl()
ResetList(ptcl())
  While NextElement(ptcl())
 DeleteElement(ptcl())
  Wend
EndProcedure

Procedure create_ptclemitter(x,y,life,typ,beweg,part)
AddElement( ptclemitter())
  ptclemitter()\x = x
  ptclemitter()\y = y
  ptclemitter()\typ = typ
  ptclemitter()\lifetime = life
  ptclemitter()\bewegung = beweg
  ptclemitter()\sx=Random(8)-4
  ptclemitter()\sy=Random(8)-4
  ptclemitter()\wave=Random(10) -20
  ptclemitter()\part=part
EndProcedure


Procedure update_ptclemitter()

ResetList(ptclemitter())
  While NextElement(ptclemitter())


;create_ptcl(x,y,lifetime,scalex,scaley,alpha,fade,zoomx,zoomy,speedx,speedy,rot,image)
Select ptclemitter()\typ
Case 1 ;rauch 1
  create_ptcl(ptclemitter()\x+Random(10),ptclemitter()\y+Random(10),49,20,20,100,-2,1,1,0,0,0,ptclemitter()\part)
 
Case 2 ;rauch2
  create_ptcl(ptclemitter()\x,ptclemitter()\y,49,5,5,100,-2,1,1,0,0,0,ptclemitter()\part)

Case 3 ;rauch2
  create_ptcl(ptclemitter()\x,ptclemitter()\y,49,3,3,100,-2,1,1,0,0,0,ptclemitter()\part)
Case 4
create_ptcl(ptclemitter()\x,ptclemitter()\y,49,30,30,100,-2,-1,-1,Random(4)-2,0,0,ptclemitter()\part)

Case 5
create_ptcl(ptclemitter()\x,ptclemitter()\y,49,30,30,100,-2,-1,-1,Random(4)-2,0,0,ptclemitter()\part)
Case 6
create_ptcl(ptclemitter()\x,ptclemitter()\y,49,30,30,150,-2,-1,-1,Random(4)-2,0,0,ptclemitter()\part)
Case 7
create_ptcl(ptclemitter()\x,ptclemitter()\y,Random(50)+10,40,40,150,-2,-1,-1,Random(4)-2,Random(4)-2,0,ptclemitter()\part)

EndSelect

Select ptclemitter()\bewegung
Case 1

ptclemitter()\wave+1
 ;ptclemitter()\x=x
ptclemitter()\y+ptclemitter()\sy
ptclemitter()\x+ ptclemitter()\sx
EndSelect

ptclemitter()\lifetime-1
If ptclemitter()\lifetime<0
emitterkill=1
EndIf
If ptclemitter()\y<0 Or ptclemitter()\y>600
emitterkill=1
EndIf
If ptclemitter()\x<0 Or ptclemitter()\x>800
emitterkill=1
EndIf
If emitterkill=1
DeleteElement(ptclemitter())
EndIf
Wend
EndProcedure


Procedure free_ptclemitter()
ResetList(ptclemitter())
  While NextElement(ptclemitter())
 DeleteElement(ptclemitter())
  Wend
EndProcedure
;-ende Partikelengine

If ReadFile(1,"installed.dat")
If ReadByte(1)=1
Else
install()
EndIf
Else
install()
EndIf
#screenX=640
#screenY=480
Dim raster.f(#screenX,#screenY)
Global futterX.w
Global futterY.w
Global score.w
Global speed.b
Global laenge.f
Global headX.w
Global headY.w
Procedure drawing(text$,X,Y,color)
StartDrawing(ScreenOutput())
DrawingMode(1);:Locate(x,y)
FrontColor(color)
DrawText(x,y,text$)
StopDrawing()
EndProcedure
Procedure.s GetAppDir()
  FullPath.s = Space(360)
  DLL = OpenLibrary(#PB_Any, "Kernel32")
  CallFunction(DLL, "GetModuleFileNameA", CallFunction(DLL, "GetModuleHandleA", 0), @FullPath, 360)
  CloseLibrary(DLL)
  FullPath = GetPathPart(FullPath)
  If Right(FullPath, 1) <> "\" : FullPath + "\" : EndIf
  ProcedureReturn FullPath
EndProcedure
laenge=3
speed=10
retry1:
futterX=((Random(((#screenX-20)/speed)))*speed)+10
futterY=((Random(((#screenY-20)/speed)))*speed)+10
If raster(futterX,futterY)<>0
Goto retry1
EndIf
level$=OpenFileRequester("Level laden", getappdir()+"level\*.slv", "*slv", 0)
If level$=""
headX=10
headY=10
speedX=speed
speedY=0
Goto start
EndIf
OpenFile(1,level$)
For y=0 To #screenY Step 10
For x=0 To #screenX Step 10
raster(x,y)=ValF(ReadString(1))
If raster(x,y)=3
headX=x
headY=y
EndIf
If raster(x,y)=1
dirX=x
dirY=y
EndIf
Next
Next
If dirY>headY
speedY=speed
ElseIf dirY<headY
speedY=-speed
ElseIf dirX<headX
speedX=-speed
ElseIf dirX>headX
speedX=speed
EndIf
raster(dirX,dirY)=0
CloseFile(1)
start:
OpenWindow(0, 0, 0, #ScreenX,#ScreenY, "Snake", #PB_Window_ScreenCentered)
OpenWindowedScreen(WindowID(0),0,0,#screenX,#screenY,1,0,0)
Sprite3DQuality(1)
LoadSprite(1,"ptcl_blau.bmp",#PB_Sprite_Texture)
LoadSprite(2,"ptcl_rot.bmp",#PB_Sprite_Texture)
LoadSprite(3,"ptcl_gelb.bmp",#PB_Sprite_Texture)
For x=1 To 3
CreateSprite3D(x,x)
Next
SetFrameRate(20)
Repeat
If sini<360:sini+1:Else:sini=0:EndIf
ClearScreen($a0a0a0)
StartDrawing(ScreenOutput())
Box(futterX,futterY,10,10,RGB(255,0,0))
For y=0 To #screenY Step 10
For x=0 To #screenX Step 10
If raster(x,y)>0
Box(x,y,10,10,RGB(255*(raster(x,y)/laenge),255*(raster(x,y)/laenge),255*(raster(x,y)/laenge)))
If raster(x,y)=laenge
Box(x,y,10,10,RGB(0,0,255))
EndIf
raster(x,y)-1
EndIf
If raster(x,y)=-1
Box(x,y,10,10,RGB(255,255,0))
Start3D()
create_ptclemitter(x,y,1,4,0,3)
Stop3D()
EndIf
Next
Next
headX+speedX
headY+speedY
If headX>#screenX-10
headX=10
EndIf
If headX<10
headX=#screenX-10
EndIf
If headY>#screenY-10
headY=10
EndIf
If headY<10
headY=#screenY-10
EndIf
If raster(headX,headY)<>0
Goto die
EndIf
raster(headX,headY)=laenge
StopDrawing()
drawing(Str(score),1,1,RGB(255,255,255))
;-3d
Start3D()
create_ptcl((headX+(speedX/2))+(gsin(sini,2)*10),(headY+(speedY/2))+(gcos(sini,2)*10),25,25,10,120,10,-1,-1,-speedX,-speedy,20,1)
create_ptclemitter(headX-10,headY-10,laenge,1,0,1)
create_ptclemitter(futterX-10,futterY-10,5,7,0,2)
update_ptclemitter()
update_ptcl()
Stop3D()
FlipBuffers()
WindowEvent()
ExamineKeyboard()
If KeyboardPushed(#PB_Key_Up) And speedY<>speed
speedY=-speed
speedX=0
ElseIf KeyboardPushed(#PB_Key_Down) And speedY<>-speed
speedY=speed
speedX=0
ElseIf KeyboardPushed(#PB_Key_Left) And speedX<>speed
speedY=0
speedX=-speed
ElseIf KeyboardPushed(#PB_Key_Right) And speedX<>-speed
speedY=0
speedX=speed
EndIf
If headX=futterX And headY=futterY
score+1
laenge+1
retry:
futterX=((Random(((#screenX-20)/speed)))*speed)+10
futterY=((Random(((#screenY-20)/speed)))*speed)+10
If raster(futterX,futterY)<>0
Goto retry
EndIf
EndIf
Until KeyboardPushed(#PB_Key_Escape)
End
die:
StopDrawing()
drawing("GameOver!",100,100,RGB(100,100,100))
OpenFile(1,GetFilePart(level$)+"-highscore.dat")
highscore.w=ReadWord(1)
CloseFile(1)
drawing("Highscore:"+Str(highscore),50,150,RGB(255,255,0))
FlipBuffers()
Delay(1000)
If score>highscore
drawing("New Highscore!",200,200,RGB(0,255,0))
OpenFile(1,GetFilePart(level$)+"-highscore.dat")
WriteWord(1,score)
CloseFile(1)
FlipBuffers()
Delay(1000)
EndIf
End 
my pb stuff..
Bild..jedenfalls war das mal so.
c4s
Beiträge: 1235
Registriert: 19.09.2007 22:18

Beitrag von c4s »

#NULL hat geschrieben:hab's nur eben auf PB4 gebracht
habe ich gerade getestet und bei mir funzt es nicht..
Ich hatte auch davor ein Level generiert, aber es startet einfach nicht.

Die gelobten Partikeleffekte würde ich nämlich schon gerne mal sehen!


Edit:
natürlich funktioniert es -.-
und die Partikeleffekte sind klasse!
"Menschenskinder, das Niveau dieses Forums singt schon wieder!" — GronkhLP ||| "ich hogffe ihr könnt den fehle endecken" — Marvin133 ||| "Ideoten gibts ..." — computerfreak ||| "Jup, danke. Gruss" — funkheld
Antworten