Advertisement
LBASIC

ANSISHOW.BAS

Jun 6th, 2023
770
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
QBasic 2.93 KB | Software | 0 0
  1. ''''' -=*=--=*=--=*=-  begin CANSI.BAS  -=*=--=*=--=*=-
  2. DECLARE SUB ansi (a$)
  3. ON ERROR GOTO botched
  4. DEF SEG = &HB800: DIM SHARED SCR%(2): SCR%(1) = 80: SCR%(2) = 25
  5. WIDTH 80, 25: F$ = COMMAND$: COLOR 7, 0: CLS
  6. IF F$ = "" THEN INPUT "File to display"; F$
  7. OPEN F$ FOR INPUT AS #1
  8. WHILE NOT EOF(1): ansi (INPUT$(1, #1)): WEND: CLOSE #1
  9. fini: COLOR 2, 0: FOR S% = 5 TO 35: SOUND S% * 200, .1: NEXT
  10.    R$ = "": WHILE R$ = "": R$ = INKEY$: WEND: END
  11. botched: COLOR 2, 0
  12.    PRINT "file "; CHR$(34); F$; CHR$(34); " not found"
  13.    PRINT "error"; ERR: RESUME fini
  14. ''''' -=*=--=*=--=*=-  end CANSI.BAS  -=*=--=*=--=*=-
  15.  
  16. SUB ansi (a$)
  17. DEFINT A-Z: STATIC H, W, R, E, L, C, F, B, O, V, E$
  18. IF W < 40 THEN W = SCR%(1): H = SCR%(2) - 1: R = W - 1: C = 0: F = 7: B = 0
  19. IF E <> 27 THEN
  20.    IF ASC(a$) <> 27 THEN GOSUB CHRout:  ELSE E = 27: E$ = a$
  21.    EXIT SUB
  22. END IF
  23. IF O <> 27 AND ASC(a$) = 34 THEN O = E: EXIT SUB
  24. IF O = 27 THEN
  25.    IF ASC(a$) = 34 THEN O = 0
  26.    EXIT SUB
  27. END IF: E$ = E$ + a$
  28. IF LEN(E$) = 2 AND a$ <> "[" THEN E = 0: E$ = "": EXIT SUB
  29. S = INSTR("HfABCDsuJKmhlp", a$)
  30. SELECT CASE S
  31.   CASE 0: EXIT SUB
  32.   CASE 1: GOSUB CursorA
  33.   CASE 2: GOSUB CursorA
  34.   CASE 3: L = -1: GOSUB CursorL
  35.   CASE 4: L = 1: GOSUB CursorL
  36.   CASE 5: L = 1: GOSUB CursorC
  37.   CASE 6: L = -1: GOSUB CursorC
  38.   CASE 7: V = C
  39.   CASE 8: C = V
  40.   CASE 9: CLS : C = 0
  41.   CASE 10: L = C: WHILE L MOD W <> 0: POKE L * 2, 32: L = L + 1: WEND
  42.   CASE 11: GOSUB Colorz
  43. END SELECT: E% = 0: E$ = "": EXIT SUB
  44. CursorA: L = VAL(MID$(E$, INSTR(E$, "[") + 1)) - 1
  45.    C = VAL(MID$(E$, INSTR(E$, ";") + 1)) - 1
  46.    IF C < 0 THEN C = 0:  ELSE IF C > R THEN C = R
  47.    IF L < 1 THEN L = 0:  ELSE IF L > H THEN L = H
  48.    C = L * W + C: RETURN
  49. CursorL: P = VAL(MID$(E$, INSTR(E$, "[") + 1)): IF P < 1 THEN P = 1
  50.    L = INT(C / W) + P * L
  51.    IF L < 0 THEN L = 0:  ELSE IF L > H THEN L = H
  52.    C = (C MOD W) + L * W: RETURN
  53. CursorC: P = VAL(MID$(E$, INSTR(E$, "[") + 1)): IF P < 1 THEN P = 1
  54.    L = (C MOD W) + P * L: C = INT(C / W) * W
  55.    IF L < 1 THEN L = 0:  ELSE IF L > R THEN L = R
  56.    C = C + L: RETURN
  57. Colorz: E$ = MID$(E$, INSTR(E$, "[") + 1)
  58.   DO: E = VAL(E$)
  59.   SELECT CASE E
  60.      CASE 0: F = 7: B = 0
  61.      CASE 1: F = (F AND 7) OR 8
  62.      CASE 5: B = (B AND 7) OR 8
  63.      CASE 8: F = B
  64.      CASE 30 TO 37: P = E - 29: E = ASC(MID$("@DBFAECG", P)) AND 7
  65.                     F = (F AND 248) OR E
  66.      CASE 40 TO 47: P = E% - 39: E = ASC(MID$("@DBFAECG", P)) AND 7
  67.                     B = (B AND 248) OR E
  68.   END SELECT: P = INSTR(E$, ";"): E$ = MID$(E$, P + 1): LOOP WHILE P > 0
  69. COLOR F, B: RETURN
  70. CHRout: P = ASC(a$)
  71.    IF P = 7 THEN BEEP: RETURN
  72.    IF P = 13 THEN C = C - C MOD W: RETURN
  73.    IF P = 10 THEN C = C + W
  74.    IF P <> 10 THEN POKE C * 2, P: POKE C * 2 + 1, F + 16 * B: C = C + 1
  75.    IF C >= W * (H + 1) THEN
  76.       C = C - W: LOCATE H + 1, W: PRINT
  77.       P = W * 2: L = (H - 1) * P
  78.       FOR L = L TO L + P: POKE L, PEEK(L + P): POKE L + P, B: NEXT
  79.    END IF
  80.    RETURN
  81. END SUB
  82.  
  83.  
Tags: qbasic
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement