1000 ' マウスで３Ｄプログラム
1010 ' save "3D-96.BAS",a :  'Programed by T.Tokoro  H5.7.29-10.20, H6.7.14
1020 '                                               H8.7.16-19
1030 '*****  初期設定  *****
1040 '
1050  OPTION BASE 1
1060  DIM Z(2001,3)
1070  DEF FNZ(X,Y)=(POINT(X,Y)-8)/10
1080 L=10:C=8:ANS$="n"   '半径と色の初期値
1090 CLS 3:COLOR ,,,,2   '4096色中 16色モード
1100 SCREEN 3,0,0,1      '400ﾗｲﾝ ｶﾗｰﾓｰﾄﾞ
1110 CONSOLE 0,24,0,1,0  :'0-25ｽｸﾛｰﾙ,ﾌｧﾝｸｼｮﾝｷｰ ｱﾘ,ｶﾗｰ,ﾆﾎﾝｺﾞ
1120 MOUSE 0             :'ﾏｳｽﾉ ｼｮｷｶ
1130 MOUSE 1,,,0         :'ﾏｳｽﾉ ﾋｮｳｼﾞ off
1140 MOUSE (2) ON        :'ﾏｳｽﾉ ｷｰ ﾆｭｳﾘｮｸ ﾋﾀﾞﾘ
1150 MOUSE (3) ON        :'               ﾐｷﾞ
1160 MOUSE 1,,,1         :'ﾏｳｽﾉ ﾋｮｳｼﾞ on
1170 GOSUB *GLOADER'
1180 IF ANS$="" THEN LINE (0,0)-(639,399),8,BF
1190 FOR I=0 TO 15: LINE (I*40,16)-(I*40+40,32),I,BF: NEXT I
1200 LINE (0,16)-(639,32),7,B: LOCATE 0,0
1210 PRINT "マウスの左ボタンで書く，右ボタンで消す．色    "
1220 PRINT " 後" :LOCATE 77,1:PRINT "前"
1230 ' LOCATE 24,24:COLOR 5:PRINT "  岐阜高専電気工学科見学会";:COLOR 7
1240 LOCATE 26,24:COLOR 5:PRINT "岐阜高専ひらめきパズル教室";:COLOR 7
1250 ' LOCATE 26,24:COLOR 5:PRINT "岐阜高専電気工学科一日入学";:COLOR 7
1260 '
1270 '*****  描画ルーチン　*****
1280 '
1290 X=MOUSE(0):Y=MOUSE(1)  :'ﾏｳｽﾉ ｻﾞﾋｮｳ
1300 IF Y<32 THEN GOSUB *COLORS
1310 IF X<5 THEN 1320 ELSE 1350
1320   L=L-1 : IF L=<2 THEN L=2
1330   BEEP:LOCATE 48,0: PRINT "筆を小さくします。大きさ＝";L;"  ";
1340   FOR T=1 TO 1000: NEXT T :GOTO 1410
1350 IF X>635 THEN 1360 ELSE 1390
1360   L=L+1 : IF L=>640 THEN L=640
1370   BEEP:LOCATE 48,0: PRINT "筆を大きくします。大きさ＝";L;"  ";
1380   FOR T=1 TO 1000: NEXT T: GOTO 1410
1390 '
1400 LOCATE 48,0: PRINT"マウスの座標 X=";X;",Y=";Y;"     "
1410 MOUSE 1,,,0
1420   IF MOUSE(2,1)=1 AND MOUSE (2,2)=1 THEN *ENDING
1430   IF MOUSE(2,1)=1 THEN CIRCLE(X,Y),L,C,,,,F
1440   IF MOUSE(2,2)=1 THEN LINE(X-L-1,Y-L-1)-(X+L+1,Y+L+1),0,BF
1450 MOUSE 1,,,1:GOTO 1290
1460 '
1470 *ENDING
1480 MOUSE 1,,,0 :GOTO 1570: CLS 3: COLOR 7: END
1490 '
1500 *COLORS ' 色（奥行き）の選択
1510 '
1520 C=X\40
1530 LINE(340,0)-(360,15),C,BF
1540 LINE(340,0)-(360,15),7,B
1550 IF C=0 THEN RETURN 1190
1560 RETURN 1290
1570 '
1580 '*****  ３Ｄステレオグラム化ルーチン  ******
1590 '
1600 SCREEN 3,1,1,33:CLS 3
1610 'INPUT WAIT 100,"繰り返しの回数（４〜８）は？（Return : 8）";NUM
1620 'INPUT WAIT 100,"画面の深度（２〜６）は？（Return : 4）";NUM2
1630 IF NUM=0 THEN NUM=8
1640 IF NUM2=0 THEN NUM2=4
1650 XMAX=639!:XMIN=0!:DX=(XMAX-XMIN)/NUM
1660 YMAX=399!:YMIN=0!:DX2=DX/2
1670 ZMAX=1!:ZMIN=-1!:Z0=DX/(ZMAX-ZMIN)/NUM2
1680 SCREEN ,,0:I=1
1690 WHILE I<1990
1700   Y0=RND*639
1710   ZZ=FNZ(DX2,Y0)
1720   XX=DX+Z0*ZZ
1730   X0=(XX)*RND
1740   COL=(RND*16 MOD 15)+1
1750   Z(I,1)=X0:Z(I,2)=Y0:Z(I,3)=COL
1760   ZZ=FNZ(X0+DX2,Y0)
1770   X0=X0+DX+Z0*ZZ:I=I+1
1780   IF X0<XMAX THEN GOTO 1750
1790 WEND
1800   SCREEN ,,1
1810 FOR I=1 TO 2000
1820    LINE(Z(I,1),Z(I,2))-(Z(I,1)+.5 ,Z(I,2)+.5),Z(I,3),B
1830 ' PSET(Z(I,1),Z(I,2))                        ,Z(I,3)
1840 ' PSET(Z(I+1,1),Z(I,2))                      ,Z(I,3)
1850 NEXT I
1860 LOCATE 0,0:PRINT"もっと点を打つ場合は左ボタン，印刷する場合は右ボタン"
1870 IF MOUSE(2,1)=1 THEN 1680
1880 IF MOUSE(2,2)=1 THEN 1890 ELSE 1870
1890  CLS:LINE(200,399-16)-(422,399),0,BF
1900 INPUT "                         パズル    パズル    パズル    ",ANS$
1910 MOUSE 1,,,0 : COLOR 7: SCREEN ,,1 :CLS 3:SCREEN ,,0
1920 INPUT "画面を消しますか？　（はい : リターン、いいえ : 他のキー）";ANS$
1930 IF ANS$="" THEN CLS 3 ELSE GOSUB *GSAVER
1940 GOTO 1100
1950 *GSAVER
1960 FILES "*.B1"
1970 INPUT "グラフィックを保存します。名前を半角８文字以内で入力(リターンで自動)";MN$
1980 IF NM$="" THEN NM$="PUZZLE"
1990 CLS
2000 DEF SEG=&HA800:BSAVE NM$+".b1",0,32000
2010 DEF SEG=&HB000:BSAVE NM$+".r1",0,32000
2020 DEF SEG=&HB800:BSAVE NM$+".g1",0,32000
2030 DEF SEG=&HE000:BSAVE NM$+".e1",0,32000
2040 RETURN
2050 *GLOADER
2060 FILES "*.B1"
2070 INPUT "グラフィックを画面に読み込みます。名前を入力して下さい(リターンで自動)";MN$
2080 IF NM$="" THEN NM$="PUZZLE"
2090 CLS
2100 DEF SEG=&HA800:BLOAD NM$+".b1",0
2110 DEF SEG=&HB000:BLOAD NM$+".r1",0
2120 DEF SEG=&HB800:BLOAD NM$+".g1",0
2130 DEF SEG=&HE000:BLOAD NM$+".e1",0
2140 RETURN