home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Loadstar 16
/
016.d81
/
figmaker
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2022-08-26
|
6KB
|
156 lines
5 ifff>0then63000
10 poke55,0:poke56,68: rem lower memory to $6000
30 ifll=0thenll=1:load"figplot.o",8,1
35 clr:dim z(199)
40 ba=8*16^3:in=ba:rs=ba+3:cl=ba+6:dr=ba+9:mv=ba+15:cr=ba+632
50 poke53280,14:poke53281,0:dimc(150,3),sh(4),mb(4,4),mc(4,4)
60 dimma(4,4),p(44),pt(4),x(150),y(150),e1(150),e2(150):ix=1:ux=1
100 print"[147] enter type of figure:":rem first menu
110 print" 1[146][154] figure or graph"
120 print" 2[146][154] demo of a figure"
130 print" 3[146][154] demo of a graph"
140 print" 4[146][154] input fig/graph from file"
170 input" choice (1-4[146][154])";f
180 iff<1orf>4then100
190 on f gosub600,800,800,1200
280 gosub 1300:ez=10000:rem initialize matrices and set eye dist.
290 print"[147] choose one option:"
300 print" p[154][146]lot figure or graph"
310 print" v[154][146]iew stereoscopic figure"
320 print" r[154][146]otate figure"
330 print" s[154][146]ize change"
340 print" m[154][146]ove figure"
350 print" l[154][146]ocate eye"
360 print" t[154][146]ape or disk figure save"
370 print" o[154][146]riginal figure"
380 print" n[154][146]ew type of figure"
390 print" q[154][146]uit"
440 input" choice";d$:d=asc(d$+chr$(0))-75:ifd<1ord>11then290
450 on d gosub1000,3400,1380,1300,1900,3660,2900,3200,1400,1380,3600
460 ifd=9ord=3then100
470 goto290
600 print"[147] corner list"
610 input" number[146][154] of corners";nc
620 print" enter coordinates of corner: x,y,z[146][154]"
630 for i=1tonc:print"[146] corner number ";i;"[146]";
640 input"";c(i,1),c(i,2),c(i,3):nexti
650 print"[146][136] edge list"
660 input" number[146][154] of edges";ne
670 print" enter corners of edge: corner#,corner#[146][154]"
680 fori=1tone:print"[146] edge number ";i;"[146]";
690 input"";e1(i),e2(i):nexti:print"[146]":restore
700 print"[147] do you want to include text?"
710 input" y[146]es or n[146]o";c$:ifc$<>"y"thenreturn
720 input" figure title up to 35 char.";v$:return
800 rem crnrs & edges for octahedron
810 data6,32,10,40,-68,10,40,-32,-10,-40,68,-10,-40,0,60,-10,0,-60,10
820 data12,1,2,2,3,3,4,4,1,5,1,5,2,5,3,5,4,6,1,6,2,6,3,6,4,-999
825 v$="octahedron"
830 rem crnrs & edges for 3d bar graph
840 data21,-100,100,0,-100,-100,0,10,-130,108,70,-70,-170,-70,6,-28
850 data-70,-94,-28,0,-110,42,42,-100,0,-28,-87,-70,-28,14,-70,0,68
860 data-100,0,-82,-100,53,-92,-47,95,-85,-88,42,-74,-140,42,76,-140
870 data-65,-105,40,-32,-114,72,-103,-50,0,-103,0,0,-103,50,0:rem corners
880 data24,1,2,2,4,2,3,5,6,6,7,7,5,8,9,9,10,10,8,10,5,8,7,11,12,12,13,13,11
890 data13,14,11,16,14,15,15,16,16,14,17,17,18,18,19,19,20,20,21,21
900 iff<>3then930
910 i=1:v$="3d bar graph"
920 readh:ifh<>-999theni=i+1:goto920
930 readnc:fori=1tonc:forj=1to3:readc(i,j):nextj:nexti:rem read in corners
940 readne:fori=1tone:reade1(i),e2(i):nexti:sr=0:restore:return
1000 input" eye distance to orgin";ez:return:rem new eye distance
1200 input" d[146][154]isk or t[146][154]ape";t$
1210 ift$<>"d"andt$<>"t"then1200
1220 dt=1:input" name of figure file[146][154]";of$
1230 ift$="d"thendt=8
1240 open1,dt,0,of$:input#1,nc,ne,ez,v$
1250 forn=1tonc:input#1,c(n,1),c(n,2),c(n,3):nextn
1260 fori=1tone:input#1,e1(i),e2(i):nexti:close1:sr=0:return
1300 fori=1to4:forj=1to4:ma(i,j)=0:rem initalize trans matrices ma & mb
1310 mb(i,j)=0:ifi=jthenma(i,j)=1:mb(i,j)=1
1320 nextj:nexti:return
1380 restore:return
1400 input" d[146][154]isk or t[146][154]ape";t$
1410 ift$<>"d"andt$<>"t"then1400
1420 dt=1:input" name of figure file[146][154]";of$
1430 ift$="d"thendt=8
1440 open1,dt,1,of$:cr$=chr$(13):print#1,nc;cr$;ne;cr$;ez;cr$;v$
1450 forn=1tonc:print#1,c(n,1);cr$;c(n,2);cr$;c(n,3):nextn
1460 fori=1tone:print#1,e1(i);cr$;e2(i):nexti:close1:return
1600 p(4)=1:rem project p(1-3) into xp,yp
1610 for j=1to4:eu=0:fork=1to4:eu=eu+p(k)*ma(k,j):nextk:pt(j)=eu:nextj
1620 w=1/pt(4):fork=1to3:pt(k)=pt(k)*w:nextk:ifpt(3)=ezthenf=10000:goto1640
1630 f=ez/(ez-pt(3)):rem persp projection
1640 xp=f*pt(1):yp=f*pt(2)*.75:rem fixes x vs y screen distortion
1650 ifxp<-159thenxp=-159
1660 ifxp>159thenxp=159
1670 ifyp<-99thenyp=-99
1680 ifyp>99thenyp=99
1690 xp=xp+160:yp=yp+100:return
1900 print" do you want to create or edit text?"
1910 input" y[146]es or n[146]o";b$:ifb$<>"y"then1930
1920 input"figure title up to 35 letters";v$:vv=1
1930 forn=1tonc:rem persp proj onto x,y
1940 p(1)=c(n,1):p(2)=c(n,2):p(3)=c(n,3):gosub1600:x(n)=xp:y(n)=yp:nextn
1950 ifix=0then1980:rem do ploting
1960 pokecr,1:ix=0:sys49152:sys49158:sys49161,1:sys49164,0
1970 ifv$<>""orvv=1thengosub2200:vv=0:b$="n":rem text
1980 fori=1tone:ii=e1(i):jj=e2(i):sys49170,x(ii),y(ii),x(jj),y(jj):nexti
1990 ifux=0thenreturn
2000 poke198,0:wait198,1:geta$
2010 ifa$="p"thengosub2100
2020 print"[147]":ix=1:sys49158:sys49155: return:rem clear screen on restore
2100 open4,4:rem basic bit screen dump for 1525 printer
2110 y=0:r=0:s=24576:rem start of bit scrn $6000
2120 fori=39to0step-1:forj=0to24:fork=0to7:q=j*8+k
2130 z(q)=z(q)+(peek(s+320*j+i*8+k))*2^y:p$=p$+chr$((z(q)and127)+128):
2140 z(q)=z(q)/128:nextk:nextj
2150 print#4,chr$(8)p$:p$="":y=y+1:ify=7theny=0:goto2170
2160 nexti:pp=1
2170 forl=0to199:p$=p$+chr$((z(l)and127)+128)
2180 z(l)=z(l)/128:nextl:print#4,chr$(8)p$:p$="":ifpp=0then2160
2190 close4:return
2200 poke56334,peek(56334)and254:poke1,peek(1)and251:bc=53248:bs=32280
2210 ln=len(v$):ifln>35thenln=35
2220 fori=1to ln:as=asc(mid$(v$,i,1)):ifas<64andas>31then2250
2230 ifas<96and as=>64thenas=as-64:goto2250
2240 as=32:rem blank for all others
2250 cm=as*8+bc:forj=0to7:pokebs+(i-1)*8+j,peek(cm+j):nextj:nexti
2260 poke1,peek(1)or4:poke56334,peek(56334)or1:vv=0:b$="n":return
2700 fori=1to4:forj=1to4:eu=0:fork=1to4
2705 eu=eu+ma(i,k)*mb(k,j):nextk:mc(i,j)=eu
2710 nextj:nexti:fori=1to4:forj=1to4:ma(i,j)=mc(i,j):nextj:nexti:return
2900 print" rotate about[157][157][157][157][157]x[146][154] or y[146][154] or z[146][154] and angle[146][154]";
2905 inputax$,md
2910 ra=md*(NULL)/180:c=cos(ra):s=sin(ra):fori=1to4:forj=1to4:mb(i,j)=0
2920 if i=jthenmb(i,j)=1
2930 nextj:nexti:ifax$<>"x"then2950
2940 mb(2,2)=c:mb(3,3)=c:mb(2,3)=s:mb(3,2)=-s:goto2990:rem x axis
2950 ifax$<>"y"thengoto2970
2960 mb(1,1)=c:mb(3,3)=c:mb(1,3)=-s:mb(3,1)=s:goto2990:rem y axis
2970 ifax$<>"z"thengoto2900
2980 mb(1,1)=c:mb(2,2)=c:mb(1,2)=s:mb(2,1)=-s:rem z axis
2990 gosub2700:return
3200 input" size: sx,[154]sy,[154]sz[154] & sglobal[154]";sh(1),sh(2),sh(3),sh(4)
3210 ifsh(1)=0orsh(2)=0orsh(3)=0orsh(4)=0thenprint" no size=0":goto3200
3220 fori=1to4:forj=1to4:mb(i,j)=0:ifi=jthenmb(i,j)=sh(i):rem dignl=size
3230 ifi=jthen mb(i,j)=sh(i):rem set main diagonal element with size factor
3240 ifi=4andj=4thenmb(i,j)=1/sh(i)
3250 nextj:nexti:gosub2700:return
3400 input" moves: give mx,[154]my,[154]& mz[154]";sh(1),sh(2),sh(3):rem moving
3410 fori=1to3:forj=1to4:mb(i,j)=0:ifi=jthenmb(i,j)=1:rem set mb to matrix
3420 nextj:nexti:mb(4,4)=1:forj=1to3:mb(4,j)=sh(j):nextj:gosub2700:return
3600 print" stereoscopic view"
3610 input" enter offset, angle[154]";sh(1),md:sh(2)=0:sh(3)=0
3620 ax$="y":gosub3410:gosub2910:ux=0:gosub1900:rem 1st view
3630 sh(1)=-2*sh(1):md=-2*md:gosub3410:gosub2910:ux=1:gosub1930:rem view-2
3640 sh(1)=sh(1)/-2:md=md/-2:print"[147] restoring figure"
3650 gosub3410:gosub2910:return
3660 goto63000
63000 rem reconnect to ls
63005 ifff=0thenff=1:load"sidirq v3",8,1
63006 ifff=1thenff=2:load"romusic",8,1
63007 poke51200,75:poke52016,33:poke56,120
63010 print"[147]load"chr$(34)"payload"chr$(34)",8":print"run"
63020 poke631,13:poke632,13:poke198,2: end