[bknr-cvs] ksprotte changed trunk/projects/bos/

BKNR Commits bknr at bknr.net
Wed Jul 30 13:18:21 UTC 2008


Revision: 3695
Author: ksprotte
URL: http://bknr.net/trac/changeset/3695

working on new m2 poi schema; cleaned up exprted poi symbols
U   trunk/projects/bos/m2/packages.lisp
U   trunk/projects/bos/m2/poi.lisp
U   trunk/projects/bos/test/bos.test.asd
U   trunk/projects/bos/test/suites.lisp

Modified: trunk/projects/bos/m2/packages.lisp
===================================================================
--- trunk/projects/bos/m2/packages.lisp	2008-07-30 11:21:33 UTC (rev 3694)
+++ trunk/projects/bos/m2/packages.lisp	2008-07-30 13:18:21 UTC (rev 3695)
@@ -200,47 +200,40 @@
            #:allocation-area-percent-used
            #:left #:top #:width #:height #:active-p
 
-           ;; pois
-           #:*current-language*
+           ;; slot-strings
            #:slot-string
            #:set-slot-string-values
-
+                      
+           ;; pois
+           #:title #:subtitle #:description ; for slot-string access
+           #:update-textual-attributes
+           #:poi-medium
+           #:poi-medium-poi
+           #:make-poi-medium
            #:poi-image
-           #:poi-image-poi
-           #:poi-image-title
-           #:poi-image-subtitle
-           #:poi-image-description
-           #:poi-airals
-           #:airals
-           #:poi-panoramas
-           #:panoramas
-           #:poi-movies
-           #:movies
+           #:poi-airal
+           #:poi-panorama
            #:poi-movie
-           #:poi-movie-poi
            #:poi-movie-url
-           #:make-poi-image
-           #:update-poi-image
            #:poi
            #:poi-name
+           #:find-poi
+           #:all-pois
            #:poi-published
-           #:poi-title
-           #:poi-subtitle
-           #:poi-description
            #:poi-area
            #:poi-icon
-           #:poi-images
-           #:poi-complete
-           #:title #:subtitle #:description ; for slot-string access
+           #:poi-media
            #:make-poi
-           #:update-poi
-           #:find-poi
-
+           #:poi-complete
            #:poi-center-x
            #:poi-center-y
            #:poi-center-lon-lat
+           #:poi-images
+           #:poi-airals
+           #:poi-panoramas
+           #:poi-movies
            #:make-poi-javascript
-
+           
            ;; news
            #:news-item
            #:make-news-item

Modified: trunk/projects/bos/m2/poi.lisp
===================================================================
--- trunk/projects/bos/m2/poi.lisp	2008-07-30 11:21:33 UTC (rev 3694)
+++ trunk/projects/bos/m2/poi.lisp	2008-07-30 13:18:21 UTC (rev 3695)
@@ -8,13 +8,13 @@
 ;;; POI-Anwendungsklassen und Konstruktoren
 
 ;;; textual-attributes-mixin
-(define-persistent-class textual-attributes-mixin ()
-  ((title :update :initform (make-string-hash-table)
-                  :documentation "Angezeigter Name")
-   (subtitle :update :initform (make-string-hash-table)
-                     :documentation "Unterschrift")
-   (description :update :initform (make-string-hash-table)
-                        :documentation "Beschreibungstext")))
+(defpersistent-class textual-attributes-mixin ()
+  ((title :initform (make-string-hash-table)
+          :documentation "angezeigter name")
+   (subtitle :initform (make-string-hash-table)
+             :documentation "unterschrift")
+   (description :initform (make-string-hash-table)
+                :documentation "beschreibungstext")))
 
 (deftransaction update-textual-attributes (obj language &key title subtitle description)
   (when title
@@ -22,11 +22,12 @@
   (when subtitle
     (setf (slot-string obj 'subtitle language) subtitle))
   (when description
-    (setf (slot-string obj 'description language) description)))
+    (setf (slot-string obj 'description language) description))
+  obj)
 
 ;;; poi-medium
-(define-persistent-class poi-medium (textual-attributes-mixin)
-  ((poi :read)))
+(defpersistent-class poi-medium (textual-attributes-mixin)
+  ((poi :reader poi-medium-poi :initarg :poi)))
 
 (deftransaction make-poi-medium (class-name &rest rest &key language title subtitle description poi initargs)
   (declare (ignore poi initargs))
@@ -53,30 +54,40 @@
       (setf (poi-media poi) (remove poi-medium (poi-media poi))))))
 
 ;;; poi-image
-(define-persistent-class poi-image (store-image poi-medium)
+(defpersistent-class poi-image (store-image poi-medium)
   ())
 
 ;;; poi-airal
-(define-persistent-class poi-airal (store-image poi-medium)
+(defpersistent-class poi-airal (store-image poi-medium)
   ())
 
 ;;; poi-panorama
-(define-persistent-class poi-panorama (store-image poi-medium)
+(defpersistent-class poi-panorama (store-image poi-medium)
   ())
 
 ;;; poi-movie
-(define-persistent-class poi-movie (poi-medium)
-  ((url :update :initform nil)))
+(defpersistent-class poi-movie (poi-medium)
+  ((url :accessor poi-movie-url :initarg :url :initform nil)))
 
 ;;; poi
-(define-persistent-class poi (textual-attributes-mixin)
-  ((name :read :index-type string-unique-index
-               :index-reader find-poi :index-values all-pois
-               :documentation "Symbolischer Name")
-   (published :update :initform nil :documentation "Wenn dieses Flag NIL ist, wird der POI in den UIs nicht angezeigt")
-   (area :update :initform nil :documentation "Polygon mit den POI-Koordinaten")
-   (icon :update :initform "palme" :documentation "Name des Icons")
-   (media :update :initform nil :documentation "Liste aller POI-Medien, wie POI-IMAGE, POI-AIRAL ...")))
+(defpersistent-class poi (textual-attributes-mixin)  
+  ((name
+    :reader poi-name :initarg :name
+    :index-type string-unique-index
+    :index-reader find-poi :index-values all-pois
+    :documentation "symbolischer name")
+   (published
+    :accessor poi-published :initarg :published :initform nil
+    :documentation "wenn dieses flag nil ist, wird der poi in den uis nicht angezeigt")
+   (area
+    :accessor poi-area :initarg :area :initform nil
+    :documentation "polygon mit den poi-koordinaten")
+   (icon
+    :accessor poi-icon :initarg :icon :initform "palme"
+    :documentation "name des icons")
+   (media
+    :accessor poi-media :initarg :media :initform nil
+    :documentation "liste aller poi-medien, wie poi-image, poi-airal ...")))
 
 (deftransaction make-poi (language name &key title description area)
   (let ((poi (make-object 'poi :name name :area area)))

Modified: trunk/projects/bos/test/bos.test.asd
===================================================================
--- trunk/projects/bos/test/bos.test.asd	2008-07-30 11:21:33 UTC (rev 3694)
+++ trunk/projects/bos/test/bos.test.asd	2008-07-30 13:18:21 UTC (rev 3695)
@@ -1,18 +1,20 @@
-        (in-package :cl-user)
+;; -*- Lisp -*-
+(in-package :cl-user)
 
-        (asdf:defsystem :bos.test
-          :description "BOS Online-System test-suite"
-            :depends-on (:bos.web :fiveam :drakma)
-              :components ((:file "package")
-                             (:file "suites" :depends-on ("package"))
-                                            (:file "fixtures" :depends-on ("package"))
-                                                           (:file "allocation" :depends-on ("suites" "fixtures"))
-                                                                          (:file "geometry" :depends-on ("suites"))
-                                                                                         (:file "geo-utm" :depends-on ("suites"))
-                                                                                                        ;; (:file "utils" :depends-on ("config"))
-                                                                                                                       (:module :web
-                                                                                                                                               :depends-on ("suites" "fixtures")
-                                                                                                                                                                       :components
-                                                                                                                                                                                               ((:file "drakma-requests")
-                                                                                                                                                                                                                        (:file "quad-tree")
-                                                                                                                                                                                                                                                 (:file "sat-tree")))))
+(asdf:defsystem :bos.test
+  :description "BOS Online-System test-suite"
+  :depends-on (:bos.web :fiveam :drakma)
+  :components ((:file "package")
+               (:file "suites" :depends-on ("package"))
+               (:file "fixtures" :depends-on ("package"))
+               (:file "allocation" :depends-on ("suites" "fixtures"))
+               (:file "geometry" :depends-on ("suites"))
+               (:file "geo-utm" :depends-on ("suites"))
+               (:file "poi" :depends-on ("suites"))
+               ;; (:file "utils" :depends-on ("config"))
+               (:module :web
+                        :depends-on ("suites" "fixtures")
+                        :components
+                        ((:file "drakma-requests")
+                         (:file "quad-tree")
+                         (:file "sat-tree")))))

Modified: trunk/projects/bos/test/suites.lisp
===================================================================
--- trunk/projects/bos/test/suites.lisp	2008-07-30 11:21:33 UTC (rev 3694)
+++ trunk/projects/bos/test/suites.lisp	2008-07-30 13:18:21 UTC (rev 3695)
@@ -7,6 +7,9 @@
     :in :bos.test
     :description "Tests for everything about allocation, including the allocation-cache.")
 
+(def-suite :bos.test.poi
+    :in :bos.test)
+
 (def-suite :bos.test.geometry
     :in :bos.test
     :description "Tests for the small geometry helper package.")




More information about the Bknr-cvs mailing list