modules/x11/low/x11gc.st

   1 Package [
   2   X11
   3 ]
   4
   5
   6 X11ResourceObject subclass: X11Color [
   7   | color |
   8
   9   ^new [
  10     ^self error: 'X11Color can''t be created with #new'.
  11   ]
  12
  13   ^new: r g: g b: b [
  14     | obj |
  15     obj := super new.
  16     self in: obj at: 1 put: (X11Singleton XNewColor: r g: g b: b).
  17     ^obj
  18   ]
  19
  20   ^black [
  21     ^self new: 0 g: 0 b: 0.
  22   ]
  23
  24   ^white [
  25     ^self new: 1.0 g: 1.0 b: 1.0.
  26   ]
  27
  28   free [
  29     color ifNotNil: [
  30       "'free color: ' print. color printNl."
  31       X11Singleton XFreeColor: color. color := nil
  32     ]
  33   ]
  34
  35   color [
  36     ^color
  37   ]
  38 ]
  39
  40
  41 X11ResourceObject subclass: X11GC [
  42   | gc fgcolor bgcolor linestyle capstyle joinstyle width |
  43
  44   ^new [
  45     ^self error: 'X11GC can''t be created with #new'.
  46   ]
  47
  48   ^new: wid [
  49     | obj |
  50     obj := super new.
  51     self;
  52       in: obj at: 1 put: (X11Singleton XCreateGC: wid);
  53       in: obj at: 2 put: X11Color white;
  54       in: obj at: 3 put: X11Color black;
  55       in: obj at: 4 put: 0;
  56       in: obj at: 5 put: 1;
  57       in: obj at: 6 put: 0;
  58       in: obj at: 7 put: 0.
  59     obj realizeLineStyle.
  60     ^obj
  61   ]
  62
  63   ^new: wid fgColor: aClr [
  64     | obj |
  65     obj := super new.
  66     self;
  67       in: obj at: 1 put: (X11Singleton XCreateGC: wid fgColor: aClr color);
  68       in: obj at: 2 put: aClr;
  69       in: obj at: 3 put: X11Color black.
  70     ^obj
  71   ]
  72
  73   free [
  74     gc ifNotNil: [ X11Singleton XFreeGC: gc. gc := nil ]
  75   ]
  76
  77   gc [
  78     ^gc
  79   ]
  80
  81   fgColor: aClr [
  82     fgcolor := aClr.
  83     X11Singleton fgColor: gc color: aClr color.
  84   ]
  85
  86   bgColor: aClr [
  87     bgcolor := aClr.
  88     X11Singleton bgColor: gc color: aClr color.
  89   ]
  90
  91   realizeLineStyle [
  92     X11Singleton XSetLineAttr: gc
  93       width: width
  94       line: linestyle
  95       cap: capstyle
  96       join: joinstyle
  97   ]
  98
  99   width [
 100     ^width
 101   ]
 102   width: aValue [
 103     width := aValue.
 104     ^self realizeLineStyle
 105   ]
 106
 107   lineStyle [
 108     ^linestyle
 109   ]
 110   lineStyle: aValue [
 111     linestyle := aValue.
 112     ^self realizeLineStyle
 113   ]
 114   lineSolid [
 115     ^0
 116   ]
 117   lineDoubleDash [
 118     ^1
 119   ]
 120   lineOnOffDash [
 121     ^2
 122   ]
 123 ]