4k - Artillerie 4k

    Diese Seite verwendet Cookies. Durch die Nutzung unserer Seite erklären Sie sich damit einverstanden, dass wir Cookies setzen. Weitere Informationen

    Unsere Datenschutzerklärung wurde aktualisiert. Mit der Nutzung unseres Forums akzeptierst Du unsere Datenschutzerklärung. Du bestätigst zudem, dass Du mindestens 16 Jahre alt bist.

    • 4k - Artillerie 4k

      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! :-)

      [Blockierte Grafik: http://s16.postimg.org/lk2ybtlrl/Screen_22_03_2013_21_Uhr_06_47_Sek.jpg]

      Download als ausführbare Datei, incl. ungekürztem Quellcode: Artillerie4k.zip

      Quellcode

      1. Declare x&,y&,px1&,py1&,px2&,py2&,w1&,w2&,nx&,ny&,a1&,a2&,t&,s&,n&,ux&,uy&
      2. Declare p0&,ofx&,ofy&,ax&,ay&,ti&,tr&,ex&,ey&,s2&,t$
      3. Randomize:WindowStyle 2074:WindowTitle "Artillerie 4k © 2013 Frabbing":Window 640,480
      4. a1&=120:s&=6
      5. Proc ti
      6. SetText %hwnd,"Artillerie 4k ‡ Schusswinkel: "+Str$(a1&)+"° ++ Treibladung: "+Str$(s&)+"00 g {Space}"
      7. EndProc
      8. Proc gk
      9. Parameters w!,xxx&,yyy&
      10. Declare x!,y!
      11. w!=(Pi()/180)*(w!+180):nx&=xxx&+(Cos(w!)*16):ny&=yyy&+(Sin(w!)*10)
      12. EndProc
      13. Proc gs
      14. MCls 640,480,$ffaa44:StartPaint -1:y&=Rnd(220)+200:x&=y&:UsePen 1,3,$559944:Line 0,y&-0,y&
      15. WhileLoop 0,680,Rnd(20)+8
      16. LineTo &loop-1,y&:y&=y&+(Rnd(31)-15)
      17. If &loop<310
      18. y&=y&-Rnd(20)
      19. Else
      20. y&=y&+Rnd(20)
      21. EndIf
      22. Case y&>400:y&=y&-Rnd(15)
      23. Case y&<80:y&=y&+Rnd(15)
      24. EndWhile
      25. UseBrush 1,$42AE50:Fill 0,479,$559944:px1&=Rnd(100):py1&=0:px2&=Rnd(100)+500:py2&=0
      26. While 1
      27. Case GetPixel(px1&+10,py1&+12)=$42AE50:BREAK
      28. Inc py1&
      29. EndWhile
      30. While 1
      31. Case GetPixel(px2&+10,py2&+12)=$42AE50:BREAK
      32. Inc py2&
      33. EndWhile
      34. EndPaint:MCopyBmp 0,0-640,480>0,0;0
      35. EndProc
      36. Proc gl
      37. UsePen 0,2,$447733:UseBrush 1,$ee0000:MCopyBmp px1&-8,(py1&-6)-36,24>px1&-8,py1&-6;0
      38. RoundRect px1&,py1&-px1&+20,py1&+12;6,4
      39. ax&=px1&+10:ay&=py1&+5
      40. Line ax&,ay&-ax&,ay&
      41. gk(a1&,px1&+10,py1&+5)
      42. LineTo nx&,ny&
      43. ux&=nx&:uy&=ny&
      44. EndProc
      45. Proc gr
      46. UsePen 0,2,$447733
      47. UseBrush 1,$0088ff
      48. MCopyBmp px2&-8,(py2&-6)-36,24>px2&-8,py2&-6;0
      49. RoundRect px2&,py2&-px2&+20,py2&+12;6,4
      50. Line px2&+10,py2&+5-px2&+10,py2&+5
      51. gk(a2&,px2&+10,py2&+5)
      52. LineTo nx&,ny&
      53. EndProc
      54. Proc cp
      55. MCopyBmp (ofx&-3),(ofy&-3)-6,6>ofx&-3,ofy&-3;0
      56. SetPixel ofx&,ofy&,$888888
      57. EndProc
      58. Proc el:Ellipse (fx!-50),(fy!-50)-fx!+50,fy!+50:Rectangle (fx!-50),0-fx!+50,fy!:EndProc
      59. Proc fi
      60. Parameters a&,sp&,fx!,fy!
      61. Declare x!,y!
      62. Play 47;47;47,-1,0:Play 25;35;45,0,0:x!=ux&-ax&:y!=uy&-ay&:ofx&=-4:ofy&=-4:t&=0
      63. UsePen 0,2,$447733:UseBrush 1,$ffffff:tr&=0
      64. While 1
      65. ti&=&gettickcount:cp():StartPaint -1:p0&=GetPixel(fx!,fy!):EndPaint
      66. Ellipse (fx!-2),(fy!-2)-fx!+2,fy!+2:ofx&=fx!:ofy&=fy!
      67. Case fx!>=640:BREAK
      68. Case fx!<=0:BREAK
      69. Case fy!>=480:BREAK
      70. If ((fy!>0) And (p0&<>$ffaa44))
      71. tr&=1
      72. BREAK
      73. EndIf
      74. fx!=fx!+x!:fy!=fy!+y!:y!=y!+(0.01*(30-sp&))
      75. While 1
      76. Case &gettickcount-ti&>16:BREAK
      77. EndWhile
      78. EndWhile
      79. If a&=a2&
      80. ex&=fx!:ey&=fy!
      81. EndIf
      82. If tr&
      83. 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
      84. el():Sleep 50:UsePen 0,2,$ffdd99:UseBrush 1,$ffdd99:Ellipse (fx!-35),(fy!-35)-fx!+35,fy!+35
      85. Sleep 50:StartPaint -1:UsePen 0,2,$ffaa44:UseBrush 1,$ffaa44:el():While 1
      86. Case ((GetPixel(px1&+10,py1&+12)=$42AE50) Or (py1&>480)):BREAK
      87. Inc py1&:EndWhile:While 1
      88. Case ((GetPixel(px2&+10,py2&+12)=$42AE50) Or (py2&>480)):BREAK
      89. Inc py2&
      90. EndWhile:EndPaint
      91. EndIf
      92. MCopyBmp 0,0-640,480>0,0;0:gl():gr()
      93. EndProc:Proc Won
      94. TextColor $225511,-1:t&=1:t$="":If py1&>=440
      95. t$="Die CPU hat gewonnen!!"
      96. ElseIf py2&>=440
      97. t$="Du hast gewonnen!!"
      98. EndIf:If t$<>""
      99. WhileLoop 2:DrawText 8+t&,420+t&,t$:TextColor $66ffff,-1:t&=0
      100. EndWhile:Play -1,0,0:Music "MSO7I79T180L8CCD<B>L16P16CL8DEEFEL16P16DL8CDC<B>MLL2C":WaitInput
      101. EndIf:EndProc:While 1:a2&=80:s2&=15:gs():gl():gr():Usefont "Verdana",20,0,0,1,0:TextColor $225511,-1
      102. If n&=0
      103. t&=1:WhileLoop 2:DrawText 68+t&,380+t&,"Cursortasten Hoch/Runter:Schusswinkel einstellen"
      104. DrawText 88+t&,400+t&,"Cursortasten Links/Rechts:Treibladung einstellen"
      105. DrawText 108+t&,420+t&,"Leertaste:Schuss mit diesen Einstellungen abfeuern":TextColor $66ffff,-1:t&=0:EndWhile
      106. EndIf:ShowWindow(%hwnd,1)
      107. While 1:WaitInput:Case %key=2:BREAK
      108. If n&=0
      109. n&=1:MCopyBmp 0,0-640,480>0,0;0:gl():gr():ti():EndIf:If Iskey(40)
      110. a1&=a1&+1
      111. Case a1&>359:a1&=0
      112. gl():ti():ElseIf Iskey(38)
      113. a1&=a1&-1
      114. Case a1&<0:a1&=359
      115. gl():ti():ElseIf Iskey(37)
      116. s&=s&-1:Case s&<=1:s&=1
      117. ti():ElseIf Iskey(39)
      118. s&=s&+1
      119. Case s&>=24:s&=24
      120. ti():ElseIf Iskey(32)
      121. fi(a1&,s&,ux&,uy&):Won()
      122. Case t$<>"":BREAK
      123. Sleep 500:If ex&>px1&
      124. s2&=s2&+((ex&-px1&)/30):Else
      125. s2&=s2&-((px1&-ex&)/30):EndIf
      126. Case s2&>24:s2&=24
      127. ax&=px2&+10:ay&=py2&+5:ux&=nx&:uy&=ny&:fi(a2&,s2&,ux&,uy&):Won()
      128. Case t$<>"":BREAK
      129. EndIf:EndWhile:EndWhile
      Alles anzeigen
      Gruß, Frank
    • Na das glaub ich ja nicht. :-)
      Für eine in allen Situationen clevere CPU hatte ich leider keinen Platz mehr, da mußte ich Abstriche machen. Zumindest kann sie oft mithalten. Diese Zeilen stellen die gesamte KI dar, sie lernt aus Fehlschüssen und reagiert darauf:

      If ex&>px1&
      s2&=s2&+((ex&-px1&)/25)
      Else
      s2&=s2&-((px1&-ex&)/25)
      EndIf


      Kernstück des Codes ist die Landschaftsgenerierung, daraus ist das Spiel letzte Tage erst entstanden. Da hatte ich mir in den Kopf gesetzt, immer einen verschiedenartigen Hügel darzustellen. :-)
      Gruß, Frank
    • Hi Frank, du bist schuld, daß ich jetzt 'n steifen Nacken hab :-D - macht wirklich Spaß. Meine SiegQuote ist ca. 45:55(CPU), aber auch erst, wenn man sich ein wenig eingeschossen hat. Du solltest eine (offline) MiniGame-Serie rausbringen...;)

      Edit: vllt. kannste ja noch die Treibladung limitieren, dann ist Spieler gezwungen, mehr mit dem Schußwinkel zu arbeiten... (ja ich weiß, schlau reden kann jeder ;-))
      Gruß Jörg

      Ideen gibt es viele - man muß sie nur haben...
      Win7-Pro / Linux Mint