|
|
(ご注意)
できるだけモニター画面から離れて(50-500cm程度)行ってください。
画面解像度や距離によっては、文字や図形の表示位置や大きさなどプログラムの一部修正が必要になる場合があります。
測定結果はあくまで参考程度にしてください。信憑性はありません。
一人での実行で操作上困難になる場合は、二人で行うなどしてください。
!'ランドルト環
PUBLIC NUMERIC XSIZE,YSIZE
LET XSIZE=1280 !'画面解像度1280*800(画面のプロパティの「設定」より)
LET YSIZE=800
LET XSIZE=XSIZE-50 !'スクロールバーが出ない程度に(できるだけ広く表示させるため)
LET YSIZE=YSIZE-100
CALL GINIT(XSIZE,YSIZE)
DIM A$(8),S$(13)
MAT READ A$
DATA "1.右","2.右上","3.上","4.左上","5.左","6.左下","7.下","8.右下"
MAT READ S$ !'視力
DATA 0.1,0.2,0.3,0.4,0.5,0.6,0.7,0.8,0.9,1.0,1.2,1.5,2.0
RANDOMIZE
LET MODE=2 !'入力モード
LET L=192 !'←書き換えること。画面上での長さ5cm(※15.4インチモニター、画面解像度1280*800の場合です)
CALL DISPSCALE(L) !'初回実行時のみ。実行2度目以降では変数 L値を書き換え、この行を削除、又は注釈にしてください
INPUT PROMPT "モニター画面との距離(cm) (50-500)":DISTANCE
WAIT DELAY 2
CALL DISP(XSIZE*.05,YSIZE*.85,YSIZE*.05,7,"LEFT","TOP","画面との距離 " & STR$(DISTANCE) & "cm")
CALL DISP(XSIZE*.2,YSIZE*.7,YSIZE*.06,7,"CENTER","HALF","向き")
FOR I=0 TO 7
CALL LINE(XSIZE/2,YSIZE*.7,XSIZE/2+XSIZE*.1*COS(I/4*PI),YSIZE*.7-XSIZE*.1*SIN(I/4*PI),7)
CALL CIRCLEFULL(XSIZE/2+XSIZE*.1*COS(I/4*PI),YSIZE*.7-XSIZE*.1*SIN(I/4*PI),YSIZE*.04,0)
CALL CIRCLE(XSIZE/2+XSIZE*.1*COS(I/4*PI),YSIZE*.7-XSIZE*.1*SIN(I/4*PI),YSIZE*.04,7)
CALL DISP(XSIZE/2+XSIZE*.1*COS(I/4*PI),YSIZE*.7-XSIZE*.1*SIN(I/4*PI),YSIZE*.05,7,"CENTER","HALF",STR$(I+1))
NEXT I
DO
LET MISS=0
LET N=N+1
LET D$=S$(N) & " "
DO
CALL BOXFULL(0,0,XSIZE-1,YSIZE*.48,0)
CALL DISP(XSIZE*.1,YSIZE*.25,XSIZE*.08,7,"LEFT","HALF",S$(N))
LET R=1.5*L/20/VAL(S$(N))*DISTANCE/500
IF R<4 THEN !'半径4dot未満で測定中止(判別不可能)
CALL BOXFULL(0,0,XSIZE-1,YSIZE*.48,0)
CALL DISP(XSIZE*.5,YSIZE*.15,YSIZE*.05,7,"CENTER","BOTTOM","これ以上測定できません")
CALL DISP(XSIZE*.5,YSIZE*.21,YSIZE*.05,7,"CENTER","BOTTOM","あなたの視力は" & S$(N-1) & "以上です")
STOP
END IF
LET K=INT(RND*8)
CALL CIRCLEFULL(XSIZE/2,YSIZE*.25,R,7) !'ランドルト環表示
CALL CIRCLEFULL(XSIZE/2,YSIZE*.25,R*.6,0)
DRAW BOX(R) WITH ROTATE(-K*PI/4)*SHIFT(XSIZE/2,YSIZE*.25)
SELECT CASE MODE
CASE 0
INPUT PROMPT "向き (1 - 8)":H
CASE 1
LOCATE CHOICE(A$) : H
CASE 2
CALL GETNUM(H)
END SELECT
IF H<>(K+1) THEN
CALL BOXFULL(0,0,XSIZE-1,YSIZE*.48,0)
CALL DISP(XSIZE/2,YSIZE*.25,XSIZE*.08,2,"CENTER","HALF","不正解")
LET D$=D$ & "×"
LET MISS=MISS+1
ELSE
CALL BOXFULL(0,0,XSIZE-1,YSIZE*.48,0)
CALL DISP(XSIZE/2,YSIZE*.25,XSIZE*.08,2,"CENTER","HALF","正解")
LET D$=D$ & "○"
END IF
IF N<10 THEN
CALL DISP(XSIZE*.65,YSIZE/2+YSIZE*.04*N,YSIZE*.03,7,"LEFT","HALF",D$)
ELSE
CALL DISP(XSIZE*.83,YSIZE/2+YSIZE*.04*(N-9),YSIZE*.03,7,"LEFT","HALF",D$)
END IF
WAIT DELAY 1.2
IF MISS=2 THEN !'連続ミス2回で測定終了
CALL BOXFULL(0,0,XSIZE-1,YSIZE*.48,0)
IF N=1 THEN
CALL DISP(XSIZE*.5,YSIZE*.2,YSIZE*.05,7,"CENTER","BOTTOM","あなたの視力は0.1未満です")
ELSE
CALL DISP(XSIZE*.5,YSIZE*.2,YSIZE*.05,7,"CENTER","BOTTOM","あなたの視力は" & S$(N-1) & "です")
END IF
STOP
END IF
LOOP WHILE H<>(K+1)
LOOP UNTIL N=13
CALL BOXFULL(0,0,XSIZE-1,YSIZE*.48,0)
CALL DISP(XSIZE*.5,YSIZE*.2,YSIZE*.05,7,"CENTER","BOTTOM","あなたの視力は" & S$(N) & "です")
END
EXTERNAL SUB GETNUM(K) !'マウス操作による入力
CALL DISP(XSIZE/2,YSIZE*.95,YSIZE*.03,3,"CENTER","HALF","数字をクリックしてください")
DO
DO
LET XX=X
LET YY=Y
MOUSE POLL X,Y,LEFT,RIGHT
LOOP WHILE X=XX AND Y=YY AND LEFT=0 AND RIGHT=0
FOR I=0 TO 7
LET XO=XSIZE/2+XSIZE*.1*COS(I/4*PI)
LET YO=YSIZE*.7-XSIZE*.1*SIN(I/4*PI)
IF SQR((X-XO)^2+(Y-YO)^2)<YSIZE*.05 THEN
CALL CIRCLEFULL(XSIZE/2+XSIZE*.1*COS(I/4*PI),YSIZE*.7-XSIZE*.1*SIN(I/4*PI),YSIZE*.04,4)
CALL DISP(XSIZE/2+XSIZE*.1*COS(I/4*PI),YSIZE*.7-XSIZE*.1*SIN(I/4*PI),YSIZE*.05,2,"CENTER","HALF",STR$(I+1))
IF LEFT=1 OR RIGHT=1 THEN
LET K=I+1
EXIT SUB
END IF
ELSE
CALL CIRCLEFULL(XSIZE/2+XSIZE*.1*COS(I/4*PI),YSIZE*.7-XSIZE*.1*SIN(I/4*PI),YSIZE*.04,0)
CALL CIRCLE(XSIZE/2+XSIZE*.1*COS(I/4*PI),YSIZE*.7-XSIZE*.1*SIN(I/4*PI),YSIZE*.04,7)
CALL DISP(XSIZE/2+XSIZE*.1*COS(I/4*PI),YSIZE*.7-XSIZE*.1*SIN(I/4*PI),YSIZE*.05,7,"CENTER","HALF",STR$(I+1))
END IF
NEXT I
LOOP
END SUB
EXTERNAL PICTURE BOX(R)
SET AREA COLOR 0
PLOT AREA: 0,0-R*.2;0,0+R*.2;0+R*1.1,0+R*.2;0+R*1.1,0-R*.2
END PICTURE
EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0 , XSIZE-1 , YSIZE-1, 0
SET POINT STYLE 1
SET COLOR MODE "REGULAR"
SET COLOR MIX(0) 1,1,1
SET COLOR MIX(1) 0,0,1
SET COLOR MIX(2) 1,0,0
SET COLOR MIX(3) 1,0,1
SET COLOR MIX(4) 0,1,0
SET COLOR MIX(5) 0,1,1
SET COLOR MIX(6) 1,1,0
SET COLOR MIX(7) 0,0,0
CLEAR
END SUB
EXTERNAL SUB DISPSCALE(L) !'画面にものさしをあてて調整して下さい。初回実行時は要調整
CALL DISP(XSIZE*.5,YSIZE*.18,YSIZE*.04,7,"CENTER","HALF","下記目盛りの長さが5cmになるように調整してください")
CALL DISP(XSIZE*.15,YSIZE*.7,YSIZE*.03,7,"CENTER","HALF","'+' or '-' Key")
CALL DISP(XSIZE*.15,YSIZE*.8,YSIZE*.03,7,"CENTER","HALF","SPACE Key")
DO
CALL BOXFULL(XSIZE*.1,YSIZE*.25,XSIZE,YSIZE*.65,0)
CALL LINE(XSIZE*.5-100,YSIZE*.3124,XSIZE*.5-100+L,YSIZE*.3124,7)
FOR I=0 TO 5
IF I=0 OR I=5 THEN LET K=YSIZE*.0125 ELSE LET K=0
CALL LINE(XSIZE*.5-100+I*L/5,YSIZE*.3062-K,XSIZE*.5-100+I*L/5,YSIZE*.3187+K,7)
NEXT I
CALL DISP(XSIZE/2,YSIZE*.55,YSIZE*.04,7,"CENTER","HALF","L=" & STR$(L))
CHARACTER INPUT S$
IF S$="+" THEN LET L=L+1
IF S$="-" THEN LET L=L-1
LOOP UNTIL S$=" " OR S$=" "
CLEAR
END SUB
EXTERNAL SUB DISP(X,Y,H,C,M$,N$,MES$)
SET TEXT HEIGHT H
SET TEXT COLOR C
SET TEXT JUSTIFY M$,N$
PLOT TEXT ,AT X,Y:MES$
END SUB
EXTERNAL SUB CIRCLEFULL(X,Y,RR,C)
SET COLOR C
DRAW DISK WITH SCALE(RR)*SHIFT(X,Y)
END SUB
EXTERNAL SUB CIRCLE(X,Y,RR,C)
SET COLOR C
DRAW CIRCLE WITH SCALE(RR)*SHIFT(X,Y)
END SUB
EXTERNAL SUB BOXFULL(X1,Y1,X2,Y2,C)
SET AREA COLOR C
PLOT AREA: X1,Y1;X2,Y1;X2,Y2;X1,Y2;X1,Y1
END SUB
EXTERNAL SUB LINE(XS,YS,XE,YE,C)
SET LINE COLOR C
PLOT LINES
PLOT LINES: XS,YS;XE,YE
END SUB
|
|