home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib29a.dsk / NOVEMBER.1986 / FONT.EDITOR.bas < prev    next >
BASIC Source File  |  2023-02-26  |  5KB  |  86 lines
  1. 10  REM  **********************
  2. 20  REM  * FONT.EDITOR        *
  3. 30  REM  * BY DAVID W. MILLER *
  4. 40  REM  * COPYRIGHT (C) 1986 *
  5. 50  REM  * BY MICROSPARC, INC.*
  6. 60  REM  * CONCORD, MA  01742 *
  7. 70  REM  **********************
  8. 80  HIMEM: 37632: GOTO 540
  9. 90  HTAB AC: VTAB AR: POKE  -16368,0: GET A$: POKE  -16368,0:A =  ASC(A$)
  10. 100  IF A = 21  THEN 270
  11. 110  IF A = 8  THEN 310
  12. 120  IF A = 65  OR A = 97  OR A = 11  THEN 250
  13. 130  IF A = 90  OR A = 122  OR A = 10  THEN 290
  14. 140  IF A = 32  THEN 330
  15. 150  IF A = 83  OR A = 115  THEN 370
  16. 160  IF A = 70  OR A = 102  THEN 410
  17. 170  IF A = 68  OR A = 100  THEN 710
  18. 180  IF A = 67  OR A = 99  THEN 750
  19. 190  IF A = 78  OR A = 110  THEN 780
  20. 200  IF A = 82  OR A = 114  THEN 430
  21. 210  IF A = 76  OR A = 108  THEN 650
  22. 220  IF A < >81  AND A < >113  THEN 90
  23. 230  VTAB 21: HTAB 1: CALL  -958: PRINT "ARE YOU SURE YOU WANT TO QUIT? ";: POKE  -16368,0: POKE  -16368,0: GET A$: POKE  -16368,0: IF A$ = "Y"  OR A$ =  CHR$(121)  THEN  TEXT : HOME : POKE 216,0: END 
  24. 240  GOTO 680
  25. 250  IF AR < >VT  THEN AR = AR -1
  26. 260  GOTO 90
  27. 270  IF AC < >HT +7  THEN AC = AC +1
  28. 280  GOTO 90
  29. 290  IF AR < >VT +6  THEN AR = AR +1
  30. 300  GOTO 90
  31. 310  IF AC < >HT  THEN AC = AC -1
  32. 320  GOTO 90
  33. 330 R = AR -VT:C = AC -HT
  34. 340  IF   NOT GD(C,R)  THEN BY(C) = BY(C) +2 ^R:GD(C,R) = 1: GOTO 360
  35. 350 BY(C) = BY(C) -2 ^R:GD(C,R) = 0
  36. 360  VTAB AR: HTAB AC: PRINT C$(GD(C,R));: GOTO 90
  37. 370  GOSUB 700: HTAB 1: PRINT "ENTER NAME FOR THIS FONT": INPUT "OR <RETURN> TO CONTINUE: ";A$: PRINT 
  38. 380  IF A$ = ""  THEN 680
  39. 390  IF  RIGHT$(A$,3) < >".PF"  THEN A$ = A$ +".PF"
  40. 400  PRINT D$"BSAVE"A$",A"TL",L767,D"DV: GOSUB 700: GOTO 520
  41. 410  FOR I = 0 TO 7: POKE CL +I,BY(I): NEXT 
  42. 420 AC = HT:AR = VT: GOTO 90
  43. 430  GOSUB 690: GOSUB 700:AC = HT:AR = VT
  44. 440  INPUT "ENTER ASCII CODE (32-127) -> ";CH$: IF CH$ = ""  THEN  GOSUB 700: GOTO 470
  45. 450 CH =  VAL(CH$) -32: IF CH <0  OR CH >95  AND CH$ < >""  THEN  PRINT  CHR$(7);: GOTO 430
  46. 460 CL = CH *8 +TL
  47. 470  FOR I = 0 TO 7:BY(I) =  PEEK(CL +I): POKE HR,BY(I)
  48. 480  FOR K = 0 TO 6:GD(I,K) = 0: DRAW 1 AT K,0
  49. 490  IF  PEEK(Z)  THEN  VTAB VT +K: HTAB HT +I: PRINT "X";:GD(I,K) = 1
  50. 500  NEXT : NEXT 
  51. 510 LC = CH: IF CH >63  THEN LC = CH -32
  52. 520  GOSUB 700: PRINT "USUAL CHARACTER FOR ASCII "CH +32" IS '";
  53. 530  PRINT  CHR$(LC +32)"'": GOTO 90
  54. 540  DIM BY(7),GD(7,6),C$(1): ONERR  GOTO 800
  55. 550 DR = 0:VT = 7:HT = 18:TL = 37632:CL = TL:HR = 8192:Z = 234:DV = 1:CH = 0: IF  PEEK(48896) = 76  THEN TL = TL +1024:CL = TL
  56. 560 D$ =  CHR$(4):SC$ = "::::::::":C$(0) = ":":C$(1) = "X": REM  8 COLONS
  57. 570  HGR : TEXT : HOME : SCALE= 1: ROT= 0: HCOLOR= 3
  58. 580  VTAB 2: HTAB 6: PRINT "FONT EDITOR BY DONALD MILLER": HTAB 3: PRINT "COPYRIGHT 1986 BY MICROSPARC, INC.": POKE 34,3: GOSUB 690
  59. 590  POKE 767,1: POKE 769,0: POKE 770,4: POKE 771,0: POKE 772,4
  60. 600  POKE 773,0: POKE 232,0: POKE 233,3
  61. 610  VTAB 17: HTAB 1: PRINT "COMMANDS A,Z,->,<-,SPACE,R,F,S,L,N,D,C,Q"
  62. 620  VTAB 21: HTAB 3: PRINT "(L)OAD FONT OR (N)EW FONT? ";: POKE  -16368,0: GET A$: POKE  -16368,0
  63. 630  IF A$ = "N"  OR A$ =  CHR$(110)  THEN  GOSUB 700: HTAB 10: PRINT "INITIALIZING...": FOR I = TL TO TL +767: POKE I,0: NEXT : GOTO 680
  64. 640  IF A$ < >"L"  AND A$ < > CHR$(108)  THEN  GOTO 620
  65. 650  GOSUB 700: HTAB 1: PRINT "FONT TO LOAD,OR <RETURN> TO CONTINUE": INPUT "?";A$
  66. 660  IF A$ < >""  AND  RIGHT$(A$,3) < >".PF"  THEN A$ = A$ +".PF"
  67. 670  IF A$ < >""  THEN  PRINT D$"BLOAD"A$",A"TL",D"DV
  68. 680 D = 1: GOSUB 700:AC = HT:AR = VT: GOSUB 690: GOSUB 470: GOTO 520
  69. 690  VTAB VT: FOR I = 0 TO 6: HTAB HT: PRINT SC$: NEXT : RETURN 
  70. 700  VTAB 21: HTAB 1: CALL  -958: VTAB 21: HTAB 3: RETURN 
  71. 710  GOSUB 700: IF DV = 1  THEN DV = 2: GOTO 730
  72. 720 DV = 1
  73. 730  HTAB 1: PRINT "DRIVE SET TO "DV
  74. 740  VTAB 22: PRINT "PRESS <RETURN> TO CONTINUE ";: POKE  -16368,0: GET CH$: POKE  -16368,0: GOTO 520
  75. 750  HOME : PRINT : PRINT  CHR$(4); LEFT$("CATALOG",7 -4 *( PEEK(48896) = 76))",D"DV
  76. 760  PRINT "PRESS <RETURN> TO CONTINUE ";: POKE  -16368,0: GET CH$: POKE  -16368,0
  77. 770  HOME : VTAB 17: HTAB 1: PRINT "COMMANDS--A,Z,->,<-,SPACE,R,F,S,L,D,C,Q": GOSUB 690: GOTO 470
  78. 780  GOSUB 700: PRINT "ERASE CURRENT FONT. ARE YOU SURE? ";: POKE  -16368,0: GET CH$: POKE  -16368,0: IF CH$ < >"Y"  AND CH$ < > CHR$(121)  THEN  GOTO 680
  79. 790  GOSUB 700: HTAB 10: PRINT "INITIALIZING...": FOR I = TL TO TL +767: POKE I,0: NEXT : GOTO 680
  80. 800  VTAB 21: HTAB 1: CALL  -958:ER =  PEEK(222):EL =  PEEK(219) *256 + PEEK(218)
  81. 810  PRINT  CHR$(4)"CLOSE"
  82. 820  IF ER = 6  THEN  PRINT "FILE NOT FOUND": GOTO 860
  83. 830  IF ER = 8  THEN  PRINT "I/O ERROR": GOTO 860
  84. 840  IF ER = 16  THEN  PRINT "SYNTAX ERROR IN LINE "EL: GOTO 860
  85. 850  PRINT "ERROR IN LINE "EL
  86. 860  VTAB 22: PRINT "PRESS <RETURN> TO CONTINUE";: POKE  -16368,0: GET CH$: POKE  -16368,0: CALL  -3288:AC = HT:AR = VT: GOTO 520