QB64.org Forum

Active Forums => Programs => Topic started by: Dav on January 20, 2021, 11:55:26 am

Title: Restricted keyboard INPUT routine
Post by: Dav on January 20, 2021, 11:55:26 am

I'm adding this to my Keys48 program, thought I'd share it here in case someone whats it.

Basically this is like a keyboard INPUT routine that puts a limit on the number of characters you can enter.

- Dav

Code: QB64: [Select]

1. '==========
2. 'KINPUT.BAS
3. '==========
4. 'A restricted keyboard like INPUT routine.
5. 'Limits how many characters you can enter.
6. 'Coded by Dav, JAN/2021
7.  
8. a$ = KINPUT$(3, 3, "Enter up to 12 letters: ", 12)
9.  
10. PRINT
11. PRINT "You entered: "; a$
12.  
13.  
14. FUNCTION KINPUT$ (y, x, text$, limitnum)
15.   'ENTER returns text entered.
16.   'Handles the backspace.
17.   'ESC returns nothing.
18.  
19.     LOCATE y, x: PRINT text$;
20.  
21.     entry$ = ""
22.     y = CSRLIN: x = POS(1)
23.  
24.     DO
25.         a$ = INPUT$(1)
26.  
27.         IF a$ = CHR$(13) THEN 'enter returns entry
28.             KINPUT$ = entry$: EXIT FUNCTION
29.         END IF
30.  
31.         IF a$ = CHR$(27) THEN 'ESC bails out
32.             KINPUT$ = "": EXIT FUNCTION
33.         END IF
34.  
35.         IF a$ = CHR$(8) THEN 'Backspace goes back a space
36.             IF LEN(entry$) > 0 THEN
37.                 entry$ = MID$(entry$, 1, LEN(entry$) - 1)
38.             END IF
39.         ELSE
40.             'add letter entered, if not over limitnum
41.             IF LEN(entry$) < limitnum THEN
42.                 entry$ = entry$ + a$
43.             END IF
44.         END IF
45.  
46.         LOCATE y, x: PRINT SPACE$(limitnum);
47.         LOCATE y, x: PRINT entry$;
48.  
49.     LOOP
50.  
51. END FUNCTION
52.  

Title: Re: Restricted keyboard INPUT routine
Post by: Pete on January 20, 2021, 12:03:11 pm

I don't like being limited. That's why I only use SCREEN 0.

Pete

Title: Re: Restricted keyboard INPUT routine
Post by: FellippeHeitor on January 20, 2021, 12:04:53 pm

I'm yet to try your latest musical piece, Dav! Will do soon.

I'd have used another do/loop to get keyboard input. Your approach with INPUT$() is much cleaner (I hardly ever remember the function syntax of INPUT$()). Thanks for sharing!

Title: Re: Restricted keyboard INPUT routine
Post by: OldMoses on January 20, 2021, 10:11:18 pm

Useful, simple and expands my syntax vocabulary. Filed in my "Dav" folder. Thanks.

Title: Re: Restricted keyboard INPUT routine
Post by: Dav on January 20, 2021, 11:27:22 pm

Thanks!  I made a graphical version too, called INPUTBOX, which I probably will use instead.  It saves/restores the screen, and returns to original cursor position.

Draws a little box based on total text length.

- Dav

Code: QB64: [Select]

1. '=============
2. 'INPUTBOX$.BAS
3. '=============
4. 'Graphical restricted INPUT Box.
5. 'Coded by Dav, JAN/2021
6.  
7. '=== Set screen mode, and color
8. SCREEN _NEWIMAGE(600, 600, 32)
9.  
10. CLS , _RGB(32, 32, 32)
11.  
12. '=== draw stuff
13. FOR x = 1 TO 600 STEP 3
14.     FOR y = 1 TO 600 STEP 3
15.         PSET (x, y), _RGB(RND * 255, RND * 255, RND * 255)
16.     NEXT
17. NEXT
18.  
19. _DELAY 1
20.  
21. a$ = INPUTBOX$(15, 15, "ENTER SOMETHING: ", 22, _RGB(255, 255, 255), _RGB(70, 95, 114))
22.  
23. IF a$ <> "" THEN
24.     PRINT "You entered: "; a$
25. ELSE
26.     PRINT "You entered nothing."
27. END IF
28.  
29.  
30.  
31. FUNCTION INPUTBOX$ (y, x, text$, limitnum, fg&, bg&)
32.  
33.     '=== save original place of cursor
34.     origy = CSRLIN: origx = POS(1)
35.  
36.     '=== Save whole screen
37.     DIM scr1 AS _MEM, scr2 AS _MEM
38.     scr1 = _MEMIMAGE(0): scr2 = _MEMNEW(scr1.SIZE)
39.     _MEMCOPY scr1, scr1.OFFSET, scr1.SIZE TO scr2, scr2.OFFSET
40.  
41.     tl = LEN(text$) + limitnum 'total length of letter spacing used
42.  
43.     LINE (x * 8 - 24, y * 16 - 32)-((x * 8) + (tl * 8) + 8, y * 16 + 16), bg&, BF
44.     LINE (x * 8 - 24, y * 16 - 32)-((x * 8) + (tl * 8) + 8, y * 16 + 16), fg&, B
45.     COLOR fg&, bg&
46.  
47.     LOCATE y, x: PRINT text$;
48.     y = CSRLIN: x = POS(1)
49.  
50.     entry$ = ""
51.  
52.     DO
53.         a$ = INPUT$(1)
54.  
55.         '=== Return exits with data
56.         IF a$ = CHR$(13) THEN INPUTBOX$ = entry$: EXIT DO
57.         '=== ESC cancels
58.         IF a$ = CHR$(27) THEN INPUTBOX$ = "": EXIT DO
59.         '=== Handle backspace
60.         IF a$ = CHR$(8) THEN 'Backspace goes back a space
61.             IF LEN(entry$) > 0 THEN
62.                 entry$ = MID$(entry$, 1, LEN(entry$) - 1)
63.             END IF
64.         ELSE
65.             'add letter entered, if not over limitnum
66.             IF LEN(entry$) < limitnum THEN
67.                 entry$ = entry$ + a$
68.             END IF
69.         END IF
70.  
71.         LOCATE y, x: PRINT SPACE$(limitnum);
72.         LOCATE y, x: PRINT entry$;
73.  
74.     LOOP
75.  
76.     '=== Restore the whole screen
77.     _MEMCOPY scr2, scr2.OFFSET, scr2.SIZE TO scr1, scr1.OFFSET
78.     _MEMFREE scr1: _MEMFREE scr2
79.  
80.     '=== restore original y,x
81.     LOCATE origy, origx
82.  
83. END FUNCTION
84.  
85.  

Title: Re: Restricted keyboard INPUT routine
Post by: Dav on January 21, 2021, 09:03:36 am

Worked the graphics version out to more what I was looking for.  IBOX$ Function performs 2 tasks - either gets user input, or shows an info box.  It automatically centers the box on the screen based on text length.

If limitnum = 0 then it just displays text$. If you set the limit number, it will return user input.

- Dav

Code: QB64: [Select]

1. '=============
2. 'IBOX$.BAS
3. '=============
4. 'INPUT & INFO line box.
5. 'Either get user info, or show info.
6. 'Coded by Dav, JAN/2021
7.  
8. '=== Set screen mode, and color
9. SCREEN _NEWIMAGE(600, 600, 32)
10.  
11. CLS , _RGB(32, 32, 32)
12.  
13. '=== draw stuff
14. FOR x = 1 TO 600 STEP 3
15.     FOR y = 1 TO 600 STEP 3
16.         PSET (x, y), _RGB(RND * 255, RND * 255, RND * 255)
17.     NEXT
18. NEXT
19.  
20. a$ = IBOX$("ENTER SOMETHING: ", 22, _RGB(255, 255, 255), _RGB(70, 95, 114))
21.  
22. b$ = IBOX$("YOU ENTERED: " + a$, 0, _RGB(255, 255, 255), _RGB(70, 95, 114))
23.  
24. END
25.  
26.  
27. FUNCTION IBOX$ (text$, limitnum, fg&, bg&)
28.     'This function either gets user input or shows info.
29.     'If limitnum is 0, it just shows info.
30.  
31.     'text$: Your text to show
32.     'limitnum: how many letters of input to get
33.     'fg&: The Text color
34.     'bg&: Background color of box
35.  
36.     '=== save original place of cursor
37.     origy = CSRLIN: origx = POS(1)
38.  
39.     '=== Save whole screen
40.     DIM scr1 AS _MEM, scr2 AS _MEM
41.     scr1 = _MEMIMAGE(0): scr2 = _MEMNEW(scr1.SIZE)
42.     _MEMCOPY scr1, scr1.OFFSET, scr1.SIZE TO scr2, scr2.OFFSET
43.  
44.     '=== find center x/y of screen
45.     y = INT(_HEIGHT / _FONTHEIGHT / 2)
46.     x = INT(_WIDTH / _FONTWIDTH / 2)
47.  
48.     tl = LEN(text$) + limitnum 'total length of letter spacing used
49.     x = x - INT(tl / 2) 'recompute x based on text length
50.  
51.     LINE (x * 8 - 24, y * 16 - 32)-((x * 8) + (tl * 8) + 8, y * 16 + 16), bg&, BF
52.     LINE (x * 8 - 24, y * 16 - 32)-((x * 8) + (tl * 8) + 8, y * 16 + 16), fg&, B
53.     COLOR fg&, bg&
54.  
55.     LOCATE y, x: PRINT text$;
56.     y = CSRLIN: x = POS(1)
57.  
58.     IF limitnum = 0 THEN
59.         a$ = INPUT$(1)
60.         IBOX$ = ""
61.     ELSE
62.  
63.         entry$ = ""
64.  
65.         DO
66.             a$ = INPUT$(1)
67.  
68.             '=== Return exits with data
69.             IF a$ = CHR$(13) THEN IBOX$ = entry$: EXIT DO
70.             '=== ESC cancels, returns nothing
71.             IF a$ = CHR$(27) THEN IBOX$ = "": EXIT DO
72.             '=== Backspace handle
73.             IF a$ = CHR$(8) THEN 'Backspace goes back a space
74.                 IF LEN(entry$) > 0 THEN
75.                     entry$ = MID$(entry$, 1, LEN(entry$) - 1)
76.                 END IF
77.             ELSE
78.                 'add letter entered, if not over limitnum
79.                 IF LEN(entry$) < limitnum THEN
80.                     entry$ = entry$ + a$
81.                 END IF
82.             END IF
83.  
84.             LOCATE y, x: PRINT SPACE$(limitnum);
85.             LOCATE y, x: PRINT entry$;
86.  
87.         LOOP
88.  
89.     END IF
90.  
91.     '=== Restore the whole screen
92.     _MEMCOPY scr2, scr2.OFFSET, scr2.SIZE TO scr1, scr1.OFFSET
93.     _MEMFREE scr1: _MEMFREE scr2
94.  
95.     '=== restore original y,x
96.     LOCATE origy, origx
97.  
98. END FUNCTION
99.  

Title: Re: Restricted keyboard INPUT routine
Post by: bplus on January 21, 2021, 12:51:05 pm

I have an InputBox$ you can grab title bar and move around screen:

Code: QB64: [Select]

1. OPTION _EXPLICIT
2. _TITLE "inputBox$ tester.bas started 2018-10-26 need an input box for WS Editor"
3. ' 2019-07-32 assimulate scnState(restoreTF) used to save and restore screen settings
4. ' so sub can do it's thing and restore settings, Thanks Steve McNeill for starter code and idea.
5.  
6. SCREEN _NEWIMAGE(800, 600, 32)
7. _SCREENMOVE 100, 20
8. DIM well$, enter$, k$, kh AS LONG
9.  
10. COLOR &HFFFFFF00, &HFF880000
11. PRINT "Here is some stuff on screen."
12. well$ = inputBox$("Well?", "Test inputBox$", 20)
13. PRINT "inputBox$ returned: "; well$; ". Is this line printing exactly below last stuff sentence?" ' OK now with center fix too!
14. INPUT "OK? enter for next test, use h or m keypress to invoke inputBox$...", enter$
15.  
16. 'draw stuff, until h or m press, then show message box
17. WHILE 1
18.     k$ = INKEY$
19.     IF k$ = "m" OR k$ = "h" THEN
20.         well$ = inputBox$("Well?", "Test call inputBox", 36)
21.         PRINT "inputBox$() returned: *"; well$; "*"
22.     END IF
23.     'kh = 0  'should not need this to stop esc keypress in input box
24.     LINE (RND * _WIDTH, RND * _HEIGHT)-STEP(RND * 80, RND * 60), _RGB32(RND * 255, RND * 255, RND * 255), BF
25.     kh = _KEYHIT
26.     IF kh = 27 THEN EXIT WHILE
27.     '_DISPLAY   '<< should not need this
28.     _LIMIT 5
29. WEND
30. PRINT "OK where is this print line going to end up, hopefully under the last inputBox returned." 'yes! Excellent!
31. PRINT "InputBox$() last returned: "; well$; ",  Goodbye!"
32. END
33.  
34. ' You can grab this box by title and drag it around screen for full viewing while answering prompt.
35. ' Only one line allowed for prompt$
36. ' boxWidth is 4 more than the allowed length of input, it needs to be longer than title$ and prompt$ also
37. ' Utilities > Input Box > Input Box 1 tester v 2019-07-31
38. FUNCTION inputBox$ (prompt$, title$, boxWidth AS _BYTE)
39.     DIM ForeColor AS _UNSIGNED LONG, BackColor AS _UNSIGNED LONG, White AS _UNSIGNED LONG
40.     DIM sw AS INTEGER, sh AS INTEGER, curScrn AS LONG, backScrn AS LONG, ibx AS LONG 'some handles
41.  
42.     'colors
43.     ForeColor = &HFF000055 '<  change as desired  prompt text color, back color or type in area
44.     BackColor = &HFF6080CC '<  change as desired  used fore color in type in area
45.     White = &HFFFFFFFF
46.  
47.     'items to restore at exit
48.     scnState 0
49.  
50.     'screen snapshot
51.     sw = _WIDTH: sh = _HEIGHT: curScrn = _DEST
52.     backScrn = _NEWIMAGE(sw, sh, 32)
53.     _PUTIMAGE , curScrn, backScrn
54.  
55.     'moving box around on screen
56.     DIM bxW AS INTEGER, bxH AS INTEGER
57.     DIM mb AS INTEGER, mx AS INTEGER, my AS INTEGER, mi AS INTEGER, grabx AS INTEGER, graby AS INTEGER
58.     DIM tlx AS INTEGER, tly AS INTEGER 'top left corner of message box
59.     DIM lastx AS INTEGER, lasty AS INTEGER
60.     DIM INP$, kh&
61.  
62.     'draw message box
63.     bxW = boxWidth * 8: bxH = 7 * 16
64.     ibx = _NEWIMAGE(bxW, bxH, 32)
65.     _DEST ibx
66.     COLOR &HFF880000, White
67.     LOCATE 1, 1: PRINT LEFT$(SPACE$(INT((boxWidth - LEN(title$) - 3)) / 2) + title$ + SPACE$(boxWidth), boxWidth)
68.     COLOR White, &HFFBB0000
69.     LOCATE 1, boxWidth - 2: PRINT " X "
70.     COLOR ForeColor, BackColor
71.     LOCATE 2, 1: PRINT SPACE$(boxWidth);
72.     LOCATE 3, 1: PRINT LEFT$(SPACE$((boxWidth - LEN(prompt$)) / 2) + prompt$ + SPACE$(boxWidth), boxWidth);
73.     LOCATE 4, 1: PRINT SPACE$(boxWidth);
74.     LOCATE 5, 1: PRINT SPACE$(boxWidth);
75.     LOCATE 6, 1: PRINT SPACE$(boxWidth);
76.     INP$ = ""
77.     GOSUB finishBox
78.  
79.     'convert to pixels the top left corner of box at moment
80.     bxW = boxWidth * 8: bxH = 5 * 16
81.     tlx = (sw - bxW) / 2: tly = (sh - bxH) / 2
82.     lastx = tlx: lasty = tly
83.     _KEYCLEAR
84.     'now allow user to move it around or just read it
85.     WHILE 1
86.         CLS
87.         _PUTIMAGE , backScrn
88.         _PUTIMAGE (tlx, tly), ibx, curScrn
89.         _DISPLAY
90.         WHILE _MOUSEINPUT: WEND
91.         mx = _MOUSEX: my = _MOUSEY: mb = _MOUSEBUTTON(1)
92.         IF mb THEN
93.             IF mx >= tlx AND mx <= tlx + bxW AND my >= tly AND my <= tly + 16 THEN 'mouse down on title bar
94.                 IF mx >= tlx + bxW - 24 THEN EXIT WHILE
95.                 grabx = mx - tlx: graby = my - tly
96.                 DO WHILE mb 'wait for release
97.                     mi = _MOUSEINPUT: mb = _MOUSEBUTTON(1)
98.                     mx = _MOUSEX: my = _MOUSEY
99.                     IF mx - grabx >= 0 AND mx - grabx <= sw - bxW AND my - graby >= 0 AND my - graby <= sh - bxH THEN
100.                         'attempt to speed up with less updates
101.                         IF ((lastx - (mx - grabx)) ^ 2 + (lasty - (my - graby)) ^ 2) ^ .5 > 10 THEN
102.                             tlx = mx - grabx: tly = my - graby
103.                             CLS
104.                             _PUTIMAGE , backScrn
105.                             _PUTIMAGE (tlx, tly), ibx, curScrn
106.                             lastx = tlx: lasty = tly
107.                             _DISPLAY
108.                         END IF
109.                     END IF
110.                     _LIMIT 400
111.                 LOOP
112.             END IF
113.         END IF
114.         kh& = _KEYHIT
115.         SELECT CASE kh& 'whew not much for the main event!
116.             CASE 13: EXIT WHILE
117.             CASE 27: INP$ = "": EXIT WHILE
118.             CASE 32 TO 128: IF LEN(INP$) < boxWidth - 4 THEN INP$ = INP$ + CHR$(kh&): GOSUB finishBox ELSE BEEP
119.             CASE 8: IF LEN(INP$) THEN INP$ = LEFT$(INP$, LEN(INP$) - 1): GOSUB finishBox ELSE BEEP
120.         END SELECT
121.  
122.         _LIMIT 60
123.     WEND
124.  
125.     'put things back
126.     scnState 1 'need fg and bg colors set to cls
127.     CLS '? is this needed YES!!
128.     _PUTIMAGE , backScrn
129.     _DISPLAY
130.     _FREEIMAGE backScrn
131.     _FREEIMAGE ibx
132.     scnState 1 'because we have to call _display, we have to call this again
133.     inputBox$ = INP$
134.     EXIT FUNCTION
135.  
136.     finishBox:
137.     _DEST ibx
138.     COLOR BackColor, ForeColor
139.     LOCATE 5, 2: PRINT LEFT$(" " + INP$ + SPACE$(boxWidth - 2), boxWidth - 2)
140.     _DEST curScrn
141.     RETURN
142. END FUNCTION
143.  
144. 'from mBox v 2019-07-31 update
145. ' for saving and restoring screen settins
146. SUB scnState (restoreTF AS INTEGER) 'Thanks Steve McNeill
147.     STATIC Font AS LONG, DefaultColor AS _UNSIGNED LONG, BackGroundColor AS _UNSIGNED LONG, Dest AS LONG, Source AS LONG
148.     STATIC row AS INTEGER, col AS INTEGER, autodisplay AS INTEGER, mb AS INTEGER
149.     IF restoreTF THEN
150.         _FONT Font
151.         COLOR DefaultColor, BackGroundColor
152.         _DEST Dest
153.         _SOURCE Source
154.         LOCATE row, col
155.         IF autodisplay THEN _AUTODISPLAY ELSE _DISPLAY
156.         _KEYCLEAR
157.         WHILE _MOUSEINPUT: WEND 'clear mouse clicks
158.         mb = _MOUSEBUTTON(1)
159.         IF mb THEN
160.             DO
161.                 WHILE _MOUSEINPUT: WEND
162.                 mb = _MOUSEBUTTON(1)
163.                 _LIMIT 100
164.             LOOP UNTIL mb = 0
165.         END IF
166.     ELSE
167.         Font = _FONT: DefaultColor = _DEFAULTCOLOR: BackGroundColor = _BACKGROUNDCOLOR
168.         Dest = _DEST: Source = _SOURCE
169.         row = CSRLIN: col = POS(0): autodisplay = _AUTODISPLAY
170.     END IF
171. END SUB
172.  
173.  
174.  
175.  

Also has brother mBox SUB for messages:
https://www.qb64.org/forum/index.php?topic=1511.msg107661#msg107661

Title: Re: Restricted keyboard INPUT routine
Post by: Dav on January 21, 2021, 01:05:03 pm

Those are nicely done, @bplus!  Will come in handy!  I'm saving them.

- Dav

Title: Re: Restricted keyboard INPUT routine
Post by: Pete on January 21, 2021, 02:36:40 pm

Hey Dav, think BIGGER! Go with screen 0!

https://www.qb64.org/forum/index.php?topic=3520.0

Includes lateral scrolling, highlighting, cut, copy, paste, arrow, home, end, ctrl, overwrite, insert, and mouse functions.

Pete

Title: Re: Restricted keyboard INPUT routine
Post by: Dav on January 21, 2021, 02:41:33 pm

Yeah, I was checking that out, Pete! Looks good, i will test it out...

-Dav

Title: Re: Restricted keyboard INPUT routine
Post by: Pete on January 21, 2021, 03:02:19 pm

I wonder what others, not you, I know you made a text editor, but people who would like to have a way to input and manipulate a line of text, think when they see the code needed to achieve that ability, which may be as large, or larger, than their project.

Well if you do get a chance to take it for a spin, I'd love to discuss any differences you may have had in your approach to text input and editing in your IDE.

Pete

Text Only | Text with Attachments