Changeset 12366 in project


Ignore:
Timestamp:
11/05/08 23:32:19 (13 years ago)
Author:
sjamaan
Message:

Port phoghorn to Chicken 4. Not completely finished yet; URL encoding/decoding is broken right now, but that's something to fix in another library that will use uri-generic internally, or sth

Location:
release/4/phoghorn
Files:
2 deleted
3 edited
1 copied

Legend:

Unmodified
Added
Removed
  • release/4/phoghorn/phoghorn.meta

    r3630 r12366  
    77 (category web)
    88 (license "BSD")
    9  (needs spiffy spiffy-utils url epeg imlib2 sxml-transforms)
    10  (files "phoghorn.scm" "phoghorn.setup" "phoghorn-eggdoc.scm" "phoghorn.html"))
     9 (doc-from-wiki)
     10 (needs spiffy uri-generic epeg imlib2 sxml-transforms)
     11 (files "phoghorn.scm" "phoghorn.setup" "phoghorn.html"))
  • release/4/phoghorn/phoghorn.scm

    r10549 r12366  
    11;;; phoghorn - Image gallery library
    22;
    3 ; Version 2.2
     3; Version 2.3
    44;
    55; Copyright (c) 2005-2008 Peter Bex (Peter.Bex@xs4all.nl)
     
    3030; SUCH DAMAGE.
    3131
    32 (declare
    33  (uses utils srfi-13)
    34  (export gallery-dir gallery-var entry-var root-gallery-name
    35          max-thumb-dimensions thumb-dir gallery-url zoomed-url movie-image
    36          gallery-contents thumbnail thumbnail/epeg thumbnail/imlib2
    37          galleries-up-to prev-entry next-entry phoghorn-rules))
    38 
    39 (use spiffy-utils sxml-transforms srfi-8 epeg imlib2)
     32(module phoghorn
     33 (gallery-dir gallery-var entry-var root-gallery-name
     34  max-thumb-dimensions thumb-dir gallery-url zoomed-url movie-image
     35  current-gallery current-entry-filename gallery-contents
     36  thumbnail thumbnail/epeg thumbnail/imlib2
     37  galleries-up-to prev-entry next-entry phoghorn-rules)
     38
     39(import chicken scheme extras data-structures files posix)
     40(require-extension srfi-1 srfi-13 spiffy intarweb uri-generic
     41                   sxml-transforms)
     42
     43(require-library epeg)
     44(import (prefix epeg epeg:))
     45(require-library imlib2)
     46(import (prefix imlib2 imlib2:))
    4047
    4148;; Config
     
    7582        ((conjoin file-read-access? file-execute-access?) thumbdir))))
    7683
     84(define (current-gallery)
     85  (alist-ref (gallery-var) (or (uri-query (request-uri (current-request))) '())
     86             string=?))
     87
     88(define (current-entry-filename)
     89  (alist-ref (entry-var) (or (uri-query (request-uri (current-request))) '())
     90             string=?))
     91
     92(define (link-to path attribs)
     93  (if (null? attribs)
     94      path
     95      (string-append path "?" (string-join (map (lambda (v)
     96                                                  (sprintf "~A=~A"
     97                                                   (uri-encode-string (car v))
     98                                                   (uri-encode-string (cdr v))))
     99                                                attribs) "&"))))
     100
    77101(define (gallery-contents)
    78   (let* ((dir (local-file (get-var (gallery-var)) #f))
     102  (let* ((dir (local-file (current-gallery) #f))
    79103         (contents (map (cut make-pathname dir <>) (directory dir))))
    80104    (unless (thumbs-ok? dir)
     
    136160  (need-access
    137161   (if filename
    138        (make-pathname (list (spiffy-root-path) (current-workdir) (gallery-dir) gallery) filename)
    139        (make-pathname (list (spiffy-root-path) (current-workdir) (gallery-dir)) gallery))))
     162       (make-pathname (list (root-path)
     163                            (pathname-directory (current-file))
     164                            (gallery-dir)
     165                            gallery)
     166                      filename)
     167       (make-pathname (list (root-path)
     168                            (pathname-directory (current-file))
     169                            (gallery-dir))
     170                      gallery))))
    140171
    141172(define (gallery-thumbs gallery)
     
    145176  (let ((target-file (local-file (gallery-thumbs gallery) entry)))
    146177    (unless (file-exists? target-file)
    147       (let ((img (epeg:file-open (local-file gallery entry))))
     178      (let ((img (epeg:image-open (local-file gallery entry))))
    148179        (receive (width height)
    149              (epeg:size-get img)
    150           (epeg:decode-size-set! img
     180             (epeg:image-size img)
     181          (epeg:image-size-set! img
    151182                                 (thumb-width width height)
    152183                                 (thumb-height width height))
    153           (epeg:file-output-set! img target-file)
    154           (epeg:encode img)))))
     184          (epeg:image-file-output-set! img target-file)
     185          (epeg:image-encode img)))))
    155186  (remote-file (gallery-thumbs gallery) entry))
    156187
     
    164195                                 (pathname-replace-extension entry "png"))))
    165196    (unless (file-exists? target-file)
    166             (let* ((img    (imlib:load (local-file gallery entry)))
    167                    (width  (imlib:width  img))
    168                    (height (imlib:height img))
    169                    (thumb  (imlib:scale img
     197            (let* ((img    (imlib2:image-load (local-file gallery entry)))
     198                   (width  (imlib2:image-width  img))
     199                   (height (imlib2:image-height img))
     200                   (thumb  (imlib2:image-scale img
    170201                                        (thumb-width width height)
    171202                                        (thumb-height width height))))
    172               (imlib:save thumb target-file))))
     203              (imlib2:image-save thumb target-file))))
    173204  (remote-file (gallery-thumbs gallery)
    174205               (pathname-replace-extension entry "png")))
     
    201232             (gallery-contents)
    202233          `(div (@ (class "phoghorn"))
    203                 (phoghorn-breadcrumbs ,(get-var (gallery-var)))
     234                (phoghorn-breadcrumbs ,(current-gallery))
    204235                (gallery-list ,galleries)
    205236                (gallery-entries ,entries)))))
     
    221252               ,(map (lambda (e)
    222253                       `(gallery-entry
    223                          ,(get-var (gallery-var))
     254                         ,(current-gallery)
    224255                         ,(pathname-strip-directory e)))
    225256                     entries)))))
     
    231262                   ,@(map (lambda (e)
    232263                            `(li (gallery-link
    233                                   ,(make-pathname (get-var (gallery-var))
     264                                  ,(make-pathname (current-gallery)
    234265                                                  (pathname-strip-directory e)))))
    235266                          galleries)))))
     
    260291             (gallery-contents)
    261292          (let* ((entries (map pathname-strip-directory full-entries))
    262                  (next (next-entry (get-var (entry-var)) entries))
    263                  (prev (prev-entry (get-var (entry-var)) entries)))
     293                 (next (next-entry (current-gallery) entries))
     294                 (prev (prev-entry (current-gallery) entries)))
    264295            `(div (@ (class "phoghorn"))
    265296                  (phoghorn-breadcrumbs
    266                    ,(make-pathname (get-var (gallery-var))
    267                                    (pathname-strip-extension (get-var (entry-var)))))
     297                   ,(make-pathname (current-gallery)
     298                                   (pathname-strip-extension (current-entry-filename))))
    268299                  (entry-navigation ,next ,prev)
    269                   (zoomed-picture ,(get-var (gallery-var)) ,(get-var (entry-var)))
     300                  (zoomed-picture ,(current-gallery) ,(current-entry-filename))
    270301                  (entry-navigation ,next ,prev))))))
    271302    (entry-navigation *macro* .
     
    277308                                  (zoomed-url)
    278309                                  `((,(entry-var) . ,prev)
    279                                     (,(gallery-var) . ,(get-var (gallery-var)))))
     310                                    (,(gallery-var) . ,(current-gallery))))
    280311                                "prev")
    281312                          "prev"))
     
    285316                                  (zoomed-url)
    286317                                  `((,(entry-var) . ,next)
    287                                     (,(gallery-var) . ,(get-var (gallery-var)))))
     318                                    (,(gallery-var) . ,(current-gallery))))
    288319                                "next")
    289320                          "next")))))
     
    297328    (*text* . ,(lambda (tag str) str))
    298329    (*default* . ,(lambda x x))))
     330)
  • release/4/phoghorn/phoghorn.setup

    r1 r12366  
    1 (run (csc -s -O2 -R syntax-case -run-time-macros -d0 phoghorn.scm))
     1(compile -s -O2 phoghorn.scm -j phoghorn)
     2(compile -s -O2 phoghorn.import.scm)
    23
    3 (install-extension 'phoghorn '("phoghorn.so"))
     4(install-extension
     5  'phoghorn
     6  '("phoghorn.so" "phoghorn.import.so")
     7  `((version 2.3)
     8    (documentation "phoghorn.html")))
Note: See TracChangeset for help on using the changeset viewer.