Date: Thu, 13 Feb 92 22:22:12 JST
From: <@uunet.UU.NET:kddlab!shpcsl.sharp.co.jp!ueda> (UEDA masaya)
Return-Path: <ueda@shpcsl.sharp.co.jp>
To: lindahl%cse.uta.edu@kddlab.kddlabs.co.jp
In-Reply-To: Charlie Lindahl's message of Wed, 12 Feb 92 12:21:38 -0600 <9202121821.AA16173@cse.uta.edu>
Subject: movie-window

Dear Charile:

   Date: Wed, 12 Feb 92 12:21:38 -0600
   From: lindahl@cse.uta.edu (Charlie Lindahl)

   Please post your QT MCL code at cambridge.apple.com. 

Sorry. I have not FTP pass to cambrige.apple.com.

May I ask you to post this code?

Thanks.


- read.me ---------------------------------------------------------------------

(1) If no MOVIE is handed to the MAKE-INSTANCE method of MOVIE-WINDOW
class, it opens a #_StandardGetFilePeview dialog and ask you to select
a movie file. The first movie resource in the file is played. In this
case the MOVIE is disposed (handed to #_DisposeMovie) when the window
is closed.

(setq mvwnd (make-instance 'movie-window))

If you handed a MOVIE which you want to play to the MAKE-INSTANCE
method of MOVIE-WINDOW class, that MOVIE is not disposed when the
window is closed. Once you are finished working with the MOVIE, you
should dispose your MOVIE to release the memory used by the MOVIE.

(setq mvwnd (make-instance 'movie-window :movie your-movie))

(2) You should install QuickTime and QuickTime 1.0 interfaces. Don't
forget to eval (reindex-interfaces) after you install interfaces.

  From: bill@cambridge.apple.com
  Date: Fri, 20 Dec 1991 00:45:11 -0500
  To: info-mcl@cambridge.apple.com
  Subject: QuickTime interfaces uploaded

  I have uploaded a translation (from Pascal to MCL) of the QuickTime 1.0
  interfaces into the file "/pub/MCL2/QuickTime.sea.hqx" on the
  anonymous FTP server at cambridge.apple.com and into the "MCL Discussion"
  bulletin board on AppleLink.

  -----
  Bill St. Clair
  bill@cambridge.apple.com

(3) A MOVIE-WINDOW starts to play when you double-click in the window
and stops to play when you click in the window or the window is
deactivated or #_IsMovieDone returns not nil. You can play from the
beginning when a MOVIE-WINDOW stops at the end by double-clicking.

(4) I used ccl::gestalt to determine whether the movie toolbox is
installed or not, but this function is not documented in MCL2.0
Reference.

  From: bill@cambridge.apple.com
  Return-Path: <bill@cambridge.apple.com>
  Date: Fri, 24 Jan 1992 10:39:11 -0500
  To: kddlab!shpcsl.sharp.co.jp!ueda@uunet.uu.net (UEDA masaya)

  >I used ccl::gestalt (It is not documented too) to determine whether
  >the movie toolbox is installed.
  ...
  >Is this right or not recommended?

  I can't officially sanction the use of non-exported functions, but your
  use of ccl::gestalt is correct and I doubt that we're going to remove
  it any time soon.

(defmethod initialize-instance :after ((mvwnd movie-window) &rest r)
  ...
    (let ((gestalt (ccl::gestalt #$gestaltQuickTime)))
      (if (and (numberp gestalt)
               (/= 0 gestalt)
  ...))))


THANKS!


- definitions -----------------------------------------------------------------
;-*- Mode: Lisp; Package: QuickTime -*-
;
;	movie-window.lisp
;
;	Created:	Wednesday, Feb 5, 1992
;	Author:		Masaya UEDA
;	Organization:	Information System R&D Center, SHARP Co.
;	E-mail:		ueda@shpcs.sharp.co.jp
;	Snail-mail: 	2613-1, Ichinomto, Tenri, Nara 632, JAPAN
;	Facsimile:	+81-7436-5-4176

(defpackage :QuickTime
  (:use :common-lisp :ccl)
  (:nicknames :qt))

(in-package :qt)

(use-package 'QuickTime 'CL-User)

(require :traps)
(require :quickdraw)
(require :movies)
(require :events)

(defmacro until (cond . body) `(loop (if ,cond (return)) ,@body))

; ======= class =======

(defclass movie-window (window)
  ((movie :initarg :movie :accessor movie)
   (need-to-dispose-p :initform nil :accessor need-to-dispose-p)
   (enter-movies-p :initform nil :accessor enter-movies-p)
   (playing-p :initform nil :accessor playing-p))
  (:default-initargs :movie nil :color-p t :window-show nil :window-type :document))

; ======= methods =======

; ----- to construct & destruct instance ----- 

(defmethod initialize-instance :after ((mvwnd movie-window) &rest r)
  (declare (ignore r))
  (rlet ((m :pointer))
    (let ((gestalt (ccl::gestalt #$gestaltQuickTime)))
      (if (and (numberp gestalt)
               (/= 0 gestalt)
               (setf (enter-movies-p mvwnd) (= #$noErr (#_EnterMovies)))
               (if (movie mvwnd)
                 t
                 (and
                  (get-movie m)
                  (setf (movie mvwnd) (%get-ptr m)
                        (need-to-dispose-p mvwnd) t))))
        (progn
          (setup-movie-window mvwnd)
          (window-select mvwnd)
          (#_MoviesTask (movie mvwnd) #$doTHeRIghtThing))
        (window-close mvwnd)))))

(defmethod window-close :after ((mvwnd movie-window))
  (if (and (movie mvwnd) (need-to-dispose-p mvwnd))
    (#_DisposeMovie (movie mvwnd)))
  (if (enter-movies-p mvwnd) (#_ExitMovies)))

; ----- to handle events -----

(defmethod view-click-event-handler :after ((mvwnd movie-window) where)
  (declare (ignore where))
  (let ((movie (movie mvwnd)))
    (if (playing-p mvwnd)
      (progn
        (#_StopMovie movie)
        (if (/= #$noErr (#_GetMoviesError)) (return-from view-click-event-handler))      
        (setf (playing-p mvwnd) nil))
      (when (double-click-p)
        (if (#_IsMovieDone movie) (#_GotoBeginningofMovie movie))
        (#_StartMovie movie)
        (if (/= #$noErr (#_GetMoviesError)) (return-from view-click-event-handler))
        (setf (playing-p mvwnd) t)))))

#|	; This plain code works too slow.
	; (on my II-fx, #_MoviesTask is called about 4.5 times/sec)
(defmethod window-null-event-handler :after ((mvwnd movie-window))
  (if (playing-p mvwnd)
    (let ((movie (movie mvwnd)))
      (if (not (#_IsMovieDone movie))
        (#_MoviesTask movie #$doTHeRIghtThing)))))
|#

(defmethod window-null-event-handler :after ((mvwnd movie-window))
  (if (playing-p mvwnd)
    (let ((movie (movie mvwnd)))
      (rlet ((er :EventRecord))
        (until (or (#_IsMovieDone movie) (#_eventavail #$EveryEvent er))
          ;	*** to call #_MoviesTask as often as possible ***
          (#_MoviesTask movie #$doTHeRIghtThing))
        (if (#_IsMovieDone movie) (setf (playing-p mvwnd) nil))))))

(defmethod view-deactivate-event-handler :after ((mvwnd movie-window))
  (#_StopMovie (movie mvwnd))
  (setf (playing-p mvwnd) nil))

(defmethod window-update-event-handler :after ((mvwnd movie-window))
  (#_UpdateMovie (movie mvwnd))
  (#_MoviesTask (movie mvwnd) #$doTHeRIghtThing))

; ----- to modify movie properties -----

(defmethod goto-beginning-of-movie ((mvwnd movie-window))
  (#_GotoBeginningOfMovie (movie mvwnd))
  (#_MoviesTask (movie mvwnd) #$doTHeRIghtThing))

(defmethod goto-end-of-movie ((mvwnd movie-window))
  (#_GotoEndOfMovie (movie mvwnd))
  (#_MoviesTask (movie mvwnd) #$doTHeRIghtThing))

(defmethod get-movie-volume ((mvwnd movie-window))
  (#_GetMovieVolume (movie mvwnd)))

(defmethod set-movie-volume ((mvwnd movie-window) (volume integer))
  (#_SetMovieVolume (movie mvwnd) volume))

(defmethod get-movie-rate ((mvwnd movie-window))
  (#_GetMovieRate (movie mvwnd)))

(defmethod set-movie-rate ((mvwnd movie-window) (rate integer))
  (#_SetMovieRate (movie mvwnd) rate))

; ======= functions =======

(defun if-oSErr-throw-nil (result tag where)
  (when (/= result #$noErr)
    (format t "~&ERROR[~a]:~a" result where)
    (throw tag nil)))

(defun get-movie-aux ()
  (rlet ((file-types :SFTypeList) (reply :StandardFileReply)
         (movie-res-file :signed-integer))
    (rset file-types (SFTypeList.array 0) "MooV")
    (#_StandardGetFilePreview (%null-ptr) 1 file-types reply)
    (unless (rref reply :StandardFileReply.sfGood)
      (format t "~&_StandardGetFilePreview")
      (throw 'GetMovie nil))
    (if-oSErr-throw-nil (#_OpenMovieFile
                         (rref reply :StandardFileReply.sfFile)
                         movie-res-file
                         #$fsRdPerm)
                        'GetMovie
                        "_OpenMovieFile")
    (%get-word movie-res-file)))

(defun get-movie (m)
  (catch 'GetMovie
    (rlet ((resID :signed-integer) (was-changed :boolean))
      (%put-word resID 0)
      (let* ((resrefnum (get-movie-aux))
             (result (#_NewMovieFromFile
                      m
                      resrefnum
                      resID
                      (%null-ptr)
                      #$newMovieActive
                      was-changed)))
        (if-oSErr-throw-nil (#_CloseMovieFile resrefnum) 'GetMovie "_CloseMovieFile")
        (if-oSErr-throw-nil result 'GetMovie "_NewMovieFromFile")))
    t))

(defun setup-movie-window (mvwnd)
  (catch 'SetUpMovieWindow
    (let ((movie (movie mvwnd)))
      (rlet ((movie-box :rect))
        ;The movie box may come with negative coordinates so we reset the origin to 0,0
        (#_getmoviebox movie movie-box)
        (offset-rect movie-box (rref movie-box :rect.topleft))
        (#_SetMovieBox movie movie-box)
        (if-oSErr-throw-nil (#_GetMoviesError) 'SetUpMovieWindow "_SetMovieBox")
        (set-view-size mvwnd (rref movie-box :rect.bottomright))
        (window-show mvwnd)
        (#_SetMovieGWorld movie (rref (wptr mvwnd) :CWindowRecord.port) (%null-ptr))
        (if-oSErr-throw-nil (#_GetMoviesError) 'SetUpMovieWindow "_SetMovieGWorld")
        (#_GotoBeginningOfMovie movie)
        (if-oSErr-throw-nil (#_GetMoviesError) 'SetUpMovieWindow "_GotoBeginningOfMovie")))
    t))

(export '(movie-window initialize-instance close-window view-click-event-handler
          window-null-event-handler view-deactivate-event-handler window-update-event-handler
          goto-beginning-of-movie goto-end-of-movie get-movie-volume set-movie-volume
          get-movie-rate set-movie-rate))

#| --- do-it! ---
(setq mvwnd (make-instance 'movie-window :view-position #@(4 -400)))
(setq mvwnd (make-instance 'movie-window :movie (movie mvwnd)))
|#


