Scramble Codeless
The following code is generated automatically by Treescript:
import (Hidden-form)
(class (public) Scrab-form extends Form
var (auto) (
Game-server game-server;
Button next-btn;
Button back-btn;
Button new-game-btn;
Button exit-btn;
Board-grid board-grid;
Rack-grid rack-grid;
Card-stack bag;
Card-stack table-top;
Editable-grid score-grid;
)
(proc (public static) main (String-list args)
var (
Scrab-form form1 (new Scrab-form);
Hidden-form form2 (new Hidden-form);
)
)
(proc (public) Scrab-form
do (
: game-server init-game;
show;
)
)
(proc (auto) next-btn_click (Event e)
do (
: game-server next-player;
)
)
(proc (auto) back-btn_click (Event e)
do (
: game-server previous-player;
)
)
(proc (auto) new-game-btn_click (Event e)
do (
: game-server new-game;
)
)
(proc (auto) exit-btn_click (Event e)
do (
: game-server quit-player;
)
)
)
This class belongs in a separate source file:
(class (public) Hidden-form extends Form
var (auto) (
Card premium-card;
Rack-grid premium-grid;
Card letter-card;
Board-grid alpha-grid;
Board-grid bag-grid;
Card-stack bag;
)
)
Scramble Automation
Feature No. 1: Display no. of letters in bag
(proc (auto) bag_change (Event e)
do (
: bag-count-lbl (set-caption (: bag get-count));
)
)
Feature No. 2: Add current word score to total
(proc (auto) next-btn_click (Event e)
var (int i)
do (
= i (- (: game-server get-player-no) 1); \ get current player no.
: score-grid (set-cell i 1 (+
(str-to-int (: score-grid (get-cell i 1)))
(str-to-int (: score-grid (get-cell 4 1)))
));
: game-server next-player;
)
)
Feature No. 3: Prevent dragging of board letters already down
(proc (auto) board-grid_change (Event e)
do (
: game-state (set-board (: e row) (: e col)
(- (abs (: board-grid (cells (: e row) (: e col))
get-top value))));
)
)
(proc (auto) next-btn_click (Event e)
var (int i; int j; int m; int n)
do (
= m (- (: board-grid get-row-count) 1);
= n (- (: board-grid get-col-count) 1);
for i (0 m) do (
for j (0 n) do (
: game-state (set-board i j
(abs (get-board i j)));
);
);
: game-server next-player;
)
)
(proc (auto) board-grid_drag (Event e)
do (
= (: e can-drag) (<
(: game-state (get-board (: e row) (: e col))) 0);
)
)
Feature No. 4: Fill rack at start of turn
(proc (event) next-btn_click (Event e)
do (
fill-rack;
: game-server next-player;
)
)
{ fill all racks at start of game }
(proc init-game
var (int i)
do (
: game-server first-player;
for i (1 (: game-server get-player-count)) do (
fill-rack;
: game-server next-player;
);
{ rest of init-game... }
)
)
(proc fill-rack
var (int i)
do (
for i (0 (- (: rack-grid count) 1)) do (
if (<= (: bag count) 0) then (
break;
);
if (== (: rack-grid (cells i) count) 0) then (
: rack (cells i) push (: bag pop);
);
);
)
)
Scramble Move Constraints
var (private) (
boolean challenging;
boolean interchange-blanks;
boolean use-on-same-turn;
boolean three-of-a-kind;
boolean four-of-a-kind;
)
(proc (auto) next-btn_click (Event e)
var (String msg)
do (
= msg '';
if (== (: game-state (get-board 7 7)) 0) then (
= msg 'Center square not covered';
)
elseif (not is-word-connected) then (
= msg 'Word not adjacent to other words';
)
elseif (not is-word-contiguous) then (
= msg 'Letters in word not contiguous';
)
elseif (not is-challenging) then (
= msg get-words-not-in-dict;
if (<> msg '') then (
= msg (+ 'Word(s) not in dictionary: ' msg);
);
)
elseif (and is-interchangeable-blanks is-use-on-same-turn
(< get-blank-count-this-turn get-interchg-blank-count))
then (
= msg 'Not enough blank(s) used';
);
if (== msg '') then (
: game-server next-player;
)
else (
: show-err-msg msg;
);
)
)
(proc (auto) board_dbl-click (Event e)
do (
if (and is-interchangeable-blanks
(is-blank-at (: e row) (: e col))
(has-letter (get-blank-val-at (: e row) (: e col))))
then (
do-blank-interchange (: e row) (: e col);
);
)
)
(proc (auto) bag_drop (Event e)
do (
if (and is-three-of-a-kind is-part-of-3-of-a-kind) then (
: e (set-accept true);
)
elseif (and is-four-of-a-kind is-part-of-4-of-a-kind) then (
: e (set-accept true);
)
elseif (== (message-dlg 'Do you wish to Scramble?'
mt-confirmation (mb-yes mb-no)) mr-yes) then (
: e (set-accept true);
: game-server next-player;
)
else (
: e (set-accept false);
);
)
)
{ Helper Methods }
(func boolean is-challenging do (return challenging;))
(func boolean is-interchangeable-blanks
do (return interchangeable-blanks;))
(func boolean is-use-on-same-turn do (return use-on-same-turn;))
(func boolean is-three-of-a-kind do (return three-of-a-kind;))
(func boolean is-four-of-a-kind do (return four-of-a-kind;))
(func boolean is-word-connected do ( ... ))
(func boolean is-word-contiguous do ( ... ))
(func String get-words-not-in-dict do ( ... ))
(func int get-blank-count-this-turn do ( ... ))
(func int get-interchg-blank-count do ( ... ))
(func boolean is-blank-at (int row; int col) do ( ... ))
(func boolean has-letter (int letter) do ( ... ))
(func int get-blank-val-at (int row; int col) do ( ... ))
(proc do-blank-interchange (int row; int col) do ( ... ))
(func boolean is-part-of-3-of-a-kind do ( ... ))
(func boolean is-part-of-4-of-a-kind do ( ... ))
(proc show-err-msg (String msg) do ( ... ))
Scramble Auto Move
The (abbreviated) source code listing below shows how to implement Scramble using the on-change events and the 4 Auto Move classes.
On Change Events
(class (public) Scrab-form extends Form
var (auto) (
Game-server game-server;
Board-grid board-grid;
Rack-grid rack-grid;
Card-stack bag;
Card-stack table-top;
Editable-grid score-grid;
)
var (private) (
Game-state game-state;
...
)
(proc (auto) board-grid_change (Event e)
do (
: game-state (set-board (: e row) (: e col) (: e intval));
)
)
(proc (auto) rack-grid_change (Event e)
do (
: game-state curr-player (set-rack (: e col) (: e intval));
)
)
(proc (auto) game-server_auto-move (Event e)
var (
Move-generator mg (new Move-generator game-state);
Move-implementer mi (new Move-implementer game-state);
)
do (
: mi do-move (: mg get-move);
)
)
...
)
Game State
(class Game-state
var (private) (
array 2 int board (new int 15 15);
Player-state curr-player;
list Player-state player-list;
)
(func (public) int get-board (int row; int col)
do (
return (board row col);
)
)
(proc (public) set-board (int row; int col; int val)
do (
= (board row col) val;
)
)
)
(class Player-state
var (private) (
array int rack (new int 7);
)
(func (public) int get-rack (int col)
do (
return (rack col);
)
)
(proc (public) set-rack (int col; int val)
do (
= (rack col) val;
)
)
)
Move
(class Move
var (private) (
array int mv-word (new int 7);
boolean across;
int row;
int col;
int blank-pos-1;
int blank-pos-2;
)
(func (public) int get-mv-word (int idx)
do (
return (mv-word idx);
)
)
(proc (public) set-mv-word (int idx; int val)
do (
= (mv-word idx) val;
)
)
(func (public) int get-row do (
return row;
))
(func (public) int get-col do (
return col;
))
(func (public) int get-board-row (int i) do (
{ calculate board row of i-th letter }
))
(func (public) int get-board-col (int i) do (
{ calculate board col of i-th letter }
))
(func (public) int get-rack-col (int i) do (
{ calculate rack col of i-th letter }
))
...
)
Move Generator
(class Move-generator
var (private) (
Game-state game-state;
)
(cons Move-generator (Game-state gs)
do (
= game-state gs;
)
)
(func (public) Move get-move
var (private) (
Move best-move;
)
do (
{ calculate optimum move }
...
return best-move;
)
)
)
Move Implementer
(class Move-implementer
var (private) (
Game-state game-state;
)
(cons Move-implementer (Game-state gs)
do (
= game-state gs;
)
)
(proc (public) do-move (Move move)
var (
int i;
int ltr-val;
)
do (
{ handle special cases... }
if (== (: move get-row) -1) then (
{ player is scrabbling or passing }
)
else ( { normal case }
for i (0 6) do (
if (or (== i (: move get-blank-pos-1))
(== i (: move get-blank-pos-2))) then (
= ltr-val 27;
\ store blank info...
)
else (
= ltr-val (: move (get-mv-word i));
);
if (== ltr-val 0) then (
break;
);
board-grid (auto-drop
(: move (get-board-row i)) \ board row of i-th letter
(: move (get-board-col i)) \ board col of i-th letter
(: rack-grid (auto-drag (: move (get-rack-col i))))
);
);
);
)
)
)