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