home *** CD-ROM | disk | FTP | other *** search
/ Transactor / Transactor_21_1988_Transactor_Publishing.d64 / projector64 (.txt) < prev    next >
Commodore BASIC  |  2023-02-26  |  5KB  |  252 lines
  1. 1000 printchr$(147)"  64 projector
  2. 1010 [153]"  perspective plotter
  3. 1020 print"  with hidden lines
  4. 1030 [153]"  by  ian  adam
  5. 1040 print"  vancouver  bc
  6. 1050 [153]"  december 1985
  7. 1060 :
  8. 1070 rem requires hires plotting routines
  9. 1080 rem the transactor vol 5  issue 6
  10. 1090 rem with extensions by ia
  11. 1100 :
  12. 1110 if peek(38912)=1 then a=2
  13. 1120 poke 53281,2-a
  14. 1130 on a goto 1150,1190
  15. 1140 a=1: load"hiprnt1.ml",8,1
  16. 1150 poke 56,152 : clr
  17. 1160 load"hiprnt2.ml",8,1
  18. 1170 :
  19. 1180 rem start here!
  20. 1190 gosub1990, constants
  21. 1200 gosub2650, choose
  22. 1210 gosub2090, config'n
  23. 1220 gosub2170, viewing angle
  24. 1230 gosub2390, get data
  25. 1240 gosub1390, scale
  26. 1250 gosub1580, plot
  27. 1260 gosub2550, message
  28. 1270 :
  29. 1280 poke198,0:wait198,1:getb$
  30. 1290 if b$="r" then gosub2170:goto1240
  31. 1300 if b$="p" then sys hi,0: sys du,0,0: sys te:goto1260: dump to printer
  32. 1310 if b$="a" then 1250
  33. 1320 if b$="n" then if dd then run
  34. 1330 if b$="n" then gosub2650:goto1220
  35. 1340 if b$="v" then v=1-v
  36. 1350 if b$="h" then h=1-h
  37. 1360 if b$<>"q" then 1260
  38. 1370 end
  39. 1380 :
  40. 1390 rem vertical scaling
  41. 1400 print:print"scaling data...
  42. 1410 vscalar[178]9e9
  43. 1420 [129] y[178]0 [164] n
  44. 1430 a[178]z(0,y):[129] x[178]1 [164] m
  45. 1440 [139] z(x,y)[177]a [167] a[178]z(x,y)
  46. 1450 [130]:[143] find highest point on line
  47. 1460 [139] a [167] tmp[178](199[171]yv(y))[173]a : [139] vs[177]tm [167] vs[178]tm
  48. 1470 [130]:[143] select best feasible scale
  49. 1480 :
  50. 1490 [143] calculate rise
  51. 1500 [153]"...still scaling!
  52. 1510 for y=0 to n
  53. 1520 tm=yv(y)
  54. 1530 for x=0 to m
  55. 1540 r(x,y)=z(x,y)*vs+tm
  56. 1550 nextx,y
  57. 1560 return
  58. 1570 :
  59. 1580 rem set up screen
  60. 1590 syshi,0,0,13
  61. 1600 sysdm,1
  62. 1610 :
  63. 1620 rem plot horizontal lines
  64. 1630 sysmo,10,r(0,0)
  65. 1640 d1=dr:if h then d1=hd
  66. 1650 for y=0 to n
  67. 1660 tm=yh(y)
  68. 1670 for x=1 to m
  69. 1680 sysd1,tm+xh(x),r(x,y)
  70. 1690 nextx
  71. 1700 if y=n then 1800
  72. 1710 :
  73. 1720 rem plot vertical lines
  74. 1730 sysdr,yh(y+1)+xh(m),r(m,y+1)
  75. 1740 sysd1,yh(y)+xh(m),r(m,y)
  76. 1750 for x=m-1 to 0 step-1
  77. 1760 if v then x=0
  78. 1770 sysmo,tm+xh(x),r(x,y)
  79. 1780 sysd1,yh(y+1)+xh(x),r(x,y+1)
  80. 1790 next x,y
  81. 1800 :
  82. 1810 rem draw box
  83. 1820 sysmo,10,r(0,0)
  84. 1830 sysdr,10,10
  85. 1840 sysdr,xh(m),10
  86. 1850 sysdr,xh(m),r(m,0)
  87. 1860 sysmo,xh(m),10
  88. 1870 sysdr,xh(m)+yh(n),yv(n)
  89. 1880 sysdr,xh(m)+yh(n),r(m,n)
  90. 1890 :
  91. 1900 rem title
  92. 1910 sysco,8:syspr,1,24,a$
  93. 1920 :
  94. 1930 rem wait for human
  95. 1940 wait198,3:poke198,0
  96. 1950 syste:print chr$(147)
  97. 1960 return
  98. 1970 :
  99. 1980 rem  constants
  100. 1990 hi=49152:dr=49155:mo=49161
  101. 2000 dm=49167:co=49173:te=49179
  102. 2010 pr=49182:hd=49191:du=49194
  103. 2020 m=20:rem x-dimension
  104. 2030 n=16:rem y-dimension
  105. 2040 sp=96:rem vertical separation
  106. 2050 th=-1
  107. 2060 ms$(0)="hide":ms$(1)="show
  108. 2070 [142]
  109. 2080 :
  110. 2090 [133]"hidden lines to be shown (y/n)";b$
  111. 2100 h[178][182](b$[178]"n")
  112. 2110 [133]"vertical lines to be shown (y/n)";b$
  113. 2120 v[178][182](b$[178]"n")
  114. 2130 [134] z(m,n),r(m,n)
  115. 2140 [134] xh(m),yh(n),yv(n)
  116. 2150 [142]
  117. 2160 :
  118. 2170 [143] view angle
  119. 2180 [139] theta[179]0 [167] theta[178]60:[143] default angle
  120. 2190 [153]:[153]"enter viewing angle, or press return
  121. 2200 print"for"th"degrees:
  122. 2210 [133]th :[139] th[179]0 [176] th[177]90 [167] 2180
  123. 2220 an[178]th[172][255][173]180
  124. 2230 tmp[178]120[172][190](an)
  125. 2240 xgrid[178][181]((309[171]tm)[173]m)
  126. 2250 ygrid[178][181](sp[172][191](an)[173]n)
  127. 2260 ystp[178][181](tm[173]n)
  128. 2270 :
  129. 2280 [143] calculate offsets
  130. 2290 [129] x[178]0 [164] m
  131. 2300 xhriz(x)[178]10[170]x[172]xg
  132. 2310 [130]
  133. 2320 [129] y[178]0 [164] n
  134. 2330 yhriz(y)[178]y[172]ys
  135. 2340 yvert(y)[178]10[170]y[172]yg
  136. 2350 [130]
  137. 2360 [142]
  138. 2370 :
  139. 2380 [143] data to plot
  140. 2390 [153]:[153]"creating data...
  141. 2400 if dd then 2480
  142. 2410 for x=0 to m
  143. 2420 for y=0 to n
  144. 2430 if e then r=fnr(x):s=fns(y)
  145. 2440 z(x,y)=fnz(x)
  146. 2450 nexty:printx;:nextx:return
  147. 2460 :
  148. 2470 rem  read empirical results from data
  149. 2480 for y=0 to n
  150. 2490 for x=0 to m
  151. 2500 read z(x,y)
  152. 2510 nextx:printy;:nexty
  153. 2520 return
  154. 2530 :
  155. 2540 rem *** menus: ***
  156. 2550 print chr$(19)chr$(18);" press:": print
  157. 2560 print"r review from another angle
  158. 2570 [153]"p send projection to printer
  159. 2580 print"h:  "ms$(1-h)" hidden lines
  160. 2590 [153]"v:  "ms$(1[171]v)" vertical lines
  161. 2600 print"a plot again
  162. 2610 [153]"n for a new shape
  163. 2620 print"q quit
  164. 2630 [142]
  165. 2640 :
  166. 2650 [153]:[153] [199](18);" press:": [153]
  167. 2660 [153]"1. stetson
  168. 2670 print"2. inverse waves
  169. 2680 [153]"3. furrows
  170. 2690 print"4. cascade
  171. 2700 [153]"5. twin peaks
  172. 2710 print"6. crater
  173. 2720 [153]"7. radial
  174. 2730 print"8. read data
  175. 2740 :
  176. 2750 [146]198,1:[161]a$
  177. 2760 e[178]0:a[178][197](a$):[139] a[179]1 [176] a[177]8 [167] [138]
  178. 2770 [145] a [141] 2890,2940,2980,3020,3070,3130,3180,2800
  179. 2780 [153]a$:[142]
  180. 2790 :
  181. 2800 [153]:[153] [199](18);" press:": [153]
  182. 2810 [153]"1. rainfall
  183. 2820 print"2. more data
  184. 2830 [153]:[153]"0. first menu
  185. 2840 wait198,1:geta:if a=0 or a>2 then run
  186. 2850 on a gosub 3230,3470
  187. 2860 read a$,m,n,sp
  188. 2870 dd=1:return
  189. 2880 :
  190. 2890 a=m/2:b=5:c=n/2:d=2:e=.2
  191. 2900 deffnr(x)=(x-a)/b:deffns(y)=(y-c)/b
  192. 2910 deffnz(x)=sin(r*r*d+s*s)*exp(-r*r-s*s)+e
  193. 2920 a$="stetson":return
  194. 2930 :
  195. 2940 a=5
  196. 2950 deffnz(x)=sin(x*y/m)+a
  197. 2960 a$="inverse waves":return
  198. 2970 :
  199. 2980 a=m/2:b=n/2:c=4:d=1
  200. 2990 deffnz(x)=sin((x-a)*(y-b)/b)+y/c+d
  201. 3000 a$="furrows":return
  202. 3010 :
  203. 3020 a=6:b=2:c=.1:e=-1.2
  204. 3030 deffnr(x)=y/n-x/m:deffns(y)=r+r
  205. 3040 deffnz(x)=(c+exp(s+r))*cos(a*r*r-a*s+e)+b
  206. 3050 a$="cascade":return
  207. 3060 :
  208. 3070 a=int(m/3):b=m-a:c=n/2:d=3:e=.1:f=.4
  209. 3080 deffnr(x)=(x-a)*(x-a)+(y-c)*(y-c)
  210. 3090 deffns(y)=(x-b)*(x-b)+(y-c)*(y-c)
  211. 3100 deffnz(x)=cos(sqr(r))*(exp(-r/d)+e)+cos(sqr(s))*(exp(-s/d)+e)+f
  212. 3110 a$="twin peaks":return
  213. 3120 :
  214. 3130 a=m/2:b=n/2:c=45:e=5
  215. 3140 deffnr(x)=abs((x-a)*(x-a)+(y-b)*(y-b)-c)+e:deffns(y)=.
  216. 3150 deffnz(x)=e/r+e
  217. 3160 a$="crater":return
  218. 3170 :
  219. 3180 a=m/2:b=n/2:c=.001:d=40
  220. 3190 deffnz(x)=(abs(x-a)+abs(y-b))*sin(4*atn((y-b)/(x-a+c)))+d
  221. 3200 a$="radial":return
  222. 3210 :
  223. 3220 :
  224. 3230 poke 65,peek(61): poke 66,peek(62): rem set data ptr
  225. 3240 return
  226. 3250 :
  227. 3260 data rainfall in mm   vancouver   1975-1985,11,10,160
  228. 3270 :
  229. 3280 data  30,  94,  83,  90,  44,  31,   7,  29
  230. 3290 data  95, 266,   0,   0: rem 1985
  231. 3300 data 268, 176, 132, 140, 109,  80,   1,  17
  232. 3310 data  60, 167, 225, 170, 186, 239, 122,  98
  233. 3320 data  40,  84, 102,  30,  99,  97, 325,  77
  234. 3330 data 247, 229,  68, 116,  18,  28,  74,  44
  235. 3340 data  46, 131, 173, 131,  57, 106, 124, 173
  236. 3350 data 130, 138,  17,  59,  89, 125, 274, 157
  237. 3360 data  96, 165, 120,  71,  54, 100,  74,  35
  238. 3370 data 104,  40, 319, 218: rem 1980
  239. 3380 data  57, 162,  61,  57,  49,  33,  32,  19
  240. 3390 data  74,  76,  65, 294, 113,  95,  77,  84
  241. 3400 data  65,  23,   9, 104,  96,  42, 124,  88
  242. 3410 data 102,  87,  84,  52,  98,  18,  51,  53
  243. 3420 data  82,  98,  20, 140, 167, 159, 112,  87
  244. 3430 data  95,  67,  24,  84,  53,  81,  64, 135
  245. 3440 data 162, 126, 118,  30,  49,  31,  19, 106
  246. 3450 data   1, 300, 210, 268: rem 1975
  247. 3460 :
  248. 3470 poke 65,peek(61): poke 66,peek(62): rem set data ptr
  249. 3480 return
  250. 3490 :
  251. 3500 data none entered,1,1,100
  252.