home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1988 / 10_11 / amiga / lqe.bas < prev   
BASIC Source File  |  1988-07-12  |  7KB  |  328 lines
  1. ' ********************************
  2. '     Printer Character Editor
  3. '
  4. ' (C) 1988 by G.Glendown & TOOLBOX
  5. ' ********************************
  6.  
  7. CLEAR,10000
  8. CLEAR,70000&
  9. DIM b%(96,30,3)
  10. DIM a(64,3)
  11. DIM m(30,24)
  12. DIM z(30,3)
  13. DIM D(96)
  14. char =33       ' Anfangen mit "A"
  15. prndev$ = "PAR:"
  16.  
  17. SCREEN 1,640,512,1,4
  18. WINDOW 2," NEC Zeichengenerator  V 1.1",(0,1)-(631,497),0,1
  19. PALETTE 1,0,0,0
  20. PALETTE 0,.5,.5,.5
  21. FOR t=2 TO 4:MENU t,0,0,"":NEXT
  22. g=1
  23. READ a
  24. loop:
  25.   FOR t=0 TO a
  26.     READ a$:MENU g,t,1,a$
  27.   NEXT
  28.   g=g+1
  29.   READ a
  30. IF a<>-1 THEN GOTO loop
  31.  
  32. ' ** Menuetexte **
  33. DATA 4,Project,New,Load,Save,Quit
  34. DATA 4,Edit,Select,Save C ,Clear,Copy
  35. DATA 2,Printer,Test,Copy CSet
  36. DATA -1
  37.  
  38. maxp=29:mas=36:mayp=24:xfak=10
  39. LOCATE 1,1
  40. PRINT "Bitte Drucker Online machen D = Draft";
  41. PRINT " RETURN = Letter Qualitaet"
  42. INPUT a$:IF a$="D" OR a$="d" THEN maxp=9:mas=12:xfak=30   
  43. LOCATE 2,1:PRINT SPACE$(80)
  44. FOR t=0 TO 63:a(t,1)=2:a(t,3)=mas-maxp-2:a(t,2)=maxp:NEXT
  45. GOSUB initp
  46. GOSUB drawgrid
  47. ON MENU GOSUB medecode
  48. ON MOUSE GOSUB modecode
  49. MENU ON
  50. MOUSE ON
  51. md=1
  52. GOSUB was
  53. LOCATE 1,1:PRINT SPACE$(80)  
  54.  
  55. g:
  56.   p$=INKEY$
  57.   IF p$=" " THEN md=1-md: GOSUB was
  58.   IF p$="B" OR p$="b" THEN GOSUB berech
  59.   IF p$="C" OR p$="c" THEN GOSUB clre
  60.   IF p$="S" OR p$="s" THEN GOSUB st
  61.   IF p$="T" OR p$="t" THEN GOSUB tst
  62. GOTO g
  63.  
  64. was:
  65.   GOSUB drawgrid
  66.   LOCATE 10,60:
  67.   IF md = 0 THEN PRINT  "Loeschen"
  68.   IF md = 1 THEN PRINT  "Zeichnen"
  69.   LOCATE 20,50
  70.   PRINT "Das aktuelle Zeichen : "CHR$(char+32)
  71.   LOCATE 1,1
  72. RETURN
  73.  
  74. initp:
  75. REM  OPEN prndev$ FOR OUTPUT AS #3
  76. REM    IF maxp=29 THEN PRINT#3,CHR$(27)"x"CHR$(1);
  77. REM    IF maxp=9 THEN PRINT#3,CHR$(27)"x"CHR$(0);
  78. REM    PRINT#3,CHR$(27)"!"CHR$(0);
  79. REM    PRINT#3,CHR$(27)":"CHR$(0)CHR$(0)CHR$(0);
  80. REM  CLOSE #3
  81. RETURN
  82.  
  83. berech:
  84.   MOUSE STOP: MENU STOP
  85.   LOCATE 1,1:PRINT"  Berechnen bitte warten "SPACE$(60)
  86.   OPEN prndev$ FOR OUTPUT AS #3
  87.   PRINT#3,CHR$(27)"&"CHR$(0)CHR$(char+32)CHR$(char+32);
  88.   PRINT#3,CHR$(2)CHR$(maxp)CHR$(mas-maxp-2);
  89.   FOR x=1 TO maxp
  90.     FOR y=1 TO 3
  91.       offs=(y-1)*8+1
  92.       GOSUB berbyte
  93.       b%(char,x,y)=summe
  94.       PRINT #3,CHR$(summe);
  95.     NEXT
  96.   NEXT
  97.   PRINT #3,CHR$(27)"%"CHR$(1);
  98.   CLOSE #3
  99.   MOUSE ON : MENU ON
  100.   D(char)=1
  101.   LOCATE 1,1 : PRINT "   Fertig  "SPACE$(70)
  102.   BEEP
  103. RETURN
  104.  
  105. berbyte:
  106.   summe=0
  107.   FOR g=0 TO 7
  108.     summe=summe+m(x,g+offs)*2^(7-g)
  109.   NEXT
  110. RETURN
  111.  
  112. modecode:
  113.   v=MOUSE(0)
  114.   IF ABS(v)<1 THEN RETURN
  115.   x=MOUSE(3) : y=MOUSE(4)
  116.   xg=INT((x-20)/xfak+.5)
  117.   yg=INT((y-10)/20+.5)
  118. IF xg<1 OR xg>maxp THEN RETURN
  119. IF yg<1 OR yg>mayp THEN RETURN
  120. IF m(xg-1,yg)+m(xg+1,yg)<>0 THEN RETURN
  121.   CIRCLE (20+xfak*xg,10+20*yg),20,md,,,.88
  122.   m(xg,yg)=md
  123.   PSET (60+maxp*xfak+xg,100+yg),md
  124. RETURN
  125.  
  126. medecode:
  127.   mn=MENU(0)
  128.   in=MENU(1)
  129.   ON mn GOTO proj,edt,prin
  130. prin:
  131.   ON in GOTO tst,copset
  132. proj:
  133.   ON in GOTO nw,ld,sv,qt
  134. copset:
  135.   MOUSE STOP: MENU STOP
  136.   LOCATE 1,1
  137.   PRINT " Der aktuelle Zeichensatz wird zum Drucker ";
  138.   PRINT "kopiert, bitte warten";SPACE$(40)
  139.   OPEN prndev$ FOR OUTPUT AS #3
  140.   FOR t=0 TO 64
  141.     IF D(t)=1 THEN GOSUB copchar
  142.   NEXT
  143.   PRINT #3,CHR$(27)"%"CHR$(1);
  144.   CLOSE #3
  145.   BEEP
  146.   LOCATE 1,1 : PRINT "   Fertig ";SPACE$(70)
  147.   MOUSE ON: MENU ON
  148. RETURN   
  149.  
  150. copchar:
  151.   PRINT#3,CHR$(27)"&"CHR$(0)CHR$(t+32)CHR$(t+32);
  152.   PRINT#3,CHR$(2)CHR$(maxp)CHR$(mas-maxp-2);
  153.   FOR x=1 TO maxp
  154.      FOR y=1 TO 3
  155.         PRINT #3,CHR$(b%(t,x,y));
  156.      NEXT
  157.   NEXT
  158. RETURN
  159.  
  160. nw:
  161.   RUN
  162.  
  163. ld:
  164.   MOUSE STOP:MENU STOP
  165.   LOCATE 1,1: PRINT SPACE$(80):LOCATE 1,1
  166.   INPUT" Bitte Filenamen eingeben ",a$
  167.   FOR t=0 TO 64:D(t)=0:NEXT
  168.   OPEN a$ FOR INPUT AS #1
  169.   kz$=INPUT$(4,1)
  170.   IF kz$<>"PCSE" THEN PRINT "Kein Datenfile !":GOTO ENDLD
  171.   kz$= INPUT$(1,1)
  172.   WHILE NOT(EOF(1))
  173.     q$=INPUT$(2,1): t=ASC(LEFT$(q$,1))
  174.     D(t)=1
  175.     IF ASC(RIGHT$(q$,1))<>maxp THEN
  176.       PRINT "Falsches Format!!!"
  177.       STOP
  178.       FOR t=1 TO 1000:NEXT:RUN
  179.     END IF
  180.     FOR g=1 TO 3
  181.       q$=INPUT$(1,1): a(t,g)=ASC(q$)
  182.     NEXT
  183.     FOR g=1 TO a(t,2)
  184.       FOR i=1 TO 3
  185.         q$=INPUT$(1,1): b%(t,g,i)=ASC(q$)
  186.       NEXT
  187.     NEXT
  188.   WEND
  189. ENDLD:
  190.   CLOSE #1
  191.   BEEP
  192.   LOCATE 1,1: PRINT SPACE$(80)
  193.   GOSUB was
  194.   MOUSE ON:MENU ON
  195.   PRINT cmax
  196.   char=33
  197.   GOSUB displaychar
  198. RETURN
  199.  
  200. sv:
  201.   MOUSE STOP: MENU STOP
  202.   LOCATE 1,1: PRINT SPACE$(80): LOCATE 1,1
  203.   INPUT"Bitte Filenamen zum Abspeichern eingeben ",a$
  204.   CLOSE 1
  205.   OPEN a$ FOR OUTPUT AS #1
  206.   PRINT#1,"PCSE";CHR$(maxp);
  207.   t=0
  208.   FOR t=0 TO 64
  209.     IF D(t)=1 THEN GOSUB writechar
  210.   NEXT
  211.   CLOSE #1
  212.   BEEP
  213.   LOCATE 1,1: PRINT SPACE$(80)
  214.   MOUSE ON: MOUSE ON
  215. RETURN 
  216.  
  217. writechar:
  218.   PRINT#1,CHR$(t)CHR$(maxp);
  219.   FOR g=1 TO 3
  220.     PRINT#1,CHR$(a(t,g));
  221.   NEXT
  222.   FOR g=1 TO a(t,2)
  223.     FOR i=1 TO 3
  224.       PRINT #1,CHR$(b%(t,g,i));
  225.     NEXT
  226.   NEXT
  227. RETURN
  228.  
  229. qt:
  230. END
  231.  
  232. edt:
  233.   ON in GOTO st,sc,clre,cpy
  234.  
  235. cpy:
  236.   LOCATE 1,1:PRINT SPACE$(80)
  237.   LOCATE 1,1:INPUT"in welches Zeichen kopieren -> ",a$
  238.   we=ASC(LEFT$(a$,1))-32
  239.   IF VAL(a$)<>0 THEN we=cal(a$)-32
  240.   IF we<0 OR we>96 THEN GOTO cpy
  241.   FOR x=1 TO maxp
  242.     FOR y=1 TO 3
  243.       b%(we,x,y)=b%(char,x,y)
  244.     NEXT
  245.   NEXT
  246.   D(we)=1
  247.   OPEN prndev$ FOR OUTPUT AS #3
  248.   t=we:GOSUB copchar
  249.   CLOSE 3
  250.   LOCATE 1,1:PRINT SPACE$(80)
  251.   GOTO drawgrid
  252.  
  253. clre:
  254.   FOR x=1 TO maxp:FOR y=1 TO 24:m(x,y)=0:NEXT :NEXT
  255.   CLS : D(char) = 0
  256.   GOSUB was
  257.   GOTO drawgrid
  258.  
  259. st:
  260.   abcdef=char
  261.   LOCATE 1,1:PRINT SPACE$(80)
  262.   LOCATE 1,1:INPUT"Zeichen-> ",a$
  263.   char=ASC(LEFT$(a$,1))-32
  264.   IF VAL(a$)<>0 THEN char=VAL(a$)-32
  265.   CLS
  266.   IF char<0 OR char>96 THEN char =abcdef
  267.   GOSUB drawgrid
  268.   GOSUB was
  269.   LOCATE 1,1:PRINT SPACE$(80)
  270.  
  271. displaychar:
  272.   MOUSE STOP
  273.   FOR x=1 TO maxp
  274.     FOR y=1 TO mayp:m(x,y)=0:NEXT
  275.     FOR y=1 TO 3
  276.       p=b%(char,x,y)
  277.       IF p = 0 THEN GOTO la2
  278.       FOR g=1 TO 8
  279.         IF (p AND 2^(8-g)) THEN
  280.           CIRCLE (20+xfak*x,10+20*((y-1)*8+g)),20,1,,,.88
  281.           m(x,(y-1)*8+g)=1
  282.           PSET (60+maxp*xfak+x,100+(y-1)*8+g),1
  283.         END IF
  284.       NEXT
  285. la2:
  286.     NEXT
  287.   NEXT
  288.   MOUSE ON
  289. RETURN
  290.  
  291. sc:
  292.   GOTO berech
  293.  
  294. trnsd:
  295.   RETURN
  296.  
  297. trnsl:
  298.   RETURN
  299.  
  300. tst:
  301.   LOCATE 1,1:PRINT"Bitte Zeichen eingeben "SPACE$(60)
  302.   LOCATE 1,24
  303.   OPEN prndev$ FOR OUTPUT AS #3
  304.   PRINT#3,CHR$(27)"%"CHR$(1);:CLOSE 3
  305.   INPUT a$
  306.   IF LEN(a$)<2 THEN
  307.     OPEN prndev$ FOR OUTPUT AS #4
  308.     FOR t=32 TO 96:PRINT#4,CHR$(t);:NEXT
  309.     FOR t=96 TO 128:PRINT #4,CHR$(t);:NEXT
  310.     PRINT #4,CHR$(13)
  311.     CLOSE 4
  312.     CLOSE #4
  313.     RETURN
  314.   END IF
  315.   OPEN prndev$ FOR OUTPUT AS #5
  316.   PRINT#5,a$;:PRINT#5,CHR$(13):CLOSE 5
  317.   LOCATE 1,1:PRINT SPACE$(80)
  318. RETURN     
  319.  
  320. drawgrid:
  321.   FOR x=1 TO maxp
  322.     LINE (20+x*xfak,10+20)-(20+x*xfak,10+mayp*20),1
  323.   NEXT
  324.   FOR y=1 TO mayp
  325.     LINE (20+xfak,10+20*y)-(20+maxp*xfak,10+20*y),1
  326.   NEXT
  327. RETURN
  328.