From: Jan Nieuwenhuizen Date: Thu, 8 Nov 2001 12:13:21 +0000 (+0100) Subject: patch::: 1.5.21.jcn1 X-Git-Tag: release/1.5.22~1 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=1fb3b8fa97e8026d1a4cd7a04e250bcab1f51cd2;p=lilypond.git patch::: 1.5.21.jcn1 1.5.21.jcn1 =========== * snapnie sketch output 1.5.21 ====== --- diff --git a/CHANGES b/CHANGES index 8ad23847a9..5347c65727 100644 --- a/CHANGES +++ b/CHANGES @@ -1,3 +1,11 @@ +1.5.21.jcn1 +=========== + +* snapnie sketch output + +1.5.21 +====== + 1.5.20.jcn1 =========== diff --git a/VERSION b/VERSION index 08539f2bab..4a2c8b1361 100644 --- a/VERSION +++ b/VERSION @@ -2,7 +2,7 @@ PACKAGE_NAME=LilyPond MAJOR_VERSION=1 MINOR_VERSION=5 PATCH_LEVEL=21 -MY_PATCH_LEVEL= +MY_PATCH_LEVEL=jcn1 # use the above to send patches: MY_PATCH_LEVEL is always empty for a # released version. diff --git a/lily/main.cc b/lily/main.cc index f4ccf040d0..d24ffdcf05 100644 --- a/lily/main.cc +++ b/lily/main.cc @@ -277,13 +277,8 @@ setup_paths () new_glp = ":" + new_glp; new_glp = prefix_directory + new_glp; - /* - Yes , so setenv is not posix. - - I say, fuckem'all. - */ - - setenv ("GUILE_LOAD_PATH", new_glp.ch_C(), 1); + /* URG, overwrite load path */ + putenv ((char*)("GUILE_LOAD_PATH=" + new_glp).ch_C ()); } /** diff --git a/scm/lily.scm b/scm/lily.scm index 8679e958cc..8922fef0ea 100644 --- a/scm/lily.scm +++ b/scm/lily.scm @@ -123,6 +123,7 @@ (scm ps) (scm pysk) (scm ascii-script) + (scm sketch) ) (define output-alist @@ -132,6 +133,7 @@ ("scm" . ,write) ("as" . ,as-output-expression) ("pysk" . ,pysk-output-expression) + ("sketch" . ,sketch-output-expression) )) diff --git a/scm/sketch.scm b/scm/sketch.scm index 8b13789179..e13e67c4e4 100644 --- a/scm/sketch.scm +++ b/scm/sketch.scm @@ -1 +1,296 @@ +;;; sketch.scm -- implement Scheme output routines for Sketch +;;; +;;; source file of the GNU LilyPond music typesetter +;;; +;;; (c) 1998--2001 Jan Nieuwenhuizen +;;; Han-Wen Nienhuys + + +(define-module (scm sketch) + :export (sketch-output-expression) + :no-backtrace + ) + +(define this-module (current-module)) + +(define (sketch-output-expression expr port) + (display (eval expr this-module) port) + ) + + +(use-modules + (guile) + (guile-user)) + + +(use-modules (ice-9 format)) + +(define (ascii->string i) (make-string 1 (integer->char i))) + +(define (control->list c) + (list (+ global-x (car c)) (+ global-y (cdr c)))) + +(define (control-flip-y c) + (cons (car c) (* -1 (cdr c)))) + +;;; urg. +(define (sk-numbers->string l) + (string-append + (number->string (car l)) + (if (null? (cdr l)) + "" + (string-append "," (sk-numbers->string (cdr l)))))) + +(define global-x 0.0) +(define global-y 0.0) +(define global-list '()) +(define global-font "") +(define global-s "") +(define global-scale 1.0) +(define (global-mul-scale x) (* global-scale x)) + +;; hmm, global is global +(define (global-filledbox width dy dx height x y) + (string-append + "fp((0,0,0))\n" + "lw(0.1)\n" + "r(" + (sk-numbers->string + (map global-mul-scale (list width dy dx height x y))) + ")\n")) + +(define (global-bezier l) + (let* ((c0 (car (list-tail l 3))) + (c123 (list-head l 3)) + (start (control->list c0)) + (control (apply append (map control->list c123)))) + (string-append + "bs(" (sk-numbers->string (map global-mul-scale start)) ",0)\n" + "bc(" (sk-numbers->string (map global-mul-scale control)) ",2)\n"))) + + +(define (global-beziers l thick) + (let* (;;(burp (set! global-y (+ global-y (* 2 (cdar l))))) + (first + (list-tail l 4)) + (second + (list-head l 4)) + ) + (string-append + "fp((0,0,0))\n" + "lw(0.1)\n" + "b()\n" + (global-bezier first) + (global-bezier second) + ;;"b_()\n" + ))) + + +;; alist containing fontname -> fontcommand assoc (both strings) +(define font-alist '()) +(define font-count 0) +(define current-font "") + +(define (fontify name-mag-pair exp) + (string-append (select-font name-mag-pair) + (if (string? exp) exp ""))) + +(define (define-fonts x) "") + +(define (font-def x) +"") + + +(define (cached-fontname i) + "") + +(define (select-font name-mag-pair) + (set! global-font (car name-mag-pair)) + "") + +(define (font-load-command name-mag command) + "") + +(define (beam width slope thick) + (let ((s (list + 'global-filledbox + width + (* slope width) + 0 + thick + 'global-x + 'global-y))) + (set! global-s s)) + "\n") + +(define (comment s) + (string-append "% " s)) + +(define (bracket arch_angle arch_width arch_height height arch_thick thick) + (string-append + (numbers->string (list arch_angle arch_width arch_height height arch_thick thick)) " draw_bracket" )) + +(define (char i) + (set! global-s +;; `(string-append "txt(" ,(number->string i) ",(" +;; (sk-numbers->string (list global-x global-y)) + `(string-append + "fp((0,0,0))\n" + "le()\n" + "lw(0.1)\n" +;; "Fn('" global-font "')\n" +;; "Fn('Times-Roman')\n" + "Fn('TeX-feta20')\n" + "Fs(20)\n" + ;; chars > 128 don't work yet + "txt('" ,(ascii->string (modulo i 128)) "',(" +;; "char(" ,(number->string i) ",(" + (sk-numbers->string (list (* global-scale global-x) + (* global-scale global-y))) + "))\n"))) + +(define (hairpin thick width starth endh ) + (string-append + (numbers->string (list width starth endh thick)) + " draw_hairpin")) + +;; what the heck is this interface ? +(define (dashed-slur thick dash l) + (string-append + (apply string-append (map control->string l)) + (ly-number->string thick) + " [ " + (ly-number->string dash) + " " + (ly-number->string (* 10 thick)) ;UGH. 10 ? + " ] 0 draw_dashed_slur")) + +(define (dashed-line thick on off dx dy) + (string-append + (ly-number->string dx) + " " + (ly-number->string dy) + " " + (ly-number->string thick) + " [ " + (ly-number->string on) + " " + (ly-number->string off) + " ] 0 draw_dashed_line")) + +(define (repeat-slash wid slope thick) + (string-append (numbers->string (list wid slope thick)) + " draw_repeat_slash")) + +(define (end-output) + "guidelayer('Guide Lines',1,0,0,1,(0,0,1)) +grid((0,0,20,20),0,(0,0,1),'Grid')\n") + +(define (experimental-on) "") + +(define (font-switch i) + "") + +(define (header-end) + "") + +(define (lily-def key val) + (if (equal? key "lilypondpaperoutputscale") + (set! global-scale (string->number val))) + "") + + +(define (header creator generate) + (string-append + "##Sketch 1 2 +document() +layout('A4',0) +layer('Layer 1',1,1,0,0,(0,0,0)) +")) + +(define (invoke-char s i) + "") + +(define (invoke-dim1 s d) + (string-append + (ly-number->string (* d (/ 72.27 72))) " " s )) + +;; urg +(define (placebox x y s) + (format (current-error-port) "placebox: ~S, ~S, ~S\n" x y s) + (set! global-x (+ x 0)) + (set! global-y (+ y 100)) + (let ((s (primitive-eval global-s))) + (set! global-s "\n") + s)) + +(define (bezier-sandwich l thick) + (let ((s (list + 'global-beziers + 'global-list + thick))) + (set! global-s s) + (set! global-list l)) + "\n") + +; TODO: use HEIGHT argument +(define (start-line height) + "G()\n" + ) + +;; r((520.305,0,0,98.0075,51.8863,10.089)) +;; width, 0, 0, height, x, y +(define (filledbox breapth width depth height) + (let ((s (list + 'global-filledbox + (+ breapth width) + 0 0 + (+ depth height) + `(- global-x ,breapth) + `(- global-y ,depth)))) + (format (current-error-port) "filledbox: ~S\n" s) + (set! global-s s)) + "\n") + +(define (stem x y z w) (filledbox x y z w)) + + +(define (stop-line) + "G_()\n") + +;; huh? +(define (stop-last-line) + stop-line) + +(define (text s) + (set! global-s + `(string-append "txt('" ,s "',(" + (sk-numbers->string (list global-x global-y)) + "))\n"))) + + +(define (volta h w thick vert_start vert_end) + (string-append + (numbers->string (list h w thick (inexact->exact vert_start) (inexact->exact vert_end))) + " draw_volta")) + +(define (tuplet ht gap dx dy thick dir) + (string-append + (numbers->string (list ht gap dx dy thick (inexact->exact dir))) + " draw_tuplet")) + + +(define (unknown) + "\n unknown\n") + +(define (ez-ball ch letter-col ball-col) + (string-append + " (" ch ") " + (numbers->string (list letter-col ball-col)) + " /Helvetica-Bold " ;; ugh + " draw_ez_ball")) + +(define (define-origin a b c ) "") +(define (no-origin) "") +