home *** CD-ROM | disk | FTP | other *** search
/ Compute! Gazette 1995 February / 1995-02b.d64 / mapmaker (.txt) < prev    next >
Encoding:
Commodore BASIC  |  1995-01-01  |  15.1 KB  |  384 lines
  1. 0 rem copyright 1995 - compute publication intl ltd - all rights reserved
  2. 1 poke55,0:poke56,80:clr:goto9000
  3. 3 poke51200,0:poke49153,0:poke53280,0:poke53281,0:print"":end
  4. 5 poke648,4:poke2,0:sys2
  5. 6 fori=1to22:forj=1to9:printi;:next:print:next:print"";:    end
  6. 2700 rem"[162][162]set colors
  7. 2705 x[178]49195:[151]x,c(0):[129]j[178]0[164]3:[151]x[170]1[170]j,c(j):[130]:[151]646,c(5)
  8. 2710 [151]53280,c(4):[158]49176:[142]
  9. 2800 [143]"newnewmed-res setup
  10. 2805 ifh<57orh>252thenh=200
  11. 2810 if(peek(789)and240)=192then2850
  12. 2815 x=52160:for i=0 to 5*3-1:poke x+i,255:next:fori=ito 63:poke x+i,0:next
  13. 2820 v=53248:pokev+21,0:fl=0
  14. 2825 for i=0 to 6:poke 53240+i,47
  15. 2830 x=i*48+24:pokev+i*2,xand255:ifx>255thenfl=fl+int(2^i)
  16. 2835 poke v+39+i,c(4):next:pokev+16,fl:pokev+29,127
  17. 2845 poke53269,0:sys49185:sys49167:poke780,252:sys49173:poke 648,204
  18. 2850 ifh<251then2880
  19. 2860 poke780,h:sys49173:poke53269,0:fori=53249toi+12step2:pokei,h-2:next:return
  20. 2880 poke53269,0:fori=53249toi+12step2:pokei,h-2:next:poke53269,127
  21. 2885 poke780,h:sys49173:return
  22. 3000 rem"[162][162][162][162][162][162]screen list
  23. 3010 [141]4600:[139]x[179]0[167][142]
  24. 3015 ec[178]x:bp[178]fe(ec):ll[178]fl(ec)
  25. 3020 la$[178]" (NULL)ot:     #  (NULL)atitude  (NULL)ongitude  valstr$right$(NULL) wait"
  26. 3025 lz$[178]"len(NULL)(NULL)-(NULL)croll right$(NULL)(NULL)/str$val(NULL)/(NULL)val(NULL)-valdit (NULL)left$/(NULL)val(NULL)-valxitwait":lc$[178]"len(NULL)(NULL)(NULL)val(NULL)(NULL)>"
  27. 3030 [153]"load":[141]3600:[153]"":c[178]1:t[178]8
  28. 3035 [129]c[178]1[164]23:[141]3500:[130]:lz[178]c:la[178]1
  29. 3045 [151]781,1:[151]782,0:[158]58636:[153]lc$
  30. 3050 [151]198,0:[146]198,7:[161]x$:x[178][198](x$):[139]x[178]141[167][153]"load";:[142]
  31. 3055 [151]781,1:[151]782,0:[158]58636:[153][200](bl$,[195](lc$))
  32. 3060 x[178][171](x[178]145)[171]2[172](x[178]17)[171]3[172](x[178]13)[171]4[172](x[178]148)[171]5[172](x[178]20)
  33. 3065 [145]x[141]3100,3200,3300,3150,3250:[137]3045
  34. 3100 [143]"newnewcur up
  35. 3105 ifla<2thenreturn
  36. 3110 poke781,23:sys59903:poke218,132:print"[157]"chr$(148):poke218,132
  37. 3115 print"":la=la-1:lz=lz-1:c=la:gosub3500:goto3600
  38. 3150 rem"[162][162]insert
  39. 3155 [139]fl(ec)[170]4[177]zl[167]3630
  40. 3160 x[178]fe(ec)[170]la[172]4:y[178](fl(ec)[171]la[170]2)[172]4:[158]49182,x,x[170]4,y:fl(ec)[178]fl(ec)[170]1:ll[178]ll[170]1
  41. 3165 [151]x,48:[151]x[170]1,42:[151]x[170]2,48:[151]x[170]3,42
  42. 3170 la[178]la[170]1:lz[178]lz[170]1:[141]3100:[153]"":x[178]lz[171]1:[139]x[177]ll[167]x[178]ll
  43. 3175 [129]i[178]la[164]x:[153][163]t)[201]("  "[170][196](i),3):[130]:fd(ec)[178]1:[142]
  44. 3200 [143]"newnewcur down
  45. 3205 ifla>ll-1thenreturn
  46. 3210 c=lz:lz=lz+1:la=la+1
  47. 3215 poke218,132:poke781,1:sys59903:poke781,24:sys59903:sys59626:gosub3600
  48. 3220 poke781,23:poke782,0:sys58636
  49. 3225 iflz<ll+2then3500
  50. 3230 return
  51. 3250 rem"[162][162]delete rec
  52. 3255 [139]fl(ec)[179][178]1[176]ll[179][178]la[167][142]
  53. 3260 [141]3200:x[178]fe(ec)[170]la[172]4:y[178](fl(ec)[171]la[170]3)[172]4:[158]49182,x,x[171]4,y:fl(ec)[178]fl(ec)[171]1
  54. 3265 [153]"":ll[178]ll[171]1:la[178]la[171]1:lz[178]lz[171]1:x[178]lz[171]1:[139]x[177]ll[171]1[167]x[178]ll
  55. 3270 [129]i[178]la[164]x:[153][163]t)[201](" "[170][196](i),3):[130]:fd(ec)[178]1:[142]
  56. 3300 [143]"newnewenter/edit
  57. 3305 fd(ec)=1:c=la:print""lc$:print"";
  58. 3310 ifla<llandpeek(t+peek(648)*256+45)<>63thengosub3500:goto3350
  59. 3315 ifll*4+30>zmthen3630
  60. 3340 fl(ec)=fl(ec)+1:x$="0   0  n  0   0  w":printtab(t)x$
  61. 3350 print"":x=t+5:y=6:z=1:gosub3400:a=b:ifx=0then3370
  62. 3355 gosub3900:iffthen3375
  63. 3360 goto3350
  64. 3370 x=t+15:y=16:z=2:gosub3400
  65. 3375 p=c*4+bp:pokep,fnl(a):pokep+1,fnh(a):pokep+2,fnl(b):pokep+3,fnh(b)
  66. 3380 ifla=llthenll=ll+1:print"";:pokep+5,255:c=ll:gosub3500:c=la:print"[145][145]";
  67. 3385 print"[145]":goto3500
  68. 3400 rem"[162][162]get d/m/dir-set x,y,z,x$
  69. 3410 [153]:[153][163]x)"on";:y$[178][202](x$,y,3):[158]in,y$,y$,11:[139]y$[178]""[167]3410
  70. 3413 b[178][197](y$):[139][182]([181](b))[179][177]b[176]b[177]179[167]3410
  71. 3414 [139]z[178]1[175]b[177]89[167]3410
  72. 3415 [139]b[177]0[176][200](y$,1)[178]"0"[167]3420
  73. 3418 [139]z[177]1[167]3420
  74. 3419 x[178][171]1:[142]
  75. 3420 [153]:[153][163]x[170]4)"on";:y$[178][202](x$,y[170]4,2):[158]in,y$,y$,9:[139]y$[178]""[167]3420
  76. 3425 w[178][197](y$):[139][182]([181](w))[179][177]w[176]w[177]59[167]3420
  77. 3430 b[178]b[172]60[170]w
  78. 3435 [153]:[153][163]x[170]7)"on";:y$[178][202](x$,y[170]7,1):[158]in,y$,y$,2
  79. 3440 w[178]0:z$[178]"nwse":[129]i[178]z[164][195](z$)[169]2:w[178]w[171](y$[178][202](z$,i,1))[172]i:[130]
  80. 3445 [139]w[178]0[167]3435
  81. 3450 b[178]10800[170]b[172]((w[179]3)[171](w[177]2)):x[178]0
  82. 3455 [153]:[153]"on";:[142]
  83. 3460 [143]"newnewget y->x$ dir
  84. 3465 x$="ns":ifz=1then3475
  85. 3470 x$="we"
  86. 3475 x$=mid$(x$,2+(fnns(y)<0),1)
  87. 3480 x$=right$(" "+str$(fnnd(y)),3)+right$(" "+str$(fnnm(y)),3)+" "+x$:return
  88. 3500 rem"[162][162]out line c
  89. 3505 p[178]bp[170]c[172]4:a[178][165]d(p):[139]c[177]ll[167][153][200](bl$,39):[142]
  90. 3510 x$[178][201](" "[170][196](c),3)[170]":close"
  91. 3515 [139]c[178]ll[167][153][200](bl$,39):[153]"on"[163]t)x$" -------eof-------":[142]
  92. 3520 [139]a[179]16200[175]a[177]5399[167]3525
  93. 3522 x[178]a[173]256:[139]x[177]249[175]x[179]256[167][141]3800:x$[178][200](x$[170]y$[170]bl$,39[171]t):[139]f[167]3555
  94. 3523 x$[178]x$[170]"?   ?  ?  ?   ?  ?":p[178]p[171]4:[137]3555
  95. 3525 [158]cv,a:x$[178]x$[170][201](" "[170][196]([194](782)),3)[170][201](" "[170][196]([194](780)),3)
  96. 3530 x$[178]x$[170]" "[170][202]("sn",[194](781),1)[170]"  "
  97. 3535 b[178][165]d(p[170]2):[139]b[177]21599[167]a[178]1e9:[137]3510
  98. 3540 [158]cv,b
  99. 3544 x$[178]x$[170][201](" "[170][196]([194](782)),3)[170][201](" "[170][196]([194](780)),3)
  100. 3545 x$[178]x$[170]" "[170][202]("ew",[194](781),1)
  101. 3555 p[178]p[170]4:[153][163]t)x$[200](bl$,39[171][195](x$)[171]t):[142]
  102. 3600 [143]"newnewset top/botlines
  103. 3605 print""la$""fl(ec)-1"[146]"
  104. 3610 poke781,24:poke782,0:sys58636:printlz$;:return
  105. 3630 rem"[162][162]full list
  106. 3635 [153]""[200](bl$,39)""[163]t[170]4)" (NULL)ist ascull wait"
  107. 3640 [129]i[178]1[164]1500:[130]:[137]3500
  108. 3650 [143]"newnewcreate empty map
  109. 3655 gosub4700:ifx<1thenreturn
  110. 3660 print"[197]nter [205]ap [206]ame: ";:sysin,left$(bl$,16),x$:ifx$=""thenreturn
  111. 3665 x=fs(zc)+1:fori=1tolen(x$):pokex+i,asc(mid$(x$,i,1)):next:pokei+x,160
  112. 3670 ft$(zc)=x$:return
  113. 3700 rem"[162][162]del map
  114. 3705 [141]4600:[139]x[179]0[167][142]
  115. 3710 [151]fs(x),0:[139]x[177][178]zc[167]3725
  116. 3715 [129]i[178]x[164]zc[171]1:fl(i)[178]fl(i[170]1):fs(i)[178]fs(i[170]1):fe(i)[178]fe(i[170]1):ft$(i)[178]ft$(i[170]1)
  117. 3720 fd(i)[178]fd(i[170]1):fx(i)[178]fx(i[170]1):[130]
  118. 3725 zc[178]zc[171]1:[142]
  119. 3800 [143]"newnewhandle commands x->x$
  120. 3805 f=1:y=peek(p+2):y$=mid$(str$(1e3+y),4,2)
  121. 3810 ifx>249thenonx-249goto3860,3850,3820,3840,3830
  122. 3815 f=0:return
  123. 3820 y$="g"+mid$("+xo",y,1)+"   graphic character":return
  124. 3830 y$="c"+y$+"  set curr. color="+y$:return
  125. 3840 z$=right$(y$,1):y$="d"+z$+"   draw with pen # "+z$:return
  126. 3850 y$="pu   pick up pen":return
  127. 3860 y$="pd   put down pen":return
  128. 3900 rem"[162][162]enter commands y$->a,b
  129. 3905 f[178]1:b[178][197]([202](y$,2,5))
  130. 3910 x[178]0:z$[178]"cdgotop":[129]i[178]1[164][195](z$):x[178]x[171]([200](y$,1)[178][202](z$,i,1))[172]i:[130]
  131. 3915 [145]x[170]1[137]3920,3925,3935,3945,3960
  132. 3920 a[178]0:b[178]0:f[178]0:[142]
  133. 3925 [139]b[177]15[176]b[179]0[176]b[179][177][181](b)[167]3920
  134. 3930 a[178]254[172]256:[142]
  135. 3935 [139]b[177]3[176]b[179]0[176][181](b)[179][177]b[167]3920
  136. 3940 a[178]253[172]256:[142]
  137. 3945 b[178]0:y$[178][201](y$,1):z$[178]"+xo":[129]i[178]1[164][195](z$):b[178]b[171](y$[178][202](z$,i,1))[172]i:[130]
  138. 3950 [139]b[178]0[167]3920
  139. 3955 a[178]252[172]256:[142]
  140. 3960 y$[178][201](y$,1):[139]y$[178]"u"[167]a[178]251[172]256:[142]
  141. 3965 [139]y$[179][177]"d"[167]3920
  142. 3970 a[178]250[172]256:[142]
  143. 4600 [143]"newnewlists-sel.item x ((NULL)val(NULL)=0)
  144. 4605 x=-1:ifzc<1thenprint" [206]o [205]aps in [205]emory [146]":return
  145. 4610 x$="[192][192][192] [205]ap [211]election [205]enu [192][192][192]":printtab(38+(40-len(x$))/2)x$""
  146. 4615 fori=1tozc:x=fs(i)+2
  147. 4625 printtab(12)chr$(i+64)"-"ft$(i):next
  148. 4630 print"  [211]elect [205]ap  (or [208]ress [210][197][212][213][210][206] to [197]xit) [146]"
  149. 4635 poke198,0:wait198,7:getx$:x=asc(x$)-64:print"[147]":ifx=-51thenx=-1:return
  150. 4640 ifx<1orx>=ithenprint" [197]nter a - "chr$(63+i)" only [146]":goto4610
  151. 4695 return
  152. 4700 rem"[162][162]new entry:x-ptr (0=full)
  153. 4703 x[178]0:[129]i[178]ms[164]me[169]zm:[139][194](i)[179][177]60[167]x[178]i:i[178]1e9
  154. 4704 [130]:[139]x[179]1[167][153]" (NULL)o (NULL)oom for valntry wait":[142]
  155. 4705 [151]x,60:[151]x[170]1,159:[151]x[170]25,255:zc[178]zc[170]1:fs(zc)[178]x:fe(zc)[178]x[170]20:fl(zc)[178]1
  156. 4720 fx(zc)[178]0:fd(zc)[178]1:[151]x[170]2,63:[151]x[170]3,160:ft$(zc)[178]"?":[142]
  157. 4750 [143]"newnewquit
  158. 4755 ifzc<1then4780
  159. 4760 x=0:fori=1tozc:x=fd(i)+x:next:ifx=0then4780
  160. 4765 print" [198]iles [195]hanged and [206]ot [211]aved [146]"
  161. 4770 fori=1tozc:iffd(i)thenprinttab(t)ft$(i)
  162. 4775 next
  163. 4780 print"[208]ress 'y' to [209]uit":poke198,0:wait198,7:getx$:ifx$<>"y"thenreturn
  164. 4785 poke648,4:poke2,0:sys2:end
  165. 4800 rem"[162][162]save file
  166. 4805 [141]4600:ec[178]x:[139]x[179]0[167][142]
  167. 4815 [153]"ascilename: ";:[158]in,[200](ft$(x)[170]bl$,16),x$:[153]"":[139]x$[178]""[167][142]
  168. 4820 [129]i[178]1[164][195](x$):[151]fs(x)[170]1[170]i,[198]([202](x$,i,1)):[130]:[151]fs(x)[170]i[170]1,160
  169. 4825 ft$(x)[178]x$:a[178]fs(x):z[178]a[170]fl(x)[172]4[170]23
  170. 4830 [141]4840:[141]47050:[141]4845:[139]x[167][142]
  171. 4835 [153]"(NULL)uccessful (NULL)ave":fd(ec)[178]0:[142]
  172. 4840 [151]53269,0:[142]:[143]"newnewprep in
  173. 4845 poke53269,127:return:rem"[162][162]prepout
  174. 4850 [143]"newnewload file #
  175. 4855 gosub4700:ifx<1thenreturn
  176. 4860 print"[198]ilename: ";:sysin,left$(bl$,16),x$:print"":ifx$=""then4875
  177. 4865 ft$(zc)=x$:a=fs(zc):gosub4840:gosub47000:gosub4845:ifx=0then4880
  178. 4875 pokefs(zc),0:zc=zc-1:return
  179. 4880 x=fs(zc):ifpeek(x)<>60orpeek(x+1)<>159thenprint"[206]ot [205]ap [198]ile[146]":goto4875
  180. 4883 y=1:x=fs(zc)+2:x$="":print"processing..."
  181. 4885 ify<17andpeek(x)<>160thenx$=x$+chr$(peek(x)):x=x+1:y=y+1:goto4885
  182. 4890 ft$(zc)=x$:x=fe(zc)+5:y=fs(zc)+zm-5
  183. 4895 ifpeek(x)<>255andx<ythenx=x+4:goto4895
  184. 4898 pokex,255:fl(zc)=int((x-fe(zc))/4):print"[211]uccessful [204]oad":return
  185. 4900 rem"[162][162]setup memory
  186. 4903 me[178]40950:ms[178][194](55)[170]256[172][194](56)
  187. 4904 x[178]18432:y[178][194](56):[139]y[179]73[175]y[177]70[175][194](x)[178]120[175][194](x[170]1)[178]76[167]ms[178]32768
  188. 4905 zm[178]950:zl[178][181]((zm[171]24)[173]4):ze[178]1[170][181]((me[171]ms)[173]zm):zc[178]0
  189. 4908 [134]ft$(ze),fs(ze),fe(ze),fl(ze),fd(ze),fx(ze)
  190. 4909 [153]"available:"ze[171]1"entries of"zl[171]4"recs
  191. 4910 fori=mstoms+zm*ze-9stepzm:print".";
  192. 4913 ifpeek(i)<>60orpeek(i+1)<>159thenpokei,0:goto4990
  193. 4915 zc=zc+1:x$="":y=1:x=i+2:fs(zc)=i:fe(zc)=i+20
  194. 4920 ify<17andpeek(x)<>160thenx$=x$+chr$(peek(x)):x=x+1:y=y+1:goto4920
  195. 4925 ft$(zc)=x$:fe(zc)=i+20:x=fe(zc)+5:y=i+zm-5
  196. 4930 ifpeek(x)<>255andx<ythenx=x+4:goto4930
  197. 4935 pokex,255:fl(zc)=int((x-fe(zc))/4)
  198. 4990 next:return
  199. 5000 rem"[162][162]view
  200. 5005 [141]5600:[139]x[178]0[167][142]
  201. 5010 x[178]0:[129]i[178]1[164]zc:x[178]x[170]fx(i):[130]:[139]x[178]0[167][153]" (NULL)o (NULL)ists (NULL)elected wait":[142]
  202. 5020 [141]5500:cp[178]3:[129]i[178]1[164]zc:[139]fx(i)[178]0[167][130]:[137]5070
  203. 5025 ya[178][171]1:p[178]fe(i)[170]4:pu[178]0
  204. 5030 xc[178]xa:yc[178]ya:[139][194](198)[167]i[178]1e9:[130]:[137]5070
  205. 5033 y0[178][165]d(p):x0[178][165]d(p[170]2):p[178]p[170]4:[139]y0[177]16199[176]y0[179]5401[167]5100
  206. 5035 ya[178]y0:xa[178]x0:[139]pu[179][177]0[176]yc[179]0[167]5030
  207. 5040 x1[178]xc:y1[178]yc:[141]5700:[139]f[167]5030
  208. 5060 [158]49161,x3,y3:[158]49161,x2,y2:[158]49164:[137]5030
  209. 5070 [153]"       (NULL)ress atnny (NULL)ey (NULL)o lenontinue       ";:[146]198,7:[151]198,0
  210. 5095 c(0)[178]c(6):[141]2700:[158]49185:h[178]252:[137]2800
  211. 5100 [143]"newnewexecute cmds
  212. 5105 a=int(y0/256):b=fnl(x0):on(256-a)goto5110,5120,5130,5150,5140,5145
  213. 5110 next:goto5070
  214. 5115 goto5030
  215. 5120 c(cp)=band15:gosub2700:gosub5580:goto5115
  216. 5130 cp=band3:poke49194,cp:goto5115
  217. 5140 pu=1:goto5115
  218. 5145 pu=0:goto5115
  219. 5150 onbgosub5160:goto5115
  220. 5160 return
  221. 5500 rem"[162][162]edit view
  222. 5503 [153]"load":[139]yb[179]0[167]5510
  223. 5505 [141]5580:[153]:[153]"    (NULL)ress 'y' to (NULL)etain (NULL)creen (NULL)iew"
  224. 5508 [151]198,0:[146]198,7:[161]x$:[153]"load":[139]x$[178]"y"[167]5570
  225. 5510 [153]"load   valnter (NULL)creen peekoundary lenoordinates"
  226. 5515 t[178]20:yr[178]21:y[178]xl:z[178]2:[141]3460:[153]"  (NULL)eft: "x$
  227. 5520 [153]"on";:y[178]1:x[178]8:z[178]2:[141]3400:xl[178]b:[139]x[167]5520
  228. 5525 y[178]xr:z[178]2:[141]3460:[153][163]t)" (NULL)ight: "x$;:y[178]1:x[178]t[170]8:[141]3400:xr[178]b
  229. 5535 y[178]yt:z[178]1:[141]3460:[153]"   (NULL)op: "x$;:y[178]1:x[178]8:[141]3400:yt[178]b
  230. 5540 yb[178][181](yt[170](xr[171]xl)[172](200[171]yr)[172]as[173]160)
  231. 5543 [139]yb[177]16199[176]yb[179]5401[167]yb[178]16199:[137]5550
  232. 5545 ub[178][165]nv(yb):ut[178][165]nv(yt):ux[178]ub
  233. 5548 [129]i[178]1[164]10:ux[178]ut[171](ut[171]ub)[172]([190]((ut[170]ux)[172][255][173]360)):[130]:yb[178][165]vn(ux)
  234. 5550 y[178]yb:z[178]1:[141]3460:[153][163]t)"peekottom: "x$;:y[178]1:x[178]t[170]8:[141]3400:yb[178]b
  235. 5555 [139]xr[179]xl[170]1[167][153]"right$nvalid left, rightwait":[129]i[178]1[164]1500:[130]:[137]5510
  236. 5560 [139]yb[179]yt[170]1[167][153]"right$nvalid top, bottomwait":[129]i[178]1[164]1500:[130]:[137]5510
  237. 5570 xs[178]159[173](xr[171]xl):ys[178](199[171]yr)[173](yb[171]yt)
  238. 5575 [158]49185:h[178]68:[141]2800:[137]5580
  239. 5580 [143]
  240. 5582 [153]"   (NULL)op     peekottom    (NULL)eft      (NULL)ight"
  241. 5584 z[178]2:y[178]yt:[141]5595:[153]" (NULL)="x$,
  242. 5586 y[178]yb:[141]5595:[153]"peek="x$,
  243. 5587 z[178]1:y[178]xl:[141]5595:[153]"(NULL)="x$,
  244. 5588 y[178]xr:[141]5595:[153]"(NULL)="x$;:[142]
  245. 5595 [143]
  246. 5596 x$[178]"ns":[139]z[178]2[167]5598
  247. 5597 x$[178]"we"
  248. 5598 x$[178][202](x$,2[170]([165]ns(y)[179]0),1)
  249. 5599 x$[178][196]([165]nd(y))[170][196]([165]nm(y))[170]x$:x$[178][201](x$,[195](x$)[171]1):[142]
  250. 5600 [143]"newnewlists-sel.item x ((NULL)val(NULL)=0)
  251. 5605 x=0:ifzc<1thenprint" [206]o [205]aps in [205]emory [146]":return
  252. 5610 print"":x$="[192][192][192] [205]ap [211]election [205]enu [192][192][192]":printtab(38+(40-len(x$))/2)x$""
  253. 5620 fori=1tozc:x=fs(i)+2
  254. 5625 printtab(10)mid$("  [186] ",fx(i)*2+1,2)chr$(i+64)"-"ft$(i):next
  255. 5630 print"  [211]elect/[195]ancel [195]hoices ([210][197][212][213][210][206] [212]o [197]nd) [146]"
  256. 5635 poke198,0:wait198,7:getx$:x=asc(x$)-64:ifx=-51thenx=9:print"[147]":return
  257. 5640 print""left$(bl$,39)""
  258. 5645 ifx<1orx>=ithenprint" [197]nter a - "chr$(63+i)" only [146]":goto5610
  259. 5695 fx(x)=1-fx(x):goto5610
  260. 5700 rem"[162][162]clip p0=(x0,y0), p1=(x1,y1)
  261. 5703 f[178]1:[139]x1[179][177]x0[167]sx[178](y1[171]y0)[173](x1[171]x0)
  262. 5705 [139]y1[179][177]y0[167]sy[178](x1[171]x0)[173](y1[171]y0)
  263. 5708 :  [143] xr clipping
  264. 5710 [139]x0[179][178]xr[167]5725
  265. 5715 [139]x1[177]xr[167][142]
  266. 5720 y0[178]sx[172](xr[171]x0)[170]y0:x0[178]xr:[137]5735
  267. 5725 [139]x1[179][178]xr[167]5735
  268. 5730 y1[178]sx[172](xr[171]x0)[170]y0:x1[178]xr
  269. 5735 :  [143] xl clipping
  270. 5740 [139]x0[177][178]xl[167]5755
  271. 5745 [139]x1[179]xl[167][142]
  272. 5750 y0[178]sx[172](xl[171]x0)[170]y0:x0[178]xl:[137]5765
  273. 5755 [139]x1[177][178]xl[167]5765
  274. 5760 y1[178]sx[172](xl[171]x0)[170]y0:x1[178]xl
  275. 5765 :  [143] yb clipping
  276. 5770 [139]y0[179][178]yb[167]5785
  277. 5775 [139]y1[177]yb[167][142]
  278. 5780 x0[178]sy[172](yb[171]y0)[170]x0:y0[178]yb:[137]5795
  279. 5785 [139]y1[179][178]yb[167]5795
  280. 5790 x1[178]sy[172](yb[171]y0)[170]x0:y1[178]yb
  281. 5795 :  [143] yt clipping
  282. 5800 [139]y0[177][178]yt[167]5815
  283. 5805 [139]y1[179]yt[167][142]
  284. 5810 x0[178]sy[172](yt[171]y0)[170]x0:y0[178]yt:[137]5825
  285. 5815 [139]y1[177][178]yt[167]5825
  286. 5820 x1[178]sy[172](yt[171]y0)[170]x0:y1[178]yt
  287. 5825 :::
  288. 5830 x2[178][181]((x0[171]xl)[172]xs)
  289. 5835 y2[178][181]((y0[171]yt)[172]ys[170]yr)
  290. 5840 x3[178][181]((x1[171]xl)[172]xs)
  291. 5845 y3[178][181]((y1[171]yt)[172]ys[170]yr)
  292. 5895 f[178]0:[142]
  293. 9000 [143]"newnewinit
  294. 9005 gosub63999:sysx:in=51200:cv=50800
  295. 9050 deffnd(x)=peek(x)+256*peek(x+1)
  296. 9055 deffnns(x)=(x<10800)-(x>10799)
  297. 9060 deffnxx(x)=(x-10800)/((x<10800)-(x>10799))
  298. 9065 deffnnd(x)=int((x-10800)/((x<10800)-(x>10799))/60)
  299. 9068 deffnnm(x)=(x-10800)/((x<10800)-(x>10799))-fnnd(x)*60
  300. 9070 deffnnv(x)=-((fnnd(x)+fnnm(x)/60)*fnns(x))
  301. 9073 deffnvn(x)=10800-sgn(x+.01)*int(abs(x*60))
  302. 9075 deffnh(x)=int(x/256)
  303. 9080 deffnl(x)=x-fnh(x)*256
  304. 9085 bl$="                                                    "
  305. 9090 as=.63:yt=8580:xl=5520:xr=6720:yb=-1
  306. 9100 dim c(6):c(0)=0:c(1)=1:c(2)=7:c(3)=7:c(4)=12:c(5)=1:c(6)=c(0):rem colors
  307. 9125 x=700:pokex,169:pokex+1,0:pokex+2,133:pokex+3,145:pokex+4,76
  308. 9130 pokex+5,peek(655):pokex+6,peek(656)
  309. 9135 y=peek(56334):poke56334,0:poke655,fnl(x):poke656,fnh(x):poke56334,y
  310. 9140 h=252:gosub2800:print"[147]":gosub2700:print" "
  311. 9190 in=51200:gosub4900:print"[147]"
  312. 9195 gosub14000:goto9195
  313. 14000 rem"[162][162]menu/calling routine
  314. 14005 [141]14080
  315. 14010 [158]vg[170]6,14100:[135]x$:y[178](40[171][195](x$))[173]2[171]2:[153][163]80[170]y)x$"":y[178]0
  316. 14020 [135]x$:[139]x$[179][177]"xxx"[167][153][163]12)[199](y[170]65)"-"x$:[135]x:y[178]y[170]1:[137]14020
  317. 14030 [153][163]9)" (NULL)lease (NULL)elect a-"[199](y[170]64)" wait"
  318. 14035 [151]198,0:[146]198,7:[161]x$
  319. 14040 x[178][198](x$)[171]64:[153]"load"
  320. 14043 [139]x$[177][178]"a"[175]x$[179][178][199](64[170]y)[167]14050
  321. 14045 [153]" valnter a - "[199](64[170]y)" only wait":[137]14010
  322. 14050 dm[178][198](x$)[171]65:[158]vg[170]6,14100:[135]x$
  323. 14055 [129]i[178]0[164]dm:[135]x$,x:[130]:[153]""x$"wait":[158]vg[170]3,x
  324. 14080 [143]"tantantanml code: sys vg,x - gosub xsys vg+3-goto x: sys vg+6- restore x
  325. 14079 x$="[144][144]? [168] [138][173] [247][183] [166][164]{$60}[166]_[208][136][202][138]8l$[168][169] [251][163][165]{$7b}h[165]Zh[165]:h[165]9h[169][141]h [170][166] [168] [138][173] [247][183] [163][168]l[174][167] [168] [138][173] [247][183]l[163][168]                                  "
  326. 14090 sys45195x$:x=peek(780)+256*peek(781):vg=peek(x+1)+256*peek(x+2):return
  327. 14100 rem"[192][192]data items- 1st entry title followed by choice/goto line # pair
  328. 14105 [131]"tantantan (NULL)ap (NULL)aker tantantan"
  329. 14110 [131]"lenreate (NULL)ap",3650
  330. 14115 [131]"valrase (NULL)ap",3700
  331. 14120 [131]"valdit (NULL)aps",3000
  332. 14125 [131]"(NULL)ave (NULL)aps",4800
  333. 14130 [131]"(NULL)oad (NULL)aps",4850
  334. 14135 [131]"(NULL)iew (NULL)aps",5000
  335. 14195 [131]"(NULL)uit",4750
  336. 14200 [131] xxx:[143]"tantantanthis is end
  337. 47000 rem"[192][192][192]load binary file
  338. 47005 [143]"tantantanin:x$-name a-start         out:x=0,z=end(ok), x=er#,x$=mess(not)
  339. 47010 z=a:y=678:fori=1tolen(x$):pokey+i,asc(mid$(x$,i,1)):next
  340. 47015 gosub47470:poke780,d:poke781,8:poke782,0:sys65466
  341. 47020 poke781,167:poke782,2:poke780,len(x$):sys65469
  342. 47025 poke780,0:poke782,int(a/256):poke781,a-peek(782)*256:sys65493
  343. 47035 gosub47300
  344. 47040 z=peek(781)+256*peek(782):return
  345. 47050 rem"[192][192][192]save binary file
  346. 47055 [143]"tantantanin:x$-name a-start z-end  out:x=0,(ok),x=er#,x$=mess(not)
  347. 47060 y=678:fori=1tolen(x$):pokey+i,asc(mid$(x$,i,1)):next
  348. 47065 gosub47470:poke780,d:poke781,8:poke782,1:sys65466
  349. 47070 poke781,167:poke782,2:poke780,len(x$):sys65469
  350. 47075 poke3,int(a/256):poke2,a-peek(3)*256:poke780,2
  351. 47080 poke782,int(z/256):poke781,z-peek(782)*256:sys65496
  352. 47085 gosub47300:return
  353. 47100 rem"[192][192][192]open file   in: x$-message out:d-dv# x=0(ok),x=er#,x$=message(not)
  354. 47110 y[178]678:[129]i[178]1[164][195](x$):[151]y[170]i,[198]([202](x$,i,1)):[130]
  355. 47115 [151]781,167:[151]782,2:[151]780,[195](x$):[158]65469
  356. 47120 [141]47470:[151]780,d:[151]781,8:[151]782,0:[158]65466:[158]65472
  357. 47125 [141]47300:[142]
  358. 47200 [143]"tantantanget error message in:x-#         out x$-message
  359. 47203 ifx=0thenx=30
  360. 47205 ifx>30thenx$="err#"+str$(x):return
  361. 47208 x=41766+2*x:x=peek(x)+256*peek(x+1):x$=""
  362. 47210 x$=x$+chr$(peek(x)and127):ifpeek(x)<128thenx=x+1:goto47210
  363. 47215 return
  364. 47300 rem"[162][162]error check-disk
  365. 47306 [141]47400:[139]en[177]0[167]47320
  366. 47310 [139]([194](783)[175]1)[178]0[167]x[178]0:[142]
  367. 47315 x[178][194](780):[141]47200
  368. 47320 [153]" "x$" wait":x[178][171]1:[142]
  369. 47400 [143]"tantantancheck disk err channel
  370. 47402 d=15:gosub47480:ify=0thenopen15,8,15
  371. 47404 input#15,en,em$,et,es:x$=str$(en)+" "+em$+str$(et)+str$(es)+" "
  372. 47408 return
  373. 47470 rem"[192][192][192]get avail dev#->d
  374. 47472 d[178][181]([187](0)[172]16):[141]47480:[139]y[167]47472
  375. 47478 [142]
  376. 47480 [143]"tantantancheck if dev d open
  377. 47482 x=peek(152):y=0:ifx=0thenreturn
  378. 47484 fori=601to600+x:ifpeek(i)=dtheny=-1:i=1e6
  379. 47486 next:return
  380. 47490 rem"[192][192][192]closeall
  381. 47496 x[178][194](152):[139]x[167][129]i[178]601[164]600[170]x:[160][194](i):[130]:[143]"tantancloseall
  382. 47498 return
  383. 63999 x=peek(61)+256*peek(62)+30:return
  384.