Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
24 Game (Math 24) Card Solver
#1
I am working on a program that solves 24 Game cards (the official 24 Game site is http://24game.com/). Variable cards are the wheel cards on the website, and wheel cards are the double wheel cards on the website. Quad cards (not on the website) are a special type of card in which there are four regular (single/double digit cards), only one of which has a solution. The program is currently slow (takes between 5 and 20 seconds to generate/solve a card). I am looking for ideas/suggestions to make it better and quicker. I am sorry for the complete lack of comments (a bad habbit of mine). Here is my code:
[code]
DECLARE FUNCTION max% (number1%, number2%)
DECLARE FUNCTION GOWait$ ()
DECLARE SUB GenCrd (CardType%)
DECLARE FUNCTION CardWork% (Num1 AS INTEGER, Num2 AS INTEGER, Num3 AS INTEGER, Num4 AS INTEGER, cardNum AS INTEGER)
DECLARE FUNCTION Check% (cardNum AS INTEGER)
DECLARE SUB DoSelects (BYVAL o AS INTEGER, p AS STRING, ts AS DOUBLE, e AS STRING, BYVAL Num1 AS DOUBLE, BYVAL Num2 AS DOUBLE)
DECLARE SUB PSols (curSolution%)
DECLARE SUB Solve (CardType%)
DECLARE FUNCTION CW% (Part%)
DECLARE FUNCTION rand% (lowerbound AS INTEGER, upperbound AS INTEGER)
DEFINT A-Z
TYPE RegType 'for CALL INTERRUPT
ax AS INTEGER
bx AS INTEGER
cx AS INTEGER
dx AS INTEGER
bp AS INTEGER
si AS INTEGER
di AS INTEGER
flags AS INTEGER
END TYPE
DECLARE SUB MouseDriver (m0%, m1%, m2%, m3%)
DECLARE SUB MouseHide ()
DECLARE SUB MouseInit ()
DECLARE SUB MousePoll (MouseRow%, MouseCol%, lButton%, rButton%)
DECLARE SUB MouseShow ()
DECLARE SUB AttrBox (row1%, col1%, row2%, col2%, attr%)
DECLARE SUB Box (row1%, col1%, row2%, col2%, fore%, back%, border$, fillFlag%)
DECLARE SUB GetBackground (row1%, col1%, row2%, col2%, buffer$)
DECLARE SUB GetCopyBox (row1%, col1%, row2%, col2%, buffer$)
DECLARE SUB Interrupt (intnum AS INTEGER, inregs AS RegType, outregs AS RegType)
DECLARE SUB PutBackground (row%, col%, buffer$)
DECLARE SUB PutCopyBox (row%, col%, buffer$)
DECLARE SUB Scroll (row1%, col1%, row2%, col2%, lines%, attr%)
DECLARE FUNCTION AltToASCII$ (kbd$)
DECLARE FUNCTION GetShiftState% (bit%)
DECLARE FUNCTION ShowInfo$ ()
CONST FALSE = 0
CONST TRUE = -1
CONST MINROW = 2
CONST MAXROW = 25
CONST MINCOL = 1
CONST MAXCOL = 80
CONST MAXMENU = 10
CONST MAXITEM = 20
CONST MAXWINDOW = 10
CONST MAXBUTTON = 50
CONST MAXEDITFIELD = 20
CONST MAXHOTSPOT = 20
DIM SHARED Solutions(4, 999) AS STRING
DIM SHARED p(3) AS STRING
DIM SHARED e(3) AS STRING
DIM SHARED ts(3) AS DOUBLE
DIM SHARED Number(1 TO 16)
DIM SHARED SUpTo AS INTEGER
DIM SHARED SUpToA(1 TO 4) AS INTEGER
KEY 15, CHR$(0) + CHR$(1)
ON KEY(15) GOSUB leaver
KEY(15) ON
MouseInit
MouseShow
DO
SUpTo = 1
doing$ = ShowInfo$
MouseHide
CLS
MouseShow
IF LEFT$(doing$, 1) = "s" THEN
SELECT CASE RIGHT$(doing$, 1)
CASE "r"
FOR i = 1 TO 4
DO
PRINT "Number " + LTRIM$(STR$(i)) + " = ";
INPUT "", n$
Number(i) = VAL(n$)
LOOP UNTIL Number(i) = INT(Number(i)) AND Number(i) > 0 AND Number(i) < 25
NEXT i
CALL Solve(1)
CASE "v"
FOR i = 1 TO 6
DO
PRINT "Number " + LTRIM$(STR$(i)) + " = ";
INPUT "", n$
Number(i) = VAL(n$)
LOOP UNTIL Number(i) = INT(Number(i)) AND Number(i) > 0 AND Number(i) < 25
NEXT i
CALL Solve(2)
CASE "w"
FOR i = 1 TO 12
DO
PRINT "Number " + LTRIM$(STR$(i)) + " = ";
INPUT "", n$
Number(i) = VAL(n$)
LOOP UNTIL Number(i) = INT(Number(i)) AND Number(i) > 0 AND Number(i) < 25
NEXT i
CALL Solve(3)
CASE "q"
FOR i = 1 TO 16
DO
PRINT "Number " + LTRIM$(STR$(i)) + " = ";
INPUT "", n$
Number(i) = VAL(n$)
LOOP UNTIL Number(i) = INT(Number(i)) AND Number(i) > 0 AND Number(i) < 25
NEXT i
CALL Solve(4)
END SELECT
ELSE
SELECT CASE RIGHT$(doing$, 1)
CASE "r"
CALL GenCrd(1)
CASE "v"
CALL GenCrd(2)
CASE "w"
CALL GenCrd(3)
CASE "q"
CALL GenCrd(4)
END SELECT
END IF
LOOP
leave:
MouseHide
CLS
KEY(15) OFF
PRINT "Thank you for using this program."
PRINT
PRINT
PRINT "This program was made by Jason Gross."
PRINT
PRINT "Press any key or click anywhere to exit."
MouseShow
ik$ = ""
DO
ik$ = INKEY$
CALL MousePoll(row, col, lButton, rButton)
IF lButton THEN
ik$ = "a"
END IF
LOOP WHILE ik$ = ""
END
leaver: GOTO leave

FUNCTION CardWork% (Num1 AS INTEGER, Num2 AS INTEGER, Num3 AS INTEGER, Num4 AS INTEGER, cardNum AS INTEGER)
DIM intn(0 TO 3)
SUpTo = 1
intn(0) = Num1
intn(1) = Num2
intn(2) = Num3
intn(3) = Num4
DIM o(0 TO 2)
DIM nu(0 TO 3)
DIM give(0 TO 1)
i = 1
FOR i = 1 TO 999
Solutions(cardNum, i) = ""
NEXT i
FOR n1 = 0 TO 3
FOR n2 = 0 TO 3
IF n2 <> n1 THEN
FOR n3 = 0 TO 3
IF n1 <> n3 AND n2 <> n3 THEN
FOR n4 = 0 TO 3
IF n1 <> n4 AND n2 <> n4 AND n3 <> n4 THEN
FOR o1 = 0 TO 3
FOR o2 = 0 TO 3
FOR o3 = 0 TO 3
nu(0) = intn(n1)
nu(1) = intn(n2)
nu(2) = intn(n3)
nu(3) = intn(n4)
ts(0) = nu(0)
o(0) = o1
o(1) = o2
o(2) = o3
FOR slw = 1 TO 4
FOR tlw = 1 TO 2
IF slw >= 3 THEN tlw = tlw + 2
CALL DoSelects(o(0), p(1), ts(1), e(1), nu(0), nu(1))
IF slw = 1 THEN
give(0) = ts(1)
give(1) = nu(2)
ELSEIF slw = 2 THEN
give(0) = nu(2)
give(1) = ts(1)
ELSEIF slw = 3 THEN
give(0) = nu(2)
give(1) = nu(3)
ELSE
give(0) = nu(3)
give(1) = nu(2)
END IF
CALL DoSelects(o(1), p(2), ts(2), e(2), give(0), give(1))
IF tlw = 1 THEN
give(0) = ts(2)
give(1) = nu(3)
ELSEIF tlw = 2 THEN
give(0) = nu(3)
give(1) = ts(2)
ELSEIF tlw = 3 THEN
give(0) = ts(1)
give(1) = ts(2)
ELSE
give(0) = ts(2)
give(1) = ts(1)
END IF
CALL DoSelects(o(2), p(3), ts(3), e(3), give(0), give(1))
IF slw >= 3 THEN tlw = tlw - 2
IF Check(cardNum) THEN works = TRUE
NEXT tlw
NEXT slw
NEXT o3
NEXT o2
NEXT o1
END IF
NEXT n4
END IF
NEXT n3
END IF
NEXT n2
NEXT n1
IF works THEN CardWork% = TRUE ELSE CardWork% = FALSE
END FUNCTION

FUNCTION Check (cardNum AS INTEGER)
working = TRUE
DIM StringIN AS STRING
StringIN = ""
IF ts(3) = 24 THEN
FOR i = 1 TO 3
StringIN = StringIN + p(i) + e(i)
IF i < 3 THEN StringIN = StringIN + CHR$(13)
NEXT i
Solutions(cardNum, SUpTo) = StringIN
SUpTo = SUpTo + 1
IF SUpTo <> 2 THEN
FOR i = 1 TO SUpTo - 2
IF Solutions(cardNum, i) = Solutions(cardNum, SUpTo - 1) THEN
working = FALSE
Solutions(cardNum, SUpTo - 1) = ""
SUpTo = SUpTo - 1
EXIT FOR
END IF
NEXT i
END IF
ELSE
working = FALSE
END IF
Check = working
END FUNCTION

FUNCTION CW% (Part)
CW% = CardWork%(Number((Part - 1) * 4 + 1), Number((Part - 1) * 4 + 2), Number((Part - 1) * 4 + 3), Number((Part - 1) * 4 + 4), Part)
END FUNCTION

SUB DoSelects (BYVAL o AS INTEGER, p AS STRING, ts AS DOUBLE, e AS STRING, BYVAL Num1 AS DOUBLE, BYVAL Num2 AS DOUBLE)
ON LOCAL ERROR GOTO errfix
IF Num1 < 0 OR Num2 < 0 OR Num1 <> INT(Num1) OR Num2 <> INT(Num2) THEN
p = "invalid"
ts = -1
e = ""
EXIT SUB
END IF
SELECT CASE o
CASE 0
p = LTRIM$(STR$(Num1)) + " + " + LTRIM$(STR$(Num2))
ts = Num1 + Num2
CASE 1
p = LTRIM$(STR$(Num1)) + " - " + LTRIM$(STR$(Num2))
ts = Num1 - Num2
CASE 2
p = LTRIM$(STR$(Num1)) + " * " + LTRIM$(STR$(Num2))
ts = Num1 * Num2
CASE 3
p = LTRIM$(STR$(Num1)) + " " + LTRIM$(RTRIM$(CHR$(246))) + " " + LTRIM$(STR$(Num2))
ts = Num1 / Num2
END SELECT
e = " = " + LTRIM$(STR$(ts))
IF ts <> INT(ts) OR ts < 0 THEN
p = "invalid"
ts = -1
e = ""
END IF
EXIT SUB
errfix:
SELECT CASE ERR
CASE 6, 11
p = "invalid"
ts = -1
e = ""
EXIT SUB
CASE ELSE
PRINT ERR
END
END SELECT
END SUB

SUB GenCrd (CardType)
SELECT CASE CardType
CASE 1
DO
DO
FOR i = 1 TO 4
Number(i) = rand(1, 24)
NEXT i
LOOP UNTIL CardWork%(Number(1), Number(2), Number(3), Number(4), 1)
MouseHide
CLS
FOR i = 1 TO 4
PRINT "Number "; LTRIM$(STR$(i)); " ="; Number(i)
NEXT i
MouseShow
ik$ = GOWait$
IF ik$ = "b" THEN EXIT SUB
IF ik$ = "s" THEN CALL Solve(CardType)
LOOP
CASE 2
DO
DO
working = FALSE
FOR i = 1 TO 6
Number(i) = rand(1, 24)
NEXT i
FOR i = 1 TO 9
IF CardWork%(Number(1), Number(2), Number(3), i, 1) AND CardWork%(Number(4), Number(5), Number(6), i, 2) THEN working = TRUE
NEXT i
LOOP UNTIL working
MouseHide
CLS
FOR i = 1 TO 3
PRINT "Number "; LTRIM$(STR$(i)); " ="; Number(i)
NEXT i
PRINT
FOR i = 4 TO 6
PRINT "Number "; LTRIM$(STR$(i)); " ="; Number(i)
NEXT i
MouseShow
ik$ = GOWait$
IF ik$ = "b" THEN EXIT SUB
IF ik$ = "s" THEN CALL Solve(CardType)
LOOP
CASE 3
DO
DO
working = FALSE
FOR i = 1 TO 12
Number(i) = rand(1, 24)
NEXT i
FOR i = 1 TO 9
IF CardWork%(Number(1), Number(2), Number(3), i, 1) AND CardWork%(Number(4), Number(5), Number(6), i, 2) THEN
IF CardWork%(Number(7), Number(8), Number(9), i, 3) AND CardWork%(Number(10), Number(11), Number(12), i, 4) THEN working = TRUE
END IF
NEXT i
LOOP UNTIL working
MouseHide
CLS
FOR i = 1 TO 3
PRINT "Number "; LTRIM$(STR$(i)); " ="; Number(i)
NEXT i
PRINT
FOR i = 4 TO 6
PRINT "Number "; LTRIM$(STR$(i)); " ="; Number(i)
NEXT i
PRINT
PRINT
FOR i = 7 TO 9
PRINT "Number "; LTRIM$(STR$(i)); " ="; Number(i)
NEXT i
PRINT
FOR i = 10 TO 12
PRINT "Number "; LTRIM$(STR$(i)); " ="; Number(i)
NEXT i
MouseShow
ik$ = GOWait$
IF ik$ = "b" THEN EXIT SUB
IF ik$ = "s" THEN CALL Solve(CardType)
LOOP
CASE 4
DO
DO
FOR i = 1 TO 16
Number(i) = rand(1, 24)
NEXT i
LOOP UNTIL CW%(1) XOR CW%(2) XOR CW%(3) XOR CW%(4)
MouseHide
CLS
FOR i = 1 TO 4
LOCATE ((i - 1) MOD 4) + 1, 20 * INT((i - 1) / 4) + 1
PRINT "Number "; LTRIM$(STR$(i)); " ="; Number(i)
NEXT i
PRINT
FOR i = 5 TO 8
LOCATE ((i - 1) MOD 4) + 1, 20 * INT((i - 1) / 4) + 1
PRINT "Number "; LTRIM$(STR$(i)); " ="; Number(i)
NEXT i
PRINT
FOR i = 9 TO 12
LOCATE ((i - 1) MOD 4) + 1, 20 * INT((i - 1) / 4) + 1
PRINT "Number "; LTRIM$(STR$(i)); " ="; Number(i)
NEXT i
PRINT
FOR i = 13 TO 16
LOCATE ((i - 1) MOD 4) + 1, 20 * INT((i - 1) / 4) + 1
PRINT "Number "; LTRIM$(STR$(i)); " ="; Number(i)
NEXT i
PRINT
MouseShow
ik$ = GOWait$
IF ik$ = "b" THEN EXIT SUB
IF ik$ = "s" THEN CALL Solve(CardType)
LOOP
END SELECT
END SUB

FUNCTION GOWait$
MouseHide
LOCATE 20, 1
PRINT TAB(9); "********* ********************* *************************"
PRINT TAB(9); "* Solve * * Generate New Card * * Choose Another Option *"
PRINT TAB(9); "********* ********************* *************************"
MouseShow
DO
ik$ = LCASE$(INKEY$)
IF ik$ = "c" THEN ik$ = "b"
IF ik$ <> "s" AND ik$ <> "g" AND ik$ <> "b" THEN ik$ = ""
CALL MousePoll(row, col, lButton, rButton)
IF lButton THEN
IF row > 19 AND row < 23 THEN
IF col > 8 AND col < 18 THEN ik$ = "s"
IF col > 20 AND col < 42 THEN ik$ = "g"
IF col > 44 AND col < 70 THEN ik$ = "b"
END IF
END IF
LOOP WHILE ik$ = ""
GOWait$ = ik$
END FUNCTION

FUNCTION max (number1, number2)
IF number1 > number2 THEN max = number1 ELSE max = number2
END FUNCTION

SUB MouseBorder (row1, col1, row2, col2) STATIC

' =======================================================================
' Sets max and min bounds on mouse movement both vertically, and
' horizontally
' =======================================================================

MouseDriver 7, 0, (col1 - 1) * 8, (col2 - 1) * 8
MouseDriver 8, 0, (row1 - 1) * 8, (row2 - 1) * 8

END SUB

SUB MouseDriver (m0, m1, m2, m3) STATIC

DIM regs AS RegType

IF MouseChecked = FALSE THEN
DEF SEG = 0

MouseSegment& = 256& * PEEK(207) + PEEK(206)
MouseOffset& = 256& * PEEK(205) + PEEK(204)

DEF SEG = MouseSegment&

IF (MouseSegment& = 0 AND MouseOffset& = 0) OR PEEK(MouseOffset&) = 207 THEN
MousePresent = FALSE
MouseChecked = TRUE
DEF SEG
END IF
END IF

IF MousePresent = FALSE AND MouseChecked = TRUE THEN
EXIT SUB
END IF

' =======================================================================
' Calls interrupt 51 to invoke mouse functions in the MS Mouse Driver.
' =======================================================================

regs.ax = m0
regs.bx = m1
regs.cx = m2
regs.dx = m3

Interrupt 51, regs, regs

m0 = regs.ax
m1 = regs.bx
m2 = regs.cx
m3 = regs.dx

IF MouseChecked THEN EXIT SUB

' =======================================================================
' Check for successful mouse initialization
' =======================================================================

IF m0 AND NOT MouseChecked THEN
MousePresent = TRUE
DEF SEG
END IF

MouseChecked = TRUE

END SUB

SUB MouseHide

' =======================================================================
' Decrements internal cursor flag
' =======================================================================

MouseDriver 2, 0, 0, 0

END SUB

SUB MouseInit

' =======================================================================
' Mouse driver's initialization routine
' =======================================================================

MouseDriver 0, 0, 0, 0

END SUB

SUB MousePoll (MouseRow, MouseCol, lButton, rButton) STATIC

' =======================================================================
' Polls mouse driver, then sets parms correctly
' =======================================================================

MouseDriver 3, button, MouseCol, MouseRow
MouseRow = MouseRow / 8 + 1
MouseCol = MouseCol / 8 + 1

IF button AND 1 THEN
lButton = TRUE
ELSE
lButton = FALSE
END IF

IF button AND 2 THEN
rButton = TRUE
ELSE
rButton = FALSE
END IF

END SUB

SUB MouseShow

' =======================================================================
' Increments mouse's internal cursor flag
' =======================================================================

MouseDriver 1, 0, 0, 0

END SUB

SUB PSols (curSolution) STATIC
MouseHide
PRINT
PRINT
PRINT
IF curSolution > 1 THEN
LOCATE 20, 5: PRINT "********"
LOCATE 21, 5: PRINT "* Last *"
LOCATE 22, 5: PRINT "********"
END IF
LOCATE 21, 31
PRINT "Solution ";
PRINT USING "###"; curSolution;
PRINT " of ";
PRINT USING "###"; SUpTo - 1
IF curSolution < SUpTo - 1 THEN
LOCATE 20, 69: PRINT "********"
LOCATE 21, 69: PRINT "* Next *"
LOCATE 22, 69: PRINT "********"
ELSE
LOCATE 20, 69: PRINT "********"
LOCATE 21, 69: PRINT "* Done *"
LOCATE 22, 69: PRINT "********"
END IF
MouseShow
DO
ik$ = LCASE$(INKEY$)
IF ik$ = "n" AND NOT (curSolution < SUpTo - 1) THEN ik$ = ""
IF (ik$ = "d" AND NOT (curSolution < SUpTo - 1)) OR ik$ = CHR$(0) + "m" THEN ik$ = "n"
IF ik$ = CHR$(0) + "k" AND curSolution > 1 THEN ik$ = "l"
IF ik$ <> "n" AND (ik$ <> "l" OR (ik$ = "l" AND NOT (curSolution > 1))) THEN ik$ = ""
IF ik$ <> "" THEN TimesArr = TimesArr + 1 ELSE TimesArr = 0
CALL MousePoll(row, col, lButton, rButton)
IF lButton THEN
IF row > 19 AND row < 23 THEN
IF curSolution > 1 AND col > 4 AND col < 13 THEN ik$ = "l"
IF curSolution < SUpTo AND col > 68 AND col < 77 THEN ik$ = "n"
END IF
END IF
LOOP WHILE ik$ = ""
IF ik$ = "l" THEN curSolution = curSolution - 1
IF ik$ = "n" THEN curSolution = curSolution + 1
IF lButton OR TimesArr < 3 THEN
PLAY "L3 N0"
ELSEIF TimesArr < 60 THEN
player$ = "L" + LTRIM$(STR$(TimesArr + 1)) + " N0"
PLAY player$
ELSE
PLAY "L60 N0"
END IF
END SUB

FUNCTION rand (lowerbound AS INTEGER, upperbound AS INTEGER)
RANDOMIZE TIMER
rand = INT((upperbound - lowerbound + 1) * RND + lowerbound)
END FUNCTION

FUNCTION ShowInfo$
MouseHide
CLS
PRINT "This program solves 24 Game cards and generates them."
PRINT
PRINT TAB(32); "****************"
PRINT TAB(32); "* Solve A Card *"
PRINT TAB(32); "****************"
PRINT
PRINT
PRINT TAB(31); "*******************"
PRINT TAB(31); "* Generate A Card *"
PRINT TAB(31); "*******************"
MouseShow
DO
dowc$ = LCASE$(INKEY$)
IF dowc$ <> "s" AND dowc$ <> "g" THEN dowc$ = ""
CALL MousePoll(row, col, lButton, rButton)
IF lButton THEN
IF row > 2 AND row < 6 AND col > 31 AND col < 48 THEN dowc$ = "s"
IF row > 7 AND row < 11 AND col > 30 AND col < 50 THEN dowc$ = "g"
END IF
LOOP WHILE dowc$ = ""
PLAY "L1 N0"
MouseHide
CLS
PRINT "This program solves 24 Game cards and generates them."
PRINT
PRINT TAB(10); "**************** *****************"
PRINT TAB(10); "* Regular Card * * Variable Card *"
PRINT TAB(10); "**************** *****************"
PRINT
PRINT
PRINT TAB(10); " ************** *************"
PRINT TAB(10); " * Wheel Card * * Quad Card *"
PRINT TAB(10); " ************** *************"
MouseShow
DO
tc$ = LCASE$(INKEY$)
IF tc$ <> "r" AND tc$ <> "q" AND tc$ <> "v" AND tc$ <> "w" THEN tc$ = ""
CALL MousePoll(row, col, lButton, rButton)
IF lButton THEN
IF row > 2 AND row < 6 THEN
IF col > 9 AND col < 26 THEN tc$ = "r"
IF col > 52 AND col < 70 THEN tc$ = "v"
END IF
IF row > 7 AND row < 11 THEN
IF col > 10 AND col < 25 THEN tc$ = "w"
IF col > 54 AND col < 78 THEN tc$ = "q"
END IF
END IF
LOOP WHILE tc$ = ""
ShowInfo$ = dowc$ + tc$
END FUNCTION

SUB Solve (CardType)
SELECT CASE CardType
CASE 1
IF CardWork%(Number(1), Number(2), Number(3), Number(4), 1) THEN
curSolution = 1
DO
MouseHide
CLS
FOR i = 1 TO 4
PRINT "Number "; LTRIM$(STR$(i)); " ="; Number(i)
NEXT i
PRINT
PRINT
PRINT Solutions(1, curSolution)
MouseShow
CALL PSols(curSolution)
LOOP UNTIL curSolution = SUpTo
ELSE
MouseHide
CLS
FOR i = 1 TO 4
PRINT "Number "; LTRIM$(STR$(i)); " ="; Number(i)
NEXT i
PRINT
PRINT
PRINT "This card does not work."
PRINT
PRINT "Press any key or click anywhere to continue."
MouseShow
ik$ = ""
DO
ik$ = INKEY$
CALL MousePoll(a, a, lButton, a)
IF lButton THEN
ik$ = "a"
END IF
LOOP WHILE ik$ = ""
END IF
CASE 2
DIM WVari(9) AS INTEGER
cv = 1
FOR vari = 1 TO 9
IF CardWork%(Number(1), Number(2), Number(3), vari, 1) AND CardWork%(Number(4), Number(5), Number(6), vari, 2) THEN
WVari(cv) = vari
cv = cv + 1
END IF
NEXT vari
tv = cv - 1
DO
MouseHide
CLS
FOR i = 1 TO 3
PRINT "Number "; LTRIM$(STR$(i)); " ="; Number(i)
NEXT i
PRINT
FOR i = 4 TO 6
PRINT "Number "; LTRIM$(STR$(i)); " ="; Number(i)
NEXT i
PRINT
PRINT
IF tv > 0 THEN
PRINT "Working Variables:"
FOR i = 1 TO tv
PRINT WVari(i)
NEXT i
LOCATE 20, 1
PRINT TAB(34); "************"
PRINT TAB(34); "* New Card *"
PRINT TAB(34); "************"
ELSE
PRINT "This card does not work."
PRINT
PRINT "Press any key or click anywhere to continue."
MouseShow
DO
ik$ = INKEY$
CALL MousePoll(a, a, lButton, a)
IF lButton THEN ik$ = "a"
LOOP WHILE ik$ = ""
EXIT SUB
END IF
PRINT
PRINT "Press the number of the variable that you want to see the solutions for."
MouseShow
DO
ik$ = INKEY$
IF ik$ <> "" THEN
working = FALSE
IF LCASE$(ik$) = "n" THEN EXIT SUB
FOR i = 1 TO tv
IF VAL(ik$) = WVari(i) THEN
working = -1
EXIT FOR
END IF
NEXT i
IF NOT working THEN ik$ = ""
END IF
CALL MousePoll(row, col, lButton, rButton)
IF lButton AND row > 19 AND row < 23 AND col > 33 AND col < 47 THEN EXIT SUB
LOOP WHILE ik$ = ""
CVari = VAL(ik$)
IF CardWork%(Number(1), Number(2), Number(3), CVari, 1) AND CardWork%(Number(4), Number(5), Number(6), CVari, 2) THEN
temp% = CardWork%(Number(1), Number(2), Number(3), CVari, 1)
SUpToA(1) = SUpTo
temp% = CardWork%(Number(4), Number(5), Number(6), CVari, 2)
SUpToA(2) = SUpTo
SUpTo = max(SUpToA(1), SUpToA(2))
curSolution = 1
DO
MouseHide
CLS
FOR i = 1 TO 3
PRINT "Number "; LTRIM$(STR$(i)); " ="; Number(i)
NEXT i
PRINT "Variable = "; CVari
FOR i = 4 TO 6
PRINT "Number "; LTRIM$(STR$(i)); " ="; Number(i)
NEXT i
PRINT
PRINT
PRINT Solutions(1, curSolution)
PRINT
PRINT Solutions(2, curSolution)
MouseShow
CALL PSols(curSolution)
LOOP UNTIL curSolution = SUpTo
END IF
LOOP
CASE 3
DIM WVari(9) AS INTEGER
cv = 1
FOR vari = 1 TO 9
IF CardWork%(Number(1), Number(2), Number(3), vari, 1) AND CardWork%(Number(4), Number(5), Number(6), vari, 2) THEN
IF CardWork%(Number(7), Number(8), Number(9), vari, 3) AND CardWork%(Number(10), Number(11), Number(12), vari, 4) THEN
WVari(cv) = vari
cv = cv + 1
END IF
END IF
NEXT vari
tv = cv - 1
DO
MouseHide
CLS
FOR i = 1 TO 3
LOCATE ((i - 1) MOD 3) + 1, 20 * INT((i - 1) / 3) + 1
PRINT "Number "; LTRIM$(STR$(i)); " ="; Number(i)
NEXT i
PRINT
FOR i = 4 TO 6
LOCATE ((i - 1) MOD 3) + 1, 20 * INT((i - 1) / 3) + 1
PRINT "Number "; LTRIM$(STR$(i)); " ="; Number(i)
NEXT i
PRINT
FOR i = 7 TO 9
LOCATE ((i - 1) MOD 3) + 1, 20 * INT((i - 1) / 3) + 1
PRINT "Number "; LTRIM$(STR$(i)); " ="; Number(i)
NEXT i
PRINT
FOR i = 9 TO 12
LOCATE ((i - 1) MOD 3) + 1, 20 * INT((i - 1) / 3) + 1
PRINT "Number "; LTRIM$(STR$(i)); " ="; Number(i)
NEXT i
PRINT
PRINT
IF tv > 0 THEN
PRINT "Working Variables:"
PRINT WVari(1);
IF tv > 1 THEN
FOR i = 2 TO tv
PRINT ","; WVari(i);
NEXT i
END IF
PRINT
LOCATE 20, 1
PRINT TAB(34); "************"
PRINT TAB(34); "* New Card *"
PRINT TAB(34); "************"
ELSE
PRINT "This card does not work."
PRINT
PRINT "Press any key or click anywhere to continue."
MouseShow
DO
ik$ = INKEY$
CALL MousePoll(a, a, lButton, a)
IF lButton THEN ik$ = "a"
LOOP WHILE ik$ = ""
EXIT SUB
END IF
PRINT
PRINT "Press the number of the variable that you want to see the solutions for."
MouseShow
DO
ik$ = INKEY$
IF ik$ <> "" THEN
working = FALSE
IF LCASE$(ik$) = "n" THEN EXIT SUB
FOR i = 1 TO tv
IF VAL(ik$) = WVari(i) THEN
working = -1
EXIT FOR
END IF
NEXT i
IF NOT working THEN ik$ = ""
END IF
CALL MousePoll(row, col, lButton, rButton)
IF lButton AND row > 19 AND row < 23 AND col > 33 AND col < 47 THEN EXIT SUB
LOOP WHILE ik$ = ""
CVari = VAL(ik$)
IF CardWork%(Number(1), Number(2), Number(3), CVari, 1) AND CardWork%(Number(4), Number(5), Number(6), CVari, 2) THEN
IF CardWork%(Number(7), Number(8), Number(9), CVari, 3) AND CardWork%(Number(10), Number(11), Number(12), CVari, 4) THEN
temp% = CardWork%(Number(1), Number(2), Number(3), CVari, 1)
SUpToA(1) = SUpTo
temp% = CardWork%(Number(4), Number(5), Number(6), CVari, 2)
SUpToA(2) = SUpTo
temp% = CardWork%(Number(7), Number(8), Number(9), CVari, 3)
SUpToA(3) = SUpTo
temp% = CardWork%(Number(10), Number(11), Number(12), CVari, 4)
SUpToA(4) = SUpTo
SUpTo = max(max(SUpToA(1), SUpToA(2)), max(SUpToA(3), SUpToA(4)))
curSolution = 1
DO
MouseHide
CLS
FOR i = 1 TO 3
LOCATE ((i - 1) MOD 3) + 1, 20 * INT((i - 1) / 3) + 1
PRINT "Number "; LTRIM$(STR$(i)); " ="; Number(i)
NEXT i
PRINT
FOR i = 4 TO 6
LOCATE ((i - 1) MOD 3) + 1, 20 * INT((i - 1) / 3) + 1
PRINT "Number "; LTRIM$(STR$(i)); " ="; Number(i)
NEXT i
PRINT
FOR i = 7 TO 9
LOCATE ((i - 1) MOD 3) + 1, 20 * INT((i - 1) / 3) + 1
PRINT "Number "; LTRIM$(STR$(i)); " ="; Number(i)
NEXT i
PRINT
FOR i = 9 TO 12
LOCATE ((i - 1) MOD 3) + 1, 20 * INT((i - 1) / 3) + 1
PRINT "Number "; LTRIM$(STR$(i)); " ="; Number(i)
NEXT i
PRINT
PRINT Solutions(1, curSolution)
PRINT
PRINT Solutions(2, curSolution)
PRINT
PRINT Solutions(3, curSolution)
PRINT
PRINT Solutions(4, curSolution)
MouseShow
CALL PSols(curSolution)
LOOP UNTIL curSolution = SUpTo
END IF
END IF
LOOP
CASE 4
IF CW%(1) XOR CW%(2) XOR CW%(3) XOR CW%(4) THEN
FOR i = 1 TO 4
IF CW%(i) THEN QW = i
NEXT i
curSolution = 1
temp% = CW%(QW)
DO
MouseHide
CLS
FOR i = 1 TO 4
LOCATE ((i - 1) MOD 4) + 1, 20 * INT((i - 1) / 4) + 1
PRINT "Number "; LTRIM$(STR$(i)); " ="; Number(i)
NEXT i
PRINT
FOR i = 5 TO 8
LOCATE ((i - 1) MOD 4) + 1, 20 * INT((i - 1) / 4) + 1
PRINT "Number "; LTRIM$(STR$(i)); " ="; Number(i)
NEXT i
PRINT
FOR i = 9 TO 12
LOCATE ((i - 1) MOD 4) + 1, 20 * INT((i - 1) / 4) + 1
PRINT "Number "; LTRIM$(STR$(i)); " ="; Number(i)
NEXT i
PRINT
FOR i = 13 TO 16
LOCATE ((i - 1) MOD 4) + 1, 20 * INT((i - 1) / 4) + 1
PRINT "Number "; LTRIM$(STR$(i)); " ="; Number(i)
NEXT i
PRINT
PRINT
PRINT "The Working Card Is:"
FOR i = 1 TO 4
PRINT "Number "; LTRIM$(STR$((QW - 1) * 4 + i)); " ="; Number((QW - 1) * 4 + i)
NEXT i
PRINT
PRINT
PRINT Solutions(QW, curSolution)
MouseShow
CALL PSols(curSolution)
LOOP UNTIL curSolution = SUpTo
ELSEIF CW%(1) OR CW%(2) OR CW%(3) OR CW%(4) THEN
MouseHide
CLS
FOR i = 1 TO 4
PRINT "Number "; LTRIM$(STR$(i)); " ="; Number(i)
NEXT i
PRINT
FOR i = 5 TO 8
PRINT "Number "; LTRIM$(STR$(i)); " ="; Number(i)
NEXT i
PRINT
FOR i = 9 TO 12
PRINT "Number "; LTRIM$(STR$(i)); " ="; Number(i)
NEXT i
PRINT
FOR i = 13 TO 16
PRINT "Number "; LTRIM$(STR$(i)); " ="; Number(i)
NEXT i
PRINT
PRINT
PRINT "More than one of the cards works."
PRINT
PRINT "Press any key or click anywhere to continue."
MouseShow
ik$ = ""
DO
ik$ = INKEY$
CALL MousePoll(a, a, lButton, a)
IF lButton THEN
ik$ = "a"
END IF
LOOP WHILE ik$ = ""
ELSE
MouseHide
CLS
FOR i = 1 TO 4
PRINT "Number "; LTRIM$(STR$(i)); " ="; Number(i)
NEXT i
PRINT
FOR i = 5 TO 8
PRINT "Number "; LTRIM$(STR$(i)); " ="; Number(i)
NEXT i
PRINT
Reply
#2
As pretty as it looks, I'll have to suggest posting the entire program within one code tag (because I still don't have privs to do this for you), so that it can be easily copy pasted into a single file.

I'm looking on the 24-game website and not seeing "wheel" cards or "double wheel" cards. Are they 96-card decks?
Reply
#3
For a sec I thought it was separite codes.. Yeah, Cha0s is right, you don't need to put the SUBs apart from the main code.. :wink: .. QB only does that to make it easier to read, its not required on the forums..
Kevin (x.t.r.GRAPHICS)

[Image: 11895-r.png]
Reply
#4
Oops :oops: , it's under variable cards on the website (http://24game.com/Catalog/catalog96_VAR.htm). Double wheel cards, or just wheel cards are 2 variable cards places side by side. They don't actually have a seperate "wheel card". I can't edit my posts in the Projects form, so I can't fix it (without posting it again), but now I know for next time.
Reply
#5
I edited it for you here, you'll notice your post isn't broken into seperate code sections, all into one now, like it should :-).
hen they say it can't be done, THAT's when they call me ;-).

[Image: kaffee.gif]
[Image: mystikshadows.png]

need hosting: http://www.jc-hosting.net
All about ASCII: http://www.ascii-world.com
Reply


Forum Jump:


Users browsing this thread: 1 Guest(s)