مرحباً بك في إجابة - موسوعة الأسئلة والإجابات الحرة
اطرح سؤالاً:


لعبة Kamikaze Aliens VIII لغة كيوبيسك

من إجابة
اذهب إلى: تصفح, البحث
Question red.png

سـؤال

أريد مصدر برنامج لعبة Kamikaze Aliens VIII بلغة QBASIC.

محتويات

[عدل]

رد

ما يلي الشفرة المصدرية بلغة كيوبيسك للعبة الغرباء (تنزيل).

DECLARE SUB playsong (n AS INTEGER)
DECLARE SUB moveenm ()
DECLARE SUB movelift ()
DECLARE SUB sfx (freq AS INTEGER)
DECLARE SUB intro ()
DECLARE SUB loadfont ()
DECLARE SUB jprint (xl AS INTEGER, yl AS INTEGER, mess AS STRING, zoom AS INTEGER, col AS INTEGER)
DECLARE SUB border (bsz AS INTEGER)
DECLARE SUB clearkey (nk AS STRING)
DECLARE SUB colscroll ()
DECLARE SUB stars ()
DECLARE SUB putgrd (x AS INTEGER, y AS INTEGER, nr AS INTEGER)
DECLARE SUB makepal ()
DECLARE SUB putobj (x AS INTEGER, y AS INTEGER, nr AS INTEGER)
DECLARE SUB init ()
DECLARE SUB mplr ()
DECLARE SUB drawall ()
DECLARE SUB mcam ()
DECLARE FUNCTION checklift% (x AS INTEGER, y AS INTEGER)
DECLARE FUNCTION buf% (x AS INTEGER, y AS INTEGER, nr0 AS INTEGER, nr1 AS INTEGER)
 
CONST root = "" ' c:\main\sprache\qb45\kalviii\
CONST limx = 320, limy = 200
CONST size = 20
CONST viewx = 4, viewy = 4
CONST fieldx = 200, fieldy = viewy * 2
CONST midx = limx / 2 - size / 2, midy = limy / 2 - size / 2
CONST wave = 9
CONST psize = 2000 ' 4 + INT(((size + 1) * 8 + 7) / 8) * (size + 1)
CONST lettersz = 7
 
TYPE sprite
 x AS INTEGER
 y AS INTEGER
 sx AS INTEGER
 sy AS INTEGER
 nrg AS INTEGER
END TYPE
 
DIM plr AS sprite, cam AS sprite
DIM map(fieldx, fieldy) AS INTEGER, obj(fieldx, fieldy) AS INTEGER
DIM enmnr AS INTEGER, liftnr AS INTEGER, termnr AS INTEGER
DIM lift(9) AS sprite, enm(9) AS sprite
 
init
SCREEN 13
COLOR 4
makepal
intro
playsong 1
CLS
border 5
 
DO
 
 mplr
 mcam
 stars
 colscroll
 movelift
 moveenm
 drawall
 
LOOP
 
SUB border (bsz AS INTEGER)
 
LINE (midx - viewx * size - bsz, midy - viewy * size - bsz)-(midx + (viewx + 1) * size + bsz, midy + (viewy + 1) * size + bsz), 200, B
 
END SUB
 
FUNCTION buf% (x AS INTEGER, y AS INTEGER, nr0 AS INTEGER, nr1 AS INTEGER) STATIC
 
DIM pic(-viewx TO viewx, -viewy TO viewy, 1) AS INTEGER
 
IF pic(x, y, 0) = nr0 AND pic(x, y, 1) = nr1 THEN
 buf% = 0
ELSE
 pic(x, y, 0) = nr0
 pic(x, y, 1) = nr1
 buf% = 1
END IF
 
END FUNCTION
 
FUNCTION checklift% (x AS INTEGER, y AS INTEGER)
 
DIM nr AS INTEGER, value AS INTEGER
SHARED lift() AS sprite
 
FOR nr = 0 TO 9
 IF lift(nr).x = x AND lift(nr).y = y THEN
  value = 1
  EXIT FOR
 END IF
NEXT
 
checklift% = value
 
END FUNCTION
 
SUB clearkey (nk AS STRING)
 
STATIC lk AS STRING
DIM dummy AS STRING
DIM nr AS INTEGER
 
IF nk = lk THEN
 FOR nr = 1 TO 3
  dummy = INKEY$
 NEXT
END IF
 
lk = nk
 
END SUB
 
SUB colscroll
 
STATIC counter AS INTEGER
STATIC coln AS INTEGER
 
IF counter = 30 THEN
 counter = 0
 coln = coln + 3
 IF coln > 63 THEN
  coln = -63
 END IF
 PALETTE 3, 65536 * ABS(coln) + 256 * ABS(coln)
ELSE
 counter = counter + 1
END IF
 
END SUB
 
SUB drawall
 
DIM nx AS INTEGER, ny AS INTEGER
DIM xx AS INTEGER, yy AS INTEGER
SHARED cam AS sprite
SHARED map() AS INTEGER
SHARED obj() AS INTEGER
 
FOR nx = cam.x - viewx TO cam.x + viewx
 FOR ny = cam.y - viewy TO cam.y + viewy
 
   IF buf%(nx - cam.x, ny - cam.y, map(nx, ny), obj(nx, ny)) THEN
 
    xx = midx + (nx - cam.x) * (size + 1)
    yy = midy + (ny - cam.y) * (size + 1)
 
    IF map(nx, ny) = -1 THEN
     LINE (xx, yy)-STEP(size, size), 2, BF
    ELSEIF map(nx, ny) > 0 THEN
     putgrd xx, yy, map(nx, ny)
    END IF
 
    IF obj(nx, ny) > 0 THEN putobj xx, yy, obj(nx, ny)
 
   END IF
 
 NEXT
NEXT
 
END SUB
 
SUB init
 
DIM nx AS INTEGER, ny AS INTEGER, ln AS INTEGER, nr AS INTEGER
SHARED liftnr AS INTEGER
SHARED enmnr AS INTEGER
SHARED termnr AS INTEGER
SHARED map() AS INTEGER
SHARED obj() AS INTEGER
SHARED cam AS sprite
SHARED plr AS sprite
SHARED lift() AS sprite
SHARED enm() AS sprite
 
OPEN root + "1.pln" FOR INPUT AS #1
OPEN root + "1.obj" FOR INPUT AS #2
 
 FOR nx = 0 TO fieldx
  FOR ny = 0 TO fieldy
   INPUT #1, map(nx, ny)
   INPUT #2, obj(nx, ny)
   IF map(nx, ny) = 0 THEN map(nx, ny) = -1
 
   SELECT CASE obj(nx, ny)
    CASE 1, 2
     plr.x = nx
     plr.y = ny
     plr.nrg = 10
 
    CASE 3
     lift(liftnr).sy = 1
     lift(liftnr).x = nx
     lift(liftnr).y = ny
     liftnr = liftnr + 1
 
    CASE 7
     termnr = termnr + 1
 
    CASE 9, 10
     enm(enmnr).sx = 1
     enm(enmnr).x = nx
     enm(enmnr).y = ny
     enmnr = enmnr + 1
 
   END SELECT
 
  NEXT
 NEXT
 
CLOSE #1
CLOSE #2
 
liftnr = liftnr - 1
enmnr = enmnr - 1
 
cam.x = plr.x + 2
cam.y = plr.y - 1
 
END SUB
 
SUB intro
 
DIM nx AS INTEGER, ny AS INTEGER, nn AS INTEGER
 
OPEN root + "2.spr" FOR INPUT AS #1
 FOR nx = 0 TO size
  FOR ny = 0 TO size
   INPUT #1, nn
   LINE (nx * 8, ny * 8)-STEP(8 - 1, 8 - 1), nn, BF
  NEXT
 NEXT
CLOSE #1
 
jprint 6, 8, "jester presents", 1, 18
jprint 1, 3, "kamikaze", 3, 22
jprint 1, 4, "aliens", 3, 23
jprint 2, 8, "-part viii-", 2, 16
 
END SUB
 
SUB jprint (xl AS INTEGER, yl AS INTEGER, mess AS STRING, zoom AS INTEGER, col AS INTEGER)
 
DIM x AS INTEGER, y AS INTEGER, letter AS INTEGER
 
FOR letter = 1 TO LEN(mess)
 
 LOCATE 1, 1
 PRINT UCASE$(MID$(mess, letter, 1))
 
 FOR x = 0 TO lettersz
  FOR y = 0 TO lettersz
   IF POINT(x, y) THEN
    LINE ((xl + letter) * (zoom * (lettersz + 1)) + x * zoom, yl * (zoom * (lettersz + 1)) + y * zoom)-STEP(zoom - 1, zoom - 1), col * wave + y / 2 + 1, BF
   END IF
  NEXT
 NEXT
 
NEXT
 
END SUB
 
SUB makepal
 
DIM nr AS INTEGER
DIM n AS INTEGER
DIM bl AS INTEGER, gr AS INTEGER, rd AS INTEGER
 
PALETTE 1, 2 ^ 16 * 63 + 2 ^ 8 * 63 + 63
PALETTE 2, 0
PALETTE 4, 0
 
n = wave / 2
FOR c1 = 0 TO 2
 FOR c2 = 0 TO 2
  FOR c3 = 0 TO 2
   FOR atbnr = 1 TO wave
    n = n + 1
    bl = (atbnr / (wave / (63 / 2))) * c1
    gr = (atbnr / (wave / (63 / 2))) * c2
    rd = (atbnr / (wave / (63 / 2))) * c3
    PALETTE n, 65536 * bl + 256 * gr + rd
   NEXT
  NEXT
 NEXT
NEXT
 
END SUB
 
SUB mcam
 
SHARED cam AS sprite
SHARED plr AS sprite
 
IF plr.x > cam.x + viewx / 2 AND cam.x + viewx / 2 < fieldx THEN
 cam.sx = 1
ELSEIF plr.x < cam.x - viewx / 2 AND cam.x - viewx / 2 > 0 THEN
 cam.sx = -1
END IF
 
cam.x = cam.x + cam.sx
 
IF cam.x + viewx > fieldx THEN
 cam.x = fieldx - viewx
ELSEIF cam.x - viewx < 0 THEN
 cam.x = viewx
END IF
 
cam.sx = 0
 
END SUB
 
SUB moveenm
 
SHARED obj() AS INTEGER
SHARED enmnr AS INTEGER
SHARED enm() AS sprite
SHARED plr AS sprite
STATIC nr AS INTEGER
 
nr = nr + 1
IF nr > enmnr THEN nr = 0
 
obj(enm(nr).x, enm(nr).y) = 0
 
IF enm(nr).x + enm(nr).sx <= 1 OR enm(nr).x + enm(nr).sx >= fieldx - 1 THEN
 enm(nr).sx = enm(nr).sx * -1
ELSEIF obj(enm(nr).x + enm(nr).sx, enm(nr).y) > 2 THEN
 enm(nr).sx = enm(nr).sx * -1
ELSEIF obj(enm(nr).x + enm(nr).sx, enm(nr).y) = 1 OR obj(enm(nr).x + enm(nr).sx, enm(nr).y) = 2 THEN
 enm(nr).x = enm(nr).x + enm(nr).sx * -1
 plr.nrg = plr.nrg - 1
 sfx INT(RND * 3) + 3
END IF
 
IF RND * 20 < 2 THEN enm(nr).x = enm(nr).x + enm(nr).sx
 
IF enm(nr).sx = -1 THEN
 obj(enm(nr).x, enm(nr).y) = 9
ELSE
 obj(enm(nr).x, enm(nr).y) = 10
END IF
 
END SUB
 
SUB movelift
 
SHARED obj() AS INTEGER
SHARED liftnr AS INTEGER
SHARED lift() AS sprite
STATIC nr AS INTEGER
STATIC counter AS INTEGER
 
nr = nr + 1
IF nr > liftnr THEN nr = 0
 
obj(lift(nr).x, lift(nr).y) = 0
 
IF counter = 20 THEN
 counter = 0
 
 IF obj(lift(nr).x + lift(nr).sx, lift(nr).y + lift(nr).sy) = 0 THEN
  IF lift(nr).y + lift(nr).sy = 0 OR lift(nr).y + lift(nr).sy = fieldy THEN
   lift(nr).sy = lift(nr).sy * -1
  END IF
 ELSE
  lift(nr).sy = lift(nr).sy * -1
 END IF
 lift(nr).y = lift(nr).y + lift(nr).sy
 
ELSE
 counter = counter + 1
END IF
 
obj(lift(nr).x, lift(nr).y) = 3
 
END SUB
 
SUB mplr
 
STATIC direct AS INTEGER
STATIC jump AS INTEGER
STATIC grav AS INTEGER
SHARED termnr AS INTEGER
SHARED plr AS sprite
SHARED obj() AS INTEGER
DIM newkey AS STRING
 
IF direct = 0 THEN direct = 2
 
newkey = INKEY$
clearkey newkey
 
SELECT CASE newkey
 CASE CHR$(0) + "M"
  IF direct = 2 THEN
   plr.sx = plr.sx + 1
  ELSE
   direct = 2
  END IF
 
 CASE CHR$(0) + "K"
  IF direct = 1 THEN
   plr.sx = plr.sx - 1
  ELSE
   direct = 1
  END IF
 
 CASE CHR$(0) + "H"
  IF plr.y < fieldy THEN
   IF obj(plr.x, plr.y + 1) = 8 THEN
    jump = 7
    sfx 5
   ELSEIF obj(plr.x, plr.y + 1) <> 0 THEN
    jump = 4
    sfx 2
   END IF
  ELSE
   jump = 4
   sfx 2
  END IF
 
 CASE CHR$(27)
  plr.nrg = 0
 
END SELECT
 
IF grav = 40 THEN
 grav = 0
 plr.sy = 1
ELSE
 grav = grav + 1
END IF
 
IF jump > 0 THEN
 jump = jump - 1
 plr.sy = -1
END IF
 
obj(plr.x, plr.y) = 0
 
IF plr.x + plr.sx < 0 OR plr.x + plr.sx > fieldx OR plr.y + plr.sy < 0 OR plr.y + plr.sy > fieldy THEN
 plr.sx = 0
 plr.sy = 0
END IF
 
SELECT CASE obj(plr.x + plr.sx, plr.y + plr.sy)
 CASE 3
  IF checklift%(plr.x + plr.sx, plr.y + plr.sy) THEN plr.y = plr.y - 1
 
 CASE 4
  IF RND * 20 < 4 AND plr.y + plr.sy * 2 <= fieldy AND plr.y + plr.sy * 2 >= 0 THEN
   IF plr.sx = 0 AND obj(plr.x, plr.y + plr.sy * 2) = 0 THEN
    SWAP obj(plr.x, plr.y + plr.sy), obj(plr.x, plr.y + plr.sy * 2)
   ELSEIF plr.sx = 0 AND obj(plr.x, plr.y + plr.sy * 2) = 6 THEN
    obj(plr.x, plr.y + plr.sy) = 0
   END IF
  END IF
 
 CASE 6
  IF plr.sy = 1 THEN
   plr.sy = -1
   plr.nrg = plr.nrg - 1
   sfx 4
  END IF
 
 CASE 7
  obj(plr.x + plr.sx, plr.y + plr.sy) = 0
  sfx 3
  termnr = termnr - 1
  IF termnr = 0 THEN
   sfx 4
   jprint 5, 6, "well done", 2, 22
   SLEEP 5
   END
  END IF
 
 CASE 9, 10
  plr.nrg = plr.nrg - 1
  sfx 5
 
END SELECT
 
IF obj(plr.x + plr.sx, plr.y + plr.sy) <= 0 THEN
 plr.x = plr.x + plr.sx
 plr.y = plr.y + plr.sy
END IF
 
obj(plr.x, plr.y) = direct
 
plr.sx = 0
plr.sy = 0
 
IF plr.nrg = 0 THEN
 sfx 5
 jprint 5, 6, "game over", 2, 22
 SLEEP 5
 END
END IF
 
END SUB
 
SUB playsong (n AS INTEGER)
 
DIM nr AS INTEGER, w AS INTEGER, freq AS INTEGER, tonemax AS INTEGER
 
OPEN root + RTRIM$(LTRIM$(STR$(n))) + ".sng" FOR INPUT AS #1
 INPUT #1, tonemax
 DIM tone(tonemax) AS INTEGER
 
 FOR nr = 0 TO tonemax - 1
  INPUT #1, tone(nr)
 NEXT
CLOSE #1
 
DO
 FOR nr = 0 TO tonemax - 1
  FOR w = 1 TO 3
   FOR freq = -20 TO 20
    SOUND tone(nr) - ABS(freq) + RND * 5, .03
   NEXT
  NEXT
 IF INKEY$ <> "" THEN EXIT DO
 NEXT
LOOP
 
END SUB
 
SUB putgrd (x AS INTEGER, y AS INTEGER, nr AS INTEGER) STATIC
 
DIM pic1(psize) AS INTEGER
DIM pic2(psize) AS INTEGER
DIM pic3(psize) AS INTEGER
DIM pic4(psize) AS INTEGER
DIM pic5(psize) AS INTEGER
DIM pic6(psize) AS INTEGER
DIM pic7(psize) AS INTEGER
DIM pic8(psize) AS INTEGER
DIM pic9(psize) AS INTEGER
DIM picmem(9) AS INTEGER
 
IF picmem(nr) = 0 THEN
 SELECT CASE nr
  CASE 1: DEF SEG = VARSEG(pic1(0)): BLOAD root + "1.GRD", VARPTR(pic1(0))
  CASE 2: DEF SEG = VARSEG(pic2(0)): BLOAD root + "2.GRD", VARPTR(pic2(0))
  CASE 3: DEF SEG = VARSEG(pic3(0)): BLOAD root + "3.GRD", VARPTR(pic3(0))
  CASE 4: DEF SEG = VARSEG(pic4(0)): BLOAD root + "4.GRD", VARPTR(pic4(0))
  CASE 5: DEF SEG = VARSEG(pic5(0)): BLOAD root + "5.GRD", VARPTR(pic5(0))
  CASE 6: DEF SEG = VARSEG(pic6(0)): BLOAD root + "6.GRD", VARPTR(pic6(0))
  CASE 7: DEF SEG = VARSEG(pic7(0)): BLOAD root + "7.GRD", VARPTR(pic7(0))
  CASE 8: DEF SEG = VARSEG(pic8(0)): BLOAD root + "8.GRD", VARPTR(pic8(0))
  CASE 9: DEF SEG = VARSEG(pic9(0)): BLOAD root + "9.GRD", VARPTR(pic9(0))
 END SELECT
 DEF SEG
END IF
 
SELECT CASE nr
 CASE 1: PUT (x, y), pic1, PSET
 CASE 2: PUT (x, y), pic2, PSET
 CASE 3: PUT (x, y), pic3, PSET
 CASE 4: PUT (x, y), pic4, PSET
 CASE 5: PUT (x, y), pic5, PSET
 CASE 6: PUT (x, y), pic6, PSET
 CASE 7: PUT (x, y), pic7, PSET
 CASE 8: PUT (x, y), pic8, PSET
 CASE 9: PUT (x, y), pic9, PSET
END SELECT
 
END SUB
 
SUB putobj (x AS INTEGER, y AS INTEGER, nr AS INTEGER) STATIC
 
DIM nx AS INTEGER, ny AS INTEGER
DIM pic(10, size, size) AS INTEGER
DIM picmem(10) AS INTEGER
 
IF picmem(nr) = 0 THEN
 picmem(nr) = 1
 
 OPEN root + RTRIM$(LTRIM$(STR$(nr))) + ".spr" FOR INPUT AS #1
  FOR nx = 0 TO size
   FOR ny = 0 TO size
    INPUT #1, pic(nr, nx, ny)
   NEXT
  NEXT
 CLOSE #1
 
END IF
 
FOR nx = 0 TO size
 FOR ny = 0 TO size
  IF pic(nr, nx, ny) > 0 THEN PSET (x + nx, y + ny), pic(nr, nx, ny)
 NEXT
NEXT
 
END SUB
 
SUB sfx (freq AS INTEGER)
 
DIM n AS INTEGER
 
FOR n = -20 TO 20 STEP 2
 SOUND 150 + freq * 100 + ABS(n), .03
NEXT
 
END SUB
 
SUB stars STATIC
 
STATIC nr AS INTEGER
DIM star(40) AS sprite
 
IF nr < UBOUND(star) THEN
 nr = nr + 1
ELSE
 nr = 0
END IF
 
IF star(nr).nrg = 0 THEN
 star(nr).x = RND * limx
 star(nr).y = RND * limy
 star(nr).sx = INT(nr / 5) + 1
 star(nr).sy = 0
 star(nr).nrg = 1
ELSE
 
 IF POINT(star(nr).x, star(nr).y) = 1 THEN
  PSET (star(nr).x, star(nr).y), 2
 END IF
 
 IF star(nr).x > midx + size + viewx * size THEN
  star(nr).nrg = 0
 END IF
 star(nr).x = star(nr).x + star(nr).sx
 star(nr).y = star(nr).y + star(nr).sy
 IF POINT(star(nr).x, star(nr).y) = 2 AND star(nr).nrg > 0 THEN
  PSET (star(nr).x, star(nr).y), 1
 END IF
 
END IF
 
END SUB

[عدل] أسئلة ذات صلة

قد ترغب أيضاً التعرف على

[عدل] أسئلة متنوعة

[عدل] برمجة

  • برمجة حل المعادلات الخطية
  • الأمر T في تطبيق Debug
  • لعبة الشواش Adventures of Joe Trilogy لغة كيوبيسك
  • الأمر F في تطبيق Debug
  • لعبة Pipeline لغة كيوبيسك
  • كيف يمكن برمجة مصفوفة عشوائياً بلغة جافا سكربت
  • الأمر D في تطبيق Debug
  • الأمر M في تطبيق Debug
  • ادراج عدة صور عن طريق الكود بلغة فيجوال بيسك
  • لعبة Kamikaze Aliens VIII لغة كيوبيسك
  • [عدل] حاسوب

  • ما هي شاشة الموت الزرقاء (BSoD)؟
  • الأمر XD في تطبيق Debug
  • كيفية برمجة آلة حاسبة
  • برمجة السمبلكس بلغة سي
  • لعبة الشواش Adventures of Joe Trilogy لغة كيوبيسك
  • ماهو برتوكول DHCP؟
  • استعادة سجل الإقلاع الرئيسي MBR في ويندوز 7
  • الأمر L في تطبيق Debug
  • برمجة دالة بسل
  • ما هو الملف thumbs.db ؟
  • [عدل] علوم

  • ماذا لو انعكس دوران الأرض حول محورها
  • ماهو نظام الاطفاء التلقائي للحريق FM200 ؟
  • من هو جابر بن حيان
  • لعبة Kamikaze Aliens VIII لغة كيوبيسك
  • أيهما أسرع الضوء أوتخيل الشي؟
  • نصف قطر الأرض الفعّال
  • كيف يمكن برمجة مصفوفة عشوائياً بلغة جافا سكربت
  • قياس جاذبية الأرض بواسطة البندول البسيط
  • كيف يعمل برج التقطير
  • ما مفهوم الدالة في حياتنا اليومية ؟
  • أدوات شخصية

    المتغيرات
    النطاقات
    أفعال
    إبحار
    أسئلة وإجابات
    مجالات علمية
    مجالات ثقافية وترفيه
    صندوق الأدوات
    برامج تحتاجها