Is there existing an inputroutine?

jj2007 · Post by **jj2007** » Dec 29, 2018 1:27

TmpFb.bas(65) error 57: Type mismatch, at parameter 2:

            Locate y, x: Print String$(Len(bb), "*"); " ";

It compiles when commenting out this line. This is a known bug, FreeBasic has a problem with STRING and Utf8.

Furthermore, when you go back in the string and start typing, the position does not change, i.e. the cursor does not advance.

Jawade · Post by **Jawade** » Dec 29, 2018 2:08

I have never problems with String, Maybe I am a locky one.

If you will write between the letters, use Insert. It is not a bug.
I can make so he makes free space, 2 modes with Insert, but it
is a choice.

jj2007 · Post by **jj2007** » Dec 29, 2018 7:48

1. If you don't have the problem with STRING$, it means you are using an editor or IDE that is not Utf8-aware. You can test that by printing some text after your Cls:

Cls
print "Привет, мир" ' Russian
print "Hällo Wörld" ' Görmän

If you don't see that text on screen, think about using another IDE.

2. I know that you can INSERT an empty space. But
a) it's not standard behaviour (Insert mode = typing ANY letter inserts)
b) once you have inserted a space there, typing produces one letter always at the same position.

Of course, I cannot exclude the possibility that my Gcc and Gas compilers produce different results than yours, or that your machine/your OS behave differently. Anybody else willing to test his code and give feedback?

grindstone · Post by **grindstone** » Dec 29, 2018 9:16

Just a little Christmas gift: Added a graphical cursor.

Code: Select all

Dim Shared nn As String
Dim Shared pp As String
Declare Sub xText(x As Integer, y As Integer, bb As String, s As Integer)


Main:
    ScreenRes 640, 480, 32: Width 80, 30: Color 0, -1
    Cls
    Locate 5, 6: Print "Name: ";
    xText(12, 5, nn, 0)
    Locate 7, 2: Print "Password: ";
    xText(12, 7, pp, 1)
    Locate 14, 1: Print nn: Print pp'www
    Sleep
System


Sub xText(x As Integer, y As Integer, bb As String, s As Integer)
    Dim a As Integer = x - 1
    Dim i As Integer = 1
    Dim aa As String
    Locate y, x: bb = ""
    Do
    	Dim As Integer cl = CsrLin, po = Pos
    	Do
	    	aa = InKey$
	    	Sleep 3
	    	Line ((Pos - 1) * 8, CsrLin * 16 - 2) - (Pos * 8, CsrLin * 16 - 1), IIf(Frac(Timer) < .5, 0, -1), bf
    	Loop Until aa <> ""
    	Line ((Pos - 1) * 8, CsrLin * 16 - 2) - (Pos * 8, CsrLin * 16 - 1), -1, bf
        If Len(aa) = 1 Then
            If Asc(aa) = 8 Then
                If i < Len(bb) + 1 Then
                    i = i - 1
                    bb = Left$(bb, i - 1) + Mid$(bb, i + 1)
                Else
                    bb = Left$(bb, Len(bb) - 1): i = i - 1
                    If i < 1 Then i = 1
                End If
            End If
            If Asc(aa) > 31 Then
                If i < Len(bb) + 1 Then
                    Mid$(bb, i, 1) = aa
                Else
                    bb = bb + aa: i = i + 1
                End If
            End If
        End If
        If Len(aa) = 2 Then
            If aa = Chr$(255, 71) Then i = 1
            If aa = Chr$(255, 79) Then i = Len(bb) + 1
            If aa = Chr$(255, 75) Then
                Print Chr$(8);
                i = i - 1: If i < 1 Then i = 1
            End If
            If aa = Chr$(255, 77) Then
                Print Chr$(11);
                i = i + 1: If i > Len(bb) + 1 Then i = Len(bb) + 1
            End If
            If aa = Chr$(255, 82) Then
                bb = Left$(bb, i - 1) + " " + Mid$(bb, i + 0)
            End If
            If aa = Chr$(255, 83) Then
                bb = Left$(bb, i - 1) + Mid$(bb, i + 1)
            End If
        End If
        If s Then
            Locate y, x: Print String$(Len(bb), "*"); " ";
            Locate , i + a
        Else
            Locate y, x: Print bb; " ";: Locate , i + a
        End If
    Loop Until aa = Chr$(27) Or aa = Chr$(13)
End Sub

INSERT definitely needs improvement.

jj2007 · Post by **jj2007** » Dec 29, 2018 11:13

The cursor is nice! Just for curiosity: If you use arrow left to go into the middle of the word, and then start typing, does it overwrite the rest of the word, or does it get stuck at that position as on my PC?

Jawade · Post by **Jawade** » Dec 29, 2018 19:18

Okay, thanks. Now it works for tekst mode and graphics mode.
Here i have the insertmode made all right, the only thing is
the lengt limitation.

Code: Select all


Dim Shared nn As String
Dim Shared pp As String
Declare Sub xText(x As Integer, y As Integer, bb As String, s As Integer)


Main:
    ScreenRes 640, 480, 32: Width 80, 30: Color 0, -1
    Cls
    Locate 5, 6: Print "Name: ";
    xText(12, 5, nn, 0)
    Locate 7, 2: Print "Password: ";
    xText(12, 7, pp, 1)
    Locate 14, 1: Print nn: Print pp'www
    Sleep
System


Sub xText(x As Integer, y As Integer, bb As String, s As Integer)
    Dim a As Integer = x - 1
    Dim i As Integer = 1
    Dim aa As String
    Locate y, x: bb = ""
    Do
       Dim As Integer cl = CsrLin, po = Pos
       Do
          aa = InKey$
          Sleep 3
          Line ((Pos - 1) * 8, CsrLin * 16 - 2) - (Pos * 8, CsrLin * 16 - 1), IIf(Frac(Timer) < .5, 0, -1), bf
       Loop Until aa <> ""
       Line ((Pos - 1) * 8, CsrLin * 16 - 2) - (Pos * 8, CsrLin * 16 - 1), -1, bf
        If Len(aa) = 1 Then
            If Asc(aa) = 8 Then
                If i < Len(bb) + 1 Then
                    i = i - 1
                    bb = Left$(bb, i - 1) + Mid$(bb, i + 1)
                Else
                    bb = Left$(bb, Len(bb) - 1): i = i - 1
                    If i < 1 Then i = 1
                End If
            End If
            If Asc(aa) > 31 Then
                If i < Len(bb) + 1 Then
                    bb = Left$(bb, i - 1) + aa + Mid$(bb, i + 0)
                    i = i + 1
                Else
                    bb = bb + aa: i = i + 1
                End If
            End If
        End If
        If Len(aa) = 2 Then
            If aa = Chr$(255, 71) Then i = 1
            If aa = Chr$(255, 79) Then i = Len(bb) + 1
            If aa = Chr$(255, 75) Then
                Print Chr$(8);
                i = i - 1: If i < 1 Then i = 1
            End If
            If aa = Chr$(255, 77) Then
                Print Chr$(11);
                i = i + 1: If i > Len(bb) + 1 Then i = Len(bb) + 1
            End If
            If aa = Chr$(255, 83) Then
                bb = Left$(bb, i - 1) + Mid$(bb, i + 1)
            End If
        End If
        If s Then
            Locate y, x: Print String$(Len(bb), "*"); " ";
            Locate , i + a
        Else
            Locate y, x: Print bb; " ";: Locate , i + a
        End If
    Loop Until aa = Chr$(27) Or aa = Chr$(13)
End Sub

jj2007 · Post by **jj2007** » Dec 29, 2018 19:53

Now it's almost working. If you type a long string, then go to the beginning using arrow left, and then press repeatedly backspace, you will see unexpected behaviour.

badidea · Post by **badidea** » Dec 29, 2018 20:43

Yep, press 'a', 'left', 'backspace', 'right' for a funny character.
And if I remove 'ScreenRes 640, 480, 32', the cursor keys don't work as expected.

Jawade · Post by **Jawade** » Dec 29, 2018 20:51

Now I have a length variable added. Now I think He 's ready.
Now I go working with it with a larger font. Thanks for all
the ideas and help.

Code: Select all

Dim Shared nn As String
Dim Shared pp As String
Declare Sub xText(x As Integer, y As Integer, bb As String, s As Integer, l As integer)


Main:
    ScreenRes 640, 480, 32: Width 80, 30: Color 0, -1
    Cls
    Locate 5, 6: Print "Name: ";
    xText(12, 5, nn, 0, 16)
    Locate 7, 2: Print "Password: ";
    xText(12, 7, pp, 1, 20)
    Locate 14, 1: Print nn: Print pp'www
    Sleep
System


Sub xText(x As Integer, y As Integer, bb As String, s As Integer, l As integer)
    Dim a As Integer = x - 1
    Dim i As Integer = 1
    Dim aa As String
    Locate y, x: bb = ""
    Do
        Dim As Integer cl = CsrLin, po = Pos
        Do
            aa = InKey$
            Sleep 3
            Line ((Pos - 1) * 8, CsrLin * 16 - 2) - (Pos * 8, CsrLin * 16 - 1), IIf(Frac(Timer) < .5, 0, -1), bf
        Loop Until aa <> ""
        Line ((Pos - 1) * 8, CsrLin * 16 - 2) - (Pos * 8, CsrLin * 16 - 1), -1, bf
        If Len(aa) = 1 Then
            If Asc(aa) = 8 Then
                If i < Len(bb) + 1 Then
                    i = i - 1
                    bb = Left$(bb, i - 1) + Mid$(bb, i + 1)
                Else
                    bb = Left$(bb, Len(bb) - 1): i = i - 1
                    If i < 1 Then i = 1
                End If
            End If
            If Asc(aa) > 31 Then
                If Len(bb) < l Then
                    If i < Len(bb) + 1 Then
                        bb = Left$(bb, i - 1) + aa + Mid$(bb, i + 0)
                        i = i + 1
                    Else
                        bb = bb + aa: i = i + 1
                    End If
                End If
            End If
        End If
        If Len(aa) = 2 Then
            If aa = Chr$(255, 71) Then i = 1
            If aa = Chr$(255, 79) Then i = Len(bb) + 1
            If aa = Chr$(255, 75) Then
                Print Chr$(8);
                i = i - 1: If i < 1 Then i = 1
            End If
            If aa = Chr$(255, 77) Then
                Print Chr$(11);
                i = i + 1: If i > Len(bb) + 1 Then i = Len(bb) + 1
            End If
            If aa = Chr$(255, 83) Then
                bb = Left$(bb, i - 1) + Mid$(bb, i + 1)
            End If
        End If
        If s Then
            Locate y, x: Print String$(Len(bb), "*"); " ";
            Locate , i + a
        Else
            Locate y, x: Print bb; " ";: Locate , i + a
        End If
    Loop Until aa = Chr$(27) Or aa = Chr$(13)
End Sub

jj2007 · Post by **jj2007** » Dec 30, 2018 0:19

Same problem as before.

grindstone · Post by **grindstone** » Dec 30, 2018 9:42

jj2007 wrote:Now it's almost working. If you type a long string, then go to the beginning using arrow left, and then press repeatedly backspace, you will see unexpected behaviour.

badidea wrote:Yep, press 'a', 'left', 'backspace', 'right' for a funny character.
And if I remove 'ScreenRes 640, 480, 32', the cursor keys don't work as expected.

That's easy to fix:

Code: Select all

Dim Shared nn As String
Dim Shared pp As String
Declare Sub xText(x As Integer, y As Integer, bb As String, s As Integer, l As Integer)


Main:
    ScreenRes 640, 480, 32: Width 80, 30: Color 0, -1
    Cls
    Locate 5, 6: Print "Name: ";
    xText(12, 5, nn, 0, 16)
    Locate 7, 2: Print "Password: ";
    xText(12, 7, pp, 1, 20)
    Locate 14, 1: Print nn: Print pp'www
    Sleep
System


Sub xText(x As Integer, y As Integer, bb As String, s As Integer, l As Integer)
    Dim a As Integer = x - 1
    Dim i As Integer = 1
    Dim aa As String
    Locate y, x: bb = ""
    Do
        Dim As Integer cl = CsrLin, po = Pos
        Do
            aa = Inkey$
            Sleep 3
            Line ((Pos - 1) * 8, CsrLin * 16 - 2) - (Pos * 8, CsrLin * 16 - 1), IIf(Frac(Timer) < .5, 0, -1), bf
        Loop Until aa <> ""
        Line ((Pos - 1) * 8, CsrLin * 16 - 2) - (Pos * 8, CsrLin * 16 - 1), -1, bf
        If Len(aa) = 1 Then
            If Asc(aa) = 8 Then
                If i = 1 Then '<<<<<<<<<
                	'cursor at pos 1 --> do nothing '<<<<<<<<<
                ElseIf i < Len(bb) + 1 Then '<<<<<<<<<
                    i = i - 1
                    bb = Left$(bb, i - 1) + Mid$(bb, i + 1)
                Else
                    bb = Left$(bb, Len(bb) - 1): i = i - 1
                    If i < 1 Then i = 1
                End If
            End If
            If Asc(aa) > 31 Then
                If Len(bb) < l Then
                    If i < Len(bb) + 1 Then
                        bb = Left$(bb, i - 1) + aa + Mid$(bb, i + 0)
                        i = i + 1
                    Else
                        bb = bb + aa: i = i + 1
                    End If
                End If
            End If
        End If
        If Len(aa) = 2 Then
            If aa = Chr$(255, 71) Then i = 1
            If aa = Chr$(255, 79) Then i = Len(bb) + 1
            If aa = Chr$(255, 75) Then
                Print Chr$(8);
                i = i - 1: If i < 1 Then i = 1
            End If
            If aa = Chr$(255, 77) Then
                Print Chr$(11);
                i = i + 1: If i > Len(bb) + 1 Then i = Len(bb) + 1
            End If
            If aa = Chr$(255, 83) Then
                bb = Left$(bb, i - 1) + Mid$(bb, i + 1)
            End If
        End If
        If s Then
            Locate y, x: Print String$(Len(bb), "*"); " ";
            Locate , i + a
        Else
            Locate y, x: Print bb; " ";: Locate , i + a
        End If
    Loop Until aa = Chr$(27) Or aa = Chr$(13)
End Sub

D.J.Peters · Post by **D.J.Peters** » Dec 30, 2018 12:24

No once need a GUI for FreeBASIC ;-)

Code: Select all

#include once "fltk-c.bi"
var win = Fl_WindowNew(320,200)
Fl_BoxNew(5, 5,110,20,"Fl_Input:")           : Fl_InputNew          (120, 5,128, 20)
Fl_BoxNew(5,30,110,20,"Fl_Int_Input:")       : Fl_Int_InputNew      (120,30,128, 20)
Fl_BoxNew(5,55,110,20,"Fl_Float_Input:")     : Fl_Float_InputNew    (120,55,128, 20)
Fl_BoxNew(5,80,110,20,"Fl_Multiline_Input:") : Fl_Multiline_InputNew(120,80,128,100)
Fl_WindowShow(win) : Fl_Run()

jj2007 · Post by **jj2007** » Dec 30, 2018 12:24

grindstone wrote:That's easy to fix

Works fine, and I see with pleasure that even the character limit is now working! The only thing missing would be a correct Insert vs Overwrite mode implementation.

Jawade · Post by **Jawade** » Dec 30, 2018 16:55

Yes, that is right, but we can miss it.
Nou I have the input routine extended with a big font.
You have to choose mode 0, 1 or 2:

Code: Select all

'Choose 0, 1 Or 2:
Dim Shared mode As Integer = 2
Dim Shared big As Integer
Dim Shared nn As String
Dim Shared pp As String
Declare Sub xText(x As Integer, y As Integer, bb As String, _
s As Integer, l As Integer)
Declare Sub pText(x As Integer, y As Integer, txt As String, _
fg As ulong, bg As ulong, mag As Integer)


Main:
    If mode = 0 Then big = 1
    If mode = 1 Then big = 1: ScreenRes 640, 480, 32: Width 80, 30
    If mode = 2 Then big = 2: ScreenRes 640, 480, 32: Width 80, 30
    Color 0, -1: Cls
'   pText(6*16, 5*32, "Name: ", 0, -1, 2)
    xText(12, 5, nn, 0, 16)
'   pText(2*16, 7*32, "Password: ", 0, -1, 2)
    xText(12, 7, pp, 1, 20)
    Locate 18, 1: Print nn: Print pp'www
    Sleep
System


Sub xText(x As Integer, y As Integer, bb As String, s As Integer, l As integer)
    Dim a As Integer = x - 1
    Dim i As Integer = 1
    Dim aa As String
    Locate y, x: bb = ""
    Do
        Do
            aa = InKey$
            Sleep 3
            Line ((Pos - 1) * 8*big, CsrLin * 16*big - 2) - (Pos * 8*big, _
            CsrLin * 16*big - 1), IIf(Frac(Timer) < .5, 0, -1), bf
        Loop Until aa <> ""
        Line ((Pos - 1) * 8*big, CsrLin * 16*big - 2) - (Pos * 8*big, _
        CsrLin * 16*big - 1), -1, bf
        If Len(aa) = 1 Then
            If Asc(aa) = 8 Then
                If i = 1 Then '<<<<<<<<<
                   'cursor at pos 1 --> do nothing '<<<<<<<<<
                ElseIf i < Len(bb) + 1 Then '<<<<<<<<<
                    i = i - 1
                    bb = Left$(bb, i - 1) + Mid$(bb, i + 1)
                Else
                    bb = Left$(bb, Len(bb) - 1): i = i - 1
                    If i < 1 Then i = 1
                End If
            End If
            If Asc(aa) > 31 Then
                If Len(bb) < l Then
                    If i < Len(bb) + 1 Then
                        bb = Left$(bb, i - 1) + aa + Mid$(bb, i + 0)
                        i = i + 1
                    Else
                        bb = bb + aa: i = i + 1
                    End If
                End If
            End If
        End If
        If Len(aa) = 2 Then
            If aa = Chr$(255, 134) Then
                big = big Xor 3
                ScreenRes 320*big, 240*big, 32: Width 80, 30: Color 0, -1:Cls
            End If
            If aa = Chr$(255, 71) Then i = 1
            If aa = Chr$(255, 79) Then i = Len(bb) + 1
            If aa = Chr$(255, 75) Then
                Print Chr$(8);
                i = i - 1: If i < 1 Then i = 1
            End If
            If aa = Chr$(255, 77) Then
                If big = 1 Then Print Chr$(11);
                i = i + 1: If i > Len(bb) + 1 Then i = Len(bb) + 1
            End If
            If aa = Chr$(255, 83) Then
                bb = Left$(bb, i - 1) + Mid$(bb, i + 1)
            End If
        End If
        If s Then
            pText(x*16, y*32, String$(Len(bb), "*")+" ", 0, -1, 2)
            Locate , i + a
        Else
            pText(x*16, y*32, bb+" ", 0, -1, 2)
            Locate , i + a
        End If
    Loop Until aa = Chr$(27) Or aa = Chr$(13)
End Sub


Sub pText(x As Integer, y As Integer, txt As String, _
    fg As ulong, bg As ulong, mag As Integer)
    If big = 2 Then
        x = x - big*8: y = y - big*16
        If ScreenPtr()=0 Then Return ' no screen
        var n = Len(txt) : If n < 1 Then Return ' no chars
        n Shl = 3 ' nPixels = nChars * fontwidth
        var img = imagecreate(n, 16, bg)
        If img = 0 Then Return
        draw String img,(0, 0), txt, fg
        For j As Integer = 0 To 15
            For i As Integer = 0 To n - 1
                Line (i*mag+x,j*mag+y)-Step(mag-1,mag-1), _
                Point(i,j,img),bf
            Next
        Next
        imagedestroy img
    End If
    If big = 1 Then
        Color fg, bg
        Locate y / 32, x / 16
        Print txt;
    End If
End Sub

jj2007 · Post by **jj2007** » Dec 30, 2018 17:49

Works fine. Btw you can make it compatible with Utf8-aware IDEs:

Code: Select all

            'pText(x*16, y*32, String$(Len(bb), "*")+" ", 0, -1, 2)	' chokes
            pText(x*16, y*32, Left$("*****************", Len(bb))+" ", 0, -1, 2)	' works fine

Is there existing an inputroutine?

Re: Is there existing an inputroutine?

Re: Is there existing an inputroutine?

Re: Is there existing an inputroutine?

Re: Is there existing an inputroutine?

Re: Is there existing an inputroutine?

Re: Is there existing an inputroutine?

Re: Is there existing an inputroutine?

Re: Is there existing an inputroutine?

Re: Is there existing an inputroutine?

Re: Is there existing an inputroutine?

Re: Is there existing an inputroutine?

Re: Is there existing an inputroutine?

Re: Is there existing an inputroutine?

Re: Is there existing an inputroutine?

Re: Is there existing an inputroutine?