#:use-module (gacela gl)
#:use-module (gacela ftgl)
#:use-module (gacela math)
+ #:use-module (gacela utils)
#:use-module (ice-9 optargs)
#:use-module (ice-9 receive)
#:export (init-video
3d-mode?
get-frames-per-second
set-frames-per-second!
+ get-fullscreen
+ set-fullscreen!
init-frame-time
get-frame-time
delay-frame
progn-textures
draw
load-texture
+ load-texture-without-cache
get-texture-properties
draw-texture
draw-line
set-camera
camera-look
load-font
+ load-font-without-texture
render-text)
+ #:re-export (glPushMatrix
+ glPopMatrix)
#:export-syntax (glmatrix-block))
(define screen #f)
(define flags 0)
-(define* (init-video width height bpp #:key (mode '2d) (title "") (fps 20))
+(define* (init-video width height bpp #:key (mode '2d) (title "") (fps 20) (fullscreen 'off))
(SDL_Init SDL_INIT_VIDEO)
(let ((info (SDL_GetVideoInfo)))
(SDL_GL_SetAttribute SDL_GL_DOUBLEBUFFER 1)
(set! flags (+ SDL_OPENGL SDL_GL_DOUBLEBUFFER SDL_HWPALETTE SDL_RESIZABLE
(if (= (assoc-ref info 'hw_available) 0) SDL_SWSURFACE SDL_HWSURFACE)
- (if (= (assoc-ref info 'blit_hw) 0) 0 SDL_HWACCEL)))
+ (if (= (assoc-ref info 'blit_hw) 0) 0 SDL_HWACCEL)
+ (if (eq? fullscreen 'on) SDL_FULLSCREEN 0)))
(set! screen (SDL_SetVideoMode width height bpp flags))
(set-screen-title! title)
(set-frames-per-second! fps)
+ (set-fullscreen! fullscreen #f)
(init-gl)
(if (eq? mode '3d) (set-3d-mode) (set-2d-mode))))
(define (set-screen-bpp! bpp)
(cond (screen
- (set! screen (SDL_SetVideoMode (get-screen-width) (get-screen-height) bpp flags)))))
+ (set! screen (SDL_SetVideoMode (get-screen-width) (get-screen-height) (get-screen-bpp) flags)))))
(define (resize-screen width height)
(cond (screen
(eq? mode '3d))
+(define fullscreen 'off)
+
+(define* (set-fullscreen! fs #:optional (toggle #t))
+ (cond ((or (and (eq? fullscreen 'on) (eq? fs 'off))
+ (and (eq? fullscreen 'off) (eq? fs 'on)))
+ (set! fullscreen fs)
+ (cond (toggle
+ (SDL_WM_ToggleFullScreen screen))))))
+
+(define (get-fullscreen)
+ fullscreen)
+
+
(define (init-gl)
(glShadeModel GL_SMOOTH)
(glClearColor 0 0 0 0)
(else (let ((zoomx (/ (+ width 0.5) old-width)) (zoomy (/ (+ height 0.5) old-height)))
(zoomSurface surface zoomx zoomy 0))))))
-(define* (load-texture filename #:key (min-filter GL_LINEAR) (mag-filter GL_LINEAR))
+(define* (load-texture-without-cache filename #:key (min-filter GL_LINEAR) (mag-filter GL_LINEAR))
(progn-textures
(receive
(image real-w real-h) (load-image-for-texture filename)
(set-texture-size! texture real-w real-h)
texture))))))
+(define load-texture (use-cache-with load-texture-without-cache))
+
(define (get-texture-properties texture)
`((width . ,(texture-w texture)) (height . ,(texture-h texture))))
;;; Text and fonts
-(define* (load-font font-file #:key (size 40) (encoding ft_encoding_unicode))
+(define* (load-font-without-cache font-file #:key (size 40) (encoding ft_encoding_unicode))
(let ((font (ftglCreateTextureFont font-file size)))
(ftglSetFontFaceSize font size 72)
(ftglSetFontCharMap font encoding)
font))
+(define load-font (use-cache-with load-font-without-cache))
+
(define* (render-text text font #:key (size #f))
(cond (size
(cond ((not (= (ftglGetFontFaceSize font) size))