'===========================================================================
' Subject: COLORBOX (LIKE TETRIS/COLUMNS)     Date: 10-30-97 (08:15)       
'  Author: Alexander Podkolzin                Code: PB                     
'  Origin: app@nw.sbank.e-burg.su           Packet: GAMES.ABC
'===========================================================================
'---------------------------------------------------------------------------
' <<<<<<<<<<<<<<<<<<<<<<      COLORBOX.BAS      >>>>>>>>>>>>>>>>>>>>>>>>>>>
'---------------------------------------------------------------------------
'
' Hi!  I do not know who is the first author of this game and idea but in
' Russia it is known as "TETCOLOR" of Sergey Sotnikov and is very popular!
' Of course my program only repeats the original game and is not finished
' yet (it's my first step in graphic:). Hope you'll enjoy the game.
' I'll be very glad if you'll enhance it and share with me your ideas.
' Happy game!
'
' Aim:
' Collect colors in rows, colomns or diagonals. If number of such
' color boxes > 2 they will disappear...
'
'---------------------------------------------------------------------------

 $Compile Memory
 $Dim Array

 Defint a - z

 %BackGroundColor = 7
 %BoxWidth = 26                   ' 26 is maximum!
 %Ny = 18
 %Nx = 7
 %Xshift = (640 - %BoxWidth * %Nx) / 2 - %BoxWidth / 2
 %Yshift = 6
 %MaxColor = 6
 %FALSE = 0
 %TRUE = Not %FALSE

 Type Results
   Pname As String * 12
   Score As Long
 End Type

 Dim Pot(%Ny, %Nx + 1) As Shared Integer
 Dim DPot(%Ny + %Nx - 1, %Nx) As Shared Integer
 Dim VPot(%Nx, %Ny) As Shared Integer

 Dim Fig(3, 3) As Shared Integer
 Dim Fig1(3, 3) As Shared Integer
 Dim Fig2(3, 3) As Shared Integer
 Dim Fig3(3, 3) As Shared Integer
 Dim Fig4(3, 3) As Shared Integer
 Dim FigNumber As Shared Integer

 Dim Level As Shared Integer
 Dim Bonus As Shared Integer
 Dim Score As Shared Long
 Dim MinScore As Shared Long
 Dim CurX As Shared Integer       ' X - coordinate of piece Fig(1,1)
 Dim CurY As Shared Integer       ' Y - coordinate of piece Fig(1,1)
 Dim Pause As Shared Single
 Dim NeedSound As Shared Integer
 Dim Rec As Shared Results
 Dim Txt(21) As Shared String
 Dim ResultsFile As Shared String
 ResultsFile = "Topnames.Res"
 Level = 0

 NeedSound = 0
 Pause = 1. - Level * .1 + .2

 $IF 0
'---------------------------------------------------------------------------
 Agreements:

 I. Sharps - > 000   000   010   000
        of - > 010   010   010   011
    pieces - > 000   010   010   010
                ^     ^     ^     ^
              Fig1  Fig2  Fig3  Fig4

 II. CurX, CurY - current coordinates of "piece" center(Fig(2, 2))

 III. Fig(2, 2) always equl To one, All corner elements To zero.
'---------------------------------------------------------------------------
 $ENDIF

 Fig1(2, 2) = 1
 Fig2(1, 2) = 1: Fig2(2, 2) = 1
 Fig3(1, 2) = 1: Fig3(2, 2) = 1: Fig3(3, 2) = 1
 Fig4(1, 2) = 1: Fig4(2, 2) = 1: Fig4(2, 3) = 1

 FrontScreen
 NewGame

 Do

   CurX = 4                       ' Center of upper lay
   CurY = 1
   SetRandomFig Fig()
   SetRandomColors Fig()
   Do

     If Not FreeSpaceAt(CurY, CurX) And CurY > 0 Then

       ShowFig
       Locate 2, 10: Print "Game over!"
       If Score > MinScore Then
         Txt(21) = Right$(Space$(18) + Str$(Score),18)
         Array Sort Txt(1), From 13 To 18 , Descend
         ShowResults
         For i = 1 To 20
           If Val(Right$(Txt(i),6)) = Score Then Exit For
         Next
         If i < 21 Then
           Color 14
           s$ = Left$( InputGraph(57+k, i + 3, 12) + Space$(12), 12)
           Txt(i) = s$ + Right$("     " + Str$(Score),6)
           OutputResults
         End If
       End If
       While Not Instat: Wend
       s$ = Inkey$
       If Asc(s$) = 27 Then       ' Esc
         Screen 0, 0
         End
       End If
       NewGame
       Exit Loop
     End If

     s$ = Right$(Inkey$, 1)
     Locate 29, 10: Print Time$
     If s$ <> "" Then

       If Asc(s$) = 27 Then Exit, Exit

       If s$ = "O" Then NewGame   ' End key - new game

       If s$ = "K" Then           ' Left key
         If Not FreeSpaceAt(CurY, CurX - 1) Then
           Iterate Loop
         End If
         HideFig
         Decr CurX
         If CurX < 2 Then
           If Fig(2, 1) = 0 Then
             CurX = 1
           Else
             CurX = 2
           End If
         End If
         ShowFig
         t# = Timer
         Iterate Loop
       End If

       If s$ = "M" Then           ' Right key
         If Not FreeSpaceAt(CurY, CurX + 1) Then
           Iterate Loop
         End If
         HideFig
         Incr CurX
         If CurX > %Nx - 1 Then
           If Fig(2, 3) = 0 Then
             CurX = %Nx
           Else
             CurX = %Nx - 1
           End If
         End If
         ShowFig
         t# = Timer
         Iterate Loop
       End If

       If s$ = "H" Then           ' Rotate key (Up key)
         If Not RotationPossible(CurY, CurX) Then
           Iterate Loop
         End If
         HideFig
         RotateFig
         ShowFig
         t# = Timer
         Iterate Loop
       End If

       If s$ = "P" Then           ' Down key
         t# = Timer
         HideFig
         Incr CurY
         If Not FreeSpaceAt(CurY, CurX) Or CurY > %Ny - 1 Then
           Decr CurY
           ShowFig
           Iterate Loop
         End If
         ShowFig
       End If

       If s$ = " " Then           ' Drop key  (Blank key)
         If NeedSound Then Sound 3000, .1
         Exit Loop
       End If

       If Instr("Ss", s$) Then
         NeedSound = NeedSound Xor 1
       End If

       If s$ = "+" Then
         Incr Level
         If Level > 9 Then Level = 9
         Pause = 1. - Level * .1 + .2
       End If

       If s$ = "-" Then
         Decr Level
         If Level < 0 Then Level = 0
         Pause = 1. - Level * .1 + .2
       End If

     End If


     If Timer - t# > Pause Then
       t# = Timer
       If Not FreeSpaceAt(CurY + 1, CurX) Then Exit Loop
       HideFig
       Incr CurY
       If Not FreeSpaceAt(CurY, CurX) Or CurY > %Ny - 1 Then
         Decr CurY
         Exit Loop
       End If
       ShowFig

       s$ = Right$(Time$, 2)
'       If Instr("00",s$) Then     ' 1 minit for a level
       If Instr("00 30", s$) Then ' 30 sec for a level
         Incr Level
         If Level > 9 Then Level = 9
         Pause = 1. - Level * .1 + .2
       End If

       Color 15, 0
       Locate 27, 61: Print "LEVEL = "; Level; " "

     End If

   Loop

   FixIt

 Loop

 Screen 0, 0

 End

'---------------------------------------------------------------------------
 Sub FixIt

   HideFig
   Y = FindEndY()

   If Fig(1, 2) <> 0 Then
     Pot(Y - 1, CurX) = Fig(1, 2)
   End If

   If CurX > 1 Then
     If Fig(2, 1) <> 0 Then
       Pot(Y, CurX - 1) = Fig(2, 1)
     End If
   End If

   Pot(Y, CurX) = Fig(2, 2)

   If CurX < %Nx Then
     If Fig(2, 3) <> 0 Then
       Pot(Y, CurX + 1) = Fig(2, 3)
     End If
   End If

   If Fig(3, 2) <> 0 Then
     Pot(Y + 1, CurX) = Fig(3, 2)
   End If

   CurY = Y
   ShowFig
   Do

     ShiftIt

     a = CheckRows(Pot())         ' Checking rows

     For i = 1 To %Ny             ' Inverting matrix
       For k = 1 To %Nx           '
         VPot(k, i) = Pot(i, k)   '
       Next                       '
     Next                         '

     b = CheckRows(VPot())        ' Checking colomns

     For i = 1 To %Ny             ' Restore initial matrix
       For k = 1 To %Nx           '
         Pot(i, k) = VPot(k, i)   '
       Next                       '
     Next                         '

     For i = 1 To %Ny             ' Invert diagonals to rows
       For k = 1 To %Nx           ' (From left to right UP)
         n = i + k - 1            '
         DPot(n, k) = Pot(i, k)   '
       Next                       '
     Next                         '

     c = CheckRows(DPot())        ' Checking diagonals UP

     For i = 1 To %Ny             ' Restore initial matrix
       For k = 1 To %Nx           '
         n = i + k - 1            '
         Pot(i, k) = DPot(n, k)   '
       Next                       '
     Next                         '

     Redim DPot(%Ny + %Nx - 1, %Nx)

     For i = 1 To %Ny             ' Invert diagonals to rows
       For k = 1 To %Nx           ' (From left to right DOWN)
         n = i + k - 1            '
         m = %Nx - k + 1          '
         DPot(n, m) = Pot(i, m)   '
       Next                       '
     Next                         '

     d = CheckRows(DPot())        ' Checking diagonals DOWN

     For i = 1 To %Ny             ' Restore initial matrix
       For k = 1 To %Nx           '
         n = i + k - 1            '
         m = %Nx - k + 1          '
         Pot(i, m) = DPot(n, m)   '
       Next                       '
     Next                         '

     ShiftIt

     Sum = a + b + c + d

     If Sum = 0 Then Exit Loop

     If Sum > 07 Then
       Bonus = 2500
     Elseif Sum > 06 Then
       Bonus = 2000
     Elseif Sum > 05 Then
       Bonus = 1500
     Elseif Sum > 04 Then
       Bonus = 1000
     Elseif Sum > 03 Then
       Bonus = 500
     End If

     If Bonus <> 0 Then
       Color 15, 0
       Locate 20, 10: Print "BONUS = "; Bonus; " "
       Incr Score, Bonus
       Locate 18, 10: Print "SCORE = "; Score; " "
       If NeedSound Then Sound 440, .4: Sound 220, .4
       Bonus = 0
       Delay .3
     End If

   Loop

 End Sub
'---------------------------------------------------------------------------
 Function FindEndY()

   For i = CurY + 1 To %Ny
     If Not FreeSpaceAt(i, CurX) Then
       Function = i - 1
       Exit Function
     End If
   Next
   Function = %Ny

 End Function
'---------------------------------------------------------------------------
 Function FigType()

   Select Case FigNumber
   Case 1
     t = 0
   Case 2
     If Fig(3, 2) <> 0 Then
       t = 1
     Elseif Fig(2, 1) <> 0 Then
       t = 2
     Elseif Fig(1, 2) <> 0 Then
       t = 3
     Elseif Fig(2, 3) <> 0 Then
       t = 4
     End If
   Case 3
     If Fig(2, 1) = 0 Then
       t = 1
     Else
       t = 2
     End If
   Case 4
     If Fig(3, 2) <> 0 And Fig(2, 3) <> 0 Then
       t = 1
     Elseif Fig(2, 1) <> 0 And Fig(3, 2) <> 0 Then
       t = 2
     Elseif Fig(1, 2) <> 0 And Fig(2, 1) <> 0 Then
       t = 3
     Elseif Fig(2, 3) <> 0 And Fig(1, 2) <> 0 Then
       t = 4
     End If
   End Select
   Function = 10 * FigNumber + t

 End Function
'---------------------------------------------------------------------------
 Function RotationPossible(y, x)

   Function = %TRUE

   Select Case FigType()
   Case 10
     Exit Function
   Case 21
     If CurX = 1 Then Exit Select
     If Pot(y, x - 1) = 0 And Pot(y + 1, x - 1) = 0 Then
       Exit Function
     End If
   Case 22
     If Pot(y - 1, x - 1) = 0 And Pot(y - 1, x) = 0 Then
       Exit Function
     End If
   Case 23
     If CurX = %Nx Then Exit Select
     If Pot(y - 1, x + 1) = 0 And Pot(y, x + 1) = 0 Then
       Exit Function
     End If
   Case 24
     If Pot(y + 1, x) = 0 And Pot(y + 1, x + 1) = 0 Then
       Exit Function
     End If
   Case 31
     If CurX = 1 Or CurX = %Nx Then Exit Select
     If Pot(y - 1, x + 1) = 0 And Pot(y, x - 1) = 0 And _
       Pot(y, x + 1) = 0 And Pot(y + 1, x - 1) = 0 Then
       Exit Function
     End If
   Case 32
     If Pot(y - 1, x - 1) = 0 And Pot(y - 1, x) = 0 And _
       Pot(y + 1, x) = 0 And Pot(y + 1, x + 1) = 0 Then
       Exit Function
     End If
   Case 41
     If CurX = 1 Then Exit Select
     If Pot(y, x - 1) = 0 And Pot(y + 1, x - 1) = 0 And _
       Pot(y + 1, x + 1) = 0 Then
       Exit Function
     End If
   Case 42
     If Pot(y - 1, x - 1) = 0 And Pot(y - 1, x) = 0 And _
       Pot(y + 1, x - 1) = 0 Then
       Exit Function
     End If
   Case 43
     If CurX = %Nx Then Exit Select
     If Pot(y - 1, x - 1) = 0 And Pot(y - 1, x + 1) = 0 And _
       Pot(y, x + 1) = 0 Then
       Exit Function
     End If
   Case 44
     If Pot(y - 1, x + 1) = 0 And Pot(y + 1, x) = 0 And _
       Pot(y + 1, x + 1) = 0 Then
       Exit Function
     End If
   End Select

   Function = %FALSE

 End Function
'---------------------------------------------------------------------------
 Function FreeSpaceAt(y, x)

   Function = %TRUE

   If Pot(y, x) <> 0 Then
     Function = %FALSE
     Exit Function
   End If

   Select Case FigType()
   Case 10
     Exit Function
   Case 21
     If y + 1 > %Ny Then Exit Select
     If Pot(y + 1, x) = 0 Then
       Exit Function
     End If
   Case 22
     If Pot(y, x - 1) = 0 Then
       Exit Function
     End If
   Case 23
     If Pot(y - 1, x) = 0 Then
       Exit Function
     End If
   Case 24
     If Pot(y, x + 1) = 0 Then
       Exit Function
     End If
   Case 31
     If y + 1 > %Ny Then Exit Select
     If Pot(y - 1, x) = 0 And Pot(y + 1, x) = 0 Then
       Exit Function
     End If
   Case 32
     If Pot(y, x - 1) = 0 And Pot(y, x + 1) = 0 Then
       Exit Function
     End If
   Case 41
     If y + 1 > %Ny Then Exit Select
     If Pot(y, x + 1) = 0 And Pot(y + 1, x) = 0 Then
       Exit Function
     End If
   Case 42
     If y + 1 > %Ny Then Exit Select
     If Pot(y, x - 1) = 0 And Pot(y + 1, x) = 0 Then
       Exit Function
     End If
   Case 43
     If Pot(y - 1, x) = 0 And Pot(y, x - 1) = 0 Then
       Exit Function
     End If
   Case 44
     If Pot(y - 1, x) = 0 And Pot(y, x + 1) = 0 Then
       Exit Function
     End If
   End Select

   Function = %FALSE

 End Function
'---------------------------------------------------------------------------
 Function Xb(i)
   Function = (i - 1) * %BoxWidth + %Xshift
 End Function
'---------------------------------------------------------------------------
 Function Yb(k)
   Function = (k - 1) * %BoxWidth + %Yshift
 End Function
'---------------------------------------------------------------------------
 Sub HideFig()

   For i = 1 To 3
     For k = 1 To 3
       If Fig(i, k) <> 0 Then
         EraseBox Yb(CurY + i - 2), Xb(CurX + k - 2)
       End If
     Next
   Next

 End Sub
'---------------------------------------------------------------------------
 Sub ShowFig()

   For i = 1 To 3
     For k = 1 To 3
       If Fig(i, k) <> 0 Then
         DrawBox Yb(CurY + i - 2), Xb(CurX + k - 2), Fig(i, k)
       End If
     Next
   Next

 End Sub
'---------------------------------------------------------------------------
 Sub RotateFig()

   If CurX < 2 And Fig(3, 2) <> 0 Then
     Exit Sub
   End If

   If CurX > %Nx - 1 And Fig(1, 2) <> 0 Then
     Exit Sub
   End If
   Temp = Fig(2, 1)               '     b         (abcd)
   Fig(2, 1) = Fig(3, 2)          '  a     c    1. T = a
   Fig(3, 2) = Fig(2, 3)          '     d       2. a = d
   Fig(2, 3) = Fig(1, 2)          '             3. d = c
   Fig(1, 2) = Temp               '             4. c = b
'                                 '             5. b = T
 End Sub
'---------------------------------------------------------------------------
 Sub DrawBox(Y, X, Coler)

   Xe = X + %BoxWidth
   Ye = Y + %BoxWidth
   Line(X + 1, Y + 1) - (Xe - 1, Ye - 1), Coler, BF
   Line(X + 1, Y + 1) - (Xe - 1, Ye - 1), 0, B

 End Sub
'---------------------------------------------------------------------------
 Sub EraseBox(Y, X)

   Xe = X + %BoxWidth
   Ye = Y + %BoxWidth
   Line(X + 1, Y + 1) - (Xe - 1, Ye - 1), %BackGroundColor, BF

 End Sub
'---------------------------------------------------------------------------
 Sub SetRandomColors(A ())

   For i = 1 To 3
     For k = 1 To 3
       If A (i, k) <> 0 Then
         A (i, k) = Int(Rnd * %MaxColor) + 1 + 8
       End If
     Next
   Next

 End Sub
'---------------------------------------------------------------------------
 Sub SetRandomFig(A ())

   FigNumber = Int(Rnd * 4) + 1
   Select Case FigNumber
   Case 1
     For i = 1 To 3
       For k = 1 To 3
         A (i, k) = Fig1(i, k)
       Next
     Next
   Case 2
     For i = 1 To 3
       For k = 1 To 3
         A (i, k) = Fig2(i, k)
       Next
     Next
   Case 3
     For i = 1 To 3
       For k = 1 To 3
         A (i, k) = Fig3(i, k)
       Next
     Next
   Case 4
     For i = 1 To 3
       For k = 1 To 3
         A (i, k) = Fig4(i, k)
       Next
     Next
   End Select

 End Sub
'---------------------------------------------------------------------------
 Sub NewGame()

   X = Xb(1)
   Y = Yb(1)
   Xe = X + %BoxWidth * %Nx
   Ye = Y + %BoxWidth * %Ny
   Redim Pot(%Ny, %Nx + 1)
   Randomize Timer
   Line(0, 0) - (639, 479), 0, BF
   Line(0, 0) - (639, 479), 12, B
   Line(X - 1, Y - 6) - (Xe + 1, Ye + 1), %BackGroundColor, BF' Game pot
   Line(X - 2, Y - 7) - (Xe + 2, Ye + 2), 12, B

   Color 15, 0
   Locate 2, 10: Print " New game."
   Color 9, 0
   Locate 4, 8: Print "Esc = exit."
   Locate 5, 8: Print "End = new game."
   Locate 7, 8: Print Chr$(25) + " = move down,"
   Locate 8, 8: Print Chr$(27) + " = move left,"
   Locate 9, 8: Print Chr$(26) + " = move right,"
   Locate 10, 8: Print Chr$(24) + " = rotate,"
   Locate 12, 5: Print "Blank = drop a piece,"
   Locate 14, 7: Print "S = sound On/Off,"
   Locate 15, 7: Print "+ = incr. level,"
   Locate 16, 7: Print "- = decr. level"

   Line(Xe + 10, Y) - (629, 390), 1, B
   Color 4, 0
   Locate 2, 61: Print "Top twenty"
   Color 15, 0
   Locate 27, 9: Print "Press a key"

   InputResults
   ShowResults

   While Not Instat: Wend
   s$ = Inkey$
   If Asc(s$) = 27 Then           ' Esc
     Screen 0, 0
     End
   End If
   Locate 27, 9: Print "           "
   CurX = 4                       ' Center of upper lay
   CurY = 1
   Score = 0
   Level = 0
   Pause = 1. - Level * .1 + .2
   t# = Timer

 End Sub
'---------------------------------------------------------------------------
 Sub ShowResults

   Color 9, 0
   For i = 1 To 20
     Locate i + 3, 54: Print Right$(" " + Str$(i), 2); ". "; Txt(i)
   Next

 End Sub
'---------------------------------------------------------------------------
 Sub InputResults()

   Rf = Freefile
   Open ResultsFile For Binary As Rf
   If Lof(Rf) Then

     i = 1
     m = 100000
     Do While Not Eof(Rf)
       Get Rf,, Rec
       If Rec.Score < m Then
         m = Rec.Score
       End If
       Txt(i) = Rec.Pname + Right$("     " + Str$(Rec.Score), 6)
       Incr i
     Loop
     Close
     MinScore = m
     Array Sort Txt(1), From 13 To 18, Descend
   Else
     MinScore = 0
   End If

 End Sub
'---------------------------------------------------------------------------
 Sub OutputResults()

   Rf = Freefile
   Open ResultsFile For Binary As Rf
   For i = 1 To 20
     Rec.Pname = Left$(Txt(i),12)
     Rec.Score = Val(Mid$(Txt(i),13))
     Put #Rf ,, Rec
   Next
   Close Rf

 End Sub
'---------------------------------------------------------------------------
 Sub FrontScreen
'                        Game header:
   Dim a$(5)
   a$(1) = "01111001110010000001110011110011110001110010001"
   a$(2) = "10000010001010000010001010001010001010001001010"
   a$(3) = "10000010001010000010001011110011110010001000100"
   a$(4) = "10000010001010000010001010010010001010001001010"
   a$(5) = "01111001110011111001110010001011110001110010001"

   Screen 12
   Locate 18, 29: Print "*  T E T C O L O R  *"
   Color 12, 0
   Locate 20, 22: Print "Original program of Sergey Sotnikov"
   Locate 22, 22: Print "Reprogrammed by Alexander Podkolzin"

   Do While Inkey$ = ""
     Delay .05
     For i = 1 To 5
       For k = 1 To Len(a$(i))
         If Mid$(a$(i), k, 1) = "1" Then
           PutEl 10 *(k - 1) + 80, 10 *(i - 1) + 180
         End If
       Next
     Next
   Loop

 End Sub
'---------------------------------------------------------------------------
 Sub PutEl(x, y)

   c = Int(Rnd * 15) + 1
   Circle(x, y), 10 / 2, c
   Paint(x, y), c

 End Sub
'---------------------------------------------------------------------------
 Function CheckRows(A ())

   Total = 0
   For i = 1 To Ubound(A (), 1)
     k = 1
     Do While k < Ubound(A (), 2)
       Np = 0
       p = Abs(A (i, k))
       If p = 0 Then Incr k: Iterate Loop
       For m = k To Ubound(A (), 2)
         If Abs(A (i, m)) = p Then
           Incr Np
         Else
           Exit For
         End If
       Next
       If Np > 2 Then
         Incr Total, Np
         For m = k To k + Np - 1
           A (i, m) = -Abs(A (i, m))
         Next
         k = m + Np
         Iterate Loop
       End If
       Incr k
     Loop
   Next
   Function = Total

 End Function
'---------------------------------------------------------------------------
 Sub ShiftIt()

   For i = 1 To %Ny               ' Show all deleted pieces
     For k = 1 To %Nx
       If pot(i, k) < 0 Then
         If Pot(i, k) < 0 Then
           DrawBox Yb(i), Xb(k), 0
         End If
       End If
     Next
   Next

   Delay .05

   For k = 1 To %Nx
     i = %Ny
     Sc = 0
     Do While i > 1
       If Pot(i, k) < 0 Then
         Incr Sc, 10
         For m = i To 1 Step - 1
           Pot(m, k) = Pot(m - 1, k)
         Next
       End If
       Decr i                     ' ?
     Loop

     If Sc <> 0 Then
       For i = 1 To %Ny           ' Show colomn
         x = Xb(k)
         y = Yb(i)
'--------------!!!   This "If ... End" speeds up our game !!!---------------
         If Point(x + 1, y + 1) = %BackGroundColor And Pot(i, k) = 0 Then
           Iterate For
         End If
         EraseBox y, x
         c = Abs(Pot(i, k))
         If c <> 0 Then
           DrawBox y, x, c
         End If
       Next
       Incr Score, Sc
       Color 15, 0
       Locate 18, 10: Print "SCORE = "; Score; " "
       Locate 20, 10: Print "                 "
       If NeedSound Then Sound 3000, .1
     End If

   Next

 End Sub
'---------------------------------------------------------------------------
 Function InputGraph$(x%, y%, n%)

   f$ = ""
   t# = Timer
   Do
     s$ = Inkey$ + " "
     If Ascii(s$) = 13 Then Exit Loop
     If Ascii(s$) = 27 Then
       Locate y%, x% + k%: Print " ";
       Function = ""
       Exit Function
     End If
     If Len(s$) = 3 Or Ascii(s$) < 32 Then Iterate Loop
     If Timer - t# > .2 Then      ' Like blinking :)
       Vis% = Vis% Xor 1
       t# = Timer
     End If
     If Vis% Then
       Locate y%, x% + k%: Print "_";
     Else
       Locate y%, x% + k%: Print " ";
     End If
     If s$ = " " Then Iterate Loop
     Locate y%, x% + k%: Print s$;
     f$ = f$ + Left$(s$, 1)
     Incr k%
     If k% = > n% Then Exit Loop
   Loop
   Locate y%, x% + k%: Print " ";
   Function = f$

 End Function
'---------------------------------------------------------------------------
'
' Formatted : 09:08:18  10-30-1997