視力検査

 投稿者:しばっち  投稿日:2012年 2月19日(日)21時22分36秒
  (ご注意)

できるだけモニター画面から離れて(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
 

戻る