modules/x11/x11singleton.st

   1 Package [
   2   X11
   3 ]
   4
   5 class: X11Singleton  | widgetlist quitflag disp | [
   6   ^wid2str: wid [
   7     <#X11Do 200 wid>.
   8     self primitiveFailed
   9   ]
  10
  11   ^sameWids: w0 and: w1 [
  12     <#X11Do 201 w0 w1>.
  13     self primitiveFailed
  14   ]
  15
  16   ^subtypeName: aX11 [
  17     <#X11Do 0 aX11>.
  18     ^nil
  19   ]
  20
  21   ^initialize [
  22     disp := X11Singleton XOpenDisplay: nil.
  23     X11Singleton defaultDispay: disp.
  24   ]
  25
  26
  27   ^XOpenDisplay: aName [
  28     <#X11Do 1>.
  29     self primitiveFailed
  30   ]
  31
  32   ^XCloseDisplay: dpy [
  33     <#X11Do 2 dpy>.
  34     self primitiveFailed
  35   ]
  36
  37   ^blackPixel [
  38     <#X11Do 3 false>.
  39     self primitiveFailed
  40   ]
  41
  42   ^whitePixel [
  43     <#X11Do 3 true>.
  44     self primitiveFailed
  45   ]
  46
  47   ^XSelectInput: aWindow interestFlag: aFlag [
  48     <#X11Do 4 aWindow aFlag>.
  49     self primitiveFailed
  50   ]
  51
  52   ^defaultDispay [
  53     <#X11Do 5>.
  54     self primitiveFailed
  55   ]
  56
  57   ^defaultDispay: dpy [
  58     <#X11Do 5 dpy>.
  59     self primitiveFailed
  60   ]
  61
  62   ^XCreateSimpleWindow: parentWid x: x y: y width: wdt height: hgt bgcolor: clr [
  63     <#X11Do 7 parentWid x y wdt hgt clr>.
  64     self primitiveFailed
  65   ]
  66
  67   ^getEvent [
  68     <#X11Do 6>.
  69     ^nil
  70   ]
  71
  72   ^mapWindow: wid [
  73     <#X11Do 8 wid>.
  74     self primitiveFailed
  75   ]
  76
  77   ^unmapWindow: wid [
  78     <#X11Do 9 wid>.
  79     self primitiveFailed
  80   ]
  81
  82   ^XCreateGC: parent fgcolor: aColor [
  83     <#X11Do 10 parent aColor>.
  84     self primitiveFailed
  85   ]
  86
  87   ^color: r g: g b: b [
  88     <#X11Do 11 r g b>.
  89     self primitiveFailed
  90   ]
  91
  92   ^fgColor: gc color: clr [
  93     <#X11Do 12 true gc clr>.
  94     self primitiveFailed
  95   ]
  96
  97   ^bgColor: gc color: clr [
  98     <#X11Do 12 false gc clr>.
  99     self primitiveFailed
 100   ]
 101
 102   ^XDrawLine: wid gc: gc x0: x0 y0: y0 x1: x1 y1: y1 [
 103     <#X11Do 13 wid gc x0 y0 x1 y1>.
 104     self primitiveFailed
 105   ]
 106
 107
 108   ^add: aWC [
 109     widgetlist ifNil: [ widgetlist := List new ].
 110     widgetlist << aWC.
 111   ]
 112
 113   ^remove: aWC [
 114     widgetlist ifNotNil: [ widgetlist remove: aWC ifAbsent: [ nil ]]
 115   ]
 116
 117   ^setQuitFlag [
 118     quitflag := true.
 119   ]
 120
 121   ^passEvent: wid event: evt [
 122     widgetlist ifNotNil: [ widgetlist do: [:w | (w passEvent: wid event: evt) ifTrue: [ ^true ]]].
 123     ^false
 124   ]
 125
 126   ^eventLoop [
 127     | evt |
 128     [ true ] whileTrue: [
 129       System eventWaitFor: 1200.
 130       (evt := self getEvent) ifNotNil: [
 131         "evt printNl."
 132         self passEvent: (evt at: 2) event: evt.
 133       ].
 134     ]
 135   ]
 136 ]