You are not logged in or registered. Please login or register to use the full functionality of this board...
SIGN IN Join Our Community For FREE


King's Court in QB64
06-15-2014, 10:03 PM (This post was last modified: 07-21-2014 12:29 AM by Waltersmind.)
Post: #1
 (Print Post)
King's Court in QB64
Kings court is a 2 player game.

Controls: Use Arrow key choose a piece or a board location and press ENTER. Use BACKSPACE to deselect a piece and choose another.

I wrote King's Court on the Tandy 2000 over 25 years ago.

If you download and play the game, please leave a comment or suggestion. Hope you enjoy playing.

Donald


Code Snippet: [Select]
_TITLE "King's Court by Donald L. Foster Jr."


SCREEN _NEWIMAGE(1000, 735, 256)

_PALETTECOLOR 2, _RGB32(0, 60, 0) '      Dk Ggreen
_PALETTECOLOR 3, _RGB32(255, 215, 0) '   Gold
_PALETTECOLOR 8, _RGB32(180, 180, 180) ' Grey
_PALETTECOLOR 4, _RGB32(255, 69, 0) '    Red Orange

_LIMIT 100

a = 1: b = 2: c = 1: d = 1: e = 1: f = 1: q = 0: r = 0: s = 0
c(1) = 4: c(2) = 2
d(1, 1) = 1: d(1, 2) = 2: d(1, 3) = 1: d(1, 4) = 2: d(1, 5) = 1: d(1, 6) = 2: d(1, 7) = 1: d(1, 8) = 2
d(2, 1) = 2: d(2, 2) = 1: d(2, 3) = 2: d(2, 4) = 1: d(2, 5) = 2: d(2, 6) = 1: d(2, 7) = 2: d(2, 8) = 1
d(3, 1) = 1: d(3, 2) = 2: d(3, 7) = 1: d(3, 8) = 2
d(4, 1) = 2: d(4, 2) = 1: d(4, 7) = 2: d(4, 8) = 1
d(5, 1) = 1: d(5, 2) = 2: d(5, 7) = 1: d(5, 8) = 2
d(6, 1) = 2: d(6, 2) = 1: d(6, 7) = 2: d(6, 8) = 1
d(7, 1) = 1: d(7, 2) = 2: d(7, 3) = 1: d(7, 4) = 2: d(7, 5) = 1: d(7, 6) = 2: d(7, 7) = 1: d(7, 8) = 2
d(8, 1) = 2: d(8, 2) = 1: d(8, 3) = 2: d(8, 4) = 1: d(8, 5) = 2: d(8, 6) = 1: d(8, 7) = 2: d(8, 8) = 1
cr1$ = "r35d7l28d28l7u35": cr2$ = "l35d7r28d28r7u35": cr3$ = "r35u7l28u28l7d35": cr4$ = "l35u7r28u28r7d35": dimd$ = "f42g42h42e42d1f41g41h42e41"

LINE (4, 4)-(731, 731), 2, BF: LINE (25, 25)-(710, 710), 3, BF: LINE (58, 18)-(677, 717), 3, B: LINE (18, 58)-(717, 677), 3, B: LINE (27, 27)-(708, 708), 8, BF
LINE (197, 197)-(539, 539), 3, BF: LINE (199, 199)-(537, 537), 2, BF

PSET (14, 14), 3: DRAW cr1$: PAINT (15, 15), 3: PSET (721, 14), 3: DRAW cr2$: PAINT (720, 15), 3: PSET (14, 721), 3: DRAW cr3$: PAINT (15, 720), 3: PSET (721, 721), 3: DRAW cr4$: PAINT (720, 720), 3

v = 0
FOR z = 1 TO 8
    x = 0
    FOR y = 1 TO 8
        IF d(z, y) = 0 THEN w = 3 ELSE w = 4
        PSET (70 + x, 28 + v), w: DRAW dimd$: PAINT (70 + x, 33 + v), 14, w
        IF d(z, y) > 0 THEN CIRCLE (70 + x, 70 + v), 25, c(d(z, y)): PAINT (70 + x, 70 + v), c(d(z, y)): CIRCLE (70 + x, 70 + v), 20, 15, .8, 4: CIRCLE (70 + x, 70 + v), 16, 0, 4, .8
        a(z, y) = 70 + x: b(z, y) = 70 + v
        x = x + 85
    NEXT
    v = v + 85
NEXT

LINE (736, 4)-(996, 264), 2, BF: LINE (757, 25)-(975, 243), 3, BF: LINE (790, 18)-(942, 250), 3, B: LINE (750, 58)-(982, 210), 3, B: LINE (759, 27)-(973, 241), 8, BF
PSET (746, 14), 3: DRAW cr1$: PAINT (748, 16), 3: PSET (986, 14), 3: DRAW cr2$: PAINT (984, 16), 3: PSET (746, 254), 3: DRAW cr3$: PAINT (758, 252), 3: PSET (986, 254), 3: DRAW cr4$: PAINT (984, 252), 3
LINE (821, 90)-(910, 178), 3, BF: LINE (823, 92)-(908, 176), 2, BF: PSET (866, 92), 3: DRAW dimd$: PAINT (865, 105), 14, 3
LOCATE 44, 97: PRINT "K I N G ' S     C O U R T";

STARTGAME:
CIRCLE (865, 134), 25, c(a): PAINT (866, 134), c(a)
LOCATE 19, 99: PRINT "P  L  A  Y  E  R   "; a;
CIRCLE (865, 134), 20, 15, .8, 4
CIRCLE (865, 134), 16, 0, 4, .8

CURSOR1:
IF d(c, d) > 0 THEN u = c(d(c, d)) ELSE u = 14
LINE (a(c, d) - 10, b(c, d) - 10)-(a(c, d) + 10, b(c, d) + 10), u, BF
LINE (a(e, f) - 10, b(e, f) - 10)-(a(e, f) + 10, b(e, f) + 10), 0, BF
LINE (a(e, f) - 7, b(e, f) - 7)-(a(e, f) + 7, b(e, f) + 7), 15, BF

GETINPUT1:
a$ = INKEY$: IF a$ = "" THEN GOTO GETINPUT1
IF (f = 8) * (a$ = CHR$(0) + CHR$(77)) THEN c = e: d = f: f = 1: GOTO CURSOR1
IF a$ = CHR$(0) + CHR$(77) THEN c = e: d = f: f = f + 1: GOTO CURSOR1
IF (f = 1) * (a$ = CHR$(0) + CHR$(75)) THEN c = e: d = f: f = 8: GOTO CURSOR1
IF a$ = CHR$(0) + CHR$(75) THEN c = e: d = f: f = f - 1: GOTO CURSOR1
IF (e = 1) * (a$ = CHR$(0) + CHR$(72)) THEN c = e: d = f: e = 8: GOTO CURSOR1
IF a$ = CHR$(0) + CHR$(72) THEN c = e: d = f: e = e - 1: GOTO CURSOR1
IF (e = 8) * (a$ = CHR$(0) + CHR$(80)) THEN c = e: d = f: e = 1: GOTO CURSOR1
IF a$ = CHR$(0) + CHR$(80) THEN c = e: d = f: e = e + 1: GOTO CURSOR1
IF ASC(a$) <> 13 THEN GOTO GETINPUT1

IF d(e, f) <> a THEN GOTO GETINPUT1

LINE180:
a1 = 0: a2 = 0: a3 = 0: a4 = 0

IF (s = 0) * (a = 2) * (q = 1) * (e <> 7) THEN a1 = 0: GOTO ENDCHECK
IF (s = 0) * (a = 2) * (q = 1) * (e = 7) * (d(7, f) = 0) THEN a1 = 1: GOTO ENDCHECK
IF (s = 0) * (a = 2) * (q = 2) * (f <> 2) THEN a2 = 0: GOTO ENDCHECK
IF (s = 0) * (a = 2) * (q = 2) * (f = 2) * (d(e, 2) = 0) THEN a2 = 1: GOTO ENDCHECK
IF (s = 0) * (a = 2) * (q = 3) * (e <> 2) THEN a3 = 0: GOTO ENDCHECK
IF (s = 0) * (a = 2) * (q = 3) * (e = 2) * (d(2, f) = 0) THEN a3 = 1: GOTO ENDCHECK
IF (s = 0) * (a = 2) * (q = 4) * (f <> 7) THEN a4 = 0: GOTO ENDCHECK
IF (s = 0) * (a = 2) * (q = 4) * (f = 7) * (d(e, 7) = 0) THEN a4 = 1: GOTO ENDCHECK

IF e - 1 >= 1 THEN IF (d(e - 1, f) = 0) * (t = 0) THEN a1 = 1
IF e - 2 >= 1 THEN IF (d(e - 1, f) > 0) * (d(e - 2, f) = 0) * (s = 1) * ((e - 1 <> k) + (f <> l)) THEN a1 = 2

IF f + 1 <= 8 THEN IF (d(e, f + 1) = 0) * (t = 0) THEN a2 = 1
IF f + 2 <= 8 THEN IF (d(e, f + 1) > 0) * (d(e, f + 2) = 0) * (s = 1) * ((e <> k) + (f + 1 <> l)) THEN a2 = 2

IF e + 1 <= 8 THEN IF (d(e + 1, f) = 0) * (t = 0) THEN a3 = 1
IF e + 2 <= 8 THEN IF (d(e + 1, f) > 0) * (d(e + 2, f) = 0) * (s = 1) * ((e + 1 <> k) + (f <> l)) THEN a3 = 2

IF f - 1 >= 1 THEN IF (d(e, f - 1) = 0) * (t = 0) THEN a4 = 1
IF f - 2 >= 1 THEN IF (d(e, f - 1) > 0) * (d(e, f - 2) = 0) * (s = 1) * ((e <> k) + (f - 1 <> l)) THEN a4 = 2

ENDCHECK:
IF (a1 = 0) * (a2 = 0) * (a3 = 0) * (a4 = 0) * (t = 1) THEN GOTO ENDOFTURN
IF (a1 = 0) * (a2 = 0) * (a3 = 0) * (a4 = 0) THEN GOTO GETINPUT1

g = e: h = f: i = e: j = f

CURSOR2:
IF (g = e) * (h = f) THEN u = 0 ELSE IF d(g, h) > 0 THEN u = c(d(g, h)) ELSE u = 14
LINE (a(g, h) - 10, b(g, h) - 10)-(a(g, h) + 10, b(g, h) + 10), u, BF
IF u = 0 THEN LINE (a(g, h) - 7, b(g, h) - 7)-(a(g, h) + 7, b(g, h) + 7), 8, BF
LINE (a(i, j) - 10, b(i, j) - 10)-(a(i, j) + 10, b(i, j) + 10), 0, BF
LINE (a(i, j) - 7, b(i, j) - 7)-(a(i, j) + 7, b(i, j) + 7), 15, BF

GETINPUT2:
a$ = INKEY$: IF a$ = "" THEN GOTO GETINPUT2
IF (j = 8) * (a$ = CHR$(0) + CHR$(77)) THEN g = i: h = j: j = 1: GOTO CURSOR2
IF a$ = CHR$(0) + CHR$(77) THEN g = i: h = j: j = j + 1: GOTO CURSOR2
IF (j = 1) * (a$ = CHR$(0) + CHR$(75)) THEN g = i: h = j: j = 8: GOTO CURSOR2
IF a$ = CHR$(0) + CHR$(75) THEN g = i: h = j: j = j - 1: GOTO CURSOR2
IF (i = 1) * (a$ = CHR$(0) + CHR$(72)) THEN g = i: h = j: i = 8: GOTO CURSOR2
IF a$ = CHR$(0) + CHR$(72) THEN g = i: h = j: i = i - 1: GOTO CURSOR2
IF (i = 8) * (a$ = CHR$(0) + CHR$(80)) THEN g = i: h = j: i = 1: GOTO CURSOR2
IF a$ = CHR$(0) + CHR$(80) THEN g = i: h = j: i = i + 1: GOTO CURSOR2
IF (t = 0) * ((ASC(a$) = 8) + ((i = e) * (j = f) * (ASC(a$) = 13))) THEN c = i: d = j: GOTO CURSOR1
IF (t = 1) * (i = e) * (j = f) * (ASC(a$) = 13) THEN GOTO ENDOFTURN
IF ASC(a$) <> 13 THEN GOTO GETINPUT2

x = 0
IF ((a1 = 1) * (i = e - 1) * (j = f)) + ((a2 = 1) * (i = e) * (j = f + 1)) + ((a3 = 1) * (i = e + 1) * (j = f)) + ((a4 = 1) * (i = e) * (j = f - 1)) THEN x = 1
IF (a1 = 2) * (i = e - 2) * (j = f) THEN k = e - 1: l = f: x = 2
IF (a2 = 2) * (i = e) * (j = f + 2) THEN k = e: l = f + 1: x = 2
IF (a3 = 2) * (i = e + 2) * (j = f) THEN k = e + 1: l = f: x = 2
IF (a4 = 2) * (i = e) * (j = f - 2) THEN k = e: l = f - 1: x = 2
IF x = 0 THEN GOTO GETINPUT2

IF (e = 2) * (s = 0) * (a = 1) THEN q = 1
IF (f = 7) * (s = 0) * (a = 1) THEN q = 2
IF (e = 7) * (s = 0) * (a = 1) THEN q = 3
IF (f = 2) * (s = 0) * (a = 1) THEN q = 4

d(e, f) = 0: PAINT (a(e, f), b(e, f)), 14
d(i, j) = a: CIRCLE (a(i, j), b(i, j)), 25, c(d(i, j)): PAINT (a(i, j), b(i, j)), c(a): CIRCLE (a(i, j), b(i, j)), 20, 15, .8, 4: CIRCLE (a(i, j), b(i, j)), 16, 0, 4, .8

IF x = 2 THEN IF d(k, l) = b THEN d(k, l) = 0: PAINT (a(k, l), b(k, l)), 14

r(1) = 0: r(2) = 0: p = 0
FOR z = 3 TO 6: FOR y = 3 TO 6: IF d(z, y) > 0 THEN r(d(z, y)) = 1
NEXT: NEXT

IF (r(1) = 0) * (r(2) = 0) * (s = 1) THEN p = 3 ELSE IF (r(1) = 0) * (s = 1) THEN p = 2 ELSE IF (r(2) = 0) * (s = 1) THEN p = 1

IF p = 3 THEN
    LOCATE 25, 98: PRINT "THE GAME IS FORFITTED.";
ELSEIF p > 0 THEN
    LOCATE 25, 97: PRINT "PLAYER"; p; "IS THE WINNER!!";
    CIRCLE (865, 134), 25, c(p): PAINT (866, 134), c(p)
    LOCATE 19, 99: PRINT "P  L  A  Y  E  R   "; p;
ELSE GOTO LINE330
END IF

LOCATE 27, 100: PRINT "PLAY ANOTHER GAME?";

ANOTHERGAME:
a$ = INKEY$: IF a$ = "" THEN GOTO ANOTHERGAME
IF (a$ = "y") + (a$ = "Y") THEN RUN
IF (a$ = "n") + (a$ = "N") THEN END
GOTO ANOTHERGAME

LINE330:
IF x = 2 THEN e = i: f = j: t = 1: GOTO LINE180
IF r >= 1 THEN s = 1
r = r + 1

ENDOFTURN:
c = e: d = f: e = 1: f = 1: k = 0: l = 0: t = 0: SWAP a, b: GOTO STARTGAME

   
           
   


MODIFIED BY ADMINISTRATOR:


Attached File(s)
.bas  King's Court.bas (Size: 8.24 KB / Downloads: 63)
Find all posts by this user
Like Post
The following 2 users Like Donald Foster's post:
thelasttruegreatamerican, Waltersmind (Admin)
03-08-2017, 07:46 PM
Post: #2
 (Print Post)
RE: King's Court in QB64
I recall playing this board game many years back and can't believe you've
brought this into the world of qb64. Truly outstanding, going to give it a try
now.
Find all posts by this user
Like Post



Forum Jump:


User(s) browsing this thread: 1 Guest(s)




QB64 Member Project - STxAxTIC 3D World
QB64 Member Project - Exit
QB64 Member Project - Spiro Roses
QB64 Member Project - Amazon
QB64 Member Project - Dakapo
QB64 Member Project - Color Rotating Text
QB64 Member Project - ARB Checkers
QB64 Member Project - Kings Valley verion one
QB64 Member Project - Basic Dithering
QB64 Member Project - Algeria Weather
QB64 Member Project - Kings Court
QB64 Member Project - Red Scrolling LED Sign
QB64 Member Project - Pivot version two
QB64 Member Project - Domain
QB64 Member Project - Martin Fractals version two
QB64 Member Project - Quarto
QB64 Member Project - Kobolts Monopoly
QB64 Member Project - Inside Moves
QB64 Member Project - RGB Color Wheel
QB64 Member Project - Martin Fractals version three
QB64 Member Project - Overboard
QB64 Member Project - OpenGL Triangles
QB64 Member Project - Spinning Color Wheel
QB64 Member Project - Blokus
QB64 Member Project - Connect Four
QB64 Member Project - Kings Vallery version two
QB64 Member Project - Input
QB64 Member Project - Rotating Background
QB64 Member Project - Qubic
QB64 Member Project - Touche
QB64 Member Project - Dreamy Clock
QB64 Member Project - Rubix's Magic
QB64 Member Project - Swirl
QB64 Member Project - Score 4
QB64 Member Project - Point Blank
QB64 Member Project - Isolation
QB64 Member Project - Pivet version one
QB64 Member Project - Foursight
QB64 Member Project - Line Thickness
QB64 Member Project - Splatter
QB64 Member Project - Martin Fractals version one
QB64 Member Project - Othello
QB64 Member Project - Bowditch curve
QB64 Member Project - Color Triangles
QB64 Member Project - Full Color LED Sign
QB64 Member Project - Martin Fractals version four
QB64 Member Project - 9 Board
QB64 Member Project - Sabotage
QB64 Member Project - MAPTRIANGLE