QB / QB64 Discussion Forum     RULES     Other Subforums, Links and Downloads    Index of Threads

 

 Return to Index  

Custom.bas - allows USERS to create levels

December 22 2007 at 11:09 AM
Tusike  (Login Tusike)


Response to Snake v0.8 (1 will be the full version...)

 
DECLARE SUB adios ()
DECLARE SUB openmap ()
DECLARE FUNCTION ask$ (text$, x%, y%, max%, mode%)
DECLARE SUB savemap ()
DECLARE FUNCTION MenuChoice% (selections%, start%, xstart%)
DECLARE SUB center (text$, y!)
DEFINT A-Z
DECLARE SUB editor ()
DECLARE SUB drawdef ()
DECLARE SUB PUTimage (col, row, index)
DECLARE SUB restorecolors ()
DECLARE FUNCTION eng$ (number, language)
DECLARE SUB mouse (cx, dx, bx)
DECLARE SUB MousePointer (SW)
DIM SHARED a(9), a$
SCREEN 12
DIM SHARED global$, imageSET(999), ground(1 TO 32, 1 TO 24), background(7820) AS SINGLE
DIM SHARED mch(1 TO 8) AS INTEGER, lang%, hasname, map$, block(125), cpu#, nickname$
DIM SHARED mx, my, mclick, oldx, oldy
GOSUB Getsprites
ON ERROR GOTO ignore
MKDIR "maps"
ON ERROR GOTO 0
OPEN "profile.txt" FOR INPUT AS #1
INPUT #1, nickname$
INPUT #1, lang%
INPUT #1, cpu#
CLOSE #1
map$ = ""
DEF SEG = VARSEG(a(0))

FOR i = 0 TO 17
READ r
POKE VARPTR(a(0)) + i, r
NEXT i
CALL MousePointer(0)
CALL MousePointer(3)

DATA &HB8,&H00,&H00
DATA &H55
DATA &H8B,&HEC
DATA &HCD,&H33
DATA &H92
DATA &H8B,&H5E,&H06
DATA &H89,&H07
DATA &H5D
DATA &HCA,&H02,&H00


hasname = 0

drawdef
restorecolors
editor
adios

Getsprites:
FOR n = 0 TO 15
OUT &H3C8, n
OUT &H3C9, 0
OUT &H3C9, 0
OUT &H3C9, 0
NEXT n
maxx = 19: maxy = 139: x = -1: y = 0
OPEN "files\images.dat" FOR INPUT AS #1
DO

INPUT #1, counter, colr
IF colr = 7 THEN colr = 3: GOTO 17
IF colr = 14 THEN colr = 3
IF colr = 77 THEN colr = 7
IF colr = 2 AND y > 279 THEN colr = 11
17
FOR i = 1 TO counter
x = x + 1
IF x > maxx THEN x = 0: y = y + 1
PSET (x, y), colr
NEXT
LOOP UNTIL x = maxx AND y = maxy
CLOSE #1
index = 0
placey = 0
DO
GET (0, placey)-(19, placey + 19), imageSET(index)
index = index + 125
placey = placey + 20
LOOP UNTIL placey = 140
LINE (0, 0)-(19, 19), 7, BF
FOR i = 1 TO 500
x = INT(RND * 20)
y = INT(RND * 20)
PSET (x, y), 8
PSET (x + 1, y + 1), 15
NEXT
LINE (0, 0)-(19, 19), 7, B
GET (0, 0)-(19, 19), imageSET(875)
LINE (0, 0)-(8, 8), 7, B
GET (0, 0)-(8, 8), block
PUTimage 1, 1, 750
FOR x = 0 TO 19
FOR y = 0 TO 19
PSET (19 - x, y + 20), POINT(x, y)
NEXT
NEXT
GET (0, 20)-(19, 39), imageSET(750)
PUTimage 1, 1, 0
FOR x = 0 TO 19
FOR y = 0 TO 19
PSET (19 - x, y + 20), POINT(x, y)
NEXT
NEXT
GET (0, 20)-(19, 39), imageSET(0)
RETURN

handler:
PRINT global$
SYSTEM
RETURN

ignore: RESUME NEXT






Paletteinfo:
DATA 0,14,3, 0,0,42, 0,42,0, 0,14,3, 42,0,0, 60,52,0
DATA 60,52,0, 42,42,42, 21,21,21, 21,21,63, 21,63,21, 0,42,0
DATA 63,21,21, 63,21,63, 0,0,0, 63,63,63

SUB adios
KILL "profile.txt"
OPEN "profile.txt" FOR OUTPUT AS #1
PRINT #1, nickname$
PRINT #1, cpu#
CLOSE #1
CHAIN "snake.bas"

END SUB

FUNCTION ask$ (text$, x, y, max, mode)
COLOR 15
startx = x + LEN(text$): x = (x + LEN(text$)) * 8
txtlen = 0
LINE (x, (y - 1) * 2 + y * 14 - 14)-(x, (y - 1) * 2 + y * 14), 7
txt$ = ""
DO
DO: LOOP UNTIL INKEY$ = ""
DO: a$ = INKEY$: LOOP UNTIL a$ <> ""
COLOR 5
SELECT CASE a$
CASE CHR$(13): IF txt$ <> "" THEN EXIT DO
CASE CHR$(27)

ask$ = "exit": EXIT FUNCTION
CASE CHR$(8)
IF txtlen > 0 THEN
LOCATE y, startx + txtlen: PRINT SPACE$(max - txtlen + 2)
txtlen = txtlen - 1: IF txtlen = 0 THEN txt$ = "" ELSE txt$ = MID$(txt$, 1, txtlen)
COLOR 5
IF mode = 1 THEN LOCATE y, startx + 1: PRINT txt$ ELSE LOCATE y, startx + 1: PRINT STRING$(txtlen, "*")
LINE (x + (txtlen * 8), (y - 1) * 2 + y * 14 - 14)-(x + (txtlen * 8), (y - 1) * 2 + y * 14), 7
END IF
CASE ELSE
IF mode = 2 THEN minimum = 33: maximum = 126 ELSE minimum = 48: maximum = 90
a1 = ASC(UCASE$(a$))
IF (a1 >= minimum AND a1 <= maximum) OR (a1 = 32) AND txtlen <= max THEN
IF a1 < 58 OR a1 > 64 THEN
txtlen = txtlen + 1
IF txtlen <= max THEN
IF mode = 1 THEN LOCATE y, startx + txtlen: PRINT UCASE$(a$) ELSE LOCATE y, startx + txtlen: PRINT "*"
txt$ = txt$ + UCASE$(a$)
LINE (x + txtlen * 8, (y - 1) * 2 + y * 14 - 14)-(x + txtlen * 8, (y - 1) * 2 + y * 14), 7
ELSE
txtlen = max
END IF
END IF
END IF
END SELECT
LOOP
LINE (x + LEN(txt$) * 8, (y - 1) * 2 + y * 14 - 14)-(x + LEN(txt$) * 8, (y - 1) * 2 + y * 14), 3
ask$ = txt$
END FUNCTION

DEFSNG A-Z
SUB center (text$, y)
DIM letter(0 TO 199)
textlen = LEN(text$)
FOR i = 1 TO LEN(text$)
a$ = MID$(text$, i, 1)
IF a$ = "^" THEN textlen = textlen - 1
IF a$ = "-" THEN
textlen = textlen - 2
IF MID$(text$, i + 2, 1) = "-" THEN
textlen = textlen - 1: i = i + 3: GOTO 20
ELSE
textlen = textlen - 2: i = i + 4: GOTO 20
END IF
END IF
20
NEXT
s = 0

textlen = textlen * 8
startx = 320 - (textlen / 2)
y = (y - 1) * 2 + y * 14 - 14
C = 15
ii = 0
FOR i = 1 TO LEN(text$)
a$ = MID$(text$, i, 1)
IF a$ = "-" THEN
IF MID$(text$, i + 2, 1) = "-" THEN C = VAL(MID$(text$, i + 1, 1)): i = i + 2 ELSE C = VAL(MID$(text$, i + 1, 2)): i = i + 3
GOTO 21
END IF
IF a$ = "^" THEN s = 1: GOTO 21
ii = ii + 1
IF a$ = " " THEN
LINE (startx + (ii - 1) * 8, y)-(startx + (ii) * 8, y + 14), 3, BF
GOTO 21
END IF
z = ASC(a$)
SELECT CASE a$
CASE "=": z = 45
CASE "#": IF s = 1 THEN s = 0: z = 144 ELSE z = 130
CASE "@": IF s = 1 THEN s = 0: z = 143 ELSE z = 160
CASE "|": IF s = 1 THEN s = 0: z = 161 ELSE z = 161
CASE "$": IF s = 1 THEN s = 0: z = 162 ELSE z = 162
CASE "_": IF s = 1 THEN s = 0: z = 163 ELSE z = 163
CASE "<": IF s = 1 THEN s = 0: z = 153 ELSE z = 148
CASE ">": IF s = 1 THEN s = 0: z = 154 ELSE z = 129
END SELECT
DEF SEG = VARSEG(letter(0))
global$ = "letters\chr" + LTRIM$(RTRIM$(STR$(z))) + ".chr"
ON ERROR GOTO handler
BLOAD "letters\chr" + LTRIM$(RTRIM$(STR$(z))) + ".chr", VARPTR(letter(0))
ON ERROR GOTO 0
x = startx + (ii - 1) * 8
SELECT CASE C
CASE 5: index = 160
CASE 8: index = 0
CASE 9: index = 120
CASE 12: index = 40
CASE 15: index = 80
END SELECT
global$ = STR$(x) + STR$(y) + STR$(index)
ON ERROR GOTO handler
IF y > 0 AND (z = 144 OR z = 143 OR z = 154 OR z = 153) THEN PUT (x, y - 2), letter(index), PSET ELSE PUT (x, y), letter(index), PSET
ON ERROR GOTO 0
21
NEXT

END SUB

DEFINT A-Z
SUB drawdef
LINE (0, 0)-(639, 479), 3, BF
FOR x = 1 TO 32
FOR y = 1 TO 24
ground(x, y) = 0
NEXT
NEXT

FOR x = 1 TO 32
PUTimage x, 1, 875
PUTimage x, 24, 875
ground(x, 1) = 1
ground(x, 24) = 1
NEXT
FOR y = 2 TO 23
PUTimage 1, y, 875
PUTimage 32, y, 875
ground(1, y) = 1
ground(32, y) = 1
NEXT

center "-9-" + LTRIM$(RTRIM$(eng$(78, lang%))) + "-15- = " + LTRIM$(RTRIM$(eng$(79, lang%))) + SPACE$(12) + "-9-[ENTER]-15- = " + RTRIM$(LTRIM$(eng$(80, lang%))) + SPACE$(12) + "-9-[ESC] -15-= " + RTRIM$(LTRIM$(eng$(81, lang%))), 27
LINE (29, 461)-(610, 478), 15, BF
FOR x = 23 TO 616
FOR y = 414 TO 432
IF POINT(x, y) = 9 THEN PSET (x, y), 3: PSET (x, y + 49), 4
IF POINT(x, y) = 15 THEN PSET (x, y), 3: PSET (x, y + 49), 3
NEXT
NEXT
center "-9-[CTRL] = S-15- = " + RTRIM$(LTRIM$(eng$(82, lang%))) + SPACE$(10) + "-9-" + RTRIM$(LTRIM$(eng$(89, lang%))) + "-15-" + SPACE$(10) + "-9-[CTRL] = O -15-= " + RTRIM$(LTRIM$(eng$(83, lang%))), 3
IF lang% = 1 THEN
LINE (88, 37)-(94, 37), 15
LINE (91, 34)-(91, 40), 15
LINE (534, 37)-(528, 37), 15
LINE (531, 34)-(531, 40), 15
END IF
IF lang% = 2 THEN
LINE (92, 37)-(98, 37), 15
LINE (95, 34)-(95, 40), 15
LINE (508, 37)-(514, 37), 15
LINE (511, 34)-(511, 40), 15
END IF
LINE (25, 1)-(614, 18), 15, BF
FOR x = 25 TO 614
FOR y = 23 TO 50
IF POINT(x, y) = 9 THEN PSET (x, y), 3: PSET (x, y - 28), 4
IF POINT(x, y) = 15 THEN PSET (x, y), 3: PSET (x, y + -28), 3
NEXT
NEXT

x = 24
FOR i = 1 TO 15
x = x - 1
SELECT CASE i
CASE 1: index = 0
CASE 2: index = 125
CASE 3: index = 250
CASE 4: index = 375
CASE 5: index = 375
CASE 6: index = 375
CASE 7: index = 375
CASE 8: index = 375
CASE 9: index = 375
CASE 10: index = 375
CASE 11: index = 250
CASE 12: index = 125
CASE 13: index = 500
CASE 14: index = 625
CASE 15: index = 750
END SELECT
PUTimage x, 23, index
NEXT i

END SUB

SUB editor
LINE (180, 109)-(460, 304), 3, BF
LINE (180, 109)-(460, 304), 7, B
LINE (182, 111)-(458, 302), 7, B
center eng$(73, lang%), 9
center eng$(84, lang%), 11
center eng$(85, lang%), 13
center eng$(86, lang%), 14
center eng$(87, lang%), 15
center eng$(88, lang%), 16
center "[ -5-" + eng$(89, lang%) + "-15- ]", 18
DO
DO: LOOP UNTIL INKEY$ = ""
DO: a$ = INKEY$: LOOP UNTIL a$ <> ""
SELECT CASE a$
CASE CHR$(27): adios
CASE CHR$(13), CHR$(32): SOUND 150, 1: EXIT DO
END SELECT
LOOP
2
map$ = ""
LINE (190, 119)-(450, 294), 3, BF
mx = 16: my = 12
LINE ((mx - 1) * 20, (my - 1) * 20)-((mx - 1) * 20 + 19, (my - 1) * 20 + 19), 5, B
LINE ((mx - 1) * 20 + 1, (my - 1) * 20 + 1)-((mx - 1) * 20 + 18, (my - 1) * 20 + 18), 5, B

editstart:
MousePointer 1
MousePointer 2

DO
DO: LOOP UNTIL INKEY$ = ""
a$ = INKEY$
MousePointer 3
oldx = mx: oldy = my
CALL mouse(cx, dx, bx)
a$ = INKEY$
SELECT CASE a$
CASE CHR$(27): EXIT SUB
CASE CHR$(19): savemap
LINE ((mx - 1) * 20, (my - 1) * 20)-((mx - 1) * 20 + 19, (my - 1) * 20 + 19), 5, B
LINE ((mx - 1) * 20 + 1, (my - 1) * 20 + 1)-((mx - 1) * 20 + 18, (my - 1) * 20 + 18), 5, B
CASE CHR$(15): openmap
LINE ((mx - 1) * 20, (my - 1) * 20)-((mx - 1) * 20 + 19, (my - 1) * 20 + 19), 5, B
LINE ((mx - 1) * 20 + 1, (my - 1) * 20 + 1)-((mx - 1) * 20 + 18, (my - 1) * 20 + 18), 5, B
CASE CHR$(13)
EXIT DO
1
END SELECT
IF oldx <> mx OR oldy <> my THEN
LINE ((oldx - 1) * 20, (oldy - 1) * 20)-((oldx - 1) * 20 + 19, (oldy - 1) * 20 + 19), 3, BF
IF ground(oldx, oldy) = 1 THEN PUTimage oldx, oldy, 875
LINE ((mx - 1) * 20, (my - 1) * 20)-((mx - 1) * 20 + 19, (my - 1) * 20 + 19), 5, B
LINE ((mx - 1) * 20 + 1, (my - 1) * 20 + 1)-((mx - 1) * 20 + 18, (my - 1) * 20 + 18), 5, B
END IF
IF mclick = 1 THEN
IF ground(mx, my) = 0 THEN
ground(mx, my) = 1: PUTimage mx, my, 875
LINE ((mx - 1) * 20, (my - 1) * 20)-((mx - 1) * 20 + 19, (my - 1) * 20 + 19), 5, B
LINE ((mx - 1) * 20 + 1, (my - 1) * 20 + 1)-((mx - 1) * 20 + 18, (my - 1) * 20 + 18), 5, B
END IF
END IF
IF mclick = 2 THEN
IF ground(mx, my) = 1 THEN
ground(mx, my) = 2: PUTimage mx, my, 1000
LINE ((mx - 1) * 20, (my - 1) * 20)-((mx - 1) * 20 + 19, (my - 1) * 20 + 19), 5, B
LINE ((mx - 1) * 20 + 1, (my - 1) * 20 + 1)-((mx - 1) * 20 + 18, (my - 1) * 20 + 18), 5, B
END IF
END IF



LOOP

menupause:
GET (190, 119)-(450, 294), background
LINE (190, 119)-(450, 294), 3, BF
LINE (190, 119)-(450, 294), 7, B
LINE (192, 121)-(448, 292), 7, B
center eng$(73, lang%), 10
mch(1) = 46
mch(2) = 75
mch(3) = 22
PALETTE 5, 60 + 52 * 256
SELECT CASE MenuChoice(3, 1, 13)
CASE 1: PUT (190, 119), background, PSET: GOTO 1
CASE 2
FOR x = 2 TO 31
FOR y = 2 TO 22
PUTimage x, y, 1000
ground(x, y) = 0
NEXT
NEXT
FOR x = 2 TO 8
PUTimage x, 23, 1000
ground(x, 23) = 0
PUTimage x + 22, 23, 1000
ground(x + 22, 23) = 0
NEXT
PUTimage 31, 23, 1000
ground(31, 23) = 0
hasname = 0
GOTO 2
CASE 3
adios
END SELECT
END SUB

FUNCTION eng$ (number, language)
SELECT CASE language
CASE 1
OPEN "files\english.txt" FOR RANDOM AS #7 LEN = 35
CASE 2
OPEN "files\magyar.txt" FOR RANDOM AS #7 LEN = 35
END SELECT
GET #7, number, t$
CLOSE #7
eng$ = LTRIM$(RTRIM$((t$)))

END FUNCTION

FUNCTION MenuChoice% (selections, start, xstart)
sel = start
CONST MenuBright = "-15-"
CONST MenuDull = "-8-"
DO
FOR i = 1 TO selections
IF mch(i) > 0 THEN
w$ = eng$(mch(i), lang%)
IF i = sel THEN w$ = MenuBright + "[ " + "-5-" + w$ + MenuBright + " ]" ELSE w$ = MenuDull + " " + w$ + " "
center w$, xstart + ((i - 1) * 2)
END IF
NEXT i
DO: LOOP UNTIL INKEY$ = "": DO: a$ = UCASE$(INKEY$): LOOP WHILE a$ = ""

SOUND 150, 1
SELECT CASE a$
CASE CHR$(27): adios
CASE CHR$(0) + "P":
DO
sel = sel + 1: IF sel > selections THEN sel = 1
LOOP WHILE mch(sel) = 0
CASE CHR$(0) + "H":
DO
sel = sel - 1: IF sel < 1 THEN sel = selections
LOOP WHILE mch(sel) = 0
CASE CHR$(13), CHR$(32): side$ = "": EXIT DO
CASE CHR$(0) + "K": IF side$ = "?" THEN side$ = "-": EXIT DO
CASE CHR$(0) + "M": IF side$ = "?" THEN side$ = "+": EXIT DO
END SELECT
t# = TIMER + .05: DO: LOOP UNTIL TIMER >= t#
LOOP

MenuChoice% = sel

END FUNCTION

SUB mouse (cx, dx, bx)
DEF SEG = VARSEG(a(0))
POKE VARPTR(a(4)), &H92
CALL absolute(cx, VARPTR(a(0)))
cx = cx
POKE VARPTR(a(4)), &H91
CALL absolute(dx, VARPTR(a(0)))
dx = dx
POKE VARPTR(a(4)), &H93
CALL absolute(bx, VARPTR(a(0)))
DEF SEG
mclick = bx
mx = INT(dx / 20) + 1
my = INT(cx / 20) + 1
IF my < 2 THEN my = 2
IF my > 23 THEN my = 23
IF mx < 2 THEN mx = 2
IF mx > 31 THEN mx = 31
IF my = 23 AND mx > 8 AND mx < 24 THEN my = 22
IF my = 23 AND mx = 9 THEN mx = 8
IF my = 23 AND mx = 23 THEN mx = 24
END SUB

SUB MousePointer (SW)
DEF SEG = VARSEG(a(0))
POKE VARPTR(a(0)) + 1, SW 'Swap code,Set AX = (SW)
CALL absolute(C, VARPTR(a(0))) 'Run Code

'Note:
'SW = 0-reset
'SW = 1-on
'SW = 2-off
'SW = 3-coordinates
a$ = INKEY$
DEF SEG
END SUB

SUB openmap
GET (190, 119)-(450, 334), background
LINE (190, 119)-(450, 334), 3, BF
LINE (190, 119)-(450, 334), 7, B
LINE (192, 121)-(448, 332), 7, B
PALETTE 5, 60 + 52 * 256
IF lang% = 1 THEN center "-12-O P E N M A P", 9 ELSE center "-12-P ^@ L Y A N Y I T ^@ S A", 9
SHELL "dir /b maps\*.lvl > temp"
OPEN "temp" FOR INPUT AS #1
OPEN "maps.dat" FOR RANDOM AS #2 LEN = 14
counter = 0
DO WHILE NOT EOF(1)
counter = counter + 1
LINE INPUT #1, map$
PUT #2, counter, map$
LOOP
CLOSE #1
CLOSE #2
KILL "TEMP"
mark = 1
max = counter
OPEN "maps.dat" FOR RANDOM AS #1 LEN = 14
GET #1, mark, map$
center UCASE$(MID$(map$, 1, 1)) + LCASE$(MID$(map$, 2, LEN(map$) - 5)), 10
OPEN "maps\" + map$ FOR INPUT AS #2
FOR x = 1 TO 32
FOR y = 1 TO 24
INPUT #2, g
IF g = 1 THEN PUT (208 + (x - 1) * 7, 158 + (y - 1) * 7), block, PSET
NEXT
NEXT
CLOSE #2
DO
DO: a$ = INKEY$: LOOP UNTIL a$ = ""
DO: a$ = INKEY$: LOOP UNTIL a$ <> ""
SELECT CASE a$
CASE CHR$(0) + "M": mark = mark + 1: center SPACE$(8), 10: IF mark > counter THEN mark = 1
CASE CHR$(0) + "K": mark = mark - 1: center SPACE$(8), 10: IF mark < 1 THEN mark = counter
CASE CHR$(13), CHR$(32): EXIT DO
CASE CHR$(27): CLOSE #1: KILL "maps.dat": PUT (190, 119), background, PSET: EXIT SUB
END SELECT
GET #1, mark, map$
center UCASE$(MID$(map$, 1, 1)) + LCASE$(MID$(map$, 2, LEN(map$) - 5)), 10
OPEN "maps\" + map$ FOR INPUT AS #2
FOR x = 1 TO 32
FOR y = 1 TO 24
INPUT #2, g
IF g = 1 THEN PUT (208 + (x - 1) * 7, 158 + (y - 1) * 7), block, PSET
IF g = 0 THEN LINE (208 + (x - 1) * 7, 158 + (y - 1) * 7)-(208 + (x - 1) * 7 + 6, 158 + (y - 1) * 7 + 6), 3, BF
NEXT
NEXT
CLOSE #2
LOOP
PUT (190, 119), background, PSET
OPEN "maps\" + map$ FOR INPUT AS #2
FOR x = 1 TO 32
FOR y = 1 TO 24
INPUT #2, ground(x, y)
IF x > 1 AND x < 32 AND y > 1 AND y < 24 THEN
IF ground(x, y) = 1 THEN PUTimage x, y, 875 ELSE PUTimage x, y, 1000
END IF
NEXT
NEXT
hasname = 1
CLOSE #2
CLOSE #1
KILL "maps.dat"

END SUB

SUB PUTimage (col, row, index)
x = (col - 1) * 20
y = (row - 1) * 20
IF index < 1000 THEN PUT (x, y), imageSET(index), PSET
IF index = 875 THEN ground(col, row) = 1 ELSE ground(col, row) = 0
IF row = 23 AND (col > 8 OR col < 24) THEN EXIT SUB
IF index = 1000 THEN LINE (x, y)-(x + 19, y + 19), 3, BF
END SUB

DEFSNG A-Z
SUB restorecolors
RESTORE Paletteinfo
FOR n = 0 TO 15
READ red, green, blue
OUT &H3C8, n
OUT &H3C9, red
OUT &H3C9, green
OUT &H3C9, blue
NEXT

END SUB

DEFINT A-Z
SUB savemap
GET (190, 119)-(450, 294), background
3
LINE (190, 119)-(450, 294), 3, BF
LINE (190, 119)-(450, 294), 7, B
LINE (192, 121)-(448, 292), 7, B
PALETTE 5, 60 + 52 * 256
center "-12-S A V E M A P", 11
IF hasname = 0 THEN
center "Enter map name:", 14
map$ = ask$("", 37, 16, 8, 1)
IF map$ = "exit" THEN CLOSE #2: PUT (190, 119), background, PSET: EXIT SUB
map$ = map$ + ".lvl"
END IF
OPEN "maps\" + map$ FOR APPEND AS #2
IF LOF(2) > 0 AND hasname = 0 THEN
center "-12-File already exists!!!", 16
SOUND 150, 1
t# = TIMER + 1
DO: LOOP UNTIL TIMER >= t#
center SPACE$(25), 16
CLOSE #2
GOTO 3
END IF
CLOSE #2
OPEN "maps\" + map$ FOR OUTPUT AS #2
hasname = 1
FOR x = 1 TO 32
FOR y = 1 TO 24
PRINT #2, ground(x, y)
NEXT
NEXT
CLOSE #2
PUT (190, 119), background, PSET
END SUB


 
 Respond to this message   
 Copyright © 1999-2014 Network54. All rights reserved.   Terms of Use   Privacy Statement