home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib36b.dsk / TEXT.DEMO.bas < prev    next >
BASIC Source File  |  2023-02-26  |  5KB  |  115 lines
  1. 10  REM **********************
  2. 20  REM *     TEXT.DEMO      *
  3. 30  REM *   BY HOWARD HUANG  *
  4. 40  REM * COPYRIGHT (C) 1988 *
  5. 50  REM * BY MICROSPARC, INC *
  6. 60  REM * CONCORD, MA  01742 *
  7. 70  REM **********************
  8. 80  HOME : PRINT  CHR$(21);: LOMEM: 25088
  9. 90  FOR I = 768 TO 792: READ J: POKE I,J: NEXT : DATA  165,60,41,7,208,3,32,146,253,169,160,32,237,253,177,60,32,218,253,32,186,252,144,232,96
  10. 100  GOSUB 920: GOTO 350
  11. 110  HOME : VTAB 12: HTAB 8: INVERSE : PRINT "POKING TEXT INTO MEMORY": NORMAL 
  12. 120 LC = 0: FOR I = 1 TO  LEN(T$):A =  ASC( MID$ (T$,I,1)): IF A >96  THEN LC = 1
  13. 130  POKE ADR,A +128:ADR = ADR +1: NEXT : POKE ADR,0: RETURN 
  14. 140  REM 
  15. 150  REM ** POKE IN INFO **
  16. 160  REM 
  17. 170  POKE 8,BUF - INT(BUF/256) *256: POKE 9, INT(BUF/256)
  18. 180  POKE 6,COM - INT(COM/256) *256: POKE 7, INT(COM/256)
  19. 190  POKE 4,LC: RETURN 
  20. 200  REM 
  21. 210  REM ** COMPACT TEXT **
  22. 220  REM 
  23. 230  HOME : VTAB 12: HTAB 16: INVERSE : PRINT "CRUNCHING": NORMAL : GOSUB 170: CALL 24576: RETURN 
  24. 240  REM 
  25. 250  REM ** DECRUNCH TEXT **
  26. 260  REM 
  27. 270  HOME : VTAB 12: HTAB 15: INVERSE : PRINT "DECRUNCHING": NORMAL : GOSUB 170: CALL 24761: RETURN 
  28. 280  REM 
  29. 290  REM ** DUMP HEX **
  30. 300  REM 
  31. 310  POKE 60,A1: POKE 61,A2: POKE 62,A3: POKE 63,A4: CALL 768: RETURN 
  32. 320  REM 
  33. 330  REM ** MAIN PROGRAM **
  34. 340  REM 
  35. 350 MENU = 1: HOME : VTAB 9: FOR I = 1 TO 3: HTAB 8: PRINT I") "M$(I): NEXT 
  36. 360  VTAB 15: CALL  -958: HTAB 8: PRINT "YOUR CHOICE -->";: POKE  -16368,0: GET C$:CH =  VAL(C$): IF CH <1  OR CH >3  THEN 360
  37. 370  ON CH GOTO 430,500
  38. 380  TEXT : HOME : VTAB 23: END 
  39. 390 XX =  FRE(0): PRINT : PRINT : PRINT : HTAB 13: PRINT "PRESS <RETURN>";: POKE  -16368,0: GET A$: GOTO 350
  40. 400  REM 
  41. 410  REM ** COMPACT TEXT **
  42. 420  REM 
  43. 430 LM = 240: GOSUB 750:ADR = BUF: GOSUB 110
  44. 440  GOSUB 230
  45. 450  HOME : PRINT "PLEASE PRESS RETURN TO SEE THE": PRINT "UNCOMPACTED TEXT -->";: GET A$: PRINT 
  46. 460  GOSUB 670: PRINT 
  47. 470  PRINT : PRINT "PLEASE PRESS RETURN TO SEE THE": PRINT "COMPACTED TEXT -->";: GET A$: PRINT 
  48. 480  GOSUB 710:AC = 1:TX = 0: GOTO 390
  49. 490  REM 
  50. 500  IF AC < >1  AND TX < >1  THEN  HOME : VTAB 10: PRINT "YOU HAVEN'T COMPACTED ANYTHING, SO THEREIS NOTHING TO UNCOMPACT! PLEASE CHOOSE  ONE OF THE FIRST TWO OPTIONS BEFORE THISONE.": GOTO 390
  51. 510  GOSUB 270: GOSUB 670
  52. 520  PRINT : PRINT : HTAB 15: INVERSE : PRINT "PLEASE WAIT": NORMAL : PRINT : PRINT : PRINT 
  53. 530 T$ = "":ADR = BUF
  54. 540  IF TX = 1  THEN 580
  55. 550 T =  PEEK(ADR): IF T = 0  THEN 570
  56. 560 T$ = T$ + CHR$(T):ADR = ADR +1: GOTO 550
  57. 570  PRINT T$: GOTO 390
  58. 580 I = 1
  59. 590 A$(I) = ""
  60. 600 T =  PEEK(ADR): IF T = 0  THEN 630
  61. 610  IF T = 141  THEN I = I +1:ADR = ADR +1: GOTO 590
  62. 620 A$(I) = A$(I) + CHR$(T):ADR = ADR +1: GOTO 600
  63. 630  FOR J = 1 TO I -1: PRINT A$(J): NEXT : GOTO 390
  64. 640  REM 
  65. 650  REM ** PRINT ASCII **
  66. 660  REM 
  67. 670 A1 = BUF - INT(BUF/256) *256:A2 =  INT(BUF/256):A3 =  PEEK(8):A4 =  PEEK(9): GOSUB 310: RETURN 
  68. 680  REM 
  69. 690  REM ** PRINT CRUNCHED **
  70. 700  REM 
  71. 710 A1 = COM - INT(COM/256) *256:A2 =  INT(COM/256):A3 =  PEEK(6):A4 =  PEEK(7): GOSUB 310: RETURN 
  72. 720  REM 
  73. 730  REM ** INPUT ROUTINE **
  74. 740  REM 
  75. 750  HOME : VTAB 5
  76. 760  PRINT "PLEASE TYPE UP TO "LM" CHARACTERS."
  77. 770 T$ = "":CHAR = 0
  78. 780  GET A$:A =  ASC(A$): IF A < >13  THEN 810
  79. 790  IF  LEN(T$) = 0  THEN 780
  80. 800  RETURN 
  81. 810  IF A < >8  THEN 860
  82. 820  IF  LEN(T$) = 0  THEN  CALL 64477: GOTO 780
  83. 830  IF  LEN(T$) = 1  THEN T$ = "":CHAR = 0: GOTO 850
  84. 840 T$ =  LEFT$(T$, LEN(T$) -1):CHAR = CHAR -1
  85. 850  PRINT  CHR$(8)" " CHR$(8);: GOTO 780
  86. 860  IF A <32  THEN  CALL 64477: GOTO 780
  87. 870  IF CHAR = LM  THEN  CALL 64477: GOTO 780
  88. 880 T$ = T$ +A$:CHAR = CHAR +1: PRINT A$;: GOTO 780
  89. 890  REM 
  90. 900  REM ** SETUP PROGRAM **
  91. 910  REM 
  92. 920  ONERR  GOTO 1040
  93. 930  DIM A$(101):D$ =  CHR$(4):BUF = 8192:COM = 16384: FOR I = 1 TO 3: READ M$(I): NEXT 
  94. 940  TEXT : HOME : NORMAL :A$ = "NIBBLE TEXT CRUNCHER DEMONSTRATION":T$ = "** COPYRIGHT 1989 BY MICROSPARC, INC. **"
  95. 950  VTAB 10: HTAB 4: PRINT A$: VTAB 12: HTAB 13: PRINT "BY HOWARD HUANG": VTAB 15: PRINT T$: VTAB 23: HTAB 5: PRINT "<PLEASE PRESS RETURN TO CONTINUE>": WAIT  -16384,128: POKE  -16368,0
  96. 960  VTAB 23: CALL  -868: VTAB 12: CALL  -868: FOR I = 1 TO 8: VTAB 11 -I: CALL  -868: VTAB 10 -I: HTAB 4: PRINT A$: VTAB 14 +I: CALL  -868: VTAB 15 +I: PRINT T$;: NEXT 
  97. 970  POKE 34,3: POKE 35,21: HOME 
  98. 980  PRINT : PRINT D$"BLOAD TEXT.CRUNCH": PRINT D$"BLOAD TEXT.DECRUNCH"
  99. 990  HOME : RETURN 
  100. 1000  DATA  COMPRESS TEXT,UNCOMPRESS TEXT,QUIT
  101. 1010  REM 
  102. 1020  REM ** ONERR ROUTINE **
  103. 1030  REM 
  104. 1040 ER =  PEEK(222): IF ER = 4  THEN Z$ = "DISK IS WRITE PROTECTED."
  105. 1050  IF ER = 6  THEN Z$ = "CAN'T FIND DISK FILE.": TEXT : HOME : PRINT Z$: END 
  106. 1060  IF ER = 8  THEN Z$ = "DISK I/O ERROR."
  107. 1070  IF ER = 9  THEN Z$ = "NO MORE ROOM ON YOUR DISK."
  108. 1080  IF ER = 10  THEN Z$ = "THE DISK FILE IS LOCKED."
  109. 1090  IF ER <4  OR ER = 7  OR ER >10  THEN Z$ = "ERROR #" + STR$(ER) +" IN LINE " + STR$( PEEK(218) + PEEK(219) *256) +"."
  110. 1100  HOME : HTAB 17: INVERSE : PRINT "ERROR!": NORMAL : PRINT  CHR$(7) CHR$(7)
  111. 1110  VTAB 12: HTAB 21 - LEN(Z$)/2: PRINT Z$
  112. 1120  VTAB 19: CALL  -958: HTAB 9: PRINT "PRESS <SPACE> TO RETRY": IF MENU = 1  THEN  HTAB 15: PRINT "<ESC> FOR MENU"
  113. 1130  GET Z$: IF Z$ =  CHR$(32)  THEN  PRINT : HOME : RESUME 
  114. 1140  IF MENU = 1  AND Z$ =  CHR$(27)  THEN  CALL  -3288: PRINT : GOTO 350
  115. 1150  PRINT  CHR$(7);: GOTO 1120