cello-cvs

cello-cvs@common-lisp.net

227 discussions

[cello-cvs] CVS cello/cl-openal
by ktilton 17 May '06

17 May '06

Update of /project/cello/cvsroot/cello/cl-openal In directory clnet:/tmp/cvs-serv22618/cl-openal Added Files: al.lisp alc.lisp alctypes.lisp altypes.lisp alu.lisp alut.lisp cl-openal-config.lisp cl-openal-demo.lisp cl-openal-init.lisp cl-openal.asd cl-openal.lisp cl-openal.lpr cl-opengl-config.lisp wav-handling.lisp Log Message: CVS re-organization bringing auxiliary packages under one Cello module --- /project/cello/cvsroot/cello/cl-openal/al.lisp 2006/05/17 16:14:30 NONE +++ /project/cello/cvsroot/cello/cl-openal/al.lisp 2006/05/17 16:14:30 1.1 (in-package :cl-openal) #|* * OpenAL cross platform audio library * Copyright (C) 1999-2000 by authors. * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 59 Temple Place - Suite 330, * Boston, MA 02111-1307, USA. * Or go to http://www.gnu.org/copyleft/lgpl.html |# #|* * OpenAL Maintenance Functions * Initialization and exiting. * State Management and Query. * Error Handling. * Extension Support. |# #|* State management. |# (defun-ffx al-void "openal" "alEnable" ( al-enum capability )) (defun-ffx al-void "openal" "alDisable" ( al-enum capability )) (defun-ffx al-boolean "openal" "alIsEnabled" ( al-enum capability )) #|* Application preferences for driver performance choices. |# (defun-ffx al-void "openal" "alHint" ( al-enum target al-enum mode )) #|* State retrieval. |# (defun-ffx al-boolean "openal" "alGetBoolean" ( al-enum param )) (defun-ffx al-int "openal" "alGetInteger" ( al-enum param )) (defun-ffx al-float "openal" "alGetFloat" ( al-enum param )) (defun-ffx al-double "openal" "alGetDouble" ( al-enum param )) (defun-ffx al-void "openal" "alGetBooleanv" ( al-enum param :void *data )) (defun-ffx al-void "openal" "alGetIntegerv" ( al-enum param :void *data )) (defun-ffx al-void "openal" "alGetFloatv" ( al-enum param :void *data )) (defun-ffx al-void "openal" "alGetDoublev" ( al-enum param :void *data )) (defun-ffx :pointer "openal" "alGetString" ( al-enum param )) #|* * Error support. * Obtain the most recent error generated in the AL state machine. |# (defun-ffx al-enum "openal" "alGetError" ( )) #|* * Extension support. * Obtain the address of a function (usually an extension) * with the name fname. All addresses are context-independent. |# (defun-ffx al-boolean "openal" "alIsExtensionPresent" ( :void *fname )) #|* * Extension support. * Obtain the address of a function (usually an extension) * with the name fname. All addresses are context-independent. |# (defun-ffx :pointer "openal" "alGetProcAddress" ( :void *fname )) #|* * Extension support. * Obtain the integer value of an enumeration (usually an extension) with the name ename. |# (defun-ffx al-enum "openal" "alGetEnumValue" ( :void *ename )) #|* * LISTENER * Listener is the sample position for a given context. * The multi-channel (usually stereo) output stream generated * by the mixer is parametrized by this Listener object: * its position and velocity relative to Sources, within * occluder and reflector geometry. |# #|* * * Listener Environment: default 0. |# (defun-ffx al-void "openal" "alListeneri" ( al-enum param al-int value )) #|* * * Listener Gain: default 1.0f. |# (defun-ffx al-void "openal" "alListenerf" ( al-enum param al-float value )) #|* * * Listener Position. * Listener Velocity. |# (defun-ffx al-void "openal" "alListener3f" ( al-enum param al-float v1 al-float v2 al-float v3 )) #|* * * Listener Position: ALfloat[3] * Listener Velocity: ALfloat[3] * Listener Orientation: ALfloat[6] (forward and up vector). |# (defun-ffx al-void "openal" "alListenerfv" ( al-enum param :void *values )) (defun-ffx al-void "openal" "alGetListeneri" ( al-enum param :void *value )) (defun-ffx al-void "openal" "alGetListenerf" ( al-enum param :void *value )) (defun-ffx al-void "openal" "alGetListener3f" ( al-enum param :void *v1 :void *v2 :void *v3 )) (defun-ffx al-void "openal" "alGetListenerfv" ( al-enum param :void *values )) #|* * SOURCE * Source objects are by default localized. Sources * take the PCM data provided in the specified Buffer, * apply Source-specific modifications, and then * submit them to be mixed according to spatial * arrangement etc. |# #|* Create Source objects. |# (defun-ffx al-void "openal" "alGenSources" ( al-sizei n :void *sources )) #|* Delete Source objects. |# (defun-ffx al-void "openal" "alDeleteSources" ( al-sizei n :void *sources )) #|* Verify a handle is a valid Source. |# (defun-ffx al-boolean "openal" "alIsSource" ( al-uint id )) #|* Set an integer parameter for a Source object. |# (defun-ffx al-void "openal" "alSourcei" ( al-uint source al-enum param al-int value )) (defun-ffx al-void "openal" "alSourcef" ( al-uint source al-enum param al-float value )) (defun-ffx al-void "openal" "alSource3f" ( al-uint source al-enum param al-float v1 al-float v2 al-float v3 )) (defun-ffx al-void "openal" "alSourcefv" ( al-uint source al-enum param :void *values )) #|* Get an integer parameter for a Source object. |# (defun-ffx al-void "openal" "alGetSourcei" ( al-uint source al-enum param :void *value )) (defun-ffx al-void "openal" "alGetSourcef" ( al-uint source al-enum param :void *value )) (defun-ffx al-void "openal" "alGetSource3f" ( al-uint source al-enum param :void *v1 :void *v2 :void *v3 )) (defun-ffx al-void "openal" "alGetSourcefv" ( al-uint source al-enum param :void *values )) (defun-ffx al-void "openal" "alSourcePlayv" ( al-sizei n al-uint *sources )) (defun-ffx al-void "openal" "alSourcePausev" ( al-sizei n al-uint *sources )) (defun-ffx al-void "openal" "alSourceStopv" ( al-sizei n al-uint *sources )) (defun-ffx al-void "openal" "alSourceRewindv" (al-sizei n al-uint *sources)) #|* Activate a source, start replay. |# (defun-ffx al-void "openal" "alSourcePlay" ( al-uint source )) #|* * Pause a source, * temporarily remove it from the mixer list. |# (defun-ffx al-void "openal" "alSourcePause" ( al-uint source )) #|* * Stop a source, * temporarily remove it from the mixer list, * and reset its internal state to pre-Play. * To remove a Source completely, it has to be * deleted following Stop, or before Play. |# (defun-ffx al-void "openal" "alSourceStop" ( al-uint source )) #| * * Rewinds a source, * temporarily remove it from the mixer list, * and reset its internal state to pre-Play. |# (defun-ffx al-void "openal" "alSourceRewind" ( al-uint source )) #| * * BUFFER * Buffer objects are storage space for sample data. * Buffers are referred to by Sources. There can be more than * one Source using the same Buffer data. If Buffers have * to be duplicated on a per-Source basis, the driver has to * take care of allocation, copying, and deallocation as well * as propagating buffer data changes. |# #|* Buffer object generation. |# (defun-ffx al-void "openal" "alGenBuffers" ( al-sizei n :void *buffer-uints )) (defun-ffx al-void "openal" "alDeleteBuffers" ( al-sizei n :void *buffers )) (defun-ffx al-boolean "openal" "alIsBuffer" ( al-uint buffer )) #| * * Specify the data to be filled into a buffer. * |# (defun-ffx al-void "openal" "alBufferData" ( al-uint buffer al-enum format :void *data al-sizei size al-sizei freq )) (defun-ffx al-void "openal" "alGetBufferi" ( al-uint buffer al-enum param :void *value )) (defun-ffx al-void "openal" "alGetBufferf" ( al-uint buffer al-enum param :void *value )) #| * * Queue stuff * |# (defun-ffx al-void "openal" "alSourceQueueBuffers" ( al-uint source al-sizei n :void *buffers )) (defun-ffx al-void "openal" "alSourceUnqueueBuffers" ( al-uint source al-sizei n :void *buffers )) #| * * Knobs and dials * |# (defun-ffx al-void "openal" "alDistanceModel" ( al-enum value )) (defun-ffx al-void "openal" "alDopplerFactor" ( al-float value )) (defun-ffx al-void "openal" "alDopplerVelocity" ( al-float value )) --- /project/cello/cvsroot/cello/cl-openal/alc.lisp 2006/05/17 16:14:30 NONE +++ /project/cello/cvsroot/cello/cl-openal/alc.lisp 2006/05/17 16:14:30 1.1 (in-package :cl-openal) ; typedef struct ALCdevice_struct ALCdevice; ; typedef struct ALCcontext_struct ALCcontext; ;;;(defun-ffx ALCubyte* "openal" "alcGetString" (ALCdevice *device ALCenum param)) ;;;(defun-ffx ALCvoid "openal" "alcGetIntegerv" (ALCdevice *device ALCenum param ALCsizei size ALCint *data)) ;;; (defun-ffx :pointer "openal" "alcOpenDevice" (:string device-name)) (defun-ffx :void "openal" "alcCloseDevice" (:void *device)) (defun-ffx :pointer "openal" "alcCreateContext" (:void *device alc-int *attr-list)) (defun-ffx alc-enum "openal" "alcMakeContextCurrent" (:void *context)) (defun-ffx :void "openal" "alcProcessContext" (:void *context)) (defun-ffx :pointer "openal" "alcGetCurrentContext" ()) (defun-ffx :pointer "openal" "alcGetContextsDevice" (:void *context)) (defun-ffx :void "openal" "alcSuspendContext" (:void *context)) (defun-ffx alc-enum "openal" "alcDestroyContext" (:void *context)) ;;; (defun-ffx alc-enum "openal" "alcGetError" (:void *device)) ;;; (defun-ffx alc-boolean "openal" "alcIsExtensionPresent" (:void *device alc-ubyte *ext-name)) (defun-ffx :void "openal" "alcGetProcAddress" (:void *device alc-ubyte *func-name)) (defun-ffx alc-enum "openal" "alcGetEnumValue" (:void *device alc-ubyte *enum-name)) --- /project/cello/cvsroot/cello/cl-openal/alctypes.lisp 2006/05/17 16:14:30 NONE +++ /project/cello/cvsroot/cello/cl-openal/alctypes.lisp 2006/05/17 16:14:30 1.1 (in-package :cl-openal) #| * OpenAL cross platform audio library * Copyright (C) 1999-2000 by authors. * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 59 Temple Place - Suite 330, * Boston, MA 02111-1307, USA. * Or go to http://www.gnu.org/copyleft/lgpl.html |# (dft alc-boolean :unsigned-char #+allegro character #-allegro number) (dft alc-byte :char #+allegro character #-allegro number) (dft alc-ubyte :unsigned-char #+allegro character #-allegro number) (dft alc-short #-allegro-v5.0.1 :short #+allegro-v5.0.1 :int integer) (dft alc-ushort #-allegro-v5.0.1 :unsigned-int #+allegro-v5.0.1 :int integer) (dft alc-uint #-allegro-v5.0.1 :unsigned-int #+allegro-v5.0.1 :int integer) (dft alc-int :int integer) (dft alc-float #+lispworks :lisp-single-float #-lispworks :float single-float) (dft alc-double :double double-float) (dft alc-sizei #-allegro-v5.0.1 :unsigned-int #+allegro-v5.0.1 :int integer) (dft alc-void :void integer) (dft alc-enum #-allegro-v5.0.1 :unsigned-int #+allegro-v5.0.1 :int integer) (dfc alc_invalid -1) (dfc alc_false 0) (dfc alc_true 1) (dfc alc_no_error alc_false) (dfc alc_major_version #x1000) (dfc alc_minor_version #x1001) (dfc alc_attributes_size #x1002) (dfc alc_all_attributes #x1003) (dfc alc_default_device_specifier #x1004) (dfc alc_device_specifier #x1005) (dfc alc_extensions #x1006) (dfc alc_frequency #x1007) (dfc alc_refresh #x1008) (dfc alc_sync #x1009) (dfc alc_invalid_device #xa001) (dfc alc_invalid_context #xa002) (dfc alc_invalid_enum #xa003) (dfc alc_invalid_value #xa004) (dfc alc_out_of_memory #xa005) --- /project/cello/cvsroot/cello/cl-openal/altypes.lisp 2006/05/17 16:14:30 NONE +++ /project/cello/cvsroot/cello/cl-openal/altypes.lisp 2006/05/17 16:14:30 1.1 (in-package :cl-openal) #| * OpenAL cross platform audio library * Copyright (C) 1999-2000 by authors. * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 59 Temple Place - Suite 330, * Boston, MA 02111-1307, USA. * Or go to http://www.gnu.org/copyleft/lgpl.html |# (dft al-enum #-allegro-v5.0.1 :unsigned-int #+allegro-v5.0.1 :int integer) (dft al-bitfield #-allegro-v5.0.1 :unsigned-int #+allegro-v5.0.1 :int integer) (dft al-int :int integer) (dft al-sizei :int integer) (dft al-uint #-allegro-v5.0.1 :unsigned-int #+allegro-v5.0.1 :int integer) (dft al-ushort #-allegro-v5.0.1 :unsigned-int #+allegro-v5.0.1 :int integer) (dft al-float #+lispworks :lisp-single-float #-lispworks :float single-float) (dft al-clampf #+lispworks :lisp-single-float #-lispworks :float single-float) (dft al-double :double double-float) (dft al-clampd :double double-float) (dft al-boolean :unsigned-char #+allegro character #-allegro number) (dft al-byte :char #+allegro character #-allegro number) ;; typedef signed char GLbyte; (dft al-void :void integer) (dft al-short #-allegro-v5.0.1 :short #+allegro-v5.0.1 :int integer) (dft al-ubyte :unsigned-char #+allegro character #-allegro number) (dft al-sizei #-allegro-v5.0.1 :unsigned-int #+allegro-v5.0.1 :int integer) (dfc al_invalid -1) (dfc al_none 0) (dfc al_false 0) (dfc al_true 1) #|* * Indicate the type of AL_SOURCE. * Sources can be spatialized |# (dfc al_source_type #x200) #|* Indicate source has absolute coordinates. |# (dfc al_source_absolute #x201) #|* Indicate Source has listener relative coordinates. |# (dfc al_source_relative #x202) #|* * Directional source, inner cone angle, in degrees. * Range: [0-360] * Default: 360 |# (dfc al_cone_inner_angle #x1001) #|* * Directional source, outer cone angle, in degrees. * Range: [0-360] * Default: 360 |# (dfc al_cone_outer_angle #x1002) #|* * Specify the pitch to be applied, either at source, [219 lines skipped] --- /project/cello/cvsroot/cello/cl-openal/alu.lisp 2006/05/17 16:14:30 NONE +++ /project/cello/cvsroot/cello/cl-openal/alu.lisp 2006/05/17 16:14:30 1.1 [258 lines skipped] --- /project/cello/cvsroot/cello/cl-openal/alut.lisp 2006/05/17 16:14:30 NONE +++ /project/cello/cvsroot/cello/cl-openal/alut.lisp 2006/05/17 16:14:30 1.1 [286 lines skipped] --- /project/cello/cvsroot/cello/cl-openal/cl-openal-config.lisp 2006/05/17 16:14:30 NONE +++ /project/cello/cvsroot/cello/cl-openal/cl-openal-config.lisp 2006/05/17 16:14:30 1.1 [327 lines skipped] --- /project/cello/cvsroot/cello/cl-openal/cl-openal-demo.lisp 2006/05/17 16:14:30 NONE +++ /project/cello/cvsroot/cello/cl-openal/cl-openal-demo.lisp 2006/05/17 16:14:30 1.1 [347 lines skipped] --- /project/cello/cvsroot/cello/cl-openal/cl-openal-init.lisp 2006/05/17 16:14:30 NONE +++ /project/cello/cvsroot/cello/cl-openal/cl-openal-init.lisp 2006/05/17 16:14:30 1.1 [438 lines skipped] --- /project/cello/cvsroot/cello/cl-openal/cl-openal.asd 2006/05/17 16:14:30 NONE +++ /project/cello/cvsroot/cello/cl-openal/cl-openal.asd 2006/05/17 16:14:30 1.1 [469 lines skipped] --- /project/cello/cvsroot/cello/cl-openal/cl-openal.lisp 2006/05/17 16:14:30 NONE +++ /project/cello/cvsroot/cello/cl-openal/cl-openal.lisp 2006/05/17 16:14:30 1.1 [531 lines skipped] --- /project/cello/cvsroot/cello/cl-openal/cl-openal.lpr 2006/05/17 16:14:30 NONE +++ /project/cello/cvsroot/cello/cl-openal/cl-openal.lpr 2006/05/17 16:14:30 1.1 [573 lines skipped] --- /project/cello/cvsroot/cello/cl-openal/cl-opengl-config.lisp 2006/05/17 16:14:30 NONE +++ /project/cello/cvsroot/cello/cl-openal/cl-opengl-config.lisp 2006/05/17 16:14:30 1.1 [616 lines skipped] --- /project/cello/cvsroot/cello/cl-openal/wav-handling.lisp 2006/05/17 16:14:30 NONE +++ /project/cello/cvsroot/cello/cl-openal/wav-handling.lisp 2006/05/17 16:14:30 1.1 [753 lines skipped]

1 0

[cello-cvs] CVS cello/cl-ftgl/ftgl-int
by ktilton 17 May '06

17 May '06

Update of /project/cello/cvsroot/cello/cl-ftgl/ftgl-int In directory clnet:/tmp/cvs-serv22618/cl-ftgl/ftgl-int Added Files: FTGLFromC.cpp fgc.def Log Message: CVS re-organization bringing auxiliary packages under one Cello module --- /project/cello/cvsroot/cello/cl-ftgl/ftgl-int/FTGLFromC.cpp 2006/05/17 16:14:29 NONE +++ /project/cello/cvsroot/cello/cl-ftgl/ftgl-int/FTGLFromC.cpp 2006/05/17 16:14:29 1.1 #include <assert.h> /* ;;; ;;; Copyright © 2004 by Kenneth William Tilton. ;;; ;;; Permission is hereby granted, free of charge, to any person obtaining a copy ;;; of this software and associated documentation files (the "Software"), to deal ;;; in the Software without restriction, including without limitation the rights ;;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell ;;; copies of the Software, and to permit persons to whom the Software is furnished ;;; to do so, subject to the following conditions: ;;; ;;; The above copyright notice and this permission notice shall be included in ;;; all copies or substantial portions of the Software. ;;; ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR ;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, ;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE ;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER ;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS ;;; IN THE SOFTWARE. */ #include "FTGLBitmapFont.h" #include "FTBitmapGlyph.h" #include "FTGLPixmapFont.h" #include "FTPixmapGlyph.h" #include "FTGLTextureFont.h" #include "FTTextureGlyph.h" #include "FTGlyphContainer.h" #include "FTBBox.h" #include "FTGLPolygonFont.h" #include "FTPolyGlyph.h" #include "FTGLOutlineFont.h" #include "FTOutlineGlyph.h" #include "FTGLExtrdFont.h" #include "FTExtrdGlyph.h" extern "C" { void __stdcall fgcBuildGlyphs( FTFont* f ) { f->BuildGlyphs(); } bool __stdcall fgcSetFaceSize( FTFont* f , unsigned int faceSize , unsigned int res ) { return f->FaceSize( faceSize, res ); } float __stdcall fgcAscender( FTFont* f ) { return f->Ascender( ); } float __stdcall fgcDescender( FTFont* f ) { return f->Descender( ); } float __stdcall fgcStringAdvance( FTFont* f, const char* string ) { return f->Advance( string ); } int __stdcall fgcCharTexture( FTFont* f, int chr ) { return ((FTGlyph *) f->FontGlyph( chr ))->glRendering(); //return f->GlyphRendering( chr ); } /* void FTFont::DoRender( const unsigned int chr, const unsigned int nextChr) { CheckGlyph( chr); FTPoint kernAdvance = glyphList->Render( chr, nextChr, pen); pen.x += kernAdvance.x; pen.y += kernAdvance.y; }*/ float __stdcall fgcStringX( FTFont* f, const char* string ) { float llx,lly,llz,urx,ury,urz; f->BBox( string, llx, lly, llz, urx, ury, urz ); return llx; } void __stdcall fgcRender( FTFont* f, const char *string ) { f->Render( string ); } void __stdcall fgcFree( FTFont* f ) { delete f; } //--------- Bitmap ---------------------------------------------- FTGLBitmapFont* __stdcall fgcBitmapMake( const char* fontname ) { return new FTGLBitmapFont( fontname ); } //--------- Pixmap ---------------------------------------------- FTGLPixmapFont* __stdcall fgcPixmapMake( const char* fontname ) { return new FTGLPixmapFont( fontname ); } //--------- Texture ---------------------------------------------- FTGLTextureFont* __stdcall fgcTextureMake( const char* fontname ) { return new FTGLTextureFont( fontname ); } //--------- Polygon ---------------------------------------------- FTGLPolygonFont* __stdcall fgcPolygonMake( const char* fontname ) { return new FTGLPolygonFont( fontname ); } //--------- Outline ---------------------------------------------- FTGLOutlineFont* __stdcall fgcOutlineMake( const char* fontname ) { return new FTGLOutlineFont( fontname ); } //--------- Extruded Polygon ------------------------------------- FTGLExtrdFont* __stdcall fgcExtrudedMake( const char* fontname ) { return new FTGLExtrdFont( fontname ); } bool __stdcall fgcSetFaceDepth( FTGLExtrdFont* f , float depth ) { f->Depth( depth ); return true; } } --- /project/cello/cvsroot/cello/cl-ftgl/ftgl-int/fgc.def 2006/05/17 16:14:29 NONE +++ /project/cello/cvsroot/cello/cl-ftgl/ftgl-int/fgc.def 2006/05/17 16:14:29 1.1 DESCRIPTION 'C Interface to FTGL' VERSION 0.1 EXPORTS fgcSetFaceSize fgcCharTexture fgcStringX fgcAscender fgcDescender fgcStringAdvance fgcRender fgcFree fgcBitmapMake fgcPixmapMake fgcTextureMake fgcPolygonMake fgcOutlineMake fgcExtrudedMake fgcSetFaceDepth fgcBuildGlyphs

1 0

[cello-cvs] CVS cello/cl-magick
by ktilton 17 May '06

17 May '06

Update of /project/cello/cvsroot/cello/cl-magick In directory clnet:/tmp/cvs-serv22618/cl-magick Added Files: build.lisp cl-magick.asd cl-magick.lisp cl-magick.lpr drawing-wand.lisp magick-wand.lisp mgk-utils.lisp pixel-wand.lisp wand-image.lisp wand-pixels.lisp wand-texture.lisp Log Message: CVS re-organization bringing auxiliary packages under one Cello module --- /project/cello/cvsroot/cello/cl-magick/build.lisp 2006/05/17 16:14:29 NONE +++ /project/cello/cvsroot/cello/cl-magick/build.lisp 2006/05/17 16:14:29 1.1 (in-package :cl-user) #-allegro-ide (let ((drive "C") (d-force nil)) (build-sys d-force drive "dvx" "uffi") (build-sys d-force drive "dvx" "ffi-extender") (build-sys d-force drive "dvx" "cl-opengl") (load (dev-root "cl-ftgl" "cl-ftgl.lisp")) (build-sys d-force drive "dvx" "cl-magick") ; (cl-magick::cl-magick-test) ) #+test (cl-magick::cl-magick-test) (in-package :cl-user) #-allegro-ide (let ((drive "C") (d-force nil)) (build-sys d-force drive "dvx" "uffi") (build-sys d-force drive "dvx" "ffi-extender") (build-sys d-force drive "dvx" "cl-opengl") (load (dev-root "cl-ftgl" "cl-ftgl.lisp")) (build-sys d-force drive "dvx" "cl-magick") ; (cl-magick::cl-magick-test) ) #+test (cl-magick::cl-magick-test) --- /project/cello/cvsroot/cello/cl-magick/cl-magick.asd 2006/05/17 16:14:29 NONE +++ /project/cello/cvsroot/cello/cl-magick/cl-magick.asd 2006/05/17 16:14:29 1.1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;(declaim (optimize (debug 2) (speed 1) (safety 1) (compilation-speed 1))) (declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0))) (in-package :asdf) #+(or allegro lispworks cmu mcl cormanlisp sbcl scl) (defsystem cl-magick :name "cl-magick" :author "Kenny Tilton <ktilton(a)nyc.rr.com>" :version "1.0.0" :maintainer "Kenny Tilton <ktilton(a)nyc.rr.com>" :licence "MIT" :description "Bindings for ImageMagick" :long-description "Poorly implemented bindings to half of ImageMagick" :components ((:file "cl-magick") (:file "magick-wand" :depends-on ("cl-magick")) (:file "drawing-wand" :depends-on ("magick-wand")) (:file "pixel-wand" :depends-on ("drawing-wand")) (:file "mgk-utils" :depends-on ("pixel-wand")) (:file "wand-image" :depends-on ("mgk-utils")) (:file "wand-texture" :depends-on ("wand-image")) (:file "wand-pixels" :depends-on ("wand-texture")) (:file "mgk-test" :depends-on ("wand-pixels")))) --- /project/cello/cvsroot/cello/cl-magick/cl-magick.lisp 2006/05/17 16:14:29 NONE +++ /project/cello/cvsroot/cello/cl-magick/cl-magick.lisp 2006/05/17 16:14:29 1.1 ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: cl-magick; -*- ;;; ;;; Copyright © 2004 by Kenneth William Tilton. ;;; ;;; Permission is hereby granted, free of charge, to any person obtaining a copy ;;; of this software and associated documentation files (the "Software"), to deal ;;; in the Software without restriction, including without limitation the rights ;;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell ;;; copies of the Software, and to permit persons to whom the Software is furnished ;;; to do so, subject to the following conditions: ;;; ;;; The above copyright notice and this permission notice shall be included in ;;; all copies or substantial portions of the Software. ;;; ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR ;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, ;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE ;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER ;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS ;;; IN THE SOFTWARE. (defpackage :cl-magick (:nicknames :mgk) (:use #:common-lisp #-(or cormanlisp ccl) #:clos #:hello-c #:ffx #+cl-opengl #:cl-opengl ;; wands as opengl textures ) (:export #:wand-manager #:wand-ensure-typed #:wands-clear #:wand-pixels #:wand-texture #:wand-render #:image-size #:wand-texture-activate #:xim #:magick-get-image-width #:magick-get-image-height #:magick-get-image-pixels #:new-magick-wand #:magick-read-image #:magick-flip-image #:wand-get-image-pixels #:path-to-wand #:mgk-wand-images-write #:magick-wand-template)) (eval-when (:compile-toplevel :load-toplevel :execute) (pushnew :cl-magick *features*)) (in-package :cl-magick) (defun magick-wand-template () (path-to-wand (make-pathname :directory '(:absolute "0dev" "user" "graphics" "templates") :name "metal" :type "gif"))) (defparameter *imagick-dll-loaded* nil) (defparameter *wands-loaded* nil) (defparameter *mgk-version* (fgn-alloc :unsigned-long 1)) (cffi:define-foreign-library Magick (:darwin (:framework "GraphicsMagick")) (:windows (:or #+not "C:\\Program Files\\ImageMagick-6.2.7-Q8\\CORE_RL_wand_.dll" "C:\\Program Files\\GraphicsMagick-1.1.7-Q8\\CORE_RL_wand_.dll"))) (eval-when (load eval) (cffi:use-foreign-library magick)) ;------------------------------------------------------------------- (defun cl-magick-init () (or *imagick-dll-loaded* (progn ;(print "clearing magick wands") ;(wands-clear) (assert (setq *imagick-dll-loaded* t #+not (cffi:use-foreign-library magick)) () "Unable to load imagick" ) (print `(magick-copyright ,(magick-get-copyright))) (print `(magick-version ,(magick-get-version *mgk-version*))) *imagick-dll-loaded*))) #+test (cl-magick-init) (defun wands-loaded () *wands-loaded*) (DEFUN (setf wands-loaded) (new-value) (setf *wands-loaded* new-value)) (defun wands-clear () (loop for wand in *wands-loaded* do (wand-release (cdr wand))) (setf *wands-loaded* nil)) (defun wand-ensure-typed (wand-type file-path$ &rest iargs) (when file-path$ (cl-magick-init) (let ((key (list* wand-type (namestring file-path$) iargs))) (or (let ((old nil #+nope (cdr (assoc key (wands-loaded) :test 'equal)))) ;;/// primitive test (when old (print `(wand-ensure-typed re-using prior load ,wand-type ,file-path$))) old) (let ((wi (apply 'make-instance wand-type :file-path$ file-path$ iargs))) (print `(wand-ensure-typed forced to load ,wand-type ,file-path$)) (push (cons key wi) (wands-loaded)) wi) (error "Unable to load image file ~a" file-path$))))) #+allegro (defun xim () (wands-clear) (dolist (dll (ff:list-all-foreign-libraries)) (when (search "wand" (pathname-name dll)) (print `(unloading foreign library ,dll)) (setf *imagick-dll-loaded* nil) (ff:unload-foreign-library dll)))) --- /project/cello/cvsroot/cello/cl-magick/cl-magick.lpr 2006/05/17 16:14:29 NONE +++ /project/cello/cvsroot/cello/cl-magick/cl-magick.lpr 2006/05/17 16:14:29 1.1 ;; -*- lisp-version: "8.0 [Windows] (May 5, 2006 15:39)"; cg: "1.81"; -*- (in-package :cg-user) (defpackage :CL-MAGICK) (define-project :name :cl-magick :modules (list (make-instance 'module :name "cl-magick.lisp") (make-instance 'module :name "magick-wand.lisp") (make-instance 'module :name "drawing-wand.lisp") (make-instance 'module :name "pixel-wand.lisp") (make-instance 'module :name "mgk-utils.lisp") (make-instance 'module :name "wand-image.lisp") (make-instance 'module :name "wand-texture.lisp") (make-instance 'module :name "wand-pixels.lisp")) :projects (list (make-instance 'project-module :name "..\\cl-opengl\\cl-opengl")) :libraries nil :distributed-files nil :internally-loaded-files nil :project-package-name :cl-magick :main-form nil :compilation-unit t :verbose nil :runtime-modules nil :splash-file-module (make-instance 'build-module :name "") :icon-file-module (make-instance 'build-module :name "") :include-flags '(:local-name-info) :build-flags '(:allow-debug :purify) :autoload-warning t :full-recompile-for-runtime-conditionalizations nil :default-command-line-arguments "+cx +t \"Initializing\"" :additional-build-lisp-image-arguments '(:read-init-files nil) :old-space-size 256000 :new-space-size 6144 :runtime-build-option :standard :on-initialization 'cl-magick::cl-magick-test :on-restart 'do-default-restart) ;; End of Project Definition --- /project/cello/cvsroot/cello/cl-magick/drawing-wand.lisp 2006/05/17 16:14:29 NONE +++ /project/cello/cvsroot/cello/cl-magick/drawing-wand.lisp 2006/05/17 16:14:29 1.1 ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: cl-magick; -*- ;;; ;;; Copyright © 2004 by Kenneth William Tilton. ;;; ;;; Permission is hereby granted, free of charge, to any person obtaining a copy ;;; of this software and associated documentation files (the "Software"), to deal ;;; in the Software without restriction, including without limitation the rights ;;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell ;;; copies of the Software, and to permit persons to whom the Software is furnished ;;; to do so, subject to the following conditions: ;;; ;;; The above copyright notice and this permission notice shall be included in ;;; all copies or substantial portions of the Software. ;;; ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR ;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, ;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE ;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER ;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS ;;; IN THE SOFTWARE. (in-package :cl-magick) ;;;/* ;;; ImageMagick Drawing Wand API. ;;;*/ ;;;#ifndef _MAGICK_DRAWING_WAND_H ;;;#define _MAGICK_DRAWING_WAND_H ;;; ;;;#if defined(__cplusplus) || defined(c_plusplus) ;;;extern "C" { ;;;#endif ;;; ;;;#include "wand/pixel_wand.h" ;;; ;;;typedef struct _DrawingWand ;;; *DrawContext ;;; DrawingWand; ;;; ;;;extern WandExport char ;;; *DrawGetClipPath( :void *DrawingWand) ;;; *DrawGetFont( :void *DrawingWand) ;;; *DrawGetFontFamily( :void *DrawingWand) ;;; *DrawGetTextEncoding( :void *DrawingWand); ;;; ;;;extern WandExport ClipPathUnits ;;; DrawGetClipUnits( :void *DrawingWand); ;;; ;;;extern WandExport DecorationType ;;; DrawGetTextDecoration( :void *DrawingWand); ;;; ;;;extern WandExport double ;;; DrawGetFillOpacity( :void *DrawingWand) ;;; DrawGetFontSize( :void *DrawingWand) ;;; *DrawGetStrokeDashArray( :void *DrawingWandunsigned long *) ;;; DrawGetStrokeDashOffset( :void *DrawingWand) ;;; DrawGetStrokeOpacity( :void *DrawingWand) ;;; DrawGetStrokeWidth( :void *DrawingWand); ;;; ;;;extern WandExport DrawInfo ;;; *DrawPeekGraphicContext( :void *DrawingWand); ;;; (defun-ffx (* :void) "imagick" "NewDrawingWand" ()) ;;;extern WandExport DrawingWand ;;; *DrawAllocateWand( DrawInfo *Image *) ;;; *NewDrawingWand(void); ;;; ;;;extern WandExport FillRule ;;; DrawGetClipRule( :void *DrawingWand) ;;; DrawGetFillRule( :void *DrawingWand); ;;; ;;;extern WandExport GravityType ;;; DrawGetGravity( :void *DrawingWand); ;;; ;;;extern WandExport LineCap ;;; DrawGetStrokeLineCap( :void *DrawingWand); ;;; ;;;extern WandExport LineJoin ;;; DrawGetStrokeLineJoin( :void *DrawingWand); ;;; ;;;extern WandExport StretchType ;;; DrawGetFontStretch( :void *DrawingWand); ;;; ;;;extern WandExport StyleType ;;; DrawGetFontStyle( :void *DrawingWand); ;;; ;;;extern WandExport :unsigned-int ;;; DrawGetStrokeAntialias( :void *DrawingWand) ;;; DrawGetTextAntialias( :void *DrawingWand) ;;; DrawRender( :void *DrawingWand); ;;; ;;;extern WandExport :unsigned-long ;;; DrawGetFontWeight( :void *DrawingWand) ;;; DrawGetStrokeMiterLimit( :void *DrawingWand); ;;; (ffx::defun-ffx-multi :void "imagick" ;;; DrawAffine(:void *DrawingWand AffineMatrix *) ;;; DrawAnnotation(:void *DrawingWand double double :unsigned-char *) ;;; DrawArc(:void *DrawingWand double double double double ;;; double double) ;;; DrawBezier(:void *DrawingWand :unsigned-long PointInfo *) ;;; DrawCircle(:void *DrawingWand double double double double) ;;; DrawColor(:void *DrawingWand double double PaintMethod) ;;; DrawComment(:void *DrawingWand char *) ;;; DestroyDrawingWand(:void *DrawingWand) "DrawEllipse" (:void *drawingwand :double ox :double oy :double rx :double ry :double start-angle :double end-angle) ;;; DrawComposite(:void *DrawingWand CompositeOperator double double ;;; double double Image *) ;;; DrawGetFillColor( :void *DrawingWandPixelWand *) ;;; DrawGetStrokeColor( :void *DrawingWandPixelWand *) ;;; DrawGetTextUnderColor( :void *DrawingWandPixelWand *) ;;; DrawLine(:void *DrawingWand double double double double) ;;; DrawMatte(:void *DrawingWand double double PaintMethod) ;;; DrawPathClose(:void *DrawingWand) ;;; DrawPathCurveToAbsolute(:void *DrawingWand double double double ;;; double double double) ;;; DrawPathCurveToRelative(:void *DrawingWand double double double ;;; double double double) ;;; DrawPathCurveToQuadraticBezierAbsolute(:void *DrawingWand double ;;; double double double) ;;; DrawPathCurveToQuadraticBezierRelative(:void *DrawingWand double ;;; double double double) ;;; DrawPathCurveToQuadraticBezierSmoothAbsolute(:void *DrawingWand double ;;; double) ;;; DrawPathCurveToQuadraticBezierSmoothRelative(:void *DrawingWand double ;;; double) ;;; DrawPathCurveToSmoothAbsolute(:void *DrawingWand double double ;;; double double) ;;; DrawPathCurveToSmoothRelative(:void *DrawingWand double double ;;; double double) ;;; DrawPathEllipticArcAbsolute(:void *DrawingWand double double ;;; double:unsigned-int:unsigned-int double double) ;;; DrawPathEllipticArcRelative(:void *DrawingWand double double ;;; double:unsigned-int:unsigned-int double double) ;;; DrawPathFinish(:void *DrawingWand) ;;; DrawPathLineToAbsolute(:void *DrawingWand double double) ;;; DrawPathLineToRelative(:void *DrawingWand double double) ;;; DrawPathLineToHorizontalAbsolute(:void *DrawingWand double) ;;; DrawPathLineToHorizontalRelative(:void *DrawingWand double) ;;; DrawPathLineToVerticalAbsolute(:void *DrawingWand double) ;;; DrawPathLineToVerticalRelative(:void *DrawingWand double) ;;; DrawPathMoveToAbsolute(:void *DrawingWand double double) ;;; DrawPathMoveToRelative(:void *DrawingWand double double) ;;; DrawPathStart(:void *DrawingWand) ;;; DrawPoint(:void *DrawingWand double double) ;;; DrawPolygon(:void *DrawingWand :unsigned-long PointInfo *) ;;; DrawPolyline(:void *DrawingWand :unsigned-long PointInfo *) ;;; DrawPopClipPath(:void *DrawingWand) ;;; DrawPopDefs(:void *DrawingWand) ;;; DrawPopGraphicContext(:void *DrawingWand) ;;; DrawPopPattern(:void *DrawingWand) ;;; DrawPushClipPath(:void *DrawingWand char *) ;;; DrawPushDefs(:void *DrawingWand) ;;; DrawPushGraphicContext(:void *DrawingWand) ;;; DrawPushPattern(:void *DrawingWand char * double double ;;; double double) ;;; DrawRectangle(:void *DrawingWand double double double ;;; double) ;;; DrawRotate(:void *DrawingWand double) ;;; DrawRoundRectangle(:void *DrawingWanddoubledoubledoubledoubledoubledouble) ;;; DrawScale(:void *DrawingWand double double) ;;; DrawSetClipPath(:void *DrawingWand char *) ;;; DrawSetClipRule(:void *DrawingWand FillRule) ;;; DrawSetClipUnits(:void *DrawingWand ClipPathUnits) ;;; DrawSetFillColor(:void *DrawingWand PixelWand *) ;;; DrawSetFillOpacity(:void *DrawingWand double) ;;; DrawSetFillRule(:void *DrawingWand FillRule) ;;; DrawSetFillPatternURL(:void *DrawingWand char *) ;;; DrawSetFont(:void *DrawingWand char *) ;;; DrawSetFontFamily(:void *DrawingWand char *) ;;; DrawSetFontSize(:void *DrawingWand double) ;;; DrawSetFontStretch(:void *DrawingWand StretchType) ;;; DrawSetFontStyle(:void *DrawingWand StyleType) ;;; DrawSetFontWeight(:void *DrawingWand :unsigned-long) ;;; DrawSetGravity(:void *DrawingWand GravityType) ;;; DrawSkewX(:void *DrawingWand double) ;;; DrawSkewY(:void *DrawingWand double) ;;; DrawSetStrokeAntialias(:void *DrawingWand :unsigned-int) ;;; DrawSetStrokeColor(:void *DrawingWand PixelWand *) ;;; DrawSetStrokeDashArray(:void *DrawingWand :unsigned-long double *) [21 lines skipped] --- /project/cello/cvsroot/cello/cl-magick/magick-wand.lisp 2006/05/17 16:14:29 NONE +++ /project/cello/cvsroot/cello/cl-magick/magick-wand.lisp 2006/05/17 16:14:29 1.1 [357 lines skipped] --- /project/cello/cvsroot/cello/cl-magick/mgk-utils.lisp 2006/05/17 16:14:29 NONE +++ /project/cello/cvsroot/cello/cl-magick/mgk-utils.lisp 2006/05/17 16:14:29 1.1 [457 lines skipped] --- /project/cello/cvsroot/cello/cl-magick/pixel-wand.lisp 2006/05/17 16:14:29 NONE +++ /project/cello/cvsroot/cello/cl-magick/pixel-wand.lisp 2006/05/17 16:14:29 1.1 [555 lines skipped] --- /project/cello/cvsroot/cello/cl-magick/wand-image.lisp 2006/05/17 16:14:29 NONE +++ /project/cello/cvsroot/cello/cl-magick/wand-image.lisp 2006/05/17 16:14:29 1.1 [665 lines skipped] --- /project/cello/cvsroot/cello/cl-magick/wand-pixels.lisp 2006/05/17 16:14:29 NONE +++ /project/cello/cvsroot/cello/cl-magick/wand-pixels.lisp 2006/05/17 16:14:29 1.1 [740 lines skipped] --- /project/cello/cvsroot/cello/cl-magick/wand-texture.lisp 2006/05/17 16:14:29 NONE +++ /project/cello/cvsroot/cello/cl-magick/wand-texture.lisp 2006/05/17 16:14:29 1.1 [875 lines skipped]

1 0

[cello-cvs] CVS cello/cl-ftgl
by ktilton 17 May '06

17 May '06

Update of /project/cello/cvsroot/cello/cl-ftgl In directory clnet:/tmp/cvs-serv22618/cl-ftgl Added Files: cl-ftgl.lisp cl-ftgl.lpr Log Message: CVS re-organization bringing auxiliary packages under one Cello module --- /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lisp 2006/05/17 16:14:29 NONE +++ /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lisp 2006/05/17 16:14:29 1.1 ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: cello; -*- ;;; ;;; Copyright © 2004 by Kenneth William Tilton. ;;;;; ;;; Permission is hereby granted, free of charge, to any person obtaining a copy ;;; of this software and associated documentation files (the "Software"), to deal ;;; in the Software without restriction, including without limitation the rights ;;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell ;;; copies of the Software, and to permit persons to whom the Software is furnished ;;; to do so, subject to the following conditions: ;;; ;;; The above copyright notice and this permission notice shall be included in ;;; all copies or substantial portions of the Software. ;;;; ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR ;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, ;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE ;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER ;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS ;;; IN THE SOFTWARE. ;;; $Header: /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lisp,v 1.1 2006/05/17 16:14:29 ktilton Exp $ (defpackage #:cl-ftgl (:nicknames #:ftgl) (:use #:common-lisp #:cffi #:cl-opengl) (:export #:ftgl #:ftgl-pixmap #:ftgl-texture #:ftgl-bitmap #:ftgl-polygon #:ftgl-extruded #:ftgl-outline #:ftgl-string-length #:ftgl-get-ascender #:ftgl-get-descender #:ftgl-make #:cl-ftgl-init #:cl-ftgl-reset #:xftgl #:ftgl-render #:ftgl-font-ensure #:*ftgl-dynamic-lib-path* #:*font-directory-path* #:*gui-style-default-face* #:*gui-style-button-face*)) (in-package :cl-ftgl) (define-foreign-library FTGL (:darwin (:framework "FTGL")) (:windows (:or "/0dev/user/dynlib/ftgl_dynamic_MTD_d.dll"))) (use-foreign-library FTGL) (defparameter *gui-style-default-face* 'sylfaen) (defparameter *ftgl-loaded-p* nil) (defparameter *ftgl-fonts-loaded* nil) ;; ---------------------------------------------------------------------------- ;; FOREIGN FUNCTION INTERFACE ;; ---------------------------------------------------------------------------- (defcfun ("fgcSetFaceSize" fgc-set-face-size) :unsigned-char (f :pointer)(size :int)(res :int)) (defcfun ("fgcCharTexture" fgc-char-texture) :int (f :pointer)(charCode :int)) (defcfun ("fgcAscender" fgc-ascender) :float (font :pointer)) (defcfun ("fgcDescender" fgc-descender) :float (font :pointer)) (defcfun ("fgcStringAdvance" fgc-string-advance) :float (font :pointer) (text :string)) (defcfun ("fgcStringX" fgc-string-x) :float (font :pointer)(text :string)) (defcfun ("fgcRender" fgc-render) :void (font :pointer)(text :string)) (defcfun ("fgcBuildGlyphs" fgc-build-glyphs) :void (font :pointer)) (defcfun ("fgcFree" fgc-free) :void (font :pointer)) (defcfun ("fgcBitmapMake" fgc-bitmap-make) :pointer (typeface :string)) (defcfun ("fgcPixmapMake" fgc-pixmap-make) :pointer (typeface :string)) (defcfun ("fgcTextureMake" fgc-texture-make) :pointer (typeface :string)) (defcfun ("fgcPolygonMake" fgc-polygon-make) :pointer (typeface :string)) (defcfun ("fgcOutlineMake" fgc-outline-make) :pointer (typeface :string)) (defcfun ("fgcExtrudedMake" fgc-extruded-make) :pointer (typeface :string)) (defcfun ("fgcSetFaceDepth" fgcSetFaceDepth) :unsigned-char (font :pointer)(depth :float)) (defun fgc-set-face-depth (font depth) (fgcSetFaceDepth font (coerce depth 'float))) (defparameter *font-directory-path* (make-pathname :directory #+(or win32 mswindows) '(:absolute "windows" "fonts") #+linux '(:absolute "usr" "share" "fonts" "truetype") #+darwin '(:absolute "Library" "Fonts"))) ;; ---------------------------------------------------------------------------- ;; FUNCTIONS/METHODS ;; ---------------------------------------------------------------------------- (defun cl-ftgl-reset () #-mcl (setq *ftgl-loaded-p* nil) (setq *ftgl-fonts-loaded* nil)) #+test (progn (cl-ftgl-init) (let ((sylfaen (ftgl-font-ensure :texture "Sylfaen" 24 96))) (print (list "sylfaen ascender" (ftgl-get-ascender sylfaen))) (print (list "sylfaen descender" (ftgl-get-descender sylfaen))) (print (list "sylfaen hello world length" (ftgl-string-length sylfaen "Hello world"))) (print (list "sylfaen disp font" (ftgl-get-display-font sylfaen))) )) (defun cl-ftgl-init () (unless *ftgl-loaded-p* (assert (setq *ftgl-loaded-p* (use-foreign-library ftgl))))) (defun ftgl-font-ensure (type face size target-res &optional (depth 0)) (let ((fspec (list type face size target-res depth))) (or (cdr (assoc fspec *ftgl-fonts-loaded* :test 'equal)) (let ((f (apply 'ftgl-make fspec))) (push (cons fspec f) *ftgl-fonts-loaded*) f)))) (defun ftgl-make (type face size target-res &optional (depth 0)) ;; (print (list "ftgl-make entry" type face size)) (funcall (ecase type (:bitmap 'make-ftgl-bitmap) (:pixmap 'make-ftgl-pixmap) (:texture 'make-ftgl-texture) (:outline 'make-ftgl-outline) (:polygon 'make-ftgl-polygon) (:extruded 'make-ftgl-extruded)) :face face :size size :target-res target-res :depth depth)) ;; --------- ftgl structure ----------------- (defstruct ftgl face size target-res depth descender ascender bboxes ifont) (defstruct (ftgl-disp (:include ftgl)) ready-p) (defstruct (ftgl-pixmap (:include ftgl-disp))) (defstruct (ftgl-texture (:include ftgl-disp))) (defstruct (ftgl-bitmap (:include ftgl))) (defstruct (ftgl-polygon (:include ftgl))) (defstruct (ftgl-extruded (:include ftgl-disp))) (defstruct (ftgl-outline (:include ftgl))) (defmethod ftgl-ready (font) (declare (ignorable font)) t) (defmethod (setf ftgl-ready) (new-value (font ftgl-disp)) (setf (ftgl-disp-ready-p font) new-value)) (defmethod (setf ftgl-ready) (new-value font) (declare (ignore new-value font))) (defmethod ftgl-ready ((font ftgl-disp)) ;(print (list "A cheerful HELLO from ftgl-ready: " font)) (ftgl-disp-ready-p font)) #+allegro (defun xftgl () (dolist (dll (ff:list-all-foreign-libraries)) (when (search "ftgl" (pathname-name dll)) (print `(unloading foreign library ,dll)) (ff:unload-foreign-library dll) (cl-ftgl-reset)))) (defun ftgl-get-ascender (font) (or (ftgl-ascender font) (setf (ftgl-ascender font) (fgc-ascender (ftgl-get-metrics-font font))))) (defun ftgl-get-descender (font) (or (ftgl-descender font) (setf (ftgl-descender font) (fgc-descender (ftgl-get-metrics-font font))))) (defun ftgl-get-display-font (font) (let ((cf (ftgl-get-metrics-font font))) (assert cf) ; (print (list "FTGL-GET-DISPLAY-FONT sees" (ftgl-disp-ready-p font))) ;; (print (list "FTGL-GET-DISPLAY-FONT sees" (ftgl-ready font))) (Unless (ftgl-ready font) ; (when *ogl-listing-p* ; (cells::c-break "bad time #1 for sizing? ~a ~a" *ogl-listing-p* font)) (setf (ftgl-ready font) t) (typecase font (ftgl-extruded #+nyet (let ((*ogl-listing-p* t)) (ukt::trc nil "ftgl-get-display-font> building glyphs for" font) (fgc-build-glyphs cf) (ukt::trc nil "ftgl-get-display-font> glyphs built OK for" font))) (ftgl-texture #+no (fgc-set-face-size cf (ftgl-size font) (ftgl-target-res font))) (ftgl-pixmap #+no (fgc-set-face-size cf (ftgl-size font) (ftgl-target-res font))))) cf)) (defun ftgl-get-metrics-font (font) (prog1 (or (ftgl-ifont font) (setf (ftgl-ifont font) (ftgl-font-make font))) ;; (print (list "ftgl-get-metrics-font: exit" font)) ; frgo, ADDED: debug... )) (defun ftgl-font-make (font) ;; (print (list "ftgl-font-make: entry" font)) (let ((path (merge-pathnames (make-pathname :name (string (ftgl-face font)) :type "ttf") *font-directory-path*))) (if (probe-file path) (let* ((fpath (namestring path)) (f (fgc-font-make font fpath))) (if f (progn ;;(ogl::dump-lists 1 10000) (fgc-set-face-size f (ftgl-size font) (ftgl-target-res font)) f) (error "cannot load ~a font ~a" (type-of font) fpath))) (error "Font not found: ~a" path)))) (defun ftgl-render (font s) (assert font) (assert (stringp s)) (when font (let ((df (ftgl-get-display-font font))) (if df (fgc-render df s) (break "whoa, no display font for ~a" font))))) (defmethod fgc-font-make :before (font fpath) (declare (ignore font fpath)) (cl-ftgl-init)) (defmethod fgc-font-make ((font ftgl-pixmap) fpath) (fgc-pixmap-make fpath)) (defmethod fgc-font-make ((font ftgl-bitmap) fpath) (fgc-bitmap-make fpath)) (defmethod fgc-font-make ((font ftgl-texture) fpath) (fgc-texture-make fpath)) (defmethod fgc-font-make ((font ftgl-extruded) fpath) (let ((fgc (fgc-extruded-make fpath))) (fgc-set-face-depth fgc (ftgl-depth font)) fgc)) (defmethod fgc-font-make ((font ftgl-outline) fpath) (fgc-outline-make fpath)) (defmethod fgc-font-make ((font ftgl-polygon) fpath) (fgc-polygon-make fpath)) (defun ftgl-string-length (font cs) (fgc-string-advance (ftgl-get-metrics-font font) cs)) (defmethod font-bearing-x ((font ftgl) &optional (text "m")) (fgc-string-x (ftgl-get-metrics-font font) text)) (defmethod font-bearing-x (font &optional text) (declare (ignorable font text)) 0) --- /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lpr 2006/05/17 16:14:29 NONE +++ /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lpr 2006/05/17 16:14:29 1.1 ;; -*- lisp-version: "8.0 [Windows] (Apr 21, 2006 10:24)"; cg: "1.81"; -*- (in-package :cg-user) (defpackage :CL-FTGL) (define-project :name :cl-ftgl :modules (list (make-instance 'module :name "cl-ftgl.lisp")) :projects (list (make-instance 'project-module :name "C:\\0devtools\\cl-opengl\\cl-opengl")) :libraries nil :distributed-files nil :internally-loaded-files nil :project-package-name :cl-ftgl :main-form nil :compilation-unit t :verbose nil :runtime-modules '(: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 '(:compiler :top-level :local-name-info) :build-flags '(:allow-debug :purify) :autoload-warning t :full-recompile-for-runtime-conditionalizations nil :default-command-line-arguments "+cx +t \"Initializing\"" :additional-build-lisp-image-arguments '(:read-init-files nil) :old-space-size 256000 :new-space-size 6144 :runtime-build-option :standard :on-initialization 'cl-ftgl::cl-ftgl-test :on-restart 'do-default-restart) ;; End of Project Definition

1 0

[cello-cvs] CVS cello/cellodemo
by ktilton 17 May '06

17 May '06

Update of /project/cello/cvsroot/cello/cellodemo In directory clnet:/tmp/cvs-serv22618/cellodemo Modified Files: cellodemo.lisp cellodemo.lpr demo-window.lisp light-panel.lisp Log Message: CVS re-organization bringing auxiliary packages under one Cello module --- /project/cello/cvsroot/cello/cellodemo/cellodemo.lisp 2005/07/05 17:00:29 1.1 +++ /project/cello/cvsroot/cello/cellodemo/cellodemo.lisp 2006/05/17 16:14:28 1.2 @@ -23,7 +23,7 @@ (in-package :cello) -#+test +#+(or) (list (demo-image-subdir "shapers") (demo-image-subdir)) --- /project/cello/cvsroot/cello/cellodemo/cellodemo.lpr 2005/07/05 17:00:29 1.1 +++ /project/cello/cvsroot/cello/cellodemo/cellodemo.lpr 2006/05/17 16:14:28 1.2 @@ -1,4 +1,4 @@ -;; -*- lisp-version: "7.0 [Windows] (May 6, 2005 8:25)"; cg: "1.54.2.17"; -*- +;; -*- lisp-version: "7.0 [Windows] (Aug 5, 2005 12:23)"; cg: "1.54.2.17"; -*- (in-package :cg-user) --- /project/cello/cvsroot/cello/cellodemo/demo-window.lisp 2005/07/05 17:00:29 1.1 +++ /project/cello/cvsroot/cello/cellodemo/demo-window.lisp 2006/05/17 16:14:28 1.2 @@ -128,7 +128,7 @@ :ambient *dusk* :diffuse *dim* :specular *bright*)) - :recording nil #+not (c? (when (md-value (fm-other :record)) + :recording nil #+(or) (c? (when (md-value (fm-other :record)) (make-recording :wand (magick-wand-template) :splice-wand (magick-wand-template) @@ -264,6 +264,7 @@ (setf (snapshot-release-id .w.) (incf snap-count)))))))) + (defun texture-picker (&aux (backdrops (directory (demo-image-subdir "window-bkgs")))) --- /project/cello/cvsroot/cello/cellodemo/light-panel.lisp 2005/07/05 17:00:29 1.1 +++ /project/cello/cvsroot/cello/cellodemo/light-panel.lisp 2006/05/17 16:14:28 1.2 @@ -203,7 +203,7 @@ (defmodel ix-light (light ix-stack) ((initial-pos :initarg :initial-pos :initform nil :accessor initial-pos)) (:default-initargs - :md-value nil #+not (c? (when (md-value (fm-other :enabled)) + :md-value nil #+(or) (c? (when (md-value (fm-other :enabled)) (make-instance 'light :id id))) :enabled (c? (md-value (fm-other :enabled))) @@ -266,4 +266,4 @@ (make-rgba-mixer :diffuse)) (a-stack (:justify :right :visible nil :collapsed t) (alabel "specular") - (make-rgba-mixer :specular)))))) \ No newline at end of file + (make-rgba-mixer :specular))))))

1 0

[cello-cvs] CVS cello/cl-ftgl/ftgl-int
by ktilton 17 May '06

17 May '06

Update of /project/cello/cvsroot/cello/cl-ftgl/ftgl-int In directory clnet:/tmp/cvs-serv22541/ftgl-int Log Message: Directory /project/cello/cvsroot/cello/cl-ftgl/ftgl-int added to the repository

1 0

[cello-cvs] CVS cello/cl-opengl
by ktilton 17 May '06

17 May '06

Update of /project/cello/cvsroot/cello/cl-opengl In directory clnet:/tmp/cvs-serv20661/cl-opengl Log Message: Directory /project/cello/cvsroot/cello/cl-opengl added to the repository

1 0

[cello-cvs] CVS cello/cl-openal
by ktilton 17 May '06

17 May '06

Update of /project/cello/cvsroot/cello/cl-openal In directory clnet:/tmp/cvs-serv20661/cl-openal Log Message: Directory /project/cello/cvsroot/cello/cl-openal added to the repository

1 0

[cello-cvs] CVS cello/cl-magick
by ktilton 17 May '06

17 May '06

Update of /project/cello/cvsroot/cello/cl-magick In directory clnet:/tmp/cvs-serv20661/cl-magick Log Message: Directory /project/cello/cvsroot/cello/cl-magick added to the repository

1 0

[cello-cvs] CVS cello/cl-ftgl
by ktilton 17 May '06

17 May '06

Update of /project/cello/cvsroot/cello/cl-ftgl In directory clnet:/tmp/cvs-serv20164/cl-ftgl Log Message: Directory /project/cello/cvsroot/cello/cl-ftgl added to the repository

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

cello-cvs