Is there existing an inputroutine?

General FreeBASIC programming questions.
jj2007
Posts: 1135
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: Is there existing an inputroutine?

Postby jj2007 » Dec 29, 2018 1:27

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

Code: Select all

            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
Posts: 224
Joined: Apr 25, 2008 19:13

Re: Is there existing an inputroutine?

Postby 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
Posts: 1135
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: Is there existing an inputroutine?

Postby 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
Posts: 640
Joined: May 05, 2015 5:35
Location: Germany

Re: Is there existing an inputroutine?

Postby 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
Posts: 1135
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: Is there existing an inputroutine?

Postby 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
Posts: 224
Joined: Apr 25, 2008 19:13

Re: Is there existing an inputroutine?

Postby 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
Posts: 1135
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: Is there existing an inputroutine?

Postby 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
Posts: 1300
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Is there existing an inputroutine?

Postby 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
Posts: 224
Joined: Apr 25, 2008 19:13

Re: Is there existing an inputroutine?

Postby 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
Posts: 1135
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: Is there existing an inputroutine?

Postby jj2007 » Dec 30, 2018 0:19

Same problem as before.
grindstone
Posts: 640
Joined: May 05, 2015 5:35
Location: Germany

Re: Is there existing an inputroutine?

Postby 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
Posts: 7667
Joined: May 28, 2005 3:28

Re: Is there existing an inputroutine?

Postby D.J.Peters » Dec 30, 2018 12:24

No once need a GUI for FreeBASIC ;-)
Image

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
Posts: 1135
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: Is there existing an inputroutine?

Postby 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
Posts: 224
Joined: Apr 25, 2008 19:13

Re: Is there existing an inputroutine?

Postby 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
Posts: 1135
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: Is there existing an inputroutine?

Postby 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

Return to “General”

Who is online

Users browsing this forum: No registered users and 4 guests