Rummikub Referee

[B+]

I think I can work out the AI for Rummikub IF.... but I haven't played this game so am not familiar with all fine points of game, so I need a ruling:

IF a player rearranges all the sets or most on table and IF all the sets are legal AND the player adds a tile from his rack it's OK right? ie it is not necessary to follow and rule every rearranged set along the way.

Wait one caveat, if the player uses a joker in another place he must first provide the legal substitute for that joker from his rack THEN he is free to use it any where he pleases and then thus able to completely rearrange any or all the sets as long as he leaves all legal sets when done.

Ah another caveat, for any joker not replaced, that Joker's placement in that set can't be moved or broken until a real tile replaces it. eg if joker is sitting at high end of straight it (can or can 't) be moved to low end if player wants to play a tile below that ?

hmm... these Jokers aren't funny ;(

I was thinking an AI referee would just have to copy the table, and the players hand (or AI if AI's turn) before the turn, wait until player (or AI) says they are done.
THEN the AI referee would just need to see if all the new sets are legal, if so allow next player's turn, if NOT restore table as it was and player's rack as it was and either force player to take a tile or have player do sets over again (pointing out the first illegal set discovered after player says his turn is done).

So I am thinking the above would be fine for refereeing if NO Jokers.

With Jokers, the player must replace Joker(s) with his own tile first before accessing the whole table freely to rearrange otherwise the Joker stays glued to it's position in a Straight or it's number and open color in a group.

Here is code for checking if a set is legal even if it contains one or two Jokers and it will assign the highest legal points allowed, say if player has a Joker positioned at low end of straight, the setOK function will give point credit for high end up to 13 and then start just below if 2 Jokers.  


'test setOK function" 'b+ 2019-10-25
' convert to JB 2019-10-29
'setOK% is such a monster function I want to test it independent from random tile assignments,
'see if I can break it with a legal set and get no points or wrong points or get points for illegal sets
'specially test 1 and 2 joker states
DIM table$(40), n(0), c(0) 'arrays are global n() is for numbers and c() is for colors, table$() holds the different sets of tiles.

table$(1) = "1_1 2_1 " 'right 0 points, not even long enough to check
table$(2) = "1_1 2_1 3_1 " ' legal starting, return 3
table$(3) = "1_1 2_1 1_3 " 'OK not legal 0 points
table$(4) = "3_4 3_5 3_6 " 'legal straight 15 points
table$(5) = "3_6 3_4 3_5 " 'mix order
table$(6) = "3_6 5_J 3_4 3_5 " 'mix order  add joker  15+7 = 22 great!
table$(7) = "3_2 3_6 5_J 3_4 3_5 " ' add joker filling a straight 2+3+4+5+6 = 20 yeah!"  !!!'here's where troubles started
table$(8) = "3_2 3_6 5_J 3_4 3_5 3_8 6_J " ' two jokers filling inside straights 20 + 7 + 8 = 35 check !!! Oh my disaster!!!
table$(9) = "3_2 3_6 5_J 3_5 6_J " 'two jokers fill 2 places next to each other inside fantastic!
table$(10) = "3_125_J 3_116_J " '2 jokers cover outside slots both ends 10+11+12+13? =46 great!
table$(11) = "1_125_J 3_126_J " ' little change for group  4*12 = 48
table$(12) = "5_J 3_126_J " ' just one real color tile 3*12
table$(13) = "1_123_122_12" '3*12 the real way

for slot = 1 to 13
   PRINT "Slot ";slot;" Points ";setOK(table$(slot)) 'this will just print 0 because we are testing troubled first part of function
   input "Press enter... ";w$
next
print "Testing done."

FUNCTION setOK(setString$) 'return 0 if NOT OK, else return points

   nTiles = LEN(setString$) / 4
   print:print "Slot #";nSlot;" has nTiles = ";nTiles
   IF nTiles < 3 OR nTiles > 13 THEN EXIT FUNCTION 'NOT OK to have less than 3 tiles or more than 13

   'load 2 little arrays sorting as we go to analyse colors and numbers
   REDIM c(nTiles)
   redim n(nTiles) 'erase and redim

   FOR i = 1 TO nTiles
       tile$ = MID$(setString$, i * 4 - 3, 4)
       print "Tile$ ";tile$;
       clr = VAL(LEFT$(tile$, 1)): num = VAL(MID$(tile$, 3, 2))
       print "  clr ";clr;"  num ";num
       if i = 1 then
           c(1) = clr
       else
           for j = 1 to i - 1
               if clr < c(j) then
                   for k = i to j + 1 step -1
                       c(k) = c(k - 1)
                   next
                   exit for '<<< here is what I didn't do last night!!!
               end if
           next
           c(j) = clr
       end if
       'now same for num
       if i = 1 then
           n(1) = num
       else
           for j = 1 to i - 1
               if num < n(j) then
                   for k = i to j + 1 step -1
                       n(k) = n(k - 1)
                   next
                   exit for  '<<< here is what I didn't do last night!!!
               end if
           next
           n(j) = num
       end if
   NEXT
   print "check load/sort of colors and numbers:"
   for i = 1 to nTiles
       print i, c(i), n(i)
   next

   'colors: either they are all the same which means the numbers need to be in sequence
   ' or they are all different and total 3 or 4 tiles
   ' for colors the jokers will sort last, for numbers the jokers will sort first

   'count jokers
   IF c(nTiles) = 5 OR c(nTiles) = 6 THEN
       joker = 1
       IF c(nTiles - 1) = 5 THEN joker = 2
   END IF
   start = joker + 1
   'color check
   IF c(1) = c(nTiles - joker) THEN 'do a straight check because all colors the same
       FOR i = start TO nTiles - 1 'jokers in numbers are at bottom the rest of the numbers are in sequence
           IF n(i) <> n(i + 1) - 1 THEN
               IF n(i) = n(i + 1) - 2 AND (joker > 0) THEN
                   joker = joker - 1: points = points + 2 * n(i) + 1
               ELSE
                   IF n(i) = n(i + 1) - 3 AND joker = 2 THEN
                       joker = 0: points = points + 3 * n(i) + 3
                   ELSE
                       EXIT FUNCTION 'don't have a straight
                   end if
               END IF
           ELSE
               points = points + n(i)
           END IF
       NEXT
       points = points + n(nTiles)
       'have we not used jokers in the middle?
       IF joker = 2 THEN '2 jokers!!! not used in middle what are the odds???
           IF n(nTiles) = 13 THEN
               points = points + 2 * n(start) - 3
           else
               IF n(nTiles) = 12 THEN
                   points = points + 13 + n(start) - 1
               ELSE 'n(nTiles)< 12
                   points = points + 2 * n(nTiles) + 3
               end if
           END IF
       END IF
       IF joker = 1 THEN
           IF n(nTiles) = 13 THEN
               points = points + n(start) - 1
           ELSE
               points = points + n(nTiles) + 1
           END IF
       END IF
   ELSE
       'see that all the colors are different and only 3 or 4 tiles and all the numbers are same if not joker
       IF nTiles > 4 THEN EXIT FUNCTION 'max 4 different colors
       IF n(start) <> n(nTiles) THEN EXIT FUNCTION 'not all the numbers ( past the jokers) are the same
       'now check each color is different
       FOR i = 1 TO nTiles - joker - 1 ' if 1 actual tile and 2 jokers this test wil not even start!
           FOR j = i + 1 TO nTiles - joker
               IF c(i) = c(j) THEN EXIT FUNCTION
           NEXT
       NEXT
       'if still here then
       points = nTiles * n(nTiles)
   END IF
   setOK = points
END FUNCTION



I think this is solid checker, if you find a set that is judged incorrectly, let me know.

I find it difficult to proceed with my AI meld maker SUB without more info about game rulings.

More notes: Jokers in my structure have color #5 and #6 and zero value in sorts of color and number. Tiles are 4 characters long the first is a color number 1 thru 6 then a _ for visually separating the color number from the tile number 1 thru 13 or J for Joker and a space if tile number is 1 character long. So a set minimally has to be 12 characters long, the tiles every 4 characters.

[Rod]

"IF a player rearranges all the sets or most on table and IF all the sets are legal AND the player adds a tile from his rack it's OK right? ie it is not necessary to follow and rule every rearranged set along the way."

The player must play a tile from his hand. If they cant they cant touch the table and will receive another tile out the bag. If they can play they must leave the table in good order else its all reset and they get a tile out the bag.

"Wait one caveat, if the player uses a joker in another place he must first provide the legal substitute for that joker from his rack THEN he is free to use it any where he pleases and then thus able to completely rearrange any or all the sets as long as he leaves all legal sets when done."

Yes, the player must play the correct tile to replace the joker. The joker must stay on the table it cannot go back into their hand.

"Ah another caveat, for any joker not replaced, that Joker's placement in that set can't be moved or broken until a real tile replaces it. eg if joker is sitting at high end of straight it (can or can 't) be moved to low end if player wants to play a tile below that ?"

The joker can be moved if the tile group remains legal so 5,6,j can become 3,j,5,6.

[Rod]

Ok don't want to get to picky too early, we can bend the playing rules if needs be and have our own Just BASIC version. However this play is a bit off.

Slot #0 has nTiles = 5
Tile$ 3_2 clr 3 num 2
Tile$ 3_6 clr 3 num 6
Tile$ 5_J clr 5 num 0
Tile$ 3_4 clr 3 num 4
Tile$ 3_5 clr 3 num 5
check load/sort of colors and numbers:
1 3 0
2 3 2
3 3 4
4 3 5
5 5 6
Slot 7 Points 20

The game is in two parts, 1) get to start playing by scoring more than 30 and laying down those chips on the table (the challenge we set), 2) then on your following turns play as many chips as possible. The first player to play all of their hand wins and the face value of the other players remaining chips determines the score for that round.

So if we have 2,4,5,6,j one play is 4,5,6,j leaving 2 in hand and the other is 2,j,4,5,6 leaving nothing in hand. Also 4,5,6,j is not a good play mid game because it allows the joker to be grabbed without substitution (4,5,6 remains and is a legal set). 2,j,4,5,6 requires the other player to have a 3 of the correct color to substitute.

I did say one step at a time

[B+]

Slot #0 has nTiles = 5
Tile$ 3_2 clr 3 num 2
Tile$ 3_6 clr 3 num 6
Tile$ 5_J clr 5 num 0
Tile$ 3_4 clr 3 num 4
Tile$ 3_5 clr 3 num 5
check load/sort of colors and numbers:
1 3 0
2 3 2
3 3 4
4 3 5
5 5 6
Slot 7 Points 20


Is a legal set because 2 J 4 5 6, joker fills the inside straight, all other colors are 3. Doesn't judge legality from the 2 independent sorts, the sorts take the tiles in different order according to color or according to number, I was just showing the sorts for debugging.

I was not depending on requiring the straight sets to be presented in correct order. I am just checking if tiles presented make a set and what best points are for it, towards meld. Imagine each test set individually (not the whole group together at once) just came from a player or AI trying to make meld points so that they can then play from table. This setOK function is needed to verify points and legality of each set, one at a time. You won't make meld unless the players or the AI referee agree your sets are legal.


I may need to know what sets are legal for judging if I have enough meld in my AI rack specially when one tile could be used in a Straight or a Color Group.

The joker can be moved if the tile group remains legal so 5,6,j can become 3,j,5,6.

Thanks probably needed to know that most. So joker on ends can be moved as long as player plays tile from his rack.

[B+]

I have the game progressed to point where Player's meld is made and accepted thanks to setOK function and graphic versions Mainwin commands with color.

' Rummikub Game.txt for JB v2 by B+ started 2019-10-31 using
' Mainscreen Commands for Graphics Window.txt for JB B+ 2019-10-12
' PLUS Color!!! The print here is 8X16 font.

'  Use: setup title$, desiredWidth, desiredHeight 'to setup a graphics window #gr

'Then use you can use these command substitutes for the graphics window:
'  locate = call locateG characterColumn, characterRow
'   print = call printG text$ '(strings only)
'   input = call inputG prompt$, variable$ '(string variable only)
'   color = call colorG fore$, back$ 'takes only string arguments
'           for colors I set up function QBcolr$(colrNum) to return QB color string for numbers 0 to 15
'     cls = call clsG 'clears to last colorG fore$, back$ used
' PLUS inkee$ is a global variable you have access to use like QB inkey$

' finish your code section with a wait command

' Globals for Rummikub Game
dim clr$(15)
clr$(0) = "black"
clr$(1) = "darkred"
clr$(2) = "darkgreen"
clr$(3) = "darkblue"
clr$(4) = "pink"
clr$(5) = "red" ' Joker 1
clr$(6) = "darkcyan" ' Joker 2
clr$(7) = "darkred"
clr$(8) = "darkgreen"
clr$(9) = "darkblue"
clr$(10) = "pink"
clr$(13) = "darkpink"  'for Computer
clr$(14) = "yellow" ' for player
clr$(15) = "white"  ' for info to Player

dim deck$(106) ' contains shuffled tiles,
dim table$(40) ' contains the sets played
dim pO$(13, 10) ' player Ordered rack
dim cO$(13, 10) ' computer Ordered Rack

Global deckPointer, nT, turn$, pMeld, cMeld, debug, nextTableSlot
debug = 1

call setup "Rummikub Game", 1200, 720 '150 x 45 characters check
call SetupGame
DO
   call colorG "yellow", "black"
   IF turn$ = "p" THEN 'player's turn
       call cp, 1, space$(150)
       call locateG 50, 1
       call inputG "Player, enter d to draw a tile or b to build a set. > ", choice$
       IF choice$ = "d" THEN
           call deck2Player
           call showPlayer
       ELSE 'build sets  check meld status
           'meld = table access
           IF pMeld = 0 THEN 'can only pull cards from rack and need to make meld  for builds to stick
               call handlePlayerBuildingMeld
           ELSE 'full table access

           END IF ' have meld
       END IF ' draw or build
   ELSE 'computer's turn

   END IF
   win$ = Rummikub$
   IF turn$ = "p" THEN turn$ = "c" ELSE turn$ = "p"
LOOP UNTIL win$ <> ""
wait

' ------------------------------------- Game Procedures

FUNCTION setOK(setString$) 'return 0 if NOT OK, else return points

   nTiles = LEN(setString$) / 4
   ' print:print "Slot #";slot;" has nTiles = ";nTiles
   IF nTiles < 3 OR nTiles > 13 THEN EXIT FUNCTION 'NOT OK to have less than 3 tiles or more than 13

   'load 2 little arrays sorting as we go to analyse colors and numbers
   REDIM c(nTiles)
   redim n(nTiles) 'erase and redim

   FOR i = 1 TO nTiles
       tile$ = MID$(setString$, i * 4 - 3, 4)
       ' print "Tile$ ";tile$;
       num = VAL(left$(tile$, 2)) : clr = VAL(right$(tile$, 1))
       ' print "  num ";num;"  clr ";clr
       if i = 1 then 'load number array
           n(1) = num
       else
           for j = 1 to i - 1
               if num < n(j) then
                   for k = i to j + 1 step -1
                       n(k) = n(k - 1)
                   next
                   exit for  '<<< here is what I didn't do last night!!!
               end if
           next
           n(j) = num
       end if
       if i = 1 then
           c(1) = clr
       else
           for j = 1 to i - 1
               if clr < c(j) then
                   for k = i to j + 1 step -1
                       c(k) = c(k - 1)
                   next
                   exit for '<<< here is what I didn't do last night!!!
               end if
           next
           c(j) = clr
       end if
   NEXT
   ' print "check load/sort of colors and numbers:"
   ' for i = 1 to nTiles
   '     print i, n(i), c(i)
   ' next

   'colors: either they are all the same which means the numbers need to be in sequence
   ' or they are all different and total 3 or 4 tiles
   ' for colors the jokers will sort last, for numbers the jokers will sort first

   'count jokers
   IF c(nTiles) = 5 OR c(nTiles) = 6 THEN
       joker = 1
       IF c(nTiles - 1) = 5 THEN joker = 2
   END IF
   start = joker + 1
   'color check
   IF c(1) = c(nTiles - joker) THEN 'do a straight check because all colors the same
       FOR i = start TO nTiles - 1 'jokers in numbers are at bottom the rest of the numbers are in sequence
           IF n(i) <> n(i + 1) - 1 THEN
               IF n(i) = n(i + 1) - 2 AND (joker > 0) THEN
                   joker = joker - 1: points = points + 2 * n(i) + 1
               ELSE
                   IF n(i) = n(i + 1) - 3 AND joker = 2 THEN
                       joker = 0: points = points + 3 * n(i) + 3
                   ELSE
                       EXIT FUNCTION 'don't have a straight
                   end if
               END IF
           ELSE
               points = points + n(i)
           END IF
       NEXT
       points = points + n(nTiles)
       'have we not used jokers in the middle?
       IF joker = 2 THEN '2 jokers!!! not used in middle what are the odds???
           IF n(nTiles) = 13 THEN
               points = points + 2 * n(start) - 3
           else
               IF n(nTiles) = 12 THEN
                   points = points + 13 + n(start) - 1
               ELSE 'n(nTiles)< 12
                   points = points + 2 * n(nTiles) + 3
               end if
           END IF
       END IF
       IF joker = 1 THEN
           IF n(nTiles) = 13 THEN
               points = points + n(start) - 1
           ELSE
               points = points + n(nTiles) + 1
           END IF
       END IF
   ELSE
       'see that all the colors are different and only 3 or 4 tiles and all the numbers are same if not joker
       IF nTiles > 4 THEN EXIT FUNCTION 'max 4 different colors
       IF n(start) <> n(nTiles) THEN EXIT FUNCTION 'not all the numbers ( past the jokers) are the same
       'now check each color is different
       FOR i = 1 TO nTiles - joker - 1 ' if 1 actual tile and 2 jokers this test wil not even start!
           FOR j = i + 1 TO nTiles - joker
               IF c(i) = c(j) THEN EXIT FUNCTION
           NEXT
       NEXT
       'if still here then
       points = nTiles * n(nTiles)
   END IF
   setOK = points
END FUNCTION

SUB handlePlayerBuildingMeld 'too monstrous for main loop
   slot = 40: points = 0
   DO
       call colorG "yellow", "black"
       for i = 1 to 6
           call cp i, space$(150)
       next
       s$ = "Player building meld: ";points;" points at Slot #";slot
       call cp 1, s$
       call cp 2, "Enter a tile label, number(1-13)_colr(1-4), of tile to select from rack,"
       call cp 3, " or enter <c> to check a Set (points towards meld totaled, new set started or disqualify and dismantle set),"
       call cp 4, " or enter <f> to finish Turn and store sets to table (or back to rack if no meld)."
       call locateG 70, 5
       call inputG "", cr$
       IF cr$ = "c" THEN
           'check the current set in current slot, if OK add up points towards meld and start a new slot for another set
           'if NOT Ok dismantle set back to rack
           check = setOK(table$(slot))
           IF check > 0 THEN
               points = points + check
               slot = slot - 1
               call cp 4, "Points toward meld " + str$(points)
           ELSE 'dismantle set message first
               call cp 4, "Set in slot " + str$(slot) + " is bad, dismantling."
               call pause 4
               gosub [dismantleSlot]
           END IF
       END IF
       IF cr$ = "f" THEN
           'if meld not made, return tiles to rack and get another tile
           if points < 30 then
               pMeld = 0 'dismantle slots
               for i = 1 to 40 - slot
                   gosub [dismantleSlot]
               next
           else
               pMeld = 1 'signal table access or not
               gosub [dismantleSlot] 'the last slot should be unfinished or unchecked
               for i = slot to 40
                   table$(nextTableSlot) = table$(i)
                   call showSlot nextTableSlot
                   nextTableSlot = nextTableSlot + 1
                   table$(i) = ""
                   call showSlot i
               next
           end if
           allChecked = 1 'so we can exit this sub
       END IF
       place = instr(cr$, "_")
       if place then
           if place = 2 or place = 3 then
               if place = 2 then c = val(left$(cr$, 1)) else c = val(left$(cr$, 2))
               r = val(right$(cr$, 1))
           end if
           IF 0 <= c AND c <= 13 AND 1 <= r AND r <= 10 THEN 'safe to check array
               IF r < 5 THEN
                   IF pO$(c, r + 6) <> "" THEN r = r + 6 'use the redundants first
               END IF
               IF pO$(c, r) <> "" THEN 'have a card  so move it
                   table$(slot) = table$(slot) + pO$(c, r)
                   pO$(c, r) = ""
                   call showSlot (slot)
                   call showPlayer
               END IF
           END IF 'check safe input safe
       end if
   LOOP until allChecked
   exit sub

[dismantleSlot]
   nTiles = len(table$(slot))/4
   for i = 1 to nTiles 'put em back into pO$
       call tile2player mid$(table$(slot), i * 4 -3, 4)
   next
   table$(slot) = ""
   call showSlot slot
   call showPlayer
   slot = slot + 1
   if slot > 40 then slot = 40
return
END SUB

SUB showSlot num
   call colorG clr$(15) , clr$(0)
   IF num > 20 THEN call locateG 83, num - 20 + 10 ELSE call locateG 8, num + 10
   call printG SPACE$(67)
   cnt = LEN(table$(num)) / 4
   FOR i = 1 TO cnt
       tile$ = MID$(table$(num), i * 4 - 3, 4)
       call colorG clr$(15), clr$(VAL(right$(tile$, 1)))
       IF num > 20 THEN call locateG 83 + i * 5 - 4, num - 20 + 10 ELSE call locateG 8 + i * 5 - 4, num + 10
       call printG tile$
   NEXT
   call colorG clr$(15), clr$(0)
END SUB

FUNCTION Rummikub$() ' do we have a winner?
   FOR row = 1 TO 10
       FOR col = 0 TO 13
           IF pO$(col, row) <> "" THEN GOTO [nextCheck]
       NEXT
   NEXT
   'still here?
   Rummikub$ = "p" 'player has cleaned out es rack!
   EXIT FUNCTION
   [nextCheck]
   FOR row = 1 TO 10
       FOR col = 0 TO 13
           IF cO$(col, row) <> "" THEN EXIT FUNCTION 'no winners!
       NEXT
   NEXT
   'still here?
   Rummikub$ = "c" 'computer has cleaned out es rack
END FUNCTION

SUB SetupGame 'initilizes tile set 2 sets of 13 numbers X 4 colors(1 to 4, Joker = 0 and 0 number) = 52 x 2 = 104 + 2 Jokers = 106 tiles
   'clear racks
   pMeld = 0: cMeld = 0: win$ = "" : nextTableSlot = 1
   IF deck$(1) = "" THEN 'create deck
       FOR set = 1 TO 2
           FOR num = 1 TO 13
               FOR clr = 1 TO 4
                   i = i + 1
                   deck$(i) = right$(" " + str$(num), 2) + "_" + str$(clr) ' number_color
               NEXT
           NEXT
       NEXT
       deck$(105) = " J_5": deck$(106) = " J_6" 'shuffle tile indexes
   END IF
   'shuffle deck
   FOR i = 106 TO 2 STEP -1
       R = INT(RND(0) * i) + 1
       tmp$ = deck$(i)
       deck$(i) = deck$(R)
       deck$(R) = tmp$
   NEXT
   deckPointer = 0 'deal some tiles out
   FOR i = 1 TO 14
       call deck2Player
       call deck2Computer
   NEXT
   call showTableSetup
   call showPlayer
   IF debug THEN call showComputer
   turn$ = "p"
END SUB

SUB deck2Player 'this is better than a sort, maybe
   deckPointer = deckPointer + 1
   IF deckPointer < 107 THEN
       tile$ = deck$(deckPointer)
       call tile2player tile$
   ELSE
       BEEP 'message out of tiles
   END IF
END SUB

SUB tile2player tile$ 'for dismantle of a set on the table, sending tiles back to player rack
   col = VAL(left$(tile$, 2)): row = VAL(right$(tile$, 1))
   IF pO$(col, row) <> "" THEN pO$(col, row + 6) = tile$ ELSE pO$(col, row) = tile$
END SUB

SUB deck2Computer 'this is better than a sort, maybe
   deckPointer = deckPointer + 1
   IF deckPointer < 107 THEN
       tile$ = deck$(deckPointer)
       col = VAL(left$(tile$, 2)): row = VAL(right$(tile$, 1))
       IF cO$(col, row) <> "" THEN cO$(col, row + 6) = tile$ ELSE cO$(col, row) = tile$
   ELSE
       notice "Deck is out of tiles."
   END IF
END SUB

SUB showTableSetup 'set up some labels player yellow, computer blue
   call colorG clr$(15), clr$(0) ' max sets = 105/3 = 37 so 2 coloumns of
   FOR row = 1 TO 20
       call locateG 1, row + 10 : call printG "Set " + RIGHT$(" " + str$(row), 2) + ":"
       call locateG 76, row + 10 : call printG "Set " + str$(row + 20) + ":"
   NEXT
   call colorG clr$(14), clr$(0)
   call locateG 4, 33 : call printG "Player's Rack: Columns and Rows"
   FOR col = 0 TO 13
       call locateG col * 5 + 4, 34 : call printG str$(col)
   NEXT
   FOR row = 1 TO 10
       call locateG 1, 34 + row: call printG RIGHT$(" " + str$(row), 2)
   NEXT
   IF debug THEN
       call colorG clr$(13), clr$(0)
       call locateG 78, 33 : call printG "Computer's Rack: Columns and Rows"
       FOR col = 0 TO 13
           call locateG col * 5 + 78, 34 : call printG str$(col)
       NEXT
       FOR row = 1 TO 10
           call locateG 75, 34 + row : call printG RIGHT$(" " + str$(row), 2)
       NEXT
   END IF
   call colorG clr$(15), clr$(0)
END SUB

SUB showPlayer
   FOR row = 1 TO 10
       call colorG clr$(15), clr$(0)
       call locateG 4, row + 34 : call printG SPACE$(70)
       call colorG clr$(15), clr$(row)
       FOR col = 0 TO 13
           call locateG col * 5 + 4, row + 34: call printG pO$(col, row)
       NEXT
   NEXT
END SUB

SUB showComputer
   FOR row = 1 TO 10
       call colorG clr$(15), clr$(0)
       call locateG 78, row + 34 : call printG SPACE$(70)
       call colorG clr$(15), clr$(row)
       FOR col = 0 TO 13
           call locateG col * 5 + 78, row + 34 : call printG cO$(col, row)
       NEXT
   NEXT
END SUB


' Copy Paste these Procedures so you can do a graphics setup

'  Use: setup title$, desiredWidth, desiredHeight 'to setup a graphics window #gr
'Then use you can use these command substitutes for the graphics window:
'  locate = call locateG characterColumn, characterRow
'   print = call printG text$ '(strings only)
'   input = call inputG prompt$, variable$ '(string variable only)
'   color = call colorG fore$, back$ 'takes only string arguments
'           for colors I set up function QBcolr$(colrNum) to return QB color string for numbers 0 to 15
'     cls = call clsG 'clears to last colorG fore$, back$ used
' PLUS inkee$ is a global variable you have access to use like QB inkey$

' finish your code section with a wait command

'setup graphics window with specified title$, width and height with handle #gr, AKA h$
sub setup title$, wWidth, wHeight
   global xmax, ymax  'screen width and height
   xmax = wWidth : ymax = wHeight  '<<<<<< set this as you need or from plug-in notes

   global cellW, cellH
   'do not mess with cellW and cellH globals for printing
   cellW = 8 'pixels wide for characters
   cellH = 16 'pixels high for characters

   global maxRow, maxCol
   'and then these are calculated from above globals
   maxCol = int(xmax / cellW)  'these control printing characters
   maxRow = int(ymax / cellH)

   global lastC, lastR 'for LocateG (locate), printG (print a line), lp (locate and print)
   lastC = 1 : lastR = 1

   'key events update globals with latest info
   global inkee$, h$

   h$ = "#gr"

   global wFG$, wBG$
   wFG$ = "white" : wBG$ = "black"

   nomainwin

   WindowWidth = xmax + 8
   WindowHeight = ymax + 32
   UpperLeftX = (DisplayWidth-WindowWidth) / 2
   UpperLeftY = (DisplayHeight-WindowHeight) / 2

   open title$ for graphics_nsb_nf as #gr
   #gr "trapclose quit"

   'fonts that don't work arial, tahoma, verdana
   '#gr "font arial ";cellW;" ";cellH
   '#gr "font dejavu_sans_mono ";cellW;" ";cellH

   'fonts that work
   '#gr "font courier_new ";cellW;" ";cellH
   #gr "font consolas ";cellW;" ";cellH

   '#gr "home"                  '< check drawing area
   '#gr "posxy w2 h2"           '<<<<<<<<<<<<<<<<<<
   'notice "Screen Drawing Check";chr$(13);"Size:" + chr$(13) + "Width (w2*2) = ";w2*2;",  Height (h2*2) = ";h2*2

   #gr "setfocus"
   #gr "when characterInput charIn"
   #gr "down"
   call colorG "white", "black"
   call clsG
end sub

sub printG mess$ 'print (with "line feed") for graphics window
   startR = lastR
   for i = 1 to len(mess$)
       scan
       call lp lastC, lastR, mid$(mess$, i, 1)
       if lastR <> startR then exit for
   next
   lastC = 1
   lastR = startR + 1
   if lastR > maxRow then lastR = maxRow 'yuck!
end sub

sub clsG  'cls for graphics window
   #gr "fill ";wBG$
   lastC = 1 : lastR = 1
end sub

sub colorG fore$, back$ 'set color fore and back to color string names, see QBcolr$ function
   wFG$ = fore$ : wBG$ = back$
   #gr "color ";wFG$
   #gr "backcolor ";wBG$
end sub

sub locateG x, y   'locate xColumnCell, yRowCell for printing
   if 0 < x and x < maxCol + 1 and 0 < y and y < maxRow + 1 then
       lastC = x
       lastR = y
   end if
end sub

sub inputG prmpt$, byref var$   'input for a graphics screen
   'prints prompt at lastC, lastR and leaves lastC = 1 lastR = pRow + 1

   inkee$ = "" 'clear last key (new fix for DE5)
   call lp lastC, lastR, prmpt$;"{"
   'this will update lastR and lastC to the starting point of input variable
   pRow = lastR : pCol = lastC 'save these for redrawing var
   call lp pCol, pRow, "}"
   OK$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz"
   OK$ = OK$+ chr$(8)+ chr$(27) + chr$(13) + "1234567890!@#$%^&*()_-+={}[]|\:;'<,>.?/"
   do
       scan
       if instr(OK$, inkee$) then
           if inkee$ = Chr$(8) then
               if t$ <> "" then
                   if Len(t$)=1 then t$="" else t$=Left$(t$,Len(t$)-1)
               end if
           else
               if inkee$=Chr$(13) or inkee$=Chr$(27) then
                   'new D5, I was expecting nothing in return for my esc
                   if inkee$ = chr$(27) then t$ = ""
                   exit do
               else
                   t$=t$;inkee$
               end if
           end if
           call lp pCol, pRow, t$;"} "
           inkee$ = ""
       end if
   loop until done
   var$ = t$
   lastC = 1 : lastR = pRow + 1
end sub

function QBcolr$(colrNum)
   select case colrNum
   case 0   : QBcolr$ = "black"
   case 1   : QBcolr$ = "darkblue"
   case 2   : QBcolr$ = "brown"
   case 3   : QBcolr$ = "darkcyan"
   case 4   : QBcolr$ = "darkred"
   case 5   : QBcolr$ = "darkpink"
   case 6   : QBcolr$ = "darkgreen"
   case 7   : QBcolr$ = "lightgray"
   case 8   : QBcolr$ = "darkgray"
   case 9   : QBcolr$ = "blue"
   case 10  : QBcolr$ = "green"
   case 11  : QBcolr$ = "cyan"
   case 12  : QBcolr$ = "red"
   case 13  : QBcolr$ = "pink"
   case 14  : QBcolr$ = "yellow"
   case 15  : QBcolr$ = "white"
   end select
end function

function rndColor$()
   rndColor$ = QBcolr$( int( rnd(0) * 16) )
end function

sub lp x, y, mess$ 'locate x, y : print mess$ lp = locate and print
   'if locate = x col and y row then and top left corner locates as 1, 1
   c = x - 1: r = y
   if 0 < x and x < maxCol + 1 and 0 < y and y < maxRow + 1 then
       #gr "place ";c * cellW;" ";r * cellH - 4
       #gr "|";mess$
       lastC = x + len(mess$)
       if lastC > maxCol then lastC = 1 : lastR = lastR + 1
       if lastR > maxRow then lastR = maxRow 'yuck!
   end if
end sub

sub cp y, cpText$ 'cp Center Print on line y the cpText$
   call lp int((maxCol - len(cpText$))/2 + 1.5), y, cpText$
   lastC = 1 : lastR = y + 1
end sub

sub at xPix, yPix, char$  'print a string at pixel x, y This pin point locating.
   #gr "place ";xPix;" ";yPix
   #gr "|";char$
end sub

sub pause mil   'tsh version has scan built-in
   t0 = time$("ms")
   while time$("ms") < t0 + mil : scan : wend
end sub

sub charIn hdl$, c$
   inkee$ = c$
end sub

sub quit hdl$
   timer 0
   close #gr
   end
end sub



So now you can practice making meld and getting access to board sets.

Attachments: