home *** CD-ROM | disk | FTP | other *** search
/ ftp.whtech.com / ftp.whtech.com.tar / ftp.whtech.com / club100 / prt / chrgen.ba < prev    next >
Text File  |  2006-10-19  |  5KB  |  89 lines
  1. 0  'PROGRAM NAME:  CHRGEN.BA
  2. 10 'REVISED 6/13/85
  3. 20 'A program to generate and download characters to the EPSON FX-80 printer.
  4. 30 'If you have questions or problems contact:
  5. 40 '         Paul Papanek Stork                      Don't Pa..Panic Software
  6. 50 '         E19431 Church Rd.                       Aniwa, WI  54408
  7. 55 '         COMPUSERVE ID# 75515,1651
  8. 56 'CLUB 100 Library - 415/939-1246 BBS,    937-5039 NEWSLETTER, 932-8856 VOICE
  9. 60 GOTO1000
  10. 69 '--- Screen Print Subroutine ---
  11. 70 IFLEFT$(B$,4)="CAS:"THENI=87:J=26:GOSUB90:PRINT@120,STRING$(7,239)" PLEASE TURN TAPE ON NOW! "
  12. 79 '--- Pause Subroutine ---
  13. 80 PRINT@248,NM$;"HIT ANY KEY TO CONTINUE":A$=INPUT$(1):PRINT@248,SPACE$(23):PRINT@253,C$;B$:RETURN
  14. 89 '--- Draw Inverse Block ---
  15. 90 PRINT@I,IN$;SPACE$(J);:PRINT@I+80,SPACE$(J);:RETURN
  16. 99 '--- Underline Titles ---
  17. 100 FORX=0TOJ:PRINT@I+X,"-";:NEXT:RETURN
  18. 109 '--- Outline Edit Grid ---
  19. 110 LINE(OX*6+5,OY*8)-(OX*6+5,OY*8+7):LINE-(OX*6,OY*8+7):RETURN
  20. 119 '--- Fill in Edit Grid ---
  21. 120 IFA(OX,OY)THENPRINT@NM,CHR$(239);ELSEPRINT@NM," ";:GOSUB110
  22. 125 RETURN
  23. 129 '--- EDIT SUBROUTINE ---
  24. 130 PRINT@20,"EDIT CHARACTER SET":I=60:J=17:GOSUB100:PRINT@220,"<P>lotter....":PRINT@260,"<D>escender..":PRINT@300,"<S>pacing....";:PRINT@55,CHR$(152):PRINT@95,"I":PRINT@133,CHR$(155)"J K"CHR$(154):PRINT@175,"M":PRINT@215,CHR$(153);
  25. 140 FORI=0TO7:PRINT@I*40,SPACE$(12);:LINE(5,I*8+7)-(70,I*8+7):NEXT:FORI=1TO12:LINE(I*6-1,0)-(I*6-1,63):NEXT:PRINT@140,"ENTER CHARACTER   ";
  26. 150 PRINT@156,;:A$=INPUT$(1):A=ASC(A$):IFA<32THENPRINT@156,"^";CHR$(A+32);ELSEPRINT@156,A$;
  27. 160 PL=1:AD=29000+A*12:C(0)=PEEK(BS+AD):FORX=1TO11:C(X)=PEEK(BS+AD+X):FORY=0TO7:I=2^(7-Y):A(X,Y)=C(X)/I:C(X)=C(X)MODI:IFA(X,Y)THENNM=40*Y+X:OX=X:OY=Y:GOSUB120
  28. 170 NEXT:NEXT:PS=0:GOSUB210:X=1:Y=0:IFC(0)ANDC(0)<128THENDS=1ELSEDS=0
  29. 180 GOSUB230:IFA(X,Y)THENPL=0
  30. 190 GOSUB250
  31. 199 '--- Interpret Keypress ---
  32. 200 A$=INKEY$:IFA$=""THEN200ELSEONINSTR("PpSsDdJjKkMmIi",A$)GOSUB250,250,210,210,230,230,270,270,280,280,300,300,310,310:ONINSTR(QT$,A$)GOTO400,500:GOTO200
  33. 209 '--- Proportional Spacing On/Off ---
  34. 210 IFPSTHENPS=0:PRINT@313,"OFF";ELSEPS=1:PRINT@313,"ON ";
  35. 220 RETURN
  36. 229 '--- Descender On/Off ---
  37. 230 IFDSTHENDS=0:PRINT@273,"ON ";ELSEDS=1:PRINT@273,"OFF";
  38. 240 RETURN
  39. 249 '--- Plotter On/Off ---
  40. 250 IFPLTHENPL=0:PRINT@233,"OFF";ELSEPL=1:PRINT@233,"ON ";
  41. 260 GOTO330
  42. 269 '--- Move Plotter ---
  43. 270 X=X-2
  44. 280 X=X+1:IFX>11THENX=11ELSEIFX<1THENX=1
  45. 290 GOTO320
  46. 300 Y=Y+2
  47. 310 Y=Y-1:IFY>7THENY=7ELSEIFY<0THENY=0
  48. 320 GOSUB120
  49. 330 NM=Y*40+X:OX=X:OY=Y:IFA(X-1,Y)ORA(X+1,Y)THENA(X,Y)=0ELSEA(X,Y)=PL
  50. 340 IFA(X,Y)=0THENPRINT@NM,IN$;
  51. 350 PRINT@NM,CHR$(171);NM$;:GOSUB110
  52. 360 RETURN
  53. 399 '--- Save Character, Return to Edit ---
  54. 400 GOSUB410:IFA<0THENA=-A:GOTO200ELSE140
  55. 410 FORI=1TO11:C(I)=A(I,7):FORJ=0TO6:C(I)=C(I)+A(I,J)*2^(7-J):NEXT:IF(C(I)=9ORC(I)=26)AND(I=1ORC(I-1)=0)THENA=-A:RETURN
  56. 420 POKEBS+AD+I,C(I):NEXT
  57. 430 FORI=1TO7:IFC(I)THEN440ELSENEXT
  58. 440 ST=I-1:FORI=11TO1STEP-1:IFC(I)THEN450ELSENEXT:C(0)=0:GOTO490
  59. 450 EN=I+2:IFEN-ST<4THENEN=ST+4
  60. 460 IFEN>11THENEN=11
  61. 470 IFPS=0THENST=0:EN=11
  62. 480 C(0)=128*DS+ST*16+EN:IFC(0)=26ORC(0)=9THENC(0)=10
  63. 490 POKEBS+AD,C(0):RETURN
  64. 499 '--- Save Character & Quit Edit ---
  65. 500 GOSUB410:IFA<0THENA=-A:GOTO200ELSERETURN
  66. 599 '--- Clear Character Set ---
  67. 600 PRINT@10,"CLEAR SET IN MEMORY":I=50:J=18:GOSUB100:PRINT@130,"Are You Sure? Y/N ";:A$=INPUT$(1):PRINTA$;:IFA$="Y"ORA$="y"THENCALL59875,0,59887
  68. 610 RETURN
  69. 699 '--- Save Character Set ---
  70. 700 PRINT@11,"SAVE CHARACTER SET":I=51:J=17:GOSUB100:PRINT@120,"Name of File to Save";:INPUTB$:IFB$=""THENB$="CHRSET"
  71. 710 C$="SAVING:":GOSUB70:SAVEMB$,59888,62959
  72. 799 '--- Load Character Set ---
  73. 800 PRINT@11,"LOAD CHARACTER SET":I=51:J=17:GOSUB100:PRINT@120,"Name of File to Load";:INPUTB$:IFB$=""THENB$="CHRSET"
  74. 810 C$="LOADING:":GOSUB70:LOADMB$:GOTO1020
  75. 899 '--- Download To Printer ---
  76. 900 PRINT@10,"DOWNLOAD TO PRINTER":I=50:J=18:GOSUB100:I=83:J=33:GOSUB90:PRINT@123," CAUTION:  DIP Sw1-4 must be OFF ":GOSUB80
  77. 910 PRINT@80,SPACE$(200);:PRINT@174,"PLEASE WAIT":LPRINTES$;":";ZR$;ZR$;ZR$;:FORI=0TO255:AD=29000+I*12:C(0)=PEEK(BS+AD):PRINT@280,I;:IFC(0)=0THEN940
  78. 920 LPRINTES$;"&";ZR$;CHR$(I);CHR$(I);CHR$(C(0));:FORJ=1TO11:C(J)=PEEK(BS+AD+J):IFC(J)=9THENC(J)=C(J)+C(J-1)
  79. 930 LPRINTCHR$(C(J));:NEXT
  80. 940 NEXT:RETURN
  81. 990 CLS:PRINT@130,"RESET MEMORY? (Y/N) ";
  82. 995 A$=INPUT$(1):IFA$="Y"ORA$="y"THENCLEAR256,MAXRAM:MENUELSE:MENU
  83. 999 '--- Main Menu Program ---
  84. 1000 CLEAR256,59875:FORI=1TO13:READA:POKE59874+I,A:NEXT
  85. 1010 DATA1,0,12,151,35,119,11,120,177,194,230,233,201
  86. 1020 CLEAR:DEFINTA-Z:DIMA(12,7),C(12):ES$=CHR$(27):NM$=ES$+"q":IN$=ES$+"p":ZR$=CHR$(0):QT$=CHR$(13)+ES$:BS=30888:GOSUB1030:A$=INPUT$(1):PRINT@318,A$;
  87. 1025 CLS:ONINSTR("EeCcSsLlDdQq",A$)GOSUB130,130,600,600,700,700,800,800,900,900,990,990:PRINT@318,;:GOTO1 020
  88. 1030 CLS:PRINT@15,"MAIN MENU":I=55:J=8:GOSUB100:PRINT@80,"<E>dit Character Set":PRINT"<C>lear Set in Memory":PRINT"<S>ave Character Set":PRINT"<L>oad Character Set":PRINT"<D>ownload to Printer":PRINT"<Q>uit Program           ENTER CHOICE ";:RETURN
  89.