On Tue, 2019-01-29 at 16:09 +0100, Christian Kellermann wrote:
> * Matt Welland <m...@kiatoa.com> [190129 05:44]:
> > With this I was able to get a sample page up. Thanks!
> >
> > If Christian Kellermann, owner of cairo, sees this and would like
> > to
> > add an sdl2 demo to the cairo egg please let me know.
>
> It seems like I am the owner now :)
Hmmm... did I misread the docs? Ah, I see I found your name by an
example and didn't look further. Well, thanks for helping :)
Attached is my hacked up example for cairo on sdl2. I hope it is of
use.
> Sure, why not, send it this way!
>
> Thank you Matt!
>
> Kind regards,
>
> Christian
>
; A test program for the Cairo bindings
; Michael Bridgen <mi...@squaremobius.net>
; Tony Garnock-Jones <to...@kcbbs.gen.nz>
(use posix)
(use (prefix sdl2 sdl2:)
miscmacros)
(use cairo)
(import chicken scheme foreign)
;; From: ko...@upyum.com
;;
(define (sdl-colorspace->cairo bytes-per-pixel)
(case (* 8 bytes-per-pixel)
((8) CAIRO_FORMAT_A8)
((24) CAIRO_FORMAT_RGB24)
((32) CAIRO_FORMAT_ARGB32)
(else CAIRO_FORMAT_ARGB32)))
(define (create-sdl2-cairo-context window)
(let*-values
(((width height) (sdl2:window-size window))
((window-surface) (sdl2:window-surface window))
((cairo-surface)
(cairo-image-surface-create-for-data
(sdl2:surface-pixels-raw window-surface)
(sdl-colorspace->cairo
(sdl2:pixel-format-bytes-per-pixel (sdl2:surface-format window-surface)))
width
height
(sdl2:surface-pitch window-surface))))
(cairo-create cairo-surface)))
;;; Draw (or redraw) the entire scene. It would be more efficient to
;;; only redraw the parts of the scene that have changed, but since
;;; this is just a demo program we don't want to get too complex.
(define (draw-scene!)
(let ((window-surf (sdl2:window-surface window)))
;; Clear the whole screen using a blue background color
(sdl2:fill-rect! window-surf #f (sdl2:make-color 0 80 160))
;; Draw the smileys
;; (draw-obj! smiley2 window-surf)
;; (draw-obj! smiley1 window-surf)
;; Refresh the screen
(sdl2:update-window-surface! window)))
#;(sdl-init SDL_INIT_EVERYTHING)
(define maxx 640)
(define maxy 480)
;;; Initialize the parts of SDL that we need.
(sdl2:set-main-ready!)
(sdl2:init! '(video events joystick))
;; Automatically call sdl2:quit! when program exits normally.
(on-exit sdl2:quit!)
;; Call sdl2:quit! and then call the original exception handler if an
;; unhandled exception reaches the top level.
(current-exception-handler
(let ((original-handler (current-exception-handler)))
(lambda (exception)
(sdl2:quit!)
(original-handler exception))))
(printf "Compiled with SDL version ~A~N" (sdl2:compiled-version))
(printf "Running with SDL version ~A~N" (sdl2:current-version))
(printf "Using sdl2 egg version ~A~N" (sdl2:egg-version))
;;; Create a new window.
(define window
(sdl2:create-window!
"SDL Basics" ; title
'centered 100 ; x, y
800 600 ; w, h
'(shown resizable))) ; flags
;;; Restrict the window from being made too small or too big, for no
;;; reason except to demonstrate this feature.
(set! (sdl2:window-maximum-size window) '(1024 768))
(set! (sdl2:window-minimum-size window) '(200 200))
(printf "Window position: ~A, size: ~A, max size: ~A, min size: ~A~N"
(receive (sdl2:window-position window))
(receive (sdl2:window-size window))
(receive (sdl2:window-maximum-size window))
(receive (sdl2:window-minimum-size window)))
(define c (create-sdl2-cairo-context window)) ;; (cairo-create is))
(cairo-set-source-rgba c 1 1 0 1)
(cairo-set-line-width c 20)
(cairo-new-path c)
(cairo-set-line-cap c CAIRO_LINE_CAP_BUTT)
(cairo-move-to c 10 10)
(cairo-line-to c 10 80)
(cairo-stroke c)
(cairo-new-path c)
(cairo-set-line-cap c CAIRO_LINE_CAP_ROUND)
(cairo-move-to c 50 10)
(cairo-line-to c 50 80)
(cairo-stroke c)
(cairo-new-path c)
(cairo-set-line-cap c CAIRO_LINE_CAP_SQUARE)
(cairo-move-to c 90 10)
(cairo-line-to c 90 80)
(cairo-stroke c)
(cairo-set-line-join c CAIRO_LINE_JOIN_BEVEL)
(define (tri)
(cairo-new-path c)
(cairo-move-to c 110 110)
(cairo-line-to c 110 190)
(cairo-line-to c 190 190)
(cairo-close-path c))
(cairo-set-line-width c 10)
(tri)
(cairo-set-source-rgb c 0 1 1)
(cairo-stroke c)
(tri)
(cairo-set-source-rgb c 1 0 1)
(cairo-fill c)
(define (radians degrees)
(* 3.142 (/ degrees 180)))
(define (sector x y d)
(cairo-new-path c)
(cairo-move-to c x y)
(cairo-line-to c (+ x d) y)
(cairo-line-to c (+ x d) (+ y d))
(cairo-arc c (+ x d) y d (radians 90) (radians 180)))
(sector 240 240 60)
(cairo-set-line-join c CAIRO_LINE_JOIN_MITER)
(cairo-set-source-rgb c 1 0.5 0)
(cairo-stroke c)
(cairo-reset-clip c)
(cairo-new-path c)
(cairo-rectangle c 30 240 70 300)
(cairo-clip c)
(cairo-new-path c)
(sector 20 250 100)
(cairo-set-source-rgb c 0 0.5 1)
(cairo-fill c)
(cairo-reset-clip c)
(sector 20 250 100)
(cairo-set-source-rgba c 0 0.5 1 0.3)
(cairo-fill c)
(cairo-select-font-face c "sans-serif" CAIRO_FONT_SLANT_NORMAL CAIRO_FONT_WEIGHT_NORMAL)
(cairo-set-font-size c 30)
(cairo-move-to c 300 100)
(cairo-set-source-rgba c 1 1 1 1)
(cairo-show-text c "Chicken Cairo")
(let ((ext (make-cairo-text-extents-type)))
(cairo-text-extents c "Chicken Cairo" ext)
; (display ext)(newline)
(cairo-new-path c)
(cairo-rectangle c 300 100 (cairo-text-extents-width ext) (- (cairo-text-extents-height ext)))
(cairo-set-source-rgba c 1 1 1 0.5)
(cairo-set-line-width c 2.0)
(cairo-stroke c))
;; (sdl2:flip-surface window #t #t)
(sdl2:update-window-surface! window)
#;(let ((done #f)
(verbose? #f))
(while (not done)
(let ((ev (sdl2:wait-event!)))
(when verbose?
(print ev))
(case (sdl2:event-type ev)
;; Window exposed, resized, etc.
((window)
(draw-scene!))
;; User requested app quit (e.g. clicked the close button).
((quit)
(set! done #t))
;; Joystick added (plugged in)
((joy-device-added)
;; Open the joystick so we start receiving events for it.
(sdl2:joystick-open! (sdl2:joy-device-event-which ev)))
;; Mouse button pressed
((mouse-button-down)
;; Move smiley1 to the mouse position.
(set! (obj-x smiley1) (sdl2:mouse-button-event-x ev))
(set! (obj-y smiley1) (sdl2:mouse-button-event-y ev))
(draw-scene!))
;; Mouse cursor moved
((mouse-motion)
;; If any button is being held, move smiley1 to the cursor.
;; This way it seems like you are dragging it around.
(when (not (null? (sdl2:mouse-motion-event-state ev)))
(set! (obj-x smiley1) (sdl2:mouse-motion-event-x ev))
(set! (obj-y smiley1) (sdl2:mouse-motion-event-y ev))
(draw-scene!)))
;; Keyboard key pressed.
((key-down)
(case (sdl2:keyboard-event-sym ev)
;; Escape or Q quits the program
((escape q)
(set! done #t))
;; V toggles verbose printing of events
((v)
(if verbose?
(begin
(print "Verbose OFF (events will not be printed)")
(set! verbose? #f))
(begin
(print "Verbose ON (events will be printed)")
(set! verbose? #t))))
;; Space bar randomizes smiley colors
((space)
(randomize-smiley! smiley1)
(randomize-smiley! smiley2)
(draw-scene!))
;; Arrow keys control smiley2
((left)
(dec! (obj-x smiley2) 20)
(draw-scene!))
((right)
(inc! (obj-x smiley2) 20)
(draw-scene!))
((up)
(dec! (obj-y smiley2) 20)
(draw-scene!))
((down)
(inc! (obj-y smiley2) 20)
(draw-scene!))))))))
(let ((event (sdl2:make-event)))
(let loop ((count 0))
(sdl2:wait-event! event)
(print "Got here!")
(let ((t (sdl2:event-type event)))
(print "Got here! Event=" t)
(if (or (sdl2:quit-event? t)
(> count 100))
(print "Got 100 events, I'm bored. Quiting.")
(loop (+ count 1))))))
(exit 0)
_______________________________________________
Chicken-users mailing list
Chicken-users@nongnu.org
https://lists.nongnu.org/mailman/listinfo/chicken-users
