* Re: SVG gauges in Emacs
2010-01-18 18:48 ` SVG gauges in Emacs (was: SVG insert creates newlines) Ted Zlatanov
@ 2010-01-18 19:38 ` joakim
2010-02-01 18:18 ` Ted Zlatanov
0 siblings, 1 reply; 4+ messages in thread
From: joakim @ 2010-01-18 19:38 UTC (permalink / raw)
To: Ted Zlatanov; +Cc: emacs-devel
[-- Attachment #1: Type: text/plain, Size: 912 bytes --]
Ted Zlatanov <tzz@lifelogs.com> writes:
> On Mon, 18 Jan 2010 12:26:13 -0600 Ted Zlatanov <tzz@lifelogs.com> wrote:
>
> TZ> I'm trying to set up gauges in Gnus that will show article counts
> TZ> graphically with SVG. Is there any documentation or help for the Emacs
> TZ> SVG support? `C-h a svg' shows nothing.
>
> TZ> If SVG is not the right way, what's the best way to create a graphical
> TZ> gauge to indicate something is N% full (ideally with gradients and text
> TZ> overlay capabilities)?
There are some old threads about the SVG support.
I have some different elisp SVG hacks. Maybe the attached "dragbox.el"
can be of help. It allows one to draw a box in an image interactively,
so its somewhat like drawing a gauge.
>
> Also please forgive my strange message subject (changed here). I was
> writing another message originally and forgot to change the subject.
>
> Ted
>
>
--
Joakim Verona
[-- Attachment #2: dragbox.el --]
[-- Type: text/plain, Size: 11547 bytes --]
;;; dragbox.el --- draw a bounding box interactively
;;; Commentary:
;; Draw a bounding box on an image interactively.
;; Use m-x dragbox-start to try it out, enter a the name of an image
;; file compatible with SVG, such as jpg or png.
;; Then mark the upper left corner with the left mouse button.
;; Mark the lower right corner with the right mouse button.
;; The bounding box will be drawn as a grey rectangle over the
;; image. This requires an Emacs compiled with SVG support.
;; An ocr application of the bounding box is included,
;; which will require tesseract, gocr, or ocrad installed.
;; for instance, select an image region as per above, then do:
;; m-x dragbox-ocr-gocr-image-region
;; if everything works as it should,
;; the image region should be ocr:ed and the text shown in the
;; message area. The ocr:ed text will also be put in the kill ring.
;; Please not that this is only alpha quality, feedback appreciated.
;; Author: Joakim Verona, (C) FSF 2009, GPL
;;; History:
;;
;; TODO
;; - support more than one session probably with buffer local variables
;; - use imagemagick to convert the entered file name to something compatible with svg
;; - url encode img name properly to avoid file name encoding issues
;; - some type of local minor mode so as not to pollute image-mode
;; - unbind mouse up events in this mode
;; - this code is meant as an api for emacs apps wanting interactive bounding boxes,
;; so provide nice api:
;; - dragbox-start image-file ; start interactive box finding
;; - dragbox-get-box ; get the actual box coords
;; - return image coords rather than svg coords
;; - maybe some "done" callback for clients to use
;; - set moise pointer to "arrow" over image
;; futureish:
;; - support zooming in the image for better placing of box
;; - investigate MON KEY:s idea to use artist.el
;; - ability to define a set of boxes, for ocr
;; - be able to draw a line in the image as a guide for deskewing
(require 'image-mode)
(require 'xml)
(if (not (image-type-available-p 'svg))
(error "No svg support available!"))
;;; Code:
;;Image size. currently calculated from the image we are working with
(defvar dragbox-image-width 0)
(defvar dragbox-image-height 0)
(defvar dragbox-x1y1 '(0 . 0) "Top left corner of bounding box.")
(defvar dragbox-x2y2 '(100 . 100) "Bottom right corner.")
(defvar dragbox-image-url "" "Which image to work with.")
(defun dragbox-make-image-url (image-file)
(if
(string-match "\\(\\.png\\'\\)\\|\\(\\.jpg\\'\\)" image-file)
(concat "file://" (expand-file-name image-file))
(progn
(call-process-shell-command (format "convert %s /tmp/xxx.png" image-file))
(concat "file://" (expand-file-name "/tmp/xxx.png"))
)))
(defun dragbox-start (image-file box-do-callback)
"Start here with an IMAGE-FILE suitable for svg embedding.
execute BOX-DO-callback on middle-mouse(for instance)
"
(interactive "fImage file:")
(get-buffer-create "*dragbox*")
(switch-to-buffer "*dragbox*")
(setq dragbox-image-url (dragbox-make-image-url image-file))
(setq dragbox-image-width (car (dragbox-image-size dragbox-image-url)))
(setq dragbox-image-height (cdr (dragbox-image-size dragbox-image-url)))
(setq dragbox-action-callback box-do-callback)
(dragbox-update-box-from-state))
(defun dragbox-make-svg-data (x y width height image-url)
"Return svg describing a image file with a bounding box on top.
X Y WIDTH HEIGHT describes the box, IMAGE-URL which image to draw on."
`((svg
((xmlns:xlink . "http://www.w3.org/1999/xlink")
(xmlns . "http://www.w3.org/2000/svg")
(width . ,(number-to-string dragbox-image-width))
(height . ,(number-to-string dragbox-image-height)))
(g
((id . "layer1"))
(rect
((style . "fill:#cfcfcf;fill-opacity:1")
(width . ,(number-to-string dragbox-image-width))
(height . ,(number-to-string dragbox-image-height))
(x . "0")
(y . "0")))
(image ((y . "0")
(x . "0")
(width . ,(number-to-string dragbox-image-width))
(height . ,(number-to-string dragbox-image-height))
(xlink:href . ,image-url)
))
(rect
((style . "color:#000000;fill:#000000;fill-opacity:0.5;fill-rule:nonzero;stroke:#000000;stroke-width:1;marker:none;visibility:visible;display:inline;overflow:visible;enable-background:accumulate;stroke-opacity:0.5")
(id . "dragbox")
(width . , (number-to-string width) )
(height . ,(number-to-string height))
(x . ,(number-to-string x))
(y . ,(number-to-string y))))
))))
(defun dragbox-lmb-click-handler ()
"Set upper left coords for bounding box."
(interactive)
(setq dragbox-x1y1 (dragbox-extract-event-coords last-input-event))
(dragbox-update-box-from-state)
)
(defun dragbox-rmb-click-handler ()
"Set lower right coords for bounding box."
(interactive)
(setq dragbox-x2y2 (dragbox-extract-event-coords last-input-event))
(dragbox-update-box-from-state)
)
(defun dragbox-mmb-click-handler ()
"Do something with the bounding box."
(interactive)
(apply (lambda (x1 y1 w h)
(message "(%d %d) w:%d h:%d %s" x1 y1 w h
(dragbox-extract-event-coords last-input-event)))
(dragbox-get-box))
(funcall dragbox-action-callback)
)
(defun dragbox-extract-event-coords (event)
"Get the coordinates from click EVENT."
(nth 8 (cadr last-input-event))
)
;;bind the handlers to lmb and rmb
(define-key image-mode-map [down-mouse-1] 'dragbox-lmb-click-handler)
(define-key image-mode-map [down-mouse-2] 'dragbox-mmb-click-handler)
(define-key image-mode-map [down-mouse-3] 'dragbox-rmb-click-handler)
(defun dragbox-update-box (x y width height)
"Redraw the bounding box, given X Y WIDTH and HEIGHT ontop of the image."
;;this implementation doesn't seem very efficient TODO improve
(fundamental-mode)
(erase-buffer)
(xml-print (dragbox-make-svg-data x y width height dragbox-image-url))
(image-mode))
(defun dragbox-update-box-from-state ()
"Redraw bounding box from global state ontop of image."
(apply 'dragbox-update-box (dragbox-get-box)))
(defun dragbox-get-box ()
"Return x,y,w,h from the box."
(let*
((x1 (car dragbox-x1y1))
(y1 (cdr dragbox-x1y1))
(x2 (car dragbox-x2y2))
(y2 (cdr dragbox-x2y2))
(w (- x2 x1))
(h (- y2 y1)))
(list x1 y1 w h)
))
;;image size hacks
;;identify -verbose -ping /home/joakim/Desktop/xwidget_demo_screenshot.png
;; grep for: Geometry: 992x957+0+0
;; without verbose less easy parsing:
;; /home/joakim/Desktop/xwidget_demo_screenshot.png PNG 992x957 992x957+0+0 8-bit DirectClass 166kb
;; it would be possible to open an image in a buffer and use the image-size defun, but that seems wasteful, and
;; we still need imagemagick for any practical application.
(defun dragbox-image-size (image-file)
"Return the size of IMAGE-FILE as a cons."
(with-current-buffer (get-buffer-create "*imagemagic identify*")
(erase-buffer)
(call-process "identify" nil "*imagemagic identify*" nil "-verbose" image-file) ;; "-ping" sometimes segfaults for me
(goto-char (point-min))
(re-search-forward "Geometry: \\([0-9]+\\)x\\([0-9]+\\)")
(cons (string-to-number (match-string 1))
(string-to-number (match-string 2)))))
(defun dragbox-get-real-box ()
"Like dragbox-get-box but image coordinates rather than screen coordinates."
;;currently no-op since we show image 1:1
)
(defun dragbox-get-box-geometry ()
"The box as an x and imagemagick compatible geometry string."
(let ((box (dragbox-get-box)))
(format "%sx%s+%s+%s" (nth 2 box) (nth 3 box) (nth 0 box) (nth 1 box))))
;; support for ocr of contents of bounding box
;; should use temp files like (make-temp-file "/tmp/" nil ".xxx")
(defvar dragbox-image-options "-density 150x150 -compress none -monochrome")
;;-monochrome -resize 200% -density 150x150 -fill white -tint 50 -level 20%,80%,1.0 -sigmoidal-contrast 30,50% -sharpen 0x2 -compress none
(defun dragbox-crop (crop-file image-url &optional image-options)
"Crop selected image region to CROP-FILE."
(unless image-options (setq image-options ""))
(call-process-shell-command (format "convert %s -crop %s %s %s "
image-options
(dragbox-get-box-geometry)
image-url
crop-file )))
(defun dragbox-ocr-file-to-kill-ring ()
"Put /tmp/ocr.txt in kill ring."
(with-temp-buffer
(insert-file-contents "/tmp/ocr.txt")
(copy-region-as-kill (point-min)(point-max))
(message "%s" (car kill-ring))))
(defun dragbox-ocr-tesseract-image-region ()
"Ocr region with tesseract."
(interactive)
(dragbox-crop "/tmp/dragbox-crop.tif" dragbox-image-url dragbox-image-options)
(call-process-shell-command "rm /tmp/ocr.txt;tesseract /tmp/dragbox-crop.tif /tmp/ocr")
(dragbox-ocr-file-to-kill-ring))
(defun dragbox-ocr-ocrad-image-region ()
"Ocr region with ocrad."
(interactive)
(dragbox-crop "/tmp/dragbox-crop.pbm" dragbox-image-url dragbox-image-options)
(call-process-shell-command "rm /tmp/ocr.txt;ocrad /tmp/dragbox-crop.pbm -x /tmp/x.orf -o /tmp/ocr.txt")
(dragbox-ocr-file-to-kill-ring))
(defun dragbox-ocr-gocr-image-region ()
"Ocr region with gocr."
(interactive)
(dragbox-crop "/tmp/dragbox-crop.pbm" dragbox-image-url dragbox-image-options)
(call-process-shell-command "rm /tmp/ocr.txt;gocr -i /tmp/dragbox-crop.pbm -o /tmp/ocr.txt")
(dragbox-ocr-file-to-kill-ring))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; EXPERIMENTAL functions to rename a bunch of files using cropped
;; thumbnails in imagedired.
;;tentative usage:
;; - dragbox-start on a file in an image directory
;; - select an image region where an interesting feature like a page number is
;; were assuming the region will be the same in all image files in the directory
;; - m-x dragbox-imagedired-start-crop-rename
;; all image files will be cropped into a crop dir.
;; - show this dir in imagedired thumbail mode
;; for each image you want to rename according to info in the crop do:
;; m-x dragbox-imagedired-rename-original
;;BUG: image-dired doesnt regenerate thumbnails reliably!
(defun dragbox-imagedired-generate-crops (image-directory)
;;TODO mkdir crop dir, clean it if its already there
;; crops will go into <image-directory>/crop/*png currently
(mapcar
(lambda (file)
(dragbox-crop (concat
image-directory "/crop/" file ".png") file ) )
(directory-files image-directory)) )
(defun dragbox-imagedired-rename-original (rename-to)
(interactive "Mrename to:")
(let*
((file-name (file-name-nondirectory (image-dired-original-file-name)))
(org-file-name (substring (expand-file-name (concat "../" file-name) ) 0 -4))
(rename-to (expand-file-name (concat "../" rename-to ".djvu")))
)
(message "rename %s to %s" org-file-name rename-to)
(rename-file org-file-name rename-to)
))
;;;;;;;;;;;;;;;;;;;
;;totaly untested
(provide 'dragbox)
;;; dragbox.el ends here
^ permalink raw reply [flat|nested] 4+ messages in thread