"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "TeXmacs/progs/graphics/graphics-utils.scm" between
TeXmacs-1.99.4-src.tar.gz and TeXmacs-1.99.5-src.tar.gz

About: GNU TeXmacs is a what-you-see-is-what-you-get scientific text editor, which was both inspired by TeX and GNU Emacs.

graphics-utils.scm  (TeXmacs-1.99.4-src):graphics-utils.scm  (TeXmacs-1.99.5-src)
skipping to change at line 317 skipping to change at line 317
(graphics-path (cDr path))))))) (graphics-path (cDr path)))))))
(tm-define (graphics-active-path) (tm-define (graphics-active-path)
;; path to active tag ;; path to active tag
(graphics-path (cursor-path))) (graphics-path (cursor-path)))
(tm-define (graphics-group-path) (tm-define (graphics-group-path)
;; path to innermost group ;; path to innermost group
(graphics-graphics-path)) (graphics-graphics-path))
(tm-define (make-graphics) (tm-define (make-graphics . init)
(when (null? init)
(set! init `("gr-mode" "point"
"gr-frame" (tuple "scale" "1cm" (tuple "0.5gw" "0.5gh"))
"gr-geometry" (tuple "geometry" "1par" "0.6par"))))
(graphics-reset-context 'begin) (graphics-reset-context 'begin)
(insert-raw-go-to (insert-raw-go-to `(with ,@init (graphics "")) `(,(length init) 1)))
'(with "gr-mode" "point"
"gr-frame" (tuple "scale" "1cm" (tuple "0.5gw" "0.5gh"))
"gr-geometry" (tuple "geometry" "1par" "0.6par")
(graphics ""))
'(6 1)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Subroutines for accessing the properties of the graphics ;; Subroutines for accessing the properties of the graphics
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;NOTE: This section is OK. ;;NOTE: This section is OK.
(define (graphics-get-raw-property var) (define (graphics-get-raw-property var)
(with val (get-upwards-tree-property (graphics-graphics-path) var) (with val (get-upwards-tree-property (graphics-graphics-path) var)
(if (eq? val nothing) (if (eq? val nothing)
(get-default-tree-val var) (get-default-tree-val var)
(if (eq? (tm-car val) 'quote) (if (eq? (tm-car val) 'quote)
(tree-ref val 0) (tree-ref val 0)
val)))) val))))
(tm-define (graphics-get-property var) (tm-define (graphics-get-property var)
(with val (graphics-get-raw-property var) (with val (graphics-get-raw-property var)
(tree->stree val))) (tree->stree val)))
(tm-define ((graphics-get-property-at p) var)
(with r (if (and (pair? p) (in? var (list "gr-gid" "gr-anim-id")))
(graphics-path-property p (string-drop var 3))
(graphics-get-property var))
;;(display* p ", " var " ~~> " r "\n")
r))
(tm-define (graphics-set-property var val) (tm-define (graphics-set-property var val)
(with p (graphics-graphics-path) (with p (graphics-graphics-path)
(cond ((tree? val) (graphics-set-property var (tree->stree val))) (cond ((tree? val) (graphics-set-property var (tree->stree val)))
((== val "default") (graphics-remove-property var)) ((== val "default") (graphics-remove-property var))
((== val (graphics-attribute-default var)) ((== val (graphics-attribute-default var))
(graphics-remove-property var)) (graphics-remove-property var))
(p (path-insert-with p var val))))) (p (path-insert-with p var val)))))
(tm-define (graphics-remove-property var) (tm-define (graphics-remove-property var)
(with p (graphics-graphics-path) (with p (graphics-graphics-path)
skipping to change at line 493 skipping to change at line 499
(tm-define (graphics-path-property p var) (tm-define (graphics-path-property p var)
(graphics-path-property-bis p var "default")) (graphics-path-property-bis p var "default"))
(tm-define (graphics-path-property-bis-1 p var default-val) (tm-define (graphics-path-property-bis-1 p var default-val)
(with c (get-upwards-property-1 p var) (with c (get-upwards-property-1 p var)
(if (== c nothing) default-val c))) (if (== c nothing) default-val c)))
(tm-define (graphics-path-property-1 p var) (tm-define (graphics-path-property-1 p var)
(graphics-path-property-bis-1 p var "default")) (graphics-path-property-bis-1 p var "default"))
;;(tm-define (graphics-object-root-path p)
;; (let* ((q (tm-upwards-path p '(with) '()))
;; (path (if (and q (== (+ (length q) 1) (length p))) q p)))
;; path))
(tm-define (graphics-object-root-path p) (tm-define (graphics-object-root-path p)
(let* ((q (tm-upwards-path p '(with) '())) (with t (path->tree p)
(path (if (and q (== (+ (length q) 1) (length p))) q p))) (cond ((tree-in? t :up '(with anim-edit))
path)) (graphics-object-root-path (cDr p)))
(else p))))
(tm-define (graphics-remove p . parms) (tm-define (graphics-remove p . parms)
(when p (when p
(with p0 (graphics-object-root-path p) (with p0 (graphics-object-root-path p)
(set! layer-of-last-removed-object (set! layer-of-last-removed-object
(if (and (pair? parms) (eq? (car parms) 'memoize-layer)) (if (and (pair? parms) (eq? (car parms) 'memoize-layer))
(if (list? layer-of-last-removed-object) (if (list? layer-of-last-removed-object)
(cons (cAr p0) layer-of-last-removed-object) (cons (cAr p0) layer-of-last-removed-object)
(cAr p0)) (cAr p0))
#f)) #f))
skipping to change at line 522 skipping to change at line 534
(tm-define (graphics-assign p t) (tm-define (graphics-assign p t)
(when p (when p
(tree-assign (path->tree p) t) (tree-assign (path->tree p) t)
(go-to (rcons p 1)))) (go-to (rcons p 1))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Box info & frame ;; Box info & frame
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(tm-define (box-info t cmd) (tm-define (box-info t cmd)
(tree->stree (texmacs-exec `(box-info ,t ,cmd)))) (tree->stree (texmacs-exec* `(box-info ,t ,cmd))))
(tm-define (frame-direct p) (tm-define (frame-direct p)
(tree->stree (texmacs-exec `(frame-direct ,p)))) (tree->stree (texmacs-exec* `(frame-direct ,p))))
(tm-define (frame-inverse p) (tm-define (frame-inverse p)
(tree->stree (texmacs-exec `(frame-inverse ,p)))) (tree->stree (texmacs-exec* `(frame-inverse ,p))))
(tm-define (interval-intersects i1 i2) (tm-define (interval-intersects i1 i2)
(let* ((i1a (car i1)) (let* ((i1a (car i1))
(i1b (cadr i1)) (i1b (cadr i1))
(i2a (car i2)) (i2a (car i2))
(i2b (cadr i2))) (i2b (cadr i2)))
(or (and (<= i1a i2a) (>= i1b i2b)) (or (and (<= i1a i2a) (>= i1b i2b))
(and (<= i2a i1a) (>= i2b i1b)) (and (<= i2a i1a) (>= i2b i1b))
(and (>= i1a i2a) (<= i1a i2b)) (and (>= i1a i2a) (<= i1a i2b))
(and (>= i2a i1a) (<= i2a i1b))))) (and (>= i2a i1a) (<= i2a i1b)))))
skipping to change at line 562 skipping to change at line 574
(and (interval-intersects `(,(car box1) ,(caddr box1)) (and (interval-intersects `(,(car box1) ,(caddr box1))
`(,(car box2) ,(caddr box2))) `(,(car box2) ,(caddr box2)))
(interval-intersects `(,(cadr box1) ,(cadddr box1)) (interval-intersects `(,(cadr box1) ,(cadddr box1))
`(,(cadr box2) ,(cadddr box2)))))) `(,(cadr box2) ,(cadddr box2))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Enhanced trees ;; Enhanced trees
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(tm-define (enhanced-tree? t) (tm-define (enhanced-tree? t)
(eq? (tree-label t) 'with)) (tree-in? t '(with anim-edit)))
(tm-define (enhanced-tree->radical t) (tm-define (enhanced-tree->radical t)
(if (enhanced-tree? t) (cond ((tree-is? t 'with)
(tree-ref t (- (tree-arity t) 1)) (enhanced-tree->radical (tree-ref t :last)))
t)) ((tree-is? t 'anim-edit)
(enhanced-tree->radical (tree-ref t 1)))
(else t)))
(tm-define (radical->enhanced-tree r) (tm-define (radical->enhanced-tree r)
(with t (tree-up r) (with t (tree-up r)
(if (enhanced-tree? t) t r))) (if (enhanced-tree? t)
(radical->enhanced-tree t)
r)))
(tm-define (stree-radical t) (tm-define (stree-radical t)
(if (and (pair? t) (eq? (car t) 'with) (nnull? (cdr t))) (cond ((tm-is? t 'with)
(cAr t) (stree-radical (tm-ref t :last)))
t)) ((tm-is? t 'anim-edit)
(stree-radical (tm-ref t 1)))
(else t)))
(tm-define (stree-radical* t anim?)
(cond ((and (tm-is? t 'with) (not anim?))
(stree-radical* (tm-ref t :last) anim?))
((tm-is? t 'anim-edit)
(stree-radical* (tm-ref t 1) #t))
(else t)))
(tm-define (graphics-re-enhance obj compl anim?)
(cond ((tm-is? compl 'anim-edit)
`(anim-edit ,(tm-ref compl 0)
,(graphics-re-enhance obj (tm-ref compl 1) #t)
,@(cddr (tm-children compl))))
((and (tm-is? compl 'with)
(or anim? (tm-is? (tm-ref compl :last) 'anim-edit)))
`(with ,@(cDr (tm-children compl))
,(graphics-re-enhance obj (tm-ref compl :last) anim?)))
(else obj)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Animations
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(tm-define (graphics-anim-frames t)
(and (tm-in? t '(anim-static anim-dynamic))
(tm-is? (tm-ref t 0) 'morph)
(with c (tm-children (tm-ref t 0))
(and (list-and (map (lambda (x) (tm-func? x 'tuple 2)) c))
(map (lambda (x) (tm-ref x 1)) c)))))
(tm-define (graphics-anim-radicals t)
(and-with l (graphics-anim-frames t)
(map stree-radical l)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; New style graphical attributes ;; New style graphical attributes
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (group-pairs l) (define (group-pairs l)
(if (or (null? l) (null? (cdr l))) '() (if (or (null? l) (null? (cdr l))) '()
(cons (cons (car l) (cadr l)) (group-pairs (cddr l))))) (cons (cons (car l) (cadr l)) (group-pairs (cddr l)))))
(tm-define (with-get-attributes t) (tm-define (with-get-attributes t)
 End of changes. 12 change blocks. 
21 lines changed or deleted 72 lines changed or added

Home  |  About  |  All  |  Newest  |  Fossies Dox  |  Screenshots  |  Comments  |  Imprint  |  Privacy  |  HTTPS