'$DYNAMIC
'current library-diskvoic.qlb
DEFINT A-Z
DECLARE FUNCTION over% (num%, bot%, top%)
DECLARE FUNCTION under% (num%, bot%, top%)
DECLARE SUB menu (choice%(), set$(), ptr%, top%, rows%, space%, curs%, x%, y%, w%, col%, bor%, p%)
DECLARE FUNCTION small% (n1%, n2%)
DECLARE FUNCTION large% (n1%, n2%)
DECLARE SUB setmodex ()
DECLARE SUB copypage (BYVAL page1, BYVAL page2)
DECLARE SUB setvispage (BYVAL page)
DECLARE SUB drawsprite (pic(), pal(), BYVAL po, BYVAL x, BYVAL y, BYVAL page)
DECLARE SUB wardsprite (pic(), pal(), BYVAL po, BYVAL x, BYVAL y, BYVAL page)
DECLARE SUB loadsprite (pic(), BYVAL x, BYVAL y, BYVAL w, BYVAL h, BYVAL page)
DECLARE SUB stosprite (pic(), BYVAL x, BYVAL y, BYVAL page)
DECLARE SUB fadeto (palbuff(), BYVAL red, BYVAL green, BYVAL blue)
DECLARE SUB fadetopal (pal(), palbuff())
DECLARE SUB setpal (pal())
DECLARE SUB clearpage (BYVAL page)
DECLARE SUB loadpage (buf(), fil$, BYVAL p)
DECLARE SUB storepage (buf(), fil$, BYVAL p)
DECLARE SUB setkeys ()
DECLARE SUB setfont (f())
DECLARE SUB printstr (s$, BYVAL x, BYVAL y, BYVAL p)
DECLARE SUB textcolor (BYVAL f, BYVAL b)
DECLARE SUB setitup (fil$, buff(), BYVAL p)
DECLARE SUB resetdsp
DECLARE SUB playsnd (BYVAL n, BYVAL f)
DECLARE SUB closefile
DECLARE SUB setpicstuf (buf(), BYVAL b, BYVAL p)
DECLARE SUB loadset (fil$, BYVAL i, BYVAL l)
DECLARE SUB storeset (fil$, BYVAL i, BYVAL l)
DECLARE SUB rectangle (BYVAL x, BYVAL y, BYVAL w, BYVAL h, BYVAL c, BYVAL p)
DECLARE SUB setwait (b(), BYVAL t)
DECLARE FUNCTION Keyseg ()
DECLARE FUNCTION keyoff ()
DECLARE FUNCTION keyval (BYVAL a)
DECLARE FUNCTION getkey ()
TYPE Regtype
 ax AS INTEGER
 bx AS INTEGER
 cx AS INTEGER
 dx AS INTEGER
 bp AS INTEGER
 si AS INTEGER
 di AS INTEGER
 flags AS INTEGER
 ds AS INTEGER
 es AS INTEGER
END TYPE
DIM SHARED regs AS Regtype
regs.ax = &H3509: CALL interruptx(&H21, regs, regs)
off9 = regs.bx: seg9 = regs.es
DIM font(1024), master(767), noise(16384), fade(1536), placer(4000), pal(1584), timing(4), animate(200), team(15), obey(15)
RANDOMIZE TIMER
setmodex
DEF SEG = VARSEG(font(0)): BLOAD "font.dat", VARPTR(font(0)): setfont font(): textcolor 15, 0
setpal master(): DEF SEG = VARSEG(master(0)): BLOAD "master.pal", VARPTR(master(0))
setpal master()
DEF SEG = VARSEG(pal(0)): BLOAD "card.pal", VARPTR(pal(0))
GOSUB switchon: CALL resetdsp
max = 12: delay = 110

setpicstuf noise(), 16000, 2
FOR i = 0 TO 3
loadset "card.bac" + CHR$(0), a + i, i * 50
NEXT i

'setkeys
'a = 0
'FOR y = 0 TO 199
'FOR x = 319 TO 0 STEP -1
'setkeys
'c = 112 + INT(RND * 6) + (RND * INT(y / 33))
'rectangle x, y, small(y / 40, 1), 1, c, 0
'IF keyval(1) > 1 THEN x = 0: y = 199
'NEXT: NEXT
'copypage 0, 2

x = 0: y = 0
GOSUB load
setkeys
DO: setkeys
IF keyval(1) > 1 THEN GOTO noloop
IF keyval(15) > 1 THEN GOSUB finis
IF keyval(51) > 1 THEN p = large(p - 1, 0): GOSUB load
IF keyval(52) > 1 THEN p = small(p + 1, max): GOSUB load
IF keyval(26) > 1 THEN poff = poff - 16
IF keyval(27) > 1 THEN poff = poff + 16
IF keyval(72) > 1 THEN y = y - (1 + (4 * keyval(54)))
IF keyval(80) > 1 THEN y = y + (1 + (4 * keyval(54)))
IF keyval(75) > 1 THEN x = x - (1 + (4 * keyval(54))): dir = 0
IF keyval(77) > 1 THEN x = x + (1 + (4 * keyval(54))): dir = 1
IF keyval(57) > 1 THEN page = 2
IF dir = 0 THEN drawsprite placer(), pal(), poff, x, y, page ELSE wardsprite placer(), pal(), poff, x, y, page
page = 1
copypage 1, 0: copypage 2, 1
LOOP
load:
DEF SEG = VARSEG(placer(0)): BLOAD "draw\card." + RIGHT$(STR$(p), LEN(STR$(p)) - 1), VARPTR(placer(0))
RETURN

noloop:
setvispage 2

FOR i = 0 TO 3
storeset "card.bac" + CHR$(0), a + i, i * 50
NEXT i

finis:
fadeto fade(), 0, 0, 0
GOSUB shutoff
SCREEN 13: SYSTEM

switchon:
regs.ax = &H2509: regs.ds = Keyseg: regs.dx = keyoff
CALL interruptx(&H21, regs, regs)
RETURN

shutoff:
regs.ax = &H2509: regs.ds = seg9: regs.dx = off9
CALL interruptx(&H21, regs, regs)
RETURN

REM $STATIC
FUNCTION large (n1, n2)
large = n1
IF n2 > n1 THEN large = n2
END FUNCTION

SUB menu (choice(), set$(), ptr, top, rows, space, curs, x, y, w, col, bor, p)
textcolor 15, 0
IF bor > 0 THEN rectangle x - 1, y - 1, (w * 8) + 10, (space * rows) + 10, bor, p
IF col > 0 THEN rectangle x, y, (w * 8) + 8, (space * rows) + 8, col, p
FOR i = top TO top + rows - 1
IF choice(i) < 0 THEN textcolor 8, 0
printstr set$(ABS(choice(i))), x + 16, y + 4 + (space * (i - top)), p
textcolor 15, 0
IF i = ptr THEN printstr CHR$(curs), x + 4, y + 4 + (space * (i - top)), p
NEXT
END SUB

FUNCTION over (num, bot, top)
over = num
IF num > top THEN over = num - ((top - bot) + 1)
END FUNCTION

FUNCTION small (n1, n2)
small = n1
IF n2 < n1 THEN small = n2
END FUNCTION

FUNCTION under (num, bot, top)
under = num
IF num < bot THEN under = num + ((top - bot) + 1)
END FUNCTION