Ein 4k-Klone von Spielen a la Artillerie oder Scorched Tanks. Paßt gequetscht gerade so eben in das Limit.
Gespielt wird gegen eine CPU. Gesteuert wird mit Tasten. Cursortasten hoch/runter verstellt die Achse des menschlichen Spielers. Mit den Cursortasten links/rechts wird die Wucht des Schusses eingestellt. Mit der Leertaste feuert die Haubitze. Diese Infos werden oben in der Titelleiste angezeigt.
Gewinnen wird der Spieler, der seinen Gegner unten aus dem Sichtfeld bombt. Viel Spaß und Ton anschalten!
http://postimg.org/image/lk2ybtlrl/
Download als ausführbare Datei, incl. ungekürztem Quellcode: Artillerie4k.zip
Code
Declare x&,y&,px1&,py1&,px2&,py2&,w1&,w2&,nx&,ny&,a1&,a2&,t&,s&,n&,ux&,uy&
Declare p0&,ofx&,ofy&,ax&,ay&,ti&,tr&,ex&,ey&,s2&,t$
Randomize:WindowStyle 2074:WindowTitle "Artillerie 4k © 2013 Frabbing":Window 640,480
a1&=120:s&=6
Proc ti
SetText %hwnd,"Artillerie 4k ‡ Schusswinkel: "+Str$(a1&)+"° ++ Treibladung: "+Str$(s&)+"00 g {Space}"
EndProc
Proc gk
Parameters w!,xxx&,yyy&
Declare x!,y!
w!=(Pi()/180)*(w!+180):nx&=xxx&+(Cos(w!)*16):ny&=yyy&+(Sin(w!)*10)
EndProc
Proc gs
MCls 640,480,$ffaa44:StartPaint -1:y&=Rnd(220)+200:x&=y&:UsePen 1,3,$559944:Line 0,y&-0,y&
WhileLoop 0,680,Rnd(20)+8
LineTo &loop-1,y&:y&=y&+(Rnd(31)-15)
If &loop<310
y&=y&-Rnd(20)
Else
y&=y&+Rnd(20)
EndIf
Case y&>400:y&=y&-Rnd(15)
Case y&<80:y&=y&+Rnd(15)
EndWhile
UseBrush 1,$42AE50:Fill 0,479,$559944:px1&=Rnd(100):py1&=0:px2&=Rnd(100)+500:py2&=0
While 1
Case GetPixel(px1&+10,py1&+12)=$42AE50:BREAK
Inc py1&
EndWhile
While 1
Case GetPixel(px2&+10,py2&+12)=$42AE50:BREAK
Inc py2&
EndWhile
EndPaint:MCopyBmp 0,0-640,480>0,0;0
EndProc
Proc gl
UsePen 0,2,$447733:UseBrush 1,$ee0000:MCopyBmp px1&-8,(py1&-6)-36,24>px1&-8,py1&-6;0
RoundRect px1&,py1&-px1&+20,py1&+12;6,4
ax&=px1&+10:ay&=py1&+5
Line ax&,ay&-ax&,ay&
gk(a1&,px1&+10,py1&+5)
LineTo nx&,ny&
ux&=nx&:uy&=ny&
EndProc
Proc gr
UsePen 0,2,$447733
UseBrush 1,$0088ff
MCopyBmp px2&-8,(py2&-6)-36,24>px2&-8,py2&-6;0
RoundRect px2&,py2&-px2&+20,py2&+12;6,4
Line px2&+10,py2&+5-px2&+10,py2&+5
gk(a2&,px2&+10,py2&+5)
LineTo nx&,ny&
EndProc
Proc cp
MCopyBmp (ofx&-3),(ofy&-3)-6,6>ofx&-3,ofy&-3;0
SetPixel ofx&,ofy&,$888888
EndProc
Proc el:Ellipse (fx!-50),(fy!-50)-fx!+50,fy!+50:Rectangle (fx!-50),0-fx!+50,fy!:EndProc
Proc fi
Parameters a&,sp&,fx!,fy!
Declare x!,y!
Play 47;47;47,-1,0:Play 25;35;45,0,0:x!=ux&-ax&:y!=uy&-ay&:ofx&=-4:ofy&=-4:t&=0
UsePen 0,2,$447733:UseBrush 1,$ffffff:tr&=0
While 1
ti&=&gettickcount:cp():StartPaint -1:p0&=GetPixel(fx!,fy!):EndPaint
Ellipse (fx!-2),(fy!-2)-fx!+2,fy!+2:ofx&=fx!:ofy&=fy!
Case fx!>=640:BREAK
Case fx!<=0:BREAK
Case fy!>=480:BREAK
If ((fy!>0) And (p0&<>$ffaa44))
tr&=1
BREAK
EndIf
fx!=fx!+x!:fy!=fy!+y!:y!=y!+(0.01*(30-sp&))
While 1
Case &gettickcount-ti&>16:BREAK
EndWhile
EndWhile
If a&=a2&
ex&=fx!:ey&=fy!
EndIf
If tr&
Play 47;47;47;118;118;118,-1,0:Play 0;0;0;10;20;30,0,0:UsePen 0,2,$ffffff:UseBrush 1,$ffffff
el():Sleep 50:UsePen 0,2,$ffdd99:UseBrush 1,$ffdd99:Ellipse (fx!-35),(fy!-35)-fx!+35,fy!+35
Sleep 50:StartPaint -1:UsePen 0,2,$ffaa44:UseBrush 1,$ffaa44:el():While 1
Case ((GetPixel(px1&+10,py1&+12)=$42AE50) Or (py1&>480)):BREAK
Inc py1&:EndWhile:While 1
Case ((GetPixel(px2&+10,py2&+12)=$42AE50) Or (py2&>480)):BREAK
Inc py2&
EndWhile:EndPaint
EndIf
MCopyBmp 0,0-640,480>0,0;0:gl():gr()
EndProc:Proc Won
TextColor $225511,-1:t&=1:t$="":If py1&>=440
t$="Die CPU hat gewonnen!!"
ElseIf py2&>=440
t$="Du hast gewonnen!!"
EndIf:If t$<>""
WhileLoop 2:DrawText 8+t&,420+t&,t$:TextColor $66ffff,-1:t&=0
EndWhile:Play -1,0,0:Music "MSO7I79T180L8CCD<B>L16P16CL8DEEFEL16P16DL8CDC<B>MLL2C":WaitInput
EndIf:EndProc:While 1:a2&=80:s2&=15:gs():gl():gr():Usefont "Verdana",20,0,0,1,0:TextColor $225511,-1
If n&=0
t&=1:WhileLoop 2:DrawText 68+t&,380+t&,"Cursortasten Hoch/Runter:Schusswinkel einstellen"
DrawText 88+t&,400+t&,"Cursortasten Links/Rechts:Treibladung einstellen"
DrawText 108+t&,420+t&,"Leertaste:Schuss mit diesen Einstellungen abfeuern":TextColor $66ffff,-1:t&=0:EndWhile
EndIf:ShowWindow(%hwnd,1)
While 1:WaitInput:Case %key=2:BREAK
If n&=0
n&=1:MCopyBmp 0,0-640,480>0,0;0:gl():gr():ti():EndIf:If Iskey(40)
a1&=a1&+1
Case a1&>359:a1&=0
gl():ti():ElseIf Iskey(38)
a1&=a1&-1
Case a1&<0:a1&=359
gl():ti():ElseIf Iskey(37)
s&=s&-1:Case s&<=1:s&=1
ti():ElseIf Iskey(39)
s&=s&+1
Case s&>=24:s&=24
ti():ElseIf Iskey(32)
fi(a1&,s&,ux&,uy&):Won()
Case t$<>"":BREAK
Sleep 500:If ex&>px1&
s2&=s2&+((ex&-px1&)/30):Else
s2&=s2&-((px1&-ex&)/30):EndIf
Case s2&>24:s2&=24
ax&=px2&+10:ay&=py2&+5:ux&=nx&:uy&=ny&:fi(a2&,s2&,ux&,uy&):Won()
Case t$<>"":BREAK
EndIf:EndWhile:EndWhile
Alles anzeigen