Keskustelu: Koodit: QB64: Box Man!

'
'  BOX MAN! v.1.09
'
'  By Tero Ristolainen 2017
'  Play with arrow keys, Enter=Menu
'
SCREEN 13
_FULLSCREEN _SQUAREPIXELS
_TITLE "BOX MAN!"

DIM Map$(10, 10), Guy%(130), Box%(130), MenuString$(4)
GuyTaken = 0: BoxTaken = 0
MenuString$(1) = "PLAY!"
MenuString$(2) = "LEVEL " + CHR$(29)
MenuString$(3) = "DISPLAY"
MenuString$(4) = "QUIT"

DO

    GOSUB DrawLevel

    DO
        k$ = INKEY$
        IF k$ <> "" THEN
            cx = 0: cy = 0
            SELECT CASE k$
                CASE CHR$(13): GOSUB Menu
                CASE CHR$(0) + "K": cx = -1
                CASE CHR$(0) + "M": cx = 1
                CASE CHR$(0) + "H": cy = -1
                CASE CHR$(0) + "P": cy = 1
            END SELECT
            IF cx <> 0 OR cy <> 0 THEN
                IF MID$(Map$(Level, py + cy), px + cx, 1) = " " THEN
                    FOR M = 1 TO 16
                        PUT (px * 16 + cx * M, py * 16 + cy * M), Guy%(), PSET
                        _DELAY .02
                    NEXT M
                    px = px + cx: py = py + cy: Moves = Moves + 1: GOSUB MovesCounter
                ELSE
                    IF MID$(Map$(Level, py + cy), px + cx, 1) = "$" THEN
                        bx = px + cx: by = py + cy
                        IF MID$(Map$(Level, py + (cy + cy)), px + (cx + cx), 1) = " " OR MID$(Map$(Level, py + (cy + cy)), px + (cx + cx), 1) = "." THEN
                            FOR M = 1 TO 16
                                PUT (px * 16 + cx * M, py * 16 + cy * M), Guy%(), PSET
                                PUT (bx * 16 + cx * M, by * 16 + cy * M), Box%(), PSET
                                _DELAY .02
                            NEXT M
                            IF MID$(Map$(Level, py + (cy + cy)), px + (cx + cx), 1) = " " THEN MID$(Map$(Level, py + (cy + cy)), px + (cx + cx), 1) = "$"
                            IF MID$(Map$(Level, py + (cy + cy)), px + (cx + cx), 1) = "." THEN
                                sx = px + (cx + cx): sy = py + (cy + cy)
                                FOR M = 0 TO 7
                                    LINE (sx * 16 + M, sy * 16 + M)-(sx * 16 + 15 - M, sy * 16 + 15 - M), 0, B
                                    _DELAY .04
                                    LINE (sx * 16 + M, sy * 16 + M)-(sx * 16 + 15 - M, sy * 16 + 15 - M), 15, B
                                NEXT M
                                MID$(Map$(Level, sy), sx, 1) = " ": Boxes = Boxes - 1
                            END IF
                            px = px + cx: py = py + cy: Moves = Moves + 1: GOSUB MovesCounter
                            MID$(Map$(Level, py), px, 1) = " "
                        END IF
                    END IF
                END IF
            END IF
        END IF
    LOOP UNTIL Boxes = 0
    IF Moves > 0 THEN SLEEP 2
    Level = Level + 1
    IF Level > LastLevel THEN Level = LastLevel: GOSUB Menu

LOOP

END

MovesCounter:
COLOR 0, 15
LOCATE 23, 3: PRINT "LEVEL"; Level
LOCATE 23, 14: PRINT "MOVES";
IF Boxes = 0 AND Moves <> 0 THEN COLOR 4, 15
PRINT Moves
RETURN

Menu:
LINE (200, 20)-(300, 130), 15, BF: LINE (200, 20)-(300, 130), 0, B
Selected = 1
FOR M = 1 TO 4
    IF M = Selected THEN COLOR 15, 0 ELSE COLOR 0, 15
    _PRINTSTRING (220, 20 + M * 20), MenuString$(M)
NEXT M
DO
    km$ = INKEY$
    IF km$ <> "" THEN
        cx = 0: cy = 0: LevelChanged = 0
        SELECT CASE km$
            CASE CHR$(0) + "H": IF Selected > 1 THEN Selected = Selected - 1 ELSE Selected = 4
            CASE CHR$(0) + "P": IF Selected < 4 THEN Selected = Selected + 1 ELSE Selected = 1
            CASE CHR$(0) + "K": IF Selected = 2 THEN LevelChanged = -1: Level = Level - 1: IF Level = 0 THEN Level = LastLevel
            CASE CHR$(0) + "M": IF Selected = 2 THEN LevelChanged = 1: Level = Level + 1: IF Level > LastLevel THEN Level = 1
            CASE CHR$(13)
                IF Selected = 1 THEN LINE (200, 20)-(300, 130), 15, BF: EXIT DO
                IF Selected = 3 THEN IF _FULLSCREEN = 2 THEN _FULLSCREEN _OFF ELSE _FULLSCREEN _SQUAREPIXELS
                IF Selected = 4 THEN LINE (200, 20)-(300, 130), 15, BF: LINE (200, 20)-(300, 130), 0, B: COLOR 0, 15: _PRINTSTRING (236, 70), "BYE!": END
        END SELECT
        IF LevelChanged <> 0 THEN GOSUB DrawLevel
        LINE (200, 20)-(300, 130), 15, BF: LINE (200, 20)-(300, 130), 0, B
        FOR M = 1 TO 4
            IF M = Selected THEN COLOR 15, 0 ELSE COLOR 0, 15
            _PRINTSTRING (220, 20 + M * 20), MenuString$(M)
        NEXT M
    END IF
LOOP
GOSUB DrawLevel
RETURN

DrawLevel:
Map$(1, 1) = "#####    ": Map$(2, 1) = "##########": Map$(3, 1) = "   #### "
Map$(1, 2) = "#   #    ": Map$(2, 2) = "#..      #": Map$(3, 2) = "  ##  # "
Map$(1, 3) = "#@$$# ###": Map$(2, 3) = "#..$  #  #": Map$(3, 3) = "  #@$ # "
Map$(1, 4) = "# $ # #.#": Map$(2, 4) = "#  #$## ##": Map$(3, 4) = "  ##$ ##"
Map$(1, 5) = "### ###.#": Map$(2, 5) = "# $     # ": Map$(3, 5) = "  ## $ #"
Map$(1, 6) = "###    .#": Map$(2, 6) = "##### # # ": Map$(3, 6) = "  #.$  #"
Map$(1, 7) = " #   #  #": Map$(2, 7) = "  # $ @ # ": Map$(3, 7) = "  #.. .#"
Map$(1, 8) = " #   ####": Map$(2, 8) = "  #     # ": Map$(3, 8) = "  ######"
Map$(1, 9) = " #####   ": Map$(2, 9) = "  ####### ": Map$(3, 9) = "        "
Map$(4, 1) = "  #####  ": Map$(5, 1) = "          ": Map$(6, 1) = "   #######"
Map$(4, 2) = "  #@ ### ": Map$(5, 2) = " #######  ": Map$(6, 2) = "  ##  # @#"
Map$(4, 3) = "  # $  # ": Map$(5, 3) = " #     ###": Map$(6, 3) = "  #   #  #"
Map$(4, 4) = " ### # ##": Map$(5, 4) = "##$###   #": Map$(6, 4) = "  #$ $ $ #"
Map$(4, 5) = " #.# #  #": Map$(5, 5) = "# @ $  $ #": Map$(6, 5) = "### $##  #"
Map$(4, 6) = " #.$  # #": Map$(5, 6) = "# ..# $ ##": Map$(6, 6) = "#   $   ##"
Map$(4, 7) = " #.   $ #": Map$(5, 7) = "##..#   # ": Map$(6, 7) = "#.....  # "
Map$(4, 8) = " ########": Map$(5, 8) = " ######## ": Map$(6, 8) = "######### "
Map$(4, 9) = "         ": Map$(5, 9) = "          ": Map$(6, 9) = "          "
Map$(7, 1) = "          ": Map$(8, 1) = " ######### ": Map$(9, 1) = " #######"
Map$(7, 2) = "   ###### ": Map$(8, 2) = " #  ##   # ": Map$(9, 2) = " #    .#"
Map$(7, 3) = " ###    # ": Map$(8, 3) = " #   $   # ": Map$(9, 3) = " # $ # #"
Map$(7, 4) = "##. $## ##": Map$(8, 4) = " #$ ### $# ": Map$(9, 4) = " #  @  #"
Map$(7, 5) = "#..$ $  @#": Map$(8, 5) = " # #...# # ": Map$(9, 5) = " #.### #"
Map$(7, 6) = "#.. $ $ ##": Map$(8, 6) = "## #...# ##": Map$(9, 6) = " # $ $ #"
Map$(7, 7) = "#####   # ": Map$(8, 7) = "# $  $  $ #": Map$(9, 7) = " # # # #"
Map$(7, 8) = "    ##### ": Map$(8, 8) = "#     # @ #": Map$(9, 8) = " #    .#"
Map$(7, 9) = "          ": Map$(8, 9) = "###########": Map$(9, 9) = " #######"
LastLevel = 9: Boxes = 0: Moves = 0: CLS , 15
FOR y = 1 TO 9
    FOR x = 1 TO LEN(Map$(Level, y))
        SELECT CASE MID$(Map$(Level, y), x, 1)
            CASE " "
                LINE (x * 16, y * 16)-(x * 16 + 15, y * 16 + 15), 15, BF
            CASE "#"
                LINE (x * 16, y * 16)-(x * 16 + 15, y * 16 + 15), 0, BF
            CASE "."
                LINE (x * 16 + 7, y * 16 + 7)-(x * 16 + 8, y * 16 + 8), 0, B
            CASE "$"
                LINE (x * 16, y * 16)-(x * 16 + 15, y * 16 + 15), 7, BF
                LINE (x * 16, y * 16)-(x * 16 + 15, y * 16 + 15), 0, B
                IF BoxTaken = 0 THEN BoxTaken = 1: GET (x * 16, y * 16)-(x * 16 + 15, y * 16 + 15), Box%()
                Boxes = Boxes + 1
            CASE "@"
                LINE (x * 16 + 1, y * 16 + 1)-(x * 16 + 14, y * 16 + 11), 0, B ' head
                LINE (x * 16 + 4, y * 16 + 12)-(x * 16 + 4, y * 16 + 14), 0 ' left leg
                LINE (x * 16 + 11, y * 16 + 12)-(x * 16 + 11, y * 16 + 14), 0 ' right leg
                PSET (x * 16 + 4, y * 16 + 6), 0: PSET (x * 16 + 11, y * 16 + 6), 0 ' eyes
                px = x: py = y: MID$(Map$(Level, y), x, 1) = " "
                IF GuyTaken = 0 THEN GuyTaken = 1: GET (x * 16, y * 16)-(x * 16 + 15, y * 16 + 15), Guy%()
        END SELECT
    NEXT x
NEXT y
GOSUB MovesCounter
RETURN