-(define (placebox x y s)
- (string-append
- (ly:number->string x) " " (ly:number->string y) " { " s " } place-box\n"))
-
-(define (polygon points blotdiameter)
- (string-append
- (ly:numbers->string points) " "
- (ly:number->string (/ (length points) 2)) " "
- (ly:number->string blotdiameter)
- " draw_polygon"))
-
-(define (repeat-slash wid slope thick)
- (string-append
- (ly:numbers->string (list wid slope thick))
- " draw_repeat_slash"))
-
-(define (round-filled-box x y width height blotdiam)
- (string-append
- (ly:numbers->string
- (list x y width height blotdiam)) " draw_round_box"))
-
-(define (old-text font s)
- ;; ugh, we should find a better way to
- ;; extract the hsbw for /space from the font.
- (let* ((space-length (cdar (ly:text-dimension font " ")))
- (commands '())
- (add-command (lambda (x) (set! commands (cons x commands)))))
-
- (string-fold
- (lambda (chr word)
- "Translate space as into moveto, group the rest in words."
- (if (and (< 0 (string-length word))
- (equal? #\space chr))
- (add-command
- (string-append "(" (ps-encoding word) ") show\n")))
-
- (if (equal? #\space chr)
- (add-command (string-append (number->string space-length)
- " 0.0 rmoveto ")))
-
- (if (equal? #\space chr)
- ""
- (string-append word (make-string 1 chr))))
- ""
- (string-append s " "))
-
- (string-append
- (ps-font-command font) " setfont "
- (string-join (reverse commands)))))
-
-(define (new-text font s)
- (let* ((space-length (cdar (ly:text-dimension font " ")))
- (space-move (string-append (number->string space-length)
- " 0.0 rmoveto "))
- (input-enc 'latin1)
- (out-vec (decode-byte-string input-enc s)))
-
- (string-append
- (ps-font-command font) " setfont "
- (string-join
- (vector->list
- (vector-for-each
-
- (lambda (sym)
- (if (eq? sym 'space)
- space-move
- (string-append "/" (symbol->string sym) " glyphshow")))
- out-vec))))))
-
-;;(define text old-text)
-(define (text font str)
- (ly:warn "TEXT backend-command encountered in Pango backend\nargs: ~a ~a" font str)
- (new-text font str))
-
-;; FIXME: BARF helvetica?
-(define (white-text scale s)
- (let ((mystring (string-append
- "(" s ") " (number->string scale)
- " /Helvetica-Bold "
- " draw_white_text")))
- mystring))
-
-(define (unknown)
+(define (oval x-radius y-radius thick fill)
+ (ly:format
+ "~a ~4f ~4f ~4f draw_oval"
+ (if fill
+ "true"
+ "false")
+ x-radius y-radius thick))
+
+(define (placebox x y s)
+ (if (not (string-null? s))
+ (ly:format "~4f ~4f moveto ~a\n" x y s)
+ ""))
+
+(define (polygon points blot-diameter filled?)
+ (ly:format "~a ~4l ~a ~4f draw_polygon"
+ (if filled? "true" "false")
+ points
+ (- (/ (length points) 2) 1)
+ blot-diameter))
+
+(define (repeat-slash width slope beam-thickness)
+ (define (euclidean-length x y)
+ (sqrt (+ (* x x) (* y y))))
+
+ (let ((x-width (euclidean-length beam-thickness (/ beam-thickness slope)))
+ (height (* width slope)))
+ (ly:format "~4l draw_repeat_slash"
+ (list x-width width height))))
+
+
+(define (round-filled-box left right bottom top blotdiam)
+ (let* ((halfblot (/ blotdiam 2))
+ (x (- halfblot left))
+ (width (- right (+ halfblot x)))
+ (y (- halfblot bottom))
+ (height (- top (+ halfblot y))))
+ (ly:format "~4l draw_round_box"
+ (list width height x y blotdiam))))
+
+;; save current color on stack and set new color
+(define (setcolor r g b)
+ (ly:format "gsave ~4l setrgbcolor\n"
+ (list r g b)))
+
+;; restore color from stack
+(define (resetcolor) "grestore\n")
+
+;; rotation around given point
+(define (setrotation ang x y)
+ (ly:format "gsave ~4l translate ~a rotate ~4l translate\n"
+ (list x y)
+ ang
+ (list (* -1 x) (* -1 y))))
+
+(define (resetrotation ang x y)
+ "grestore ")
+
+(define (unknown)