Minggu, 06 November 2011

membuat game sederhana

copy paste rumus berikut ke QBASIC.exe,lalu tekan f5


DECLARE SUB checkField (fields() AS INTEGER, py%, points%, bonus%)
DECLARE SUB main ()
DECLARE SUB drawBox (x%, y%, col%)
DECLARE SUB buildField (fields() AS INTEGER)
DECLARE SUB freq (n1%, n2%, n3%)
DECLARE SUB putObject (fields() AS INTEGER, object() AS INTEGER, px%, py%, n%, rot%)
DECLARE SUB clearObject (fields() AS INTEGER, object() AS INTEGER, px%, py%, n%, rot%)
DECLARE SUB getObject (object() AS INTEGER)
DECLARE FUNCTION checkObject% (fields() AS INTEGER, object() AS INTEGER, px%, py%, n%, rot%)

CONST false = 0, true = NOT false

TYPE brickType
  x AS INTEGER
  y AS INTEGER
  sx AS INTEGER
  sy AS INTEGER
  n AS INTEGER
  rot AS INTEGER
  nrg AS INTEGER
END TYPE

RANDOMIZE TIMER
SCREEN 13
COLOR 7
main
END

bricks:
  DATA 0,0,0,0
  DATA 1,1,0,0
  DATA 0,1,1,0
  DATA 0,0,0,0

  DATA 0,0,0,0
  DATA 0,1,1,0
  DATA 1,1,0,0
  DATA 0,0,0,0

  DATA 0,0,0,0
  DATA 1,0,0,0
  DATA 1,1,1,0
  DATA 0,0,0,0

  DATA 0,0,0,0
  DATA 1,1,1,0
  DATA 1,0,0,0
  DATA 0,0,0,0

  DATA 0,0,0,0
  DATA 0,1,1,0
  DATA 0,1,1,0
  DATA 0,0,0,0

  DATA 0,0,0,0
  DATA 1,1,1,1
  DATA 0,0,0,0
  DATA 0,0,0,0

  DATA 0,0,0,0
  DATA 1,1,1,0
  DATA 0,1,0,0
  DATA 0,0,0,0

SUB buildField (fields() AS INTEGER)

  FOR n% = 0 TO 500
    PSET (RND * 320, RND * 200), 8 - RND * 1
  NEXT
  LOCATE 1, 1: PRINT "Points 0"
  LOCATE 1, 33: PRINT "Level 0"
  FOR x% = 0 TO UBOUND(fields, 1)
    FOR y% = 0 TO UBOUND(fields, 2)
      IF x% = 0 OR y% = 0 OR x% = UBOUND(fields, 1) OR y% = UBOUND(fields, 2) THEN
        fields(x%, y%) = true
        drawBox px% + x%, py% + y%, 9
      ELSE
        'fields(x%, y%) = false
        drawBox px% + x%, py% + y%, 1
      END IF
    NEXT
  NEXT

END SUB

SUB checkField (fields() AS INTEGER, py%, points%, bonus%)

  FOR y% = py% TO py% + 3
    IF y% >= UBOUND(fields, 2) THEN EXIT FOR
    full% = true
    FOR x% = 1 TO UBOUND(fields, 1) - 1
      IF NOT fields(x%, y%) THEN
        full% = false%
        EXIT FOR '###
      END IF
    NEXT
    IF full% = true THEN
      lines% = lines% + 1
      FOR ny% = y% TO 2 STEP -1
        FOR nx% = 1 TO UBOUND(fields, 1) - 1
          fields(nx%, ny%) = fields(nx%, ny% - 1)
          IF fields(nx%, ny%) THEN
            drawBox nx%, ny%, 11
          ELSE
            drawBox nx%, ny%, 1
          END IF
        NEXT
      NEXT
    END IF
  NEXT
  IF lines% > 0 THEN
    freq 100, lines% * 500, 10
    points% = points% + ((lines% ^ 2) * 10) * bonus%
    LOCATE 1, 7: PRINT points%
  ELSE
    freq 800, 600, -50
  END IF

END SUB

FUNCTION checkObject% (fields() AS INTEGER, object() AS INTEGER, px%, py%, n%, rot%)

  checkObject% = true
  FOR x% = 0 TO UBOUND(object, 3)
    FOR y% = 0 TO UBOUND(object, 4)
      IF object(n%, rot%, x%, y%) THEN
        IF fields(px% + x%, py% + y%) THEN checkObject% = false
      END IF
    NEXT
  NEXT

END FUNCTION

SUB clearObject (fields() AS INTEGER, object() AS INTEGER, px%, py%, n%, rot%)

  FOR x% = 0 TO UBOUND(object, 3)
    FOR y% = 0 TO UBOUND(object, 4)
      IF object(n%, rot%, x%, y%) THEN
        drawBox px% + x%, py% + y%, 1
        fields(px% + x%, py% + y%) = false
      END IF
    NEXT
  NEXT

END SUB

SUB drawBox (x%, y%, col%)

  CONST fieldSize = 8 '6
  LINE (100 + x% * fieldSize + 1, 10 + y% * fieldSize + 1)-STEP(fieldSize - 1, fieldSize - 1), col%, BF

END SUB

SUB freq (n1%, n2%, n3%)

  STATIC sfx%
  IF n1% = 0 THEN
    sfx% = NOT sfx%
  ELSEIF sfx% THEN
    FOR n% = n1% TO n2% STEP n3%
      SOUND n%, .03
    NEXT
  END IF

END SUB

SUB getObject (object() AS INTEGER)

  'RESTORE bricks '###
  FOR n% = 0 TO UBOUND(object, 1)
    FOR y% = 0 TO UBOUND(object, 4)
      FOR x% = 0 TO UBOUND(object, 3)
        READ d%
        IF d% = 1 THEN
          object(n%, 0, x%, y%) = true
        ELSE
          object(n%, 0, x%, y%) = false
        END IF
        FOR rot% = 1 TO 3
          FOR px% = 0 TO UBOUND(object, 3)
            FOR py% = 0 TO UBOUND(object, 4)
              object(n%, rot%, px%, py%) = object(n%, rot% - 1, UBOUND(object, 4) - py%, px%)
            NEXT
          NEXT
        NEXT
      NEXT
    NEXT
  NEXT

END SUB

SUB main

  DIM fields(11, 21) AS INTEGER ' 20,30
  DIM object(6, 3, 3, 3) AS INTEGER
  freq 0, 0, 0
  getObject object()
  buildField fields()
  DIM brick AS brickType
  brick.nrg = false
  nextBrick% = INT(RND * UBOUND(object, 1) + 1)
  DO
    clock! = TIMER
    IF NOT brick.nrg THEN
      brick.x = UBOUND(fields, 1) \ 2
      brick.y = 0
      brick.sx = 0
      brick.sy = 0
      brick.rot = 0
      brick.n = nextBrick%
      nextBrick% = INT(RND * UBOUND(object, 1) + 1)
      FOR nbx% = 0 TO UBOUND(object, 3)
        FOR nby% = 0 TO UBOUND(object, 4)
          drawBox 18 + nbx%, 2 + nby%, ABS(object(nextBrick%, 0, nbx%, nby%)) * 7
        NEXT
      NEXT
      brick.nrg = true
      putObject fields(), object(), brick.x, brick.y, brick.n, brick.rot
    END IF
    IF tick% = 10 - INT(level!) THEN
      brick.sy = 1
      tick% = 0
      IF level! < 7 THEN level! = level! + .01
      IF INT(level!) <> lastLevel% THEN
        LOCATE 1, 38: PRINT INT(level!)
        lastLevel% = INT(level!)
      END IF
    ELSE
      tick% = tick% + 1
      SELECT CASE INKEY$
        CASE CHR$(0) + "K", "4": brick.sx = -1
        CASE CHR$(0) + "M", "6": brick.sx = 1
        CASE CHR$(0) + "H", "8": rotate% = true
        CASE CHR$(0) + "P", "2": brick.sy = 1
        CASE CHR$(27): END
        CASE "s":  freq 0, 0, 0
      END SELECT
      clearBuf$ = INKEY$
    END IF
    IF brick.sx <> 0 OR brick.sy <> 0 OR rotate% THEN
      clearObject fields(), object(), brick.x, brick.y, brick.n, brick.rot
      IF rotate% THEN
        rotate% = false
        IF (brick.x > 0 AND brick.x + UBOUND(object, 3) < UBOUND(fields, 1)) AND (brick.y > 1 AND brick.y + UBOUND(object, 4) < UBOUND(fields, 2) - 1) THEN
          IF brick.rot < 3 THEN
            brick.rot = brick.rot + 1
          ELSE
            brick.rot = 0
          END IF
        ELSEIF brick.y > 1 AND brick.sy = 0 THEN '###
          IF brick.x > UBOUND(fields) \ 2 THEN
            brick.sx = -1
          ELSE
            brick.sx = 1
          END IF
        END IF
      END IF
      IF checkObject%(fields(), object(), brick.x + brick.sx, brick.y + brick.sy, brick.n, brick.rot) THEN
        brick.x = brick.x + brick.sx
        brick.y = brick.y + brick.sy
        putObject fields(), object(), brick.x, brick.y, brick.n, brick.rot
      ELSE
        IF NOT (brick.sx <> 0 AND brick.sy = 0) THEN
          brick.nrg = false
          putObject fields(), object(), brick.x, brick.y, brick.n, brick.rot
          checkField fields(), brick.y, points%, INT(level!) + 1
          IF brick.y <= 2 THEN gameOver% = true
        ELSE
          putObject fields(), object(), brick.x, brick.y, brick.n, brick.rot
        END IF
      END IF
      brick.sx = 0
      brick.sy = 0
    END IF
    DO UNTIL clock! + .001 - TIMER <= 0: LOOP
  LOOP UNTIL gameOver%

END SUB

SUB putObject (fields() AS INTEGER, object() AS INTEGER, px%, py%, n%, rot%)

  FOR x% = 0 TO UBOUND(object, 3)
    FOR y% = 0 TO UBOUND(object, 4)
      IF object(n%, rot%, x%, y%) THEN
        drawBox px% + x%, py% + y%, 11
        fields(px% + x%, py% + y%) = true
      END IF
    NEXT
  NEXT

END SUB

0 komentar:

Poskan Komentar