home *** CD-ROM | disk | FTP | other *** search
/ FreeWare Collection 3 / FreeSoftwareCollection3pd199x-jp.img / kxc / basic386 / hs_grd / repgdd02.bas < prev    next >
BASIC Source File  |  1980-01-02  |  4KB  |  123 lines
  1. 1000 '-=///////////////////////////////////////////////////////////////=-
  2. 1010 '
  3. 1020 '　　　　　　楕円球体グラデーションサンプルプログラム
  4. 1030 '　Ｃｏｐｙｒｉｇｈｔ（ｃ）　ＫＸＣ　Ｕ・Ｋ　ＵＯＴＡ　June 1990
  5. 1040 '
  6. 1050 '「まるでレイトレの様な、美しい高速天然色感を御堪能下さい。（魚）」
  7. 1060 '
  8. 1070 '-=///////////////////////////////////////////////////////////////=-
  9. 1080 '
  10. 1090 SCREEN@1 : CLS : CLEAR ,,2000,50000,10000
  11. 1100 DEFSNG A-Z : DEFLNG I,X,Y,R : DEFINT J
  12. 1110 DIM IVALUE( 100 ),JSQDT( 25600/2 )
  13. 1120 I=0 : ICB=0 : ICR=0 : ICG=0
  14. 1130 IB_GRD=0     : LOADM "BALL_GR7.REX",IB_GRD
  15. 1140 ID_GRD=&H400 : LOADM "DAEN_GR4.REX",ID_GRD
  16. 1150 IAD_SQDT =VARPTR( JSQDT( 0 ) )
  17. 1160 IAD_VALUE=VARPTR( IVALUE( 0 ) )
  18. 1170 LOAD@ "isqdt.dat",JSQDT
  19. 1180 CD PLAY
  20. 1190 :
  21. 1200 *LOOP
  22. 1210   CLS
  23. 1220   GOSUB *DEMO4
  24. 1230   GOSUB *DEMO2
  25. 1240   GOSUB *DEMO1
  26. 1250   GOSUB *DEMO3
  27. 1260   FOR IWT=0 TO 10000 : NEXT IWT
  28. 1270 GOTO *LOOP
  29. 1280 '                    /////　デモ１　/////
  30. 1290 *DEMO1
  31. 1300 ICG=0 : ICR=0 : ICB=255
  32. 1310 FOR I=5 TO 159 STEP 10
  33. 1320  ICG=ICG+15 : ICR=ICR+14 : ICB=ICB-12
  34. 1330  R2=I*12/16 : R1=R2/12 : R3=R1*8 : R=I/6 : I2=I*2/3
  35. 1340  IX=160+COS(I/10)*I2
  36. 1350  IY=120+SIN(I/10)*I2
  37. 1360  CALLM ID_GRD,IAD_SQDT,ICG,ICR,ICB,160-I2,120   ,R1,R2,R3,IAD_VALUE
  38. 1370  CALLM ID_GRD,IAD_SQDT,ICG,ICR,ICB,160   ,120-I2,R2,R1,R3,IAD_VALUE
  39. 1380  CALLM ID_GRD,IAD_SQDT,ICG,ICR,ICB,160+I2,120   ,R1,R2,R3,IAD_VALUE
  40. 1390  CALLM ID_GRD,IAD_SQDT,ICG,ICR,ICB,160   ,120+I2,R2,R1,R3,IAD_VALUE
  41. 1400  CALLM IB_GRD,IAD_SQDT,ICB,ICG,ICR,IX    ,    IY,R,IAD_VALUE
  42. 1410 NEXT
  43. 1420 RETURN
  44. 1430 :
  45. 1440 '                    /////　デモ２　/////
  46. 1450 *DEMO2
  47. 1460 ICB=INT( 255*RND( 1 ) )
  48. 1470 R1=12 : R2=8 : R=6
  49. 1480 IT=IT+10 : IF IT=100 : IT=0
  50. 1490 FOR I=10 TO 119 STEP 8
  51. 1500   IT=IT+16
  52. 1510   FOR IX=0 TO 319 STEP 6
  53. 1520     ICG=ICG+8 : IF ICG >= 256 : ICG=0
  54. 1530     ICR=ICR+5 : IF ICR >= 256 : ICR=0
  55. 1540     IY=120+SIN( ( IX-IT )/30 )*I : I2=I/2
  56. 1550     CALLM ID_GRD,IAD_SQDT,ICG,ICG,ICR,IX   ,IY  ,R1,R1,I2,IAD_VALUE
  57. 1560     CALLM ID_GRD,IAD_SQDT,ICG,ICR,ICB,IX   ,IY+R,R ,R ,I2,IAD_VALUE
  58. 1570     CALLM ID_GRD,IAD_SQDT,ICG,ICR,ICB,IX   ,IY-R,R ,R ,I2,IAD_VALUE
  59. 1580     CALLM ID_GRD,IAD_SQDT,ICG,ICB,ICR,IX+R1,IY  ,R ,R ,I2,IAD_VALUE
  60. 1590     CALLM ID_GRD,IAD_SQDT,ICG,ICB,ICR,IX-R1,IY  ,R ,R ,I2,IAD_VALUE
  61. 1600   NEXT
  62. 1610 NEXT
  63. 1620 RETURN
  64. 1630 '                    /////　デモ３　/////
  65. 1640 *DEMO3
  66. 1650 ICG=0 : ICR=0 : ICB=222
  67. 1660 R1=12 : R2=8 : R=6 : IE=255
  68. 1670 FOR ICR=0 TO IE STEP 63
  69. 1680   FOR I=1 TO 159 STEP 16
  70. 1690     CALLM ID_GRD,IAD_SQDT,255,ICR,255,80 ,120,12,60,I,IAD_VALUE
  71. 1700   NEXT
  72. 1710 NEXT
  73. 1720 FOR ICR=0 TO IE STEP 63
  74. 1730   FOR I=1 TO 159 STEP 16
  75. 1740     CALLM ID_GRD,IAD_SQDT,255,ICR,255,80 ,60 ,40,10,I,IAD_VALUE
  76. 1750   NEXT
  77. 1760 NEXT
  78. 1770 FOR ICR=0 TO IE STEP 63
  79. 1780   FOR I=1 TO 159 STEP 16
  80. 1790     CALLM ID_GRD,IAD_SQDT,255,ICR,255,80 ,180,40,10,I,IAD_VALUE
  81. 1800   NEXT
  82. 1810 NEXT
  83. 1820 FOR ICR=0 TO IE STEP 63
  84. 1830   FOR I=1 TO 159 STEP 16
  85. 1840     CALLM ID_GRD,IAD_SQDT,255,ICR,255,210,120,12,60,I,IAD_VALUE
  86. 1850   NEXT
  87. 1860 NEXT
  88. 1870 FOR ICR=0 TO IE STEP 63
  89. 1880   FOR I=1 TO 159 STEP 16
  90. 1890     CALLM ID_GRD,IAD_SQDT,255,ICR,255,290,120,12,60,I,IAD_VALUE
  91. 1900   NEXT
  92. 1910 NEXT
  93. 1920 FOR ICR=0 TO IE STEP 63
  94. 1930   FOR I=1 TO 159 STEP 16
  95. 1940     CALLM ID_GRD,IAD_SQDT,255,ICR,255,250,60 ,40,10,I,IAD_VALUE
  96. 1950   NEXT
  97. 1960 NEXT
  98. 1970 FOR ICR=0 TO IE STEP 63
  99. 1980   FOR I=1 TO 159 STEP 16
  100. 1990     CALLM ID_GRD,IAD_SQDT,255,ICR,255,250,180,40,10,I,IAD_VALUE
  101. 2000   NEXT
  102. 2010 NEXT
  103. 2020 FOR ICR=0 TO IE STEP 63
  104. 2030   FOR I=1 TO 159 STEP 16
  105. 2040     CALLM ID_GRD,IAD_SQDT,255,ICR,255,160,120,20,20,I,IAD_VALUE
  106. 2050   NEXT
  107. 2060 NEXT
  108. 2070 RETURN
  109. 2080 :
  110. 2090 '                    /////　デモ４　/////
  111. 2100 *DEMO4
  112. 2110 ICG=INT( 255*RND ) : ICR=INT( 255*RND ) : ICB=INT( 255*RND )
  113. 2120 FOR FI=0 TO 1250
  114. 2130  R3=R3+1 : IF R3=160 : R3=0
  115. 2140  IX=160+COS( FI/8    )*80  : IY=120+SIN( FI/7 +4 )*60
  116. 2150  CALLM ID_GRD,IAD_SQDT,ICG,ICR,ICB,IX,IY,10,10,R3,IAD_VALUE
  117. 2160  IX=160+COS( FI/12+2 )*120 : IY=120+SIN( FI/11+2 )*90
  118. 2170  CALLM ID_GRD,IAD_SQDT,ICR,ICB,ICG,IX,IY,20,10,R3,IAD_VALUE
  119. 2180  IX=160+COS( FI/16+4 )*160 : IY=120+SIN( FI/15   )*120
  120. 2190  CALLM ID_GRD,IAD_SQDT,ICB,ICG,ICR,IX,IY,10,20,R3,IAD_VALUE
  121. 2200 NEXT
  122. 2210 RETURN
  123.