examples/applications/johans.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 Henrik Tidefelt
  17  **/
  18
  19 ##needs conssupport
  20 /**
  21 N := 1000:
  22 R := [evalf(seq(2/N*(N-i),i=1..N))]:
  23 phi := [evalf(seq(1.4*Pi/N*(N-i)+0.5,i=1..N))]:
  24 p3 := plot3d(sin(x*y),x=-2.1..2.1,y=-2.1..2.1,grid=[15,15],style=patch,color=white): # 2.1  [15,15] el. [25,25] för hög eller
  25
  26 points:= [seq([R[i]*sin(phi[i]),R[i]*cos(phi[i]),sin(R[i]*sin(phi[i])*R[i]*cos(phi[i]))],i=1..N)]:
  27 p4 := pointplot3d(points,style=LINE,thickness=2,color=black):
  28 p5 := pointplot3d(points[-1],color=black,symbol=solidsphere,symbolsize=20):
  29 p6 := pointplot3d(points[1],color=black,symbol=solidsphere,symbolsize=20):
  30
  31 display(p3,p4,p5,orientation=[-17,25]);
  32 **/
  33
  34 R: 5cm
  35 u: R/2.1
  36
  37 /** The function describing the manifold.
  38  **/
  39 surfz: \ p .> (0.24*R) * [sin (p.x/u) * (p.y/u)]
  40
  41 /** A general-purpose helper.
  42  **/
  43 surfit: \ f p .> ( p.x, p.y, [f p] )
  44
  45 /** A general-purpose surface-circle.
  46  **/
  47 surfaceCircle: \ f r c sides:'12 .>
  48 {
  49   mid: [surfit f c]
  50         [[range '0 sides-'1].foldl
  51    \ p e .> p & [fill mid--[surfit f c+r*[dir (360°*e)/sides]]--[surfit f c+r*[dir (360°*(e+'1))/sides]]--cycle]
  52          null3D]
  53 }
  54
  55 /** A path on our surface.
  56  **/
  57 points:
  58 {
  59   N: '100
  60         [[range '1 N].foldl
  61          \ p i .>
  62                  p--[surfit surfz (2/N)*(N-i)*u*[dir 90°-(1.4*(180°/N)*(N-i)-0)]]
  63    emptypath3D]
  64 }
  65
  66
  67 foldpairsl:
  68 {
  69   helper: \ op nullRes last lst .> [if [null? lst] nullRes [helper op [op nullRes last lst.car] lst.car lst.cdr]]
  70
  71   \ op nullRes lst .>
  72     [if [null? lst]
  73                         lst
  74                         [helper op nullRes lst.car lst.cdr]]
  75 }
  76
  77 foldtriplesl:
  78 {
  79   helper: \ op nullRes back2 back1 lst .> [if [null? lst] nullRes [helper op [op nullRes back2 back1 lst.car] back1 lst.car lst.cdr]]
  80
  81   \ op nullRes lst .>
  82     [if [null? lst]
  83                         lst
  84       [if [null? lst.cdr]
  85                         [list]
  86                         [helper op nullRes lst.car lst.cdr.car lst.cdr.cdr]]]
  87 }
  88
  89 functionMesh: \ zMap xRange yRange step:'1 .>
  90 {
  91   xyz: \ p .> ( p.x, p.y, [zMap p] )
  92   [foldl
  93     \ p x .>
  94                         p
  95                         &
  96                         [stroke
  97         [yRange.foldl
  98            \ p y .> p--[xyz (x,y)]
  99            emptypath3D
 100                         ]]
 101     null3D
 102                 [sublist [consify xRange] step]
 103   ]
 104         &
 105   [foldl
 106     \ p y .>
 107                         p
 108                         &
 109                         [stroke
 110         [xRange.foldl
 111            \ p x .> p--[xyz (x,y)]
 112            emptypath3D
 113                         ]]
 114     null3D
 115                 [sublist [consify yRange] step]
 116   ]
 117 }
 118
 119 functionSurface: \ zMap xRange yRange .>
 120 {
 121   xyz: \ p .> ( p.x, p.y, [zMap p] )
 122         xConsRange: [consify xRange]
 123         yConsRange: [consify yRange]
 124   [foldpairsl
 125     \ p x1 x2 .>
 126                         p
 127                         &
 128       [foldpairsl
 129          \ p y1 y2 .>
 130           p
 131                                         &
 132                                         {
 133                                           p11: [xyz (x1,y1)]
 134                                           p12: [xyz (x1,y2)]
 135                                           p21: [xyz (x2,y1)]
 136                                           p22: [xyz (x2,y2)]
 137                                           pc: [xyz (0.5*(x1+x2),0.5*(y1+y2))]
 138                                                 [fill pc--p11--p12--cycle]
 139                                                 &
 140                                                 [fill pc--p12--p22--cycle]
 141                                                 &
 142                                                 [fill pc--p22--p21--cycle]
 143                                                 &
 144                                                 [fill pc--p21--p11--cycle]
 145 /**
 146                                                 &
 147                                                 [stroke p11--pc--p22]
 148                                                 &
 149                                                 [stroke p12--pc--p21]
 150 **/
 151                                         }
 152          null3D
 153                                 yConsRange
 154                         ]
 155     null3D
 156                 xConsRange
 157   ]
 158 /**
 159         &
 160         [functionMesh zMap xRange yRange]
 161 **/
 162 }
 163
 164 angle_in_ccw_range?: \ a low high .>
 165 {
 166         am: [mod a - low 360°]
 167         [if am < 0 am+360° am] < high - low
 168 }
 169
 170 ridgeLines:
 171 {
 172   ridgeTest: \ p1 p2 o1 o2 .>
 173   {
 174     d11: [normalized o1 - p1]
 175     d12: [normalized o2 - p1]
 176     dm1: d11 + d12
 177     d21: [normalized o1 - p2]
 178     d22: [normalized o2 - p2]
 179     dm2: d21 + d22
 180     dc: [normalized p2 - p1]
 181     ( dm1*dc <= dm1*d11 ) and ( ~(dm2*dc) <= dm2*d22 )
 182   }
 183
 184  \ zMap xRange yRange tf .>
 185   {
 186     xyz: \ p .> ( p.x, p.y, [zMap p] )
 187
 188         xConsRange: [consify xRange]
 189         yConsRange: [consify yRange]
 190     [foldpairsl
 191       \ p x1 x2 .>
 192         [foldpairsl
 193           \ p y1 y2 .>
 194                                         {
 195                                           p11: view [] tf [] [xyz (x1,y1)]
 196                                           p12: view [] tf [] [xyz (x1,y2)]
 197                                           p21: view [] tf [] [xyz (x2,y1)]
 198                                           p22: view [] tf [] [xyz (x2,y2)]
 199
 200                                           pc:  view [] tf [] [xyz (0.5*(x1+x2),0.5*(y1+y2))]
 201                                                 pc3D: [xyz (0.5*(x1+x2),0.5*(y1+y2))]
 202
 203                                                 p
 204                                                 &
 205                                                   [if [ridgeTest p11 pc p12 p21] [stroke [xyz (x1,y1)]--pc3D] null3D]
 206                                                     &
 207                                                     [if [ridgeTest p12 pc p11 p22] [stroke [xyz (x1,y2)]--pc3D] null3D]
 208                                                     &
 209                                                     [if [ridgeTest p22 pc p12 p21] [stroke [xyz (x2,y2)]--pc3D] null3D]
 210                                                     &
 211                                                     [if [ridgeTest p21 pc p11 p22] [stroke [xyz (x2,y1)]--pc3D] null3D]
 212                                         }
 213           p
 214                                 yConsRange
 215                         ]
 216       null3D
 217                 xConsRange
 218     ]
 219         &
 220     [foldtriplesl
 221       \ p x1 x2 x3 .>
 222         [foldpairsl
 223           \ p y1 y2 .>
 224                                         {
 225                                           p1: view [] tf [] [xyz (x2,y1)]
 226                                           p2: view [] tf [] [xyz (x2,y2)]
 227                                           pc1:  view [] tf [] [xyz (0.5*(x1+x2),0.5*(y1+y2))]
 228                                           pc2:  view [] tf [] [xyz (0.5*(x2+x3),0.5*(y1+y2))]
 229                                                 [if [ridgeTest p1 p2 pc1 pc2]
 230                                                         p & [stroke [xyz (x2,y1)]--[xyz (x2,y2)]]
 231                                                         p]
 232                                         }
 233           p
 234                                 yConsRange
 235                         ]
 236       null3D
 237                 xConsRange
 238     ]
 239         &
 240     [foldtriplesl
 241       \ p y1 y2 y3 .>
 242         [foldpairsl
 243           \ p x1 x2 .>
 244                                         {
 245                                           p1: view [] tf [] [xyz (x1,y2)]
 246                                           p2: view [] tf [] [xyz (x2,y2)]
 247                                           pc1:  view [] tf [] [xyz (0.5*(x1+x2),0.5*(y1+y2))]
 248                                           pc2:  view [] tf [] [xyz (0.5*(x1+x2),0.5*(y2+y3))]
 249                                                 [if [ridgeTest p1 p2 pc1 pc2]
 250                                                         p & [stroke [xyz (x1,y2)]--[xyz (x2,y2)]]
 251                                                         p]
 252                                         }
 253           p
 254                                 xConsRange
 255                         ]
 256       null3D
 257                 yConsRange
 258     ]
 259   }
 260 }
 261
 262 T_view: [rotate3D dir:(1,0,0) angle:~90°-~19°]*[rotate3D dir:(0,0,1) angle:~90°+25°]
 263
 264 N_major: '12
 265 N_minor: '4
 266 xRange: [range ~R R count: N_major * N_minor + '1]
 267 yRange: [range ~R R count: N_major * N_minor + '1]
 268
 269 •page << @width:0.8bp
 270                            |
 271                                  [view
 272                                    T_view
 273                                          []
 274                                          ( newZSorter
 275                                            <<   @nonstroking:OCCLUDING
 276                                                                 | [functionSurface surfz xRange yRange]
 277                                            << [functionMesh surfz xRange yRange N_minor]
 278                                            << [ridgeLines surfz xRange yRange T_view]
 279                                          )
 280                                  ]
 281 •page << @width:1.8bp
 282                            |
 283                                  [view
 284                                    T_view
 285                                          []
 286                                          ( newGroup3D
 287                                                  << @cap:CAP_ROUND | [stroke points]
 288                                                  << [surfaceCircle surfz 2.5*@width (points.begin.p.x,points.begin.p.y)]
 289                                                  << [surfaceCircle surfz 2.5*@width (points.end.p.x,points.end.p.y)]
 290                                          )
 291                                  ]