extra/processing/shapes/shapes.factor

   1 USING: alien.c-types alien.data arrays colors.constants grouping
   2 kernel locals math math.vectors namespaces opengl opengl.demo-support
   3 opengl.gl opengl.glu sequences sequences.generalizations shuffle ;
   4 IN: processing.shapes
   5
   6 SYMBOL: fill-color
   7 SYMBOL: stroke-color
   8
   9 COLOR: black stroke-color set-global
  10 COLOR: white fill-color set-global
  11
  12 : fill-mode ( -- )
  13     GL_FRONT_AND_BACK GL_FILL glPolygonMode
  14     fill-color get gl-color ;
  15
  16 : stroke-mode ( -- )
  17     GL_FRONT_AND_BACK GL_LINE glPolygonMode
  18     stroke-color get gl-color ;
  19
  20 : gl-vertex-2d ( vertex -- ) first2 glVertex2d ;
  21
  22 : gl-vertices-2d ( vertices -- ) [ gl-vertex-2d ] each ;
  23
  24 : draw-point* ( x y    -- ) stroke-mode GL_POINTS [ glVertex2d     ] do-state ;
  25 : draw-point  ( point  -- ) stroke-mode GL_POINTS [ gl-vertex-2d   ] do-state ;
  26 : draw-points ( points -- ) stroke-mode GL_POINTS [ gl-vertices-2d ] do-state ;
  27
  28 : draw-line** ( x y x y -- )
  29     stroke-mode GL_LINES [ glVertex2d glVertex2d ] do-state ;
  30
  31 : draw-line* ( a b -- ) stroke-mode GL_LINES [ [ gl-vertex-2d ] bi@ ] do-state ;
  32
  33 : draw-lines ( seq -- ) stroke-mode GL_LINES [ gl-vertices-2d ] do-state ;
  34
  35 : draw-line ( seq -- ) draw-lines ;
  36
  37 : line-strip ( seq -- ) stroke-mode GL_LINE_STRIP [ gl-vertices-2d ] do-state ;
  38
  39 : draw-triangles ( seq -- )
  40     [ fill-mode   GL_TRIANGLES [ gl-vertices-2d ] do-state ]
  41     [ stroke-mode GL_TRIANGLES [ gl-vertices-2d ] do-state ] bi ;
  42
  43 : draw-triangle ( seq -- ) draw-triangles ;
  44
  45 : draw-triangle* ( a b c -- ) 3array draw-triangles ;
  46
  47 : draw-triangle** ( x y x y x y -- ) 6 narray 2 group draw-triangles ;
  48
  49 : draw-polygon ( seq -- )
  50     [ fill-mode   GL_POLYGON [ gl-vertices-2d ] do-state ]
  51     [ stroke-mode GL_POLYGON [ gl-vertices-2d ] do-state ] bi ;
  52
  53 :: draw-rectangle ( loc dim -- )
  54     loc first2 :> ( x y )
  55     dim first2 :> ( dx dy )
  56
  57     x y 2array
  58     x dx + y 2array
  59     x dx + y dy + 2array
  60     x y dy + 2array
  61     4array
  62     draw-polygon ;
  63
  64 : draw-rectangle* ( x y width height -- ) [ 2array ] 2bi@ draw-rectangle ;
  65
  66 : gl-translate-2d ( pos -- ) first2 0 glTranslated ;
  67
  68 : gl-scale-2d ( xy -- ) first2 1 glScaled ;
  69
  70 : gl-ellipse ( center dim -- )
  71     glPushMatrix
  72     [ gl-translate-2d ] [ gl-scale-2d ] bi*
  73     gluNewQuadric
  74     dup 0 0.5 20 1 gluDisk
  75     gluDeleteQuadric
  76     glPopMatrix ;
  77
  78 : gl-get-line-width ( -- width )
  79     GL_LINE_WIDTH 0 double <ref> tuck glGetDoublev double deref ;
  80
  81 : draw-ellipse ( center dim -- )
  82     GL_FRONT_AND_BACK GL_FILL glPolygonMode
  83     [ stroke-color get gl-color                                 gl-ellipse ]
  84     [ fill-color get gl-color gl-get-line-width 2 * dup 2array v- gl-ellipse ] 2bi ;
  85
  86 : draw-circle ( center size -- ) dup 2array draw-ellipse ;