scsh-conservatory
/
sunterlib
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

initial scx-0.2 support for X11 drawing

This commit is contained in:
Johan Ceuppens 2012-01-16 21:58:35 +00:00
parent 286428aae3
commit 31b994d43d
2 changed files with 23 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
scsh/scgame/scgame.scm
View File

@ -1,4 +1,4 @@
;;; scgame.scm - a scheme game library (needs a scheme48 with X11 support) ;;; scgame.scm - a scheme game library (needs a scx-0.2)
;;; ;;;
;;; Copyright (c) 2011-2012 Johan Ceuppens ;;; Copyright (c) 2011-2012 Johan Ceuppens
;;; ;;;
@ -29,6 +29,12 @@
(load "scgameutil.scm") (load "scgameutil.scm")
(load "scgamedictionaries.scm") (load "scgamedictionaries.scm")
;; NOTE: You need to load a display and window e.g.
;; (define dpy (open-display))
;; (define root (default-root-window dpy))
;; (define width 640) (define height 480)
;; (define win (create-simple-window dpy root 0 0 width height 1 black white))
;; interface 1 ;; interface 1
(define (make-scdraw1) (lambda (msg) (aspecterror)(display "make-scdraw1"))) (define (make-scdraw1) (lambda (msg) (aspecterror)(display "make-scdraw1")))
(define (make-scimage1) (lambda (msg) (aspecterror)(display "make-scimage1"))) (define (make-scimage1) (lambda (msg) (aspecterror)(display "make-scimage1")))
@ -36,6 +42,19 @@
;; interface 2 ;; interface 2
(define (coolness? x) (not (null? x))) ;; coolness (define (coolness? x) (not (null? x))) ;; coolness
;; override for scx-0.2
(define (putpixel x y colorname)
(let ((gc (create-gc dpy win
(make-gc-value-alist (background (string->color 'White)
(foreground (string->Color colorname)))))))
(draw-point dpy win gc (inexact->exact x) (inexact->exact y))))
(define (putpixel x y foregroundcolorname backgroundcolorname)
(let ((gc (create-gc dpy win
(make-gc-value-alist (background (string->color backgroundcolorname)
(foreground (string->Color foregroundcolorname)))))))
(draw-point dpy win gc (inexact->exact x) (inexact->exact y))))
(define (make-scdraw2) (define (make-scdraw2)
(define (draw-line x0 y0 x1 y1 . w) ;; FIXME w == line width (define (draw-line x0 y0 x1 y1 . w) ;; FIXME w == line width
(let ((width (if (coolness? w)(if (number? (car w)) (car w) 1)))) (let ((width (if (coolness? w)(if (number? (car w)) (car w) 1))))
@ -71,8 +90,8 @@
(+ ystep 1) (+ ystep 1)
(- ystep 1) (- ystep 1)
(for-each (if steep (for-each (if steep
(putpixel y x 254) (putpixel y x 'Black)
(putpixel x y 254)) (putpixel x y ))
(set! error (- error deltay)) (set! error (- error deltay))
(if (< error 0) (if (< error 0)

2
scsh/scgame/scgamewidgets.scm
View File

@ -1,4 +1,4 @@
;;; scgame.scm - a scheme game library (needs a scheme48 with X11 support) ;;; scgamewidgets.scm - a scheme game library (needs scx-0.2)
;;; ;;;
;;; Copyright (c) 2011-2012 Johan Ceuppens ;;; Copyright (c) 2011-2012 Johan Ceuppens
;;; ;;;