;;; -*- Mode:LISP; Package:ZWEI; Base:10 -*- ;; We need a separate package for these ;; demo functions: it's always dangerous ;; to put random stuff into a system package ;; like ZWEI: ;(defpackage Gateway-demo ; :nicknames '("GD") ; :prefix-name '("GD") ; :use '(zwei global) ; ) ;; yet another version of the classic DRF (defun DRF (&optional (number-of-circles 20) (window (cadr (send *display-pane-1* :inferiors)))) (let* ((w (send window :width)) (h (send window :height)) (a (fix (// (sqrt (* w h)) 4))) ;proportional to window area ) (loop for i from 0 to number-of-circles do (send window :draw-circle (random w) (random h) (random a)) ))) ;; a list of images loaded by this ;; demonstration function (defvar *gateway-images* ()) (defvar .drawing.) (defstruct (gi :conc-name) filename height width bit-array) ;; assumes that gateway is loaded and that *display-pane-1* ;; is bound unless you give explicitly specify a window (defun get-gi (filename &optional (window (cadr (send *display-pane-1* :inferiors)))) (let* ((pathname (parse-namestring filename)) (image (gi-already-loaded-p (namestring pathname))) ) (when (null image) (setq image (load-gi pathname))) (display-gi image window))) ;; images fasd'ed by PAINT always load as .drawing. (defun load-gi (pathname) (load pathname :verbose nil) (let ((image (make-gi :filename (namestring pathname) :height (pixel-array-height .drawing.) :width (pixel-array-width .drawing.) :bit-array .drawing.))) (push image *gateway-images*) image) ) (defun display-gi (image window) (send window :bitblt tv:alu-ior (gi-width image) (gi-height image) (gi-bit-array image) 0 0 0 0) ) (defun gi-already-loaded-p (filename) (loop for image in *gateway-images* if (string-equal filename (gi-filename image)) do (return image)))