2 // A program
for playing Chinese Checkers
3 // The program requires IoDesktop
.
4 // Version
1.5b5
, 13-Dec
-2006
5 // Written by Jon Kleiser
7 // This program is released in the public domain
.
8 // Look
for improved versions here
: <http
://folk
.uio
.no
/jkleiser
/china
/>
13 1.5b3 Changed font path.
14 1.5b2 Avoiding "x * -y" problem (20060327). Using new sortInPlaceBy.
15 1.5b Supporting new true/false logic. Simplified setupFont method.
16 1.4.2 Temporary fix to support 20051017. Fixed old bug "pSize : ".
17 1.4.1 Adjusted end-parameter in removeSlice call.
18 1.4 Supporting new List mapInPlace (but does not require 20050725).
19 1.3 Supporting new Sequence methods (but does not require 20050712).
20 List asString. Small change in loadGame API.
21 1.2 Supporting new appendProto as well as old parent.
22 1.1 Added saveGame and loadGame methods. Added Dialog.
23 Fixed bug in automaticMove. Supporting new/old random methods.
28 ---------- ---------------------------------------------------------------
31 Color: adjustBrightness, adjustSaturation
34 Direction: new, distance, axisOffset, drawPiece
35 GameState: initialState, newFromMove, restoreBoardFromPrevious, getBoard,
36 pieceTypeHasMadeIt, findJumpablesShort, findJumpablesLong,
37 reachableCells, traceJumpsShort, traceJumpsLong, stepTrace,
38 getPossibleMoves, movesWithRelGainAtLeast, acceptableMove,
39 hasRealMove, movesFromStart
40 Evaluator: new, evaluation, gain, targetEvaluation
41 Move: new, isReal, getStateAfter
42 ChinaBoard: makeCellRow, cellAtRowCol, init, newGame, legalDestType,
43 nextPieceType, nameOfColorToMove, vertInc, centerX, paint,
44 paintMovingPiece, lastMove, teamThatDidLastMove, teamToMove,
45 humanMustSkip, clickedCell, automaticMove, pieceTypeThatJustMadeIt,
46 gameOver, undoLastMove, currentRevealedMove, revealNextMove,
48 Dialog: new, handleKeyboard, handleSpecial, prevDialogActionApproved,
49 toggleCursor, input, inputLeft, inputRight, asList
50 ChinaApp: setMsg, addMsg, boardStateIsInitial, newGame, setBackground,
51 teamPolarities, dataPath, configure, setupFont, drawString,
52 drawMessageBox, boardTop, display, msgAboutWhatsNext, setDialog,
53 loadGameWithDialog, saveGameWithDialog, keyboard, special,
54 motion, passiveMotion, negatives, mouse, reshape, timer, run
59 Object setParent
:= method(p
,
64 if (List getSlot("asString") isNil,
65 List asString
:= method(
66 buf
:= Sequence
clone appendSeq("(")
68 buf
appendSeq(if(v
, if(v ?asString
, v asString
, "???"), "nil"))
69 buf
appendSeq(if(i
< self size
- 1, ", ", ")"))
76 adjustBrightness
:= method(coef
,
77 self setRed(self red
* coef
)
78 self setGreen(self green
* coef
)
79 self setBlue(self blue
* coef
)
83 adjustSaturation
:= method(coef
,
84 self setRed((self red
- 1) * coef
+ 1)
85 self setGreen((self green
- 1) * coef
+ 1)
86 self setBlue((self blue
- 1) * coef
+ 1)
91 Colors
:= Map clone do(
92 atPut("red", Color clone set(1, 0, 0, 1))
93 atPut("cyan", Color clone set(0, 1, 1, 1))
94 atPut("blue", Color clone set(0, 0, 1, 1))
95 atPut("yellow", Color clone set(1, 1, 0, 1))
96 atPut("green", Color clone set(0, 1, 0, 1))
97 atPut("magenta", Color clone set(1, 0, 1, 1))
98 atPut("white", Color clone set(1, 1, 1, 1))
99 atPut("gray", Color clone set(0.5, 0.5, 0.5, 1))
100 atPut("darkGray", Color clone set(0.22, 0.22, 0.22, 0.9))
104 Cell
:= Object clone do(
112 setup
:= method(p
, r
, c
,
122 Direction
:= Object clone do(
136 new
:= method(t
, ai
, bi
, ci
, di
, cName
,
143 newD colorName
= cName
144 newD pieceColor
= Colors
at(cName
)
145 newD pieceColor2
= newD pieceColor
clone adjustBrightness(0.6) // less bright
146 newD cellColor
= newD pieceColor
clone adjustSaturation(0.2) // low saturation
147 newD arrowColor
= newD pieceColor
clone adjustSaturation(0.6) // medium saturation
149 newD image
= Image clone open(
150 Path
with(launchPath
, "images/" .. newD colorName
.. ".png"))
152 e
catch (Exception, if (false
, writeln("*** Direction new: ", e error
)))
156 distance
:= method(row
, col
,
157 // Distance away from
"home zero"
158 return self c
+ (self a
* row
) + (self b
* col
)
161 axisOffset
:= method(row
, col
,
162 // Distance away from
axis (positive on one side
, negative on the other
)
163 return self d
+ (((self b
* row
) - (self a
* col
)) * 2 / (self a
+ (self b
))) + ((self b
- (self a
)) * distance(row
, col
))
166 drawPiece
:= method(quad
, pSize
,
168 if (image error
, writeln("*** drawPiece: ", image error
))
170 glTranslated(-pSize
-2, -pSize
, 0)
174 self pieceColor glColor
175 gluDisk(quad
, 0, pSize
, 90, 1)
176 self pieceColor2 glColor
// darker outline
177 gluDisk(quad
, pSize
- 1, pSize
, 90, 1)
184 GameState
:= Object clone do(
185 //parent := nil
// ChinaBoard
, slot now created with setParent
186 creator
:= nil
// the Move that created this state
187 board
:= nil
// piece values
188 evals
:= nil
// evaluations
for each of the directions
189 pieceType
:= nil
// the one to
do the next move
192 initialState
:= method(cb
, team1
,
193 // Creates the initial state
196 gs board
= List clone preallocateToSize(cb dimP
)
197 for(p
, 0, cb dimP
- 1,
198 // Put a piece of given
type only
if that
type is active
...
199 gs board
append(if(cb teamPolarities
at(cb cellP
at(p
) cType
) != 0,
200 cb cellP
at(p
) cType
, 0))
202 gs evals
= List clone preallocateToSize(6)
203 tEval
:= cb evaluator targetEvaluation
204 //writeln("GameState initialState: targetEvaluation=", tEval
)
205 6 repeat(gs evals
append(-tEval
))
206 gs pieceType
= cb teamPolarities
indexOf(team1
)
210 newFromMove
:= method(move
,
211 // Creates a new state as a result of a move
213 cb
:= move stateBefore
parent // the ChinaBoard object
216 movingPieceType
:= move stateBefore pieceType
218 gs board
= List clone preallocateToSize(cb dimP
) appendSeq(move stateBefore board
)
220 gs board
atPut(move startPos
, 0)
221 gs board
atPut(move destPos
, movingPieceType
)
224 gs evals
= List clone preallocateToSize(6) appendSeq(move stateBefore evals
)
225 gs evals
atPut(movingPieceType
- 1, gs evals
at(movingPieceType
- 1) + (move gain
))
226 gs pieceType
= cb
nextPieceType(movingPieceType
)
231 restoreBoardFromPrevious
:= method(boardToRestore
, move
,
232 prevState
:= move stateBefore
233 if (prevState board
) then(
234 boardToRestore
appendSeq(prevState board
)
236 // Using
try/catch here avoids stack overflow
Exception:
238 prevState
restoreBoardFromPrevious(boardToRestore
, self creator
)
240 e
catch (Exception, writeln("*** restoreBoardFromPrevious: ", e error
))
243 boardToRestore
atPut(move startPos
, 0)
244 boardToRestore
atPut(move destPos
, prevState pieceType
)
249 if (self board
isNil,
251 self board
= List clone preallocateToSize(dimP
)
252 restoreBoardFromPrevious(self board
, self creator
)
257 pieceTypeHasMadeIt
:= method(pType
,
258 if (pType
isNil, pType
= self pieceType
)
259 return (self evals
at(pType
- 1) abs
< 0.001)
262 findJumpablesShort
:= method(fromCell
, reach
,
263 fromCell neighbors
foreach(i
, n1
,
264 if (n1
and (self board
at(n1 pos
) > 0),
265 n2
:= n1 neighbors
at(i
)
266 if (n2
and (self board
at(n2 pos
) == 0) and (reach
at(n2 pos
) isNil),
267 reach
atPut(n2 pos
, 1) // reach by jump
268 findJumpablesShort(n2
, reach
) // look further
274 findJumpablesLong
:= method(start
, fromCell
, reach
,
275 fromCell neighbors
foreach(i
, nc
,
277 while (nc
and ((board
at(nc pos
) == 0) or (nc pos
== start
)),
278 freeCount
= freeCount
+ 1
279 nc
= nc neighbors
at(i
)
282 // After zero
or more free cells
, we have now found one that
's taken.
283 nc = nc neighbors at(i)
284 while ((freeCount > 0) and nc and ((board at(nc pos) == 0) or (nc pos == start)),
285 freeCount = freeCount - 1
286 nc = nc neighbors at(i)
288 if (nc and (board at(nc pos) == 0) and (reach at(nc pos) isNil),
289 reach atPut(nc pos, 1) // reach by jump
290 findJumpablesLong(start, nc, reach) // look further
296 reachableCells := method(start,
297 reach := reachScratch mapInPlace(p, v, nil)
298 startCell := cellP at(start)
299 startCell neighbors foreach(i, nc,
301 if (self board at(nc pos) == 0) then(
302 reach atPut(nc pos, 1) // reach by roll
304 if (shortJumps, findJumpablesShort(startCell, reach))
306 if (shortJumps not, findJumpablesLong(start, startCell, reach))
312 traceJumpsShort := method(from, dest, reach, posTrace,
313 cellP at(from) neighbors foreach(i, n1,
314 if (n1 and (getBoard at(n1 pos) > 0),
315 n2 := n1 neighbors at(i)
316 if (n2 and (board at(n2 pos) == 0) and (reach at(n2 pos) isNil),
317 reach atPut(n2 pos, 1) // reach by jump
318 if (n2 pos == dest) then(
321 p := traceJumpsShort(n2 pos, dest, reach, posTrace) // look further
333 traceJumpsLong := method(start, from, dest, reach, posTrace,
334 cellP at(from) neighbors foreach(i, nc,
336 while (nc and ((board at(nc pos) == 0) or (nc pos == start)),
337 freeCount = freeCount + 1
338 nc = nc neighbors at(i)
341 nc = nc neighbors at(i)
342 while ((freeCount > 0) and nc and ((board at(nc pos) == 0) or (nc pos == start)),
343 freeCount = freeCount - 1
344 nc = nc neighbors at(i)
346 if (nc and (board at(nc pos) == 0) and (reach at(nc pos) isNil),
347 reach atPut(nc pos, 1) // reach by jump
348 if (nc pos == dest) then(
351 p := traceJumpsLong(start, nc pos, dest, reach, posTrace) // look further
363 stepTrace := method(m,
364 reach := List clone preallocateToSize(dimP) // not to interfere with reachableCells
365 dimP repeat(reach append(nil))
366 posTrace := List clone
367 cellP at(m startPos) neighbors foreach(i, nc,
369 if (nc pos == m destPos) then(
370 posTrace append(nc pos) // reach by roll
372 p := if(shortJumps, traceJumpsShort(m startPos, m destPos, reach, posTrace),
373 traceJumpsLong(m startPos, m startPos, m destPos, reach, posTrace))
374 if (p, posTrace append(p))
378 posTrace append(m startPos)
382 getPossibleMoves := method(
383 if (self possibleMoves isNil,
384 self possibleMoves = List clone
385 // If the color to do a move has all its pieces in the target triangle,
386 // we assume that it shall/will not move any piece back out, even if it
387 // should be to help an other color on the same team. So, if it has
388 // "made it", we skip the scanning.
389 if (pieceTypeHasMadeIt not,
390 // Scanning the board for pieces of right color ...
391 getBoard foreach(s, bs,
392 if (bs == self pieceType,
393 reach := reachableCells(s)
394 // Finding possible destinations ...
396 if (rd and legalDestType(pieceType, cellP at(d) cType),
397 self possibleMoves append(Move new(self, s, d))
402 if (variations) then(
403 self possibleMoves sortInPlaceBy(method(m1, m2, m1 gain > m2 gain))
405 // Using bubble sort as long as I need full match with Java version ...
406 for(i, 0, self possibleMoves size - 2,
407 mi := self possibleMoves at(i)
408 for(j, i + 1, self possibleMoves size - 1,
409 mj := self possibleMoves at(j)
410 if (mj gain > mi gain,
411 self possibleMoves swapIndices(i, j)
418 if (self possibleMoves size == 0,
419 self possibleMoves append(Move new(self, -1, -1)) // no move, next please
422 return self possibleMoves
425 movesWithRelGainAtLeast := method(coef,
426 // If we only want the moves with the highest gain, coef should be 1.
427 // If we accept lower gains, coef should be < 1.
428 bestGain := getPossibleMoves first gain
429 if (bestGain > 0) then(
430 reqGain := bestGain * coef
432 // All moves have negative gain. Some tweak is needed ...
433 worstRelBest := getPossibleMoves last gain - bestGain
434 reqGain := worstRelBest + (bestGain - worstRelBest) * coef
435 //writeln("bestGain=", bestGain, ", worstRelBest=", worstRelBest, ", reqGain=", reqGain)
437 return getPossibleMoves select(i, move, move gain >= reqGain)
440 acceptableMove := method(start, dest,
441 getPossibleMoves detect(i, move, (move startPos == start) and (move destPos == dest))
444 hasRealMove := method(
445 getPossibleMoves detect(i, move, move isReal)
448 movesFromStart := method(
449 //return if(self creator, self creator stateBefore movesFromStart + 1, 0)
450 // Workaround due to stack space limitations in Io 20060304 ...
455 gs = gs creator stateBefore
463 Evaluator := Object clone do(
464 //parent := nil // ChinaBoard, slot now created with setParent
473 evaluation := method(pos, pieceType,
475 dist := dir at(pieceType) distance(c row, c col)
476 absOff := dir at(pieceType) axisOffset(c row, c col) abs
477 //writeln(dist, " ", absOff)
478 //return dist * (100 - (2 * dist)) - absOff
479 return dist pow(1/3) * 300 - absOff // to be tuned
483 pieceType := move stateBefore board at(move startPos)
484 return evaluation(move destPos, pieceType) - evaluation(move startPos, pieceType)
487 targetEvaluation := method(
489 pieceType0 := cellP at(0) cType // should be 2
490 targetType := dir at(pieceType0) target // should be 5 (opposite to 2)
491 //writeln("Evaluator targetEvaluation: ", pieceType0, " ", targetType)
493 self tEval = self tEval + evaluation(pos, targetType) - evaluation(pos, pieceType0)
502 Move := Object clone do(
509 new := method(gs, start, dest,
514 mv gain = if(mv isReal, gs evaluator gain(mv), 0)
518 isReal := method(self startPos >= 0)
520 getStateAfter := method(disposeOldBoard,
521 nextState := if(self stateAfter, self stateAfter, GameState newFromMove(self))
522 if (disposeOldBoard and (self stateBefore creator),
523 // The previous state was not the initial state.
524 self stateBefore board = nil // dispose to reduse memory usage
532 ChinaBoard := Object clone do(
536 cellRC := nil // the cells of the board, as a 2-dimensional List
537 cellP := nil // the same cells, as a 1-dimensional List
540 dir := nil // List of Directions
541 teamPolarities := nil // e.g. list(0, -1, 0, 0, 1, 0, 0)
546 moveTrace := nil // step positions of last move, or possible new move
550 makeCellRow := method(pos, row, c,
551 self cellRC atInsert(row, List clone preallocateToSize(c size))
554 cell := Cell clone setup(pos, row, col)
555 self cellP atInsert(pos, cell)
556 self cellRC at(row) atInsert(col, cell)
558 cell color = self dir at(t) cellColor
561 self cellRC at(row) atInsert(col, nil)
567 cellAtRowCol := method(row, col,
568 if ((row >= 0) and (row < self dimR) and (col >= 0) and (col < self cellRC at(row) size),
569 return self cellRC at(row) at(col)
575 dir = List clone preallocateToSize(7)
576 dir append(Direction new(0, -1, -1, -1, 0, "white")) // just for the color of common cell
577 dir append(Direction new(4, 1, 1, -8, 0, "blue"))
578 dir append(Direction new(5, 1, 0, 0, 24, "yellow"))
579 dir append(Direction new(6, 0, -1, 16, -8, "green"))
580 dir append(Direction new(1, -1, -1, 24, 0, "magenta"))
581 dir append(Direction new(2, -1, 0, 16, 8, "red"))
582 dir append(Direction new(3, 0, 1, 0, -24, "cyan"))
584 self cellRC = List clone preallocateToSize(self dimR)
585 self cellP = List clone preallocateToSize(self dimP)
587 // 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6
588 p = makeCellRow(p, 0, list(9,9,9,9,9,9,9,9,9,9,9,9,2))
589 p = makeCellRow(p, 1, list(9,9,9,9,9,9,9,9,9,9,9,2,2))
590 p = makeCellRow(p, 2, list(9,9,9,9,9,9,9,9,9,9,2,2,2))
591 p = makeCellRow(p, 3, list(9,9,9,9,9,9,9,9,9,2,2,2,2))
592 p = makeCellRow(p, 4, list(9,9,9,9,1,1,1,1,0,0,0,0,0,3,3,3,3))
593 p = makeCellRow(p, 5, list(9,9,9,9,1,1,1,0,0,0,0,0,0,3,3,3))
594 p = makeCellRow(p, 6, list(9,9,9,9,1,1,0,0,0,0,0,0,0,3,3))
595 p = makeCellRow(p, 7, list(9,9,9,9,1,0,0,0,0,0,0,0,0,3))
596 p = makeCellRow(p, 8, list(9,9,9,9,0,0,0,0,0,0,0,0,0))
597 p = makeCellRow(p, 9, list(9,9,9,6,0,0,0,0,0,0,0,0,4))
598 p = makeCellRow(p, 10, list(9,9,6,6,0,0,0,0,0,0,0,4,4))
599 p = makeCellRow(p, 11, list(9,6,6,6,0,0,0,0,0,0,4,4,4))
600 p = makeCellRow(p, 12, list(6,6,6,6,0,0,0,0,0,4,4,4,4))
601 p = makeCellRow(p, 13, list(9,9,9,9,5,5,5,5))
602 p = makeCellRow(p, 14, list(9,9,9,9,5,5,5))
603 p = makeCellRow(p, 15, list(9,9,9,9,5,5))
604 p = makeCellRow(p, 16, list(9,9,9,9,5))
610 // Find neighbors ...
611 self cellRC foreach(row, cellR,
612 cellR foreach(col, c,
614 c neighbors = List clone preallocateToSize(6)
615 c neighbors append(cellAtRowCol(row, col - 1))
616 c neighbors append(cellAtRowCol(row - 1, col))
617 c neighbors append(cellAtRowCol(row - 1, col + 1))
618 c neighbors append(cellAtRowCol(row, col + 1))
619 c neighbors append(cellAtRowCol(row + 1, col))
620 c neighbors append(cellAtRowCol(row + 1, col - 1))
625 self reachScratch = List clone preallocateToSize(self dimP)
626 self dimP repeat(self reachScratch append(nil))
627 self evaluator = Evaluator new(self)
628 //self currentState = GameState initialState(self, -1)
631 //writeln("Using new Random methods")
632 self random = Random clone setSeed(Date clone now asNumber)
634 writeln("Using old random methods")
635 self random = Object clone do(
636 value := method(x, Number random(x))
638 Date clone now asNumber setRandomSeed
644 newGame := method(sJumps, tPolar, team1,
645 self shortJumps = if(sJumps, true, false) // for compatibility
646 self teamPolarities = tPolar
647 self currentState = GameState initialState(self, team1)
648 self curRevealed = -1
652 legalDestType := method(pieceType, destType,
653 (destType == 0) or (destType == pieceType) or (destType == (self dir at(pieceType) target))
656 nextPieceType := method(pType,
659 pType = if(pType < 6, pType + 1, 1)
660 notFound = (self teamPolarities at(pType) == 0)
665 nameOfColorToMove := method(
666 return self dir at(self currentState pieceType) colorName
669 vertInc := method(horInc, horInc * (3 sqrt) / (2) ceil)
671 centerX := method(cell, horInc, horInc * (cell col + (cell row / 2)))
672 //centerY := method(cell, horInc, vertInc(horInc) * (cell row))
674 paint := method(x0, y0, horInc, showPosEval,
675 cs := self currentState
677 cSize := (horInc / 3 sqrt) ceil
678 pSize := (cSize / 2) floor
679 vInc := vertInc(horInc)
680 //writeln("cSize=", cSize, ", pSize=", pSize, ", vertInc=", vInc)
683 glTranslated(x0, y0, 0)
685 // Draw arrow indicating color and direction ...
687 glTranslated(12 * horInc, -8 * vInc, 0) // middle of board
688 glRotated(cs pieceType * (-60) + 30, 0, 0, 1)
689 if (cs hasRealMove) then(
690 self dir at(cs pieceType) arrowColor glColor
692 Colors at("gray") glColor
694 glBegin(GL_TRIANGLES)
695 glVertex2d(horInc * 6.87, vInc)
696 glVertex2d(horInc * 8.4, 0)
697 glVertex2d(horInc * 6.87, -vInc)
702 self cellRC foreach(row, cellR,
703 glPushMatrix // 1.2.1
704 cellR foreach(col, cell,
706 quad := gluNewQuadric
708 gluDisk(quad, 0, cSize, slices, 1)
709 glColor4d(grayLev, grayLev, grayLev, 0.6)
711 gluDisk(quad, cSize - 1, cSize, slices, 1)
712 pType := cs getBoard at(cell pos)
715 if (cell pos != self selectedPos) then(
716 self dir at(pType) drawPiece(quad, pSize)
718 // Indicating where piece is moving from ...
719 self dir at(pType) pieceColor2 glColor // darker outline
720 gluDisk(quad, pSize - 1, pSize, 90, 1)
724 // Write the evaluation of the postion ...
726 glTranslated(-0.2 * horInc, -0.1 * vInc, 0)
727 glScaled(0.08, 0.08, 0)
728 glColor4d(0, 0, 0, 1)
729 ev := self evaluator evaluation(cell pos, cs pieceType)
730 glutStrokeString(0, ev asString(0, 1))
734 glTranslated(horInc, 0, 0)
737 glTranslated(horInc / 2, -vInc, 0)
741 move := currentRevealedMove // possible new move
743 self moveTrace = cs stepTrace(move)
746 // Draw the step trace of the last move, or possible new move ...
748 Colors at("darkGray") glColor
750 glBegin(GL_LINE_STRIP)
751 self moveTrace foreach(i, pos,
752 cell := self cellP at(pos)
753 glVertex2d(centerX(cell, horInc), -vInc * cell row)
756 mtLast := self moveTrace size - 1
757 tempSize := pSize * 0.27
758 endSize := pSize * 0.39
759 self moveTrace foreach(i, pos,
761 cell = self cellP at(pos)
762 glTranslated(centerX(cell, horInc), -vInc * cell row, 0)
763 gluDisk(gluNewQuadric, if(i < mtLast, 0, endSize - 1),
764 if(0 < i < mtLast, tempSize, endSize), slices, 1)
769 // Draw game progression bars ...
770 barThick := -vInc * 0.3
771 barMaxLength := horInc * 6.5
772 tEval := self evaluator targetEvaluation
774 glTranslated(80, -14 * vInc, 0)
775 Colors at("darkGray") glColor
776 ChinaApp drawString(cs movesFromStart asString)
777 glTranslated(0, -0.25 * vInc, 0)
779 Colors at("gray") glColor
781 glBegin(GL_LINE_LOOP)
783 glVertex2d(barMaxLength, 0)
784 glVertex2d(barMaxLength, barThick * 6)
785 glVertex2d(0, barThick * 6)
787 cs evals foreach(i, e,
788 self dir at(i + 1) arrowColor glColor
789 barLength := barMaxLength * (tEval + e) / tEval
792 glVertex2d(barLength, 0)
793 glVertex2d(barLength, barThick)
794 glVertex2d(0, barThick)
796 glTranslated(0, barThick, 0)
803 paintMovingPiece := method(x, y, horInc,
804 cs := self currentState
805 cSize := (horInc / 3 sqrt) ceil
806 pSize := (cSize / 2) floor
808 glTranslated(x, y, 0)
809 self dir at(cs pieceType) drawPiece(gluNewQuadric, pSize)
813 lastMove := method(self currentState creator)
815 teamThatDidLastMove := method(
816 return if(lastMove, self teamPolarities at(lastMove stateBefore pieceType), nil)
819 teamToMove := method(
820 return self teamPolarities at(self currentState pieceType)
823 humanMustSkip := method(
824 return ((teamToMove == -1) and (self currentState hasRealMove == nil))
827 clickedCell := method(x, y, horInc, btnState, devMode,
828 cs := self currentState
829 row := (0 + y / vertInc(horInc) + 0.5) floor
830 col := (0 + (x / horInc) - (row / 2) + 0.5) floor
831 c := cellAtRowCol(row, col)
833 pType := cs getBoard at(c pos)
834 if (btnState == 0) then(
835 // Mouse button is pressed
836 //writeln("clickedCell: ", x, " ", y, " row=", row, " col=", col, " pType=", pType)
837 if ((devMode not) and (teamToMove == 1) and (pType > 0),
838 return -1 // machine to move
840 if (pType == cs pieceType) then(
841 if (cs pieceTypeHasMadeIt) then(
844 self selectedPos = c pos
848 return if(pType > 0, -3, nil) // not the one to do a move, or empty
850 ) elseif (btnState == 1,
851 // Mouse button is released
852 if (self selectedPos < 0, return nil)
853 move := cs acceptableMove(self selectedPos, c pos)
855 self curRevealed = -1
857 self currentState = move getStateAfter(1)
858 self selectedPos = -1
860 ) elseif (c pos == selectedPos,
861 self selectedPos = -1
862 return nil // released at the same cell
864 sType := cs getBoard at(selectedPos)
865 self selectedPos = -1
866 // Cell is already taken (pType > 0), or not legal move
867 //writeln(sType, " ", c cType, " ", legalDestType(sType, c cType))
868 return if(pType > 0, -4, if(legalDestType(sType, c cType), -5, -6))
871 ) elseif (self selectedPos >= 0,
872 self selectedPos = -1
877 automaticMove := method(showDetails,
878 cs := self currentState
880 if ((self variations) and (cs getPossibleMoves size > 1),
881 bestMoves := cs movesWithRelGainAtLeast(0.95)
882 if (bestMoves first gain > 0,
884 bestMoves foreach(i, mv, accumGain = accumGain + mv gain)
885 randGain := self random value(accumGain)
887 writeln(cs movesFromStart + 1, ": ", bestMoves size,
888 " ag=", accumGain, " randGain=", randGain)
891 move = bestMoves detect(i, mv,
892 (accumGain = accumGain + mv gain) >= randGain
895 // All moves have negative gain. Keep it simple ...
896 move = bestMoves anyOne
898 if (showDetails, writeln("gain of rand. move: ", move gain))
900 move = cs getPossibleMoves first
902 self curRevealed = -1
906 self moveTrace = cs stepTrace(move)
907 info = Sequence clone appendSeq((cs movesFromStart + 1) asString)
908 info appendSeq(": size=", cs getPossibleMoves size asString)
909 info appendSeq(", gain=", move gain asString)
911 self currentState = move getStateAfter(1);
915 pieceTypeThatJustMadeIt := method(
917 if (self currentState pieceTypeHasMadeIt(lastMove stateBefore pieceType),
918 if (lastMove gain > 0, return lastMove stateBefore pieceType)
925 notYet := self teamPolarities detect(i, tPol,
926 (tPol != 0) and (self currentState pieceTypeHasMadeIt(i) not)
928 return (notYet isNil)
931 undoLastMove := method(
933 self currentState = lastMove stateBefore
934 self curRevealed = -1
939 currentRevealedMove := method(
940 if (self curRevealed >= 0,
941 m := self currentState getPossibleMoves at(self curRevealed)
942 if (m isReal, return m)
947 revealNextMove := method(inc,
948 pMoves := self currentState getPossibleMoves
949 mCount := pMoves size
951 if ((self curRevealed < 0) and (inc < 0), inc = 0)
952 self curRevealed = self curRevealed + inc + mCount % mCount
953 m := currentRevealedMove
954 if (m and (m isReal),
955 info := Sequence clone
956 info appendSeq("Possible move ", (self curRevealed + 1) asString, "/")
957 info appendSeq(mCount asString, ", gain=", m gain asString(0, 1))
958 relGain := 0 + (m gain) / (pMoves first gain)
959 info appendSeq(" (", relGain asString(0, 3), ")")
966 saveGame := method(filePath,
969 gs := self currentState
971 moves push(gs creator)
972 gs = gs creator stateBefore
974 file := File clone setPath(filePath)
975 if (file exists, file remove)
977 file write("newGame(", if(self shortJumps, "1", "nil"), ", {")
978 self teamPolarities foreach(i, tp,
979 file write(tp asString)
980 if (i < 6, file write(", "))
982 // Note: 'moves last
' is now the first move in the game.
984 self teamPolarities at(moves last stateBefore pieceType) asString, ")\n")
985 file write("moves({\n")
987 while (m = moves pop,
988 file write("{", m startPos asString, ", ", m destPos asString, "},\n")
990 file write("nil})\n")
994 writeln("*** saveGame: ", e error)
996 return if(e, e, /* normal */ nil)
999 loadGame := method(filePath,
1001 Object do(curlyBrackets := getSlot("list")) // to enable {a, b, ...}
1003 // When the block below is called (in the doFile), the new empty game
1004 // has already been created (thanks to the newGame call in the doFile).
1005 moves := block(mvList,
1006 mvList foreach(i, mv,
1008 move := self currentState acceptableMove(mv first, mv last)
1010 self currentState = move getStateAfter(1)
1012 Exception raise("Bad Move", mv asString) // Error ?
1016 ) setIsActivatable(true)
1021 writeln("*** loadGame: ", e error)
1023 return if(e, e, File clone setPath(filePath))
1029 Dialog := Object clone do(
1039 new := method(pr, in, action, prev,
1042 newD inBuf = Sequence clone appendSeq(in)
1043 newD cursorPos = in size
1044 newD actionBlock = getSlot("action") setIsActivatable(true)
1045 newD prevDialog = prev
1049 handleKeyboard := method(key,
1050 if (key == 13, // GLUT_KEY_RETURN
1051 return actionBlock(self)
1053 if (key == 27, // GLUT_KEY_ESC
1054 ChinaApp setMsg(nil)
1055 return self prevDialog
1058 self inBuf atInsertSeq(self cursorPos, key asCharacter)
1059 self cursorPos = self cursorPos + 1
1061 if (key == GLUT_KEY_DELETE,
1062 if (self cursorPos > 0,
1063 self cursorPos = self cursorPos - 1
1064 self inBuf removeSlice(self cursorPos, self cursorPos)
1070 handleSpecial := method(key,
1071 if (key == GLUT_KEY_UP,
1073 ) elseif (key == GLUT_KEY_DOWN,
1074 self cursorPos = self inBuf size
1075 ) elseif (key == GLUT_KEY_LEFT,
1076 if (self cursorPos > 0, self cursorPos = self cursorPos - 1)
1077 ) elseif (key == GLUT_KEY_RIGHT,
1078 if (self cursorPos < self inBuf size, self cursorPos = self cursorPos + 1)
1082 prevDialogActionApproved := method(
1083 return self prevDialog actionBlock(self prevDialog, 1)
1086 toggleCursor := method(self showCursor = self showCursor not)
1088 input := method(self inBuf asString)
1089 inputLeft := method(input slice(0, self cursorPos)) // before cursor
1090 inputRight := method(input slice(self cursorPos)) // after cursor
1092 asList := method(list(self prompt, input))
1096 ChinaApp := Object clone do(
1101 bkgndColor := Color clone set(0.55, 0.7, 0.55, 1)
1102 board := ChinaBoard clone
1103 useAllColors := false
1105 team1 := -1 // the team to do the very first move (-1: human)
1111 cursorInterval := 400 // millis
1112 mustSkipMsg := "(Type M to proceed to the next color.)"
1113 developerMode := false
1114 showPosEval := false
1118 gameFilename := "game.txt"
1121 ChinaApp setMsg := method(msg,
1122 self msgText = if((msg type == "List") or (msg isNil), msg, list(msg))
1125 ChinaApp addMsg := method(msg,
1126 if (msg, if (self msgText, self msgText append(msg), setMsg(msg)))
1129 ChinaApp boardStateIsInitial := method(
1130 return (self board currentState creator isNil)
1133 ChinaApp newGame := method(
1134 self board newGame(self shortJumps, self teamPolarities, self team1)
1137 ChinaApp setBackground := method(
1139 OpenGL glClearColor(red, green, blue, alpha)
1143 ChinaApp teamPolarities := method(
1144 if(self useAllColors, list(0, 1, 1, 1, -1, -1, -1), list(0, 0, 1, 0, 0, -1, 0))
1147 ChinaApp dataPath := method(fileName, Path with(launchPath, fileName))
1149 ChinaApp configure := method(
1151 configPath := dataPath("chinaConfig.io")
1153 if (File clone setPath(configPath) exists,
1154 configMap := doFile(configPath)
1155 self user = configMap at("user")
1156 if (bg := configMap at("bkgndColor"),
1157 self bkgndColor = bg
1158 if (self hasSlot("run"), setBackground) // refresh
1160 if (ww := configMap at("winWidth"), self winWidth = ww)
1161 if (wh := configMap at("winHeight"), self winHeight = wh)
1162 if (hi := configMap at("horInc"), self horInc = hi)
1163 self useAllColors = if(configMap at("useAllColors"), true, false)
1164 self shortJumps = if(configMap at("shortJumps"), true, false)
1166 status = "No file '" .. configPath .. "'"
1170 writeln("*** configure: ", e error)
1172 return if(e, e error, status)
1175 ChinaApp setupFont := method(
1178 self font := Font clone open("addons/Flux/resources/fonts/Vera/Sans/Normal.ttf")
1179 self font setPixelSize(self fontSize)
1181 writeln("Couldn't find the specified font
.")
1185 writeln("*** setupFont
: ", e error)
1189 ChinaApp drawString := method(string,
1191 self font drawString(string)
1194 glScaled(0.14, 0.1, 0)
1195 glutStrokeString(0, string)
1200 ChinaApp drawMessageBox := method(
1202 self msgText = self dialog asList
1206 glColor4d(1, 1, 1, 0.6)
1208 lineHeight := self fontSize * 1.3
1209 boxHeight := lineHeight * (self msgText size + 1)
1211 glVertex2d(extBorder, extBorder)
1212 glVertex2d(self winWidth - extBorder, extBorder)
1213 glVertex2d(self winWidth - extBorder, boxHeight)
1214 glVertex2d(extBorder, boxHeight)
1216 glTranslated(20, boxHeight - (self fontSize * 0.25), 0)
1217 glColor4d(0, 0.15, 0.1, 1)
1218 self msgText foreach(i, s,
1219 glTranslated(0, -lineHeight, 0)
1222 if (self dialog and (self dialog showCursor),
1224 glTranslated(self font widthOfString(self dialog inputLeft), 0, 0)
1225 glColor4d(1, 0, 0, 1)
1232 glScaled(0.14, 0.1, 0)
1233 glColor4d(0, 0, 0, 0)
1234 glutStrokeString(0, self dialog inputLeft)
1235 glColor4d(1, 0, 0, 1)
1247 ChinaApp boardTop := method(self horInc * 1.5)
1249 ChinaApp display := method(
1250 glClear(GL_COLOR_BUFFER_BIT)
1254 //writeln("paintList call
")
1257 self paintList = DisplayList clone
1258 //writeln("new paintList id
=", self paintList id)
1259 self paintList begin
1260 self board paint(self boardLeft, self winHeight - boardTop, self horInc,
1266 self board paint(self boardLeft, self winHeight - boardTop, self horInc,
1268 if (self motionX and (self board selectedPos >= 0),
1269 self board paintMovingPiece(self motionX, self motionY, self horInc)
1276 ChinaApp msgAboutWhatsNext := method(
1277 if (doneType := self board pieceTypeThatJustMadeIt,
1278 head := if(self board teamThatDidLastMove == 1,
1279 "My
", "Congratulations
! Your
"
1280 ) .. (self board dir at(doneType) colorName)
1281 setMsg(head .. " color has just completed
.")
1283 if (self board gameOver,
1284 addMsg("GAME OVER
. (Type G
if you want to play again
.)")
1286 if (self board humanMustSkip, addMsg(self mustSkipMsg))
1290 ChinaApp setDialog := method(prompt, input, actionBlock,
1291 newDialog := Dialog new(prompt, input, getSlot("actionBlock
"), self dialog)
1293 self dialog nextDialog = newDialog
1295 glutTimerFunc(self cursorInterval, 0) // to get a blinking cursor
1297 self dialog = newDialog
1301 ChinaApp loadGameWithDialog := method(
1302 setDialog("Load game from
:", self gameFilename,
1304 res := self board loadGame(dataPath(thisDialog input))
1305 if (res type == "File",
1306 self gameFilename = res name
1307 fileDate := res lastDataChangeDate asString("%d
-%b
, %H
:%M
")
1308 setMsg(Sequence clone appendSeq("Game loaded from file
'", res name,
1309 "' (", fileDate, ")"))
1310 ) elseif (res type == "Exception",
1313 setMsg("Loaded
nothing (" .. (res type) .. ")")
1315 self shortJumps = self board shortJumps
1316 self paintList = nil
1322 ChinaApp saveGameWithDialog := method(
1323 setDialog("Save game to
:", self gameFilename,
1324 block(thisDialog, approved,
1325 file := File clone setPath(dataPath(thisDialog input))
1326 if ((file exists) and (approved isNil),
1327 setDialog("This file exists
. Replace?
(y
/n
)", "",
1329 if (thisDialog input asUppercase beginsWithSeq("Y
"),
1330 return thisDialog prevDialogActionApproved
1332 return thisDialog prevDialog
1336 return thisDialog nextDialog
1338 self gameFilename = thisDialog input
1339 err := self board saveGame(dataPath(thisDialog input))
1340 setMsg(if(err, err error,
1341 Sequence clone appendSeq("Game saved to
'", self gameFilename, "'")))
1348 ChinaApp keyboard := method(key, x, y,
1349 //writeln("keyboard
: ", key)
1351 self dialog = self dialog handleKeyboard(key)
1355 kChar := key asCharacter
1357 if ((kChar asUppercase == "H
") or (kChar == "?
"),
1358 setMsg(list("These are the most useful commands
:",
1359 " M
- for the program to
do a move
",
1360 " Z
- to undo a move
",
1361 " G
- to start a new game
",
1362 " B
- to switch between who will begin the next game
",
1363 " A
- to switch between using only two
, or all siz colors
",
1364 " J
- to switch between using short
or long jumps
",
1365 " L
- to load a game from a file
",
1366 " S
- to save the current game to a file
",
1367 " C
- to reload the configuration file
",
1368 "(Click the mouse to hide this help
.)"))
1370 if (kChar asUppercase == "B
",
1371 self team1 = self team1 negate
1372 if (boardStateIsInitial,
1374 setMsg(if(self team1 == 1, "I
'll begin. (Type M)",
1375 "OK, " .. if(self user, user .. ", ", "") .. "you start."))
1377 setMsg("OK, " .. if(self team1 == 1, "I'll
", "you can
") .. " begin in the next game
.")
1380 if (kChar asUppercase == "A
",
1381 self useAllColors = self useAllColors not
1382 if (boardStateIsInitial, newGame) else (
1383 setMsg("In the next
game (type G
) the board will use
" .. if(self useAllColors,
1384 "ALL SIX colors
.", "ONLY TWO colors
."))
1387 if (kChar asUppercase == "J
",
1388 self shortJumps = self shortJumps not
1389 shortOrLong := if(self shortJumps, "SHORT jumps only
.", "LONG jumps
.")
1390 if (boardStateIsInitial,
1392 setMsg("Now it
's " .. shortOrLong)
1394 setMsg("In the next game (type G) we'll allow
" .. shortOrLong)
1397 if (kChar asUppercase == "G
", newGame)
1398 if (kChar asUppercase == "M
",
1399 showDetails := self developerMode and (kChar == "M
") // upper case
1400 if ((self board teamToMove == 1) or (self board humanMustSkip) or (self developerMode),
1401 info := self board automaticMove(showDetails)
1404 setMsg("Please move one of your
" .. (self board nameOfColorToMove) .. " pieces
!")
1407 if (kChar asUppercase == "Z
",
1408 if ((self board teamThatDidLastMove == 1) and (self developerMode not),
1409 setMsg("You may only undo your own moves
, not mine
.")
1411 self board undoLastMove
1414 if (kChar asUppercase == "L
", loadGameWithDialog)
1415 if (kChar asUppercase == "S
", saveGameWithDialog)
1416 if (kChar asUppercase == "D
",
1417 self developerMode = self developerMode not
1418 if (self developerMode,
1419 setMsg("Beware
: Developer mode
! (Type D to get normal
.)")
1421 setMsg("You
're now back in normal user mode.")
1422 self showPosEval = false
1425 if (self developerMode,
1426 if (kChar == "r", setMsg(self board revealNextMove(1)))
1427 if (kChar == "R", setMsg(self board revealNextMove(-1)))
1428 if (kChar asUppercase == "E", self showPosEval = self showPosEval not)
1429 if (kChar == "$", testDialog)
1431 if (kChar asUppercase == "C",
1432 if (err := configure,
1435 t := Date clone now asString("%H:%M:%S")
1436 setMsg(t .. " - New configuration loaded")
1439 self paintList = nil
1443 ChinaApp special := method(key, x, y,
1445 self dialog handleSpecial(key)
1447 if (key == GLUT_KEY_UP,
1448 self horInc = self horInc + 1
1449 setMsg("horInc = " .. horInc)
1450 ) elseif (key == GLUT_KEY_DOWN,
1451 self horInc = self horInc - 1
1452 setMsg("horInc = " .. horInc)
1453 ) elseif (key == GLUT_KEY_LEFT,
1454 self horInc = self horInc - 1
1455 setMsg("horInc = " .. horInc)
1456 ) elseif (key == GLUT_KEY_RIGHT,
1457 self horInc = self horInc + 1
1458 setMsg("horInc = " .. horInc)
1460 self paintList = nil
1465 ChinaApp motion := method(x, y,
1466 if (self board selectedPos >= 0,
1468 self motionY = self winHeight - y
1473 ChinaApp passiveMotion := method(x, y,
1475 if (self board moveTrace,
1476 self board moveTrace = nil
1477 self paintList = nil
1482 ChinaApp negatives := list(
1483 // Corresponding to clickedCell return values -1 through -7
1484 "It's my turn
! Type M
, and I
'll move something myself ...",
1485 "That color has completed it's mission
! Type M
.",
1486 "Sorry
, wrong color
!",
1487 "Sorry
, that cell is already taken
!",
1488 "Sorry
, that
's just not a valid move!",
1489 "You cannot leave that piece in an area belonging to another color!",
1490 "Do you want to retire this guy?"
1493 ChinaApp mouse := method(button, state, x, y,
1495 if ((self dialog ?finalFlag) isNil,
1496 setDialog("You cannot use the mouse while a dialog is active!", "",
1497 block(thisDialog, return thisDialog prevDialog)
1501 res := self board clickedCell(x - (self boardLeft), y - boardTop,
1502 self horInc, state, self developerMode)
1506 setMsg(self negatives at(-1 - res))
1512 self paintList = nil
1517 ChinaApp reshape := method(w, h,
1520 glViewport(0, 0, w, h)
1521 glMatrixMode(GL_PROJECTION)
1523 gluOrtho2D(0, w, 0, h)
1525 glMatrixMode(GL_MODELVIEW)
1531 ChinaApp timer := method(v,
1532 //writeln("timer ", v)
1534 self dialog toggleCursor
1535 glutTimerFunc(self cursorInterval, 0)
1540 ChinaApp run := method(
1541 hello := "Welcome to Chinese Checkers"
1542 if (self user, hello = hello .. ", " .. user)
1543 setMsg(list(hello .. "!", "You may type H to get help."))
1545 glutInitDisplayMode(GLUT_DOUBLE | GLUT_RGBA)
1546 glutInitWindowSize(self winWidth, self winHeight)
1547 glutInitWindowPosition(200, 60)
1549 glutCreateWindow("Chinese Checkers")
1550 glutEventTarget(self)
1556 glutPassiveMotionFunc
1559 glEnable(GL_LINE_SMOOTH)
1561 glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA)
1562 //glBlendFunc(GL_SRC_ALPHA, GL_ONE)
1563 //glHint(GL_LINE_SMOOTH_HINT, GL_NICEST)
1567 ChinaApp testDialog := method(
1568 setDialog("Test:", "abc",
1569 block(thisDialog, approved,
1570 write("Test got Return, ")
1571 if ((thisDialog input beginsWithSeq("ap")) and (approved isNil),
1572 writeln("but we need to confirm ...")
1573 setDialog("Really? (y/n)", "",
1575 write("Really got Return")
1576 if (thisDialog input == "y",
1577 return thisDialog prevDialogActionApproved
1579 return thisDialog prevDialog
1583 return thisDialog nextDialog
1585 writeln("that's all
.")
1586 setMsg("Input was
: " .. (thisDialog input))
1594 writeln("launchPath
: ", launchPath)