put a lot more functionality than my Hangman Game needs in here.
A GOSUB that's a substitute for the INPUT Statement.
As USUAL in BASIC to make this work, other parts of the code should leave the GLOBAL variable names
alone. This GOSUB uses GET at its core. It has 4 operating modes. IT = 1,2,3, or 4
I only needed two of them for Hangman, but the others occurred to me and could be useful.
It limits input to certain characters and limits the Input String length before INPUT... If
the USER presses a Key that isn't allowed it just beeps. Ditto if trying to exceed a programmer
specified Max Length for the Input. Allows limited editing with the Backspace Key.
(I thought of implementing insert and overtype, and I may yet, but thats a considerable more amount
of code in BASIC.)
I may change the line numbers on the GOSUB. I wrote this outside of my HANGMAN base code
and not sure the line numbers fit in yet.
This is a demo program to show how it works. The GOSUB is at line 4800
NOTE: When using Mode IT=2 it is still returns a string, but that string is guaranteed to make sense
passing to the VAL statement
UPDATE: SUNDAY 9 JULY... MINOR UPDATE TO IT=4. IT WAS NOT ALLOWING ! OR " (fixed)
Code: Select all
REM IY LOCATE Y LOCATION
REM IX LOCATE X LOCATION
REM ML MAX LENGTH OF STRING TO GET (1 TO 80)
REM IT TYPE OF INPUT 1=ALPHA ONLY, 2=NUMERIC(INCLUDE 1 AND ONLY 1 DECIMAL
REM POINT)
REM 3=ALPHANUMERIC, 4=LINE INPUT(CAN INCLUDE SPACE AND
REM TAB AND PUNCTUATION MARKS)
REM IS$ THE STRING TO RETURN
REM AC ADD CHAR 1=YES
REM ID DECIMAL DONE 1=YES
10 SCREEN 1:COLOR 5,0:CLS:PRINT
20 PRINT " LIMITED INPUT ROUTINE DEMONSTRATION"
30 PRINT " FIRST PASS: ONLY NUMERIC INPUT ALLOWED 10 CHAR MAXIMUM IT=2"
40 PRINT " ONE AND ONLY ONE DECIMAL ALLOWED"
45 LOCATE 10,4:PRINT "==>: ";:COLOR 7,0
50 IY=10:IX=10
60 IT = 2:ML=10:COLOR 0,15
70 GOSUB 4800 : COLOR 1,0
80 PRINT:PRINT:PRINT "RESULT: ";:COLOR 7:PRINT IS$
90 COLOR 1:PRINT:PRINT "ANY KEY FOR NEXT DEMO"
100 GOSUB 8000
110 COLOR 5,0:CLS:PRINT
120 PRINT "SECOND DEMO: ONLY ALPHABETIC CHARACTERS NO SPACES IT=1"
130 PRINT "MAXIMUM LENGTH 15 CHARACTERS"
140 LOCATE 10,4:PRINT "==>: ";:COLOR 7,0
150 IT=1:ML=15:COLOR 0,15
160 GOSUB 4800:COLOR 1,0
170 PRINT:PRINT:PRINT "RESULT: ";:COLOR 7:PRINT IS$
180 COLOR 1:PRINT:PRINT "ANY KEY FOR NEXT DEMO"
190 GOSUB 8000
200 COLOR 5,0:CLS:PRINT
210 PRINT "THIRD DEMO: ALPHA OR NUMERIC CHARACTERS ALLOWED, NO SPACES IT=3"
220 PRINT "MAXIMUM LENGTH 15 CHARACTERS"
225 LOCATE 10,4:PRINT "==>: ";:COLOR 7,0
230 IT=3:COLOR 0,15
240 GOSUB 4800:COLOR 1,0
250 PRINT:PRINT:PRINT "RESULT: ";:COLOR 7:PRINT IS$
260 COLOR 1:PRINT:PRINT "ANY KEY FOR NEXT DEMO"
270 GOSUB 8000
300 CLS:PRINT:COLOR 5,0
310 PRINT "FINAL DEMO: STRING INPUT SPACES,LETTER,NUMBERS AND SOME SYMBOLS";
315 PRINT " IT=4"
320 PRINT "MAXIMUM LENGTH 58 CHARACTERS"
325 LOCATE 10,4:PRINT "==>: ";:COLOR 7,0
330 IT=4:ML=58:COLOR 0,15
340 GOSUB 4800:COLOR 1,0
350 PRINT:PRINT:PRINT "RESULT: ";:COLOR 7:PRINT IS$
360 COLOR 1:PRINT:PRINT "ANY KEY TO EXIT"
370 GOSUB 8000
400 SCREEN 0:END
4799 REM THE INPUT ROUTINE
4800 GET X$:IF X$<>"" THEN 4800 : REM FLUSH KEYBOARD BUFFER
4801 IS$="":ID=0: REM BEFORE INPUT BEGINS
4805 GOSUB 4920 : REM CLEAR THE INPUT AREA.
4810 GET X$:IF X$="" THEN 4810
4811 C=ASC(X$)
4815 IF WL=ML THEN
4820 AC=0
4830 IF (IT<>2 OR IT=3) AND C>=65 AND C<=90 THEN AC=1
4835 IF (IT=2 OR IT=4 OR IT=3) AND C>=48 AND C<=57 THEN AC=1
4840 IF (IT=2) AND C=46 AND ID=0 THEN AC=1:ID=1
4845 IF (IT=4) AND C=32 THEN AC = 1: REM ALLOW SPACES WHEN INPUTTING A LINE
4846 IF (IT=4) AND (C>=33 AND C<=47) THEN AC=1
4847 IF (IT=4) AND (C>=58 AND C<=63) THEN AC=1 : REM ALLOW PUNCS IN STRING.
4850 IF C=13 THEN RETURN
4855 IF AC=1 AND LEN(IS$)<ML THEN PRINT CHR$(C);:IS$=IS$+CHR$(C):GOTO 4810
4860 IF C<>20 THEN 4895
4861 IF LEN(IS$) = 0 THEN PRINT CHR$(7);
4865 IF LEN(IS$)=1 OR LEN(IS$)=0 THEN IS$="":GOSUB 4920:GOTO 4810
4870 I = LEN(IS$)-1
4871 IF RIGHT$(IS$,1)="." AND IT=2 THEN ID=0
4875 IS$=LEFT$(IS$,I)
4890 GOSUB 4920:PRINT IS$;:GOTO 4810
4895 PRINT CHR$(7);:GOTO 4810
4920 LOCATE IY,IX:FOR I = 1 TO ML:PRINT " ";:NEXT I
4921 LOCATE IY,IX
4925 RETURN
7999 REM FLUSH KEYBOARD BUFFER THEN WAIT FOR KEYPRESS
8000 GET X$:IF X$<>"" THEN 8000
8010 GET X$:IF X$="" THEN 8010
8020 RETURN