home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib29b.dsk / CHAR.ED.bas < prev    next >
BASIC Source File  |  2023-02-26  |  12KB  |  151 lines
  1. 10  REM  **********************
  2. 20  REM  * CHAR.ED            *
  3. 30  REM  * BY DOUG HENNIG     *
  4. 40  REM  * COPYRIGHT (C) 1986 *
  5. 50  REM  * BY MICROSPARC, INC.*
  6. 60  REM  * CONCORD, MA  01742 *
  7. 70  REM  **********************
  8. 80  HIMEM: 34816
  9. 90  ONERR  GOTO 1410
  10. 100  REM  -- SETUP VARIABLES --
  11. 110  TEXT : PRINT  CHR$(4)"BLOAD NORMAL.SET": PRINT  CHR$(4)"BLOAD CHAR.GEN": CALL 35840:EF = 1
  12. 120  IF  PEEK(48896) = 76  THEN  PRINT  CHR$(4)"PR#A$8DC1": PRINT  CHR$(4)"IN#A$8ECA"
  13. 130  DIM CHAR(7,7),SET$(5,2):E2 = 0: IF  PEEK(64435) = 6  THEN E2 = 1
  14. 140 SET =  PEEK(7):TABLE =  PEEK(6) +256 *SET
  15. 150 SET$(1,1) =  CHR$(33) + CHR$(34) + CHR$(35) + CHR$(36) + CHR$(37) + CHR$(38) + CHR$(39) + CHR$(40) + CHR$(41) + CHR$(32) + CHR$(42) + CHR$(61)
  16. 160 SET$(1,2) =  CHR$(49) + CHR$(50) + CHR$(51) + CHR$(52) + CHR$(53) + CHR$(54) + CHR$(55) + CHR$(56) + CHR$(57) + CHR$(48) + CHR$(58) + CHR$(45)
  17. 170 SET$(2,1) =  CHR$(81) + CHR$(87) + CHR$(69) + CHR$(82) + CHR$(84) + CHR$(89) + CHR$(85) + CHR$(73) + CHR$(79) + CHR$(80) + CHR$(123) + CHR$(125) + CHR$(124)
  18. 180 SET$(2,2) =  CHR$(113) + CHR$(119) + CHR$(101) + CHR$(114) + CHR$(116) + CHR$(121) + CHR$(117) + CHR$(105) + CHR$(111) + CHR$(112) + CHR$(91) + CHR$(93) + CHR$(92)
  19. 190 SET$(3,1) =  CHR$(65) + CHR$(83) + CHR$(68) + CHR$(70) + CHR$(71) + CHR$(72) + CHR$(74) + CHR$(75) + CHR$(76) + CHR$(58) + CHR$(34) + CHR$(32)
  20. 200 SET$(3,2) =  CHR$(97) + CHR$(115) + CHR$(100) + CHR$(102) + CHR$(103) + CHR$(104) + CHR$(106) + CHR$(107) + CHR$(108) + CHR$(59) + CHR$(39) + CHR$(32)
  21. 210 SET$(4,1) =  CHR$(90) + CHR$(88) + CHR$(67) + CHR$(86) + CHR$(66) + CHR$(78) + CHR$(77) + CHR$(60) + CHR$(62) + CHR$(63)
  22. 220 SET$(4,2) =  CHR$(122) + CHR$(120) + CHR$(99) + CHR$(118) + CHR$(98) + CHR$(110) + CHR$(109) + CHR$(44) + CHR$(46) + CHR$(47)
  23. 230  IF E2 = 0  THEN SET$(3,1) =  LEFT$(SET$(3,1),9) + CHR$(43) + CHR$(32) + CHR$(32) + CHR$(32):SET$(3,2) =  LEFT$(SET$(3,2),10) + CHR$(32) + CHR$(32) + CHR$(32):SET$(2,1) =  LEFT$(SET$(2,1),10) + CHR$(95) + CHR$(64) + CHR$(94)
  24. 240  IF E2 = 1  THEN SET$(1,2) =  CHR$(49) + CHR$(50) + CHR$(51) + CHR$(52) + CHR$(53) + CHR$(54) + CHR$(55) + CHR$(56) + CHR$(57) + CHR$(48) + CHR$(45) + CHR$(61)
  25. 250  IF E2 = 1  THEN SET$(1,1) =  CHR$(33) + CHR$(64) + CHR$(35) + CHR$(36) + CHR$(37) + CHR$(94) + CHR$(38) + CHR$(42) + CHR$(40) + CHR$(41) + CHR$(95) + CHR$(43)
  26. 260  REM  -- SET UP MENU --
  27. 270  HCOLOR= 3: HPLOT 0,7 TO 0,191 TO 279,191 TO 279,7 TO 0,7: & WINDOW(1,2 TO 38,22)
  28. 280  VTAB 10: HTAB 10: PRINT "CHARACTER SET EDITOR": PRINT : HTAB 13: PRINT "BY DOUG HENNIG": HTAB 14: PRINT : HTAB 2: PRINT "COPYRIGHT 1986 BY MICROSPARC, INC."
  29. 290  VTAB 22: GOSUB 1300
  30. 300  & WINDOW(0,0 TO 39,23): &  HOME : VTAB 1: INVERSE : PRINT  TAB( 11)"CHARACTER SET EDITOR" TAB( 41): & WINDOW(1,2 TO 38,22): NORMAL : HPLOT 0,0 TO 0,8
  31. 310  &  HOME : VTAB 5: PRINT "YOUR OPTIONS ARE:": PRINT : PRINT 
  32. 320  HTAB 8: INVERSE : PRINT "E";: NORMAL : PRINT "DIT CHARACTER SETS": PRINT : HTAB 8: INVERSE : PRINT "S";: NORMAL : PRINT "AVE CHARACTER PACKAGE"
  33. 330  PRINT : HTAB 8: INVERSE : PRINT "L";: NORMAL : PRINT "OAD CHARACTER PACKAGE"
  34. 340  PRINT : HTAB 8: INVERSE : PRINT "Q";: NORMAL : PRINT "UIT": PRINT : HTAB 8: INVERSE : PRINT "H";: NORMAL : PRINT "ELP"
  35. 350  PRINT : INVERSE : HTAB 8: PRINT "C";: NORMAL : PRINT "ATALOG DISK": PRINT : PRINT "YOUR SELECTION: ";
  36. 360  REM  -- GET DESIRED FUNCTION --
  37. 370  POKE 24,255: GET A$
  38. 380 KEY = (A$ = "E"  OR A$ =  CHR$(101)) +2 *(A$ = "S"  OR A$ =  CHR$(115)) +3 *(A$ = "Q"  OR A$ =  CHR$(113)) +5 *(A$ = "H"  OR A$ =  CHR$(104)) +4 *(A$ = "L"  OR A$ =  CHR$(108)) +6 *(A$ = "C"  OR A$ =  CHR$(99))
  39. 390  ON KEY GOTO 420,820,850,900,930,1020
  40. 400  GOTO 370
  41. 410  REM  -- EDIT CHARACTER MODE --
  42. 420  &  HOME 
  43. 430  & WINDOW(1,2 TO 38,22)
  44. 440  HPLOT 24,29 TO 192,29 TO 192,50 TO 24,50 TO 24,29: FOR I = 1 TO 11:A = I *14 +24: HPLOT A,29 TO A,50: NEXT I
  45. 450  HPLOT 24,53 TO 206,53 TO 206,74 TO 24,74 TO 24,53: FOR I = 1 TO 12:A = I *14 +24: HPLOT A,53 TO A,74: NEXT I
  46. 460  HPLOT 24,77 TO 164,77 TO 164,98 TO 24,98 TO 24,77: FOR I = 1 TO 9:A = I *14 +24: HPLOT A,77 TO A,98: NEXT I: IF E2 = 1  THEN  HPLOT 24,77 TO 178,77 TO 178,98 TO 24,98 TO 24,77
  47. 470  HPLOT 24,101 TO 164,101 TO 164,122 TO 24,122 TO 24,101: FOR I = 1 TO 9:A = I *14 +24: HPLOT A,101 TO A,122: NEXT I: IF E2 = 1  THEN  HPLOT 8,101 TO 22,101 TO 22,122 TO 8,122 TO 8,101
  48. 480  POKE 7,SET: FOR I = 1 TO 12: VTAB 5: HTAB I *2 +2: PRINT  MID$ (SET$(1,1),I,1);: VTAB 6: HTAB I *2 +2: PRINT  MID$ (SET$(1,2),I,1);: NEXT I
  49. 490  FOR J = 2 TO 4: FOR I = 1 TO 13: VTAB J *3 +2: HTAB I *2 +2: PRINT  MID$ (SET$(J,1),I,1);: VTAB J *3 +3: HTAB I *2 +2: PRINT  MID$ (SET$(J,2),I,1);: NEXT I: NEXT J
  50. 500  IF E2 = 1  THEN  VTAB 14: HTAB 2: PRINT  CHR$(126);: VTAB 15: HTAB 2: PRINT  CHR$(96);
  51. 510  POKE 7,144: IF E2 = 0  THEN  VTAB 8: HTAB 30: PRINT "O P N";: VTAB 9: HTAB 30: PRINT "K M L";
  52. 520  & WINDOW(1,16 TO 38,22): VTAB 17: HTAB 1: PRINT "CTRL-D = DUPLICATE CHAR": PRINT "CTRL-E = EXCHANGE CHARS"
  53. 530  PRINT "CTRL-X = CHANGE CHAR SET": PRINT "CTRL-Q = RETURN TO MENU": PRINT : PRINT : PRINT "EDIT CHARACTER: ";
  54. 540  VTAB 23: HTAB 17: PRINT " ";: HTAB 17: POKE 24,0: GET CHAR$: IF CHAR$ =  CHR$(17)  THEN  & WINDOW(1,2 TO 38,22): GOTO 310
  55. 550  IF CHAR$ =  CHR$(13)  OR CHAR$ = " "  THEN 540
  56. 560  IF CHAR$ =  CHR$(27)  THEN OFF =  -32: GOTO 540
  57. 570  IF CHAR$ =  CHR$(4)  THEN 630
  58. 580  IF CHAR$ =  CHR$(5)  THEN 720
  59. 590  IF CHAR$ =  CHR$(24)  THEN SET = 291 -SET:TABLE =  PEEK(6) +256 *SET: GOTO 480
  60. 600  IF CHAR$ <" "  THEN 540
  61. 610 CHAR$ =  CHR$( ASC(CHAR$) +OFF):OFF = 0
  62. 620  POKE 7,SET: PRINT CHAR$;: POKE 7,144: GOSUB 1060: VTAB 18: HTAB 1: &  CLEAR P: GOTO 520
  63. 630  &  HOME : PRINT "CHAR TO DUPLICATE: ";
  64. 640  GET A$: POKE 7,SET: PRINT A$: POKE 7,144:C1$ = A$
  65. 650  PRINT "CHAR TO DUPLICATE IT AT: ";
  66. 660  GET A$: POKE 7,SET: PRINT A$: POKE 7,144:C2$ = A$
  67. 670  PRINT : PRINT "ARE YOU SURE ABOUT THIS (Y/N)? ";
  68. 680  POKE 24,255: GET A$: IF A$ < >"Y"  AND A$ < > CHR$(121)  AND A$ < >"N"  AND A$ < > CHR$(110)  THEN 680
  69. 690  POKE 24,0: IF A$ = "N"  OR A$ =  CHR$(110)  THEN 520
  70. 700 CHAR = TABLE +8 *( ASC(C1$) -32):C = TABLE +8 *( ASC(C2$) -32): FOR I = 0 TO 7: POKE C +I, PEEK(CHAR +I): NEXT 
  71. 710  GOTO 420
  72. 720  &  HOME : PRINT "FIRST CHAR TO EXCHANGE: ";
  73. 730  GET A$: POKE 7,SET: PRINT A$: POKE 7,144:C1$ = A$
  74. 740  PRINT "SECOND CHAR TO EXCHANGE: ";
  75. 750  GET A$: POKE 7,SET: PRINT A$: POKE 7,144:C2$ = A$
  76. 760  PRINT : PRINT "ARE YOU SURE ABOUT THIS (Y/N)? ";
  77. 770  POKE 24,255: POKE  -16368,0: GET A$: IF A$ < >"Y"  AND A$ < > CHR$(121)  AND A$ < > CHR$(110)  AND A$ < >"N"  THEN 770
  78. 780  POKE 24,0: IF A$ = "N"  OR A$ =  CHR$(110)  THEN 520
  79. 790 CHAR = TABLE +8 *( ASC(C1$) -32):C = TABLE +8 *( ASC(C2$) -32): FOR I = 0 TO 7:A =  PEEK(CHAR +I): POKE CHAR +I, PEEK(C +I): POKE C +I,A: NEXT 
  80. 800  GOTO 420
  81. 810  REM  -- SAVE PACKAGE MODE --
  82. 820  VTAB 3: HTAB 7: PRINT "- SAVE CHARACTER SET -": GOSUB 1340
  83. 830  PRINT  CHR$(4)"BSAVE"F$",A$9000,L$600": GOTO 310
  84. 840  REM  -- EXIT EDITOR --
  85. 850  &  HOME : VTAB 7: PRINT "ARE YOU SURE YOU WANT TO QUIT (Y/N)? ";: GET CH$: IF CH$ = "Y"  OR CH$ =  CHR$(121)  THEN 880
  86. 860  IF CH$ < >"N"  AND CH$ < > CHR$(110)  THEN  PRINT  CHR$(7);: GOTO 850
  87. 870  GOTO 310
  88. 880  PRINT : PRINT  CHR$(4)"PR#0": PRINT  CHR$(4)"IN#0": TEXT : HOME : END 
  89. 890  REM  -- LOAD PACKAGE --
  90. 900  VTAB 3: HTAB 7: PRINT "- LOAD CHARACTER SET -": GOSUB 1340:XX = 1
  91. 910  PRINT  CHR$(4)"BLOAD"F$",A$9000": GOTO 310
  92. 920  REM  -- HELP INSTRUCTIONS --
  93. 930  &  HOME : & WINDOW(1,1 TO 38,22): PRINT : PRINT 
  94. 940  PRINT "  To edit a character, press the key": PRINT "corresponding to that character. The": PRINT "character appears in inverse on": PRINT "the keyboard diagram and a grid that"
  95. 950  PRINT "shows the dots that make up the char-": PRINT "acter is drawn."
  96. 960  PRINT : PRINT "  Move the cursor about the grid with": PRINT "the I-J-K-M or arrow keys. To toggle": PRINT "the dot under the  cursor, press": PRINT "the <SPACE> bar. "
  97. 970  PRINT : PRINT "  To cancel the changes you have made": PRINT "to the character, press Q. To save ": PRINT "the changes press <RETURN>."
  98. 980  PRINT : GOSUB 1300: &  HOME 
  99. 990  PRINT : PRINT : PRINT " When you are finished editing the": PRINT "set you can return to the main menu": PRINT "by pressing CTRL-Q. You may then": PRINT "save your new character set on disk."
  100. 1000  PRINT "Press S, then enter the filename in": PRINT "uppercase.": PRINT : GOSUB 1300
  101. 1010  & WINDOW(0,1 TO 39,23): GOTO 310
  102. 1020  & WINDOW(0,1 TO 39,23)
  103. 1030  &  HOME : VTAB 7: PRINT "CATALOG WHICH DRIVE (1/2)?";: GET CH$:CH =  VAL(CH$): POKE  -16384,0: IF CH <1  OR CH >2  THEN 310
  104. 1040  &  HOME : PRINT : PRINT  CHR$(4) LEFT$("CATALOG",7 -4 *( PEEK(48896) = 76))",D"CH: GOSUB 1300: GOTO 310
  105. 1050  REM  -- EDIT A CHARACTER --
  106. 1060 A = 0:B = 0:C = 0: FOR I = 1 TO 4: FOR J = 1 TO 2: FOR K = 1 TO  LEN(SET$(I,J)): IF CHAR$ =  MID$ (SET$(I,J),K,1)  THEN A = I:B = J:C = K
  107. 1070  NEXT K: NEXT J: NEXT I:V1 = A *3 +2: IF B = 2  THEN V1 = V1 +1
  108. 1080 H1 = C *2 +2: IF CHAR$ =  CHR$(126)  THEN V1 = 14:H1 = 2:A = 1
  109. 1090  IF CHAR$ =  CHR$(96)  THEN V1 = 15:H1 = 2:A = 1
  110. 1100  IF A = 0  THEN  RETURN 
  111. 1110  VTAB V1: HTAB H1: POKE 7,SET: INVERSE : PRINT CHAR$;: NORMAL : POKE 7,144: &  HOME 
  112. 1120  VTAB 18: HTAB 1: PRINT : PRINT "Q = LEAVE CHAR UNCHANGED": PRINT "C = CLEAR GRID": PRINT "<SPACE> = CHANGE DOT": PRINT "<RETURN> = SAVE CHANGES"
  113. 1130  HPLOT 194,101 TO 260,101 TO 260,174 TO 194,174 TO 194,101
  114. 1140 CHAR = TABLE +8 *( ASC(CHAR$) -32): FOR I = 0 TO 7:A =  PEEK(CHAR +I)
  115. 1150  FOR BIT = 7 TO 0  STEP  -1:B = 2 ^BIT:C = A/B:CHAR(I,BIT) =  SGN( INT(C)):A = B *(C - INT(C)): NEXT BIT: NEXT I
  116. 1160  FOR ROW = 0 TO 7: VTAB 14 +ROW: HTAB 29: FOR COL = 0 TO 6:A$ = ".": IF CHAR(ROW,COL)  THEN A$ = "#"
  117. 1170  PRINT A$;: NEXT COL: NEXT ROW:V = 14:H = 29: FOR LOOP = 0 TO 1
  118. 1180  VTAB V: HTAB H: POKE 24,255: POKE  -16368,0: GET A$
  119. 1190 KEY = (A$ = "I"  OR A$ =  CHR$(105)  OR A$ =  CHR$(11)  OR A$ = "M"  OR A$ =  CHR$(109)  OR A$ =  CHR$(10)) +2 *(A$ = "J"  OR A$ =  CHR$(106)  OR A$ =  CHR$(8)  OR A$ = "K"  OR A$ =  CHR$(107)  OR A$ =  CHR$(21))
  120. 1200 KEY = KEY +3 *(A$ =  CHR$(13)) +4 *(A$ = "C"  OR A$ =  CHR$(99)) +5 *(A$ = "Q"  OR A$ =  CHR$(113)) +6 *(A$ = " "): REM  1 SPACE
  121. 1210  ON KEY GOSUB 1230,1240,1250,1270,1260,1280
  122. 1220 LOOP = (KEY < >0): NEXT LOOP: VTAB 13: FOR I = 1 TO 10: HTAB 26: PRINT "          ": NEXT : RETURN : REM  10 SPACES
  123. 1230 V = (V -1) *(A$ = "I"  OR A$ =  CHR$(105)  OR A$ =  CHR$(11)) +(V +1) *(A$ = "M"  OR A$ =  CHR$(109)  OR A$ =  CHR$(10)):V = 21 *(V <14) +14 *(V >21) +V *(V > = 14  AND V < = 21):KEY = 0: RETURN 
  124. 1240 H = (H -1) *(A$ = "J"  OR A$ =  CHR$(106)  OR A$ =  CHR$(8)) +(H +1) *(A$ = "K"  OR A$ =  CHR$(107)  OR A$ =  CHR$(21)):H = 35 *(H <29) +29 *(H >35) +H *(H > = 29  AND H < = 35):KEY = 0: RETURN 
  125. 1250  FOR ROW = 0 TO 7:P = 0: FOR COL = 0 TO 7:P = P +CHAR(ROW,COL) *2 ^COL: NEXT COL: POKE CHAR +ROW,P: NEXT ROW
  126. 1260  VTAB V1: HTAB H1: POKE 7,SET: PRINT CHAR$;: POKE 7,144: RETURN 
  127. 1270 A$ = ".": FOR ROW = 0 TO 7: VTAB ROW +14: FOR COL = 0 TO 6: HTAB COL +29:CHAR(ROW,COL) = 0: PRINT A$;: NEXT COL: NEXT ROW:KEY = 0: RETURN 
  128. 1280 A = V -14:B = H -29:CHAR(A,B) = 1 -CHAR(A,B):A$ = ".": IF CHAR(A,B)  THEN A$ = "#"
  129. 1290  PRINT A$;: HTAB H:KEY = 0: RETURN 
  130. 1300  HTAB 6: INVERSE : PRINT " PRESS <RETURN> TO CONTINUE ";: NORMAL 
  131. 1310 A =  PEEK(49152): IF A <128  THEN 1310
  132. 1320  POKE 49168,0: RETURN 
  133. 1330  REM  -- INPUT STRING --
  134. 1340  VTAB 5: &  CLEAR P: PRINT "FILE NAME: "F$;: HTAB 12
  135. 1350  POKE 24,255: &  INPUT (A$,25): IF A$ =  CHR$(27)  OR (A$ = ""  AND F$ = "")  THEN 310
  136. 1360  IF A$ = ""  THEN  VTAB 5: HTAB 12: PRINT F$: RETURN 
  137. 1370  IF  LEFT$(A$,1) <"A"  OR  LEFT$(A$,1) >"Z"  THEN 1400
  138. 1380  FOR I = 1 TO  LEN(A$):B$ =  MID$ (A$,I,1): IF B$ = ","  THEN I =  LEN(A$): NEXT : GOTO 1400
  139. 1390  NEXT :F$ = A$: RETURN 
  140. 1400  PRINT  CHR$(7): VTAB 5: HTAB 12: &  CLEAR P: GOTO 1350
  141. 1410 ER =  PEEK(222):EL =  PEEK(219) *256 + PEEK(218)
  142. 1420  PRINT  CHR$(4)"CLOSE"
  143. 1430  IF ER = 255  THEN  RESUME 
  144. 1440  IF   NOT EF  THEN  TEXT : HOME : GOTO 1460
  145. 1450  &  HOME 
  146. 1460  VTAB 10: IF ER = 6  THEN  PRINT "FILE NOT FOUND": GOTO 1500
  147. 1470  IF ER = 8  THEN  PRINT "I/O ERROR": GOTO 1500
  148. 1480  IF ER = 16  THEN  PRINT "SYNTAX ERROR IN LINE "EL: GOTO 1500
  149. 1490  PRINT "ERROR IN LINE "EL
  150. 1500  VTAB 22: PRINT "<ESC> TO QUIT, <RETURN> TO CONTINUE";: GET Z$: PRINT : ON Z$ =  CHR$(27) GOTO 1510: CALL  -3288: ON EF +1 GOTO 110,310
  151. 1510  HOME : END