rem -- Uses @chr(227) for checkers, @chr(196) for kings -- rem -- Look for a sound file under 50k in size -- LIST CREATE, 1 LIST FILELIST, 1, @windir()\media\*.wav if @greater(@count(1), 0) REPEAT if @greater(50000, @file(@item(1, %x), Z)) %%wavfile = @item(1, %x) end %x = @succ(%x) UNTIL %%wavfile @equal(%x, @count(1)) end LIST CLOSE, 1 OPTION SCALE, 96 OPTION DECIMALSEP, "." TITLE By Mac rem -- Don't show main, it's use is to create/recreate child dialog -- DIALOG CREATE,"Main Checker Dialog",0,0,0,0 rem -- Holds possible moves for a single piece -- LIST CREATE, 8 rem -- Holds all possible moves for all computer pieces -- LIST CREATE, 7 :Start/Restart DIALOG CREATE,Checkers By Mac,-1,0,500,400 DIALOG ADD,STYLE,Style1,,,,YELLOW DIALOG ADD,STYLE,Style2,Symbol,36,BC,,CYAN DIALOG ADD,STYLE,Style3,Arial,12,B,,LTBLUE DIALOG ADD,STYLE,Style4,MS Sans Serif,8,B DIALOG ADD,STYLE,Empty1,Symbol,28,BC,BROWN,LTGREEN DIALOG ADD,STYLE,Empty,Symbol,28,BC,BROWN,BROWN DIALOG ADD,STYLE,Red,Symbol,28,B,BROWN,RED DIALOG ADD,STYLE,Black,Symbol,28,B,BROWN,BLACK DIALOG ADD,TEXT,GameInfo,5,405,,,"Your Turn...",Style3 DIALOG ADD,BUTTON,NewGame,30,405,90,20,"New Game",Style4 DIALOG ADD,TEXT,Instructions,60,405,90,160,"Click red checker to activate it (3 dots), then click a destination square (you can multiple jump). Clicking it again deactivates it so the computer can play. It has very basic AI, so don't cheat!" DIALOG ADD,TEXT,Board,0,0,400,400,,Style1 rem -- Squares numbers, their XY, who's piece/type if occupied -- rem -- BC = black checker, RC = red checker, NO = No checker -- rem -- BK = black king, RK = red king -- %x = 50 %y = 0 %n = 1 REPEAT if @greater(10, %n) %n = 0%n end rem -- Background squares to see where checker moved from -- DIALOG ADD,TEXT,B%n,%y,%x,50,50,"*",Empty1 rem -- Black checkers -- if @greater(13, %n) DIALOG ADD,TEXT,S%n,%y,%x,50,50," "@chr(227)" "|%n|%x|%y|BC,Black,CLICK end rem -- Blank Squares -- if @both(@greater(%n, 12), @greater(21, %n)) DIALOG ADD,TEXT,S%n,%y,%x,50,50,|%n|%x|%y|NO,Empty,CLICK end rem -- Red checkers -- if @greater(%n, 20) DIALOG ADD,TEXT,S%n,%y,%x,50,50," "@chr(227)" "|%n|%x|%y|RC,Red,CLICK end %n = @succ(%n) %x = @sum(%x, 100) if @greater(%x, 350) %y = @sum(%y, 50) %x = 0 if @equal(%y, 100)@equal(%y, 200)@equal(%y, 300) %x = 50 end end UNTIL @greater(%n, 32) rem -- Dots to highlight player active piece -- DIALOG ADD,TEXT,HL,0,0,50,50,@chr(188),TRANSPARENT,Style2,CLICK DIALOG HIDE,HL DIALOG SHOW rem -- Total checkers -- %%playernum = 12 %%compnum = 12 rem -- Active player checker -- %%checker = "" if %%wavfile PLAY %%wavfile end :EVLOOP rem -- Let everything catch up -- WAIT .2 WAIT EVENT %e = @event() if @equal(@substr(%e, 1), "S") goto ClickSquare end goto %e :NewGameBUTTON if @ask(Abandon this game?@tab()) DIALOG SELECT, 1 DIALOG CLOSE goto Start/Restart end goto EVLOOP :HLCLICK %%checker = "" DIALOG HIDE, HL if %%playermoved goto ComputerPlay end goto EVLOOP :ClickSquare %%square = @substr(%e, 1, 3) PARSE ";%%SQnum;%%SQx;%%SQy;%%SQstatus", @dlgtext(%%square) rem -- If red piece -- if @equal(%%SQstatus, RC)@equal(%%SQstatus, RK) %%checker = %%square PARSE ";%%startSQ;%%startSQx;%%startSQy;%%caller", @dlgtext(%%checker) DIALOG SHOW, HL DIALOG SETPOS, HL, %%startSQy, %%startSQx end rem -- If empty square -- if @equal(%%SQstatus, NO) if %%checker GOSUB CheckBoard if @greater(@count(8), 0) LIST SEEK, 8, 0 if @match(8, %%square) GOSUB MovePiece %%playermoved = 1 else INFO You cannot move there!@tab() end else INFO You cannot move there!@tab() end end end goto EVLOOP :ComputerPlay DIALOG SET, GameInfo, "Thinking..." WAIT LIST CLEAR, 7 rem -- Check all computer pieces for possible moves -- %x = 1 REPEAT if @greater(10, %x) %x = 0%x end PARSE ";%%startSQ;%%startSQx;%%startSQy;%%caller", @dlgtext(S%x) if @equal(%%caller, "BC")@equal(%%caller, "BK") GOSUB CheckBoard end %x = @succ(%x) UNTIL @greater(%x, 32) rem -- Check jumps or multiple jumps -- if @greater(@count(7), 0) %j = "" :CheckJumps %%OK = "" if @greater(@count(7), 0) LIST ASSIGN, 8, 7 LIST SEEK, 8, 0 %x = 0 REPEAT if @greater(@pos("JUMP", @item(8,%x)), 0) %%OK = 1 %j = 1 %%randompick = @item(8, %x) PARSE "%%square;%%start", %%randompick PARSE ";%%startSQ;%%startSQx;%%startSQy;%%caller", @dlgtext(%%start) rem -- Kill multiple jumps if this jump makes a king -- if @both(@equal(%%caller, BC), @greater(@substr(%%square, 2, 3), 28)) %%OK = "" end GOSUB MovePiece LIST CLEAR, 7 GOSUB CheckBoard %x = @pred(@count(8)) end %x = @succ(%x) UNTIL @equal(%x, @count(8)) end if %%OK goto CheckJumps end if %j goto ComputerPlayEnd end rem -- If can't jump, try to make a king -- %x = 0 %k = "" REPEAT PARSE "%a" , @item(8, %x) if @equal(%a, S29)@equal(%a, S30)@equal(%a, S31)@equal(%a, S32) %%randompick = @item(8, %x) PARSE "%%square;%%start", %%randompick PARSE ";%%startSQ;%%startSQx;%%startSQy;%%caller", @dlgtext(%%start) if @equal(%%caller, "BC") GOSUB MovePiece %x = @pred(@count(8)) %k = 1 end end %x = @succ(%x) UNTIL @equal(%x, @count(8)) if %k goto ComputerPlayEnd end rem -- Just pick a random move -- %x = 0 REPEAT %%randompick = @item(8, %x) %r = @datetime() rem -- get last digit (use as random number) %r = @substr(%r, @len(%r)) %x = @succ(%x) if @equal(%x, @count(8)) %x = 0 end UNTIL @equal(%r, 5) PARSE "%%square;%%start", %%randompick PARSE ";%%startSQ;%%startSQx;%%startSQy;%%caller", @dlgtext(%%start) GOSUB MovePiece end :ComputerPlayEnd if %%wavfile PLAY %%wavfile end DIALOG SET, GameInfo, "Your Turn..." %%playermoved = "" goto EVLOOP :CLOSE EXIT STOP rem ------------ GOSUB ROUTINES ------------ :CheckBoard rem -- Add all possible legal moves to LIST 8 -- rem -- Uses %%caller, %%startSQ, %%startSQx, %%startSQy -- LIST CLEAR, 8 if @equal(%%caller,"BC") goto CheckBoardDown end :CheckBoardUp rem -- Up left -- if @both(@greater(%%startSQ, 4), @greater(%%startSQx, 0)) %%dir = L if @equal(@mod(%%startSQy, 100), 0) %%up1 = 4 %%up2 = 5 else %%up1 = 5 %%up2 = 4 end GOSUB CheckUp end rem -- Up right -- if @both(@greater(%%startSQ, 4), @greater(350, %%startSQx)) %%dir = R if @equal(@mod(%%startSQy, 100), 0) %%up1 = 3 %%up2 = 4 else %%up1 = 4 %%up2 = 3 end GOSUB CheckUp end if @equal(%%caller,"RC") goto CheckBoardEnd end :CheckBoardDown rem -- Down left -- if @both(@greater(29, %%startSQ), @greater(%%startSQx, 0)) %%dir = L if @equal(@mod(%%startSQy, 100), 0) %%dn1 = 4 %%dn2 = 3 else %%dn1 = 3 %%dn2 = 4 end GOSUB CheckDown end rem -- Down right -- if @both(@greater(29, %%startSQ), @greater(350, %%startSQx)) %%dir = R if @equal(@mod(%%startSQy, 100), 0) %%dn1 = 5 %%dn2 = 4 else %%dn1 = 4 %%dn2 = 5 end GOSUB CheckDown end :CheckBoardEnd exit :CheckUp %z = @diff(%%startSQ, %%up1) GOSUB FormatZ PARSE ";%%tmp;;;%%piece", @dlgtext(S%z) if @equal(%%piece, "NO") LIST ADD, 8, S%%tmp|dud LIST ADD, 7, S%%tmp|S%%startSQ else rem -- If opponent is there, check for possible jump -- if @not(@equal(@substr(%%piece, 1), @substr(%%caller, 1))) if @both(@equal(%%dir, "L"), @greater(100, %%startSQx)) @both(@equal(%%dir, "R"), @greater(%%startSQx, 250)) goto CheckUpEnd end if @greater(%%startSQ, 8) %z = @diff(%z, %%up2) GOSUB FormatZ PARSE ";%%tmp;;;%%piece", @dlgtext(S%z) if @equal(%%piece, "NO") rem -- List piece to be removed if this move is used -- %z = @sum(%z, %%up2) GOSUB FormatZ LIST ADD, 8, S%%tmp|dud|JUMP|%z LIST ADD, 7, S%%tmp|S%%startSQ|JUMP|%z end end end end :CheckUpEnd exit :CheckDown %z = @sum(%%startSQ, %%dn1) GOSUB FormatZ PARSE ";%%tmp;;;%%piece", @dlgtext(S%z) if @equal(%%piece, "NO") LIST ADD, 8, S%%tmp|dud LIST ADD, 7, S%%tmp|S%%startSQ else rem -- If opponent is there, check for possible jump -- if @not(@equal(@substr(%%piece, 1), @substr(%%caller, 1))) if @both(@equal(%%dir, "L"), @greater(100, %%startSQx)) @both(@equal(%%dir, "R"), @greater(%%startSQx, 250)) goto CheckDownEnd end if @greater(25, %%startSQ) %z = @sum(%z, %%dn2) GOSUB FormatZ PARSE ";%%tmp;;;%%piece", @dlgtext(S%z) if @equal(%%piece, "NO") %z = @diff(%z, %%dn2) GOSUB FormatZ LIST ADD, 8, S%%tmp|dud|JUMP|%z LIST ADD, 7, S%%tmp|S%%startSQ|JUMP|%z end end end end :CheckDownEnd exit :MovePiece rem -- Uses %%square, %%caller, %%startSQ, %%startSQx, %%startSQy -- PARSE ";%%destSQ;%%destx;%%desty", @dlgtext(%%square) DIALOG REMOVE, S%%destSQ DIALOG REMOVE, S%%startSQ rem -- Replace destination square with appropriate checker or king -- if @equal(%%caller, "RC")@equal(%%caller, "RK") DIALOG REMOVE, HL if @both(@equal(%%caller, "RC"), @greater(%%desty, 0)) DIALOG ADD,TEXT,%%square,%%desty,%%destx,50,50," "@chr(227)" "|%%destSQ|%%destx|%%desty|RC,Red,CLICK else DIALOG ADD,TEXT,%%square,%%desty,%%destx,50,50," "@chr(196)" "|%%destSQ|%%destx|%%desty|RK,Red,CLICK end DIALOG ADD,TEXT,HL,%%desty,%%destx,50,50,@chr(188),TRANSPARENT,Style2,CLICK else if @both(@equal(%%caller, BC), @greater(350, %%desty)) DIALOG ADD,TEXT,%%square,%%desty,%%destx,50,50," "@chr(227)" "|%%destSQ|%%destx|%%desty|BC,Black,CLICK else DIALOG ADD,TEXT,%%square,%%desty,%%destx,50,50," "@chr(196)" "|%%destSQ|%%destx|%%desty|BK,Black,CLICK end end if %%checker %%checker = %%square WAIT .1 else WAIT end rem -- Replace old checker with blank square -- DIALOG ADD,TEXT,S%%startSQ,%%startSQy,%%startSQx,50,50,|%%startSQ|%%startSQx|%%startSQy|NO,Empty,CLICK PARSE ";%%startSQ;%%startSQx;%%startSQy;%%caller", @dlgtext(%%square) PARSE "%a;%b;%c;%d", @item(8) if %c %%remove = S%d GOSUB RemoveJumpedPiece end exit :RemoveJumpedPiece PARSE ";%a;%b;%c;%d", @dlgtext(%%remove) DIALOG REMOVE, %%remove if @equal(%d, BC)@equal(%d, BK) %%compnum = @pred(%%compnum) else %%playernum = @pred(%%playernum) end rem -- Replace checker with blank square -- DIALOG ADD,TEXT,%%remove,%c,%b,50,50,|%a|%b|%c|NO,Empty,CLICK rem -- Check for winner -- if @equal(%%compnum, 0) INFO YOU WON!@cr()@cr()Starting New Game...@tab() DIALOG SELECT, 1 DIALOG CLOSE goto Start/Restart end if @equal(%%playernum, 0) INFO COMPUTER WON...@cr()@cr()Starting New Game...@tab() DIALOG SELECT, 1 DIALOG CLOSE goto Start/Restart end exit :FormatZ if @greater(10, %z) %z = 0%z end exit