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