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


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

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

سـؤال

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

[عدل]

رد

<image src="http://qbasic.parkdalien.com/homes/qb/QBGamesDirectory/K/kamikazea8.gif" dir="ltr" width="640" height="480" /> ما يلي الشفرة المصدرية بلغة كيوبيسك للعبة الغرباء (تنزيل).

<source lang="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

</source>

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

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

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

برمجة[عدل]

<DynamicPageList> category = برمجة countR = 10 order = decending </DynamicPageList>

حاسوب[عدل]

<DynamicPageList> category = حاسوب countR = 10 order = decending </DynamicPageList>

علوم[عدل]

<DynamicPageList> category = علوم countR = 10 order = decending </DynamicPageList>