home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Run Magazine ReRun 1986 July & August
/
rerun-1986-07-08.d64
/
makechars
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2022-09-20
|
5KB
|
218 lines
100 d$=""
110 goto1610:rem go copy chars***********
120 dima(7):a(7)=128:a(6)=64:a(5)=32:a(4)=16:a(3)=8:a(2)=4:a(1)=2:a(0)=1:p=42
130 print"[147]":rem get character #*******
140 printd$spc(14)"prompt mode":print""rl"-"rh;"'q' to quit, or 'h' for help"
150 input"char #";c$
160 ifleft$(c$,1)="q"thengosub1750:goto140
170 ifleft$(c$,1)="h"thengosub1940:goto140
180 c=val(c$)
190 ifc<rlorc>rhthen140
200 ad=12288+8*c
210 printd$;spc(14)" edit mode[146]"
220 fori=0to9:poke1024+4*40+16-i,160:next
230 fori=0to9:poke1024+13*40+16-i,160:next
240 fori=0to9:poke1024+(4+i)*40+16,160:next
250 fori=0to9:poke1024+(4+i)*40+7,160:next
260 rem decode char to use in matrix****
270 fori=0to7
280 x=peek(ad+i)
290 b(0)=((xand1)=0)+1
300 b(1)=((xand2)=0)+1
310 b(2)=((xand4)=0)+1
320 b(3)=((xand8)=0)+1
330 b(4)=((xand16)=0)+1
340 b(5)=((xand32)=0)+1
350 b(6)=((xand64)=0)+1
360 b(7)=((xand128)=0)+1
370 for j=7to0step-1
380 v=32*(1-b(j))+42*b(j)
390 poke1024+40*(i+5)+15-j,v
400 poke55296+40*(i+5)+15-j,14
410 next
420 next
430 printchr$(142+128*(c>255))"":poke1232+40*3+20,c+256*(c>255)
440 poke55296+8*40+28,14
450 qn=0:qo=0:pf=0:rem get command*****
460 p=peek(1232+qo):poke1232+qo,p
470 getm$:p=(por128)-(pand128):poke1232+qo,p
480 p=(por128)-(pand128):poke1232+qo,p:fori=1to50:next:ifm$=""goto470
490 ifm$="[145]"thenqn=qo-40
500 ifm$=""thenqn=qo+40
510 ifm$=""thenqn=qo+1
520 ifm$="[157]"thenqn=qo-1
530 ifm$="[134]"thengoto140:rem f3 get to prompt
540 ifm$="[133]"thengosub740:goto450:rem f1 compile shape
550 ifm$="[135]"thengosub1070:goto140:rem f5 save a file
560 ifm$="[139]"thengosub860:goto140:rem load a file
570 ifm$="[136]"thengosub1270:goto140:rem f7 data statements
580 ifm$="*"thenp=42:pf=1
590 ifm$=" "thenp=32:pf=1
600 ifm$=""then450
610 ifm$="[147]"thengosub690:goto450
620 ifpeek(197)=32andpeek(653)=4thengosub1510:goto450
630 ifm$="n"thenc=c+1:goto190
640 ifm$="p"thenc=c-1:goto190
650 ifpeek(1232+qn)=160then460
660 ifpfthenpoke1232+qn,p:pf=0
670 qo=qn
680 goto460
690 fori=0to7:rem clear char box*******
700 forj=0to7
710 poke(1024+40*(i+5)+(15-j)),32
720 next:next
730 return
740 rem compile shape******************
750 fori=0to7
760 t=0
770 forj=0to7
780 x=peek(1024+40*(i+5)+(15-j))
790 ifx=32then810
800 t=t+a(j)
810 next
820 pokead+i,t
830 next
840 return
850 rem load file***********************
860 print"[147]load file from t[146]ape or d[146]isk?";
870 getfd$
880 iffd$<>"d"andfd$<>"t"then870
890 iffd$="d"thenfd=8:fw=3:fr$=",s,r":fw$=",s,w":fr=fw
900 iffd$="t"thenfd=1:fw=1:fr$="":fw$="":fr=0
910 print:input"name of file to load";nf$:goto930
920 goto1050
930 ifnf$=""then910
940 ifnf$="x"thengoto1050
950 open1,fd,fr,nf$+fr$
960 input#1,rl:input#1,rh
970 ifstthengosub2170:close1:goto910
980 forc=rltorh
990 ad=12288+8*c
1000 fori=adtoad+7
1010 input#1,xx
1020 pokei,xx
1030 next
1040 next:close1
1050 print"[147]":poke204,1:return
1060 rem save a file********************
1070 print"[147]save file to t[146]ape or d[146]isk?";
1080 getfd$
1090 iffd$<>"d"andfd$<>"t"then1080
1100 iffd$="d"thenfd=8:fw=3:fr$=",s,r":fw$=",s,w":fr=fw
1110 iffd$="t"thenfd=1:fw=1:fr$="":fw$="":fr=0
1120 print:input"filename";nf$
1130 ifnf$=""then1120
1140 ifnf$="x"thenprint"[147]":return
1150 open1,fd,fw,nf$+fw$
1160 print#1,rl:print#1,rh
1170 ifstthengosub2170:close1:goto1120
1180 forc=rltorh
1190 ad=12288+8*c
1200 fori=adtoad+7
1210 xx=peek(i)
1220 print#1,xx
1230 next
1240 next
1250 close1:print"[147]":return
1260 rem print out data****************
1270 print"[147]output to s[146]creen or p[146]rinter?";
1280 getdv$
1290 if dv$<>"p"anddv$<>"s"then1280
1300 ifdv$="s"thendv=3
1310 ifdv$="p"thendv=4
1320 co=c:print"[147]press any key to stop the listing[146]":open1,dv:cmd1
1330 fori=1to1000:next
1340 forc=rltorh
1350 print#1,"data";c;
1360 ad=12288+8*c
1370 fori=adtoad+7
1380 xx=peek(i)
1390 print#1,xx"[157],";
1400 next
1410 print#1,"[157] "
1420 getq$:ifq$<>""then1470
1430 next
1440 print"press 'x' to get back to prompt[146]"
1450 getz$:ifz$<>""thenclose1:print"[147]":return
1460 goto1450
1470 print"press 'c' to continue -or-":print"press 'x' to get back to prompt"
1480 getq$:ifq$="c"then1430
1490 ifq$="x"thenclose1:c=co:print"[147]":return
1500 goto1480
1510 print"":rem rvs character********
1520 fori=0to7
1530 t=0
1540 forj=0to7
1550 x=peek(1024+40*(i+5)+(15-j))
1560 ifx=32thenpoke1024+40*(i+5)+(15-j),42:goto1580
1570 poke1024+40*(i+5)+(15-j),32
1580 next
1590 next
1600 return
1610 rem copy chars*********************
1620 ml=12*4096:ck=0:restore:fori=mltoml+46:reada:ck=ck+a:pokei,a:next
1630 ifck<>7117thenprint"checksum error[146]":stop
1640 print"[147]-in the process of copying character set":print"please wait."
1650 sys(ml)
1660 forxx=1to1000:next
1670 gosub1750:goto120
1680 data 120,169,51,133,1
1690 data 169,0,133,251,169,208,133,252
1700 data 169,0,133,253,169,48,133,254
1710 data 162,16,160,0,177,251,145,253
1720 data 200,192,0,208,247,230,252,230
1730 data 254,202,208,240
1740 data 169,55,133,1,88,96
1750 rem pick character set************
1760 poke204,0:poke53272,21:print"[147] 1) upper case"
1770 print" 2) lower case"
1780 print" 3) graphics chars"
1790 print" 4) rev upper case"
1800 print" 5) rev graphics chars"
1810 print" 6) rev lower case"
1820 print"enter the number of your choice":print"('x' to exit)?";
1830 getr$:ifr$=""then1830
1840 ifr$="x"thenprint"[147]bye now!!!":end
1850 r=val(r$)
1860 ifr<1orr>6thengoto1830
1870 ifr=1thenrl=0:rh=63:goto1930
1880 ifr=2thenrl=256:rh=319:goto1930
1890 ifr=3thenrl=64:rh=127:goto1930
1900 ifr=4thenrl=128:rh=191:goto1930
1910 ifr=5thenrl=198:rh=255:goto1930
1920 ifr=6thenrl=385:rh=488:goto1930
1930 poke204,1:poke53272,29:print"[147]":return
1940 rem help**************************
1950 poke53272,21
1960 print"[147]the following is a list of commands thatcan be called while";
1970 print" editing a character:"
1980 print"key ","function"
1990 print"[183][183][183] ","[183][183][183][183][183][183][183][183]"
2000 print"f1[146]","compile shape"
2010 print"f3[146]","return to prompt"
2020 print"f5[146]","save char file"
2030 print"f6[146]","load char file"
2040 print"f7[146]","data for char file"
2050 print" *[146]","put star at current location"
2060 print"' '","put space at current location"
2070 print"clr[146]","clear char box"
2080 print"home[146]","place cursor in upper left hand corner"
2090 print"ctrl 9[146]","reverses current char"
2100 print" n[146]","goes to next char"
2110 print" p[146]","goes to previous char"
2120 print">>>>cursor keys move cursor<<<<[146]"
2130 print"press 'x' to get back to prompt"
2140 getq$
2150 ifq$="x"thenprint"[147]":poke54272,29:return
2160 goto2140
2170 rem error checking***************
2180 iffd=8thengoto2220
2190 print"tape error[146]"
2200 fori=1to1000:next
2210 return
2220 print"disk error[146]"
2230 open15,8,15:input#15,a1$,b1$,c1$,d1$:printa1$;b1$;c1$;d1$:close15
2240 open15,8,15,"i0":close15
2250 fori=1to1000:next
2260 return