Black box: Difference between revisions

24,264 bytes added ,  1 month ago
Added FreeBASIC
m (Thundergnat moved page Black Box to Black box: capitalization policy)
(Added FreeBASIC)
 
(8 intermediate revisions by 4 users not shown)
Line 12:
-More or less atoms (maybe random)<br />
-Different grid sizes
=={{header|AutoHotkey}}==
<syntaxhighlight lang="autohotkey">SetBatchLines -1
;--------------------------------------------------------------------------------------
BoardSize := 8
GUI()
setupBoard()
OnMessage(0x0201, "WM_LBUTTONDOWN")
return
;--------------------------------------------------------------------------------------
GUI(){
global
BoardSize += 2 ; add left/right and top/buttom
lastIndex := BoardSize-1 ; 0-based
symbol := {}, w := h := 30
Menu, FileMenu, Add, Manual Entry, MenuHandler
Menu, FileMenu, Add, E&xit, MenuHandler
Menu, MyMenuBar, Add, &File, :FileMenu
Gui, Menu, MyMenuBar
Gui, font, s14, Consolas
loop % BoardSize**2
{
r := (A_Index-1)//BoardSize, c := Mod(A_Index-1, BoardSize)
options := r = 0 ? " v" r "_" c " gSendRay"
: c = 0 ? " v" r "_" c " gSendRay"
: c = lastIndex ? " v" r "_" c " gSendRay"
: r = lastIndex ? " v" r "_" c " gSendRay"
: " v" r "_" c
if (c = 0 && r = 0)
Gui, add, button, % "section x14 y14 w" w " h" h options
else if c = 0
Gui, add, button, % "section x14 y+0 w" w " h" h options
else
Gui, add, button, % "x+0 w" w " h" h options
}
for i, v in StrSplit("0_0,0_" lastIndex "," lastIndex "_0," lastIndex "_" lastIndex "", ",")
GuiControl, hide, % v
Gui, font, s10, Consolas
Gui, add, button, xs w80 vButtonDone gDone Disabled, % ButtonDoneText := "Done"
Gui, add, text, x+10, % "?? = Hit, ? = Reflection"
Gui, add, text, y+5 , % "Atoms Found = "
Gui, add, text, x+0 vTextAtom w80
Gui, +AlwaysOnTop
Gui, show,, Black Box
}
;--------------------------------------------------------------------------------------
GuiClose:
ExitApp
return
;--------------------------------------------------------------------------------------
MenuHandler(){
global
if (A_ThisMenuItem = "Manual Entry")
{
Menu, FileMenu, ToggleCheck, Manual Entry
if (Manual_Entry := !Manual_Entry)
resetBoard()
else
Board := [], mapBoard()
}
if (A_ThisMenuItem = "E&xit")
ExitApp
}
;--------------------------------------------------------------------------------------
setupBoard(){ ; land mines in random spots on PlayField
global
resetBoard()
if Manual_Entry
return
 
Random, atoms, % Floor(BoardSize/2)-1, % Floor(BoardSize/2)
;~ atoms += 8
loop % atoms
{
Random, rnd, 1, PlayField.Count()
x := PlayField.RemoveAt(rnd)
Mines[x.1, x.2] := true
}
mapBoard()
}
;--------------------------------------------------------------------------------------
resetBoard(){ ; Reset All
global
Board:=[], PlayField:=[], Mines:=[], Solution:=[], symbol:=[], found:=atoms:=0
loop % BoardSize*4
symbol.Push(Chr(0x0387+A_Index))
loop % BoardSize**2
{
r := (A_Index-1)//BoardSize, c := Mod(A_Index-1, BoardSize)
if (r>0 && r<lastIndex && c>0 && c<lastIndex)
PlayField.Push([r , c])
}
mapBoard()
}
;--------------------------------------------------------------------------------------
mapBoard(){ ; map all buttons to reflect Board
global
loop % BoardSize**2
{
r := (A_Index-1)//BoardSize, c := Mod(A_Index-1, BoardSize)
GuiControl,, % r "_" c, % ""
GuiControl,, % r "_" c, % v := Board[r, c]
if (r>0 && r<lastIndex && c>0 && c<lastIndex)
GuiControl, % (v = "" || v = "?" || v = "+") ? "Disable" : "Enable", % r "_" c
}
GuiControl,, ButtonDone, % ButtonDoneText
GuiControl,, TextAtom, % found " / " atoms
GuiControl, % found = atoms ? "Enable" : "Disable", ButtonDone
}
;--------------------------------------------------------------------------------------
WM_LBUTTONDOWN(){
global
MouseGetPos, mx, my, mw, buttonNum
buttonNum := StrReplace(buttonNum, "Button") - 1
r := buttonNum//BoardSize, c := Mod(buttonNum, BoardSize)
if !(R>0 && r<lastIndex && c>0 && c<lastIndex)
return
if Manual_Entry
{
Mines[r, c] := !Mines[r, c]
Board[r, c] := Mines[r, c] ? "?" : ""
atoms := Mines[r, c] ? atoms+1 : atoms-1
}
else
{
Solution[r, c] := !Solution[r, c]
Board[r, c] := Solution[r, c] ? "??" : ""
found := Board[r, c] ? found + 1 : found -1
}
mapBoard()
}
;--------------------------------------------------------------------------------------
Done(){
global
if (ButtonDoneText = "done")
{
ButtonDoneText := ":)"
for r, obj in Solution
for c, bool in obj
if Solution[r, c] && (Mines[r, c] = Solution[r, c])
Board[r, c] := "?" ; right
else if Solution[r, c] && (Mines[r, c] <> Solution[r, c])
Board[r, c] := "?" , ButtonDoneText := ":(" ; wrong marking
for r, obj in Mines
for c, bool in obj
if Mines[r, c] && (Mines[r, c] <> Solution[r, c])
Board[r, c] := "?" , ButtonDoneText := ":(" ; missed marking
mapBoard()
}
else
{
ButtonDoneText := "Done"
setupBoard()
}
}
;--------------------------------------------------------------------------------------
SendRay(){
global
; troubleshooting
if TroubleShooting
{
loop % BoardSize**2
r := (A_Index-1)//BoardSize, c := Mod(A_Index-1, BoardSize)
, Board[r, c] := Board[r, c] = "+" ? "" : Board[r, c]
mapBoard()
}
 
x := StrSplit(A_GuiControl, "_")
r := x.1, c := x.2
dir := (r = 0) ? "D" : (r = lastIndex) ? "U" : (c = 0) ? "R" : (c = lastIndex) ? "L" : ""
t := Board[r, c]
if (t && t<>"??" && t<>"?")
symbol.Push(t)
 
BlackBox([r, c, dir])
mapBoard()
}
;--------------------------------------------------------------------------------------
BlackBox(Coord){
global
end := Ray(Coord)
r := Coord.1, c := Coord.2
endR := end.1, endC := end.2
if (end.3 = "hit")
Board[r, c] := "??" ; Hit
else if (r = endR && c = endC)
Board[r, c] := "?" ; Reflection
else if (end.3 = "miss")
{
Random, rnd, 1, % symbol.Count()
ch := symbol.RemoveAt(rnd)
Board[r, c] := ch
Board[endR, endC] := ch ; Miss
}
}
;--------------------------------------------------------------------------------------
Ray(Coord){
global
r := Coord.1, c := Coord.2, dir := Coord.3
deltaR := dir = "D" ? 1 : dir = "U" ? -1 : 0
deltaC := dir = "R" ? 1 : dir = "L" ? -1 : 0
if TroubleShooting
{
Board[r, c] := "+"
GuiControl,, % r "_" c, % "+"
Sleep 5
}
; Hit
if (dir = "R" && Mines[r, c+1])
return [r, c, "hit"]
if (dir = "L" && Mines[r, c-1])
return [r, c, "hit"]
if (dir = "U" && Mines[r-1, c])
return [r, c, "hit"]
if (dir = "D" && Mines[r+1, c])
return [r, c, "hit"]
; Deflection
if (dir = "R" && Mines[r+1, c+1])
return c=0 ? [r, c, "deflect"] : Ray([r, c, "U"]) ; right to up
if (dir = "R" && Mines[r-1, c+1])
return c=0 ? [r, c, "deflect"] : Ray([r, c, "D"]) ; right to down
if (dir = "L" && Mines[r+1, c-1])
return c=lastIndex ? [r, c, "deflect"] : Ray([r, c, "U"]) ; left to up
if (dir = "L" && Mines[r-1, c-1])
return c=lastIndex ? [r, c, "deflect"] : Ray([r, c, "D"]) ; left to down
if (dir = "U" && Mines[r-1, c+1])
return r=lastIndex ? [r, c, "deflect"] : Ray([r, c, "L"]) ; up to left
if (dir = "U" && Mines[r-1, c-1])
return r=lastIndex ? [r, c, "deflect"] : Ray([r, c, "R"]) ; up to down
if (dir = "D" && Mines[r+1, c+1])
return r=0 ? [r, c, "deflect"] : Ray([r, c, "L"]) ; down to left
if (dir = "D" && Mines[r+1, c-1])
return r=0 ? [r, c, "deflect"] : Ray([r, c, "R"]) ; down to right
r += deltaR, c += deltaC ; advance
; Miss
if (r=0 || r=lastIndex || c=0 || c=lastIndex)
return [r, c, "miss"]
return Ray([r, c, dir])
}
;--------------------------------------------------------------------------------------
Alt:: ; for troubleshooting purposes only ;-)
TroubleShooting := !TroubleShooting
Gui, show,, % TroubleShooting ? "Black Box - TroubleShooting Mode" : "Black Box"
return
;--------------------------------------------------------------------------------------</syntaxhighlight>
 
=={{header|FreeBASIC}}==
<syntaxhighlight lang="vbnet">Dim Shared b(99) As String ' displayed board
Dim Shared h(99) As String ' hidden atoms
Dim Shared wikiGame As Boolean
wikiGame = False ' set to false for a 'random' game
 
#define atCorner(ix) ix = 0 Or ix = 9 Or ix = 90 Or ix = 99
#define inRange(ix) ix >= 1 And ix <= 98 And ix <> 9 And ix <> 90
#define atTop(ix) ix >= 1 And ix <= 8
#define atBottom(ix) ix >= 91 And ix <= 98
#define atLeft(ix) inRange(ix) And ix Mod 10 = 0
#define atRight(ix) inRange(ix) And ix Mod 10 = 9
#define inMiddle(ix) inRange(ix) And Not atTop(ix) And Not atBottom(ix) And Not atLeft(ix) And Not atRight(ix)
 
Sub OcultarAtomos
Dim As Integer metido = 0
While metido < 4
Dim As Integer a = Int(Rnd(1) * 78) + 11 ' 11 to 88 inclusive
Dim As Integer m = a Mod 10
If m = 0 Or m = 9 Or h(a) = "T" Then Continue While
h(a) = "T"
metido += 1
Wend
End Sub
 
Sub Intro
Cls
Color 15, 0
For i As Integer = 0 To 99
b(i) = " "
h(i) = "F"
Next i
If wikiGame Then
OcultarAtomos()
Else
h(32) = "T"
h(37) = "T"
h(64) = "T"
h(87) = "T"
End If
Print Spc(5); " === BLACK BOX ==="
Print !"\n H Hit (scores 1)"
Print " R Reflection (scores 1)"
Print " 1-9, Detour (scores 2)"
Print " a-c Detour for 10-12 (scores 2)"
Print " G Guess (maximum 4)"
Print " Y Correct guess"
Print " N Incorrect guess (scores 5)"
Print " A Unguessed atom"
Color 14, 0
Print !"\n Cells are numbered a0 to j9."
Print " Corner cells do nothing."
Print " Use edge cells to fire beam."
Print " Use middle cells to add/delete a guess."
Print " Game ends automatically after 4 suposicion."
Print " Enter q to abort game at any time."
End Sub
 
Sub DibujarCuadricula(puntos As Integer, suposicion As Integer)
Print " 0 1 2 3 4 5 6 7 8 9 "
Print " "; Chr(201); String(3, Chr(205)); Chr(203); String(3, Chr(205)); Chr(203); String(3, Chr(205)); Chr(203); String(3, Chr(205)); Chr(203); String(3, Chr(205)); Chr(203); String(3, Chr(205)); Chr(203); String(3, Chr(205)); Chr(203); String(3, Chr(205)); Chr(187)
Print "a "; Chr(186); " "; b(0); " "; Chr(186); " "; b(1); " "; Chr(186); " "; b(2); " "; Chr(186); " "; b(3); " "; Chr(186); " "; b(4); " "; Chr(186); " "; b(5); " "; Chr(186); " "; b(6); " "; Chr(186); " "; b(7); " "; Chr(186); " "; b(8)
Print " "; Chr(201); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(187)
Print "b "; Chr(186); " "; b(10); " "; Chr(186); " "; b(11); " "; Chr(186); " "; b(12); " "; Chr(186); " "; b(13); " "; Chr(186); " "; b(14); " "; Chr(186); " "; b(15); " "; Chr(186); " "; b(16); " "; Chr(186); " "; b(17); " "; Chr(186); " "; b(18); " "; Chr(186); " "; b(19); " "; Chr(186)
Print " "; Chr(204); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(185)
Print "c "; Chr(186); " "; b(20); " "; Chr(186); " "; b(21); " "; Chr(186); " "; b(22); " "; Chr(186); " "; b(23); " "; Chr(186); " "; b(24); " "; Chr(186); " "; b(25); " "; Chr(186); " "; b(26); " "; Chr(186); " "; b(27); " "; Chr(186); " "; b(28); " "; Chr(186); " "; b(29); " "; Chr(186)
Print " "; Chr(204); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(185)
Print "d "; Chr(186); " "; b(30); " "; Chr(186); " "; b(31); " "; Chr(186); " "; b(32); " "; Chr(186); " "; b(33); " "; Chr(186); " "; b(34); " "; Chr(186); " "; b(35); " "; Chr(186); " "; b(36); " "; Chr(186); " "; b(37); " "; Chr(186); " "; b(38); " "; Chr(186); " "; b(39); " "; Chr(186)
Print " "; Chr(204); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(185)
Print "e "; Chr(186); " "; b(40); " "; Chr(186); " "; b(41); " "; Chr(186); " "; b(42); " "; Chr(186); " "; b(43); " "; Chr(186); " "; b(44); " "; Chr(186); " "; b(45); " "; Chr(186); " "; b(46); " "; Chr(186); " "; b(47); " "; Chr(186); " "; b(48); " "; Chr(186); " "; b(49); " "; Chr(186)
Print " "; Chr(204); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(185)
Print "f "; Chr(186); " "; b(50); " "; Chr(186); " "; b(41); " "; Chr(186); " "; b(52); " "; Chr(186); " "; b(53); " "; Chr(186); " "; b(54); " "; Chr(186); " "; b(55); " "; Chr(186); " "; b(56); " "; Chr(186); " "; b(57); " "; Chr(186); " "; b(58); " "; Chr(186); " "; b(59); " "; Chr(186)
Print " "; Chr(204); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(185)
Print "g "; Chr(186); " "; b(60); " "; Chr(186); " "; b(61); " "; Chr(186); " "; b(62); " "; Chr(186); " "; b(63); " "; Chr(186); " "; b(64); " "; Chr(186); " "; b(65); " "; Chr(186); " "; b(66); " "; Chr(186); " "; b(67); " "; Chr(186); " "; b(68); " "; Chr(186); " "; b(69); " "; Chr(186)
Print " "; Chr(204); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(185)
Print "h "; Chr(186); " "; b(70); " "; Chr(186); " "; b(71); " "; Chr(186); " "; b(72); " "; Chr(186); " "; b(73); " "; Chr(186); " "; b(74); " "; Chr(186); " "; b(75); " "; Chr(186); " "; b(76); " "; Chr(186); " "; b(77); " "; Chr(186); " "; b(78); " "; Chr(186); " "; b(79); " "; Chr(186)
Print " "; Chr(204); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(185)
Print "i "; Chr(186); " "; b(80); " "; Chr(186); " "; b(81); " "; Chr(186); " "; b(82); " "; Chr(186); " "; b(83); " "; Chr(186); " "; b(84); " "; Chr(186); " "; b(85); " "; Chr(186); " "; b(86); " "; Chr(186); " "; b(87); " "; Chr(186); " "; b(88); " "; Chr(186); " "; b(89); " "; Chr(186)
Print " "; Chr(200); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(206); String(3, Chr(205)); Chr(188)
Print "j "; Chr(186); " "; b(90); " "; Chr(186); " "; b(91); " "; Chr(186); " "; b(92); " "; Chr(186); " "; b(93); " "; Chr(186); " "; b(94); " "; Chr(186); " "; b(95); " "; Chr(186); " "; b(96); " "; Chr(186); " "; b(97); " "; Chr(186); " "; b(98)
Print " "; Chr(200); String(3, Chr(205)); Chr(202); String(3, Chr(205)); Chr(202); String(3, Chr(205)); Chr(202); String(3, Chr(205)); Chr(202); String(3, Chr(205)); Chr(202); String(3, Chr(205)); Chr(202); String(3, Chr(205)); Chr(202); String(3, Chr(205)); Chr(188)
Color 10,0
Print !"\n Score = "; puntos; " Guesses = "; suposicion; " Status = "; Iif(suposicion <> 4, "In play", "Game over!")
Color 15, 0
Print
End Sub
 
Function SgteCelda() As Integer
Dim ix As Integer
Do
Dim As String sq
Input " Choose cell : ", sq
sq = Lcase(sq)
If Len(sq) = 1 And sq = "q" Then End
If Len(sq) <> 2 Or Instr("abcdefghij", Left(sq, 1)) = 0 Or Instr("0123456789", Right(sq, 1)) = 0 Then Continue Do
ix = (Asc(Left(sq, 1)) - 97) * 10 + Val(Right(sq, 1))
If atCorner(ix) Then Continue Do
Exit Do
Loop
Print
Return ix
End Function
 
Sub Puntuacion(puntos As Integer, suposicion As Integer)
For i As Integer = 11 To 88
Dim As Integer m = i Mod 10
If m = 0 Or m = 9 Then Continue For
If b(i) = "G" And h(i) = "T" Then
b(i) = "Y"
Elseif b(i) = "G" And h(i) = "F" Then
b(i) = "N"
puntos += 5
Elseif b(i) = " " And h(i) = "T" Then
b(i) = "A"
End If
Next i
DibujarCuadricula(puntos, suposicion)
End Sub
 
Sub MenuPrincipal
Dim As Integer puntos = 0
Dim As Integer suposicion = 0
Dim As String num = "0"
Color 7, 0
Do
Dim As Integer externo = 0
DibujarCuadricula(puntos, suposicion)
Dim As Integer ix = SgteCelda()
If Not inMiddle(ix) And b(ix) <> " " Then Continue Do ' already processed
Dim As Integer inc, def
If atTop(ix) Then
inc = 10
def = 1
Elseif atBottom(ix) Then
inc = -10
def = 1
Elseif atLeft(ix) Then
inc = 1
def = 10
Elseif atRight(ix) Then
inc = -1
def = 10
Else
If b(ix) <> "G" Then
b(ix) = "G"
suposicion += 1
If suposicion = 4 Then Exit Do
Else
b(ix) = " "
suposicion -= 1
End If
Continue Do
End If
Dim As Integer x = ix + inc
Dim As Integer first = -1
While inMiddle(x)
If h(x) = "T" Then ' hit
b(ix) = "H"
puntos += 1
first = 0
externo = -1
Exit While
End If
If first And (inMiddle(x+def) And h(x+def) = "T") Or (inMiddle(x-def) And h(x-def) = "T") Then ' reflection
b(ix) = "R"
puntos += 1
first = 0
externo = -1
Exit While
End If
first = 0
Dim As Integer y = x + inc - def
If inMiddle(y) And h(y) = "T" Then ' deflection
If Abs(inc) = 1 Then
inc = 10
def = 1
Elseif Abs(inc) = 10 Then
inc = 1
def = 10
End If
End If
y = x + inc + def
If inMiddle(y) And h(y) = "T" Then ' deflection or double deflection
If Abs(inc) = 1 Then
inc = -10
def = 1
Elseif Abs(inc) = 10 Then
inc = -1
def = 10
End If
End If
x += inc
Wend
If externo Then Continue Do
num = Iif(num <> "9", Chr(Asc(num) + 1), "a")
If b(ix) = " " Then puntos += 1
b(ix) = num
If inRange(x) Then
If ix = x Then
b(ix) = "R"
Else
If b(x) = " " Then puntos += 1
b(x) = num
End If
End If
Loop
DibujarCuadricula(puntos, suposicion)
Puntuacion(puntos, suposicion)
End Sub
 
'--- Programa Principal ---
Dim As String yn
Intro
Sleep
Do
Cls
MenuPrincipal
Color 15
Input " Play again y/n : ", yn
Loop Until Lcase(yn) = "n"
End
'--------------------------
</syntaxhighlight>
{{out}}
<pre>Similar as Wren entry.</pre>
 
=={{header|Go}}==
Line 21 ⟶ 498:
 
Set wikiGame to false to play a normal 'random' game.
<langsyntaxhighlight lang="go">package main
 
import (
Line 303 ⟶ 780:
check(scanner.Err())
}
}</langsyntaxhighlight>
 
{{out}}
Line 470 ⟶ 947:
Play again y/n : n
</pre>
=={{header|J}}==
Requires a recent (release 9) jqt:<syntaxhighlight lang="j">require'ide/qt/gl2'
coinsert'jgl2'
 
NB. event handlers
game_board_mbldown=: {{
xy=.<.40%~2{._ ".sysdata
if. xy e. EDGES do.
probe xy
elseif. xy e. BLACK do.
guess xy
end.
draw''
}}
 
game_finish_button=: {{ draw FINISHED=: 1 [BEAM=: EMPTY }}
 
NB. support code
crds=: 2 {."1 ]
dirs=:_2 {."1 ]
 
probe=: {{
BEAM=: ,:y
dir=. DIRS{~EDGES i.y
while. -. ({:BEAM) e. ATOMS do.
bar=. (#~ 1-0 e.,@dirs)MIRRORS#~(crds MIRRORS) e. _1{.BEAM
if. 1=#bar do. dir=.{.(/: |@j./"1) dir(+,:-),dirs bar
elseif. 2=#bar do. dir=. -dir
end.
BEAM=: BEAM,dir+{:BEAM
if. -.({:BEAM) e. BLACK do. break. end.
end.
if. 1 e. BEAM e. BLACK do.
select. #e=.BEAM([-.-.)EDGES
case. 1 do. BEAM remember 'H'
case. 2 do. BEAM remember (#~.e){::'?';'R';0
end.
else.
(BEAM=:1{.BEAM) remember 'R'
end.
}}
remember=: {{
ndx=. EDGES i.x([-.-.)EDGES
if. 0=y do. y=. ":{.(0-.~~.0,,0".&>ndx{LABELS),1+>./0,,0".&>LABELS end.
LABELS=: (<y) ndx} LABELS
}}
 
guess=: {{ if.-.FINISHED do. GUESSES=: GUESSES ,`-.@.(e.~) y end. }}
 
NB. rendering
bbox=: {{
4 bbox y
:
wd{{)n
pc game closeok;
cc message static center;
cc board isidraw;
set board wh SZ SZ;
cc finish button;
pshow;
}} rplc 'SZ';":40*2+SIZE=:y
BLACK=: ,/1+DIM#:i.DIM=:,~SIZE
EDGES=: (,/(2+DIM)#:i.2+DIM)-.BLACK,>,{;~0 1*DIM+1
DIRS=: (1+SIZE) ((*@| |."1) * _1^=) EDGES
LABELS=: (#EDGES)#a:
ATOMS=: ({~ x?#) BLACK
MIRRORS=: /:~,/ATOMS(+,])"1/0 0-.~>,{;~i:1
GUESSES=: EMPTY
BEAM=: EMPTY
FINISHED=: 0
draw''
}}
 
boxes=: {{ 40*4{.!.1"1 y }}
drawatoms=: {{ glellipse 5 5 _10 _10+"1]boxes y[glpen glbrush glrgb x }}
 
draw=: {{
glclear''
glfont '"Lucidia Console" 15' [gltextcolor glrgb 0 255 255 NB. yellow
glpen 2 1[glrgb 3#255 NB. white
glrect boxes EDGES [glbrush glrgb 184 0 0 NB. dark red
glrect boxes BLACK [glbrush glrgb 0 0 0
wd 'set message text ',N,&":' point','s'#~1~:N=.(FINISHED*5*#GUESSES-.ATOMS)++/LABELS~:a:
if. FINISHED do.
255 0 0 drawatoms GUESSES -. ATOMS
0 255 0 drawatoms ATOMS([-.-.)GUESSES
0 0 255 drawatoms ATOMS-.GUESSES
if.#BEAM do.
gllines 20+,40*BEAM [glpen 2 1 [glbrush glrgb 255 255 0
glellipse 15 15 10 10+4{.40*{.BEAM
end.
else.
128 128 128 drawatoms GUESSES
end.
(10+40*EDGES) {{ gltext;y [ gltextxy x }}"_1 LABELS
wd 'set finish enable ',":FINISHED<GUESSES=&#ATOMS
glpaint''
}}</syntaxhighlight>
 
Example use: <syntaxhighlight lang="j"> bbox 8</syntaxhighlight>.
 
Or, for 10 atoms in a 15x15 grid: <syntaxhighlight lang="j"> 10 bbox 15</syntaxhighlight>.
 
This version allows the user to place and observe individual beams after finishing a game.
=={{header|JavaScript}}==
Play it [http://paulo-jorente.de/tests/blackbox/ here].
<langsyntaxhighlight lang="javascript">
var sel, again, check, score, done, atoms, guesses, beamCnt, brdSize;
 
Line 676 ⟶ 1,256:
startGame();
}
</syntaxhighlight>
</lang>
 
 
=={{header|Julia}}==
Gtk library GUI version.
<langsyntaxhighlight lang="julia">using Colors, Cairo, Graphics, Gtk
 
struct BoxPosition
Line 919 ⟶ 1,497:
 
blackboxapp()
</syntaxhighlight>
</lang>
 
=={{header|Nim}}==
{{trans|Go}}
<langsyntaxhighlight Nimlang="nim">import random, sequtils, strutils
 
const WikiGame = true
Line 1,146 ⟶ 1,723:
of "y": break
 
main()</langsyntaxhighlight>
 
{{out}}
Line 1,389 ⟶ 1,966:
 
Play again (y/n): n</pre>
 
=={{header|Phix}}==
{{libheader|Phix/pGUI}}
A configurable GUI version of the Black Box game, with a Knuth solver/helper.
<langsyntaxhighlight Phixlang="phix">-- demo\rosetta\Black_Box.exw
constant title = "Black Box",
help_text = """
Line 2,161 ⟶ 2,737:
end procedure
main()</langsyntaxhighlight>
 
=={{header|Wren}}==
{{trans|Go}}
Line 2,168 ⟶ 2,743:
{{libheader|Wren-ioutil}}
{{libheader|Wren-str}}
<langsyntaxhighlight ecmascriptlang="wren">import "random" for Random
import "./fmt" for Fmt
import "./ioutil" for Input
import "./str" for Str
 
var b = List.filled(100, null) // displayed board
Line 2,413 ⟶ 2,988:
var yn = Str.lower(Input.option(" Play again y/n : ", "ynYN"))
if (yn == "n") return
}</langsyntaxhighlight>
 
{{out}}
Line 2,660 ⟶ 3,235:
=={{header|zkl}}==
{{trans|Go}}
<langsyntaxhighlight lang="zkl">const ATM="A", F="F", HIT="H", G="G", GN="N", R="R", BLNK=" ", GY="Y";
 
var
Line 2,833 ⟶ 3,408:
else if(yn=="y") break(1);
}
}</langsyntaxhighlight>
Showing [results of] most of the Wikipedia actions:
{{out}}
2,130

edits