'===========================================================================
' Subject: MAX INPUT ROUTINES                 Date: 12-07-97 (21:05)       
'  Author: John Charles Bull III              Code: QB, QBasic, PDS        
'  Origin: vividbarrier@hotmail.com         Packet: TEXT.ABC
'===========================================================================
DECLARE SUB MAXinput2 (z$, xa!, xb!, max!, co1!, co2!, co3!, old!)
DECLARE SUB MAXinput (z$, xa%, xb%, max%, co1%)

' /........................\ Vivid Barrier Software 1997
' |.oO..oOo.oOo..vivid.....| QBasic 4.5x Useful SUB Procedures
' |.oO.oOo..oOo....barrier.| by John Charles Bull III
' |.oO.oOo..oOOOOo..=O97O=.|
' |.oOoOo...oOo.oOo........| http://pages.prodigy.net/wyzel/
' |.oOOo....oOOOOo.........|               
' \......................../ Phantom's Land RPG (made in 100% QBasic 4.5x)
'
' MAXinput and MAXinput2 will limit the input to a certain number of
' characters.
'
' MAXinput(TextReturn$,XPos,YPos,Max -1, TextColor)
' MAXinput2(TextReturn$,XPos,YPos,Max,FColor,BGColor,CursorColor,PrintOld)
'
' TextReturn$           - String to store text into (to not include SPACEBAR
'                         in input make the value * before you CALL the SUB)
'                         (The * can only be used in MAXinput not 2)
' XPos                  - Across position to start input
' YPos                  - Down position to start input
' Max                   - Maximum input length (the actual number is less than
'                         the one you type in MAXinput but not 2)
' TextColor             - Color of the text
' FColor                - Foreground text color
' BGColor               - Background text color
' CursorColor           - Block Cursor Color
' PrintOld              - If equal to 1 then print the old value of TextReturn$


CLS                                        'clear the screen

z1$ = "*"                                  'turn spaces off
CALL MAXinput(z1$, 1, 1, 9, 9)             'limit input to 8 characters

CALL MAXinput(z2$, 1, 1, 50, 9)            'limit input to 50 characters

CALL MAXinput2(z3$, 5, 1, 25, 9, 1, 7, 0)  'limit to 25, use MAXinput2

COLOR 9, 0                                 ' change color to 9,0

PRINT z1$                                  '
PRINT z2$                                  ' Print INPUTs for the helluvit
PRINT z3$                                  '

REM $DYNAMIC
DEFINT A-Z
SUB MAXinput (z$, xa, xb, max, co1)
no = 0
IF z$ = "*" THEN no = 1
z$ = ""
a = xa
b = xb
COLOR co1

DO
z = z + 1
z$ = z$ + " "
LOOP UNTIL z = max - 1
LOCATE xa, xb: PRINT z$;

s1:
	IF LEN(b$) = max - 1 THEN
		LOCATE xa, xb: PRINT b$;
	ELSE
		LOCATE xa, xb: PRINT b$ + "-";
	END IF
a$ = b$
b$ = b$ + INKEY$
IF b$ = a$ THEN GOTO s1

dork$ = RIGHT$(b$, 1)
	IF dork$ = " " AND no = 1 THEN
		D = LEN(b$)
		b$ = LEFT$(b$, D - 1)
	END IF

D = LEN(b$)
b = b + 1
c = LEN(b$)
c = c - 1
dork$ = RIGHT$(b$, 1)
IF dork$ = CHR$(8) THEN GOSUB takeoff
IF dork$ = CHR$(13) THEN GOTO ender
IF D = max THEN b$ = LEFT$(b$, c)
IF b$ = CHR$(8) THEN b$ = ""
	IF LEN(b$) = max - 1 THEN
		LOCATE xa, xb: PRINT b$;
	ELSE
		LOCATE xa, xb: PRINT b$ + "-";
	END IF
GOTO s1

takeoff:
c = LEN(b$)
IF c = 1 OR c = 0 THEN RETURN
c = c - 2
b$ = LEFT$(b$, c)
LOCATE xa, xb: PRINT z$;
LOCATE xa, xb: PRINT b$;
RETURN

ender:
c = LEN(b$)
c = c - 1
z$ = LEFT$(b$, c)
END SUB

DEFSNG A-Z
SUB MAXinput2 (z$, xa, xb, max, co1, co2, co3, old)
	' this will clear the area for the input to take place
	DO
		LOCATE xa, xb + a: COLOR co1, co2: PRINT " ";
		a = a + 1
	LOOP UNTIL a = max

	'if they picked old = 1 then it will print the old string if any
	IF old = 1 THEN
		LOCATE xa, xb
		IF LEN(z$) >= max THEN
			PRINT LEFT$(z$, max);
		ELSE
			PRINT z$;
		END IF
	END IF

	'print the cursor
	D = SCREEN(xa, xb, 0): COLOR co1, co3: LOCATE xa, xb: PRINT CHR$(D);
	a = 0  'cursor position relative to starting point (xa,xb)

mi1:
z$ = INKEY$
IF z$ = "" THEN GOTO mi1

IF z$ = CHR$(0) + "M" THEN GOTO inright
IF z$ = CHR$(0) + "K" THEN GOTO inleft
IF z$ = CHR$(8) THEN GOTO backspace
IF z$ = CHR$(13) THEN GOTO mi2
IF ASC(z$) = 31 OR ASC(z$) <= 31 OR ASC(z$) = 127 OR ASC(z$) >= 127 THEN GOTO mi1
      
	'repair were cursor is and print new character
	COLOR co1, co2: LOCATE xa, xb + a: PRINT z$;
	IF a + 1 = max THEN
	ELSE
		a = a + 1
	END IF
	D = SCREEN(xa, xb + a, 0): COLOR co1, co3: LOCATE xa, xb + a: PRINT CHR$(D);
GOTO mi1

backspace:
IF a = 0 THEN GOTO mi1
D = SCREEN(xa, xb + a, 0): COLOR co1, co2: LOCATE xa, xb + a: PRINT CHR$(D);
a = a - 1
D = SCREEN(xa, xb + a, 0): COLOR co1, co3: LOCATE xa, xb + a: PRINT " ";
GOTO mi1

inleft:
IF a = 0 THEN GOTO mi1
D = SCREEN(xa, xb + a, 0): COLOR co1, co2: LOCATE xa, xb + a: PRINT CHR$(D);
a = a - 1
D = SCREEN(xa, xb + a, 0): COLOR co1, co3: LOCATE xa, xb + a: PRINT CHR$(D);
GOTO mi1

inright:
IF a + 1 = max THEN GOTO mi1
D = SCREEN(xa, xb + a, 0): COLOR co1, co2: LOCATE xa, xb + a: PRINT CHR$(D);
a = a + 1
D = SCREEN(xa, xb + a, 0): COLOR co1, co3: LOCATE xa, xb + a: PRINT CHR$(D);
GOTO mi1

mi2:
'save input into a variable
a = 0
DO
D = SCREEN(xa, xb + a, 0)
z$ = z$ + CHR$(D)
a = a + 1
LOOP UNTIL a = max
z = LEN(z$)
z$ = RIGHT$(z$, z - 1)
END SUB