home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / MADTRB05.ZIP / FONTEDIT.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1984-09-17  |  7.4 KB  |  179 lines
  1. 10  DIM M%(7)
  2. 20  'Fontedit.bas        A character editor for downloading character sets
  3. 30  '                    for the Okidata Microline 93
  4. 40  '                    modified by Neil J. Rubenking,  April 1984
  5. 50  GOSUB 890            'Initialize and set up function keys
  6. 60  GOSUB 530            'Clear screen and label character matrix
  7. 70  LINE INPUT ED$       'This statement is the character editor!
  8. 80  GOSUB 100            'When <return> is hit, get new menu
  9. 90  GOTO 70              'Return to editing
  10. 100  '--------------------------------------------------------------------------
  11. 110  'Subroutine to generate the options menu
  12. 120  '--------------------------------------------------------------------------
  13. 130  LOCATE 22,1: COLOR 0,7
  14. 140  PRINT"F1:  SAVE redefinition to file        F2:  CLEAR the matrix         "
  15. 150  PRINT"F3:  EXIT fontedit                    F4:  TEST character on printer"
  16. 160  PRINT"F5:  CONTINUE editing matrix          F6:  LOOK UP matrix in ROM    ";
  17. 170  COLOR 7,0
  18. 180  LOCATE 1,1:  INPUT"Press a function key:  ",F$
  19. 190  IF F$="SAVE"                THEN GOSUB 260 : GOTO 250
  20. 200  IF F$="CLEAR"               THEN GOSUB 530 : RETURN
  21. 210  IF F$="EXIT"                THEN GOTO 1680
  22. 220  IF F$="TEST"                THEN GOSUB 740 : GOTO 250
  23. 230  IF F$="CONTINUE"            THEN GOSUB 650 : RETURN
  24. 240  IF F$="LOOKUP"              THEN GOSUB 1410: RETURN
  25. 250  FOR R=1 TO 2: LOCATE R,1: PRINT SPACE$(70);:NEXT: GOTO 180
  26. 260  '--------------------------------------------------------------------------
  27. 270  'Subrouting to read the screen and write to file.  (SAVE option)
  28. 280  '--------------------------------------------------------------------------
  29. 290  LOCATE 1,1: PRINT SPACE$(70);:LOCATE 1,1
  30. 300  INPUT "Save redefinition for what character?:  ",C$
  31. 310  INPUT "Descender  (Y/N)?  ",DES$
  32. 320  DESC$ = "chr$(65)"
  33. 330  IF (DES$ = "Y") OR (DES$ = "y") THEN DESC$ = "chr$(68)"
  34. 340  OPEN FIL$ FOR APPEND AS #1
  35. 350  PRINT #1, LINENUM;" Rem--Redefines ";C$: LINENUM = LINENUM + 10
  36. 360  PRINT #1, LINENUM;
  37. 370  PRINT #1, "Lprint chr$(27);chr$(37);";DESC$;";chr$(";ASC(C$);");"
  38. 380  LINENUM = LINENUM + 10: PRINT #1, LINENUM;" Lprint ";
  39. 390  'Alternate entry point to read screen--used for TEST option.
  40. 400  FOR SCRNLOC=1668 TO 1668+((MATCOLS-1)*2) STEP 2
  41. 410      CODE = 0
  42. 420      N = -1
  43. 430              FOR OFFSET = 0 TO (MATROWS*160) STEP 160
  44. 440                      N = N + 1
  45. 450                      IF PEEK(SCRNLOC+OFFSET)=220 THEN CODE = CODE+(2^N)
  46. 460              NEXT OFFSET
  47. 470      IF TEST=TRUE THEN LPRINT CHR$(CODE);: GOTO 490
  48. 480      PRINT #1, "chr$(";RIGHT$(STR$(CODE),LEN(STR$(CODE))-1);");";
  49. 490  NEXT SCRNLOC
  50. 500  IF TEST = FALSE THEN PRINT #1,: LINENUM = LINENUM + 10
  51. 510  CLOSE #1
  52. 520  RETURN
  53. 530  '--------------------------------------------------------------------------
  54. 540  'Subroutine to clear screen and label rows and columns (CLEAR option)
  55. 550  '--------------------------------------------------------------------------
  56. 560  CLS: LOCATE 9,35: PRINT LEFT$("12345678901",MATCOLS)
  57. 570  LOCATE 10,34
  58. 580  PRINT CHR$(201);:FOR I=1 TO MATCOLS:PRINT CHR$(205);:NEXT:PRINT CHR$(187)
  59. 590  FOR I = 11 TO 11+MATROWS-1
  60. 600      LOCATE I,31
  61. 610      PRINT I-10;CHR$(186);SPACE$(MATCOLS);CHR$(186)
  62. 620  NEXT I
  63. 630  LOCATE I,34
  64. 640  PRINT CHR$(200);:FOR I=1 TO MATCOLS:PRINT CHR$(205);:NEXT:PRINT CHR$(188)
  65. 650  'Alternate entry point--used for CONTINUE option.
  66. 660  LOCATE 22,1:COLOR 0,7
  67. 670  PRINT"Use arrow keys to move to desired dot location                      "
  68. 680  PRINT"Press F10 to set a dot...Space Bar to remove a dot                  "
  69. 690  PRINT"Press <return> for options menu                                     ";
  70. 700  COLOR 7,0
  71. 710  LOCATE 1,1:PRINT SPACE$(70);
  72. 720  LOCATE 11,35
  73. 730  RETURN
  74. 740  '-------------------------------------------------------------------------
  75. 750  'Subroutine to test character on printer (TEST option).
  76. 760  '-------------------------------------------------------------------------
  77. 770  LOCATE 1,1:PRINT SPACE$(70);:LOCATE 1,1
  78. 775  INPUT "Replace what character for test? :",C$
  79. 780  LPRINT CHR$(27);CHR$(37);"A";C$;
  80. 790  TEST = TRUE
  81. 800  GOSUB 390
  82. 810  LPRINT CHR$(27);"0"
  83. 820  LPRINT"Here is a test of the new character."
  84. 830  LPRINT CHR$(27);"2";
  85. 840  FOR I = 1 TO 20: LPRINT C$;:NEXT I
  86. 850  LPRINT CHR$(27);"0";
  87. 860  LPRINT"That was a test of the new character."
  88. 870  TEST = FALSE
  89. 880  RETURN
  90. 890  '-------------------------------------------------------------------------
  91. 900  'Subroutine to initialize and set up function keys
  92. 910  '-------------------------------------------------------------------------
  93. 920  TRUE=1:FALSE=0
  94. 930  WIDTH "SCRN: ",80:CLS:KEY OFF:CR$ = CHR$(13)
  95. 940  FOR I = 1 TO 10: KEY I, "": NEXT I
  96. 950  KEY 1, "SAVE" + CR$ : KEY 2, "CLEAR" + CR$   : KEY 3, "EXIT" + CR$
  97. 960  KEY 4, "TEST" + CR$ : KEY 5, "CONTINUE" + CR$: KEY 6, "LOOKUP" + CR$
  98. 970  KEY 10, CHR$(220)
  99. 980  'Determine display adapter (B800 for color/graphics, B000 for Mono).
  100. 990  DEF SEG=0
  101. 1000  IF (PEEK(&H410) AND &H30) <> &H30 THEN DEF SEG=&HB800 ELSE DEF SEG=&HB000
  102. 1010  MATCOLS = 11       'Number of dot matrix columns
  103. 1020  MATROWS=7          'Number of dot matrix rows.
  104. 1030  LOCATE 3,35: PRINT "FONTEDIT.BAS"
  105. 1040  LOCATE 10,10
  106. 1050  PRINT"     Be sure that the filename you select for output is not in use."
  107. 1060  LOCATE 11,10
  108. 1070  PRINT"If you are going to add more character definitions to an existing"
  109. 1080  LOCATE 12,10
  110. 1090  PRINT"file, you must know its last line number."
  111. 1100  LOCATE 13,10
  112. 1110  PRINT"     When creating a character, remember that no two dots can be"
  113. 1120  LOCATE 14,10
  114. 1130  PRINT"directly adjacent horizontally.  The LOOKUP option gets the dot"
  115. 1140  LOCATE 15,10
  116. 1150  PRINT"patterns from the display screen ROM, which requires adjacent dots,"
  117. 1160  LOCATE 16,10
  118. 1170  PRINT"so you will have to edit any characters you LOOKUP.  Also, the ROM"
  119. 1180  LOCATE 17,10
  120. 1190  PRINT"character patterns are only 7 columns wide."
  121. 1200  LOCATE 18,10:COLOR 31,0:PRINT"     IMPORTANT:  ";:COLOR 7,0
  122. 1210  PRINT"If you look at the character files created by fontedit"
  123. 1220  LOCATE 19,10
  124. 1230  PRINT"by LOADing and LISTing them, be sure not to SAVE them--if you do,"
  125. 1240  LOCATE 20,10
  126. 1250  PRINT"you will not be able to append to them.  If you make changes"
  127. 1260  LOCATE 21,10
  128. 1270  PRINT"and must save them, use the `A` option (SAVE`<filename>.BAS`,A)."
  129. 1280  LOCATE 22,1: INPUT "File for output?  (1-8 characters) "; FIL$
  130. 1290  IF FIL$ = "" THEN BEEP: GOTO 1130
  131. 1300  FIL$ = FIL$ + ".BAS"
  132. 1310  INPUT "New file or append  (N/A)? ",TYPE$
  133. 1320  IF TYPE$ = "a" OR TYPE$ = "A" THEN INPUT "Line for 1st new statement?",                     LINENUM: GOTO 1370
  134. 1330  LINENUM = 10
  135. 1340  OPEN FIL$ FOR OUTPUT AS #1
  136. 1350  PRINT #1, LINENUM;" Rem--Select Download Character Set":LINENUM=LINENUM+10
  137. 1360  PRINT #1, LINENUM;" LPrint chr$(27);chr$(50);":LINENUM=LINENUM+10:CLOSE #1
  138. 1370  RETURN
  139. 1380  '-------------------------------------------------------------------------
  140. 1390  'Subroutine to access display screen dot pattern of a character from ROM
  141. 1400  '-------------------------------------------------------------------------
  142. 1410  CHAR$ = CHR$(220)
  143. 1420  LOCATE 1,1: PRINT SPACE$(70):
  144. 1430  LOCATE 1,1
  145. 1440  INPUT "Look up what character? ", C$
  146. 1450  J% = 0
  147. 1460  N% = ASC(C$)
  148. 1470  IF (N%=95) OR (N%=103) OR (N%=112) OR (N%=113) OR (N%=121) THEN J%=2
  149. 1480  'DRAW BLOCK LETTERS by Robert Metzger 4/83 (part of it, anyway)
  150. 1490  DEF SEG=&HFFA6: O%=14
  151. 1500  FOR I% = 0 TO 7: M%(I%)=2^(7-I%): NEXT
  152. 1510     A% = O% + 8*N%
  153. 1520     FOR K% = 0 TO 7: B% = PEEK(A%+K%)
  154. 1530             FOR L% = 0 TO 7
  155. 1540             IF B% AND M%(L%) THEN 1550 ELSE 1560
  156. 1550             LOCATE 11+K%-J%,37+L%: PRINT CHAR$
  157. 1560             NEXT L%
  158. 1570     NEXT K%
  159. 1580  LOCATE 1,1:  PRINT "Now hit <return>.              "
  160. 1590  '  Glossary of Internal Variables
  161. 1600  'A% = Addresss             B% = Byte
  162. 1610  'C$ = Character            I% = Counter
  163. 1620  'J% = Descender?           K% = Counter
  164. 1630  'L% = Counter              M% = Mask
  165. 1640  'O% = Offset
  166. 1650  DEF SEG = 0
  167. 1660  IF (PEEK(&H410) AND &H30) <> &H30 THEN DEF SEG=&HB800 ELSE DEF SEG=&HB000
  168. 1670  RETURN
  169. 1680  '-------------------------------------------------------------------------
  170. 1690  '  ROUTINE TO PUT THE KEYS BACK TO NORMAL AND EXIT
  171. 1700  '-------------------------------------------------------------------------
  172. 1710  CLOSE #1 : CLS
  173. 1720  KEY 1, "LIST " : KEY 2, "RUN" + CHR$(13) : KEY 3 , "LOAD" + CHR$(34)
  174. 1730  KEY 4, "SAVE" + CHR$(34) : KEY 5, "CONT" + CHR$(13) :
  175. 1740  KEY 6, CHR$(44) + CHR$(34) + "LPT1" : KEY 7 , "TRON" + CHR$(13)
  176. 1750  KEY 8, "TROFF" + CHR$(13) : KEY 9 , "KEY" : KEY 10 , "SCREEN"
  177. 1760  KEY ON
  178. 1770  END
  179.