home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / qb_pds / baswiz / ansi.bas < prev    next >
BASIC Source File  |  1991-03-31  |  6KB  |  190 lines
  1. '   +----------------------------------------------------------------------+
  2. '   |                                                                      |
  3. '   |        BASWIZ  Copyright (c) 1990-1991  Thomas G. Hanlin III         |
  4. '   |                                                                      |
  5. '   |                      The BASIC Wizard's Library                      |
  6. '   |                                                                      |
  7. '   +----------------------------------------------------------------------+
  8.  
  9. '  This is a subroutine to display to a window which handles ANSI display
  10. '  codes.  Put it directly in your program or use REM $INCLUDE: 'ANSI.BAS'
  11. '  to include it.  The variable Win% should be set to the window handle; the
  12. '  virtual screen corresponding to the window must be at least 80 columns by
  13. '  25 rows.  Set St$ to the string to display, then GOSUB ANSIprint to handle
  14. '  it.  Use Music% = 0 for no sound, or Music% = -1 to allow music through.
  15. '  If using music, you are advised to have an ON ERROR handler in case a
  16. '  defective music command slips through.
  17.  
  18.    END           ' for safety's sake
  19.  
  20. ANSIprint:
  21.    FOR disp0% = 1 TO LEN(St$)
  22.       ch0$ = MID$(St$, disp0%, 1)
  23.       GOSUB AP0
  24.    NEXT
  25.    WUpdate
  26.    RETURN
  27.  
  28. AP0:
  29.    IF ANSIcode0% THEN
  30.       IF LEFT$(ANSIst0$, 2) = "[M" THEN
  31.          IF ASC(ch0$) = 14 THEN
  32.             IF Music% THEN PLAY "MB" + MID$(ANSIst0$, 4)
  33.             ANSIst0$ = ""
  34.             ANSIcode0% = 0
  35.          ELSE
  36.             ANSIst0$ = ANSIst0$ + ch0$
  37.          END IF
  38.       ELSEIF INSTR("ABCDEFGHIJKLMNOPQRSTUVWXYZ", UCASE$(ch0$)) THEN
  39.          SELECT CASE ch0$
  40.             CASE "A": GOSUB CursorUp0
  41.             CASE "B": GOSUB CursorDown0
  42.             CASE "C": GOSUB CursorRight0
  43.             CASE "D": GOSUB CursorLeft0
  44.             CASE "H", "f": GOSUB CursorLocate0
  45.             CASE "s": GOSUB SaveCursorPosn0
  46.             CASE "u": GOSUB RestCursorPosn0
  47.             CASE "J": GOSUB BigErase0
  48.             CASE "K": GOSUB SmallErase0
  49.             CASE "h", "l": REM  set display mode... ignored
  50.             CASE "m": GOSUB SetColors0
  51.             CASE ELSE
  52.                WWrite Win%, ANSIst0$
  53.                ANSIcode0% = 0
  54.                ANSIst0$ = ""
  55.          END SELECT
  56.          ANSIst0$ = ""
  57.          ANSIcode0% = 0
  58.       ELSEIF ASC(ch0$) <= 32 OR LEN(ANSIst0$) > 60 THEN
  59.          WWrite Win%, ANSIst0$
  60.          ANSIcode0% = 0
  61.          ANSIst0$ = ""
  62.       ELSE
  63.          ANSIst0$ = ANSIst0$ + ch0$
  64.       END IF
  65.    ELSEIF ASC(ch0$) = 27 THEN
  66.       ANSIcode0% = -1
  67.       ANSIst0$ = ""
  68.    ELSE
  69.       WWrite Win%, ch0$
  70.    END IF
  71.    RETURN
  72.  
  73. CursorUp0:
  74.    Tmp0% = VAL(MID$(ANSIst0$, 2))
  75.    IF Tmp0% < 1 THEN Tmp0% = 1
  76.    WGetLocate Win%, Row0%, Col0%
  77.    Row0% = Row0% - Tmp0%
  78.    IF Row0% < 1 THEN Row0% = 1
  79.    WLocate Win%, Row0%, Col0%
  80.    RETURN
  81.  
  82. CursorDown0:
  83.    Tmp0% = VAL(MID$(ANSIst0$, 2))
  84.    IF Tmp0% < 1 THEN Tmp0% = 1
  85.    WGetLocate Win%, Row0%, Col0%
  86.    Row0% = Row0% + Tmp0%
  87.    IF Row0% > 25 THEN Row0% = 25
  88.    WLocate Win%, Row0%, Col0%
  89.    RETURN
  90.  
  91. CursorLeft0:
  92.    Tmp0% = VAL(MID$(ANSIst0$, 2))
  93.    IF Tmp0% < 1 THEN Tmp0% = 1
  94.    WGetLocate Win%, Row0%, Col0%
  95.    Col0% = Col0% - Tmp0%
  96.    IF Col0% < 1 THEN Col0% = 1
  97.    WLocate Win%, Row0%, Col0%
  98.    RETURN
  99.  
  100. CursorRight0:
  101.    Tmp0% = VAL(MID$(ANSIst0$, 2))
  102.    IF Tmp0% < 1 THEN Tmp0% = 1
  103.    WGetLocate Win%, Row0%, Col0%
  104.    Col0% = Col0% + Tmp0%
  105.    IF Col0% > 80 THEN Col0% = 80
  106.    WLocate Win%, Row0%, Col0%
  107.    RETURN
  108.  
  109. CursorLocate0:
  110.    Row0% = VAL(MID$(ANSIst0$, 2))
  111.    Tmp0% = INSTR(ANSIst0$, ";")
  112.    IF Tmp0% THEN
  113.       Col0% = VAL(MID$(ANSIst0$, Tmp0% + 1))
  114.    ELSE
  115.       Col0% = 1
  116.    END IF
  117.    IF Row0% < 1 THEN
  118.       Row0% = 1
  119.    ELSEIF Row0% > 25 THEN
  120.       Row0% = 25
  121.    END IF
  122.    IF Col0% < 1 THEN
  123.       Col0% = 1
  124.    ELSEIF Col0% > 80 THEN
  125.       Col0% = 80
  126.    END IF
  127.    WLocate Win%, Row0%, Col0%
  128.    RETURN
  129.  
  130. SaveCursorPosn0:
  131.    WGetLocate Win%, SaveRow0%, SaveCol0%
  132.    RETURN
  133.  
  134. RestCursorPosn0:
  135.    IF SaveRow0% > 0 THEN
  136.       WLocate Win%, SaveRow0%, SaveCol0%
  137.    END IF
  138.    RETURN
  139.  
  140. BigErase0:
  141.    WClear Win%
  142.    WLocate Win%, 1, 1
  143.    RETURN
  144.  
  145. SmallErase0:
  146.    WGetLocate Win%, Row0%, Col0%
  147.    WWrite Win%, SPACE$(80 - Col0%)
  148.    WLocate Win%, Row0%, Col0%
  149.    RETURN
  150.  
  151. SetColors0:
  152.    ANSIst0$ = MID$(ANSIst0$, 2)
  153.    WGetColor Win%, Fore0%, Back0%
  154.    DO WHILE LEN(ANSIst0$)
  155.       Tmp0% = VAL(ANSIst0$)
  156.       SELECT CASE Tmp0%
  157.          CASE 0: Fore0% = 7: Back0% = 0             ' reset colors
  158.          CASE 1: Fore0% = (Fore0% OR 8)             ' high intensity
  159.          CASE 2: Fore0% = (Fore0% AND &H17)         ' normal intensity
  160.          CASE 5: Fore0% = (Fore0% OR 16)            ' blink
  161.          CASE 7: Fore0% = 0: Back0% = 7             ' reverse video
  162.          CASE 8: Fore0% = 0: Back0% = 0             ' invisible
  163.          CASE 30: Fore0% = (Fore0% AND &H18)        ' black foreground
  164.          CASE 31: Fore0% = (Fore0% AND &H18) OR 4   ' red foreground
  165.          CASE 32: Fore0% = (Fore0% AND &H18) OR 2   ' green foreground
  166.          CASE 33: Fore0% = (Fore0% AND &H18) OR 6   ' yellow foreground
  167.          CASE 34: Fore0% = (Fore0% AND &H18) OR 1   ' blue foreground
  168.          CASE 35: Fore0% = (Fore0% AND &H18) OR 5   ' magenta foreground
  169.          CASE 36: Fore0% = (Fore0% AND &H18) OR 3   ' cyan foreground
  170.          CASE 37: Fore0% = (Fore0% OR 7)            ' white foreground
  171.          CASE 40: Back0% = 0                        ' black background
  172.          CASE 41: Back0% = 4                        ' red background
  173.          CASE 42: Back0% = 2                        ' green background
  174.          CASE 44: Back0% = 6                        ' yellow background
  175.          CASE 44: Back0% = 1                        ' blue background
  176.          CASE 45: Back0% = 5                        ' magenta background
  177.          CASE 46: Back0% = 3                        ' cyan background
  178.          CASE 47: Back0% = 7                        ' white background
  179.          CASE ELSE                                  ' ignore anything weird
  180.       END SELECT
  181.       Tmp0% = INSTR(ANSIst0$, ";")
  182.       IF Tmp0% THEN
  183.          ANSIst0$ = MID$(ANSIst0$, Tmp0% + 1)
  184.       ELSE
  185.          ANSIst0$ = ""
  186.       END IF
  187.    LOOP
  188.    WColor Win%, Fore0%, Back0%
  189.    RETURN
  190.