%! %%Title:PStab 2.0 %%Creator:Baz %%CreationDate:14 March 1994 %PStab 2.0 (first full release) % % % Copyright (C) 1994 Brian Ewins. All rights reserved. % %PStab is distributed in the hope that it will be useful, but %WITHOUT ANY WARRANTY. No author or distributor accepts responsibility %to anyone for the consequences of using it or for whether it serves any %particular purpose or works at all, unless he says so in writing. Refer %to the PStab General Public License for full details. % %Everyone is granted permission to copy, modify and redistribute %PStab, but only under the conditions described in the PStab %General Public License. A copy of this license is supposed to have been %given to you along with PStab so you can know your rights and %responsibilities. It should be in a file named COPYING. Among other %things, the copyright notice and this notice must be preserved on all %copies. % %------------------------------------------------------------------------------- %Revision History: started Friday, 2 March 1994. %------------------------------------------------------------------------------- % 0.1 :Friday: crap program for lining numbers up in columns % 0.2 :Sunday: complete rewrite. chord table program only % 0.3 :Tuesday: reorganized into core & styles. % Centred,Columns,ChordTable supplied. % ifcase added to core. % 0.4 :Wednesday: rethink on text styles.easier method of entry. % Verses replaced Columns % ChordPro style provides compatability. % ChordTable renamed Chords, now has % huge table of chords you can use. % Handles VM restore properly !!! % added revision history. % 0.5 :Thursday: Back to doing tablature (again) % Chords now size-independent % Verbatim made default style. % Verbatim-equivalent defs removed.(shortens prog} % Tablature works! hooray!!! % Many marks allowed in music. % 0.6 :Friday: added default case to ifcase % finished Parser. program is still buggy. % 0.7 :: Due to a hitch, there was no alpha 7. % 0.8 :Sunday: Commented. % fbox made internal size. % Manual doubles as torture test. % manual nearly complete, program debugged % completely except for Tablature. % 1.0 :Monday: It all works!!! I'll type last man page & post. % 1.1 :Tuesday: the '2nd last page' bug fixed. % fingermark bug fixed. top , bottom, rows set % once only in Tablature. % Parsers now separate part of the program. % Font sizes reduced:I was viewing on A3!!! % Errors in manual fixed. % Only things left to do now are ASCII tab reader, % and more complete manual. % 1.2: :Tuesday: ASCII parser started. buggy. remembered to fix bug % for looooong bars.incidentally, redundant defs were % placed back in at 1.0. ASCII parser works. WOW! % manual to do. ASCII parser now does an excellent % job of it. only two pathogenic cases I can think of. % 2.0: :Wednesday: ASCII parser fixed so it split up 'bars'. this % is truly monumental: ASCII'd tab now looks % _nice_ (!)... almost worth using... % manual finished. %------------------------------------------------------------------------------- %-CORE-------------------------------------------------------------------------- %Contains idioms, and other stuff essential for %the program to break lines, pages, etc. %------------------------------------------------------------------------------- %-------Idioms %------------------------------------------------------------------------------- /debug {dup 20 string cvs show ( ) show} def /edef {exch def} def /max { 2 copy gt {pop} {exch pop} ifelse } def /min { 2 copy lt {pop} {exch pop} ifelse } def /inch {72 mul} def /plus { % x y plus is equivalent to x+=y; in C 1 index cvx exec add def } def /minus { % x y minus is equivalent to x-=y; in C 1 index cvx exec exch sub def } def /ifcase { % syntax: pattern { {match1 {proc1}} {match2 {proc2}} ...} ifcase % if match is /default, it will be executed immediately % pattern is on the stack at the start of any proc. % proc should really remove it. exch /pattern edef { aload pop exch dup /default eq {pop pattern exch exec exit} if pattern eq {pattern exch exec exit} {pop} ifelse } forall } def /ToString {3 string cvs} def /ChooseFont { % selects font and sets fbox /fbox edef findfont fbox scalefont setfont } def %------------------------------------------------------------------------------- %-------Sizes: internal unit is font size. %------------- also here is code to use real page size. %------------------------------------------------------------------------------- /ptof {fbox div exch fbox div exch} def /ftop {fbox mul exch fbox mul exch} def /moverel {ftop rmoveto} def /linerel {ftop rlineto} def /StringWidth {stringwidth pop fbox div} def /GetPageMargins { clippath pathbbox %get page size /TopMargin edef /RightMargin edef %put it where I can use it. /BottomMargin edef /LeftMargin edef newpath %stops me strokeing the clipping path } def /PageWidth {RightMargin LeftMargin ptof sub} def /smaller { exch { {/LeftMargin {exch plus}} {/RightMargin {exch minus}} {/TopMargin {exch minus}} {/BottomMargin {exch plus}} } ifcase } def %------------------------------------------------------------------------------- %-------Line,Page breaking code. %------------------------------------------------------------------------------- /Atom { GetAtom currentpoint pop hbox fbox mul add RightMargin gt {NewLine} if currentpoint vbox fbox mul sub BottomMargin lt {NewPage} if pop } def /NewDoc { % begin a document % assumes margins have been set LeftMargin TopMargin moveto Verbatim %default style /Home save def /StyleDict 128 dict def StyleDict begin } def /NewStyle { % clean up and start again Flush end currentpoint Home restore /Home save def moveto /StyleDict 128 dict def StyleDict begin } def /EndDoc { Flush end showpage %show what's left. Home restore } def /PageBreak { % when the user wants to insert a page break. EndDoc NewDoc } def %------------------------------------------------------------------------------- %-------Chord data: a table taken from ChordPro, and put in %------------------ the simpler format used here. Some mistakes corrected. %------------------ Chordpro is (c) Mario Dorion & Martin Leclerc %------------------------------------------------------------------------------- /Chordata % this is spinal tap! [ [(Ab)[ 4 6 6 5 4 4 ]] [(Abm)[ 4 6 6 4 4 4 ]] [(Ab7)[ -1 -1 1 1 1 2 ]] [(Abm7)[ -1 -1 4 4 4 4 ]] [(Absus)[ -1 -1 1 1 2 4 ]] [(Ab+)[ -1 -1 2 1 1 0 ]] [(Abdim)[ -1 -1 0 1 0 1 ]] [(Abmaj7)[ -1 -1 1 1 1 3 ]] [(A)[ -1 0 2 2 2 0 ]] [(Am)[ -1 0 2 2 1 0 ]] [(A7)[ -1 0 2 0 2 0 ]] [(Am7)[ -1 0 2 2 1 3 ]] [(Asus)[ -1 -1 2 2 3 0 ]] [(A+)[ -1 0 3 2 2 1 ]] [(Adim)[ -1 -1 1 2 1 2 ]] [(Amaj7)[ -1 0 2 1 2 0 ]] [(A#)[ -1 1 3 3 3 1 ]] [(A#m)[ -1 1 3 3 2 1 ]] [(A#7)[ -1 -1 3 3 3 4 ]] [(A#m7)[ -1 1 3 1 2 1 ]] [(A#sus)[ -1 -1 3 3 4 1 ]] [(A#+)[ -1 -1 0 3 3 2 ]] [(A#dim)[ -1 -1 2 3 2 3 ]] [(A#maj7)[ -1 1 3 2 3 -1 ]] [(Bb)[ -1 1 3 3 3 1 ]] [(Bbm)[ -1 1 3 3 2 1 ]] [(Bb7)[ -1 -1 3 3 3 4 ]] [(Bbm7)[ -1 1 3 1 2 1 ]] [(Bbsus)[ -1 -1 3 3 4 1 ]] [(Bb+)[ -1 -1 0 3 3 2 ]] [(Bbdim)[ -1 -1 2 3 2 3 ]] [(Bbmaj7)[ -1 1 3 2 3 -1 ]] [(B)[ -1 2 4 4 4 2 ]] [(Bm)[ -1 2 4 4 3 2 ]] [(B7)[ 0 2 1 2 0 2 ]] [(Bm7)[ -1 2 4 2 3 2 ]] [(Bsus)[ -1 -1 4 4 5 2 ]] [(B+)[ -1 -1 1 0 0 4 ]] [(Bdim)[ -1 -1 0 1 0 1 ]] [(Bmaj7)[ -1 2 4 3 4 -1 ]] [(C)[ 0 3 2 0 1 0 ]] [(Cm)[ -1 1 5 5 4 3 ]] [(C7)[ 0 3 2 3 1 0 ]] [(Cm7)[ -1 1 5 3 4 3 ]] [(Csus)[ -1 -1 3 0 1 3 ]] [(C+)[ -1 -1 2 1 1 0 ]] [(Cdim)[ -1 -1 1 2 1 2 ]] [(Cmaj7)[ -1 3 2 0 0 0 ]] [(C#)[ -1 -1 3 1 2 1 ]] [(C#m)[ -1 -1 2 1 2 0 ]] [(C#7)[ -1 -1 3 4 2 4 ]] [(C#m7)[ -1 -1 2 4 2 4 ]] [(C#sus)[ -1 -1 6 6 7 4 ]] [(C#+)[ -1 -1 3 2 2 1 ]] [(C#dim)[ -1 -1 2 3 2 3 ]] [(C#maj7)[ -1 4 3 1 1 1 ]] [(Db)[ -1 -1 3 1 2 1 ]] [(Dbm)[ -1 -1 2 1 2 0 ]] [(Db7)[ -1 -1 3 4 2 4 ]] [(Dbm7)[ -1 -1 2 4 2 4 ]] [(Dbsus)[ -1 -1 6 6 7 4 ]] [(Db+)[ -1 -1 3 2 2 1 ]] [(Dbdim)[ -1 -1 2 3 2 3 ]] [(Dbmaj7)[ -1 4 3 1 1 1 ]] [(D)[ -1 -1 0 2 3 2 ]] [(Dm)[ -1 -1 0 2 3 1 ]] [(D7)[ -1 -1 0 2 1 2 ]] [(Dm7)[ -1 -1 0 2 1 1 ]] [(Dsus)[ -1 -1 0 2 3 3 ]] [(D+)[ -1 -1 0 3 3 2 ]] [(Ddim)[ -1 -1 0 1 0 1 ]] [(Dmaj7)[ -1 -1 0 1 1 1 ]] [(D#)[ -1 -1 5 3 4 3 ]] [(D#m)[ -1 -1 4 3 4 2 ]] [(D#7)[ -1 -1 1 3 2 3 ]] [(D#m7)[ -1 -1 1 3 2 2 ]] [(D#sus)[ -1 -1 1 3 4 4 ]] [(D#+)[ -1 -1 1 0 0 4 ]] [(D#dim)[ -1 -1 1 2 1 2 ]] [(D#maj7)[ -1 -1 1 3 3 3 ]] [(Eb)[ -1 -1 6 4 5 4 ]] [(Ebm)[ -1 -1 4 3 4 2 ]] [(Eb7)[ -1 -1 1 3 2 3 ]] [(Ebm7)[ -1 -1 1 3 2 2 ]] [(Ebsus)[ -1 -1 1 3 4 4 ]] [(Eb+)[ -1 -1 1 0 0 4 ]] [(Ebdim)[ -1 -1 1 2 1 2 ]] [(Ebmaj7)[ -1 -1 1 3 3 3 ]] [(E)[ 0 2 2 1 0 0 ]] [(Em)[ 0 2 2 0 0 0 ]] [(E7)[ 0 2 2 1 3 0 ]] [(Em7)[ 0 2 2 0 3 0 ]] [(Esus)[ 0 2 2 2 0 0 ]] [(E+)[ -1 -1 2 1 1 0 ]] [(Edim)[ -1 -1 2 3 2 3 ]] [(Emaj7)[ 0 2 1 1 0 -1 ]] [(F)[ 1 3 3 2 1 1 ]] [(Fm)[ 1 3 3 1 1 1 ]] [(F7)[ 1 3 1 2 1 1 ]] [(Fm7)[ 1 3 1 1 1 1 ]] [(Fsus)[ -1 -1 3 3 1 1 ]] [(F+)[ -1 -1 3 2 2 1 ]] [(Fdim)[ -1 -1 0 1 0 1 ]] [(Fmaj7)[ -1 3 3 2 1 0 ]] [(F#)[ 2 4 4 3 2 2 ]] [(F#m)[ 2 4 4 2 2 2 ]] [(F#7)[ -1 -1 4 3 2 0 ]] [(F#m7)[ -1 -1 2 2 2 2 ]] [(F#sus)[ -1 -1 4 4 2 2 ]] [(F#+)[ -1 -1 4 3 3 2 ]] [(F#dim)[ -1 -1 1 2 1 2 ]] [(F#maj7)[ -1 -1 4 3 2 1 ]] [(Gb)[ 2 4 4 3 2 2 ]] [(Gbm)[ 2 4 4 2 2 2 ]] [(Gb7)[ -1 -1 4 3 2 0 ]] [(Gbm7)[ -1 -1 2 2 2 2 ]] [(Gbsus)[ -1 -1 4 4 2 2 ]] [(Gb+)[ -1 -1 4 3 3 2 ]] [(Gbdim)[ -1 -1 1 2 1 2 ]] [(Gbmaj7)[ -1 -1 4 3 2 1 ]] [(G)[ 3 2 0 0 0 3 ]] [(Gm)[ 3 5 5 3 3 3]] [(G7)[ 3 2 0 0 0 1 ]] [(Gm7)[ 3 5 3 3 3 3 ]] [(Gsus)[ -1 -1 0 0 1 3 ]] [(G+)[ -1 -1 1 0 0 4 ]] [(Gdim)[ -1 -1 2 3 2 3 ]] [(Gmaj7)[ -1 -1 5 4 3 2 ]] [(G#)[ 4 6 6 5 4 4 ]] [(G#m)[ 4 6 6 4 4 4 ]] [(G#7)[ -1 -1 1 1 1 2 ]] [(G#m7)[ -1 -1 4 4 4 4]] [(G#sus)[ -1 -1 1 1 2 4 ]] [(G#+)[ -1 -1 2 1 1 0 ]] [(G#dim)[ -1 -1 0 1 0 1 ]] [(G#maj7)[ -1 -1 1 1 1 3 ]] ] def %------------------------------------------------------------------------------- %-PARSERS----------------------------------------------------------------------- % This new section is to allow different methods of entry in different styles. % There is a plan to allow the program to parse ASCII tab, and also for % a possible interface with TabEdit, or other programs. %------------------------------------------------------------------------------- /StdParser { %the usual parser, for tablature. /Parse { /lastwasname false def /barcols 0 def { % open ({) loop ({) search exch { % open (,) loop (,) search exch { %loop again (\n) search exch { %loop again ( ) search exch dup length 0 ne {TabHandler} {pop} ifelse {pop}{exit} ifelse } loop {pop}{exit} ifelse } loop {pop WriteColumn}{exit} ifelse } loop {pop}{exit} ifelse (}) search % assumed true pop exch pop (:) search {exch pop TextHandler} {MarkHandler} ifelse } loop WriteColumn 0 1 barcols 1 sub { BarArray exch get } for % get everything back barcols array astore Atom % linebreaks do printing. /cols barcols plus %more columns... /bars 1 plus %and another bar. } def /WriteColumn { %push column to stack; make a fresh column lastwasname { DefaultColumn DefaultString get dup length array copy CurrentColumn DefaultString 3 -1 roll put } if /lastwasname false def BarArray barcols [0 CurrentColumn] put /barcols barcols 1 add def /CurrentColumn BlankColumn rows array copy def %Do this every time. } def /IsTextRow { % put text into column. CurrentColumn exch 3 -1 roll put } def /IsRow { %if last was row too, fill it in. lastwasname { DefaultColumn DefaultString get dup length array copy CurrentColumn DefaultString 3 -1 roll put } if /DefaultString edef /lastwasname true def } def /IsFret { /lastwasname false def 1 array dup 0 3 index put CurrentColumn DefaultString 2 index put DefaultColumn DefaultString 2 index put pop pop } def /MarkHandler {% what to do with special marks. CurrentColumn DefaultString get 0 get % for sensible use, we must set this dup length 0 eq % if it's not already set. { pop DefaultColumn DefaultString get 0 get /lastwasname false def} if exch { { (tie) {pop 1 2} } { (up) {pop 2 2} } { (down) {pop 3 2} } { (h) {pop 4 2} } { (p) {pop 5 2} } { (harm){pop 6 2} } { (vib) {pop 8 2} } { (0) {pop 7 (0) 3} } { (1) {pop 7 (1) 3} } { (2) {pop 7 (2) 3} } { (3) {pop 7 (3) 3} } { (4) {pop 7 (4) 3} } } ifcase array astore CurrentColumn DefaultString 3 -1 roll put } def } def %------------------------------------------------------------------------------- %-------ASCIIparser: puts any marks that aren't - into the tab. ignores first %------------------- and last thing to avoid spurious barlines. %------------------------------------------------------------------------------- /ASCIIparser { /WholeBar rows array def /WholeLine rows array def BlankColumn WholeLine copy /WholeLine def BlankColumn WholeBar copy /WholeBar def /Parse { %parse ascii tab. 0 1 rows 2 sub { exch (\n) search pop %must be true WholeLine exch 5 -1 roll exch put pop } for %tab now split into rows. now generate columns. WholeLine rows 1 sub 3 -1 roll put { /barcols 0 def /alldone true def /row 0 def { WholeLine row get (|) search { /alldone false def WholeBar row 3 -1 roll put pop WholeLine row 3 -1 roll put } { WholeBar row 3 -1 roll put WholeLine row () put } ifelse /row 1 plus row rows eq {exit} if } loop WholeBar { (-) search { 3 1 roll pop pop dup length 1 sub 0 1 3 -1 roll {1 index exch (-) 0 get put} for pop }{pop} ifelse } forall { /finished true def /makecolumn false def /row 0 def WholeBar { (-) search { /finished false def pop 0 ( ) 0 get put (-) search dup {4 1 roll exch pop exch pop} {exch} ifelse dup dup 4 1 roll length dup 0 ne {3 -1 roll makecolumn or /makecolumn edef} {3 -1 roll pop} ifelse % stick it in the column. string copy 1 array dup 0 4 -1 roll put CurrentColumn row 3 -1 roll put %left with a copy of the string %fill it with minus signs. dup length 1 sub 0 1 3 -1 roll {1 index exch (-) 0 get put} for pop } { pop } ifelse /row 1 plus } forall makecolumn { % write a column ! /row 0 def %needs to blank out later columns. BarArray barcols [0 CurrentColumn] put /barcols barcols 1 add def /CurrentColumn BlankColumn rows array copy def %Do this every time. } if finished {exit} if } loop barcols 0 ne { 0 1 barcols 1 sub { BarArray exch get } for % get everything back barcols array astore Atom % linebreaks do printing. /cols barcols plus %more columns... /bars 1 plus %and another bar. } if alldone {exit} if } loop } def } def %------------------------------------------------------------------------------- %-STYLES------------------------------------------------------------------------ % In this section I define some styles in which % the program will print. You can add more, but % don't change these. %------------------------------------------------------------------------------- %-------Tablature: this is an engine for printing tablature %----------------- in a very general way. It needs some externally %----------------- supplied information to work. %------------------------------------------------------------------------------- /Tablature { /BlankColumn edef /rows BlankColumn length def /DefaultColumn BlankColumn rows array copy def %One-shot initalise /DefaultString 1 def% first string. /CurrentColumn BlankColumn rows array copy def %Do this every time. /BarArray 128 array def %very generous too! % Initialise variables. /hbox 0 def /cols 0 def /bars 0 def BlankColumn 0 1 rows 1 sub { dup 2 index exch get type cvlit /arraytype eq {neg 0.25 add /top edef exit} {pop} ifelse } for rows 1 sub -1 0 { dup 2 index exch get type cvlit /arraytype eq {neg 0.25 add /bottom edef exit} {pop} ifelse } for /bottom top minus pop /vbox {rows 1 add} def /, {Parse} def /NewPage {showpage LeftMargin TopMargin moveto} def /NewLine { bars 0 eq { %very long bar. attempts to recover, %but an extra bar line gets drawn. /bars 1 def /cols barcols def /Justify PageWidth hbox sub cols div def Display /bars -1 def /cols barcols neg def /hbox 0 def } { %/Justify 0 def /hbox barbox minus /Justify PageWidth hbox sub cols div def bars 1 add 1 roll % stick this one on the bottom Display /bars 0 def /cols 0 def /hbox barbox def } ifelse LeftMargin currentpoint vbox fbox mul sub exch pop moveto %usual newline } def /Flush { Parse /Justify 0 def % Don't justify Display %don't bother cleaning up-we're outta here LeftMargin currentpoint vbox fbox mul sub exch pop moveto %usual newline } def /Display { %Draw bar line, tab all columns, draw bar line.. gsave 0 top moverel 0 bottom linerel stroke grestore bars 1 sub -1 0 { index % ...not reverse order [2 BlankColumn] TabColumn { %tab a single column. TabColumn } forall gsave 0 top moverel 0 bottom linerel stroke grestore } for bars {pop} repeat } def /TabColumn { /finger (x) def dup 0 get /cbox edef 1 get gsave { %forall loop gsave dup type cvlit /arraytype eq { /tie 0 def dup length {{1 {pop}} {2 {pop dup 1 get /tie edef}} {3 {pop dup dup 1 get /tie edef 2 get /finger edef}} } ifcase 0 get dup StringWidth cbox exch sub Justify add /rbox edef show gsave 0 0.25 moverel rbox 0 linerel stroke grestore SpecialMarks }{show} ifelse grestore 0 -1 moverel } forall grestore cbox Justify add 0 moverel } def /GetAtom { % needs to set: top,bottom,barcols,barbox,vbox dup %leave a copy on the stack. dup length 1 add /barcols edef /barbox 0 def %1 down! /previous [0] def /oldsbox 0 def /oldcbox 0 def { %forall /cbox 0 def /sbox 0 def 0 1 rows 1 sub { % for loop... 1 index 1 get% copy of array exch get % get this row dup type cvlit /arraytype eq { 0 get %get the string StringWidth cbox max /cbox edef } { StringWidth sbox max /sbox edef } ifelse } for sbox 0 gt {%there is a string oldsbox oldcbox max 2 add dup barbox add /barbox edef previous 0 3 -1 roll put /oldsbox sbox def /oldcbox cbox def } {%there is no string! previous 0 oldcbox 2 add put oldcbox 2 add barbox add /barbox edef /oldsbox oldsbox oldcbox sub 2 sub def /oldcbox cbox def } ifelse /previous edef } forall previous 0 oldsbox oldcbox max 2 add put oldsbox oldcbox max 2 add barbox add /barbox edef /hbox barbox plus } def /SpecialMarks { % produce all the extra bits of notation. gsave tie { {1{pop % code to do ties 0.25 0 moverel rbox 0.5 sub 3 div -0.25 ftop rbox 0.5 sub 3 div 2 mul -0.25 ftop rbox 0.5 sub 0 ftop rcurveto stroke}} {2{pop % code to do slides up 0.25 0 moverel rbox 0.5 sub 0.5 linerel stroke}} {3{pop % code to do slides down 0.25 0.5 moverel rbox 0.5 sub -0.5 linerel stroke}} {4{pop % code to do hammer on 0.5 0.5 moverel 0.25 -0.5 linerel 0.25 0.5 linerel stroke}} {5{pop % code to do pull off 0.5 0 moverel 0.25 0.5 linerel 0.25 -0.5 linerel stroke}} {6{pop % code to do harmonic 0.5 0.25 moverel 0.25 0.25 linerel 0.25 -0.25 linerel -0.25 -0.25 linerel closepath stroke}} {7{pop % code to do finger mark (specify fingering) gsave 1 0.25 moverel currentpoint newpath fbox 2 div 0 360 arc gsave 1 setgray fill grestore stroke grestore 13 16 div 0 moverel finger ToString show}} {8{pop % code to do vibrato 0.25 0.5 moverel 3 {0.125 -0.125 linerel 0.125 0.125 linerel} repeat stroke}} } ifcase grestore } def } def %------------------------------------------------------------------------------- %-------Verbatim: this is the default style. It's intended for reproducing %---------------- blocks of text directly, such as an ASCII tab file. %------------------------------------------------------------------------------- /Verbatim { /, {Parse} def /vbox 1 def /Courier 8 ChooseFont /Parse { % breaks into words. { (\n) search exch { ( ) search exch Atom Display {Atom Display}{exit} ifelse } loop {pop} {exit} ifelse NewLine } loop NewLine } def /GetAtom {dup StringWidth /hbox edef} def /Display {gsave 0 -1 moverel show grestore hbox 0 moverel} def /NewLine { LeftMargin currentpoint vbox fbox mul sub exch pop moveto } def /NewPage {showpage LeftMargin TopMargin moveto} def /Flush {Parse NewLine} def } def %------------------------------------------------------------------------------- %-------Centred: This style produces centred text. It's intended for %--------------- making titles. %------------------------------------------------------------------------------- /Centred { /, {Parse} def /vbox 1 def /Helvetica 12 ChooseFont /Parse { % breaks into words. { (\n) search exch { dup ( ) search { 3 1 roll 0 (\267) putinterval pop Atom pop dup (\267) search pop exch pop ( ) search { pop pop pop exch pop } { pop pop } ifelse } { pop Atom exit } ifelse } loop NewLine pop {pop} {exit} ifelse } loop } def /GetAtom {dup StringWidth /hbox edef} def /Display { dup dup { (\267) search {pop 0 ( ) putinterval} {pop exit} ifelse } loop gsave PageWidth hbox sub 2 div -1 moverel show grestore }def /NewLine { Display LeftMargin currentpoint vbox fbox mul sub exch pop moveto } def /NewPage {showpage LeftMargin TopMargin moveto} def /Flush {Parse} def } def %------------------------------------------------------------------------------- %-------Verses: Each block of text is assumed to be a verse, and this %-------------- style tries to place as many verses horizontally as it can. %------------------------------------------------------------------------------- /Verses { /rows 0 def /vbox 0 def /Times-Roman 8 ChooseFont /, {Parse} def /Parse { /hbox 0 def { (\n) search exch Atom exch {exch pop exch} {exit} ifelse } loop Display } def /GetAtom { dup StringWidth hbox max /hbox edef /rows 1 plus rows vbox max /vbox edef } def /NewLine { LeftMargin currentpoint vbox 1 add fbox mul sub exch pop moveto %usual def ... /vbox rows def % and reset vbox } def /NewPage { showpage LeftMargin TopMargin moveto %usual def.. /vbox rows def % and reset vbox } def /Display { % show whole verse rows -1 1 { gsave neg 0 exch moverel show grestore %start popping strings } for /rows 0 def % reset rows hbox 1 add 0 moverel /hbox 0 def % reset hbox too. } def /Flush {Parse NewLine} def } def %------------------------------------------------------------------------------- %-------Chords: This style prints chord diagrams. It 'knows' over %-------------- 130 chords, but you can use your own. %------------------------------------------------------------------------------- /Chords { /, {Parse} def /vbox 9 def /Times-Roman 8 ChooseFont /Parse {Atom Display} def /Flush {Parse NewLine} def /CentreShow { % centre a string horizontally and vertically gsave dup StringWidth 2 div neg -0.3 moverel% horizontal show grestore %back to centre } def /GetAtom { % first pass, find range, also diagram width. dup type cvlit /stringtype eq { %find it in Chordata Chordata { dup 0 get 2 index eq { %found it 1 get exit % stop search } {pop} ifelse } forall dup type cvlit /stringtype eq { %there was no match [-1 -1 -1 -1 -1 -1] % rescue program } if } if % no action otherwise dup dup length /cols edef % width of diagram. /top -2 def /bottom 99 def { dup type cvlit /arraytype eq { 0 get } if %pop % don't want string this time round. dup top max /top edef %highest fret dup 0 gt %ignore 0 fret, unplayed strings { bottom min /bottom edef } { pop } ifelse } forall top 5 le { /top 5 def /bottom 0 def } { /top bottom 5 add def bottom 1 sub /bottom edef } ifelse /hbox cols 2 add def } def /Display { %style object. gsave 0.5 -1 moverel gsave -1 -1 -6 { 1 exch moverel cols 1 sub 0 linerel stroke grestore gsave } for bottom 0 eq { % gotta draw extra line. 1 -0.875 moverel cols 1 sub 0 linerel stroke % ok that's it. } if %label first fret elsewhere... grestore gsave 1 -0.5 moverel { dup type cvlit /arraytype eq { aload pop ToString } { () } ifelse exch dup gsave % draw string 0 -0.5 moverel 0 -5 linerel stroke grestore gsave 0 le { % something is printed here -1 eq { (x) CentreShow } { (o) CentreShow } ifelse pop % if we did that,that's this string done. } { % figure out where to put this string bottom sub neg 0 exch moverel gsave currentpoint newpath 0.5 fbox mul 0 360 arc gsave 1 setgray fill grestore stroke grestore CentreShow } ifelse grestore 1 0 moverel } forall bottom 0 ne { % label first fret. 0 -0.5 moverel bottom ToString CentreShow } if grestore cols 1 add 2 div -7 moverel CentreShow %write name centred. grestore cols 2 add 0 moverel } def /NewLine { LeftMargin currentpoint vbox fbox mul sub exch pop moveto } def /NewPage {showpage LeftMargin TopMargin moveto} def } def %------------------------------------------------------------------------------- %-------ChordPro: This style prints chords above lyrics, a la ChordPro %------------------------------------------------------------------------------- /ChordPro { /vbox 3 def /Times-Roman 8 ChooseFont /, {Parse} def /Flush {Parse NewLine} def /Parse { %split into atoms { (\n) search exch { ([) search { dup length 0 ne { Atom Display } { pop } ifelse pop } { Atom Display exit } ifelse } loop {pop NewLine} {exit} ifelse } loop } def /GetAtom { % get width attributes of atom /hbox 0 def dup (]) search % contains a chord ? { StringWidth 1 add /hbox edef pop StringWidth hbox max /hbox edef } { StringWidth /hbox edef } ifelse }def /Display { (]) search % contains a chord ? { gsave 0 -1 moverel show grestore pop } if gsave 0 -2 moverel show grestore hbox 0 moverel } def /NewLine { LeftMargin currentpoint vbox fbox mul sub exch pop moveto } def /NewPage {showpage LeftMargin TopMargin moveto} def } def %------------------------------------------------------------------------------- %-------Guitar: an example of a style that uses Tablature. It defines the %-------------- things that Tablature needs to know, for printing guitar %-------------- tab with a row of text above & below. %------------------------------------------------------------------------------- /Guitar { % a tab style. this must come BEFORE 'Tablature' /Times-Roman 8 ChooseFont StdParser % usual method of entry. /TextHandler {% what to do with text.depends how many text objects you have. { { (chord) {pop 0 IsTextRow} } { (lyric) {pop 7 IsTextRow} } } ifcase } def /TabHandler {% what you call the rows that contain strings. { { (e) {pop 1 IsRow} } { (B) {pop 2 IsRow} } { (G) {pop 3 IsRow} } { (D) {pop 4 IsRow} } { (A) {pop 5 IsRow} } { (E) {pop 6 IsRow} } { /default {IsFret}} } ifcase } def %template [() [()][()][()][()][()][()] ()] } def /ASCIItab { % a tab style. this must come BEFORE 'Tablature' /Times-Roman 8 ChooseFont [[()][()][()][()][()][()]] Tablature ASCIIparser } def %------------------------------------------------------------------------------- %-DOCUMENT SETUP---------------------------------------------------------------- %This section defines the margins of the page, and %the line thickness used in the program. you may want %to change some of this. %------------------------------------------------------------------------------- GetPageMargins /LeftMargin 1 inch smaller /RightMargin 1 inch smaller /TopMargin 1 inch smaller /BottomMargin 1 inch smaller 0.1 setlinewidth /Text { /Times-Roman 8 ChooseFont } def %------------------------------------------------------------------------------- %-DOCUMENT---------------------------------------------------------------------- % Your PStab files are added beyond this point. %-------------------------------------------------------------------------------