home *** CD-ROM | disk | FTP | other *** search
/ FreeWare Collection 2 / FreeSoftwareCollection2pd199x-jp.img / fbasic / prelude / pds0a / fractal / frademo3.bas < prev    next >
BASIC Source File  |  1990-06-14  |  6KB  |  179 lines
  1. 100 ' F-BASIC386 SAMPLE PROGRAM % COPYRIGHT FUJITSU LIMITED 19900502
  2. 110 ' PUBLIC DOMAIN SOFTWARE by PRELUDE FMC(Fujitsuﾏｲｺﾝｸﾗﾌﾞ)
  3. 120 ' ★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★
  4. 130 ' ★　ソフト名：ﾌﾗｸﾀﾙ･ﾃﾞﾓ PART3 V3                              ★
  5. 140 ' ★　登録名　：FRADEMO03.BAS                                   ★
  6. 150 ' ★　登録者　：PRELUDE(Yuuichi Sasaki)         　　　　　      ★
  7. 160 ' ★  動作確認：FM-TOWNS 2 F-BASIC386 V1.1L20           　　　  ★
  8. 170 ' ★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★
  9. 180 '
  10. 190 *環境 ' *** 環境設定 ***
  11. 200 CLEAR,,1024,7000:WIDTH 80,25:CONSOLE 0,24,1
  12. 210 SCREEN@ 1:PASTEL:COLOR 7,0,1,4:CLS:COL=2:SW=1:S=1
  13. 220 WINDOW (0,0)-(319,239):VIEW (0,0)-(319,239),0,2
  14. 230 RANDOMIZE TIME:DIM X(640),Y(640)
  15. 240 ON ERROR GOTO *異常
  16. 250 INTERVAL 2:ON INTERVAL GOSUB *時計:INTERVAL ON
  17. 260 ON KEY(1) GOSUB *PF1:KEY(1) ON
  18. 270 ON KEY(3) GOSUB *PF3:KEY(3) ON
  19. 280 ON KEY(5) GOSUB *PF5:KEY(5) ON
  20. 290 KEY 1," 終了":KEY 2," PF2"
  21. 300 KEY 3," 書庫":KEY 4," PF4"
  22. 310 KEY 5," 絵":KEY 6," PF6"
  23. 320 KEY 7," PF7":KEY 8," PF8"
  24. 330 KEY 9," PF9":KEY 10," PF10"
  25. 340 MOUSE 0
  26. 350 ON MOUSE(2) GOSUB *左押す:MOUSE(2) ON
  27. 360 ON MOUSE(4) GOSUB *右押す:MOUSE(4) ON
  28. 370 MOUSE 1,319,239,0
  29. 380 LOCATE 10,22:PRINT "ﾏｳｽ左ｸﾘｯｸでﾒﾆｭｰを表示。"
  30. 390 GOTO *縦
  31. 400 '
  32. 410 *時計 ' *** 時計割込み処理 ***
  33. 420 INTERVAL OFF
  34. 430 TDT$=DATE$:TTM$=TIME$:TXX=POS(0):TYY=CSRLIN
  35. 440 LOCATE 10,1:PRINT TDT$;"†";TTM$;"†"
  36. 450 LOCATE TXX,TYY:INTERVAL ON:RETURN
  37. 460 '
  38. 470 *右押す ' *** ﾏｳｽ割込(終了) ***
  39. 480 MOUSE(2) OFF:MOUSE(4) OFF:INTERVAL OFF:RETURN *PF1
  40. 490 END
  41. 500 '
  42. 510 *PF1 ' *** 終了処理 ***
  43. 520 WINDOW (0,0)-(319,239):VIEW (0,0)-(319,239)
  44. 530 INTERVAL OFF:MOUSE 5:CLS 4:END
  45. 540 '
  46. 550 *PF3 ' *** FRA32A.TIF/FRA16A.TIFで保存 ***
  47. 560 LOCATE 0,0
  48. 570 PRINT"ｸﾞﾗﾌｨｯｸ画面を書庫(FRAxxA.TIF)に保存? Y で実行します。　"
  49. 580 IK$=INKEY$:IF IK$="Y" THEN GOTO 600 ELSE IF IK$="" THEN GOTO 580
  50. 590 GOTO 640
  51. 600 IF S=1 THEN KILL "\FILE\FRA32A.TIF"
  52. 610 IF S=1 THEN SAVE@ "\FILE\FRA32A.TIF",(0,0)-(319,239)
  53. 620 IF S=2 THEN KILL "\FILE\FRA16A.TIF"
  54. 630 IF S=2 THEN SAVE@ "\FILE\FRA16A.TIF",(0,0)-(639,479)
  55. 640 LOCATE 0,0
  56. 650 PRINT"                                                     　"
  57. 660 RETURN
  58. 670 '
  59. 680 *PF5 ' *** LOAD ***
  60. 690 LOCATE 0,0
  61. 700 PRINT"ｸﾞﾗﾌｨｯｸ画面を書庫(FRAxxA.TIF)から読む? Y で実行します。"
  62. 710 IK$=INKEY$:IF IK$="Y" THEN GOTO 730 ELSE IF IK$="" THEN GOTO 710
  63. 720 GOTO 750
  64. 730 IF S=1 THEN LOAD@ "\FILE\FRA32A.TIF"
  65. 740 IF S=2 THEN LOAD@ "\FILE\FRA16A.TIF"
  66. 750 LOCATE 0,0
  67. 760 PRINT"                                                       "
  68. 770 RETURN
  69. 780 '
  70. 790 *異常 ' 異常処理。
  71. 800 OPEN"A",#1,"\FILE\ERROR.BAS"
  72. 810 PRINT#1,ERL,"Error number=";ERR,"Error line=";ERL
  73. 820 CLOSE#1
  74. 830 BEEP:RESUME NEXT
  75. 840 '
  76. 850 *モード
  77. 860 IF S=1 THEN S=2:SCREEN@ 0 ELSE S=1:SCREEN@ 1
  78. 870 RETURN
  79. 880 '
  80. 890 *テレビ
  81. 900 MOUSE(2) OFF:SIMPOSE ON 0:MOUSE 1,100,100,0
  82. 910 IF 0=MOUSE(2,0) GOTO 910
  83. 920 SIMPOSE OFF:MOUSE 1,100,100,1:MOUSE(2) ON:RETURN
  84. 930 '
  85. 940 ' % % % % %  AUTOMATON (縦) % % % % %
  86. 950 '
  87. 960 *縦
  88. 970 MOUSE 1,100,100,0
  89. 980 LINE (0,0)-(319*S,239*S),PSET,1,BF
  90. 990 IF S=1 THEN LINE (0,0)-(319*S,239*S),PASTEL,7,BF
  91. 1000 NX=319*S:NY=239*S
  92. 1010 FOR I=1 TO NX-1:X(I)=0
  93. 1020 IF (I MOD 40)=0 THEN X(I)=RND*10 MOD COL
  94. 1030 NEXT I
  95. 1040 FOR I=1 TO NX-1:PSET(I,1),X(I),PASTEL
  96. 1050 NEXT I
  97. 1060 '
  98. 1070 FOR N=1 TO NY-1
  99. 1080 Y(0)=(X(0)+X(NX)) MOD COL
  100. 1090 PSET(1,N),Y(0),PASTEL
  101. 1100 FOR I=1 TO NX-1
  102. 1110 IF SW=1 THEN Y(I)=(X(I)+X(I-1)) MOD COL
  103. 1120 IF SW=2 THEN Y(I)=(X(I)+X(I+1)) MOD COL
  104. 1130 IF SW=3 THEN Y(I)=(X(I-1)+X(I+1)) MOD COL
  105. 1140 PSET(I,N),Y(I),PASTEL
  106. 1150 NEXT I
  107. 1160 FOR I=1 TO NX-1
  108. 1170 X(I)=Y(I)
  109. 1180 NEXT I
  110. 1190 NEXT N
  111. 1200 GOTO 1070
  112. 1210 '
  113. 1220 ' % % % % %  AUTOMATON (横)  % % % % %
  114. 1230 '
  115. 1240 *横
  116. 1250 MOUSE 1,100,100,0
  117. 1260 LINE (0,0)-(319*S,239*S),PSET,1,BF
  118. 1270 IF S=1 THEN LINE (0,0)-(319*S,239*S),PASTEL,7,BF
  119. 1280 NX=239*S:NY=319*S
  120. 1290 FOR I=1 TO NX-1:X(I)=0
  121. 1300 IF (I MOD 40)=0 THEN X(I)=RND*10 MOD COL
  122. 1310 NEXT I
  123. 1320 FOR I=1 TO NX-1:PSET(1,I),X(I),PASTEL
  124. 1330 NEXT I
  125. 1340 '
  126. 1350 FOR N=1 TO NY-1
  127. 1360 Y(0)=(X(0)+X(NX)) MOD COL
  128. 1370 PSET(N,1),Y(0),PASTEL
  129. 1380 FOR I=1 TO NX-1
  130. 1390 IF SW=1 THEN Y(I)=(X(I)+X(I-1)) MOD COL
  131. 1400 IF SW=2 THEN Y(I)=(X(I)+X(I+1)) MOD COL
  132. 1410 IF SW=3 THEN Y(I)=(X(I-1)+X(I+1)) MOD COL
  133. 1420 PSET(N,I),Y(I),PASTEL
  134. 1430 NEXT I
  135. 1440 FOR I=1 TO NX-1
  136. 1450 X(I)=Y(I)
  137. 1460 NEXT I
  138. 1470 NEXT N
  139. 1480 GOTO 1350
  140. 1490 '
  141. 1500 *左押す ' *** ﾏｳｽ割込(ﾒﾆｭｰ) ***
  142. 1510 MOUSE(2) OFF:MOUSE 1,100,100,1
  143. 1520 CLS 4
  144. 1530 LOCATE 0,2
  145. 1540 PRINT" 規則 1: Ai(n)=Ai-1(n-1)+Ai(n-1)"
  146. 1550 PRINT" 規則 2: Ai(n)=Ai+1(n-1)+Ai(n-1)"
  147. 1560 PRINT" 規則 3: Ai(n)=Ai-1(n-1)+Ai+1(n-1)"
  148. 1570 PRINT"0:色数=";COL;"+1"
  149. 1580 PRINT"1:規則=";SW;"+1"
  150. 1590 PRINT"C:画面消去"
  151. 1600 PRINT"E:終了"
  152. 1610 PRINT"R:ﾒﾆｭｰ消去"
  153. 1620 PRINT"S:モード";S
  154. 1630 PRINT"V:録画(ﾏｳｽ左で戻る)"
  155. 1640 PRINT"X:ｵｰﾄﾏﾄﾝ縦(ﾒﾆｭｰ消去)"
  156. 1650 PRINT"Y:ｵｰﾄﾏﾄﾝ横(ﾒﾆｭｰ消去)"
  157. 1660 GOSUB *読む
  158. 1670 IF D$="0:" THEN COL=COL+1:IF COL=9 THEN COL=2
  159. 1680 IF D$="1:" THEN SW=SW+1:IF SW=4 THEN SW=1
  160. 1690 IF D$="C:" THEN MOUSE(2) ON:CLS
  161. 1700 IF D$="E:" THEN RETURN *PF1
  162. 1710 IF D$="R:" THEN MOUSE(2) ON:CLS 4:MOUSE 1,100,100,0:RETURN
  163. 1720 IF D$="S:" THEN GOSUB *モード
  164. 1730 IF D$="V:" THEN IF S=1 THEN GOSUB *テレビ
  165. 1740 IF D$="X:" THEN MOUSE(2) ON:CLS 4:RETURN *縦
  166. 1750 IF D$="Y:" THEN MOUSE(2) ON:CLS 4:RETURN *横
  167. 1760 GOTO 1520
  168. 1770 '
  169. 1780 *読む ' 文字読み
  170. 1790 MO=MOUSE (2,0):IF MO<>0 GOTO 1790
  171. 1800 MOX=MOUSE (0):' X 座標
  172. 1810 MOY=MOUSE (1):' Y 座標
  173. 1820 D$=CHR$(SCREEN (MOX/(4*S),MOY/(10*S)))
  174. 1830 D$=D$+CHR$(SCREEN (1+MOX/(4*S),MOY/(10*S)))
  175. 1840 LOCATE 1,0:PRINT"選択=>";D$;" ﾏｳｽ左ｸﾘｯｸで選択。　　"
  176. 1850 MO=MOUSE (2,0):IF MO=0 GOTO 1800
  177. 1860 MO=MOUSE (2,0):IF MO<>0 GOTO 1860
  178. 1870 RETURN
  179.