pocal 2/3

 BBS: Inland Empire Archive
Date: 04-01-93 (00:12)             Number: 260
From: SCOTT BAILEY                 Refer#: NONE
  To: PAUL CRUTCHFIELD              Recvd: NO  
Subj: pocal 2/3                      Conf: (2) Quik_Bas

'Continued
SUB getkeys (hm%, pare$)
'------
'hm%=# of chars to ask for
'pare$=accepted chars ("" for any char)
'------
A$ = ""
back:
DO
  DO
    temp$ = INKEY$
    IF LEN(temp$) THEN EXIT DO   'local key pressed
  LOOP UNTIL LOC(modem) > 0      'chars waiting?
  IF temp$ = "" THEN             'if no local keys pressed then
    temp$ = INPUT$(LOC(modem), 1)'take all remote chars so no overflow
    temp$ = LEFT$(temp$, 1)      'accept only 1st char
  END IF
  IF temp$ = CHR$(13) AND INSTR(pare$, CHR$(13)) THEN 'CR valid?
    A$ = A$ + CHR$(13)
    EXIT SUB
  END IF
  IF temp$ = CHR$(8) AND LEN(A$) = 0 THEN GOTO back 'a$ empty-can't backup
  IF temp$ = CHR$(13) AND LEN(A$) = 0 THEN GOTO back'a$ empty-CR not valid
  IF temp$ = CHR$(13) AND LEN(A$) > 0 THEN EXIT SUB 'a$ not empty-CR exits
  IF temp$ = CHR$(8) THEN               'backspace char
      A$ = LEFT$(A$, LEN(A$) - 1)       'shorten a$
      'pocal CHR$(27) + "[D " + CHR$(27) + "[D", 0, 1 'ANSI backspace
      pocal CHR$(8) + " " + CHR$(8), 0, 1 'backspace
      GOTO back
  END IF
  IF pare$ <> "" THEN            'any keys to look for?
    temp$ = UCASE$(temp$)        'yes, change params to uppercase(if any)
    il% = INSTR(pare$, temp$)    'check if key is in pare$
    IF il% = 0 THEN A$ = "": GOTO back  'nope, get another char
  END IF
A$ = A$ + temp$
pocal temp$, 0, 1           'print locally and to modem with no CR or LF
IF LEN(A$) >= hm% THEN EXIT SUB 'reached max length so exit
LOOP
END SUB

SUB pocal (text$, y%, Z%)
'text$=text to send
'y%=add CR+LF (0=NO or 1=YES)
'Z%=Send to modem(0=NO or 1=YES)
SHARED hm%
FOR count = 1 TO LEN(text$) STEP 4 'shortest command is 4 chars so we
    ps = INSTR(text$, "@black")    'won't miss any if we
    IF ps > 0 THEN                 'step through for speed
        text$ = LEFT$(text$, ps - 1)
        rtext$ = MID$(text$, ps + 6)
        A = 0: f = 30: b = 40
        GOSUB ansi
    END IF
    ps = INSTR(text$, "@red")
    IF ps > 0 THEN
        rtext$ = MID$(text$, ps + 4)
        text$ = LEFT$(text$, ps - 1)
        A = 0: f = 31: b = 40
        GOSUB ansi
    END IF
    ps = INSTR(text$, "@green")
    IF ps > 0 THEN
        rtext$ = MID$(text$, ps + 6)
        text$ = LEFT$(text$, ps - 1)
        A = 0: f = 32: b = 40
        GOSUB ansi
    END IF
    ps = INSTR(text$, "@yellow")
    IF ps > 0 THEN
        rtext$ = MID$(text$, ps + 7)
        text$ = LEFT$(text$, ps - 1)
        A = 0: f = 33: b = 40
        GOSUB ansi
    END IF
    ps = INSTR(text$, "@blue")
    IF ps > 0 THEN
        rtext$ = MID$(text$, ps + 5)
        text$ = LEFT$(text$, ps - 1)
'Continued next message


--- DLG Pro v0.995/DLGMail
 * Origin: Computer Answers, Prince Albert, Sask., Canada (1:140/601)