home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Compute! Gazette 1986 June
/
1986-06.d64
/
fontmaker
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2022-09-20
|
4KB
|
163 lines
100 if xx=1 then 630
110 poke 56,123:clr:xx=1:ft=1
120 dim t(29,2),r(7,7):open 15,8,15
130 for x=0 to 29:t(x,0)=33+x:next
140 for x=0 to 25:t(x,1)=65+x:next
150 t(26,1)=31:t(27,1)=32:t(28,1)=0:t(29,1)=122
160 for x=0 to 29:t(x,2)=x+1:next
170 hh$=""
180 gg$=" "
190 poke 53280,6:print chr$(8)chr$(14)"[147][154] [198]ont[205]aker for [198]ont[208]rinter"
200 gosub 1710:print" 12345678":print" [176][192][192][192][192][192][192][192][192][174] f1 pixel on"
210 print" 1[221] [221] f2 pixel off"
220 print" 2[221] [221] f3 add column"
230 print" 3[221] [221] f4 delete column"
240 print" 4[221] [221]"
250 print" 5[221] [221] f5 keyboard choice"
260 print" 6[221] [221] f6 new font number"
270 print" 7[221] [221] f7 load a font set"
280 print" [173][192][192][192][192][192][192][192][192][189] f8 save a font set"
290 print" abcdefghijklmnopqrstuvwxyz[\]^"
300 print" [193][194][195][196][197][198][199][200][201][202][203][204][205][206][207][208][209][210][211][212][213][214][215][216][217][218]?@[164][186]"
310 print" !"+chr$(34)+"#$%&'()*+,-./0123456789:;<=>"
320 x1=4:y1=17
330 poke 55296+40*y1+x1,0:gosub 1680
340 get a$:if a$="" then 340
350 poke 55296+40*y1+x1,14
360 if a$<>"" then 390
370 if x1>32 then x1=3
380 x1=x1+1:goto 330
390 if a$<>"[157]" then 420
400 if x1<5 then x1=34
410 x1=x1-1:goto 330
420 if a$<>"" then 450
430 if y1>18 then y1=16
440 y1=y1+1:goto 330
450 if a$<>"[145]" then480
460 if y1<18 then y1=20
470 y1=y1-1:goto 330
480 if a$<>"[139]" then 520
490 gosub 1680:print"[211]witch to which font?"
500 get b$:if b$<"1" or b$>"9" then 500
510 ft=asc(b$)-48:gosub 1710:goto 330
520 if a$<>"[136]" then 570
530 gosub 1680:print"[204]oad file[144]";
540 s$="":input s$:s$=left$(s$,16):if s$="" then 330
550 open 1,8,8,s$+",p,r":input#15,a,e$,b$,b$:close 1:if a then 640
560 load s$,8,1
570 if a$<>"[140]" then 670
580 gosub 1680:print"[211]ave as[144]";
590 poke 2,peek(45):poke 3,peek(46):poke 43,0:poke 44,123:poke 45,0:poke 46,159
600 s$="":input s$:s$=left$(s$,16):if s$="" then 620
610 save s$,8
620 poke 43,1:poke 44,8:poke 45,peek(2):poke 46,peek(3)
630 input#15,a,e$,b$,b$:if a=0 then 330
640 gosub 1690:print"[196]isk [197]rror:"a;e$
650 get a$:if a$="" then 650
660 gosub 1690:goto 330
670 if a$<>"[135]" then 780
680 open 3,3:cmd 3:gosub 1690
690 print"choice: [144]";:input a$
700 print#3:close 3
710 if len(a$)=1 then a=asc(a$):goto740
720 if left$(a$,1)<>"/" then a=0:goto 740
730 a=val(right$(a$,len(a$)-1))
740 x2=5:y2=7:gosub 1600:if sc=1 then 1420
750 poke 55296+40*y1+x1,0
760 get a$:if a$="" then 760
770 gosub 1690:goto 350
780 if a$=chr$(13) then poke 55296+40*y1+x1,1:goto 820
790 a=asc(a$+chr$(0)):gosub 1600:if sc=0 then 750
800 gosub 1690:print"choice:[144] "a$
810 x2=5:y2=7:goto 1420
820 x2=5:y2=7:goto 1410
830 print left$(hh$,y2+1)tab(x2)"[154]";
840 poke 55296+40*y2+x2,0
850 get a$:if a$="" then 850
860 poke 55296+40*y2+x2,14
870 if a$<>"" then 910
880 if wd=0 then 850
890 if x2>3+wd then x2=5:goto 830
900 x2=x2+1:print"";:goto 840
910 if a$<>"[157]" then 940
920 if x2<6thenx2=4+wd:goto 830
930 x2=x2-1:print"[157]";:goto 840
940 if a$<>"" then 970
950 if y2>12 then y2=6:print"[145][145][145][145][145][145][145]";
960 y2=y2+1:print"";:goto 840
970 if a$<>"[145]" then1000
980 if y2<8 then y2=14:print"";
990 y2=y2-1:print"[145]";:goto 840
1000 ifa$=chr$(13) then 1570
1010 if a$<>chr$(141) then 1040
1020 gosub 1690:print""left$(hh$,8)tab(5);
1030 for k=0 to 7:print" [157] [157] [157] [157] [157] [157] [145][145][145][145][145][145][145]";:next:goto 330
1040 if a$<>"[147]" then 1080
1050 print left$(hh$,8);
1060 for i=0 to 6:print tab(5)""left$(gg$,wd)
1070 for r=0 to 7:r(r,i)=0:next:next:goto 830
1080 if a$<>"" then 1110
1090 if wd then x2=5
1100 y2=7:goto 850
1110 if a$<>"[137]" and a$<>chr$(32) then 1140
1120 if wd=0 then 850
1130 print" [157]";:r(x2-5,y2-7)=0:goto 890
1140 if a$<>"[134]" then 1190
1150 if wd<8 then wd=wd+1:r(wd-1,7)=128
1160 for k=7 to 13:poke 55300+40*k+wd,14:next
1170 if wd=1 then 890
1180 goto 830
1190 if a$<>"[138]" then 1240
1200 if wd=0 then 830
1210 for k=7 to 13:poke55300+40*k+wd,6:next
1220 r(wd-1,7)=0:wd=wd-1:if x2>wd+4 then x2=wd+4
1230 goto 830
1240 if a$<>"[139]" then 1280
1250 gosub 1690:print"[211]witch to which font?"
1260 get b$:if b$<"1" or b$>"9" then 1260
1270 ft=asc(b$)-48:gosub 1710:gosub 1690:goto 830
1280 if a$<>"[135]" then 1380
1290 open 3,3:cmd 3:gosub 1690
1300 print"choice: [144]";:input a$
1310 print#3:close 3
1320 if len(a$)=1 then a=asc(a$):goto 1340
1330 a=val(right$(a$,len(a$)-1))
1340 gosub 1600:poke 55296+40*y2+x2,0
1350 if sc=1 then poke 55296+40*y1+x1,14:goto 830
1360 get a$:if a$="" then 1360
1370 gosub 1690:print left$(hh$,y2+1)tab(x2)"";:goto 870
1380 if a$="[136]" or a$="[140]" then 830
1390 if wd=0 then 850
1400 print"*[157]";:r(x2-5,y2-7)=2^(y2-7):goto 890
1410 tt=8*t(x1-4,y1-17)+30464
1420 ss=tt+ft*1024
1430 if a$=chr$(13) then gosub 1690
1440 print"[154]"tab(5);:r=0
1450 rr=peek(ss+r):if rr<128 then 1520
1460 for i=0 to 6:r(r,i)=rr and 2^i
1470 if r(r,i) then print"*[157]";:goto 1490
1480 print" [157]";
1490 next:r(r,7)=128:print"[145][145][145][145][145][145][145]";
1500 r=r+1:if r<8 then 1450
1510 wd=r:goto 830
1520 if r=0 then x2=4
1530 for rr=r to 7:for i=0 to 6
1540 r(rr,i)=0:print" [157]";:next
1550 r(r,7)=0:print"[145][145][145][145][145][145][145]";
1560 next:wd=r:goto 830
1570 gosub 1690:ss=tt+ft*1024:print""tab(5);
1580 for r=0 to 7:k=0:for i=0 to 7:k=k+r(r,i):next
1590 poke ss+r,k:print" [157] [157] [157] [157] [157] [157] [145][145][145][145][145][145][145]";:next:goto 330
1600 sc=1:if a>255 then 1670
1610 if a=255 then tt=8*94+30464:return
1620 if a>127 then 1650
1630 if a<32 then 1670
1640 tt=8*(a-32)+30464:return
1650 if a<160 then 1670
1660 tt=8*(a and 127 or64)+30464:return
1670 gosub 1690:print"[144]-invalid character":sc=0:return
1680 print hh$gg$:goto 1700
1690 print "[146]"left$(hh$,16)gg$
1700 print"[145]";:return
1710 print""tab(12)"[154][195]urrent font:"ft:return