home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
64'er 1990 November
/
64er_Magazin_90-11_1990_Markt__Technik_de_Side_A.d64
/
editor.tolp
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2022-10-26
|
5KB
|
186 lines
10 rem **** editor.tolp 64 ****
12 :
20 dimli(32,2)
25 u$="":o$="[145]":r$="":l$="[157]":f7$="[136]":f1$="[133]":q=asc("#"):ab$="_":p=160
27 e$=chr$(13):printchr$(14)chr$(8):be=20000:bh=int(be/256):bl=be-bh*256
30 poke53280,11:poke53281,12:poke646,11
33 print"[147] programmed by [212]homas [211]chloegl [146]"
34 print""tab(7)"[144]----- editor.tolp 64[144] -----[151]"
35 printtab(8)"[1] designing a character"
37 printtab(8)"[2] look at a character"
40 printtab(8)"[3] loading a font"
42 printtab(8)"[4] saving a font"
45 getkk$:ifval(kk$)>4orval(kk$)=0then45
47 onval(kk$)goto60,5000,7000,6000
52 :
53 rem *** building the screen ***
60 gosub4200
90 x=0:y=0:s=asc("+"):x1=-1:poke1827,q
97 :
98 rem *** main-branch ***
100 xl=x:yl=y:gosub2000:onflgoto200,300,400,500,25
197 :
198 rem *** move the cursor ***
200 u=xl:v=yl:gosub3000:pokead,s:u=x:v=y:gosub3000:s=peek(ad)
205 ifs=160thenpokead,q+128:goto220
210 pokead,q
220 goto100
297 :
298 rem ** store the point and draw **
299 rem ** if it's necessary a line **
300 ifx=15andy=15then380
302 printza;" [145][145]"
305 ifza=0then310
307 ifli(za-1,0)=xandli(za-1,1)=ythen380
310 li(za,0)=x:li(za,1)=y:gosub3500:iffz=1then500
320 ifx1=-1thenx1=x:y1=y:u=x:v=y:gosub3000:pokead,q+128:s=p
330 x2=x:y2=y:gosub4000:x1=x2:y1=y2:goto100
380 print" not possible![145][145]":goto100
397 :
398 rem *** start a new line ***
400 ifx1=-1then100
405 printza;" [145][145]"
410 x1=-1:gosub3500:goto100
497 :
498 rem *** store the character ***
500 u=x:v=y:gosub3000:pokead,s:aa=0
505 ifco$=chr$(34)thenco$=co$+chr$(34)
510 print"[147][144]character: ","'"co$"' "co;asc(co$)"[151]"
520 fori=0to15:gosub600:next:poke198,0:wait198,1:print"[147]"
530 fori=16to31:gosub600:next
540 poke198,0:wait198,1:ifaa>0thenreturn
550 co=asc(co$):co=co+1:co$=chr$(co):gosub1517
560 gosub4210:goto90
600 li(i,2)=li(i,0)*16+li(i,1):printi,li(i,0),li(i,1),li(i,2)
610 pokebe+co*32+i,li(i,2):return
798 :
799 rem *** erase the li-array ***
800 fori=0to32:li(i,0)=15:li(i,1)=15:li(i,2)=255:next:return
997 :
998 :
999 rem *** subroutines ***
1000 print" 0123456789012345 [146]":return
1010 printtab(3)"[144]++++++++++++++++[151]":return
1498 :
1499 rem *** getting the character ***
1500 input"[144] character: c or asc";co$
1505 ifco$="_"thengosub1800:goto1500
1510 iflen(co$)>1thenco=val(co$):co$=chr$(co):goto1517
1515 ifco$=""then1500
1517 co=asc(co$):ifco<33or(co>93andco<160)then1500
1520 co=co-33:ifco>159thenco=co-99
1530 ifco>86then1500
1580 return
1800 print"":fori=33to93:co$=chr$(i):gosub1517:print,co,asc(co$),co$:next
1810 fori=asc("[193]")toasc("[218]"):co$=chr$(i):gosub1517:print,co,asc(co$),co$:next
1880 return
1997 :
1998 rem *** getting a key ***
2000 getk$:ifk$=u$ork$=o$ork$=r$ork$=l$ork$=f7$ork$=f1$ork$=e$ork$=ab$then2008
2005 goto2000
2008 fl=1
2010 ifk$=u$theny=y-1:ify=-1theny=15
2020 ifk$=o$theny=y+1:ify=16theny= 0
2030 ifk$=l$thenx=x-1:ifx=-1thenx=15
2040 ifk$=r$thenx=x+1:ifx=16thenx= 0
2050 ifk$=f1$thenfl=2
2060 ifk$=f7$thenfl=3
2070 ifk$=e$thenfl=4
2080 ifk$=ab$thenfl=5
2090 return
2997 :
2998 rem * transform u,v to an adress *
3000 ad=1024+(20-v)*40+u+3
3010 return
3500 ifza<29thenza=za+1:fz=0:return
3510 fz=1:return
3997 :
3998 rem ** draw from x1,y1 to x2,y2 **
4000 xx=x1:yy=y1
4005 dx=int(abs(x1-x2)):dy=int(abs(y1-y2))
4010 s1=sgn(x2-x1):s2=sgn(y2-y1)
4020 t=0:ifdx<dythendd=dx:dx=dy:dy=dd:t=1
4030 i1=2*dy:i2=2*dx:d=i1-dx
4040 fori=1todx:u=xx:v=yy:gosub3000:pokead,p
4050 ifd<0then4090
4060 ift=1thenxx=xx+s1:goto4080
4070 yy=yy+s2
4080 d=d-i2
4090 ift=1thenyy=yy+s2:goto4110
4100 xx=xx+s1
4110 d=d+i1:nexti
4120 u=xx:v=yy:gosub3000:pokead,q+128:s=p:return
4200 gosub1500
4210 print"[151][147] ----- editor.tolp 64 ----- [146]":za=0
4212 ifco$=chr$(34)thenco$=co$+chr$(34)
4214 print"[144] character: ","'"co$"' ",co;asc(co$)"[151]"
4215 ifkk$="1"thengosub4400:goto4222
4220 gosub4500
4222 gosub1000:fori=15to0step-1:a=(i/10-int(i/10))*10+176
4225 ifi<>3andi<>11thengosub1010:goto4230
4227 printtab(3)"[144]----------------[151]"
4230 poke1843-i*40,a:poke1826-i*40,a:next
4240 gosub1000:gosub800:poke55514,11:poke1242,160
4250 return
4400 print""tab(22)"[f1] set a point"
4410 printtab(22)"[f7] start a new"
4420 printtab(29)"line"
4430 printtab(22)"[cr] store"
4440 printtab(22)"[_] exit"
4450 return
4500 print""tab(22)"[f1] previous"
4505 printtab(29)"character"
4510 printtab(22)"[f7] next"
4515 printtab(29)"character"
4520 printtab(22)"[cr] data"
4530 printtab(22)"[_] exit"
4540 return
4998 rem *** showing a character ***
5000 gosub1500
5005 gosub4210:lu=0:iu=0:q=32
5010 forj=0to31:in=peek(be+co*32+j)
5020 x=int(in/16):y=in-x*16
5030 li(j,0)=x:li(j,1)=y:li(j,2)=in
5040 ifin=255theniu=iu+1:lu=0
5050 ifiu=2thenj=31:goto5100
5060 ifin=255then5100
5070 iu=0:lu=lu+1:iflu=1thenx2=x:y2=y:goto5100
5080 x1=x2:y1=y2:x2=x:y2=y
5090 gosub4000
5100 nextj:poke198,0
5110 getk$:ifk$<>f7$andk$<>f1$andk$<>ab$andk$<>e$then5110
5115 ifk$=f1$thenco=co-1:ifco<0thenco=0
5120 ifk$=f7$thenco=co+1:ifco>86thenco=86
5125 ifco>60thenco$=chr$(co+132)
5127 ifco<61thenco$=chr$(co+33)
5130 ifk$=ab$then25
5140 ifk$=e$thenaa=1:gosub505:goto5110
5150 goto5005
5998 :
5999 rem *** save a font ***
6000 gosub8000:iffo$="_"then25
6005 fo$="@0:"+fo$
6010 gosub8200:gosub8300:sys19021
6020 goto25
6998 :
6999 rem *** load a font ***
7000 gosub8000:iffo$="_"then25
7010 gosub8200:gosub8300:sys19000
7020 goto25
7998 :
7999 rem *** get a fontname ***
8000 input"[144] name of the font:";fo$
8040 return
8198 :
8199 rem ** write fo$ to 19800/$4d58 **
8200 fori=1tolen(fo$):poke19800+i-1,asc(mid$(fo$,i,1)):next
8210 return
8298 :
8299 rem *** load the ass-routine ***
8300 i=0:restore
8310 readin:ifin>=0thenpoke19000+i,in:i=i+1:goto8310
8320 poke251,bl:poke252,bh:poke19008,len(fo$):poke19027,len(fo$):return
8500 data162,8,160,1,32,186,255,169,0,162,88,160,77,32,189,255
8510 data169,0,76,213,255,162,8,32,186,255,169,0,162,88,160,77,32,189
8520 data255,169,251,162,0,160,89,76,216,255,-1