Minggu, 06 November 2011

Tagged Under:

membuat game sederhana

By: Arief Hidayat On: 00.51
  • Share The Gag
  • 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