#lang racket

 

(require ffi/unsafe)

 

(define (string->c-string encoding text)

  (let ([conv (bytes-open-converter "UTF-8" encoding)])

    (let-values ([(bstr len result) 

                  (bytes-convert conv (string->bytes/utf-8 text))])

      (bytes-close-converter conv)

      bstr)))

 

(define _HWND (_or-null _pointer))

(define _LPCTSTR _string/eof)

(define _LPCWSTR _string/utf-16)

(define _UINT _uint32)

 

;; int WINAPI MessageBoxA (HWND hWnd, 

;;                         LPCTSTR lpText, 

;;                         LPCTSTR lpCaption, 

;;                         UINT uType);

(define-c MessageBoxA "User32.dll" 

  (_fun (hWnd lpText lpCaption uType) 

        :: (hWnd : _HWND) (lpText : _LPCTSTR) 

           (lpCaption : _LPCTSTR) (uType : _UINT)

        -> _int))

 

(MessageBoxA #f (string->c-string "cp1251" "Текст") 

             (string->c-string "cp1251" "Заголовок") 0)

 

(define-c MessageBoxW "User32.dll" 

  (_fun (hWnd lpText lpCaption uType) 

        :: (hWnd : _HWND) (lpText : _LPCWSTR) 

           (lpCaption : _LPCWSTR) (uType : _UINT)

        -> _int))

 

(MessageBoxW #f "Текст 2" "Заголовок 2" 0)

 

;BOOL Rectangle(

;  __in  HDC hdc,

;  __in  int nLeftRect,

;  __in  int nTopRect,

;  __in  int nRightRect,

;  __in  int nBottomRect

;);

 

 

(define-c Rectangle "Gdi32.dll" 

 

  (_fun (hdc nLeftRect nTopRect nRightRect nBottomRect) 

 

        :: (hdc : _HDC) (nLeftRect : _int) 

 

           (nTopRect : _int) (nRightRect : _int)

 

           (nBottomRect : _int)

 

        -> _bool))

 

#lang racket

 

(require graphics/graphics)

 

(open-graphics)

 

(define vp (open-viewport "Demo" 200 100))

 

((draw-rectangle vp)                    

 (make-posn 20.0 20.0) 160 60 "Red")

 

((draw-string vp) 

 (make-posn 70.0 55.0) "Привет!" "Blue")

 

(sleep 1)

 

((clear-solid-rectangle vp) 

 (make-posn 21.0 21.0) 158 58)

 

((draw-string vp) 

 (make-posn 80.0 55.0) "Пока!" "Blue")

 

(sleep 3)

 

(close-viewport vp)

 

(close-graphics)