home *** CD-ROM | disk | FTP | other *** search
/ Amiga GigaPD 3 / Amiga_GigaPD_v3_3of3.iso / netbsd / docs / mailinglist-archive / 1993-11 / text0206.txt < prev    next >
Encoding:
Text File  |  1993-06-25  |  6.4 KB  |  239 lines

  1. #!/usr/bin/perl
  2.  
  3. ######################################################################################
  4. #  X-Server connection example by BRAND Olivier                         #
  5. #  Create a window, handle 2 events: Mouse and Expose                     #
  6. #  Notice: You have to be in xhost + to run this program, because the authorisation  #
  7. #  is NOT supported yet                                     #
  8. ######################################################################################
  9.  
  10. ######################################################################################
  11.  
  12. #Set the port and get the display name (Without the :0.0 part)
  13.  
  14. $port = 6000;
  15. $host = $ENV{'DISPLAY'}; 
  16. ($display) = split(/:/,$host,2);
  17. print "HOST = $display \n";
  18.  
  19. $AF_INET = 2;
  20. $SOCK_STREAM = 1;
  21.  
  22. ######################################################################################
  23.  
  24. #X-Protocol structures
  25.  
  26. $xConnClientPrefix = 'C c S S S S S';
  27. $xConnSetUpPrefix = 'C c S S S';
  28. $xConnSetup = 'L L L L S S C C C C C C C C L';
  29. $xDepth = 'C C S L';
  30. $xWindowRoot = 'L L L L L S S S S S S L C C C C';
  31. $xVisualType = 'L C C S L L L L';
  32. $xCreateWindowReq = 'C C S L L s s S S S S L L';
  33. $xResourceReq = 'C c S L';
  34. $xGenericReply = 'c c S L L L L L L L';
  35. $xPolySegmentReq = 'C c S L L';
  36. $xCreateGCReq = 'C c S L L L';
  37. $xGCFunc = 'L5';
  38. $xPoints = 'S4';
  39. $xButtonPress = 'C C S L L L L S S S S S C C';
  40. $xExpose = 'C C S L S S S S S S7';
  41. $xKeyPress = 'C C S L L L L S S S S S C C';
  42.  
  43. $vendor = 'a64';
  44. $xmasque = 'L';
  45. $xback = 'i';
  46.  
  47.  
  48. ######################################################################################
  49.  
  50.  
  51. $SIG{'INT'} = 'dokill';
  52. sub dokill {
  53.     kill 9,$child if $child;
  54. }
  55.  
  56. ######################################################################################
  57.  
  58. #Create the connection to the X-Server
  59.  
  60. #Structure of the sockaddr struct
  61. $sockaddr = 'S n a4 x8';
  62.  
  63. ($name,$aliases,$proto) = getprotobyname('tcp');
  64. ($name,$aliases,$port) = getservbyname($port,'tcp')
  65.     unless $port =~ /^\d+$/;;
  66. ($name,$aliases,$type,$len,$servaddr) =
  67.     gethostbyname($display);
  68.  
  69. $serv = pack($sockaddr, $AF_INET, $port, $servaddr);
  70.  
  71. # Make the socket filehandle.
  72.  
  73. if (socket(S, $AF_INET, $SOCK_STREAM, $proto)) { 
  74.     print "socket ok\n";
  75. }
  76. else {
  77.     die $!;
  78. }
  79.  
  80. if(connect(S,$serv)) {
  81.     print "connect ok\n";
  82. }
  83. else {
  84.     die $!;
  85. }
  86.  
  87. ######################################################################################
  88.  
  89. #Prepare the X connection
  90.  
  91. $conn = pack($xConnClientPrefix,0x42,0,11,0,0,0,0);
  92. $len = syswrite(S,$conn,12);
  93. print "WRITE LEN = $len\n";
  94. $len = sysread(S,$data,8);
  95. print "READ LEN = $len\n";
  96. @res = unpack($xConnSetUpPrefix,$data);
  97. printf "%d %d %d %d %d\n",@res;
  98. if($res[0] == 0) {
  99.     sysread(S,$xerror,$res[1]);
  100.     print "Connection error: $error\n";
  101.     die $!;        
  102. }
  103. $len = sysread(S,$data,32);
  104. print "READ LEN = $len\n";
  105. @connsetup = unpack($xConnSetup,$data);
  106. printf "%d %d %d %d %d %d %d %d %d %d %d %d %d %d %d\n",@connsetup;
  107. #Read the X-Vendor
  108. $len = sysread(S,$data,$connsetup[4]);
  109. @xvendor = unpack($vendor,$data);
  110. print "rid base = $connsetup[1]\n";
  111. printf "Vendor = %s\n",@xvendor;
  112.  
  113. print "READ $connsetup[7] type of DEPTH\n";
  114. for($i=0;$i<$connsetup[7];$i++) {
  115.     $len = sysread(S,$data,8);
  116.     print"type of DEPTH\n";
  117. }
  118. print "READ $connsetup[6] type of ROOTS\n";
  119. for($i=0;$i<$connsetup[6];$i++) {
  120.     $len = sysread(S,$data,40);
  121.     print "LEN FIRST FOR $len\n";
  122.     @xroot = unpack($xWindowRoot,$data);
  123.     print "READ $xroot[15] DEPTH of ROOT $i\n";
  124.     for($j=0;$j<$xroot[15];$j++) {
  125.         print "READ NUMBER $j\n";
  126.         $len = sysread(S,$data,8);
  127.         print "READ LEN = $len\n";
  128.         @xdepth = unpack($xDepth,$data);    
  129.         print "DEPTH of ROOT $i = $xdepth[0], READ $xdepth[2] VISUALS\n";    
  130.         for($k=0;$k<$xdepth[2];$k++) {
  131.             $len = sysread(S,$visualtype,24);
  132.             @visu = unpack($xVisualType,$visualtype);
  133.             print "class $visu[1]\n";
  134.         }
  135.     }
  136. }
  137.  
  138. @xvisual = unpack($xVisualType,$visualtype);
  139. $ridbase = $connsetup[1];
  140. $ridcpt = $ridbase;
  141. $ridcpt++;
  142.  
  143. ######################################################################################
  144.  
  145. #Create our first window
  146.  
  147. $masque = 0x800 | 0x02;
  148. $window = pack($xCreateWindowReq,1,$xroot[14],10,$ridbase,$xroot[0],100,100,300,300,3,1,0,$masque);
  149. $len = syswrite(S,$window,32);
  150.  
  151. #Background color for the window
  152.  
  153. $back=pack($xback,3);
  154. $len = syswrite(S,$back,4);
  155.  
  156. #Set ExposureMask ButtonPressMask KeyPressMask for desired events
  157. $mask = 1 << 15 | 1 << 2 | 1 << 0;
  158.  
  159. $masque = pack($xmasque,$mask);
  160. $len = syswrite(S,$masque,4);
  161.  
  162. #Map the window on screen
  163.  
  164. $mapreq = pack($xResourceReq,8,0,2,$ridbase);
  165. $len = syswrite(S,$mapreq,8);
  166.  
  167. #####################################################################################
  168.  
  169. #Create a graphic context
  170.  
  171. #Set the GC Mask: GCFunction|GCLineStyle|GCFillStyle|GCForeground|GCBackground
  172. $gcmasque = 1<<0 | 1<<5 | 1<<8 | 1<<2 | 1<<3;
  173. $maingc = pack($xCreateGCReq,55,0,9,$ridcpt,$xroot[0],$gcmasque);
  174. $len = syswrite(S,$maingc,16);
  175.  
  176. #Assign an index for our gc, andincrement ridcpt for
  177. #the next object (window, gc, ...) (simple things are sometime the better ones)
  178.  
  179. $maingc = $ridcpt;
  180. $ridcpt++;
  181.  
  182. #Set: GXcopy LineSolid FillSolid Foreground Background for our GC
  183.  
  184. $gcfunc = pack($xGCFunc,0x3,0,0,0,1);
  185. $len = syswrite(S,$gcfunc,20);
  186.  
  187. #####################################################################################
  188.  
  189. #X-Event Loop (here it is !!!)
  190.  
  191. while (1) {
  192.     #Wait for a server reply
  193.  
  194.     $len = sysread(S,$xreply,32);
  195.     @reply = unpack($xGenericReply,$xreply);    
  196.  
  197.     #Is the reply an error (0) or a normal reply (1) ?
  198.  
  199.     if($reply[0]==0) {
  200.         print "X Error: $reply[1]\n";
  201.     } else {
  202.         print "Event: $reply[0]\n";
  203.         if($reply[0] == 2) {
  204.             print "KeyPress\n";
  205.  
  206.             #Decode a KeyPress structurep
  207.             @keypress = unpack($xKeyPress,$xreply);    
  208.             $keycode = $keypress[1];
  209.             print "keycode = $keycode\n";
  210.         }
  211.         if($reply[0] == 4) {
  212.             print "ButtonPress\n";
  213.             
  214.             #Decode a ButtonPress structure
  215.             @buttonpress = unpack($xButtonPress,$xreply);    
  216.             #Write the coordinates where the user has clicked on the window
  217.             print "X=$buttonpress[9] Y=$buttonpress[10]\n";
  218.         }
  219.         if($reply[0] == 12) {
  220.             print "Expose\n";
  221.             
  222.             #Decode a xExpose structure
  223.             @expose = unpack($xExpose,$xreply);    
  224.             print "Refresh region: width=$expose[6] height=$expose[7] at coordinates: X=$expose[4] Y=$expose[5]\n";
  225.             #Draw a square at the coordinates: 10,50 and height,width: 100,100
  226.             #create a X_PolyFillRectangle structure: type = 70 and send it to the X-Server
  227.             $rect = pack($xPolySegmentReq,70,0,5,$ridbase,$maingc);
  228.             $len = syswrite(S,$rect,12);
  229.             #Send the points
  230.             $poly = pack($xPoints,10,50,100,100);
  231.             $len = syswrite(S,$poly,8);
  232.  
  233.         }
  234.     }
  235. }
  236.  
  237.  
  238.  
  239.