src/ui/SDL/port.slate

   1 ports ensureNamespace: #SDL.
   2
   3 CObject parseDefinitionsFrom:
   4 q{('SDLPortEvent'
   5       (Structure
   6          ('type' UnsignedChar)
   7          ('param1' LongInt)
   8          ('param2' LongInt)))
   9 } into: SDL.
  10
  11 SDL define: #Lib &builder:
  12   [ExternalInterface newForLibrary: 'sdl-ui' primitives: q{
  13     (LongInt 'Restart' (UnsignedLongInt UnsignedLongInt UnsignedLongInt UnsignedLongInt UnsignedLongInt))
  14     (Void 'Destroy' ())
  15     (UnsignedLongInt 'PollEvent' (#[SDL _SDLPortEvent pointer]))
  16     (UnsignedLongInt 'WaitEvent' (#[SDL _SDLPortEvent pointer]))
  17
  18     (Void 'Clip' (UnsignedLongInt UnsignedLongInt UnsignedLongInt UnsignedLongInt))
  19     (Void 'Update' (UnsignedLongInt UnsignedLongInt UnsignedLongInt UnsignedLongInt))
  20     (Void 'Flip' ())
  21     (Void 'DrawPoint' (UnsignedLongInt UnsignedLongInt UnsignedChar UnsignedChar UnsignedChar))
  22     (Void 'DrawRectangle' (UnsignedLongInt UnsignedLongInt UnsignedLongInt UnsignedLongInt UnsignedChar UnsignedChar UnsignedChar))
  23     (Void 'DrawFilledRectangle' (UnsignedLongInt UnsignedLongInt UnsignedLongInt UnsignedLongInt UnsignedChar UnsignedChar UnsignedChar))
  24     (Void 'DrawLine' (UnsignedLongInt UnsignedLongInt UnsignedLongInt UnsignedLongInt UnsignedChar UnsignedChar UnsignedChar))
  25     (Void 'DrawCircle' (UnsignedLongInt UnsignedLongInt UnsignedLongInt UnsignedChar UnsignedChar UnsignedChar))
  26     (Void 'DrawFilledCircle' (UnsignedLongInt UnsignedLongInt UnsignedLongInt UnsignedChar UnsignedChar UnsignedChar))
  27     (Void 'DrawEllipse' (UnsignedLongInt UnsignedLongInt UnsignedLongInt UnsignedLongInt UnsignedChar UnsignedChar UnsignedChar))
  28     (Void 'DrawFilledEllipse' (UnsignedLongInt UnsignedLongInt UnsignedLongInt UnsignedLongInt UnsignedChar UnsignedChar UnsignedChar))
  29     (Void 'DrawFilledTriangle' (UnsignedLongInt UnsignedLongInt UnsignedLongInt UnsignedLongInt UnsignedLongInt UnsignedLongInt UnsignedChar UnsignedChar UnsignedChar))
  30 } &leader: 'SDLPort'].
  31
  32 SDL define: #Port
  33   &parents: {Port. ReadStream}
  34   &slots: {#width -> 640. #height -> 480. #bpp -> 0.
  35            #fullScreen -> False. #doubleBuffer -> False}.
  36
  37 _@(SDL Port traits) serverType
  38 ['SDL'].
  39
  40 p@(SDL Port traits) restart
  41 [
  42   SDL Lib enable.
  43   SDL Lib primitives Restart applyTo:
  44     {p width.
  45       p height.
  46       p bpp.
  47       p fullScreen ifTrue: [1] ifFalse: [0].
  48       p doubleBuffer ifTrue: [1] ifFalse: [0]}.
  49   p
  50 ].
  51
  52 _@(SDL Port traits) destroy
  53 [
  54   SDL Lib primitives Destroy do
  55 ].
  56
  57 _@(SDL Port traits) flush
  58 [
  59   SDL Lib primitives Flip do
  60 ].
  61
  62 _@(SDL Port traits) isAtEnd
  63 [False].
  64
  65 p@(SDL Port traits) next
  66 [| data event |
  67   data: SDL SDLPortEvent clone.
  68   [(SDL Lib primitives WaitEvent applyWith: data) isZero
  69     ifTrue: [error: 'Could not read event from SDL Port'].
  70     data _type caseOf:
  71       {0 -> [Quit signal].
  72        1 -> [p width: data _param1.
  73              p height: data _param2.
  74              p restart.
  75              ^ (WindowConfigEvent clone `>> [region: (Rectangle origin: Point origin corner: (Point x: p width y: p height)). ])].
  76        2 -> [^ (WindowRepaintEvent clone `>> [region: (Rectangle origin: Point origin corner: (Point x: p width y: p height)). ])].
  77        3 -> [^ (KeyboardPressEvent clone `>> [key: data _param1. ])].
  78        4 -> [^ (KeyboardReleaseEvent clone `>> [key: data _param1. ])].
  79        5 -> [^ (MouseMotionEvent clone `>> [position: (Point x: data _param1 y: data _param2). ])].
  80        6 -> [^ (MouseButtonPressEvent clone `>> [button: data _param1. ])].
  81        7 -> [^ (MouseButtonReleaseEvent clone `>> [button: data _param1. ])].
  82        8 -> [^ MouseEnterEvent clone].
  83        9 -> [^ MouseLeaveEvent clone].
  84       }] loop
  85 ].
  86
  87 Portlist include: SDL Port.
  88
  89 SDL define: #Medium &parents: {Medium}.
  90
  91 SDL Medium traits define: #colorScale -> 255.99.
  92
  93 m@(SDL Medium traits) rgbArrayFor: c@(Color traits)
  94 [
  95   {(c red * m colorScale `cache) floor.
  96    (c green * m colorScale) floor.
  97    (c blue * m colorScale) floor}
  98 ].
  99
 100 m@(SDL Medium traits) foregroundRGBArray
 101 [m rgbArrayFor: m foreground].
 102
 103 obj drawOn: m@(SDL Medium traits)
 104 [warn: 'Unhandled shape: ' ; obj printString].
 105
 106 p@(Point traits) drawOn: m@(SDL Medium traits)
 107 [
 108   SDL Lib primitives DrawPoint applyTo:
 109     {p x. p y} ; m foregroundRGBArray
 110 ].
 111
 112 r@(Rectangle traits) drawOn: m@(SDL Medium traits)
 113 [
 114   SDL Lib primitives DrawFilledRectangle applyTo:
 115     {r origin x. r origin y. r corner x. r corner y} ; m foregroundRGBArray
 116 ].
 117
 118 l@(LineSegment traits) drawOn: m@(SDL Medium traits)
 119 [
 120   SDL Lib primitives DrawLine applyTo:
 121     {l start x. l start y. l end x. l end y} ; m foregroundRGBArray
 122 ].
 123
 124 p@(Path traits) drawOn: m@(SDL Medium traits)
 125 [| start |
 126   start: p points first.
 127   p points allButFirstDo:
 128     [| :end |
 129       SDL Lib primitives DrawLine applyTo:
 130         {start x. start y. end x. end y} ; m foregroundRGBArray.
 131       start: end]
 132 ].
 133
 134 e@(Ellipse traits) drawOn: m@(SDL Medium traits)
 135 [
 136   e isCircle
 137     ifTrue:
 138       [SDL Lib primitives DrawFilledCircle applyTo:
 139         {e center x. e center y. e xRadius. e yRadius}
 140          ; m foregroundRGBArray]
 141     ifFalse:
 142       [SDL Lib primitives DrawFilledEllipse applyTo:
 143         {e center x. e center y. e xRadius. e yRadius}
 144          ; m foregroundRGBArray]
 145 ].
 146
 147 p@(Polygon traits) drawOn: m@(SDL Medium traits)
 148 "Draw a filled Polygon one spanning triangle at a time."
 149 [| firstPoint prevPoint |
 150   m foregroundRGBArray `cache.
 151   firstPoint: p points first.
 152   prevPoint: p points second.
 153   p points from: 2 below: p points indexLast do:
 154     [| :nextPoint |
 155       SDL Lib primitives DrawFilledTriangle applyTo:
 156         {firstPoint x. firstPoint y. prevPoint x. prevPoint y. nextPoint x. nextPoint y}
 157        ; m foregroundRGBArray.
 158      prevPoint: nextPoint]
 159 ].