apps/lindenmayer/lindenmayer.factor

   1 ! Eduardo Cavazos - wayo.cavazos@gmail.com
   2
   3 REQUIRES: libs/math
   4           libs/vars
   5           libs/slate
   6           apps/lindenmayer/opengl
   7           apps/lindenmayer/turtle
   8           apps/lindenmayer/camera
   9           apps/lindenmayer/camera-slate ;
  10
  11 USING: kernel alien namespaces arrays vectors math opengl sequences threads
  12        hashtables strings gadgets
  13        math-contrib vars slate turtle turtle-camera camera-slate
  14        opengl-contrib ;
  15
  16 IN: lindenmayer
  17
  18 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  19
  20 : record-vertex ( -- ) position> gl-vertex ;
  21
  22 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  23
  24 DEFER: polygon-vertex
  25
  26 : draw-forward ( length -- )
  27 GL_LINES glBegin record-vertex step-turtle record-vertex glEnd ;
  28
  29 : move-forward ( length -- ) step-turtle polygon-vertex ;
  30
  31 : sneak-forward ( length -- ) step-turtle ;
  32
  33 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  34
  35 ! (v0 - v1) x (v1 - v2)
  36
  37 : polygon-normal ( {_v0_v1_v2_} -- normal ) first3 dupd v- -rot v- swap cross ;
  38
  39 : (polygon) ( vertices -- )
  40 GL_POLYGON glBegin dup polygon-normal gl-normal [ gl-vertex ] each glEnd ;
  41
  42 : polygon ( vertices -- ) dup length 3 >= [ (polygon) ] [ drop ] if ;
  43
  44 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  45
  46 ! Maybe use an array instead of a vector
  47
  48 VAR: vertices
  49
  50 : start-polygon ( -- ) 0 <vector> >vertices ;
  51
  52 : finish-polygon ( -- ) vertices> polygon ;
  53
  54 : polygon-vertex ( -- ) position> vertices> push ;
  55
  56 : reset-vertices start-polygon ;
  57
  58 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  59 ! Lindenmayer string rewriting
  60 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  61
  62 ! Maybe use an array instead of a quot in the work of segment
  63
  64 VAR: rules
  65
  66 : segment ( str -- seq )
  67 { { [ dup "" = ] [ drop [ ] ] }
  68   { [ dup length 1 = ] [ unit ] }
  69   { [ 1 over nth CHAR: ( = ]
  70     [ CHAR: ) over index 1 +            ! str i
  71       2dup head                         ! str i head
  72       -rot tail                         ! head tail
  73       segment swap add* ] }
  74   { [ t ] [ dup 1 head swap 1 tail segment swap add* ] } }
  75 cond ;
  76
  77 : lookup ( str -- str ) dup 1 head rules get hash dup [ nip ] [ drop ] if ;
  78
  79 : rewrite ( str -- str ) segment [ lookup ] map concat ;
  80
  81 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  82 ! Lindenmayer string interpretation
  83 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  84
  85 SYMBOL: command-table
  86
  87 : segment-command ( seg -- command ) 1 head ;
  88
  89 : segment-parameter ( seg -- parameter )
  90 dup length 1 - 2 swap rot subseq string>number ;
  91
  92 : segment-parts ( seg -- param command )
  93 dup segment-parameter swap segment-command ;
  94
  95 : exec-command ( str -- ) command-table get hash dup [ call ] [ drop ] if ;
  96
  97 : exec-command-with-param ( param command -- )
  98 command-table get hash dup [ peek unit call ] [ 2drop ] if ;
  99
 100 : (interpret) ( seg -- )
 101 dup length 1 =
 102 [ exec-command ] [ segment-parts exec-command-with-param ] if ;
 103
 104 : interpret ( str -- ) segment [ (interpret) ] each ;
 105
 106 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 107 ! Lparser dialect
 108 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 109
 110 VAR: angle
 111 VAR: len
 112 VAR: thickness
 113 VAR: color-index
 114
 115 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 116
 117 DEFER: set-thickness
 118 DEFER: set-color-index
 119
 120 TUPLE: state position orientation angle len thickness color-index ;
 121
 122 VAR: states
 123
 124 : reset-state-stack ( -- ) V{ } clone >states ;
 125
 126 : save-state ( -- )
 127 position> orientation> angle> len> thickness> color-index> <state>
 128 states> push ;
 129
 130 : restore-state ( -- )
 131 states> pop
 132 dup state-position    >position
 133 dup state-orientation >orientation
 134 dup state-len         >len
 135 dup state-angle       >angle
 136 dup state-color-index set-color-index
 137 dup state-thickness   set-thickness
 138 drop ;
 139
 140 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 141
 142 : scale-len ( m -- ) len> * >len ;
 143
 144 : scale-angle ( m -- ) angle> * >angle ;
 145
 146 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 147
 148 VAR: color-table
 149
 150 : init-color-table ( -- )
 151 { { 0    0    0 }    ! black
 152   { 0.5  0.5  0.5 }  ! grey
 153   { 1    0    0 }    ! red
 154   { 1    1    0 }    ! yellow
 155   { 0    1    0 }    ! green
 156   { 0.25 0.88 0.82 } ! turquoise
 157   { 0    0    1 }    ! blue
 158   { 0.63 0.13 0.94 } ! purple
 159   { 0.00 0.50 0.00 } ! dark green
 160   { 0.00 0.82 0.82 } ! dark turquoise
 161   { 0.00 0.00 0.50 } ! dark blue
 162   { 0.58 0.00 0.82 } ! dark purple
 163   { 0.50 0.00 0.00 } ! dark red
 164   { 0.25 0.25 0.25 } ! dark grey
 165   { 0.75 0.75 0.75 } ! medium grey
 166   { 1    1    1 }    ! white
 167 } [ 1 set-color-alpha ] map color-table set ;
 168
 169 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 170
 171 : material-color ( color -- )
 172 GL_FRONT_AND_BACK GL_AMBIENT_AND_DIFFUSE rot gl-material-fv ;
 173
 174 : set-color-index ( i -- )
 175 dup >color-index color-table> nth dup gl-color material-color ;
 176
 177 : inc-color-index ( -- ) color-index> 1 + set-color-index ;
 178
 179 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 180
 181 : set-thickness ( i -- ) dup >thickness glLineWidth ;
 182
 183 : scale-thickness ( m -- ) thickness> * 0.5 max set-thickness ;
 184
 185 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 186
 187 VAR: default-values
 188 VAR: model-values
 189
 190 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 191
 192 : lparser-dialect ( -- )
 193
 194 [ 1 >len   45 >angle   1 >thickness   2 >color-index ] >default-values
 195
 196 H{ { "+" [ angle get     turn-left ] }
 197    { "-" [ angle get     turn-right ] }
 198    { "&" [ angle get     pitch-down ] }
 199    { "^" [ angle get     pitch-up ] }
 200    { "<" [ angle get     roll-left ] }
 201    { ">" [ angle get     roll-right ] }
 202
 203    { "|" [ 180.0         rotate-y ] }
 204    { "%" [ 180.0         rotate-z ] }
 205    { "$" [ roll-until-horizontal ]  }
 206
 207    { "F" [ len get     draw-forward ] }
 208    { "Z" [ len get 2 / draw-forward ] }
 209    { "f" [ len get     move-forward ] }
 210    { "z" [ len get 2 / move-forward ] }
 211    { "g" [ len get     sneak-forward ] }
 212    { "." [ polygon-vertex ] }
 213
 214    { "[" [ save-state ] }
 215    { "]" [ restore-state ] }
 216    { "{" [ start-polygon ] }
 217    { "}" [ finish-polygon ] }
 218
 219    { "/" [ 1.1 scale-len ] } ! double quote command in lparser
 220    { "'" [ 0.9 scale-len ] }
 221    { ";" [ 1.1 scale-angle ] }
 222    { ":" [ 0.9 scale-angle ] }
 223    { "?" [ 1.4 scale-thickness ] }
 224    { "!" [ 0.7 scale-thickness ] }
 225
 226    { "c" [ color-index> 1 + color-table get length mod set-color-index ] }
 227
 228 } command-table set ;
 229
 230 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 231
 232 VAR: axiom
 233 VAR: result
 234
 235 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 236
 237 : iterate ( -- ) result> rewrite >result ;
 238
 239 : iterations ( n -- ) [ iterate ] times ;
 240
 241 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 242
 243 VAR: model
 244
 245 : init-model ( -- ) 1 glGenLists >model ;
 246
 247 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 248
 249 : display ( -- )
 250
 251 black gl-clear-color
 252
 253 GL_FLAT glShadeModel
 254
 255 GL_PROJECTION glMatrixMode
 256 glLoadIdentity
 257 -1 1 -1 1 1.5 200 glFrustum
 258
 259 GL_MODELVIEW glMatrixMode
 260
 261 glLoadIdentity
 262
 263 [ do-look-at ] camera> with-turtle
 264
 265 GL_COLOR_BUFFER_BIT glClear
 266
 267 GL_FRONT_AND_BACK GL_LINE glPolygonMode
 268
 269 white gl-color
 270 GL_LINES glBegin { 0 0 0 } gl-vertex { 0 0 1 } gl-vertex glEnd
 271
 272 color-index> set-color-index
 273
 274 model> glCallList ;
 275
 276 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 277
 278 : init-turtle ( -- ) <turtle> >turtle ;
 279
 280 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 281
 282 : init-camera ( -- ) <turtle> >camera ;
 283
 284 : reset-camera ( -- ) [
 285 reset-turtle
 286 45 turn-left
 287 45 pitch-up
 288 5 step-turtle
 289 180 turn-left
 290 ] camera> with-turtle ;
 291
 292 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 293
 294 : init-slate ( -- )
 295 <camera-slate> >slate
 296 namespace slate> set-slate-ns
 297 slate> "L-system" open-titled-window
 298 [ display ] >action ;
 299
 300 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 301
 302 : init ( -- )
 303 init-turtle
 304 init-turtle-stack
 305 init-camera reset-camera
 306 init-model
 307
 308 2 >color-index
 309 init-color-table
 310
 311 init-slate ;
 312
 313 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 314
 315 : result>model ( -- )
 316 [ model> GL_COMPILE glNewList result> interpret glEndList ] >action .slate ;
 317
 318 : build-model ( -- )
 319 reset-state-stack
 320 reset-vertices
 321 reset-turtle
 322 default-values> call
 323 model-values> call
 324 result>model
 325 3000 sleep
 326 [ display ] >action .slate ;
 327
 328 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 329 ! Examples
 330 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 331
 332 : koch ( -- ) lparser-dialect   [ 90 >angle ] >model-values
 333
 334 H{ { "K" "[[a|b] '(0.41)f'(2.439) |<(60) [a|b]]" }
 335    { "k" "[ c'(0.5) K]" }
 336    { "a" "[d <(120) d <(120) d ]" }
 337    { "b" "e" }
 338    { "e" "[^ '(.2887)f'(3.4758) &(180)      +z{.-(120)f-(120)f}]" }
 339    { "d" "[^ '(.2887)f'(3.4758) &(109.5111) +zk{.-(120)f-(120)f}]" }
 340 } >rules
 341
 342 "K" >result ;
 343
 344 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 345
 346 : spiral-0 ( -- ) lparser-dialect   [ 10 >angle 5 >thickness ] >model-values
 347
 348 "[P]|[P]" >result
 349
 350 H{ { "P" "[A]>>>>>>>>>[cB]>>>>>>>>>[ccC]>>>>>>>>>[cccD]" }
 351    { "A" "F+;'A" }
 352    { "B" "F!+F+;'B" }
 353    { "C" "F!^+F^+;'C" }
 354    { "D" "F!>^+F>^+;'D" }
 355 } >rules ;
 356
 357 : spiral-0-scene ( -- )
 358 spiral-0
 359 22 iterations
 360 build-model
 361 [ reset-turtle 90 turn-left 16 step-turtle 180 turn-left ]
 362 camera> with-turtle .slate ;
 363
 364 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 365
 366 : tree-5 ( -- ) lparser-dialect   [ 5 >angle   1 >thickness ] >model-values
 367
 368 "c(4)FFS" >result
 369
 370 H{ { "S" "FFR>(60)R>(60)R>(60)R>(60)R>(60)R>(30)S" }
 371    { "R" "[Ba]" }
 372    { "a" "$tF[Cx]Fb" }
 373    { "b" "$tF[Dy]Fa" }
 374    { "B" "&B" }
 375    { "C" "+C" }
 376    { "D" "-D" }
 377
 378    { "x" "a" }
 379    { "y" "b" }
 380
 381    { "F" "'(1.25)F'(.8)" }
 382 } >rules ;
 383
 384 : tree-5-scene ( -- )
 385 tree-5
 386 9 iterations
 387 build-model
 388 [ reset-turtle 90 pitch-down -70 step-turtle 50 strafe-up ] camera> with-turtle
 389 .slate ;
 390
 391 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 392
 393 : abop-1 ( -- ) lparser-dialect   [ 45 >angle   5 >thickness ] >model-values
 394
 395 H{ { "A" "F[&'(.8)!BL]>(137)'!(.9)A" }
 396    { "B" "F[-'(.8)!(.9)$CL]'!(.9)C" }
 397    { "C" "F[+'(.8)!(.9)$BL]'!(.9)B" }
 398
 399    { "L" "~c(8){+(30)f-(120)f-(120)f}" }
 400 } >rules
 401
 402 "c(12)FFAL" >result ;
 403
 404 : abop-1-scene ( -- )
 405 abop-1
 406 8 iterations
 407 build-model
 408 [ reset-turtle
 409   90 pitch-up 7 step-turtle 90 pitch-down 4 step-turtle 90 pitch-down ]
 410 camera> with-turtle .slate ;
 411
 412 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 413
 414 : abop-2 ( -- ) lparser-dialect   [ 30 >angle   5 >thickness ] >model-values
 415
 416 H{ { "A" "F[&'(.7)!BL]>(137)[&'(.6)!BL]>(137)'(.9)!(.9)A" }
 417    { "B" "F[-'(.7)!(.9)$CL]'(.9)!(.9)C" }
 418    { "C" "F[+'(.7)!(.9)$BL]'(.9)!(.9)B" }
 419
 420    { "L" "~c(8){+(45)f(.1)-(45)f(.1)-(45)f(.1)+(45)|+(45)f(.1)-(45)f(.1)-(45)f(.1)}" }
 421
 422 } >rules
 423
 424 "c(12)FAL" >result ;
 425
 426 : abop-2-scene ( -- )
 427 abop-2
 428 7 iterations
 429 build-model
 430 [ reset-turtle { 0 4 4 } >position 90 pitch-down ]
 431 camera> with-turtle .slate ;
 432
 433 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 434
 435 : abop-3 ( -- ) lparser-dialect   [ 30 >angle   5 >thickness ] >model-values
 436
 437 H{ { "A" "!(.9)t(.4)FB>(94)B>(132)B" }
 438    { "B" "[&t(.4)F$A]" }
 439    { "F" "'(1.25)F'(.8)" }
 440 } >rules
 441
 442 "c(12)FA" >result ;
 443
 444 : abop-3-scene ( -- )
 445 abop-3 11 iterations build-model
 446 [ reset-turtle { 0 47 29 } >position 90 pitch-down ] camera> with-turtle
 447 .slate ;
 448
 449 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 450
 451 : abop-4 ( -- ) lparser-dialect   [ 18 >angle   5 >thickness ] >model-values
 452
 453 H{ { "N" "FII[&(60)rY]>(90)[&(45)'(0.8)rA]>(90)[&(60)rY]>(90)[&(45)'(0.8)rD]!FIK" }
 454    { "Y" "[c(4){++l.--l.--l.++|++l.--l.--l.}]" }
 455    { "l" "g(.2)l" }
 456    { "K" "[!c(2)FF>w>(72)w>(72)w>(72)w>(72)w]" }
 457    { "w" "[c(2)^!F][c(5)&(72){-(54)f(3)+(54)f(3)|-(54)f(3)+(54)f(3)}]" }
 458    { "f" "_" }
 459
 460    { "A" "B" }
 461    { "B" "C" }
 462    { "C" "D" }
 463    { "D" "E" }
 464    { "E" "G" }
 465    { "G" "H" }
 466    { "H" "N" }
 467
 468    { "I" "FoO" }
 469    { "O" "FoP" }
 470    { "P" "FoQ" }
 471    { "Q" "FoR" }
 472    { "R" "FoS" }
 473    { "S" "FoT" }
 474    { "T" "FoU" }
 475    { "U" "FoV" }
 476    { "V" "FoW" }
 477    { "W" "FoX" }
 478    { "X" "_" }
 479
 480    { "o" "$t(-0.03)" }
 481    { "r" "~(30)" }
 482 } >rules
 483
 484 "c(12)&(20)N" >result ;
 485
 486 : abop-4-scene ( -- )
 487 abop-4 21 iterations build-model
 488 [ reset-turtle
 489   { 53 25 36 } >position
 490   { { 0.57 -0.14 -0.80 } { -0.81 -0.18 -0.54 } { -0.07 0.97 -0.22 } }
 491   >orientation
 492 ] camera> with-turtle .slate ;
 493
 494 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 495
 496 : abop-5 ( -- ) lparser-dialect   [ 5 >angle   5 >thickness ] >model-values
 497
 498 H{ { "a" "F[+(45)l][-(45)l]^;ca" }
 499
 500    { "l" "j" }
 501    { "j" "h" }
 502    { "h" "s" }
 503    { "s" "d" }
 504    { "d" "x" }
 505    { "x" "a" }
 506
 507    { "F" "'(1.17)F'(.855)" }
 508 } >rules
 509
 510 "&(90)+(90)a" >result ;
 511
 512 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 513
 514 : abop-6 ( -- ) lparser-dialect   [ 5 >angle   5 >thickness ] >model-values
 515
 516 "&(90)+(90)FFF[-(120)'(.6)x][-(60)'(.8)x][+(120)'(.6)x][+(60)'(.8)x]x" >result
 517
 518 H{ { "a" "F[cdx][cex]F!(.9)a" }
 519    { "x" "a" }
 520
 521    { "d" "+d" }
 522    { "e" "-e" }
 523
 524    { "F" "'(1.25)F'(.8)" }
 525 } >rules ;
 526
 527 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 528
 529 : airhorse ( -- ) lparser-dialect [ 10 >angle 5 >thickness ] >model-values
 530
 531 "C" >result
 532
 533 H{ { "C" "LBW" }
 534
 535    { "B" "[[''aH]|[g]]" }
 536    { "a" "Fs+;'a" }
 537    { "g" "Ft+;'g" }
 538    { "s" "[::cc!!!!&&[FFcccZ]^^^^FFcccZ]" }
 539    { "t" "[c!!!!&[FF]^^FF]" }
 540
 541    { "L" "O" }
 542    { "O" "P" }
 543    { "P" "Q" }
 544    { "Q" "R" }
 545    { "R" "U" }
 546    { "U" "X" }
 547    { "X" "Y" }
 548    { "Y" "V" }
 549    { "V" "[cc!!!&(90)[Zp]|[Zp]]" }
 550    { "p" "h>(120)h>(120)h" }
 551    { "h" "[+(40)!F'''p]" }
 552
 553    { "H" "[cccci[>(50)dcFFF][<(50)ecFFF]]" }
 554    { "d" "Z!&Z!&:'d" }
 555    { "e" "Z!^Z!^:'e" }
 556    { "i" "-:/i" }
 557
 558    { "W" "[%[!!cb][<<<!!cb][>>>!!cb]]" }
 559    { "b" "Fl!+Fl+;'b" }
 560    { "l" "[-cc{--z++z++z--|--z++z++z}]" }
 561 } >rules ;
 562
 563 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 564
 565 ! These should be moved into a separate file. They are used to pretty
 566 ! print matricies and vectors.
 567
 568 USING: styles prettyprint io ;
 569
 570 : decimal-places ( n d -- n )
 571 10 swap ^ tuck * >fixnum swap /f ;
 572
 573 ! : .mat ( matrix -- ) [ [ 2 decimal-places ] map ] map . ;
 574
 575 : .mat ( matrix -- )
 576 H{ { table-gap 4 } { table-border 4 } }
 577 [ 2 decimal-places pprint ]
 578 tabular-output ;
 579
 580 : .vec ( vector -- ) [ 2 decimal-places ] map . ;
 581
 582 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!