;KV Map Genrator


Graphics 640, 480, 16, 2
SetBuffer BackBuffer()
SeedRnd MilliSecs()

Type TRect
   Field x
   Field y
   Field w
   Field h
End Type

Const LOGICAL_OR$ = " | "
Const LOGICAL_AND$ = " & "
Const LOGICAL_NOT$ = "-"
Const DISJUNCTIVE_CONJUNCTION = 1
Const CONJUNCTIVE_CONJUNCTION = 0

Dim l(15) ;truth table
Dim kv(3, 4) ;kv map data

;get truth table
Locate 300, 0
Print "a b c d e"
For i = 0 To 15
   Locate 300, i * 12 + 12
   a = (i And %1000) / %1000
   b = (i And %100) / %100
   c = (i And %10) / %10
   d = (i And %1) / %1
   l(i) = Input(a + " " + b + " " + c + " " + d + " ")
Next

Local conjunction = Int(Input("DNF? 1/0 "))


MakeKV()
FindRects(conjunction)
Color 255, 255, 255

DrawKV()

Local r.TRect
Local count

;draw rects + coords
For r.TRect = Each TRect
   Color Rand(15, 25)*10, Rand(15, 25)*10, Rand(15, 25)*10
   Locate 50, count*12
   Print "BLOCK (" + r\x + ";" + r\y + " - " + r\w + ";" + r\h + ")"
   Rect r\x * 12, r\y * 12, r\w * 12, r\h * 12, 0
   count = count + 1
Next

Color 255, 255, 255
Locate 0, 14 * 16
Print MakeSolution(conjunction)

Flip

AppTitle "done."
WaitKey

End


Function MakeSolution$(conjunction)
      
   Local r.TRect
   Local i, x, y
   Local a, b, c, d
   Local solution$
   Local count
   Local con = conjunction
   
   For r.TRect = Each TRect
      
      solution$ = solution$ + "("
      count = count + 1
      
      a = 2
      b = 2
      c = 2
      d = 2
      
      
      If r\x >= 2 Then a = 1 : Else a = 0
      If r\x = 1 Or r\x = 2 Then b = 1 : Else : b = 0
      If r\y >= 2 Then c = 1 : Else : c = 0
      If r\y = 1 Or r\y = 2 Then d = 1 : Else : d = 0
      
      For y = r\y To r\y + r\h - 1
         For x = r\x To r\x + r\w - 1
            If x <= 1 And a = 1 Then a = 2
            If x >= 2 And a = 0 Then a = 2
            If (x = 0 Or x = 3) And b = 1 Then b = 2
            If (x = 1 Or x = 2) And b = 0 Then b = 2
            If y <= 1 And c = 1 Then c = 2
            If y >= 2 And c = 0 Then c = 2
            If (y = 0 Or y = 3) And d = 1 Then d = 2
            If (y = 1 Or y = 2) And d = 0 Then d = 2
         Next
      Next
      
         
      If conjunction = DISJUNCTIVE_CONJUNCTION
         If a = 1 Then solution$ = solution$ + "A" + LOGICAL_AND$
         If a = 0 Then solution$ = solution$ + LOGICAL_NOT$ + "A" + LOGICAL_AND$
      
         If b = 1 Then solution$ = solution$ + "B" + LOGICAL_AND$
         If b = 0 Then solution$ = solution$ + LOGICAL_NOT$ + "B" + LOGICAL_AND$
         
         If c = 1 Then solution$ = solution$ + "C" + LOGICAL_AND$
         If c = 0 Then solution$ = solution$ + LOGICAL_NOT$ + "C" + LOGICAL_AND$
      
         If d = 1 Then solution$ = solution$ + "D" + LOGICAL_AND$
         If d = 0 Then solution$ = solution$ + LOGICAL_NOT$ + "D" + LOGICAL_AND$
         
         solution$ = Mid(solution$, 1, Len(solution$)-Len(LOGICAL_AND$)) + ")" + LOGICAL_OR$
      Else
         If a = 1 Then solution$ = solution$ + "A" + LOGICAL_OR$
         If a = 0 Then solution$ = solution$ + LOGICAL_NOT$ + "A" + LOGICAL_OR$
      
         If b = 1 Then solution$ = solution$ + "B" + LOGICAL_OR$
         If b = 0 Then solution$ = solution$ + LOGICAL_NOT$ + "B" + LOGICAL_OR$
      
         If c = 1 Then solution$ = solution$ + "C" + LOGICAL_OR$
         If c = 0 Then solution$ = solution$ + LOGICAL_NOT$ + "C" + LOGICAL_OR$
      
         If d = 1 Then solution$ = solution$ + "D" + LOGICAL_OR$
         If d = 0 Then solution$ = solution$ + LOGICAL_NOT$ + "D" + LOGICAL_OR$
         
         solution$ = Mid(solution$, 1, Len(solution$)-Len(LOGICAL_OR$)) + ")" + LOGICAL_AND$
      EndIf
   Next
   
   Return Mid(solution$, 1, Len(solution$) - 3)
   
End Function


Function MakeKV()
   
   Local count = %0000
   Local tx, ty
   Local a, b, c, d
   
   For count = %0000 To %1111
      
      ;get boolean values for a, b, c and d
      a = (count And %1000) / %1000
      b = (count And %100) / %100
      c = (count And %10) / %10
      d = (count And %1) / %1
         
      If l(count)
         
         ;find target col
         Select a*2 + b
            Case 0
               tx = 0
            Case 1
               tx = 1
            Case 2
               tx = 3
            Case 3
               tx = 2
         End Select
         
         ;find target row
         Select c*2 + d
            Case 0
               ty = 3
            Case 1
               ty = 1
            Case 2
               ty = 0
            Case 3
               ty = 2
         End Select
         
         ;order to the right place in kv-array
         kv(tx, ty) = 1
         
      EndIf
   Next
      
End Function


Function DrawKV()
   
   Local x, y
   
   ;graphical output
   For y = 0 To 3
      For x = 0 To 3
         Text x * 12, y * 12, kv(x, y)
      Next
   Next
   
End Function


Function FindRects(conjunction)
   
   Local x, y
   Local w, w2, h, abort
   Local r.TRect, r2.TRect
   Local biggest.TRect
   Local con = conjunction
   
   For y = 0 To 3
      For x = 0 To 3
         If kv(x, y) = con
            
            h = 0
            w = 0
            w2 = 0
            
            ;find max width
            While kv(x+w, y) = con And x+w < 4
               w = w + 1
            Wend
            
            ;find max height + scan if the whole row is true
            While kv(x, y+h) = con And y+h < 4
               h = h + 1
               
               ;scan row
               While kv(x+w2, y+h) = con And x+w2 < 4
                  w2 = w2 + 1
               Wend
               
               ;row does not equal initial row
               If w2 < w Then Exit
            Wend
            
            r.TRect = New TRect
            r\x = x
            r\y = y
            r\w = w
            r\h = h
            
            ;trim block
            If r\w > 4 And r\w < 8 Then r\w = 4
            If r\w > 2 And r\w < 4 Then r\w = 2
            If r\h > 4 And r\h < 8 Then r\h = 4
            If r\h > 2 And r\h < 4 Then r\h = 2
            
         EndIf
      Next
   Next
   
   ;remove wrapped rects
   For r.TRect = Each TRect
      For r2.TRect = Each TRect
         If r <> r2
            If IsInsideBlock(r, r2) Then Delete r2
         EndIf
      Next
   Next
   
End Function


Function IsInsideBlock(block1.TRect, block2.TRect)
   
   Return (block2\x >= block1\x And block2\x < block1\x + block1\w And block2\w <= block1\w) And (block2\y >= block1\y And block2\y < block1\y + block1\h And block2\h <= block1\h)
   
End Function