REM **** simulation of simple lens ***** by smbstarv
'        refraction index and cuvature of lens are variable (within limits)
'        theta1 AND theta2 are in/ouput angles on the left side of the lens
'        phi1 AND phi2 are in/output angles on the right side of the lens
'        + 3 colored objects
     IF DEVICE_TYPE$()<>"iPad" THEN
         PRINT "for iPad only"
         STOP
     END IF
'g'
     GRAPHICS
     GRAPHICS CLEAR 0,0,0
     SET ORIENTATION 2
     OPTION ANGLE DEGREES
     SLIDER "rix" VALUE .8 AT 10,10 SIZE 300     'refractive index
     SLIDER "curv" VALUE .8 AT 500,10 SIZE 500   'curvature of leftside lens
     xrside=500
     topx=xrside
     topy=300
     botx=xrside
     boty=500
     y0=(topy+boty)/2
     
 s0:
     DRAW LINE topx,topy TO botx,boty            'draw rightside lens
     rix=1+SLIDER_VALUE("rix")*2
     DRAW TEXT "refraction index n = "&STR$(rix) AT 10,50
     svc=SLIDER_VALUE("curv")
     IF ABS(svc-.3)<.0001 THEN svc=.50001
     r=100/(svc-.3)
     h1=ASIN((boty-topy)/2/r)
     
     DRAW TEXT "curvature R= "&STR$(r) AT 510,50
     IF r>0 THEN
         x0=xrside+SQR(r^2-((boty-topy)/2)^2)
         DRAW ARC x0,y0,r,180-h1,180+h1          'draw leftside if convex lens
     END IF
     IF r<0 THEN
         x0=xrside+r
         DRAW ARC x0,y0,-r,h1,-h1                'draw leftside if concave lens
         cp=r-r*COS(h1)                          'cap length
         DRAW LINE TOpx+cp,TOpy TO TOpx,TOpy     'cap upper edge
         DRAW LINE botx+cp,boty TO botx,boty     'cap bottom edge
     END IF
'r'
     REFRESH OFF
     apx=50                                      'colored objects ap,bp, cp
     bpx=50
     cpx=50
     apy=y0-40
     bpy=y0
     cpy=y0+40
     apx1=x0-SQR(r^2-(y0-apy)^2)*SIGN(r)
     bpx1=x0-SQR(r^2-(y0-bpy)^2)*SIGN(r)
     cpx1=x0-SQR(r^2-(y0-cpy)^2)*SIGN(r)
     atheta=ASIN((y0-apy)/r)
     btheta=ASIN((y0-bpy)/r)
     ctheta=ASIN((y0-cpy)/r)
     
     DRAW COLOR 1,1,1
     DRAW ALPHA .2
     FOR y=(topy+10) TO (boty-10) STEP 20
         x1=x0-SQR(r^2-(y0-y)^2)*SIGN(r)
         y1=y
         ray(0,y1,x1,y1,ASIN((y0-y1)/r))
     NEXT y
     
     DRAW ALPHA 1
     FILL COLOR 1,0,0
     DRAW COLOR 1,0,0
     FILL CIRCLE apx,apy SIZE 4
     ay3=ray(apx,apy,apx1,apy,atheta)
     ay2=ray.by2
     ray(apx,apy,bpx1,bpy,btheta)
     ray(apx,apy,cpx1,cpy,ctheta)
     GOSUB drawpoint
     
     FILL COLOR 0,1,0
     DRAW COLOR 0,1,0
     FILL CIRCLE bpx,bpy SIZE 4
     ay3=ray(bpx,bpy,apx1,apy,atheta)
     ay2=ray.by2
     ray(bpx,bpy,bpx1,bpy,btheta)
     ray(bpx,bpy,cpx1,cpy,ctheta)
     GOSUB drawpoint
     
     FILL COLOR 0,0,1
     DRAW COLOR 0,0,1
     FILL CIRCLE cpx,cpy SIZE 4
     ay3=ray(cpx,cpy,apx1,apy,atheta)
     ay2=ray.by2
     ray(cpx,cpy,bpx1,bpy,btheta)
     ray(cpx,cpy,cpx1,cpy,ctheta)
     GOSUB drawpoint
     
     
     DEF ray(ax,ay,bx1,by1,theta0)
         DRAW LINE ax,ay TO bx1,by1
         theta1=ATAN((by1-ay)/(bx1-ax))-theta0
         theta2=ASIN(SIN(theta1)/.rix)
         phi1=theta2+theta0
         by2=TAN(phi1)*(.botx-bx1)+by1
         DRAW LINE bx1,by1 TO .xrside,by2
         phi2=ASIN(SIN(phi1)*.rix)
         by3=by2+TAN(phi2)*600
         IF ABS(SIN(phi1))<1/.rix THEN           'from rightside onward
             IF .topy<by2 AND .boty>by2 THEN DRAW LINE .xrside,by2 TO .xrside+600,by3
         END IF
         RETURN by3
     END DEF
     
     DRAW COLOR 1,1,1
     REFRESH ON
     DO
         sw1=SLIDER_CHANGED("rix")
         sw2=SLIDER_CHANGED("curv")
         sw=sw1+ sw2
     UNTIL sw
     GRAPHICS CLEAR 0,0,0
     GOTO s0
'b'
 drawpoint:                                       'intersection upper and lower ray
     cy2=ray.by2
     cy3=ray.by3
     tm=(cy2-ay2)/(ay3-cy3)
     xac=xrside+tm/(tm+1)*(600)
     yac=ay2+tm/(tm+1)*(ay3-ay2)
     IF xac>xrside THEN FILL CIRCLE xac,yac SIZE 4
     RETURN
     END