unmaintained/lsys/tortoise/graphics/graphics.factor

   1
   2 USING: kernel math vectors sequences opengl.gl math.vectors math.order
   3        math.matrices vars opengl self pos ori turtle lsys.tortoise
   4
   5        lsys.strings.interpret combinators.short-circuit ;
   6
   7        ! lsys.strings
   8
   9 IN: lsys.tortoise.graphics
  10
  11 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  12
  13 ! (v0 - v1) x (v1 - v2)
  14
  15 : polygon-normal ( {_v0_v1_v2_} -- normal ) first3 dupd v- -rot v- swap cross ;
  16
  17 : (polygon) ( vertices -- )
  18 GL_POLYGON glBegin
  19 dup polygon-normal gl-normal [ gl-vertex ] each
  20 glEnd ;
  21
  22 : polygon ( vertices -- ) dup length 3 >= [ (polygon) ] [ drop ] if ;
  23
  24 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  25
  26 VAR: vertices
  27
  28 ! : init-vertices ( -- ) 0 <vector> >vertices ;
  29
  30 : start-polygon ( -- ) vertices> delete-all ;
  31
  32 : finish-polygon ( -- ) vertices> polygon ;
  33
  34 : polygon-vertex ( -- ) pos> vertices> push ;
  35
  36 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  37
  38 : record-vertex ( -- ) pos> gl-vertex ;
  39
  40 : draw-forward ( length -- )
  41 GL_LINES glBegin record-vertex step-turtle record-vertex glEnd ;
  42
  43 : move-forward ( length -- ) step-turtle polygon-vertex ;
  44
  45 : sneak-forward ( length -- ) step-turtle ;
  46
  47 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  48
  49 : scale-len ( m -- ) len> * >len ;
  50
  51 : scale-angle ( m -- ) angle> * >angle ;
  52
  53 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  54
  55 : set-thickness ( i -- ) dup >thickness glLineWidth ;
  56
  57 : scale-thickness ( m -- ) thickness> * 0.5 max set-thickness ;
  58
  59 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  60
  61 VAR: color-table
  62
  63 : init-color-table ( -- )
  64 { { 0    0    0 }    ! black
  65   { 0.5  0.5  0.5 }  ! grey
  66   { 1    0    0 }    ! red
  67   { 1    1    0 }    ! yellow
  68   { 0    1    0 }    ! green
  69   { 0.25 0.88 0.82 } ! turquoise
  70   { 0    0    1 }    ! blue
  71   { 0.63 0.13 0.94 } ! purple
  72   { 0.00 0.50 0.00 } ! dark green
  73   { 0.00 0.82 0.82 } ! dark turquoise
  74   { 0.00 0.00 0.50 } ! dark blue
  75   { 0.58 0.00 0.82 } ! dark purple
  76   { 0.50 0.00 0.00 } ! dark red
  77   { 0.25 0.25 0.25 } ! dark grey
  78   { 0.75 0.75 0.75 } ! medium grey
  79   { 1    1    1 }    ! white
  80 } [ 1 suffix ] map >color-table ;
  81
  82 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  83
  84 : material-color ( color -- )
  85 GL_FRONT_AND_BACK GL_AMBIENT_AND_DIFFUSE rot gl-material ;
  86
  87 : set-color ( i -- )
  88 dup >color color-table> nth dup gl-color material-color ;
  89
  90 : inc-color ( -- ) color> 1+ set-color ;
  91
  92 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  93
  94 VAR: tortoise-stack
  95
  96 ! : init-tortoise-stack ( -- ) V{ } clone >tortoise-stack ;
  97
  98 ! : save-tortoise ( -- ) self> tortoise-stack> push ;
  99
 100 ! : save-tortoise ( -- ) self> tortoise-stack> push   self> clone >self ;
 101
 102 : save-tortoise ( -- ) self> clone tortoise-stack> push ;
 103
 104 : restore-tortoise ( -- )
 105 tortoise-stack> pop >self
 106 color> set-color
 107 thickness> set-thickness ;
 108
 109 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 110
 111 VAR: default-values
 112 VAR: model-values
 113
 114 : lparser-dialect ( -- )
 115
 116 [ 1 >len   45 >angle   1 >thickness   2 >color ] >default-values
 117
 118 H{ { "+" [ angle>     turn-left ] }
 119    { "-" [ angle>     turn-right ] }
 120    { "&" [ angle>     pitch-down ] }
 121    { "^" [ angle>     pitch-up ] }
 122    { "<" [ angle>     roll-left ] }
 123    { ">" [ angle>     roll-right ] }
 124
 125    { "|" [ 180.0         rotate-y ] }
 126    { "%" [ 180.0         rotate-z ] }
 127    { "$" [ roll-until-horizontal ]  }
 128
 129    { "F" [ len>     draw-forward ] }
 130    { "Z" [ len> 2 / draw-forward ] }
 131    { "f" [ len>     move-forward ] }
 132    { "z" [ len> 2 / move-forward ] }
 133    { "g" [ len>     sneak-forward ] }
 134    { "." [ polygon-vertex ] }
 135
 136    { "[" [ save-tortoise ] }
 137    { "]" [ restore-tortoise ] }
 138    { "{" [ start-polygon ] }
 139    { "}" [ finish-polygon ] }
 140
 141    { "/" [ 1.1 scale-len ] } ! double quote command in lparser
 142    { "'" [ 0.9 scale-len ] }
 143    { ";" [ 1.1 scale-angle ] }
 144    { ":" [ 0.9 scale-angle ] }
 145    { "?" [ 1.4 scale-thickness ] }
 146    { "!" [ 0.7 scale-thickness ] }
 147
 148    { "c" [ color> 1 + color-table> length mod set-color ] }
 149
 150 } >command-table ;
 151
 152 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 153