examples/nci/xlibtest.pir

   1 # Copyright (C) 2008, Parrot Foundation.
   2 # $Id$
   3
   4 =head1 TITLE
   5
   6 xlibtest.pir - Test NCI with libX11
   7
   8 =head1 SYNOPSIS
   9
  10 This is an initial version, be careful and not expect too much.
  11
  12 Compile Xlib.pir to Xlib.pbc before usage:
  13
  14 ../../parrot -o Xlib.pbc Xlib.pir [ filename ]
  15
  16 Press Escape key to exit.
  17
  18 Press S to save to filename
  19
  20 =cut
  21
  22 .include 'Xlibconstants.pir'
  23
  24 # Key for JSON line data
  25 .const string JKEY_LINES = 'lines'
  26
  27 .sub main :main
  28     .param pmc args
  29
  30     .local string filename
  31     filename = args [1]
  32     say filename
  33
  34     load_bytecode 'Xlib.pbc'
  35
  36 # Initialize and print some information
  37
  38     show_display_name()
  39
  40     .local pmc openDisplay
  41     openDisplay = get_global ['Xlib'], 'OpenDisplay'
  42
  43     .local pmc display
  44     display = openDisplay('')
  45
  46     display.'hello'()
  47
  48     print 'DefaultScreen: '
  49     $I0 = display.'DefaultScreen'()
  50     say $I0
  51
  52     print 'BlackPixel: '
  53     .local int black
  54     black = display.'BlackPixel'()
  55     say black
  56
  57     print 'WhitePixel: '
  58     .local int white
  59     white = display.'WhitePixel'(0)
  60     say white
  61
  62 # Create and map the window
  63
  64     .local pmc rw
  65     rw = display.'RootWindow'()
  66
  67     .local pmc w
  68     w = display.'CreateSimpleWindow'(rw, 0, 0, 600, 400, 0, 0, white)
  69     $I0 = KeyPressMask
  70     bor $I0, ButtonPressMask
  71     bor $I0, ButtonReleaseMask
  72     bor $I0, PointerMotionMask
  73     bor $I0, StructureNotifyMask
  74     bor $I0, ExposureMask
  75     w.'SelectInput'($I0)
  76     w.'StoreName'('Hello, parrot')
  77     w.'Map'()
  78
  79 # Get keycode of the Escape key to check in key press event
  80
  81     .local pmc KeysymToString
  82     KeysymToString = get_global ['Xlib'], 'KeysymToString'
  83     .local pmc StringToKeysym
  84     StringToKeysym = get_global ['Xlib'], 'StringToKeysym'
  85
  86 #    print 'Escape-'
  87     $I0 = StringToKeysym('Escape')
  88 #    print $I0
  89 #    print '-'
  90     .local int codeEscape
  91     codeEscape = display.'KeysymToKeycode'($I0)
  92 #    say codeEscape
  93
  94     $I0 = StringToKeysym('S')
  95 #    print $I0
  96 #    print '-'
  97     .local int codeS
  98     codeS = display.'KeysymToKeycode'($I0)
  99 #    say codeS
 100
 101     .local pmc listline
 102     listline = load(filename)
 103
 104 mainloop:
 105
 106     .local pmc line
 107
 108 # Event loop
 109
 110     .local pmc newEvent
 111     newEvent = get_global ['Xlib'], 'newEvent'
 112
 113     .local pmc event
 114     event = newEvent()
 115
 116     .local int pressed
 117     .local int px
 118     .local int py
 119     .local int lastpx
 120     .local int lastpy
 121     pressed = 0
 122     lastpx = 0
 123     lastpy = 0
 124 loop:
 125     $I0 = display.'NextEvent'(event)
 126
 127     $I1 = event.'type'()
 128
 129     eq $I1, KeyPress, keypress
 130     eq $I1, KeyRelease, loop
 131     eq $I1, ButtonPress, press
 132     eq $I1, ButtonRelease, release
 133     eq $I1, MotionNotify, paint
 134     eq $I1, Expose, expose
 135     eq $I1, ClientMessage, message
 136     eq $I1, DestroyNotify, finish
 137
 138     # Unhandled event type
 139     #say $I1
 140     goto loop
 141
 142 keypress:
 143     $I0 = event.'keycode'()
 144 #    say 'Keypress'
 145 #    say $I0
 146
 147 #    $I1 = display.KeycodeToKeysym($I0)
 148 #    say $I1
 149 #    $S0 = KeysymToString($I1)
 150 #    say $S0
 151 #    eq $S0, 'Escape', finish
 152
 153     if $I0 == codeEscape goto handleescape
 154     if $I0 == codeS goto handleS
 155     goto loop
 156 handleescape:
 157     w.'Unmap'()
 158     w.'Destroy'()
 159     goto loop
 160 handleS:
 161     say 'S'
 162     save(filename, listline)
 163     goto loop
 164
 165
 166 press:
 167     lastpx = event.'x'()
 168     lastpy = event.'y'()
 169     w.'DrawPoint'(lastpx, lastpy)
 170     line = new [ 'ResizableIntegerArray' ]
 171     push listline, line
 172     push line, lastpx
 173     push line, lastpy
 174     pressed = 1
 175     goto loop
 176 release:
 177     pressed = 0
 178     goto loop
 179
 180 paint:
 181     unless pressed goto loop
 182 #    print $I1
 183 #    print ': '
 184 #    $I0 = event.serial()
 185 #    print $I0
 186 #    print ' '
 187 #    $I0 = event.time()
 188 #    print $I0
 189 #    print ' '
 190     px = event.'x'()
 191 #    print px
 192 #    print ' '
 193     py = event.'y'()
 194 #    print py
 195 #    say ''
 196
 197     eq lastpx, px, checky
 198     goto draw
 199 checky:
 200     eq lastpy, py, loop
 201 draw:
 202     w.'DrawLine'(lastpx, lastpy, px, py)
 203     lastpx = px
 204     lastpy = py
 205     push line, px
 206     push line, py
 207
 208     goto loop
 209
 210 expose:
 211     #say 'Exposed'
 212
 213     $I0 = elements listline
 214     #say $I0
 215     unless $I0 goto loop
 216     $I1 = 0
 217 nextline:
 218     #print $I0
 219     #print ' - '
 220     #say $I1
 221
 222     eq $I1, $I0, loop
 223     $P0 = listline[$I1]
 224     inc $I1
 225     $I2 = elements $P0
 226     #say $I2
 227     unless $I2 goto nextline
 228
 229     $I3 = 0
 230     lastpx = $P0[$I3]
 231     inc $I3
 232     lastpy = $P0[$I3]
 233     inc $I3
 234     w.'DrawPoint'(lastpx, lastpy)
 235 nextpoint:
 236     eq $I3, $I2, nextline
 237     px = $P0[$I3]
 238     inc $I3
 239     py = $P0[$I3]
 240     inc $I3
 241     w.'DrawLine'(lastpx, lastpy, px, py)
 242     lastpx = px
 243     lastpy = py
 244     goto nextpoint
 245
 246     goto loop
 247
 248 message:
 249     w.'Unmap'()
 250     w.'Destroy'()
 251     goto loop
 252
 253 # End. Close window and display, and exit.
 254
 255 finish:
 256     say 'Exiting'
 257
 258     display.'Close'()
 259 .end
 260
 261 #-----------------------------------------------------------------------
 262 .sub show_display_name
 263     print 'DisplayName: "'
 264     .local pmc DisplayName
 265     DisplayName = get_global ['Xlib'], 'DisplayName'
 266     .local string dname
 267     dname = DisplayName()
 268     print dname
 269     say '"'
 270 .end
 271
 272 #-----------------------------------------------------------------------
 273 .sub load
 274     .param string filename
 275     .local pmc listline
 276     if null filename goto newfile
 277
 278     push_eh newfile
 279     .local pmc handle
 280     handle = open filename, 'r'
 281     pop_eh
 282
 283     push_eh failed
 284     .local string jsonfile
 285     jsonfile = handle.'readall'()
 286     close handle
 287
 288     load_bytecode 'compilers/json/JSON.pbc'
 289     .local pmc json
 290     json = compreg 'JSON'
 291     .local pmc jsonobject
 292     jsonobject = json(jsonfile)
 293     listline = jsonobject [JKEY_LINES]
 294     goto finish
 295
 296 failed:
 297     .local pmc exception
 298     .get_results(exception)
 299     pop_eh
 300     print "\nERROR LOADING FILE: "
 301     print exception
 302     print "\n\n"
 303
 304 newfile:
 305     listline = new [ 'ResizablePMCArray' ]
 306 finish:
 307     .return(listline)
 308 .end
 309
 310 #-----------------------------------------------------------------------
 311 .sub save
 312     .param string filename
 313     .param pmc listline
 314
 315     push_eh failed
 316     load_bytecode 'JSON.pbc'
 317
 318     .local pmc jsondata
 319     jsondata = new [ 'Hash' ]
 320     jsondata [JKEY_LINES] = listline
 321     .local string jsonfile
 322     jsonfile = _json(jsondata)
 323     .local pmc handle
 324     handle = open filename, 'w'
 325     print handle, jsonfile
 326     print handle, "\n"
 327     close handle
 328     .return()
 329 failed:
 330     .local pmc exception
 331     .get_results(exception)
 332     pop_eh
 333     print "\nERROR SAVING FILE: "
 334     print exception
 335     print "\n\n"
 336 .end
 337
 338 #-----------------------------------------------------------------------
 339 # Local Variables:
 340 #   mode: pir
 341 #   fill-column: 100
 342 # End:
 343 # vim: expandtab shiftwidth=4 ft=pir: