home *** CD-ROM | disk | FTP | other *** search
/ 8bitfiles.net/archives / archives.tar / archives / canada-remote-systems / c64 / utils / evsbasic.arc / DODECAHEDRON.DMO (.txt) < prev    next >
Encoding:
Commodore BASIC  |  2019-04-13  |  3.9 KB  |  171 lines
  1. 1 REM STELLATION
  2. 2 REM  BY RICHARD RYLANDER
  3. 3 REM  ORIGINALLY APPEARED IN
  4. 4 REM  DR. DOBB'S JOURNAL, MAY 1985
  5. 5 REM MODIFIED FOR EVSBASIC
  6. 6 REM  BY ANTON TREUENFELS
  7. 7 :
  8. 100 (null)0:(null)14,1:(null)0
  9. 105 PRINT"[147]    ********************************"
  10. 110 PRINT"    * SMALL STELLATED DODECAHEDRON *"
  11. 115 PRINT"    ********************************"
  12. 120 :
  13. 130 PRINT" READING VERTEX DATA"
  14. 135 VN=32:DIMP%(VN-1,2),P(VN-1,2)
  15. 140 FORN=0TOVN-1
  16. 145 READP%(N,0),P%(N,1),P%(N,2)
  17. 150 NEXT
  18. 155 :
  19. 160 PRINT" READING CONNECTION DATA"
  20. 165 FA=60
  21. 170 DIMF%(FA,2),F(FA,2),SH(FA),Z(FA),K(FA)
  22. 175 FORN=1TOFA
  23. 180 READF%(N,0),F%(N,1),F%(N,2)
  24. 185 NEXT
  25. 190 :
  26. 200 PRINT" A SMALL STELLATED DODECAHEDRON IS"
  27. 205 PRINT" ROTATED AND DRAWN IN 3-D.  (TRY"
  28. 210 PRINT" ROTATION VALUE 10,10,10 OR 10,20,30)"
  29. 220 PRINT" AFTER THE FIGURE IS DRAWN PRESS"
  30. 225 PRINT" <RETURN> TO QUIT THE PROGRAM, OR ANY"
  31. 230 PRINT" OTHER KEY TO ENTER A NEW ROTATION"
  32. 235 PRINT" VALUE."
  33. 240 :
  34. 245 PRINT" PRESS ANY KEY TO START."
  35. 250 :
  36. 255 A$=(null)(1)
  37. 260 :
  38. 300 PRINT"[147] ENTER X,Y, AND Z ROTATION VALUES"
  39. 305 A$="X":GOSUB900:X=A
  40. 310 A$="Y":GOSUB900:Y=A
  41. 315 A$="Z":GOSUB900:Z=A
  42. 320 :
  43. 325 PRINT" PERFORMING ROTATION"
  44. 330 J=3.14159265/180
  45. 335 A=SIN(X*J):B=COS(X*J):C=SIN(Y*J):D=COS(Y*J):E=SIN(Z*J):F=COS(Z*J)
  46. 340 X0=D*F-A*C*E:X1=D*E+A*C*F:X2=-B*C
  47. 345 Y0=-B*E:Y1=B*F:Y2=A
  48. 350 Z0=C*F+A*D*E:Z1=C*E-A*D*F:Z2=B*D
  49. 355 :
  50. 360 FORN=0TOVN-1
  51. 365 X=P%(N,0):Y=P%(N,1):Z=P%(N,2)
  52. 370 P(N,0)=X0*X+X1*Y+X2*Z
  53. 375 P(N,1)=Y0*X+Y1*Y+Y2*Z
  54. 380 P(N,2)=Z0*X+Z1*Y+Z2*Z
  55. 385 NEXT
  56. 390 :
  57. 400 REM USE NORMAL VECTORS FOR VISIBLE
  58. 405 PRINT" FINDING VISIBLE FACETS"
  59. 410 VF=-1
  60. 415 FORN=1TOFA
  61. 420 VF=VF+1
  62. 425 A=F%(N,0):D=F%(N,1):G=F%(N,2)
  63. 430 F(VF,0)=A:F(VF,1)=D:F(VF,2)=G
  64. 435 C=P(A,2):B=P(A,1):A=P(A,0)
  65. 440 F=P(D,2):E=P(D,1):D=P(D,0)
  66. 445 I=P(G,2):H=P(G,1):G=P(G,0)
  67. 450 Z=(G-D)*(B-E)-(A-D)*(H-E)
  68. 455 IFZ<=0THENVF=VF-1:GOTO485
  69. 460 X=(H-E)*(C-F)-(B-E)*(I-F)
  70. 465 Y=(I-F)*(A-D)-(C-F)*(G-D)
  71. 470 NC=SQR(X*X+Y*Y+Z*Z)
  72. 475 J=(26*(2*Z+X+Y)/NC)+64
  73. 480 SH(VF)=(J*J)/256
  74. 485 NEXT
  75. 490 :
  76. 500 PRINT" SCALING TO DISPLAY SIZE"
  77. 505 A=0
  78. 510 FORN=0TOVN-1
  79. 515 IFABS(P(N,1))>ATHENA=ABS(P(N,1))
  80. 520 NEXT
  81. 525 A=119/A
  82. 530 FORN=0TOVN-1
  83. 535 P(N,0)=A*P(N,0):P(N,1)=A*P(N,1)
  84. 540 NEXT
  85. 545 :
  86. 550 PRINT" FINDING AVERAGE 'Z'"
  87. 555 FORN=0TOVF
  88. 560 K(N)=N:Z(N)=P(F(N,0),2)+P(F(N,1),2)+P(F(N,2),2)/3
  89. 565 NEXT
  90. 570 :
  91. 600 PRINT" SORTING ACCORDING TO 'Z'"
  92. 605 A=VF
  93. 610 (null)
  94. 615 A=INT(A/2)
  95. 620 IFA=0THEN(null)
  96. 625 B=VF-A
  97. 630 FORN=0TOB
  98. 635 C=N
  99. 640 (null)
  100. 645 D=C+A
  101. 650 IFZ(C)<=Z(D)THEN(null)
  102. 655 (null)K(C),K(D):(null)Z(C),Z(D)
  103. 660 C=C-A
  104. 665 (null)(null)C>0
  105. 670 NEXT
  106. 675 (null)
  107. 680 :
  108. 700 (null)4:(null)14,1:(null)0,6,15
  109. 705 (null)320,-240,160,-120
  110. 710 FORN=0TOVF
  111. 715 A=K(N)
  112. 720 X0=P(F(A,0),0):Y0=P(F(A,0),1)
  113. 725 X1=P(F(A,1),0):Y1=P(F(A,1),1)
  114. 730 X2=P(F(A,2),0):Y2=P(F(A,2),1)
  115. 735 (null)2:(null)X0,Y0:(null)X1,Y1TOX2,Y2TOX0,Y0
  116. 740 B=(X2+(X0+X1)/2)/2
  117. 745 C=(Y2+(Y0+Y1)/2)/2
  118. 750 (null)B,C:(null)3:(null)SH(A),2
  119. 755 (null)1:(null)X0,Y0:(null)X1,Y1TOX2,Y2TOX0,Y0
  120. 760 NEXT
  121. 765 :
  122. 800 A$=(null)(1)
  123. 805 (null)0:(null)14,1:(null)0:(null)
  124. 810 IFA$<>CHR$(13)THEN300
  125. 815 END
  126. 820 :
  127. 900 PRINT" ";A$;"= ";
  128. 905 A$="":B$=""
  129. 910 PRINTA$;" [146][157]";
  130. 915 A$=(null)(1)
  131. 920 A=LEN(B$)
  132. 925 IFA$="-"ANDA=0THENB$=A$:GOTO910
  133. 930 IFA$>="0"ANDA$<="9"ANDA<10THENB$=B$+A$:GOTO910
  134. 935 IFA$=CHR$(20)ANDA>0THENB$=LEFT$(B$,A-1):GOTO910
  135. 940 IFA$<>CHR$(13)ORA=0THEN915
  136. 945 PRINT" "
  137. 950 A=VAL(B$)
  138. 955 RETURN
  139. 960 :
  140. 1000 REM *VERTEX DATA
  141. 1005 DATA 1000,618,0,1000,-618,0
  142. 1010 DATA -1000,618,0,-1000,-618,0
  143. 1015 DATA 0,1000,618,0,1000,-618
  144. 1020 DATA 0,-1000,618,0,-1000,-618
  145. 1025 DATA 618,0,1000,-618,0,1000
  146. 1030 DATA 618,0,-1000,-618,0,-1000
  147. 1035 DATA 618,0,236,618,0,-236
  148. 1040 DATA -618,0,236,-618,0,-236
  149. 1045 DATA 236,618,0,-236,618,0
  150. 1050 DATA 236,-618,0,-236,-618,0
  151. 1055 DATA 0,236,618,0,-236,618
  152. 1060 DATA 0,236,-618,0,-236,-618
  153. 1065 DATA 382,382,382,382,382,-382
  154. 1070 DATA 382,-382,382,382,-382,-382
  155. 1075 DATA -382,382,382,-382,382,-382
  156. 1080 DATA -382,-382,382,-382,-382,-382
  157. 1085 :
  158. 1100 REM *CONNECTION DATA
  159. 1105 DATA 0,12,13,0,13,25,0,25,16,0,16,24,0,24,12
  160. 1110 DATA 1,12,26,1,26,18,1,18,27,1,27,13,1,13,12
  161. 1115 DATA 2,15,14,2,14,28,2,28,17,2,17,29,2,29,15
  162. 1120 DATA 3,14,15,3,15,31,3,31,19,3,19,30,3,30,14
  163. 1125 DATA 4,16,17,4,17,28,4,28,20,4,20,24,4,24,16
  164. 1130 DATA 5,17,16,5,16,25,5,25,22,5,22,29,5,29,17
  165. 1135 DATA 6,19,18,6,18,26,6,26,21,6,21,30,6,30,19
  166. 1140 DATA 7,18,19,7,19,31,7,31,23,7,23,27,7,27,18
  167. 1145 DATA 8,20,21,8,21,26,8,26,12,8,12,24,8,24,20
  168. 1150 DATA 9,21,20,9,20,28,9,28,14,9,14,30,9,30,21
  169. 1155 DATA 10,23,22,10,22,25,10,25,13,10,13,27,10,27,23
  170. 1160 DATA 11,22,23,11,23,31,11,31,15,11,15,29,11,29,22
  171.