Skip to content

Commit

Permalink
Branch celtk-3d pulls OpenGL via Togl1.7 and cl-opengl into the mix
Browse files Browse the repository at this point in the history
  • Loading branch information
Kenneth Tilton committed Apr 19, 2010
1 parent e6ccd21 commit 4845a81
Show file tree
Hide file tree
Showing 11 changed files with 399 additions and 388 deletions.
188 changes: 93 additions & 95 deletions Celtk3D.lpr
View file
@@ -1,95 +1,93 @@
;; -*- lisp-version: "8.1 [Windows] (Jan 2, 2008 9:44)"; cg: "1.103.2.10"; -*-

(in-package :cg-user)

(defpackage :CELTK)

(define-project :name :celtk3d
:modules (list (make-instance 'module :name "cellogears.lisp"))
:projects (list (make-instance 'project-module :name
"..\\cells\\cells")
(make-instance 'project-module :name
"C:\\1-devtools\\cffi\\cffi")
(make-instance 'project-module :name
"C:\\1-devtools\\cl-opengl\\glu")
(make-instance 'project-module :name "CELTK"))
:libraries nil
:distributed-files nil
:internally-loaded-files nil
:project-package-name :celtk
:main-form nil
:compilation-unit t
:verbose nil
:runtime-modules (list :cg-dde-utils :cg.base :cg.bitmap-pane
:cg.bitmap-pane.clipboard :cg.bitmap-stream
:cg.button :cg.caret :cg.check-box
:cg.choice-list :cg.choose-printer
:cg.clipboard :cg.clipboard-stack
:cg.clipboard.pixmap :cg.color-dialog
:cg.combo-box :cg.common-control :cg.comtab
:cg.cursor-pixmap :cg.curve :cg.dialog-item
:cg.directory-dialog :cg.directory-dialog-os
:cg.drag-and-drop :cg.drag-and-drop-image
:cg.drawable :cg.drawable.clipboard
:cg.dropping-outline :cg.edit-in-place
:cg.editable-text :cg.file-dialog
:cg.fill-texture :cg.find-string-dialog
:cg.font-dialog :cg.gesture-emulation
:cg.get-pixmap :cg.get-position
:cg.graphics-context :cg.grid-widget
:cg.grid-widget.drag-and-drop :cg.group-box
:cg.header-control :cg.hotspot :cg.html-dialog
:cg.html-widget :cg.icon :cg.icon-pixmap
:cg.ie :cg.item-list :cg.keyboard-shortcuts
:cg.lamp :cg.lettered-menu :cg.lisp-edit-pane
:cg.lisp-text :cg.lisp-widget :cg.list-view
:cg.mci :cg.menu :cg.menu.tooltip
:cg.message-dialog
:cg.multi-line-editable-text
:cg.multi-line-lisp-text
:cg.multi-picture-button
:cg.multi-picture-button.drag-and-drop
:cg.multi-picture-button.tooltip :cg.ocx
:cg.os-widget :cg.os-window :cg.outline
:cg.outline.drag-and-drop
:cg.outline.edit-in-place :cg.palette
:cg.paren-matching :cg.picture-widget
:cg.picture-widget.palette :cg.pixmap
:cg.pixmap-widget :cg.pixmap.file-io
:cg.pixmap.printing :cg.pixmap.rotate
:cg.printing :cg.progress-indicator
:cg.project-window :cg.property
:cg.radio-button :cg.rich-edit
:cg.rich-edit-pane
:cg.rich-edit-pane.clipboard
:cg.rich-edit-pane.printing
:cg.sample-file-menu :cg.scaling-stream
:cg.scroll-bar :cg.scroll-bar-mixin
:cg.selected-object :cg.shortcut-menu
:cg.static-text :cg.status-bar
:cg.string-dialog :cg.tab-control
:cg.template-string :cg.text-edit-pane
:cg.text-edit-pane.file-io
:cg.text-edit-pane.mark :cg.text-or-combo
:cg.text-widget :cg.timer :cg.toggling-widget
:cg.toolbar :cg.tooltip :cg.trackbar :cg.tray
:cg.up-down-control :cg.utility-dialog
:cg.web-browser :cg.web-browser.dde
:cg.wrap-string :cg.yes-no-list
:cg.yes-no-string :dde)
:splash-file-module (make-instance 'build-module :name "")
:icon-file-module (make-instance 'build-module :name "")
:include-flags (list :top-level :debugger)
:build-flags (list :allow-runtime-debug :purify)
:autoload-warning t
:full-recompile-for-runtime-conditionalizations nil
:include-manifest-file-for-visual-styles t
:default-command-line-arguments "+M +t \"Console for Debugging\""
:additional-build-lisp-image-arguments (list :read-init-files nil)
:old-space-size 256000
:new-space-size 6144
:runtime-build-option :standard
:on-initialization 'celtk::cellogears
:on-restart 'do-default-restart)
;; End of Project Definition
;; -*- lisp-version: "8.1 [Windows] (Jan 2, 2008 9:44)"; cg: "1.103.2.10"; -*-

(in-package :cg-user)

(defpackage :celtk)

(define-project :name :celtk3d
:modules (list (make-instance 'module :name "cellogears.lisp"))
:projects (list (make-instance 'project-module :name
"..\\cells\\cells")


(make-instance 'project-module :name "celtk"))
:libraries nil
:distributed-files nil
:internally-loaded-files nil
:project-package-name :celtk
:main-form nil
:compilation-unit t
:verbose nil
:runtime-modules (list :cg-dde-utils :cg.base :cg.bitmap-pane
:cg.bitmap-pane.clipboard :cg.bitmap-stream
:cg.button :cg.caret :cg.check-box
:cg.choice-list :cg.choose-printer
:cg.clipboard :cg.clipboard-stack
:cg.clipboard.pixmap :cg.color-dialog
:cg.combo-box :cg.common-control :cg.comtab
:cg.cursor-pixmap :cg.curve :cg.dialog-item
:cg.directory-dialog :cg.directory-dialog-os
:cg.drag-and-drop :cg.drag-and-drop-image
:cg.drawable :cg.drawable.clipboard
:cg.dropping-outline :cg.edit-in-place
:cg.editable-text :cg.file-dialog
:cg.fill-texture :cg.find-string-dialog
:cg.font-dialog :cg.gesture-emulation
:cg.get-pixmap :cg.get-position
:cg.graphics-context :cg.grid-widget
:cg.grid-widget.drag-and-drop :cg.group-box
:cg.header-control :cg.hotspot :cg.html-dialog
:cg.html-widget :cg.icon :cg.icon-pixmap
:cg.ie :cg.item-list :cg.keyboard-shortcuts
:cg.lamp :cg.lettered-menu :cg.lisp-edit-pane
:cg.lisp-text :cg.lisp-widget :cg.list-view
:cg.mci :cg.menu :cg.menu.tooltip
:cg.message-dialog
:cg.multi-line-editable-text
:cg.multi-line-lisp-text
:cg.multi-picture-button
:cg.multi-picture-button.drag-and-drop
:cg.multi-picture-button.tooltip :cg.ocx
:cg.os-widget :cg.os-window :cg.outline
:cg.outline.drag-and-drop
:cg.outline.edit-in-place :cg.palette
:cg.paren-matching :cg.picture-widget
:cg.picture-widget.palette :cg.pixmap
:cg.pixmap-widget :cg.pixmap.file-io
:cg.pixmap.printing :cg.pixmap.rotate
:cg.printing :cg.progress-indicator
:cg.project-window :cg.property
:cg.radio-button :cg.rich-edit
:cg.rich-edit-pane
:cg.rich-edit-pane.clipboard
:cg.rich-edit-pane.printing
:cg.sample-file-menu :cg.scaling-stream
:cg.scroll-bar :cg.scroll-bar-mixin
:cg.selected-object :cg.shortcut-menu
:cg.static-text :cg.status-bar
:cg.string-dialog :cg.tab-control
:cg.template-string :cg.text-edit-pane
:cg.text-edit-pane.file-io
:cg.text-edit-pane.mark :cg.text-or-combo
:cg.text-widget :cg.timer :cg.toggling-widget
:cg.toolbar :cg.tooltip :cg.trackbar :cg.tray
:cg.up-down-control :cg.utility-dialog
:cg.web-browser :cg.web-browser.dde
:cg.wrap-string :cg.yes-no-list
:cg.yes-no-string :dde)
:splash-file-module (make-instance 'build-module :name "")
:icon-file-module (make-instance 'build-module :name "")
:include-flags (list :top-level :debugger)
:build-flags (list :allow-runtime-debug :purify)
:autoload-warning t
:full-recompile-for-runtime-conditionalizations nil
:include-manifest-file-for-visual-styles t
:default-command-line-arguments "+M +t \"Console for Debugging\""
:additional-build-lisp-image-arguments (list :read-init-files nil)
:old-space-size 256000
:new-space-size 6144
:runtime-build-option :standard
:on-initialization 'celtk::cellogears
:on-restart 'do-default-restart)
;; End of Project Definition
8 changes: 6 additions & 2 deletions asdf-projects.lisp
View file
Expand Up @@ -2,9 +2,13 @@

(eval-when (compile load)
(require :asdf)
(loop for project in '(alexandria trivial-features_0.6 babel_0.3.0 cffi_0.10.5)
(loop for project in '(alexandria trivial-features_0.6 babel_0.3.0 cffi_0.10.5 cl-opengl)
do (pushnew
(namestring (make-pathname :directory `(:absolute "devel" ,(string project))))
asdf:*central-registry* :test 'string-equal))
(asdf:oos 'asdf:load-op :cffi))
(asdf:oos 'asdf:load-op :cffi)
(asdf:oos 'asdf:load-op :cl-glu)
(asdf:oos 'asdf:load-op :cl-glut))



6 changes: 4 additions & 2 deletions celtk.lpr
View file
Expand Up @@ -35,7 +35,9 @@
(make-instance 'module :name "lotsa-widgets.lisp")
(make-instance 'module :name "demos.lisp")
(make-instance 'module :name "andy-expander.lisp")
(make-instance 'module :name "notebook.lisp"))
(make-instance 'module :name "notebook.lisp")
(make-instance 'module :name "gears/nehe-02")
(make-instance 'module :name "gears/gears.lisp"))
:projects (list (make-instance 'project-module :name "../cells/cells" :show-modules
nil))
:libraries nil
Expand Down Expand Up @@ -102,7 +104,7 @@
:build-number 0
:run-with-console nil
:project-file-version-info nil
:on-initialization 'celtk::tk-test
:on-initialization 'celtk::gears
:default-error-handler-for-delivery 'report-unexpected-error-and-exit
:on-restart 'do-default-restart)
Expand Down
2 changes: 1 addition & 1 deletion entry.lisp
View file
Expand Up @@ -107,7 +107,7 @@ See the Lisp Lesser GNU Public License for more details.
(setf (^modified) t)))))
))))

(defmethod clear ((self text-widget))
(defmethod clear-value ((self text-widget))
(setf (value self) nil))

(defobserver .value ((self text-widget))
Expand Down
23 changes: 14 additions & 9 deletions gears/gears.lisp
View file
Expand Up @@ -3,10 +3,12 @@
;;;
;;; Simple program with rotating 3-D gear wheels.

(defpackage :gears
(:use :common-lisp :utils-kt :cells :celtk))

(in-package :gears)
(in-package :celtk)

(eval-when (compile load)
(use-package :gl)
(use-package :glu))

(defvar *startx*)
(defvar *starty*)
Expand All @@ -17,6 +19,9 @@

(defparameter *vTime* 100)

#+test
(gears)

(defun gears () ;; ACL project manager needs a zero-argument function, in project package
(let ((*startx* nil)
(*starty* nil)
Expand All @@ -28,7 +33,7 @@

(defmodel gears-demo (window)
((gear-ct :initform (c-in 1) :accessor gear-ct :initarg :gear-ct)
(scale :initform (c-in 1) :accessor scale :initarg :scale))
(gr-scale :initform (c-in 1) :accessor gr-scale :initarg :gr-scale))
(:default-initargs
:title$ "Rotating Gear Widget Test"
:kids (c? (the-kids
Expand Down Expand Up @@ -127,8 +132,8 @@
)

(defun truc (self &optional truly)
(let ((width (Togl-width (togl-ptr self)))
(height (Togl-height (togl-ptr self))))
(let ((width (togl-width (togl-ptr self)))
(height (togl-height (togl-ptr self))))
(trc nil "enter gear reshape" self width (width self))
(gl:viewport 0 (- height (height self)) (width self) (height self))
(unless truly
Expand All @@ -142,11 +147,11 @@
(gl:translate 0 0 -30))))


(defmethod togl-display-using-class ((self gears) &aux (scale (scale (upper self gears-demo))))
(defmethod togl-display-using-class ((self gears) &aux (scale (gr-scale (upper self gears-demo))))
(declare (ignorable scale))
(trc nil "display angle" (^rotx)(^roty)(^rotz))
(gl:clear-color 0 0 0 1)
(gl:clear :color-buffer-bit :depth-buffer-bit)
(gl:clear :COLOR-BUFFER-BIT :DEPTH-BUFFER-BIT)

(gl:with-pushed-matrix
(gl:rotate (^rotx) 1 0 0)
Expand All @@ -168,7 +173,7 @@
(gl:rotate (- (* -2 (^angle)) 25) 0 0 1)
(gl:call-list (^gear3))))

(Togl-Swap-Buffers (togl-ptr self))
(togl-swap-buffers (togl-ptr self))

#+shhh (print-frame-rate self))

Expand Down

0 comments on commit 4845a81

Please sign in to comment.