Autore Topic: Semplice calcolatrice utilizzando le risorse del API di X11  (Letto 397 volte)

Offline vuott

  • Moderatore globale
  • Senatore Gambero
  • *****
  • Post: 11.307
  • Ne mors quidem nos iunget
    • Mostra profilo
Il seguente codice è un semplice esempio di uso delle risorse esterne del API di X11 mediante Extern, ed esempio di traduzione dal C in Gambas.
Funziona solo con sistemi a 64-bit.


Codice: [Seleziona]
'******************************************************************************************************************************************
' Il presente codice è la traduzione in Gambas, effettuata dal membro del foro gambas-it.org "vuott", con variazioni ed integrazioni,
' del codice originale, scritto in linguaggio C, del progetto di Kjetil Erga, chiamato "Xlib Calculator".
'
'
' Copyright (c) 2008 Kjetil Erga
'
' Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation
' files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use,
' copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom
' the Software is Furnished to do so, subject to the following conditions:
' The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.
' THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
' OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
' BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
' OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
'******************************************************************************************************************************************



Private Const BLOCCHI_X As Integer = 4
Private Const BLOCCHI_Y As Integer = 6
Private Const SPAZIO As Integer = 5
Private valore_mostrato As Float
Private valore_buffer As Float
Private operazione As Byte
Private modo_decimale As Integer
Private disp_mod As Integer
Private simboli As String[][] = [["C", "/", "*", "-"], ["7", "8", "9", "+"], ["4", "5", "6", " "], ["1", "2", "3", " "], ["0", " ", ".", "="]]


Library "libX11:6.3.0"

Private Const ExposureMask As Long = 32768
Private Const KeyPressMask As Long = 1
Private Const ButtonPressMask As Long = 4
Private Const ClientMessage As Integer = 33

Private Enum KeyPress = 2, KeyRelease, ButtonPress, ButtonRelease, MotionNotify, EnterNotify, LeaveNotify,
             FocusIn, FocusOut, KeymapNotify, Expose, GraphicsExpose, NoExpose

' Display *XOpenDisplay(char *display_name)
' Opens a connection to the X server that controls a display.
Private Extern XOpenDisplay(display As Pointer) As Pointer

' int XDefaultScreen(Display *display)
' Return the default screen number referenced by the XOpenDisplay() function.
Private Extern XDefaultScreen(display As Pointer) As Integer
 
' Window XRootWindow(Display *display, int screen_number)
' Return the root window for the default screen.
Private Extern XRootWindow(display As Pointer, screen_number As Integer) As Integer

' Window XCreateSimpleWindow(Display *display, Window parent, int x, int y, unsigned int width, unsigned int height, unsigned int border_width, unsigned long border, unsigned long background)
' creates an unmapped InputOutput subwindow for a specified parent window, returns the window ID of the created window.
Private Extern XCreateSimpleWindow(display As Pointer, parent As Long, x As Integer, y As Integer, width As Integer, height As Integer, border_width As Integer, border As Integer, background As Long) As Integer

' XSelectInput (Display *display, Window w, long event_mask)
' requests that the X server report the events associated with the specified Event mask.
Private Extern XSelectInput(display As Pointer, w As Long, event_mask As Long)

' XMapRaised (Display *display, Window w)
' raises the specified window to the top of the stack.
Private Extern XMapRaised(display As Pointer, w As Long)

' Atom XInternAtom(Display *display, char *atom_name, Bool only_if_exists)
' Returns the atom identifier associated with the specified atom_name string.
Private Extern XInternAtom(display As Pointer, atom_name As String, only_if_exists As Boolean) As Long

' Status XSetWMProtocols(Display *display, Window w, Atom *protocols, int count)
' Replaces the WM_PROTOCOLS property on the specified window with the list of atoms specified by the protocols argument.
Private Extern XSetWMProtocols(display As Pointer, w As Long, protocols As Pointer, count As Integer) As Integer

' XNextEvent (Display *display, XEvent *event_return)
' gets the next event and remove it from the queue
Private Extern XNextEvent(display As Pointer, event_return As Pointer)

' KeySym XkbKeycodeToKeysym (Display *dpy, KeyCode kc, unsigned int group, unsigned int level)
' Returns the keysym bound to a particular group and shift level for a particular key on the core keyboard.
Private Extern XkbKeycodeToKeysym(dpy As Pointer, kc As Integer, group As Integer, level As Integer) As Long

' Status XSendEvent(Display *display, Window w, Bool propagate, long event_mask, XEvent *event_send)
' Identifies the destination window, determines which clients should receive the specified events.
Private Extern XSendEvent(display As Pointer, w As Long, propagate As Boolean, event_mask As Long, event_send As Pointer) As Integer

' Status XGetWindowAttributes(Display *display, Window w, XWindowAttributes *window_attributes_return)
' Returns the current attributes for the specified window to an XWindowAttributes structure.
Private Extern XGetWindowAttributes(display As Pointer, w As Long, window_attributes As Pointer) As Integer

' GC XDefaultGC(Display *display, int screen_number)
' Returns the default graphics context for the root window of the specified screen.
Private Extern XDefaultGC(display As Pointer, screen_number As Integer) As Pointer

' int XClearArea(Display *display, Window w, int x, int y, unsigned int width, unsigned int height, Bool exposures)
' Paints a rectangular area in the specified window.
Private Extern XClearArea(display As Pointer, w As Long, x As Integer, y As Integer, width As Integer, height As Integer, exposures As Boolean) As Integer

' int XDrawRectangle(Display *display, Drawable d, GC gc, int x, int y, unsigned int width, unsigned int height)
' Draw the outlines of the specified rectangle.
Private Extern XDrawRectangle(display As Pointer, d As Long, gc As Pointer, x As Integer, y As Integer, width As Integer, height As Integer) As Integer

' int XDrawString(Display *display, Drawable d, GC gc, int x, int y, char *string, int length)
' Treats each character image as an additional mask for a fill operation on the drawable.
Private Extern XDrawString(display As Pointer, d As Long, gc As Pointer, x As Integer, y As Integer, stringc As String, length As Integer) As Integer

' XDestroyWindow(Display *display, Window w)
' destroys the specified window as well as all of its subwindows
Private Extern XDestroyWindow(display As Pointer, w As Long)

' XCloseDisplay(Display *display)
' Closes the connection to the X server for the display specified in the Display structure and destroys all windows.
Private Extern XCloseDisplay(display As Pointer)
 

Public Sub Main()

 Dim disp, ev As Pointer
 Dim scr As Integer
 Dim id, atom, ks As Long
 Dim st As Stream

' Apre la connessione con il server display del sistema grafico X:
  disp = XOpenDisplay(0)
  If disp = 0 Then Error.Raise("Impossibile aprire il server X !")
 
  scr = XDefaultScreen(disp)
   
' Crea la finestra secondo i parametri previsti dalla funzione. L'ultimo parametro imposta il colore di fondo della finestra:
  id = XCreateSimpleWindow(disp, XRootWindow(disp, scr), 0, 0, 200, 300, 0, 0, &FFEFDF)
  Print "ID della finestra creata: "; Hex(id, 6)

' Dice al server display quali eventi deve vedere:
  XSelectInput(disp, id, ExposureMask Or KeyPressMask Or ButtonPressMask)
 
' Apre la finestra sullo schermo. Si può utilizzare anche la funzione "XMapWindow(display, w)":
  XMapRaised(disp, id)
 
  atom = XInternAtom(disp, "WM_DELETE_WINDOW", False)
 
  XSetWMProtocols(disp, id, VarPtr(atom), 1)
 
' Alloca un'area di memoria pari alla Struttura esterna 'XEvent' (192 byte):
  ev = Alloc(192)

' Inizia il ciclo, restando in attesa di un evento stabilito con la precedente funzione XSelectInput():
  While True

    XNextEvent(disp, ev)

    Select Case Int@(ev)
' Se viene premuta la X nell'angolo alto a destra, chiude la finestra:
      Case ClientMessage
        If Short@(ev + 56) = atom Then Break
      Case Expose
        DisegnaCalc(disp, id, scr)
      Case KeyPress
        ks = XkbKeycodeToKeysym(disp, Int@(ev + 84), 0, 0)
' Se viene premuto il tasto "q" della tastiera, la finestra viene chiusa:
        If CByte(ks) = 113 Then
          Break
        Else
          Calcolo(ks)
' Ridisegna la finestra:
          st = Memory ev For Write
          Write #st, Expose As Integer
          st.Close
          XSendEvent(disp, id, False, 0, ev)
        Endif
      Case ButtonPress
        Pressione_Tasti(disp, id, Int@(ev + 64), Int@(ev + 68))
        st = Memory ev For Write
        Write #st, Expose As Integer
        st.Close
        XSendEvent(disp, id, False, 0, ev)
    End Select

  Wend


' Chiude la finestra e libera la memoria:
  Free(ev)
  XDestroyWindow(disp, id)
  XCloseDisplay(disp)

End


Private Procedure DisegnaCalc(dis As Pointer, idW As Long, sc As Integer)
 
  Dim i, j, buf_len As Integer
  Dim buf As String
  Dim attributes, gc As Pointer
 
   
' Alloca un'area di memoria pari alla Struttura esterna 'XWindowAttributes' (192 byte):
    attributes = Alloc(136)
 
    If XGetWindowAttributes(dis, idW, attributes) = 0 Then Return
    gc = XDefaultGC(dis, sc)
    XClearArea(dis, idW, SPAZIO, SPAZIO, Int@(attributes + 8) - (SPAZIO * 2), (Int@(attributes + 12) - ((BLOCCHI_Y - 1 + 2) * SPAZIO)) / BLOCCHI_Y, False)
    XDrawRectangle(dis, idW, gc, SPAZIO, SPAZIO, Int@(attributes + 8) - (SPAZIO * 2), (Int@(attributes + 12) - ((BLOCCHI_Y - 1 + 2) * SPAZIO)) / BLOCCHI_Y)

    buf = Format(valore_mostrato, "0.000000")
    buf_len = Len(buf)
    XDrawString(dis, idW, gc, 30, 30, buf, buf_len)
   
    For i = 0 To BLOCCHI_X - 1
      For j = 1 To BLOCCHI_Y - 1
        XDrawRectangle(dis, idW, gc, (((Int@(attributes + 8) - (BLOCCHI_X - 1)) / BLOCCHI_X) * i) + SPAZIO,
          (((Int@(attributes + 12) - (BLOCCHI_Y - 1)) / BLOCCHI_Y) * j) + SPAZIO,
          (Int@(attributes + 8) - ((BLOCCHI_X - 1 + 2) * SPAZIO)) / BLOCCHI_X, (Int@(attributes + 12) - ((BLOCCHI_Y - 1 + 2) * SPAZIO)) / BLOCCHI_Y)   
        XDrawString(dis, idW, gc, (((Int@(attributes + 8) / BLOCCHI_X) * (i + 1))) - Int@(attributes + 8) / BLOCCHI_X / 2,
          ((Int@(attributes + 12) / BLOCCHI_Y) * (j + 1)) - Int@(attributes + 12) / BLOCCHI_Y / 2, simboli[j - 1][i], 1)
      Next

    Next

    Free(attributes)

End


Private Procedure Calcolo(lo As Long)

  Select Case CInt(lo)
    Case 8, Asc("C"), Asc("c")
      valore_mostrato = 0.0
      valore_buffer = 0.0
      modo_decimale = 0
      operazione = 0
      disp_mod = 0
    Case 48 To 57
      If disp_mod Then
        valore_mostrato = 0.0
        disp_mod = 0
      Endif
      If modo_decimale Then
        If modo_decimale <= 6 Then
          valore_mostrato += ((lo - &30) / CFloat(Decimali(10, modo_decimale)))
          Inc modo_decimale
        Endif
      Else
        valore_mostrato *= 10
        valore_mostrato += (lo - &30)
      Endif
    Case 44, 46
      If modo_decimale = 0 Then modo_decimale = 1
    Case 42, 43, 45, 47
      If operazione <> 0 Then
        Select Case operazione
          Case 42
            valore_mostrato = valore_buffer * valore_mostrato
          Case 43
            valore_mostrato = valore_buffer + valore_mostrato
          Case 45
            valore_mostrato = valore_buffer - valore_mostrato
          Case 47
            valore_mostrato = valore_buffer / valore_mostrato
        End Select
      Endif
      valore_buffer = valore_mostrato
      operazione = lo
      disp_mod = 1
      modo_decimale = 0
    Case &0D, 61
      If operazione <> 0 Then
        Select Case operazione
          Case 42
           valore_mostrato = valore_buffer * valore_mostrato
          Case 43
            valore_mostrato = valore_buffer + valore_mostrato
          Case 45
            valore_mostrato = valore_buffer - valore_mostrato
          Case 47
            valore_mostrato = valore_buffer / valore_mostrato
        End Select
      Endif
      operazione = 0
      disp_mod = 1
      modo_decimale = 0
  End Select
 
End


Private Function Decimali(i As Integer, n As Integer) As Integer

    Return i ^ n
 
End


Private Procedure Pressione_Tasti(di As Pointer, wi As Long, x As Integer, y As Integer)

  Dim i, j, x1, x2, y1, y2 As Integer
  Dim attributes As Pointer

    attributes = Alloc(136)

    If XGetWindowAttributes(di, wi, attributes) = 0 Then Return

    For i = 0 To BLOCCHI_X - 1
      For j = 1 To BLOCCHI_Y - 1
        x1 = (((Int@(attributes + 8) - (BLOCCHI_X - 1)) / BLOCCHI_X) * i) + SPAZIO
        y1 = (((Int@(attributes + 12) - (BLOCCHI_Y - 1)) / BLOCCHI_Y) * j) + SPAZIO
        x2 = x1 + (Int@(attributes + 8) - ((BLOCCHI_X - 1 + 2) * SPAZIO)) / BLOCCHI_X
        y2 = y1 + (Int@(attributes + 12) - ((BLOCCHI_Y - 1 + 2) * SPAZIO)) / BLOCCHI_Y
        If (x > x1) And (x < x2) And (y > y1) And (y < y2) Then Calcolo(CLong(Asc(simboli[j - 1][i])))
      Next
    Next
 
    Free(attributes)
 
End
« Ultima modifica: 10 Maggio 2016, 23:48:22 da vuott »
« Chiunque, non ricorrendo lo stato di necessità, nel proprio progetto Gambas fa uso delle istruzioni Shell o Exec, è punito con la sanzione pecuniaria da euro 20,00 a euro 60,00. »