Scripts/Set Game

From J Wiki
Jump to navigation Jump to search
Scrnshot3.png

Introduction

Having enjoyed the the Set Game with my family for a number of years, I read Roger's Set Game essay with interest. When I saw Kirk Iverson's code for a GUI version of the game while reading the original comp.lang.apl thread, I decided to try and get it running. Unfortunately this was not quite a matter of just copying-and-pasting because of some of the changes to J since 1996. Despite this I found the code very instructive, and particularly enjoyed the routines for generating the card bitmaps. I have made the updated scripts available here so others may also enjoy them.

To provide a working application, I've had to replace some of Kirk's more elegant code with my hacks. If anyone is able to improve on my solutions I'd welcome and appreciate it.

I've also created an additional version of the GUI that draws the cards directly on to the form using gl2 and is therefore resizeable.

The Game

For the object and rules of the game please see the Set Game essay.

To Run

To run the application:

  • download the five scripts (choose Literate from the More Actions drop-down at the top of the page to download a zip file containing the scripts.)
  • save the scripts in a folder e.g. jpath '~temp/set'
  • start a J session and load either the bitmap or the gl2 versions
      • load '~temp/set/setplaybmp.ijs' NB. the bitmap version
      • load '~temp/set/setplaygl2.ijs' NB. the gl2 version

The Code

This script is the equivalent of the code given in the Set Game essay. The original code posted didn't require any edits. [{{#file: "setengine.ijs"}} Download script: setengine.ijs ] 

NB. Shuffle the deck and deal a hand:
combs=: #~ #: i.@^              NB. Combs of y selections from x choices.
deck=: 3: combs 4:              NB. Deck is 3 choices for 4 features,
shuffle=: {~ ?~@#               NB. shuffle it,
hand=: 12&{.                    NB. and pick off a single hand.

NB. Determine if some cards form a set:
allsod=: (#@~. e. 1: , #)"1     NB. Is list ALL Same Or Different
isset=: *./@:allsod@|:"2        NB. Do cards form a set?

NB. All combinations of cards:
btab=: 2&combs                  NB. Make binary table,
sumsof=: ] #~ [ = +/"1@]        NB. rows of y whose total matches x,
outof=: (sumsof btab) # i.@]    NB. and return indices of 1's.
all3=: (3 outof 12)&{           NB. Select all 3-tuples.

NB. Test all combinations for a set:
allsets=: (#~ isset)@all3       NB. Select all sets.

NB. A verb to display cards:
Props=: _3]\;:}: 0 : 0          NB. Table of properties x labels.
one two three red green blue solid outline shaded diamond oval squiggle
)
see=: }.@;@:(' '&,&.>)@({"0 1&Props)"1  NB. Display a card.

NB. And finally put it together:
newhand=: hand@shuffle@deck     NB. Return freshly-dealt hand.
play=: see&.>@(];allsets)       NB. Display hand and all sets.

Bitmap GUI

The original GUI needed a bit of work mainly to replace the now obsolete isipicture with isigraph. I also added on some code at the top to pull the three scripts together. [{{#file: "setplaybmp.ijs"}} Download script: setplaybmp.ijs ] 

require 'gl2 bmp'
coinsert 'jgl2'
loc_z_=: 3 : '> (4!:4 <''y'') { 4!:3 $0'
INSTALLDIR=: getpath_j_ loc ''
load INSTALLDIR,'setengine.ijs'     NB.  ** Location of setengine script.
BMP=: (INSTALLDIR,'set')"_ , {&'012' , '.bmp'"_   NB.  ** Location of bitmaps

3 : 0 ''
if. -.*./fexist_j_"1 BMP"0 1 ]3 combs 4 do.
  load INSTALLDIR,'setcardsbmp.ijs'
  genbmps INSTALLDIR
end.
)

NB. base form

SET=: 0 : 0
pc set closeok dialog nomax nomin nosize;
xywh 6 6 32 48;cc p0 isigraph;
xywh 40 6 32 48;cc p1 isigraph;
xywh 74 6 32 48;cc p2 isigraph;
xywh 108 6 32 48;cc p3 isigraph;
xywh 142 6 32 48;cc p4 isigraph;
xywh 176 6 32 48;cc p5 isigraph;
xywh 6 73 32 48;cc p6 isigraph;
xywh 40 73 32 48;cc p7 isigraph;
xywh 74 73 32 48;cc p8 isigraph;
xywh 108 73 32 48;cc p9 isigraph;
xywh 142 73 32 48;cc p10 isigraph;
xywh 176 73 32 48;cc p11 isigraph;
xywh 6 56 32 10;cc s0 static ss_center;
xywh 40 56 32 10;cc s1 static ss_center;
xywh 74 56 32 10;cc s2 static ss_center;
xywh 108 56 32 10;cc s3 static ss_center;
xywh 142 56 32 10;cc s4 static ss_center;
xywh 176 56 32 10;cc s5 static ss_center;
xywh 6 126 32 10;cc s6 static ss_center;
xywh 40 126 32 10;cc s7 static ss_center;
xywh 74 126 32 10;cc s8 static ss_center;
xywh 108 126 32 10;cc s9 static ss_center;
xywh 142 126 32 10;cc s10 static ss_center;
xywh 176 126 32 10;cc s11 static ss_center;
xywh 216 13 34 34;cc doit button bs_defpushbutton;cn "Solve";
xywh 216 80 34 34;cc close button;cn "Close";
pas 6 6;pcenter;
rem form end;
)

solve=: 1

set_run=: 3 : 0
  wd SET
  NB. initialize form here
  deal''
  wd 'pshow;'
)

caption=: wd@('setcaption doit *'"_ , ])

deal=: 3 : 0
  H=: newhand ''
  NB. (i.12) wd@('set p'"_ , ":@[ , ' '"_ , BMP@])"0 1 H
  (i.#H) paint"0 1 BMP"0 1 H
  wd@('set s'"_ , ":@[ , ' ""'"_)"0 i.12
  caption 'Solve'
)

paint=: 4 : 0
  glsel 'p'&,@": x
  glclear ''
  dat=. 256 #. |."1 [ 256 256 256 #: readbmp jpath y
  glpixels (0 0,|.$dat),,dat
  glpaint ''
)

set_doit_button=: 3 : 0
  solve=: -. solve
  if. solve do. deal'' return. end.
  caption 'Solving..'
  s=. (] i."2 allsets) H NB. indices of cards in sets
  t=. (i.12) e."1 s  NB. Mask over cards in solutions
  l=. (|:t) <@# >:i.#s  NB. label for each card
  (i.12) wd@('set s'"_ , ":@[ , ' *'"_ , ":@])&> l
  caption 'Deal'
)

set_close_button=: wd bind 'pclose'
set_enter=: set_doit_button

set_run ''

The script below only loads and runs the first time you run setplaybmp.ijs in a folder. It generates the *.bmp files for the Set cards used in the game. Sure you could make prettier symbols, but I like the ingenuity of the following method. [{{#file: "setcardsbmp.ijs"}} Download script: setcardsbmp.ijs ] 

circle=: ];._2 ] 0 : 0
.....XXXXXX.....
...XX+--+--XX...
..X-+--+--+--X..
.X-+--+--+--+-X.
.X+--+--+--+--X.
X---+--+--+--+-X
X--+--+--+--+--X
X-+--+--+--+--+X
X+--+--+--+--+-X
X--+--+--+--+--X
X-+--+--+--+---X
.X--+--+--+--+X.
.X-+--+--+--+-X.
..X--+--+--+-X..
...XX--+--+XX...
.....XXXXXX.....
)

square=: ];._2 ] 0 : 0
XXXXXXXXXXXXXXXX
X-+--+--+--+--+X
X+--+--+--+--+-X
X--+--+--+--+--X
X-+--+--+--+--+X
X+--+--+--+--+-X
X--+--+--+--+--X
X-+--+--+--+--+X
X+--+--+--+--+-X
X--+--+--+--+--X
X-+--+--+--+--+X
X+--+--+--+--+-X
X--+--+--+--+--X
X-+--+--+--+--+X
X+--+--+--+--+-X
XXXXXXXXXXXXXXXX
)

squiggle=: ];._2 ] 0 : 0
........XXX.....
.......X+--X....
......X+--X.....
.....X+--X......
....X+--X.......
....X--+X.......
....X-+--X......
.....X--+-X.....
......X+--+X....
.......X-+-X....
.......X+--X....
.......X--X.....
......X--+X.....
.....X--+X......
....X--+X.......
....XXXX........
)

outline=: e.&'X'
shaded=:  e.&'X+'
solid=:   e.&'X+-'

red=: 249&*
green=: 250&*
blue=: 252&*
grey=: 248&*
white=: 255&*

on=: 4 : '96{.(24#0),"1 (24#0),~"1 (0$~y,16),x' " _ 0

The definition for bg in the original code was 11 : '+ [: x 0: = ]'. 11 is no longer valid in current J so I ended up by making bg an adverb. (According to this thread, "11 : was to 1 : as 13 : is to 3 :".) [{{#file: "setcardsbmp.ijs"}} Download script: setcardsbmp.ijs ] 

bg=:  1 : '+ [: x 0: = ]'

one=:       on&40
two=:   +/@(on&30 50)
three=: +/@(on&20 40 60)

pal=: _256{. ".;._2 ] 0 : 0
192 192 192
255   0   0
  0 255   0
255 255   0
  0   0 255
255   0 255
  0 255 255
255 255 255
)

combs=: #~ #: i.@^

verbs=: ;:;._2 ] 0 : 0
one two three
red green blue
outline shaded solid
circle square squiggle
)

The following verb took me a while to get working and my edits can probably be improved upon. I ended up commenting out the last line of the original and replacing with 3 extras. I also used a white rather than grey background that shows up symbols better in my opinion. [{{#file: "setcardsbmp.ijs"}} Download script: setcardsbmp.ijs ] 

genbmps=: 3 : 0
  NB. Generate bitmaps for "Set" game.
  NB.    genbmps 'dirname'
  NB.    genbmps jpath '~user/usercontrib/set'
  all=. 3 combs 4  NB. All combinations
  fn=. ('set'"_ , {&'012')"1 all
  bmps=.  all ({"0 1)"1 _ verbs
  q=. ''''"_ , ] , ''''"_
  bmparg=. pal"_ ; white bg  NB. white was grey in the original code
  NB.  bmps (bmparg@".@(;:^:_1)@[ writebmp8  y&,@('\'&,)@(,&'.bmp')@])"1 fn
  fbmps=.({~every/"1(bmparg@".@(;:^:_1)) bmps) NB. added
  fnmes=.y&,@('\'&,)@(,&'.bmp')"1 fn           NB. added
  (<"3 fbmps) writebmp every <"1 fnmes         NB. added
)

gl2 GUI

The gl2 version draws symbols directly into the isigraph controls rather than to a file first. The form is resizeable. [{{#file: "setplaygl2.ijs"}} Download script: setplaygl2.ijs ] 

require 'gl2'
coinsert 'jgl2'
loc_z_=: 3 : '> (4!:4 <''y'') { 4!:3 $0'
INSTALLDIR=: getpath_j_ loc ''
load INSTALLDIR,'setengine.ijs'     NB.  ** Location of setengine script.
load INSTALLDIR,'setcardsgl2.ijs'   NB.  ** Location of card drawing script.

NB. base form
SETGL2=: 0 : 0
pc setgl2 closeok dialog;
xywh 6 6 48 32;cc p0 isigraph leftscale topscale rightscale bottomscale;
xywh 56 6 48 32;cc p1 isigraph leftscale topscale rightscale bottomscale;
xywh 106 6 48 32;cc p2 isigraph leftscale topscale rightscale bottomscale;
xywh 156 6 48 32;cc p3 isigraph leftscale topscale rightscale bottomscale;
xywh 6 57 48 32;cc p4 isigraph leftscale topscale rightscale bottomscale;
xywh 56 57 48 32;cc p5 isigraph leftscale topscale rightscale bottomscale;
xywh 106 57 48 32;cc p6 isigraph leftscale topscale rightscale bottomscale;
xywh 156 57 48 32;cc p7 isigraph leftscale topscale rightscale bottomscale;
xywh 6 108 48 32;cc p8 isigraph leftscale topscale rightscale bottomscale;
xywh 56 108 48 32;cc p9 isigraph leftscale topscale rightscale bottomscale;
xywh 106 108 48 32;cc p10 isigraph leftscale topscale rightscale bottomscale;
xywh 156 108 48 32;cc p11 isigraph leftscale topscale rightscale bottomscale;
xywh 6 40 48 10;cc s0 static ss_center leftscale topscale rightscale bottomscale;
xywh 56 40 48 10;cc s1 static ss_center leftscale topscale rightscale bottomscale;
xywh 106 40 48 10;cc s2 static ss_center leftscale topscale rightscale bottomscale;
xywh 156 40 48 10;cc s3 static ss_center leftscale topscale rightscale bottomscale;
xywh 6 91 48 10;cc s4 static ss_center leftscale topscale rightscale bottomscale;
xywh 56 91 48 10;cc s5 static ss_center leftscale topscale rightscale bottomscale;
xywh 106 91 48 10;cc s6 static ss_center leftscale topscale rightscale bottomscale;
xywh 156 91 48 10;cc s7 static ss_center leftscale topscale rightscale bottomscale;
xywh 6 142 48 10;cc s8 static ss_center leftscale topscale rightscale bottomscale;
xywh 56 142 48 10;cc s9 static ss_center leftscale topscale rightscale bottomscale;
xywh 106 142 48 10;cc s10 static ss_center leftscale topscale rightscale bottomscale;
xywh 156 142 48 10;cc s11 static ss_center leftscale topscale rightscale bottomscale;
xywh 216 28 34 34;cc doit button bs_defpushbutton leftscale topscale rightscale bottomscale;cn "Solve";
xywh 216 80 34 34;cc close button leftscale topscale rightscale bottomscale;cn "Close";
pas 6 6;pcenter;
rem form end;
)

solve=: 1

setgl2_run=: 3 : 0
  wd SETGL2
  NB. initialize form here
  deal''
  wd 'pshow;'
)

caption=: wd@('setcaption doit *'"_ , ])

deal=: 3 : 0
  H=: (({"0 1&Props)"1) newhand ''
  setgl2_p0_paint ''
  wd@('set s'"_ , ":@[ , ' ""'"_)"0 i.12
  caption 'Solve'
)

I'm sure it is possible to clean up the next section to remove the duplication and am interested in solutions to that end. Defining only setgl2_p0_paint works OK, except that resizing the form results in unpredictable repainting of the other cards. With them all defined repainting is nice and smooth. (This thread suggests that the solution below is pretty good for multiple isigraph controls, but that another solution may be to use a single big control and paint each area as required.) [{{#file: "setplaygl2.ijs"}} Download script: setplaygl2.ijs ] 

setgl2_p0_paint=:  3 :'(i.#H) setpaint"0 1 H'
setgl2_p1_paint=:  3 :  '1 setpaint  1{H'
setgl2_p2_paint=:  3 :  '2 setpaint  2{H'
setgl2_p3_paint=:  3 :  '3 setpaint  3{H'
setgl2_p4_paint=:  3 :  '4 setpaint  4{H'
setgl2_p5_paint=:  3 :  '5 setpaint  5{H'
setgl2_p6_paint=:  3 :  '6 setpaint  6{H'
setgl2_p7_paint=:  3 :  '7 setpaint  7{H'
setgl2_p8_paint=:  3 :  '8 setpaint  8{H'
setgl2_p9_paint=:  3 :  '9 setpaint  9{H'
setgl2_p10_paint=: 3 : '10 setpaint 10{H'
setgl2_p11_paint=: 3 : '11 setpaint 11{H'

setpaint=: 4 : 0
  glsel 'p'&,@": x
  SYMBSZ=: getSymbSz crdsz=. glqwh''
  glclear ''
  drawcard crdsz
  drawsymb y
  glpaint ''
)

setgl2_doit_button=: 3 : 0
  solve=: -. solve
  if. solve do. deal'' return. end.
  caption 'Solving..'
  s=. (] i."2 allsets) H NB. indices of cards in sets
  t=. (i.12) e."1 s  NB. Mask over cards in solutions
  l=. (|:t) <@# >:i.#s  NB. label for each card
  (i.12) wd@('set s'"_ , ":@[ , ' *'"_ , ":@])&> l
  caption 'Deal'
)

setgl2_close_button=: wd bind 'pclose'
setgl2_enter=: set_doit_button

setgl2_run ''

The setcardsgl2.ijs script defines the symbols to be drawn on the cards using gl2 commands. [{{#file: "setcardsgl2.ijs"}} Download script: setcardsgl2.ijs ] 

getSymbSz=: 3 : 0
  crdh=. ({: <. %&1.9@{.) y  NB. Height is %1.90 of width
  symh=. 0.9 * crdh
  symy=. (0.5 * {:y)-0.5*symh NB. 0.05 * crdh
  symw=. 0.55 * symh
  symx=. (0.5 * {.y)-0.5*symw
  symx, symy, symw, symh
)

drawcard=: 3 : 0
  glrgb cardborder
  glpen 1 0
  glrgb cardbkgrnd
  glbrush ''
  glrect 0 0, y
)

drawsymb=: 3 : 0
  'count color fill shape'=. y
  glrgb color~
  glpen 3 0  NB. 3pt solid outline
  glrgb fill~ color~
  glbrush ''
  shape~ count~ SYMBSZ
)

The Set Game usually uses a "squiggle" for the 3rd symbol (see www.setgame.com), but I am unsure about how to go about drawing one using J's gl2 commands, so have used a circle for now. Squiggle contributions are welcome! (This forum thread contains some ideas about how to go about doing this.) [{{#file: "setcardsgl2.ijs"}} Download script: setcardsgl2.ijs ] 

diamond=: setdiamond
oval=: setroundr
squiggle=: setcircle

red=: 255 0 0
green=: 0 255 0
blue=: 0 0 255
white=: 255 255 255
grey=: 192 192 192
darkgrey=: 100 100 100
lightgrey=: 220 220 220

cardborder=: darkgrey
cardbkgrnd=: lightgrey

solid=: 1&*
shaded=: grey >. ] NB. light color
outline=: white >. ]

one=: (1 1 1 1)*"1 ]
two=: (0.5 1.5,"0 1] 1 1 1) *"1 ]
three=: (0.1 1 1.9,"0 1] 1 1 1) *"1 ]

Note 'formats for gl commands'
 glpolygon x y x y x y x y
 glroundr  x y w h rw rh
 glellipse x y w h
)

gldiamond=: 3 : 0"1
NB.   'tlx tly wid hgt'=. y
NB.   xs=. tlx+ 0.5 1 0.5 0 * wid
NB.   ys=. tly+ 0 0.5 1 0.5 * hgt
NB.   glpolygon ,xs,.ys
  xywh=._2]\y
  rot=.0 _1|."0 1] 0.5 1 0.5 0
  xys=. rot ((]{.) + (* {:)) xywh
  glpolygon ,|:xys
)

setdiamond=: gldiamond

setroundr=: 3 : 0"1
  arg=. (],2&#@(2&{)) y
  glroundr arg
)

setcircle=: 3 : 0"1
  'xpos ypos wid hgt'=. y
  ypos=. ypos+0.5*hgt-wid
  hgt=. wid
  glellipse xpos,ypos,wid,hgt
)

See Also


Original code by Kirk Iverson.

J6.02 and gl2 versions contributed by -- Ric Sherlock <<DateTime(2008-02-05T08:11:02Z)>>

CategoryGames CategoryLiterate

Retrieved from "https://code.jsoftware.com/mediawiki/index.php?title=Scripts/Set_Game&oldid=41615"