Loadstar 98/098.d81/projector

Commodore BASIC | 2022-08-26 | 11KB | 407 lines

10 rem the projector
20 rem (c) 1992
30 gosub 8800
160 poke 56,144:clr:dimc$(15):poke53280,0:poke53281,0:poke650,128
190 j$(0)="shown":j$(1)="hidden"
200 c$(0)="[194]lack":c$(1)="[215]hite":c$(2)="[210]ed":c$(3)="[195]yan":c$(4)="[208]urple"
210 c$(5)="[199]reen":c$(6)="[194]lue":c$(7)="[217]ellow":c$(8)="[207]range":c$(9)="[194]rown"
215 c$(10)="[204]ight [210]ed":c$(11)="[196]ark [199]ray":c$(12)="[205]edium [199]ray"
217 c$(13)="[204]ight [199]reen":c$(14)="[204]ight [194]lue":c$(15)="[204]ight [199]ray"
220 gosub5000:rem constants
300 mt=36864:gosub5400:rem choose
310 if pc=. then 300
320 gosub9000:rem config'n
330 gosub 700:rem draw
340 gosub10000: rem menu
350 :
360 if a=6 then 330
400 print:poke212,0:sysmt+9,208:on a gosub500,600,14000,9000,5400,330,9900
410 sysmt+9,208:if ud>. then gosub 1300
420 goto 340
490 :
500 sys hi,0:waitkb,7:get a$:return:rem   view screen
540 :
600 sys hi,0:sys du,0,0:return:rem dump to printer
690 :
700 gosub 2600
710 ifddthen 900
720 sysmt+9,208:poke787,1:ms$="[195]reating data for "+n$:gosub15000
730 onpcgosub3000,3100,3200,3300,3400,3500,3600,3700,3800,3900,4000,4100
735 ifpc>12thenonpc-12gosub4200,4300,10,10,10,10,10
740 ifkthen 800
745 :
750 forx=mto0step-1
755 fory=0ton
760 z(x,y)=fnz(x)
770 nexty:print"[146]"x"[157]  ";:nextx:goto1000
780 :
800 forx=mto0step-1
810 fory=0ton
820 r=fnr(x):s=fns(y)
830 z(x,y)=fnz(x)
840 nexty:print"[146]"x"[157] ";:nextx:goto 1000
850 :
890 rem read empirical data
900 ms$="[210]eading data...":poke787,1:gosub15000
910 on pc gosub7000,7500:readn$,m,n,sp
920 fory=0ton
930 forx=0tom
940 read z(x,y)
950 nextx:print"[146]"n-y"[157]  ";:nexty
960 :
1000 rem vertical scaling
1010 sysmt+9,208:ms$="[195]hecking data...":poke787,1:gosub15000:
1020 :
1030 vscalar=9e9
1040 fory=0ton
1050 :
1060 a=0:forx=0tom
1070 ifz(x,y)>athena=z(x,y)
1080 next:rem high pt on line
1090 :
1100 ifathentmp=(199-yv(y))/a:if vs>tm then vs=tm
1120 next:rem best scale
1130 :
1200 rem calculate rise
1210 ms$="[211]caling data...":poke787,1:gosub15000
1220 :
1230 fory=0ton
1240 tm=yv(y)
1250 forx=0tom
1260 r(x,y)=z(x,y)*vs+tm
1270 nextx,y
1280 :
1300 rem set up screen
1320 syshi,0,gb,gc
1330 sysdm,1
1340 :
1380 rem plot horizontal lines
1400 sys mo,10,r(0,0)
1410 :
1420 fory=0ton
1430 tm=yh(y)
1440 :
1450 forx=1tom
1460 sysdr,tm+xh(x),r(x,y)
1470 nextx
1480 :
1490 if y=n then 1580
1500 rem plot verticals
1520 sysd1,yh(y+1)+xh(m),r(m,y+1)
1530 sysdr,yh(y)+xh(m),r(m,y)
1535 :
1536 if v then forx=0to0:goto 1550
1540 forx=m-1to0step-1
1550 sysmo,tm+xh(x),r(x,y)
1560 sysdr,yh(y+1)+xh(x),r(x,y+1)
1570 nextx
1575 :
1580 nexty
1590 :
1600 rem draw box
1620 ifpeek(653)then1800
1625 sysmo,10,r(0,0)
1630 sysd1,10,10
1640 sysd1,xh(m),10
1650 sysd1,xh(m),r(m,0)
1660 sysmo,xh(m),10
1670 sysd1,xh(m)+yh(n),yv(n)
1680 sysd1,xh(m)+yh(n),r(m,n)
1690 :
1700 rem title
1720 sysco,tc:syspr,1,24,n$
1740 :
1800 t$=n$:rem wait for human
1810 for i=1 to 2e3
1820 geta$:if a$="" then next
1840 ud=.:return
1845 :
2300 if dd thenms$="[195]an't change size of data":gosub15000:return
2310 ms$="[204][201][206][197][211] [193][195][210][207][211][211]":min=2:max=yz+1:cu=n+1:gosub8100
2340 x=cu:n=int(x)-1:return
2350 :
2400 if dd thenms$="[195]an't change size of data":gosub15000:return
2405 ms$="[208][207][201][206][212][211] [208][197][210] [204][201][206][197]":min=2:max=xz+1:cu=m+1:gosub8100:x=cu
2430 m=int(x)-1:return
2500 rem projection
2510 :
2520 rem default angle
2530 ms$="[196][197][199][210][197][197][211] (0-90)":min=0:max=90:cu=th:gosub8100:th=cu
2560 return
2570 :
2600 a=th*(NULL)/180
2610 tmp=120*cos(a)
2620 xgrid=int((309-tm)/m)
2630 ygrid=int(sp*sin(a)/n)
2640 ystp=int(tm/n)
2650 :
2700 rem offsets
2710 :
2720 forx=0tom
2730 xhriz(x)=10+x*xg
2740 next
2750 :
2760 fory=0ton
2770 yhriz(y)=y*ys
2780 yvert(y)=10+y*yg
2790 next
2800 return
2810 :
3000 g=m/2:h=n/2:k=1
3010 deffnr(x)=sqr((x-g)*(x-g)+(y-h)*(y-h))+1:deffns(y)=.
3020 deffnz(x)=(cos(r)+1)/r+1
3030 data"[211]plash":return
3040 :
3100 g=560:h=m/2:i=n/2:j=h*i/40
3110 deffnz(x)=g-exp(sqr(abs((x-h)*(y-i)/j)))
3120 data"[211]hell roof":return
3130 :
3200 g=10:h=1.5:i=4
3210 deffnz(x)=g+sin(sqr(x*x+h*y*y))+y/i
3220 data"[199]ravity waves":return
3230 :
3300 g=m*m*m/360:h=1200/n:i=3000/n/n:j=2000/n/n/n
3310 deffnz(x)=x*x-x*x*x/g+h*y-i*y*y+y*y*y*j+500
3320 data"[195]ontours":return
3330 :
3400 g=n/2:h=m/4:i=.75*m:j=.6*n
3410 deffnz(x)=y+(g-y)*((x>h)and(x<i))*((y>3)and(y<j))
3420 data"[208]lateau":return
3430 :
3500 g=m*n:j=2
3510 deffnz(x)=g-n*x-m*y+j*x*y
3520 data"[200]yperboloid":return
3530 :
3600 g=5
3610 deffnz(x)=sin(x*y/m)+g
3620 data"[201]nverse waves 1":return
3630 :
3700 g=m/2:h=n/2:i=4:j=1
3710 deffnz(x)=sin((x-g)*(y-h)/h)+y/i+j
3720 data"[201]nverse waves 2":return
3730 :
3800 g=m/2:h=n/2:k=m-1
3810 deffnr(x)=m-abs(x-g):deffns(y)=k-abs(y-h)
3820 deffnz(x)=r-(r<s)*(s-r)
3830 data"[200]ouse roof":return
3840 :
3900 g=m/4:h=2:i=n/4:k=.4
3910 deffnr(x)=x/g-h:deffns(y)=y/i-h
3920 deffnz(x)=sin(r*r*h+s*s)*exp(-r*r-s*s)+k
3930 data"[211]tetson":return
3940 :
4000 g=6:h=2:i=.1:k=-1.2
4010 deffnr(x)=y/n-x/m:deffns(y)=r+r
4020 deffnz(x)=(i+exp(s+r))*cos(g*r*r-g*s+k)+h
4030 data"[195]ascade":return
4040 :
4100 g=int(m/3):h=m-g:i=n/2:j=3:k=.05:f=.6
4104 deffnr(x)=(x-g)*(x-g)+(y-i)*(y-i)
4106 deffns(y)=(x-h)*(x-h)+(y-i)*(y-i)
4120 deffnz(x)=cos(sqr(r))*(exp(-r/j)+k)+cos(sqr(s))*(exp(-s/j)+k)+f
4130 data"[212]win peaks":return
4140 :
4200 g=m/2:h=n/2:i=sqr(m*n)/3:j=5:k=1
4210 deffnr(x)=abs(sqr((x-g)*(x-g)+(y-h)*(y-h))-i)+k:deffns(y)=.
4220 deffnz(x)=k/r+j
4230 data"[195]rater":return
4240 :
4300 g=1
4310 k=1:deffnr(x)=x:deffns(y)=y
4320 deffnz(x)=r+s
4330 data "[213]ser [198]unction":rem title
4340 return
4350 :
4980 datax
4990 :
5000 hi=49152:d1=49155:mo=49161
5010 dm=49167:co=49173:te=49179
5020 pr=49182:hd=49191:du=49194
5030 rv$(0)="[146][154]":rv$(1)="[158]
5040 :
5050 kb[178]198:m[178]20:n[178]16:th[178]60:dr[178]hd:sp[178]96
5060 [134] a,b,c,d,e,f,g,h,j,k,r,s,x,y,pc,a$,t$,v,hl,dd,vs,tm,xg,yg,ys,th,ud
5065 xz[178]49:yz[178]39:gc[178]13:gb[178]0:tc[178]8:ft[178]15
5070 [134] n$(20):[129] i[178]1 [164] 20:[135]n$
5080 n$(i)[178]n$:[130]:pt[178]14
5100 [134] z(xz,yz),r(xz,yz)
5110 [134] xh(xz),yh(yz),yv(yz)
5200 [142]
5397 :
5398 [143] choices
5399 :
5400 [141] 8800:[158]mt[170]3,1,38,4,24,127,14
5405 [158]mt[170]3,9,29,6,23,255,6:[158]mt[170]3,10,30,5,22,160,3:[153]"open";
5410 [129] i[178]1 [164] 14
5430 [158]mt[170]18,5[170]i,n$(i):[130]
5460 [158]mt[170]18,5[170]i,"(NULL)ead data"
5470 [158]mt[170]18,6[170]i,"(NULL)eturn (NULL)o (NULL)(NULL)atnstr$(NULL)(NULL)atn(NULL)"
5540 [158]mt,6,10,30,16,3[170]128,129,0:[161]a$:a[178][198](a$)[171]48
5550 [139]a[178]16[167][141]9900:[137]5540
5560 [151]199,0:[139]a[178]15[167]6000
5570 [139]a[178]14[167][141]13000:[151]199,0:[139]a$[178]"e"[167]5700
5580 k[178]0:dd[178]0
5590 pc[178]a:n$[178]"'"[170]n$(a)[170]"'":[158]mt[170]24,n$:[143]  print"   "a$". "n$;
5600 sp[178]96:[142]
5610 :
5700 [153]"load(NULL)he (NULL)rojector can display your own":[153]"mathematical functions.  str$efine
5705 print"the equation in line 4320, ie:
5710 [153]" 4320 str$valascasc(NULL)(NULL)((NULL))=..... (NULL), (NULL) +chr$
5715 print"[193]dd constant [199] as needed, so there are
5720 [153]"no negative results.  valnter the title
5725 print"as [196][193][212][193] in line 4330, then return.
5730 [153]"(NULL)ee the other formulas for examples.
5735 print"[204]ine 4300 [205][213][211][212] be present, and may
5740 [153]"define chr$, left$, right$, & mid$ as constants, if
5745 print"wanted. [204]ine 4310 may define [198][206][210]([216]) and
5750 [153]"asc(NULL)(NULL)((NULL)) as intermediate steps if wanted.
5755 print"[201]f they are used, then you must set
5760 [153]"(NULL)=1; otherwise, set (NULL)=0.
5775 print"[208]ress e to enter equation now, [210][197][212][213][210][206]
5780 [153]"to bypass:";:[146] kb,7:[161]a$:[139] a$[179][177]"e"[167][142]
5790 [153]:[153]"(NULL)rogram halted":[155] 4300[171]4340
6000 [143] data reader
6010 :
6020 [158]mt[170]6,208:[158]mt[170]3,8,19,8,12,255,6:[158]mt[170]3,9,20,7,11,160,7
6030 [158]mt[170]15,10,8,"sys(NULL)ainfall
6040 sysmt+15,10,9,"[217]our data
6070 [158]mt[170]15,10,10,"ascorg