Category : BASIC Source Code
Archive   : BASCREEN.ZIP
Filename : SCREEN.BAS
'-----------------------------------------------------------------------
' THIS SUB POSITIONS CURSOR AT ROWX, COLX OF SCREEN, AND READS IN
' INVERSE VIDEO THE INTEGER VARIABLE VAR, WID DIGITS.
' FG% AND BG% ARE THE NORMAL FORGROUND AND BACKGROUND COLORS, AND IN
' INVERSE VIDEO THEY WILL BE REVERSED.
' ESC ENDS PROGRAM, BACKSPACE OR CURSOR LEFT, RIGHT ALLOWS OVERWRITING
' IF Shift Tab IS PRESSED, ROWX% IS SET TO 51 AS SIGNAL TO CALLING PGM
' IF ROWX% < 0 THEN VAR% IS PUT INTO FIELD, BUT NO INPUT IS EXPECTED
' IF COLX% < 0 THEN VAR% IS PUT INTO FIELD, BUT MAY BE MODIFIED
'-----------------------------------------------------------------------
ROW% = ABS(ROWX%)
COL% = ABS(COLX%)
LOCATE ROW%, COL%, 1
COLOR BG%, FG%
10 IF ROWX% < 0 THEN
PRINT USING STRING$(WID%, "#"); VAR%
COLOR FG%, BG%
EXIT SUB
END IF
IF COLX% < 0 THEN
PRINT USING STRING$(WID%, "#"); VAR%
LOCATE ROW%, COL%, 1
END IF
FOR J = 1 TO WID%
40 I$ = INKEY$: IF I$ = "" THEN 40
IF I$ = CHR$(27) THEN
COLOR FG%, BG%
CLS
END
END IF
IF I$ = CHR$(13) OR I$ = CHR$(9) THEN GOTO 100 ' CR OR TAB
IA = ASC(RIGHT$(I$, 1))
L = LEN(I$)
IF J > 1 AND ((L = 2 AND IA = 75) OR I$ = CHR$(8)) THEN ' BACKSPACE
J = J - 1
LOCATE CSRLIN, POS(0) - 1, 1
GOTO 40
END IF
IF J < WID% AND L = 2 AND IA = 77 THEN ' CURSOR RIGHT
J = J + 1
LOCATE CSRLIN, POS(0) + 1, 1
GOTO 40
END IF
IF L = 2 AND IA = 15 THEN ' SHIFT TAB
ROWX% = 51
GOTO 100
END IF
IF L = 2 AND IA = 71 THEN ' HOME
J = 1
LOCATE CSRLIN, COL%, 1
GOTO 40
END IF
IF L = 2 AND IA = 79 THEN ' END
J = WID%
LOCATE CSRLIN, COL% - 1 + WID%, 1
GOTO 40
END IF
IF I$ <> " " AND I$ <> "-" AND (I$ < "0" OR I$ > "9") THEN
BEEP
LOCATE CSRLIN, POS(0), 1
GOTO 40
END IF
PRINT I$;
NEXT J
100 I$ = ""
FOR J = COL% TO COL% - 1 + WID%
I$ = I$ + CHR$(SCREEN(ROW%, J))
NEXT
VAR% = VAL(I$)
COLOR FG%, BG%
END SUB
SUB SCREENF (ROWX%, COLX%, WID%, VAR!, FG%, BG%) STATIC
'-----------------------------------------------------------------------
' THIS SUB POSITIONS CURSOR AT ROWX, COLX OF SCREEN, AND READS IN
' INVERSE VIDEO THE REAL VARIABLE VAR, WID DIGITS.
' FG% AND BG% ARE THE NORMAL FORGROUND AND BACKGROUND COLORS, AND IN
' INVERSE VIDEO THEY WILL BE REVERSED.
' ESC ENDS PROGRAM, BACKSPACE OR CURSOR LEFT, RIGHT ALLOWS OVERWRITING
' IF Shift Tab IS PRESSED, ROWX% IS SET TO 51 AS SIGNAL TO CALLING PGM
' IF ROWX% < 0 THEN VAR! IS PUT INTO FIELD, BUT NO INPUT IS EXPECTED
' IF COLX% < 0 THEN VAR! IS PUT INTO FIELD, BUT MAY BE MODIFIED
'-----------------------------------------------------------------------
ROW% = ABS(ROWX%)
COL% = ABS(COLX%)
LOCATE ROW%, COL%, 1
COLOR BG%, FG%
IF ROWX% < 0 OR COLX% < 0 THEN
VAR$ = LEFT$(LTRIM$(STR$(VAR!)), WID%)
END IF
F10: IF ROWX% < 0 THEN
PRINT VAR$
COLOR FG%, BG%
EXIT SUB
END IF
IF COLX% < 0 THEN
PRINT VAR$
LOCATE ROW%, COL%, 1
END IF
FOR J = 1 TO WID%
F40: I$ = INKEY$: IF I$ = "" THEN GOTO F40
IF I$ = CHR$(27) THEN
COLOR FG%, BG%
CLS
END
END IF
IF I$ = CHR$(13) OR I$ = CHR$(9) THEN GOTO F100 ' CR OR TAB
IA = ASC(RIGHT$(I$, 1))
L = LEN(I$)
IF J > 1 AND ((L = 2 AND IA = 75) OR I$ = CHR$(8)) THEN ' BACKSPACE
J = J - 1
LOCATE CSRLIN, POS(0) - 1, 1
GOTO F40
END IF
IF J < WID% AND L = 2 AND IA = 77 THEN ' CURSOR RIGHT
J = J + 1
LOCATE CSRLIN, POS(0) + 1, 1
GOTO F40
END IF
IF L = 2 AND IA = 15 THEN ' SHIFT TAB
ROWX% = 51
GOTO F100
END IF
IF L = 2 AND IA = 71 THEN ' HOME
J = 1
LOCATE CSRLIN, COL%, 1
GOTO F40
END IF
IF L = 2 AND IA = 79 THEN ' END
J = WID%
LOCATE CSRLIN, COL% - 1 + WID%, 1
GOTO F40
END IF
IF I$ <> "." AND I$ <> " " AND I$ <> "-" AND (I$ < "0" OR I$ > "9") THEN
BEEP
LOCATE CSRLIN, POS(0), 1
GOTO F40
END IF
PRINT I$;
NEXT J
F100: I$ = ""
FOR J = COL% TO COL% - 1 + WID%
I$ = I$ + CHR$(SCREEN(ROW%, J))
NEXT
VAR! = VAL(I$)
COLOR FG%, BG%
END SUB
SUB SCREENS (ROWX%, COLX%, WID%, VAR$, FG%, BG%) STATIC
'-----------------------------------------------------------------------
' THIS SUB POSITIONS CURSOR AT ROWX, COLX OF SCREEN, AND READS IN
' INVERSE VIDEO THE STRING VARIABLE VAR$, WID POSITIONS.
' FG% AND BG% ARE THE NORMAL FORGROUND AND BACKGROUND COLORS, AND IN
' INVERSE VIDEO THEY WILL BE REVERSED.
' ESC ENDS PROGRAM, BACKSPACE, CURSOR RIGHT, LEFT ALLOWS OVERWRITING
' IF Shift Tab IS PRESSED, ROWX% IS SET TO 51 AS SIGNAL TO CALLING PGM
' IF ROWX% < 0 THEN VAR$ IS PUT INTO FIELD, BUT NO INPUT IS EXPECTED
' IF COLX% < 0 THEN VAR$ IS PUT INTO FIELD, BUT MAY BE MODIFIED
'-----------------------------------------------------------------------
ROW% = ABS(ROWX%)
COL% = ABS(COLX%)
LOCATE ROW%, COL%, 1
COLOR BG%, FG%
101 IF ROWX% < 0 THEN
PRINT VAR$
COLOR FG%, BG%
EXIT SUB
END IF
IF COLX% < 0 THEN
PRINT VAR$;
LOCATE ROW%, COL%, 1
END IF
FOR J = 1 TO WID%
401 I$ = INKEY$: IF I$ = "" THEN 401
IF I$ = CHR$(27) THEN
COLOR FG%, BG%
CLS
END
END IF
IA = ASC(RIGHT$(I$, 1))
L = LEN(I$)
IF J > 1 AND ((L = 2 AND IA = 75) OR I$ = CHR$(8)) THEN ' BACKSPACE
J = J - 1
LOCATE CSRLIN, POS(0) - 1, 1
GOTO 401
END IF
IF J < WID% AND L = 2 AND IA = 77 THEN ' CURSOR RIGHT
J = J + 1
LOCATE CSRLIN, POS(0) + 1, 1
GOTO 401
END IF
IF L = 2 AND IA = 15 THEN ' SHIFT TAB
ROWX% = 51
GOTO 901
END IF
IF L = 2 AND IA = 71 THEN ' HOME
J = 1
LOCATE CSRLIN, COL%, 1
GOTO 401
END IF
IF L = 2 AND IA = 79 THEN ' END
J = WID%
LOCATE CSRLIN, COL% - 1 + WID%, 1
GOTO 401
END IF
IF I$ = CHR$(13) OR I$ = CHR$(9) THEN GOTO 901
IF L = 2 AND (IA = 75 OR IA = 77) THEN
BEEP
LOCATE CSRLIN, POS(0), 1
GOTO 401
END IF
PRINT I$;
NEXT J
901 I$ = ""
FOR J = COL% TO COL% - 1 + WID%
I$ = I$ + CHR$(SCREEN(ROW%, J))
NEXT
VAR$ = I$
COLOR FG%, BG%
END SUB
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/