Change parser to do C style () for operators: 1+2*3 == 1+(2)*3
[io/jrb1.git] / addons / Flux / samples / China / china.io
blobe68bca5ade56427a2b5a576db761d8361254e45b
1 // china.io
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/>
11 History:
12 1.5b4 Images
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.
24 1.0 First release
27 Prototypes Methods
28 ---------- ---------------------------------------------------------------
29 Object: setParent
30 List: asString
31 Color: adjustBrightness, adjustSaturation
32 Colors
33 Cell: setup
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,
47 saveGame, loadGame
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
57 OpenGL; Random;
59 Object setParent := method(p,
60 self parent := p
61 self ?appendProto(p)
64 if (List getSlot("asString") isNil,
65 List asString := method(
66 buf := Sequence clone appendSeq("(")
67 self foreach(i, v,
68 buf appendSeq(if(v, if(v ?asString, v asString, "???"), "nil"))
69 buf appendSeq(if(i < self size - 1, ", ", ")"))
71 return buf asString
75 Color do(
76 adjustBrightness := method(coef,
77 self setRed(self red * coef)
78 self setGreen(self green * coef)
79 self setBlue(self blue * coef)
80 return self
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)
87 return self
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(
105 cType := 0
106 color := nil
107 neighbors := nil
108 pos := nil
109 row := nil
110 col := nil
112 setup := method(p, r, c,
113 self pos = p
114 self row = r
115 self col = c
116 return self
119 ) // Cell
122 Direction := Object clone do(
123 setParent(OpenGL)
124 target := nil
125 a := nil
126 b := nil
127 c := nil
128 d := nil
129 colorName := nil
130 pieceColor := nil
131 pieceColor2 := nil
132 cellColor := nil
133 arrowColor := nil
134 image := nil
136 new := method(t, ai, bi, ci, di, cName,
137 newD := self clone
138 newD target = t
139 newD a = ai
140 newD b = bi
141 newD c = ci
142 newD d = di
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
148 e := try (
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)))
153 return newD
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,
167 if (image) then(
168 if (image error, writeln("*** drawPiece: ", image error))
169 glPushMatrix
170 glTranslated(-pSize -2, -pSize, 0)
171 image draw
172 glPopMatrix
173 ) else (
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)
181 ) // Direction
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
190 possibleMoves := nil
192 initialState := method(cb, team1,
193 // Creates the initial state
194 gs := self clone
195 gs setParent(cb)
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)
207 return gs
210 newFromMove := method(move,
211 // Creates a new state as a result of a move
212 gs := self clone
213 cb := move stateBefore parent // the ChinaBoard object
214 gs setParent(cb)
215 gs creator = move
216 movingPieceType := move stateBefore pieceType
217 // Copy board ...
218 gs board = List clone preallocateToSize(cb dimP) appendSeq(move stateBefore board)
219 if (move isReal,
220 gs board atPut(move startPos, 0)
221 gs board atPut(move destPos, movingPieceType)
223 // Copy evals
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)
227 move stateAfter = gs
228 return gs
231 restoreBoardFromPrevious := method(boardToRestore, move,
232 prevState := move stateBefore
233 if (prevState board) then(
234 boardToRestore appendSeq(prevState board)
235 ) else (
236 // Using try/catch here avoids stack overflow Exception:
237 e := try (
238 prevState restoreBoardFromPrevious(boardToRestore, self creator)
240 e catch (Exception, writeln("*** restoreBoardFromPrevious: ", e error))
242 if (move isReal,
243 boardToRestore atPut(move startPos, 0)
244 boardToRestore atPut(move destPos, prevState pieceType)
248 getBoard := method(
249 if (self board isNil,
250 // Restore board ...
251 self board = List clone preallocateToSize(dimP)
252 restoreBoardFromPrevious(self board, self creator)
254 return self board
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,
276 freeCount := 0
277 while (nc and ((board at(nc pos) == 0) or (nc pos == start)),
278 freeCount = freeCount + 1
279 nc = nc neighbors at(i)
281 if (nc,
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,
300 if (nc,
301 if (self board at(nc pos) == 0) then(
302 reach atPut(nc pos, 1) // reach by roll
303 ) else (
304 if (shortJumps, findJumpablesShort(startCell, reach))
306 if (shortJumps not, findJumpablesLong(start, startCell, reach))
309 return 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(
319 return dest
320 ) else (
321 p := traceJumpsShort(n2 pos, dest, reach, posTrace) // look further
322 if (p,
323 posTrace append(p)
324 return n2 pos
330 return nil
333 traceJumpsLong := method(start, from, dest, reach, posTrace,
334 cellP at(from) neighbors foreach(i, nc,
335 freeCount := 0
336 while (nc and ((board at(nc pos) == 0) or (nc pos == start)),
337 freeCount = freeCount + 1
338 nc = nc neighbors at(i)
340 if (nc,
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(
349 return dest
350 ) else (
351 p := traceJumpsLong(start, nc pos, dest, reach, posTrace) // look further
352 if (p,
353 posTrace append(p)
354 return nc pos
360 return nil
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,
368 if (nc,
369 if (nc pos == m destPos) then(
370 posTrace append(nc pos) // reach by roll
371 ) else (
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)
379 return posTrace
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 ...
395 reach foreach(d, rd,
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))
404 ) else (
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)
412 mi = mj
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
431 ) else (
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 ...
451 mfs := 0
452 gs := self
453 while (gs creator,
454 mfs = mfs + 1
455 gs = gs creator stateBefore
457 return mfs
460 ) // GameState
463 Evaluator := Object clone do(
464 //parent := nil // ChinaBoard, slot now created with setParent
465 tEval := 0
467 new := method(cb,
468 ev := self clone
469 ev setParent(cb)
470 return ev
473 evaluation := method(pos, pieceType,
474 c := cellP at(pos)
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
482 gain := method(move,
483 pieceType := move stateBefore board at(move startPos)
484 return evaluation(move destPos, pieceType) - evaluation(move startPos, pieceType)
487 targetEvaluation := method(
488 if (self tEval == 0,
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)
492 for(pos, 0, 9,
493 self tEval = self tEval + evaluation(pos, targetType) - evaluation(pos, pieceType0)
496 return self tEval
499 ) // Evaluator
502 Move := Object clone do(
503 stateBefore := nil
504 stateAfter := nil
505 startPos := nil
506 destPos := nil
507 gain := nil
509 new := method(gs, start, dest,
510 mv := self clone
511 mv stateBefore = gs
512 mv startPos = start
513 mv destPos = dest
514 mv gain = if(mv isReal, gs evaluator gain(mv), 0)
515 return mv
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
526 return nextState
529 ) // Move
532 ChinaBoard := Object clone do(
533 setParent(OpenGL)
534 dimR := 17
535 dimP := 121
536 cellRC := nil // the cells of the board, as a 2-dimensional List
537 cellP := nil // the same cells, as a 1-dimensional List
538 shortJumps := true
539 reachScratch := nil
540 dir := nil // List of Directions
541 teamPolarities := nil // e.g. list(0, -1, 0, 0, 1, 0, 0)
542 currentState := nil
543 evaluator := nil
544 selectedPos := -1
545 curRevealed := -1
546 moveTrace := nil // step positions of last move, or possible new move
547 variations := true
548 random := nil
550 makeCellRow := method(pos, row, c,
551 self cellRC atInsert(row, List clone preallocateToSize(c size))
552 c foreach(col, t,
553 if (t <= 6) then(
554 cell := Cell clone setup(pos, row, col)
555 self cellP atInsert(pos, cell)
556 self cellRC at(row) atInsert(col, cell)
557 cell cType = t
558 cell color = self dir at(t) cellColor
559 pos = pos + 1
560 ) else (
561 self cellRC at(row) atInsert(col, nil)
564 return pos
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)
571 return nil
574 init := method(
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)
586 p := 0
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))
606 /* 12
610 // Find neighbors ...
611 self cellRC foreach(row, cellR,
612 cellR foreach(col, c,
613 if (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)
630 if (?Random) then(
631 //writeln("Using new Random methods")
632 self random = Random clone setSeed(Date clone now asNumber)
633 ) else (
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
641 return self
642 ) // init
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
649 self moveTrace = nil
652 legalDestType := method(pieceType, destType,
653 (destType == 0) or (destType == pieceType) or (destType == (self dir at(pieceType) target))
656 nextPieceType := method(pType,
657 notFound := 1
658 while(notFound,
659 pType = if(pType < 6, pType + 1, 1)
660 notFound = (self teamPolarities at(pType) == 0)
662 return pType
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
676 slices := 6
677 cSize := (horInc / 3 sqrt) ceil
678 pSize := (cSize / 2) floor
679 vInc := vertInc(horInc)
680 //writeln("cSize=", cSize, ", pSize=", pSize, ", vertInc=", vInc)
681 grayLev := 0.25
682 glPushMatrix // 1
683 glTranslated(x0, y0, 0)
685 // Draw arrow indicating color and direction ...
686 glPushMatrix // 1.1
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
691 ) else (
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)
698 glEnd
699 glPopMatrix // 1.1
701 glPushMatrix // 1.2
702 self cellRC foreach(row, cellR,
703 glPushMatrix // 1.2.1
704 cellR foreach(col, cell,
705 if (cell,
706 quad := gluNewQuadric
707 cell color glColor
708 gluDisk(quad, 0, cSize, slices, 1)
709 glColor4d(grayLev, grayLev, grayLev, 0.6)
710 //glLineWidth(3)
711 gluDisk(quad, cSize - 1, cSize, slices, 1)
712 pType := cs getBoard at(cell pos)
713 if (pType > 0,
714 // Draw piece ...
715 if (cell pos != self selectedPos) then(
716 self dir at(pType) drawPiece(quad, pSize)
717 ) else (
718 // Indicating where piece is moving from ...
719 self dir at(pType) pieceColor2 glColor // darker outline
720 gluDisk(quad, pSize - 1, pSize, 90, 1)
723 if (showPosEval,
724 // Write the evaluation of the postion ...
725 glPushMatrix
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))
731 glPopMatrix
734 glTranslated(horInc, 0, 0)
736 glPopMatrix // 1.2.1
737 glTranslated(horInc / 2, -vInc, 0)
739 glPopMatrix // 1.2
741 move := currentRevealedMove // possible new move
742 if (move,
743 self moveTrace = cs stepTrace(move)
746 // Draw the step trace of the last move, or possible new move ...
747 if (self moveTrace,
748 Colors at("darkGray") glColor
749 //glLineWidth(1.2)
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)
755 glEnd
756 mtLast := self moveTrace size - 1
757 tempSize := pSize * 0.27
758 endSize := pSize * 0.39
759 self moveTrace foreach(i, pos,
760 glPushMatrix // 1.3
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)
765 glPopMatrix // 1.3
769 // Draw game progression bars ...
770 barThick := -vInc * 0.3
771 barMaxLength := horInc * 6.5
772 tEval := self evaluator targetEvaluation
773 glPushMatrix // 1.4
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
780 glLineWidth(1)
781 glBegin(GL_LINE_LOOP)
782 glVertex2d(0, 0)
783 glVertex2d(barMaxLength, 0)
784 glVertex2d(barMaxLength, barThick * 6)
785 glVertex2d(0, barThick * 6)
786 glEnd
787 cs evals foreach(i, e,
788 self dir at(i + 1) arrowColor glColor
789 barLength := barMaxLength * (tEval + e) / tEval
790 glBegin(GL_QUADS)
791 glVertex2d(0, 0)
792 glVertex2d(barLength, 0)
793 glVertex2d(barLength, barThick)
794 glVertex2d(0, barThick)
795 glEnd
796 glTranslated(0, barThick, 0)
798 glPopMatrix // 1.4
800 glPopMatrix // 1
803 paintMovingPiece := method(x, y, horInc,
804 cs := self currentState
805 cSize := (horInc / 3 sqrt) ceil
806 pSize := (cSize / 2) floor
807 glPushMatrix
808 glTranslated(x, y, 0)
809 self dir at(cs pieceType) drawPiece(gluNewQuadric, pSize)
810 glPopMatrix
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)
832 if (c,
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(
842 return -2
843 ) else (
844 self selectedPos = c pos
845 return nil
847 ) else (
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)
854 if (move) then(
855 self curRevealed = -1
856 self moveTrace = nil
857 self currentState = move getStateAfter(1)
858 self selectedPos = -1
859 return 1
860 ) elseif (c pos == selectedPos,
861 self selectedPos = -1
862 return nil // released at the same cell
863 ) else (
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
873 return -7
877 automaticMove := method(showDetails,
878 cs := self currentState
879 move := nil
880 if ((self variations) and (cs getPossibleMoves size > 1),
881 bestMoves := cs movesWithRelGainAtLeast(0.95)
882 if (bestMoves first gain > 0,
883 accumGain := 0
884 bestMoves foreach(i, mv, accumGain = accumGain + mv gain)
885 randGain := self random value(accumGain)
886 if (showDetails,
887 writeln(cs movesFromStart + 1, ": ", bestMoves size,
888 " ag=", accumGain, " randGain=", randGain)
890 accumGain = 0
891 move = bestMoves detect(i, mv,
892 (accumGain = accumGain + mv gain) >= randGain
894 ) else (
895 // All moves have negative gain. Keep it simple ...
896 move = bestMoves anyOne
898 if (showDetails, writeln("gain of rand. move: ", move gain))
899 ) else (
900 move = cs getPossibleMoves first
902 self curRevealed = -1
903 self moveTrace = nil
904 info := nil
905 if (move isReal,
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);
912 return info
915 pieceTypeThatJustMadeIt := method(
916 if (lastMove,
917 if (self currentState pieceTypeHasMadeIt(lastMove stateBefore pieceType),
918 if (lastMove gain > 0, return lastMove stateBefore pieceType)
921 return nil
924 gameOver := method(
925 notYet := self teamPolarities detect(i, tPol,
926 (tPol != 0) and (self currentState pieceTypeHasMadeIt(i) not)
928 return (notYet isNil)
931 undoLastMove := method(
932 if (lastMove,
933 self currentState = lastMove stateBefore
934 self curRevealed = -1
935 self moveTrace = nil
939 currentRevealedMove := method(
940 if (self curRevealed >= 0,
941 m := self currentState getPossibleMoves at(self curRevealed)
942 if (m isReal, return m)
944 return nil
947 revealNextMove := method(inc,
948 pMoves := self currentState getPossibleMoves
949 mCount := pMoves size
950 if (mCount > 0,
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), ")")
960 return info asString
963 return nil
966 saveGame := method(filePath,
967 e := try (
968 moves := List clone
969 gs := self currentState
970 while (gs creator,
971 moves push(gs creator)
972 gs = gs creator stateBefore
974 file := File clone setPath(filePath)
975 if (file exists, file remove)
976 file open
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.
983 file write("}, ",
984 self teamPolarities at(moves last stateBefore pieceType) asString, ")\n")
985 file write("moves({\n")
986 m := nil
987 while (m = moves pop,
988 file write("{", m startPos asString, ", ", m destPos asString, "},\n")
990 file write("nil})\n")
991 file close
993 e catch (Exception,
994 writeln("*** saveGame: ", e error)
996 return if(e, e, /* normal */ nil)
999 loadGame := method(filePath,
1000 e := try (
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,
1007 if (mv,
1008 move := self currentState acceptableMove(mv first, mv last)
1009 if (move,
1010 self currentState = move getStateAfter(1)
1011 ) else (
1012 Exception raise("Bad Move", mv asString) // Error ?
1016 ) setIsActivatable(true)
1018 doFile(filePath)
1020 e catch (Exception,
1021 writeln("*** loadGame: ", e error)
1023 return if(e, e, File clone setPath(filePath))
1026 ) // ChinaBoard
1029 Dialog := Object clone do(
1030 setParent(OpenGL)
1031 prompt := nil
1032 inBuf := nil
1033 cursorPos := 0
1034 showCursor := false
1035 actionBlock := nil
1036 prevDialog := nil
1037 nextDialog := nil
1039 new := method(pr, in, action, prev,
1040 newD := self clone
1041 newD prompt = pr
1042 newD inBuf = Sequence clone appendSeq(in)
1043 newD cursorPos = in size
1044 newD actionBlock = getSlot("action") setIsActivatable(true)
1045 newD prevDialog = prev
1046 return newD
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
1057 if (key isPrint,
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)
1067 return self
1070 handleSpecial := method(key,
1071 if (key == GLUT_KEY_UP,
1072 self cursorPos = 0
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))
1093 ) // Dialog
1096 ChinaApp := Object clone do(
1097 setParent(OpenGL)
1098 user := nil
1099 winWidth := 640
1100 winHeight := 640
1101 bkgndColor := Color clone set(0.55, 0.7, 0.55, 1)
1102 board := ChinaBoard clone
1103 useAllColors := false
1104 shortJumps := true
1105 team1 := -1 // the team to do the very first move (-1: human)
1106 horInc := 33
1107 boardLeft := -60
1108 fontSize := 16
1109 msgText := nil
1110 dialog := nil
1111 cursorInterval := 400 // millis
1112 mustSkipMsg := "(Type M to proceed to the next color.)"
1113 developerMode := false
1114 showPosEval := false
1115 motionX := nil
1116 motionY := nil
1117 paintList := nil
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(
1138 self bkgndColor do(
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(
1150 status := nil
1151 configPath := dataPath("chinaConfig.io")
1152 e := try (
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)
1165 ) else (
1166 status = "No file '" .. configPath .. "'"
1169 e catch (Exception,
1170 writeln("*** configure: ", e error)
1172 return if(e, e error, status)
1175 ChinaApp setupFont := method(
1176 e := try (
1177 if (Lobby ?Font,
1178 self font := Font clone open("addons/Flux/resources/fonts/Vera/Sans/Normal.ttf")
1179 self font setPixelSize(self fontSize)
1180 ) else (
1181 writeln("Couldn't find the specified font.")
1184 e catch (Exception,
1185 writeln("*** setupFont: ", e error)
1189 ChinaApp drawString := method(string,
1190 if (self ?font,
1191 self font drawString(string)
1192 ) else (
1193 glPushMatrix
1194 glScaled(0.14, 0.1, 0)
1195 glutStrokeString(0, string)
1196 glPopMatrix
1200 ChinaApp drawMessageBox := method(
1201 if (self dialog,
1202 self msgText = self dialog asList
1204 if (self msgText,
1205 glPushMatrix
1206 glColor4d(1, 1, 1, 0.6)
1207 extBorder := 4
1208 lineHeight := self fontSize * 1.3
1209 boxHeight := lineHeight * (self msgText size + 1)
1210 glBegin(GL_QUADS)
1211 glVertex2d(extBorder, extBorder)
1212 glVertex2d(self winWidth - extBorder, extBorder)
1213 glVertex2d(self winWidth - extBorder, boxHeight)
1214 glVertex2d(extBorder, boxHeight)
1215 glEnd
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)
1220 drawString(s)
1222 if (self dialog and (self dialog showCursor),
1223 if (self ?font,
1224 glTranslated(self font widthOfString(self dialog inputLeft), 0, 0)
1225 glColor4d(1, 0, 0, 1)
1226 glBegin(GL_LINES)
1227 glVertex2d(0, -6)
1228 glVertex2d(0, 16)
1229 glEnd
1230 ) else (
1231 glPushMatrix
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)
1236 glBegin(GL_LINES)
1237 glVertex2d(0, -60)
1238 glVertex2d(0, 150)
1239 glEnd
1240 glPopMatrix
1243 glPopMatrix
1247 ChinaApp boardTop := method(self horInc * 1.5)
1249 ChinaApp display := method(
1250 glClear(GL_COLOR_BUFFER_BIT)
1251 glLoadIdentity
1253 if (self paintList,
1254 //writeln("paintList call")
1255 self paintList call
1256 ) else (
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,
1261 self showPosEval)
1262 self paintList end
1263 self paintList call
1266 self board paint(self boardLeft, self winHeight - boardTop, self horInc,
1267 self showPosEval)
1268 if (self motionX and (self board selectedPos >= 0),
1269 self board paintMovingPiece(self motionX, self motionY, self horInc)
1271 drawMessageBox
1272 glFlush
1273 glutSwapBuffers
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.)")
1285 ) else (
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)
1292 if (self dialog,
1293 self dialog nextDialog = newDialog
1294 ) else (
1295 glutTimerFunc(self cursorInterval, 0) // to get a blinking cursor
1297 self dialog = newDialog
1298 return newDialog
1301 ChinaApp loadGameWithDialog := method(
1302 setDialog("Load game from:", self gameFilename,
1303 block(thisDialog,
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",
1311 setMsg(res error)
1312 ) else (
1313 setMsg("Loaded nothing (" .. (res type) .. ")")
1315 self shortJumps = self board shortJumps
1316 self paintList = nil
1317 return 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)", "",
1328 block(thisDialog,
1329 if (thisDialog input asUppercase beginsWithSeq("Y"),
1330 return thisDialog prevDialogActionApproved
1331 ) else (
1332 return thisDialog prevDialog
1336 return thisDialog nextDialog
1337 ) else (
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, "'")))
1342 return nil
1348 ChinaApp keyboard := method(key, x, y,
1349 //writeln("keyboard: ", key)
1350 if (self dialog,
1351 self dialog = self dialog handleKeyboard(key)
1352 self display
1353 return
1355 kChar := key asCharacter
1356 setMsg(nil)
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,
1373 newGame
1374 setMsg(if(self team1 == 1, "I'll begin. (Type M)",
1375 "OK, " .. if(self user, user .. ", ", "") .. "you start."))
1376 ) else (
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,
1391 newGame
1392 setMsg("Now it's " .. shortOrLong)
1393 ) else (
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)
1402 msgAboutWhatsNext
1403 ) else (
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.")
1410 ) else (
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.)")
1420 ) else (
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,
1433 setMsg(err)
1434 ) else (
1435 t := Date clone now asString("%H:%M:%S")
1436 setMsg(t .. " - New configuration loaded")
1439 self paintList = nil
1440 self display
1443 ChinaApp special := method(key, x, y,
1444 if (self dialog,
1445 self dialog handleSpecial(key)
1446 ) else (
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
1462 self display
1465 ChinaApp motion := method(x, y,
1466 if (self board selectedPos >= 0,
1467 self motionX = x
1468 self motionY = self winHeight - y
1469 self display
1473 ChinaApp passiveMotion := method(x, y,
1474 //yield
1475 if (self board moveTrace,
1476 self board moveTrace = nil
1477 self paintList = nil
1478 self display
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,
1494 if (self dialog,
1495 if ((self dialog ?finalFlag) isNil,
1496 setDialog("You cannot use the mouse while a dialog is active!", "",
1497 block(thisDialog, return thisDialog prevDialog)
1498 ) finalFlag := 1
1500 ) else (
1501 res := self board clickedCell(x - (self boardLeft), y - boardTop,
1502 self horInc, state, self developerMode)
1503 if (res == 1,
1504 msgAboutWhatsNext
1505 ) elseif (res < 0,
1506 setMsg(self negatives at(-1 - res))
1507 ) else (
1508 setMsg(nil)
1510 self motionX = nil
1511 self motionY = nil
1512 self paintList = nil
1514 self display
1517 ChinaApp reshape := method(w, h,
1518 self winWidth = w
1519 self winHeight = h
1520 glViewport(0, 0, w, h)
1521 glMatrixMode(GL_PROJECTION)
1522 glLoadIdentity
1523 gluOrtho2D(0, w, 0, h)
1525 glMatrixMode(GL_MODELVIEW)
1526 glLoadIdentity
1527 setBackground
1528 display
1531 ChinaApp timer := method(v,
1532 //writeln("timer ", v)
1533 if (self dialog,
1534 self dialog toggleCursor
1535 glutTimerFunc(self cursorInterval, 0)
1537 self display
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)
1548 glutInit
1549 glutCreateWindow("Chinese Checkers")
1550 glutEventTarget(self)
1551 glutDisplayFunc
1552 glutKeyboardFunc
1553 glutSpecialFunc
1554 glutMotionFunc
1555 glutMouseFunc
1556 glutPassiveMotionFunc
1557 glutReshapeFunc
1559 glEnable(GL_LINE_SMOOTH)
1560 glEnable(GL_BLEND)
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)
1564 glutMainLoop
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)", "",
1574 block(thisDialog,
1575 write("Really got Return")
1576 if (thisDialog input == "y",
1577 return thisDialog prevDialogActionApproved
1578 ) else (
1579 return thisDialog prevDialog
1583 return thisDialog nextDialog
1584 ) else (
1585 writeln("that's all.")
1586 setMsg("Input was: " .. (thisDialog input))
1587 return nil
1593 ChinaApp do(
1594 writeln("launchPath: ", launchPath)
1595 configure
1596 setupFont
1597 newGame