DECLARE SUB clearfirstline ()
DECLARE SUB shade (row, col, length, keycolor, backcol, lightcol, shadycol)
DECLARE SUB clearkeypress ()
DECLARE SUB getpal ()
DECLARE SUB redraw ()
DECLARE SUB game ()
DECLARE SUB menu ()
DECLARE SUB slow (sec!)
DECLARE SUB WRITET (aantalt, coll, shad, light, back, textboxcolor, menutype, marge, delay)
DECLARE SUB RECEIVE (item$, soort)
'$DYNAMIC
CONST Max = 34
DIM SHARED speed, charisma, luck, life, energy, lifeleft, energyleft, fpower
DIM SHARED weaponskill, magic, colorr(0 TO 255), colorg(0 TO 255), colorb(0 TO 255)
DIM SHARED focusx, focusy, mosaic, charcol, charposy, charposx
DIM SHARED col(0), mas(0), map(0, 0), boxstyle, textcol, textboxcol, marge
DIM SHARED camx, camy, hpx, hpy, Tekst$(0), asci(0), F$
CLS
map$ = "C:/map.txt"
saveb$ = "C:/opt.txt"
OPEN map$ FOR INPUT AS #1
LINE INPUT #1, mapsizex$: mapsizex = VAL(mapsizex$)
LINE INPUT #1, mapsizey$: mapsizey = VAL(mapsizey$)
REDIM SHARED map(mapsizex, mapsizey)
LINE INPUT #1, st$: charposx = VAL(st$)
LINE INPUT #1, st$: charposy = VAL(st$)
LINE INPUT #1, st$: st = VAL(st$)
REDIM SHARED asci(st), mas(st), col(st)
FOR a = 1 TO st
LINE INPUT #1, st$: asci(a) = VAL(st$)
LINE INPUT #1, st$: mas(a) = VAL(st$)
LINE INPUT #1, st$: col(a) = VAL(st$)
NEXT
FOR y = 1 TO mapsizey
LINE INPUT #1, a$
FOR x = 1 TO mapsizex
map(x, y) = VAL(MID$(a$, (x * 2) - 1, 2))
NEXT
NEXT
CLOSE #1
OPEN saveb$ FOR INPUT AS #1
LINE INPUT #1, st$: boxstyle = VAL(st$)
LINE INPUT #1, st$: textcol = VAL(st$)
LINE INPUT #1, st$: textboxcol = VAL(st$)
LINE INPUT #1, st$: marge = VAL(st$)
LINE INPUT #1, st$: charcol = VAL(st$)
LINE INPUT #1, st$: mosaic = VAL(st$)
SCREEN 13
CLOSE #1
redraw
CALL game
SLEEP
REM $STATIC
SUB clearkeypress
DO UNTIL INKEY$ = "": LOOP
END SUB
SUB game
DO
t = TIMER + .15
F$ = INKEY$
IF F$ = CHR$(0) + "H" THEN
IF charposx > 0 AND charposy > 1 AND charposy < 24 AND charposx < 41 THEN
IF mas(map(charposx, charposy - 1)) = 0 THEN
COLOR col(map(charposx, charposy)): LOCATE charposy, charposx: PRINT CHR$(asci(map(charposx, charposy)))
charposy = charposy - 1
END IF
END IF
focusx = charposx: focusy = charposy - 1
j = 1
ELSEIF F$ = CHR$(0) + "P" THEN
IF charposx > 0 AND charposy > 0 AND charposy < 23 AND charposx < 41 THEN
IF mas(map(charposx, charposy + 1)) = 0 THEN
COLOR col(map(charposx, charposy)): LOCATE charposy, charposx: PRINT CHR$(asci(map(charposx, charposy)))
charposy = charposy + 1
END IF
END IF
focusx = charposx: focusy = charposy + 1
j = 1
ELSEIF F$ = CHR$(0) + "K" THEN
IF charposx > 1 AND charposy > 0 AND charposy < 24 AND charposx < 41 THEN
IF mas(map(charposx - 1, charposy)) = 0 THEN
COLOR col(map(charposx, charposy)): LOCATE charposy, charposx: PRINT CHR$(asci(map(charposx, charposy)))
charposx = charposx - 1
END IF
END IF
focusx = charposx - 1: focusy = charposy
j = 1
ELSEIF F$ = CHR$(0) + "M" THEN
IF charposx > 0 AND charposy > 0 AND charposy < 24 AND charposx < 40 THEN
IF mas(map(charposx + 1, charposy)) = 0 THEN
COLOR col(map(charposx, charposy)): LOCATE charposy, charposx: PRINT CHR$(asci(map(charposx, charposy)))
charposx = charposx + 1
END IF
END IF
focusx = charposx - 1: focusy = charposy
j = 1
ELSEIF F$ = CHR$(122) THEN
IF mas(map(focusx, focusy)) = 1 AND j = 1 THEN
REDIM Tekst$(2)
Tekst$(1) = "Dit is massief."
WRITET 1, 7, 8, 15, 4, textboxcol, 1, marge, .05
redraw
H$ = ""
clearkeypress
j = 0
END IF
END IF
IF F$ = CHR$(27) THEN CALL menu
IF charposx > 0 AND charposy > 0 AND charposy < 24 AND charposx < 41 THEN
COLOR charcol: LOCATE charposy, charposx: PRINT CHR$(2)
END IF
DO UNTIL INKEY$ = "": LOOP
DO UNTIL TIMER >= t: LOOP
LOOP
END SUB
REM $DYNAMIC
SUB menu
FOR y = 1 TO 200 STEP mosaic
LINE (0, y)-(320, y), 0
NEXT
FOR x = 1 TO 320 STEP mosaic
LINE (x, 0)-(x, 200), 0
NEXT
linksbovenx = 23: linksboveny = 22 - marge
linksonderx = 23: linksondery = 113 + marge
rechtsbovenx = 183: rechtsboveny = 22 - marge
rechtsonderx = 183: rechtsondery = 113 + marge
LINE (linksbovenx, linksboveny)-(rechtsonderx, rechtsondery), textboxcol, B
LINE (linksbovenx + 1, linksboveny + 1)-(rechtsonderx - 1, rechtsondery - 1), 0, BF
IF boxstyle = 1 THEN
PSET (rechtsonderx, rechtsondery), 0
PSET (rechtsbovenx, rechtsboveny), 0
PSET (linksbovenx, linksboveny), 0
PSET (linksonderx, linksondery), 0
END IF
sit = 5
DO
COLOR 4
IF sit = 1 THEN COLOR 2
LOCATE 4, 7: PRINT "Main Menu": COLOR 4
IF sit = 2 THEN COLOR 2
LOCATE 6, 7: PRINT "Options": COLOR 4
IF sit = 3 THEN COLOR 2
LOCATE 8, 7: PRINT "Items": COLOR 4
IF sit = 4 THEN COLOR 2
LOCATE 10, 7: PRINT "Character": COLOR 4
IF sit = 5 THEN COLOR 2
LOCATE 12, 7: PRINT "Resume": COLOR 4
IF sit = 6 THEN COLOR 2
LOCATE 14, 7: PRINT "Exit to Windows": COLOR 4
COLOR 2
LOCATE 4 + ((sit - 1) * 2), 5: PRINT CHR$(16)
H$ = INKEY$
IF H$ = CHR$(0) + "P" THEN
IF sit < 6 THEN LOCATE 4 + ((sit - 1) * 2), 5: PRINT " ": sit = sit + 1
ELSEIF H$ = CHR$(0) + "H" THEN
IF sit > 1 THEN LOCATE 4 + ((sit - 1) * 2), 5: PRINT " ": sit = sit - 1
ELSEIF H$ = CHR$(122) THEN
IF sit = 6 THEN END
IF sit = 5 THEN redraw: game
END IF
LOOP
END SUB
SUB RECIEVE
END SUB
REM $STATIC
SUB redraw
FOR AX = 1 TO 40
FOR AY = 1 TO 23
COLOR col(map(AX, AY))
LOCATE AY, AX: PRINT CHR$(asci(map(AX, AY)))
NEXT
NEXT
END SUB
REM $DYNAMIC
SUB shade (row, col, length, keycolor, backcol, lightcol, shadycol)
x1 = (col - 1) * 8 - border
x2 = (col + length - 1) * 8 + border - 1
y1 = (row - 1) * 8 - border
y2 = (row - 1) * 8 + 7 + border
FOR x = x1 TO x2
FOR y = y1 TO y2
IF POINT(x, y) = 0 THEN PSET (x, y), backcol
NEXT
NEXT
FOR x = x1 TO x2
FOR y = y1 TO y2
IF POINT(x, y) = keycolor THEN
IF POINT(x - 1, y - 1) <> keycolor AND POINT(x - 1, y - 1) <> lightcol THEN PSET (x, y), lightcol
IF POINT(x, y + 1) = backcol THEN PSET (x, y + 1), shadycol
END IF
NEXT
NEXT
END SUB
SUB slow (sec)
t = TIMER + sec
DO UNTIL TIMER >= t: LOOP
END SUB
SUB WRITET (aantalt, coll, shad, light, back, textboxcolor, menutype, marge, delay)
COLOR coll
linksbovenx = 0: linksboveny = 150 - marge
linksonderx = 0: linksondery = 170 + marge
rechtsbovenx = 300: rechtsboveny = 150 - marge
rechtsonderx = 300: rechtsondery = 170 + marge
LINE (linkbovenx, linksboveny)-(rechtsonderx, rechtsondery), textboxcolor, B
LINE (linkbovenx + 1, linksboveny + 1)-(rechtsonderx - 1, rechtsondery - 1), back, BF
IF menutype = 1 THEN
PSET (rechtsonderx, rechtsondery), 0
PSET (rechtsbovenx, rechtsboveny), 0
PSET (linksbovenx, linksboveny), 0
PSET (linksonderx, linksondery), 0
END IF
'Gebruik LOCATE 22,2 en 23,2 om in het vak tekst te plaatsen en
'CHR$(16) voor het > teken. CHR$(122) is de toets Z
FOR j = 1 TO aantalt
LINE (linkbovenx + 1, linksboveny + 1)-(rechtsonderx - 1, rechtsondery - 1), back, BF
FOR I = 1 TO Max
a$ = MID$(Tekst$(j), I, 1)
LOCATE 20, 2 + I: PRINT a$
IF a$ <> "" THEN shade 20, 2 + I, 1, coll, back, light, shad
slow delay
NEXT I
j = j + 1
FOR K = 1 TO Max
a$ = MID$(Tekst$(j), K, 1)
LOCATE 21, 2 + K: PRINT a$
IF a$ <> "" THEN shade 21, 2 + K, 1, coll, back, light, shad
slow delay
NEXT K
H$ = ""
DO UNTIL INKEY$ = "": LOOP
DO UNTIL H$ = CHR$(122)
LOCATE 21, 37: PRINT CHR$(16)
shade 21, 37, 1, coll, back, light, shad
slow 10 * delay
LINE (288, 160)-(295, 167), back, BF
slow 10 * delay
H$ = INKEY$
LOOP
DO UNTIL INKEY$ = "": LOOP
H$ = ""
NEXT j
END SUB
|