resources/extensions/bondgraph.shext

   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 blockdraw_wfo
  20 ##needs centering
  21 ##needs shiftoff
  22
  23
  24 junction: \ txt .> [bboxed [centerat txt (0,0)] [rectangle (~@smallblockr,~@smallblockr) (@smallblockr,@smallblockr)]]
  25
  26 pjunction: [junction (TeX `p´)]
  27 sjunction: [junction (TeX `s´)]
  28
  29 junctionlbl: \ txt arrowdir lbl doArrow .>
  30 {
  31   ahLength: 1.5mm
  32   ahAngle: 30°
  33   tmppic: [junction txt]
  34   thebb: [bbox tmppic]
  35   pOffset: 0bp           |**  @connectionlw + ahLength*[sin 0.5*ahAngle]
  36   p: [if arrowdir == to_lft [[shift (0,pOffset)] ([xmax thebb],[ymax thebb])--([xmin thebb],[ymax thebb])]
  37       [if arrowdir == to_rt [[shift (0,pOffset)] ([xmin thebb],[ymax thebb])--([xmax thebb],[ymax thebb])]
  38        [if arrowdir == to_bot [[shift (pOffset,0)] ([xmax thebb],[ymax thebb])--([xmax thebb],[ymin thebb])]
  39         [if arrowdir == to_top [[shift (pOffset,0)] ([xmax thebb],[ymin thebb])--([xmax thebb],[ymax thebb])]
  40          [error [sprintf `Bad arrowdir constant: %g´ arrowdir]]]]]]
  41   d: [if arrowdir == to_lft to_top
  42       [if arrowdir == to_rt to_top
  43        [if arrowdir == to_bot to_rt
  44         [if arrowdir == to_top to_rt
  45          [error [sprintf `Bad arrowdir constant: %g´ arrowdir]]]]]]
  46
  47   [symbboxed
  48     (newGroup
  49        << [if doArrow
  50               [stroke p head: [triangleArrow ahLength:ahLength ahAngle:ahAngle...]]
  51               null]
  52        << [conlabel d lbl [mspoint p 0.5]]
  53        << tmppic )]
  54 }
  55
  56 tfjunction: \ arrowdir lbl .> [junctionlbl (TeX `TF´) arrowdir lbl true]
  57 gyjunction: \ arrowdir lbl .> [junctionlbl (TeX `GY´) arrowdir lbl false]
  58
  59
  60
  61 putblockTerminal: \ newBlock pos oldBlock .>
  62 {
  63   r: [normalized pos - [centerof oldBlock]]
  64   res: [[shift pos] [symbboxed [shift  ~r * @smallblockr] [] [shiftoffwlm newBlock [to_dir r]]]]
  65   res
  66 }
  67
  68 bgconnect: \ pica picb .>
  69 {
  70   ca: [centerof pica]
  71   cb: [centerof picb]
  72   d: [if [abs ca - cb] == 0bp
  73          (1,0)
  74          [normalized cb - ca]]
  75   (ca + d * @smallblockr)--(cb - d * @smallblockr)
  76 }
  77
  78 dynamic @bgArrowWidth identity 4bp
  79
  80 bondgraphArrow: \ p doHook:false doCausal:false ahAngle:20° fillAsStroking:true .>
  81  (@blend:BLEND_NORMAL
  82   |
  83   { theLength: @bgArrowWidth / [sin ahAngle]
  84     hook:
  85     {
  86       sl: [p theLength]
  87       z: sl.p - sl.N * theLength * [sin ahAngle]
  88       @nonstroking:[if fillAsStroking @stroking @nonstroking]
  89       |
  90       [fill [[shift sl.N * 0.5 * @width] [p 0]--sl]--z--cycle]
  91     }
  92     causal:
  93     {
  94       sl: [p 0]
  95       z: sl.p + sl.rT * @width
  96       r: sl.N * theLength * [sin ahAngle]
  97       @width: 1.5*@width
  98       |
  99       [stroke (z-r)--(z+r)]
 100     }
 101     (>
 102       picture:
 103         ( newGroup
 104            << [if doHook
 105                   hook
 106                   null]
 107           << [if doCausal
 108                  causal
 109                  null] )
 110       cut:
 111         [if doHook
 112             0.8 * theLength
 113             @width]
 114    <)
 115   }
 116  )
 117
 118 ubond: \ p .> ( @width:@connectionlw | [stroke p head:[bondgraphArrow doHook:true ...]] )
 119 hbond: \ p .> ( @width:@connectionlw | [stroke p head:[bondgraphArrow doHook:true doCausal:true ...]] )
 120 tbond: \ p .> ( @width:@connectionlw | [stroke p head:[bondgraphArrow doHook:true ...] tail:[bondgraphArrow doCausal:true ...]] )
 121
 122 |**  the midpoint has typically singular direction, so we can't do the obvious:
 123 |**  draw( conlabel( to_dir( dir( angle( direction (0.5*length(p)) of p ) - 90 ) ), txt, mspoint( p, 0.5, 0 ) ) )
 124 |**  Actually, the above comment is a relic from the MetaPost implementation, and I no longer understand it as I
 125 |**  think that bond graph connections are _typically_ just straight lines.
 126 flowlabel: \ p lbl .>
 127   [conlabel [to_dir [dir [angle [p ∞].p - [p 0].p] - 90°]] lbl [mspoint p 0.5]]
 128
 129 effortlabel: \ p lbl .>
 130   [conlabel [to_dir [dir [angle [p ∞].p - [p 0].p] + 90°]] lbl [mspoint p 0.5]]
 131
 132
 133 /** The following two functions are conventience functions that factors out the oldBlock which appears at two places.
 134  ** They return the path so that it can be labeled.
 135  **/
 136 terminalfrom: \ •dst oldBlock pos newBlock  .>
 137 {
 138   t: [putblockTerminal newBlock pos oldBlock]
 139          •dst << t
 140   [bgconnect oldBlock t]
 141 }
 142 terminalto: \ •dst oldBlock pos newBlock .>
 143 {
 144   t: [putblockTerminal newBlock pos oldBlock]
 145          •dst << t
 146   [bgconnect t oldBlock]
 147 }