From: sherwin@mcis2.enet.dec.com (Jim Sherwin)
Subject: Re: Labels for Video Tapes
Organization: DEC -- Greater Marlboro Area Property Management
Date: 16 NOV 92 15:55:38 EDT


In article <13NOV199209530837@lheavx.gsfc.nasa.gov>, orlandini@lheavx.gsfc.nasa.gov (Mauro Orlandini) writes...
>       I am wondering if there exists a PostScript program to create
>       labels for Video Tapes. I know of such a file for audio cassettes,
>       but I am not aware of something for videos.

	I pulled this from this news group about 18 months ago.

<<<<<<<<<<<<<<<  cut here ... dont forget to delete the tailer  >>>>>>>>>>>>>>>>
%!PS-Adobe-1
%%Creator: Jamie Zawinski <jwz@lucid.com>
%%Title: video-tape.ps
%%CreationDate: 1-mar-91
%%
%%  PostScript code to generate VHS video cassette labels.  Version 2.0.
%%  Copyright (c) 1991 Jamie Zawinski <jwz@lucid.com>.  Comments welcome.
%%
%%  Permission granted for non-commercial use and distribution so long as
%%  this notice of copyright remains intact.
%%
%%  There are examples of how to use this code at the end of this file.
%%
%%  I find that rubber cement works best for attaching these labels to
%%  video cassettes.  A water-based glue or epoxy will cause the paper
%%  to warp eventually.
%%
%%EndComments

% Set this to any (short) string you like.
/ID (JWZ) def
/side-font   /Helvetica-Bold def
/top-font    /Helvetica-Bold def
/header-font /Helvetica-Bold def
/number-font /Helvetica-Bold def

% swap the values of FG and BG if you want black-on-white.
/FG 1   def
/MG 0.5 def
/BG 0   def

/bdef { bind readonly def } bind readonly def

/box {
  4 2 roll
  newpath moveto
    exch dup 0 rlineto
    exch 0 exch neg rlineto
    neg 0 rlineto
  closepath
} bdef

/rightshow
 {dup stringwidth pop
  neg 0 rmoveto
  show } bdef

/centershow
 {dup stringwidth pop
  2 div neg 0 rmoveto
  show } bdef

/inch { 72 mul } bdef

/internal-draw-side-label {
  gsave
    1 setlinejoin
    MG setgray
    0 0 5.75 inch 0.75 inch  box fill
    0 setgray
    0 0 5.75 inch  0.75 inch  box stroke
    BG setgray
    1 inch -0.1 inch  4.25 inch 0.55 inch box fill
    0.1 inch -0.1 inch  0.25 inch 0.55 inch box fill
    FG setgray
    1 inch -0.1 inch  4.25 inch 0.55 inch box stroke
    0.1 inch -0.1 inch  0.25 inch 0.55 inch box stroke
    gsave
      number-font findfont [21 0 0 18 0 0] makefont setfont
      0.324 inch -0.375 inch moveto
      90 rotate
      dup stringwidth pop /sw exch def
      sw 0.54 inch gt { 0.54 inch sw div 1 scale } if
      centershow
    grestore
} bdef

/draw-side-label {
  gsave
    0 0 moveto
    translate
    internal-draw-side-label
    /names exch def
    /height 0.5 inch names length div def
    side-font findfont [height 0.9 mul 0 0 height 0 0] makefont setfont
    FG setgray
    1.05 inch -0.1 inch height sub moveto
    names {
      dup type /arraytype eq
      { dup 0 get gsave show grestore
	1 get gsave 4.1 inch 0 rmoveto rightshow grestore }
      { gsave show grestore }
      ifelse
      0 height neg rmoveto
    } forall
  grestore
} bdef


/internal-draw-top-label {
  gsave
     1 setlinejoin
     MG setgray
     0 0 3.1 inch 1.75 inch box fill
     0 setgray 
     0 0 3.1 inch 1.75 inch box stroke
     BG setgray 
     0.1 inch  -0.5 inch  2.9 inch  1.15 inch  box fill
     0.1 inch  -0.1 inch  2.9 inch  0.3 inch   box fill
     FG setgray
     0.1 inch  -0.5 inch  2.9 inch  1.15 inch  box stroke
     0.1 inch  -0.1 inch  2.9 inch  0.3 inch   box stroke

     header-font findfont [12 0 0 15 0 0] makefont setfont
     0.2 inch -0.3 inch moveto   (Tape )show show
     header-font findfont [8 0 0 15 0 0] makefont setfont
     2.9 inch -0.3 inch moveto   ID rightshow
  grestore
} bdef

/draw-top-label {
  gsave
    0 0 moveto
    translate
    internal-draw-top-label
    /names exch def
    top-font findfont [9 0 0 10 0 0] makefont setfont
    FG setgray
    0.2 inch -0.5 inch 9 dup add sub moveto
    names {
      dup type /arraytype eq
      { dup 0 get gsave show grestore
	1 get gsave 2.7 inch 0 rmoveto rightshow grestore }
      { gsave show grestore }
      ifelse
      0 -9 rmoveto
    } forall
  grestore
} bdef

/flag false def
/count 0 def

/showpage {
  initgraphics
  0 setgray
  8 inch 0.25 inch moveto 90 rotate
  /Helvetica findfont 6 scalefont setfont
  (video-tape.ps, version 2.0 (c) 1991 Jamie Zawinski <jwz@lucid.com>) show
  systemdict begin showpage end
} bdef

/draw-label {
  /names exch def
  /number exch def
  names number 0.5 inch
    flag { 3.58 inch } { 1.02 inch } ifelse
  names number
    flag { 3.63 inch } { 0.5 inch } ifelse
  2.8 inch
  gsave draw-top-label grestore
  gsave draw-side-label grestore
  flag {
    0 3.35 inch translate
    /count count 1 add def
    count 3 eq { showpage /count 0 def } if
  } if
  /flag flag not def
} bdef

%%EndProlog

%% Examples.


(006)	[[(DEFCON-4)				(0)]
	 [(Videodrome)				()]
	 [(An American Werewolf in London)	()]]
draw-label

(008)	[(Birdy)
	 (Rosemary's Baby)
	 (Repo Man)
	 (How the Grinch Stole Christmas)]
draw-label

(023)	[[(The Art of Noise Live)		(0)]
	 [(Duran Duran)				(1117)]
	 [(Depeche Mode Live in Hamburg)	(1880)]
	 [(The The: Infected)			(2548)]
	 [(Sugarcubes Live)			(3487)]
	 [(Siouxsie and the Banshees: Once Upon a Time)	()]]
draw-label

(028)	[[(The Thing)				(0)]
	 [(Attack of the Killer Tomatoes)	(1844)]
	 [(Time Bandits)			(2840)]
	 [(Max Headroom)			(3922)]
	 [()					(4410)]]
draw-label

(057)	[[(Someone to Watch Over Me)		(0:00)]
	 [(The Abyss)				(1:46)]
	 [(Internal Affairs)			(4:11)]
	 [()					(6:04)]]
draw-label

(002)	[(Logan's Run)
	 (The Terminator)
	 (The Hunger)
	 (New Twilight Zone: "Aqua Vita")]
draw-label

(051)	[[(The Blob)				(0)]
	 [(Straight to Hell)			(1653)]
	 [(Legend)				(2679)]
	 [(The Company of Wolves)		(4:29)]]
draw-label

(053)	[[(Tapeheads)				(0)]
	 [(Hellbound: Hellraiser 2)		(1:33)]
	 [(The Kiss)				(3:11)]
	 (Penn and Teller's Cruel Tricks)
	 [(  for Dear Friends)			(4:56)]]
draw-label


%%Trailer
%
% This line must always be at the end of the file to ensure 
% that the last page is forced out even if it's not full.
%
count 0 eq not { showpage } if
<<<<<<<<<<<<<<<  cut here  >>>>>>>>>>>>>>>>
 <>-<>-<>-<>-<>-<>-<>-<>-<>-<>-<>-<>-<>-<>-<>-<>-<>-<>-<>-<>-<>-<>-<>-<>-<>-<>
 <> "When things are going well,   \    Jim Sherwin a.k.a.                  <>
 <>  someone will inevitably        \   sherwin@mcis2.enet.dec.com         <>
 <>  experiment detrimentally."      \  !decwrl!mcis2.enet.dec.com!sherwin <>
 <>               Boyle's Second Law  \ sherwin%mcis2.enet@decwrl.dec.com  <>
 <>-<>-<>-<>-<>-<>-<>-<>-<>-<>-<>-<>-<>-<>-<>-<>-<>-<>-<>-<>-<>-<>-<>-<>-<>-<>
Newsgroups: comp.lang.idl-pvwave