Post by bplus on Sept 17, 2023 15:02:18 GMT -5
My first port from QB64 to FB with allot of Help:
' b+ 2023-01-12
' FB version: Imortis Inglorian, 2023-09-15
' b+ messing with this code some more
' const sw, sh
' one window
#cmdline "-s gui"
windowtitle "Nonogram Trainer - esc to quit"
Randomize Timer
const sw = 400, sh = 400
Dim Shared As uLong White, Black, Blue
White = RGB(255,255,255): Black = RGB(000,000,000): Blue = RGB(000,000,255)
ReDim Shared as ulong Game(1 To 1, 1 To 1), Board(1 To 1, 1 To 1)
Dim Shared as ulong Sq, mx, my, mb, x, y
Redim shared as string RowRuns(1 To 1), ColRuns(1 To 1)
Screenres(sw, sh, 32)
width sw\8, sh\16
Declare Sub makegame
Declare Function Runs (rowTF as ulong, number as ulong, arr() as ulong) as string
Declare Function Solved as ulong
makeGame
Do
getmouse(mx, my, , mb)
If mb Then
sleep 200
If mx > 20 And mx <= Sq * 20 + 40 Then
If my > 20 And my <= Sq * 20 + 40 Then
x = Int(mx / 20): y = Int(my / 20)
If Board(x, y) Then Board(x, y) = 0 Else Board(x, y) = 1
If Board(x, y) Then Color White Else Color Black
Line (x * 20, y * 20)-Step(20, 20), , BF
Line (x * 20, y * 20)-Step(20, 20), Blue, B
End If
End If
End If
If Solved Then
draw string (0,0),"Solved! spacebar for another..."
'_MessageBox "Solved", "Hurray you've solved the puzzle!": makeGame
sleep
makegame
end if
sleep 1
Loop Until inkey = chr(27)
Function Runs (rowTF as ulong, number as ulong, arr() as ulong) as string
dim as ulong flag
dim as string b
For i as integer = 1 To Sq
If (arr(i, number) And rowTF) Or (arr(number, i) And rowTF = 0) Then
If flag Then flag = flag + 1 Else flag = 1
Else
If flag Then
If Len(b) Then b = b + " " + Trim(Str(flag)) Else b = Trim(Str(flag))
flag = 0
End If
End If
Next
If flag Then
If Len(b) Then b = b + " " + Trim(Str(flag)) Else b = Trim(Str(flag))
End If
return b
End Function
Sub makeGame
dim test as ulong
Cls
do ' here we need to give user an escape
? ">9 quits"
Input "How many cells per square side (1 to 9) "; test
if test > 9 then end
loop while test < 1 Or test > 9
Cls: Sq = test
ReDim Game(1 To Sq, 1 To Sq), Board(1 To Sq, 1 To Sq)
ReDim RowRuns(1 To Sq), ColRuns(1 To Sq)
Line (18, 18)-(Sq * 20 + 22, Sq * 20 + 22), white, B
For y as integer = 1 To Sq
For x as integer = 1 To Sq
If Rnd < .5 Then Game(x, y) = 0 Else Game(x, y) = 1
Line (x * 20, y * 20)-Step(20, 20), blue, B
Next
Next
Color RGB(255,255,255)
For i as integer = 1 To Sq
RowRuns(i) = Runs(1, i, Game())
draw string(Sq * 20 + 30, i * 20 + 4), RowRuns(i)
ColRuns(i) = Runs(0, i, Game())
Next
For i as integer = 1 To Sq
var row = Sq
For j as integer = 1 To Len(ColRuns(i)) Step 2
row = row + 1
draw string(i * 20 + 6, row * 20 + 10), Mid(ColRuns(i), j, 1)
Next
Next
End Sub
Function Solved as ulong
For i as integer = 1 To Sq
If RowRuns(i) <> Runs(1, i, Board()) Then return 0 'not done
If ColRuns(i) <> Runs(0, i, Board()) Then return 0
Next
return -1
End Function
