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 blockdraw
  20 ##needs braces
  21
  22 ##lookin ..Shapes
  23 ##lookin Blockdraw
  24
  25 ##unit u = 1cm
  26
  27 pointMark: [facing [fill [circle 2bp]]]
  28
  29 baseVectors3D: \ nx ny nz →
  30 {
  31   len: 1.5u
  32   tmpHead: [MetaPostArrow3D ahLength:3mm ...]
  33   @width: 1.5bp
  34   |
  35   ( newGroup3D
  36     << pointMark
  37     << [stroke (0u,0u,0u)--(len,0u,0u) head:[tmpHead normal:nx ...]]
  38     << [stroke (0u,0u,0u)--(0u,len,0u) head:[tmpHead normal:ny ...]]
  39     << [stroke (0u,0u,0u)--(0u,0u,len) head:[tmpHead normal:nz ...]]
  40     << [tag 'x (len,0u,0u)]
  41     << [tag 'y (0u,len,0u)]
  42     << [tag 'z (0u,0u,len)]
  43   )
  44 }
  45
  46 baseVectors2D: \ →
  47 {
  48   nx: (0,0,1)
  49   ny: (0,0,1)
  50   len: 1u
  51   tmpHead: [MetaPostArrow3D ahLength:2mm ahAngle:60° ...]
  52   @width: 0.6bp
  53   |
  54   ( newGroup3D
  55     << pointMark
  56     << [stroke (0u,0u,0u)--(len,0u,0u) head:[tmpHead normal:nx ...]]
  57     << [stroke (0u,0u,0u)--(0u,len,0u) head:[tmpHead normal:ny ...]]
  58     << [tag 'x (len,0u,0u)]
  59     << [tag 'y (0u,len,0u)]
  60   )
  61 }
  62
  63 •world: newGroup3D
  64
  65 /**
  66  ** We draw the picture in the camera's coordinates
  67  **/
  68
  69 C: (0u,0u,0u)
  70 P: (1u,0.5u,8u)
  71 P0: (0u,0u,9u)
  72 f: 5u
  73 p: [mspoint C--P f/P.z]
  74
  75 {
  76   base: [baseVectors3D (0,0,1) (0,0,1) (1,0,0)]
  77   •world << base
  78          << [shift [find base 'x]] [] [facing [putlabelBelow [TeX `$x$´] (0m,0m) ~1]]
  79          << [shift [find base 'y]] [] [facing [putlabelRight [TeX `$y$´] (0m,0m) ~1]]
  80          << [shift [find base 'z]] [] [facing [putlabelAbove [TeX `$z$´] (0m,0m) 1]]
  81 }
  82
  83 •rayWorld: newZSorter
  84 •rayWorld << [stroke C--P]
  85 •rayWorld << @dash:[dashpattern 1mm 1mm] | [stroke C--P0]
  86 {
  87   sz: 1.5u
  88   imageFrame: [shift (0u,0u,f)] [] [immerse [rectangle (~sz,~sz) (sz,sz)]]
  89   •world << [tag 'frame imageFrame]
  90   •rayWorld << @nonstroking:GRAY_WHITE | [fill imageFrame]
  91   •rayWorld << [stroke imageFrame]
  92 }
  93 rayWorld: •rayWorld;
  94 •world << rayWorld
  95 {
  96   base: [shift (0u,0u,f)] [] [baseVectors2D]
  97   •world << base
  98          << [shift [find base 'x]] [] [facing [putlabelAbove [TeX `$x$´] (0m,0m) ~1]]
  99          << [shift [find base 'y]] [] [facing [putlabelRight [TeX `$y$´] (0m,0m) ~1]]
 100 }
 101
 102 {
 103   bracePath: [rotate3D dir:(0,1,0) angle:~90°] [] [immerse [someClosedBrace (f,0u) (0u,0u)]]
 104   •world << [fill bracePath]
 105   |** Next, I use that I happen to know that the tip of the brace is at path time 1.
 106   •world << [shift [bracePath 1].p] [] [facing [putlabelBelow [TeX `$\mathrm{f}$´] (0m,0m) 0]]
 107 }
 108
 109 •world << [shift C] [] [facing [putlabelAbove [TeX `$\mathrm{C}$´] (0m,0m) 1]]
 110        << [tag 'C C]
 111        << [shift P] [] pointMark
 112        << [tag 'P P]
 113        << [shift P] [] [facing [putlabelBelow [TeX `$P$´] (0m,0m) 0]]
 114        << [shift p] [] pointMark
 115        << [shift p] [] [facing [putlabelLeft [TeX `$p$´] (0m,0m) 1]]
 116        << [tag 'P0 P0]
 117        << [tag 'planePoint [shift (0u,0u,f)][][immerse (0.3u,~1u)]]
 118
 119 flatWorld: (•world) >> [shift (~30u,~5u,0u)]*[rotate3D dir:(1,0,0) angle:180°]*[rotate3D dir:(0,1,0) angle:90°] >> view
 120 •page << flatWorld
 121
 122   @width: 0.5bp
 123 & @defaultunit: 1%C
 124 |
 125 {
 126   lblArrow: ShapesArrow
 127 {
 128   pt: [find flatWorld 'C]
 129   lblPt: pt + (0.3u,1u)
 130   •page << [shift lblPt] [] [center [TeX `\begin{minipage}{1cm}\centering optical\\center\end{minipage}´] (0,~1)]
 131   •page << [stroke lblPt>(^~80°)--(^60°)<pt head:lblArrow]
 132 }
 133 {
 134   pt: [mspoint [find flatWorld 'C]--[find flatWorld 'P0] 1 ~1.5u]
 135   lblPt: pt + (0.5u,1u)
 136   •page << [shift lblPt] [] [center [TeX `\begin{minipage}{1cm}\centering optical\\axis\end{minipage}´] (0,~1)]
 137   •page << [stroke lblPt>(^~100°)--(^90°)<pt head:lblArrow]
 138 }
 139 {
 140   pt: [find flatWorld 'planePoint]
 141   lblPt: pt + (~1.5u,0.2u)
 142   •page << [shift lblPt] [] [center [TeX `\begin{minipage}{1cm}\centering image\\plane\end{minipage}´] (1,0)]
 143   pth: lblPt>(^10°)--(^180°)<pt
 144   sl: [intersection pth [find flatWorld 'frame]]+0.5bp  /** The extra distance is for half the width of the image frame. **/
 145   •page << [stroke pth.begin--sl] << @stroking:[gray 0.7] | [stroke sl--pth.end head:lblArrow]
 146 }
 147 }