home *** CD-ROM | disk | FTP | other *** search
/ Compute! Gazette 1995 February / 1995-02b.d64 / mapmaker (.txt) < prev    next >
Commodore BASIC  |  2022-09-20  |  15KB  |  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>=ithenprin