Rosetta Code

Black box: Difference between revisions

Page Discussion

Black box (view source)

Revision as of 01:44, 23 April 2024

13,010 bytes added ,  1 month ago
Added FreeBASIC
(J draft)
(Added FreeBASIC)
 
(5 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:<langsyntaxhighlight Jlang="j">require'ide/qt/gl2'
coinsert'jgl2'
 
Line 820 ⟶ 1,044:
wd 'set finish enable ',":FINISHED<GUESSES=&#ATOMS
glpaint''
}}</langsyntaxhighlight>
 
Example use: <syntaxhighlight lang="j"> bbox 8</syntaxhighlight>.
 
Or, for 10 atoms in a 15x15 grid: <syntaxhighlight lang="j"> 10 bbox 15</syntaxhighlight>.
Example use: <lang J> bbox 8</lang>
 
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 1,029 ⟶ 1,256:
startGame();
}
</syntaxhighlight>
</lang>
 
=={{header|Julia}}==
Gtk library GUI version.
<langsyntaxhighlight lang="julia">using Colors, Cairo, Graphics, Gtk
 
struct BoxPosition
Line 1,271 ⟶ 1,497:
 
blackboxapp()
</syntaxhighlight>
</lang>
 
=={{header|Nim}}==
{{trans|Go}}
<langsyntaxhighlight Nimlang="nim">import random, sequtils, strutils
 
const WikiGame = true
Line 1,498 ⟶ 1,723:
of "y": break
 
main()</langsyntaxhighlight>
 
{{out}}
Line 1,741 ⟶ 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,513 ⟶ 2,737:
end procedure
main()</langsyntaxhighlight>
 
=={{header|Wren}}==
{{trans|Go}}
Line 2,520 ⟶ 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,765 ⟶ 2,988:
var yn = Str.lower(Input.option(" Play again y/n : ", "ynYN"))
if (yn == "n") return
}</langsyntaxhighlight>
 
{{out}}
Line 3,012 ⟶ 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,185 ⟶ 3,408:
else if(yn=="y") break(1);
}
}</langsyntaxhighlight>
Showing [results of] most of the Wikipedia actions:
{{out}}
Jjuanhdez
2,123

edits

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