examples/applications/pinhole.shape

   1 /** This file is part of Shapes.
   2  **
   3  ** Shapes is free software: you can redistribute it and/or modify
   4  ** it under the terms of the GNU General Public License as published by
   5  ** the Free Software Foundation, either version 3 of the License, or
   6  ** any later version.
   7  **
   8  ** Shapes is distributed in the hope that it will be useful,
   9  ** but WITHOUT ANY WARRANTY; without even the implied warranty of
  10  ** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11  ** GNU General Public License for more details.
  12  **
  13  ** You should have received a copy of the GNU General Public License
  14  ** along with Shapes.  If not, see <http://www.gnu.org/licenses/>.
  15  **
  16  ** Copyright 2008, 2010, 2014 Henrik Tidefelt
  17  **/
  18
  19 ##needs ..Applications..Blockdraw
  20 ##needs ..Shapes..Graphics / braces
  21 ##needs ..Shapes..Graphics3D / metapostarrow
  22
  23 ##lookin ..Shapes
  24 ##lookin ..Shapes..Geometry3D
  25 ##lookin ..Applications..Blockdraw
  26
  27 ##unit u = 1cm
  28
  29 pointMark: [Graphics3D..facing [Graphics..fill [Geometry..circle 2bp]]]
  30
  31 baseVectors3D: \ nx ny nz →
  32 {
  33   len: 1.5u
  34   tmpHead: [Graphics3D..MetaPostArrow ahLength:3mm ...]
  35   Traits..@width: 1.5bp
  36   |
  37   ( Graphics3D..newGroup
  38     << pointMark
  39     << [Graphics..stroke (0u,0u,0u)--(len,0u,0u) head:[tmpHead normal:nx ...]]
  40     << [Graphics..stroke (0u,0u,0u)--(0u,len,0u) head:[tmpHead normal:ny ...]]
  41     << [Graphics..stroke (0u,0u,0u)--(0u,0u,len) head:[tmpHead normal:nz ...]]
  42     << [Graphics..Tag..tag 'x (len,0u,0u)]
  43     << [Graphics..Tag..tag 'y (0u,len,0u)]
  44     << [Graphics..Tag..tag 'z (0u,0u,len)]
  45   )
  46 }
  47
  48 baseVectors2D: \ →
  49 {
  50   nx: (0,0,1)
  51   ny: (0,0,1)
  52   len: 1u
  53   tmpHead: [Graphics3D..MetaPostArrow ahLength:2mm ahAngle:60° ...]
  54   Traits..@width: 0.6bp
  55   |
  56   ( Graphics3D..newGroup
  57     << pointMark
  58     << [Graphics..stroke (0u,0u,0u)--(len,0u,0u) head:[tmpHead normal:nx ...]]
  59     << [Graphics..stroke (0u,0u,0u)--(0u,len,0u) head:[tmpHead normal:ny ...]]
  60     << [Graphics..Tag..tag 'x (len,0u,0u)]
  61     << [Graphics..Tag..tag 'y (0u,len,0u)]
  62   )
  63 }
  64
  65 •world: Graphics3D..newGroup
  66
  67 /**
  68  ** We draw the picture in the camera's coordinates
  69  **/
  70
  71 C: (0u,0u,0u)
  72 P: (1u,0.5u,8u)
  73 P0: (0u,0u,9u)
  74 f: 5u
  75 p: [Layout..mspoint C--P f/P.z]
  76
  77 {
  78   base: [baseVectors3D (0,0,1) (0,0,1) (1,0,0)]
  79   •world << base
  80          << [shift [Graphics..Tag..find base 'x]] [] [Graphics3D..facing [putlabelBelow [Graphics..TeX `$x$´] (0m,0m) ~1]]
  81          << [shift [Graphics..Tag..find base 'y]] [] [Graphics3D..facing [putlabelRight [Graphics..TeX `$y$´] (0m,0m) ~1]]
  82          << [shift [Graphics..Tag..find base 'z]] [] [Graphics3D..facing [putlabelAbove [Graphics..TeX `$z$´] (0m,0m) 1]]
  83 }
  84
  85 •rayWorld: Graphics3D..newZSorter
  86 •rayWorld << [Graphics..stroke C--P]
  87 •rayWorld << Traits..@dash:[Traits..dashpattern 1mm 1mm] | [Graphics..stroke C--P0]
  88 {
  89   sz: 1.5u
  90   imageFrame: [shift (0u,0u,f)] [] [immerse [Geometry..rectangle (~sz,~sz) (sz,sz)]]
  91   •world << [Graphics..Tag..tag 'frame imageFrame]
  92   •rayWorld << Traits..@nonstroking:Traits..BW..WHITE | [Graphics..fill imageFrame]
  93   •rayWorld << [Graphics..stroke imageFrame]
  94 }
  95 rayWorld: freeze •rayWorld
  96 •world << rayWorld
  97 {
  98   base: [shift (0u,0u,f)] [] [baseVectors2D]
  99   •world << base
 100          << [shift [Graphics..Tag..find base 'x]] [] [Graphics3D..facing [putlabelAbove [Graphics..TeX `$x$´] (0m,0m) ~1]]
 101          << [shift [Graphics..Tag..find base 'y]] [] [Graphics3D..facing [putlabelRight [Graphics..TeX `$y$´] (0m,0m) ~1]]
 102 }
 103
 104 {
 105   bracePath: [Geometry3D..rotate dir:(0,1,0) angle:~90°] [] [immerse [Graphics..someClosedBrace (f,0u) (0u,0u)]]
 106   •world << [Graphics..fill bracePath]
 107   |** Next, I use that I happen to know that the tip of the brace is at path time 1.
 108   •world << [shift [bracePath 1].p] [] [Graphics3D..facing [putlabelBelow [Graphics..TeX `$\mathrm{f}$´] (0m,0m) 0]]
 109 }
 110
 111 •world << [shift C] [] [Graphics3D..facing [putlabelAbove [Graphics..TeX `$\mathrm{C}$´] (0m,0m) 1]]
 112        << [Graphics..Tag..tag 'C C]
 113        << [shift P] [] pointMark
 114        << [Graphics..Tag..tag 'P P]
 115        << [shift P] [] [Graphics3D..facing [putlabelBelow [Graphics..TeX `$P$´] (0m,0m) 0]]
 116        << [shift p] [] pointMark
 117        << [shift p] [] [Graphics3D..facing [putlabelLeft [Graphics..TeX `$p$´] (0m,0m) 1]]
 118        << [Graphics..Tag..tag 'P0 P0]
 119        << [Graphics..Tag..tag 'planePoint [shift (0u,0u,f)][][immerse (0.3u,~1u)]]
 120
 121 flatWorld: (•world) >> [shift (~30u,~5u,0u)]*[Geometry3D..rotate dir:(1,0,0) angle:180°]*[Geometry3D..rotate dir:(0,1,0) angle:90°] >> view
 122 IO..•page << flatWorld
 123
 124   Traits..@width: 0.5bp
 125 & Geometry..@defaultunit: 1%C
 126 |
 127 {
 128   lblArrow: Graphics..ShapesArrow
 129 {
 130   pt: [Graphics..Tag..find flatWorld 'C]
 131   lblPt: pt + (0.3u,1u)
 132   IO..•page << [Geometry..shift lblPt] [] [Layout..center [Graphics..TeX `\begin{minipage}{1cm}\centering optical\\center\end{minipage}´] (0,~1)]
 133   IO..•page << [Graphics..stroke lblPt>(^~80°)--(^60°)<pt head:lblArrow]
 134 }
 135 {
 136   pt: [Layout..mspoint [Graphics..Tag..find flatWorld 'C]--[Graphics..Tag..find flatWorld 'P0] 1 ~1.5u]
 137   lblPt: pt + (0.5u,1u)
 138   IO..•page << [Geometry..shift lblPt] [] [Layout..center [Graphics..TeX `\begin{minipage}{1cm}\centering optical\\axis\end{minipage}´] (0,~1)]
 139   IO..•page << [Graphics..stroke lblPt>(^~100°)--(^90°)<pt head:lblArrow]
 140 }
 141 {
 142   pt: [Graphics..Tag..find flatWorld 'planePoint]
 143   lblPt: pt + (~1.5u,0.2u)
 144   IO..•page << [Geometry..shift lblPt] [] [Layout..center [Graphics..TeX `\begin{minipage}{1cm}\centering image\\plane\end{minipage}´] (1,0)]
 145   pth: lblPt>(^10°)--(^180°)<pt
 146   sl: [Geometry..intersection pth [Graphics..Tag..find flatWorld 'frame]]+0.5bp  /** The extra distance is for half the width of the image frame. **/
 147   IO..•page << [Graphics..stroke pth.begin--sl] << Traits..@stroking:[Traits..gray 0.7] | [Graphics..stroke sl--pth.end head:lblArrow]
 148 }
 149 }