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