Rosetta Code

Black box: Difference between revisions

Page Discussion

Black box (view source)

Revision as of 01:44, 23 April 2024

15,513 bytes added ,  24 days ago
Added FreeBASIC
(Added FreeBASIC)
 
(6 intermediate revisions by 3 users not shown)
Line 12:
-More or less atoms (maybe random)<br />
-Different grid sizes
 
=={{header|AutoHotkey}}==
<langsyntaxhighlight AutoHotkeylang="autohotkey">SetBatchLines -1
;--------------------------------------------------------------------------------------
BoardSize := 8
Line 263 ⟶ 262:
Gui, show,, % TroubleShooting ? "Black Box - TroubleShooting Mode" : "Black Box"
return
;--------------------------------------------------------------------------------------</langsyntaxhighlight>
 
=={{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 273 ⟶ 498:
 
Set wikiGame to false to play a normal 'random' game.
<langsyntaxhighlight lang="go">package main
 
import (
Line 555 ⟶ 780:
check(scanner.Err())
}
}</langsyntaxhighlight>
 
{{out}}
Line 722 ⟶ 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 928 ⟶ 1,256:
startGame();
}
</syntaxhighlight>
</lang>
 
 
=={{header|Julia}}==
Gtk library GUI version.
<langsyntaxhighlight lang="julia">using Colors, Cairo, Graphics, Gtk
 
struct BoxPosition
Line 1,171 ⟶ 1,497:
 
blackboxapp()
</syntaxhighlight>
</lang>
 
=={{header|Nim}}==
{{trans|Go}}
<langsyntaxhighlight Nimlang="nim">import random, sequtils, strutils
 
const WikiGame = true
Line 1,398 ⟶ 1,723:
of "y": break
 
main()</langsyntaxhighlight>
 
{{out}}
Line 1,641 ⟶ 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,413 ⟶ 2,737:
end procedure
main()</langsyntaxhighlight>
 
=={{header|Wren}}==
{{trans|Go}}
Line 2,420 ⟶ 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,665 ⟶ 2,988:
var yn = Str.lower(Input.option(" Play again y/n : ", "ynYN"))
if (yn == "n") return
}</langsyntaxhighlight>
 
{{out}}
Line 2,912 ⟶ 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 3,085 ⟶ 3,408:
else if(yn=="y") break(1);
}
}</langsyntaxhighlight>
Showing [results of] most of the Wikipedia actions:
{{out}}
Jjuanhdez
2,122

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/276390...363906"