extra/processing/shapes/shapes.factor

   1
   2 USING: kernel namespaces arrays sequences grouping
   3        alien.c-types
   4        math math.vectors math.geometry.rect
   5        opengl.gl opengl.glu opengl generalizations vars
   6        combinators.cleave colors ;
   7
   8 IN: processing.shapes
   9
  10 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  11
  12 : do-state ( mode quot -- ) swap glBegin call glEnd ; inline
  13
  14 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  15
  16 VAR: fill-color
  17 VAR: stroke-color
  18
  19 T{ rgba f 0 0 0 1 } stroke-color set-global
  20 T{ rgba f 1 1 1 1 } fill-color   set-global
  21
  22 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  23
  24 : fill-mode ( -- )
  25   GL_FRONT_AND_BACK GL_FILL glPolygonMode
  26   fill-color> gl-color ;
  27
  28 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  29
  30 : stroke-mode ( -- )
  31   GL_FRONT_AND_BACK GL_LINE glPolygonMode
  32   stroke-color> gl-color ;
  33
  34 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  35
  36 : gl-vertex-2d ( vertex -- ) first2 glVertex2d ;
  37
  38 : gl-vertices-2d ( vertices -- ) [ gl-vertex-2d ] each ;
  39
  40 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  41
  42 : point* ( x y    -- ) stroke-mode GL_POINTS [ glVertex2d     ] do-state ;
  43 : point  ( point  -- ) stroke-mode GL_POINTS [ gl-vertex-2d   ] do-state ;
  44 : points ( points -- ) stroke-mode GL_POINTS [ gl-vertices-2d ] do-state ;
  45
  46 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  47
  48 : line** ( x y x y -- )
  49   stroke-mode GL_LINES [ glVertex2d glVertex2d ] do-state ;
  50
  51 : line* ( a b -- ) stroke-mode GL_LINES [ [ gl-vertex-2d ] bi@ ] do-state ;
  52
  53 : lines ( seq -- ) stroke-mode GL_LINES [ gl-vertices-2d ] do-state ;
  54
  55 : line ( seq -- ) lines ;
  56
  57 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  58
  59 : line-strip ( seq -- ) stroke-mode GL_LINE_STRIP [ gl-vertices-2d ] do-state ;
  60
  61 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  62
  63 : triangles ( seq -- )
  64   [ fill-mode   GL_TRIANGLES [ gl-vertices-2d ] do-state ]
  65   [ stroke-mode GL_TRIANGLES [ gl-vertices-2d ] do-state ] bi ;
  66
  67 : triangle ( seq -- ) triangles ;
  68
  69 : triangle* ( a b c -- ) 3array triangles ;
  70
  71 : triangle** ( x y x y x y -- ) 6 narray 2 group triangles ;
  72
  73 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  74
  75 : polygon ( seq -- )
  76   [ fill-mode   GL_POLYGON [ gl-vertices-2d ] do-state ]
  77   [ stroke-mode GL_POLYGON [ gl-vertices-2d ] do-state ] bi ;
  78
  79 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  80
  81 : rectangle ( loc dim -- )
  82   <rect>
  83     { top-left top-right bottom-right bottom-left }
  84   1arr
  85   polygon ;
  86
  87 : rectangle* ( x y width height -- ) [ 2array ] 2bi@ rectangle ;
  88
  89 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  90
  91 : gl-translate-2d ( pos -- ) first2 0 glTranslated ;
  92
  93 : gl-scale-2d ( xy -- ) first2 1 glScaled ;
  94
  95 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  96
  97 : gl-ellipse ( center dim -- )
  98   glPushMatrix
  99     [ gl-translate-2d ] [ gl-scale-2d ] bi*
 100     gluNewQuadric
 101       dup 0 0.5 20 1 gluDisk
 102     gluDeleteQuadric
 103   glPopMatrix ;
 104
 105 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 106
 107 : gl-get-line-width ( -- width )
 108   GL_LINE_WIDTH 0 <double> tuck glGetDoublev *double ;
 109
 110 : ellipse ( center dim -- )
 111   GL_FRONT_AND_BACK GL_FILL glPolygonMode
 112   [ stroke-color> gl-color                                 gl-ellipse ]
 113   [ fill-color> gl-color gl-get-line-width 2 * dup 2array v- gl-ellipse ] 2bi ;
 114
 115 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 116
 117 : circle ( center size -- ) dup 2array ellipse ;
 118
 119 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 120