option explicit Dim objShell If WScript.Arguments.Count = 0 Then Set objShell = WScript.CreateObject("WScript.Shell") objShell.Run("cmd /c ""@echo off & title CHECKERS BY MARIOMASTA64 & cls & cscript.exe " & WScript.ScriptFullName & " 1""") Wscript.Quit WScript.Echo "Arguments were passed" End If dim wsh set wsh = createObject("wScript.shell") dim use_ps_trick ' ' Try to read registry value. If value does not exist, an error is thrown. ' Therefore, we use «on error resume next» to catch such an error. ' dim virtualTerminalLevel on error resume next virtualTerminalLevel = wsh.regRead("HKCU\Console\VirtualTerminalLevel") if err.number <> 0 then ' { ' ' The registry value does not exist, we have to ' use the «powershell trick» ' use_ps_trick = true else ' ' The registry valued does exist. We use ' the «powershell trick» depending on the value: ' if virtualTerminalLevel = 0 then use_ps_trick = true else use_ps_trick = false end if end if ' } ' ' Go back to normal error handling: ' on error goto 0 if use_ps_trick then ' { dim ps set ps = wsh.exec("powershell.exe -noProfile -executionPolicy bypass -c ""exit""") while ps.status = 0 wScript.sleep 50 wend end if ' } ' Code Above Is Totally 100% Stolen ' Fun Fact: Windows 10 Terminal Natively Supports Color ' Code Above Will Add It To CMD / Powershell Dim x,y,ix,iy,xa,ya,xb,yb,t,board,rplaying,bplaying,winner,invalid,valid,kinged,jumping,xtravel,ytravel,xdir,xmid,ymid,selection,length,color,xtemp,ytemp,display,selected,highlighted Function Min(x, y) If x < y Then Min = x Else Min = y End Function Function Max(x, y) If x > y Then Max = x Else Max = y End Function Function UpdateBoard(x,y,t,xa,ya) 'move cursor to beggining of cmd screen WScript.StdOut.Write Chr(27) & "[34A" 'clear screen WScript.StdOut.Write Chr(27) & "[2J" ' For color = 0 to 255 ' Display All Console Colors ' Wscript.StdOut.Write("[") ' Wscript.StdOut.Write(color) ' Wscript.StdOut.Write("m") ' Wscript.StdOut.Write(color) ' Wscript.StdOut.Write("") ' Next rplaying = 0 : bplaying = 0 : winner = 0 Wscript.StdOut.Write vbCrLf ' Creates a Newline Wscript.StdOut.Write(" ") Wscript.StdOut.Write("C") Wscript.StdOut.Write("H") Wscript.StdOut.Write("E") Wscript.StdOut.Write("C") Wscript.StdOut.Write("K") Wscript.StdOut.Write("E") Wscript.StdOut.Write("R") Wscript.StdOut.Write("S") Wscript.StdOut.Write vbCrLf ' Creates a Newline Wscript.StdOut.Write vbCrLf ' Creates a Newline ' Wscript.Echo " Checkers" Wscript.StdOut.Write " 01234567" Wscript.StdOut.Write vbCrLf ' Creates a Newline For ix = 0 to 7 ' Wscript.StdOut.Write(" ") Wscript.StdOut.Write " " Wscript.StdOut.Write ix Wscript.StdOut.Write " " ' Wscript.StdOut.Write(" ") For iy = 0 to 7 xtemp = ix While xtemp >= 2 xtemp = xtemp - 2 Wend ytemp = iy While ytemp >= 2 ytemp = ytemp - 2 Wend If xtemp = ytemp Then display = 0 Else display = 1 End If ' Wscript.StdOut.Write(xa) : Wscript.StdOut.Write(ix) : Wscript.StdOut.Write(ya) : Wscript.StdOut.Write(iy) highlighted = 0 If CInt(xa) = ix And CInt(ya) = iy Then highlighted = 1 End If Select Case board(ix)(iy) Case 0 If display = 1 Then Wscript.StdOut.Write("0") Else Wscript.StdOut.Write "_" End If Case 1 rplaying = 1 If highlighted = 1 Then Wscript.StdOut.Write("P") Else Wscript.StdOut.Write("P") End If ' Wscript.StdOut.Write 1 Case 2 rplaying = 1 If highlighted = 1 Then Wscript.StdOut.Write("K") Else Wscript.StdOut.Write("K") End If ' Wscript.StdOut.Write 2 Case 3 bplaying = 1 If highlighted = 1 Then Wscript.StdOut.Write("P") Else Wscript.StdOut.Write("P") End If ' Wscript.StdOut.Write 3 Case 4 bplaying = 1 If highlighted = 1 Then Wscript.StdOut.Write("K") Else Wscript.StdOut.Write("K") End If ' Wscript.StdOut.Write 4 Case Else Wscript.StdOut.Write "?" End Select ' Wscript.StdOut.Write board(ix)(iy) ' Wscript.StdOut.Write Omits Newline So Better Than Wscript.Echo Next Wscript.StdOut.Write vbCrLf ' Creates a Newline Next Wscript.StdOut.Write vbCrLf ' Creates a Newline If t = 1 Then Wscript.StdOut.Write(" Player") Else Wscript.StdOut.Write(" Player") End If ' Wscript.StdOut.Write " Player Turn: " ' Wscript.StdOut.Write t If rplaying <> 1 Then winner = 2 End If If bplaying <> 1 Then winner = 1 End If If xa <> 8 Then Wscript.StdOut.Write " / Selection: " Wscript.StdOut.Write xa Wscript.StdOut.Write ya Wscript.StdOut.Write " =>" End If Wscript.StdOut.Write vbCrLf ' Creates a Newline UpdateBoard = winner ' This is how returns work. End Function Function MoveLogic(t,xa,ya,xb,yb) invalid = 0 : jumping = 0 : kinged = 0 xtravel = Abs(xa - xb) : ytravel = Abs(ya - yb) xdir = xb - xa ' Wscript.StdOut.Write " executing" If board(xa)(ya) = 1 And xdir < 0 Then invalid = 1 End If If board(xa)(ya) = 3 And xdir > 0 Then invalid = 1 End If If xtravel <> ytravel Then invalid = 1 End If ' <> == != If xtravel > 2 Then Invalid = 1 End If If xtravel = 2 and ytravel = 2 Then ' xmid = (xa + xb) / 2 ' Just like fuze4 this doesnt work. i hate typing. xmid = Max(xa, xb) - 1 ' ymid = (ya + yb) / 2 ' Just like fuze4 this doesnt work. i hate typing. ymid = Max(ya, yb) - 1 If t = 1 And board(xmid)(ymid) <> 3 And board(xmid)(ymid) <> 4 Then invalid = 1 End If If t = -1 And board(xmid)(ymid) <> 1 And board(xmid)(ymid) <> 2 Then invalid = 1 End If jumping = 1 End If If invalid <> 1 Then If jumping = 1 Then ' xmid should be set properly unlike fuze4. ' ymid should be set properly unlike fuze4. board(xmid)(ymid) = 0 End If If board(xa)(ya) = 1 And xb = 7 Then kinged = 1 End If If board(xa)(ya) = 3 And xb = 0 Then kinged = 1 End If If kinged = 1 Then board(xb)(yb) = board(xa)(ya) + 1 Else board(xb)(yb) = board(xa)(ya) End If board(xa)(ya) = 0 t = t * -1 End If MoveLogic = t ' This is how returns work. End Function While 1 board = array(array(0,1,0,1,0,1,0,1),array(1,0,1,0,1,0,1,0),array(0,1,0,1,0,1,0,1),array(0,0,0,0,0,0,0,0),array(0,0,0,0,0,0,0,0),array(3,0,3,0,3,0,3,0),array(0,3,0,3,0,3,0,3),array(3,0,3,0,3,0,3,0)) ' board = array(array(0,0,0,0,0,0,0,1),array(0,0,0,0,0,0,3,0),array(0,0,0,0,0,0,0,1),array(0,0,0,0,0,0,0,0),array(0,0,0,0,0,0,0,0),array(3,0,0,0,0,0,0,0),array(0,1,0,0,0,0,0,0),array(3,0,0,0,0,0,0,0)) ' Debug Board ' Wscript.StdOut.Write board(0)(0) x = 0 : y = 0 : t = 1 : xa = 8 : ya = 8 : xb = 8 : yb = 8 : winner = 0 ' Why TF is this how it works????????? "Cannot use parentheses when calling a Sub" otherwise ' Wscript.StdOut.Write " New Game!" ' Wscript.StdOut.Write vbCrLf ' Creates a Newline UpdateBoard x,y,t,xa,ya ' winner = UpdateBoard (x,y,t,xa,ya) ' If = then () but if not then not ??????? wut?????????? ' Wscript.StdOut.Write winner While winner = 0 valid = 1 : selected = 0 : selection = "00" ' Error correction aka FUCKING NUKE the positions and start over If xa = 8 And ya <> 8 Then xa = 8 : ya = 8 : xb = 8 : yb = 8 End If If xa <> 8 And ya = 8 Then xa = 8 : ya = 8 : xb = 8 : yb = 8 End If If xb = 8 And yb <> 8 Then xa = 8 : ya = 8 : xb = 8 : yb = 8 End If If xb <> 8 And yb = 8 Then xa = 8 : ya = 8 : xb = 8 : yb = 8 End If winner = UpdateBoard(x,y,t,xa,ya) Select Case winner Case 1 rplaying = 1 Wscript.StdOut.Write " / Red Wins! / Type Anything To Reset" Wscript.StdOut.Write vbCrLf ' Creates a Newline Wscript.StdOut.Write vbCrLf ' Creates a Newline Case 2 bplaying = 1 Wscript.StdOut.Write " / Black Wins! / Type Anything To Reset" Wscript.StdOut.Write vbCrLf ' Creates a Newline Wscript.StdOut.Write vbCrLf ' Creates a Newline Case Else ' End Select ' winner = UpdateBoard x,y,t,xa,ya ' No parentheses if not getting variable because vbs ig Wscript.StdOut.Write vbCrLf ' Creates a Newline If xa = 8 Or ya = 8 Then WScript.StdOut.Write(" Source [ Col ] [ Row ] [ Exa: 14 ] : ") WScript.StdIn.Read(0) ' Get user input selection = WScript.StdIn.ReadLine() ' Store user input Else WScript.StdOut.Write(" Target [ Col ] [ Row ] [ Exa: 14 ] : ") WScript.StdIn.Read(0) ' Get user input selection = WScript.StdIn.ReadLine() ' Store user input End If If Len(selection) <> 2 Then valid = 0 End If If Not IsNumeric(Mid(selection, 1, 1)) Then valid = 0 End If ' Add Range Check If Not IsNumeric(Mid(selection, 2, 1)) Then valid = 0 End If ' Add Range Check Wscript.StdOut.Write vbCrLf ' Creates a Newline xtemp = Mid(selection, 1, 1) While xtemp >= 2 xtemp = xtemp - 2 Wend ytemp = Mid(selection, 2, 1) While ytemp >= 2 ytemp = ytemp - 2 Wend If xtemp = ytemp Then valid = 0 End If If valid = 1 Then x = Mid(selection, 1, 1) y = Mid(selection, 2, 1) If t = 1 And xa = 8 Then If board(x)(y) = 1 Or board(x)(y) = 2 Then selected = 1 End If End If If t = -1 And xa = 8 Then If board(x)(y) = 3 Or board(x)(y) = 4 Then selected = 1 End If End If If board(x)(y) = 0 And xa <> 8 Then selected = 1 End If If x = xa And y = ya Then selected = 1 End If End If If selected = 1 Then If xa = 8 Then xa = x Else xb = x End If If ya = 8 Then ya = y Else yb = y End If If xb = xa And yb = ya Then xa = 8 : ya = 8 : xb = 8 : yb = 8 End If If xb <> 8 And yb <> 8 Then t = MoveLogic(t,xa,ya,xb,yb) End If If xb <> 8 Then x = xb : xa = 8 : xb = 8 End If If yb <> 8 Then y = yb : ya = 8 : yb = 8 End If End If ' WScript.StdOut.Write(valid) ' Wscript.StdOut.Write vbCrLf ' Creates a Newline Wend Wend