(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "INTERLISP")

(FILECREATED "23-Mar-94 17:45:59" |{DSK}<king>export>lispcore>internal>library>CALENDARHACKS.;3|
 11258  

      |changes| |to:|  (FNS PRINTMONTHIMAGE PRINT-NOTEBOOK-YEAR PRINT-SUMMARY-YEAR PRINT-SCALED-MONTH
                            )

      |previous| |date:| "15-Jun-90 11:46:01" 
|{DSK}<king>export>lispcore>internal>library>CALENDARHACKS.;1|)


; Copyright (c) 1987, 1990, 1994 by Venue & Xerox Corporation.  All rights reserved.

(PRETTYCOMPRINT CALENDARHACKSCOMS)

(RPAQQ CALENDARHACKSCOMS

       (
        (* |;;| "Hacks for making reminder-book pages for calendars.")


        (FILES CALENDAR)
        (COMS 
              (* |;;| "User level functions")


              (FNS PRINT-LAND-MONTH PRINT-LAND-YEAR PRINT-NOTEBOOK-MONTH PRINT-NOTEBOOK-YEAR 
                   PRINT-SUMMARY-YEAR PRINT-NARROW-MONTH))
        (COMS 
              (* |;;| "Internal functions and macros")


              (FNS PRINT-SCALED-MONTH PRINTMONTHIMAGE)
              (FUNCTIONS CAL-X CAL-Y))))



(* |;;| "Hacks for making reminder-book pages for calendars.")



(FILESLOAD CALENDAR)



(* |;;| "User level functions")


(DEFINEQ

(PRINT-LAND-MONTH

  (LAMBDA (MONTH YEAR STREAM)
                                (* \; "Edited 17-Oct-87 17:45 by jds")

          
          (* |;;| "Print a single month's calendar landscape on letter paper.")


    (LET ((PRINTSTREAM (OR STREAM (OPENIMAGESTREAM "{LPT}" 'INTERPRESS '(LANDSCAPE T)))))
         (PRINT-SCALED-MONTH
 MONTH YEAR 635 635 1.0 1.0 PRINTSTREAM 12 18 6)
         (CLOSEF PRINTSTREAM))))

(PRINT-LAND-YEAR

  (LAMBDA (YEAR STREAM)
                                      (* \; "Edited 17-Oct-87 17:49 by jds")

          
          (* |;;| "Print a single month's calendar landscape on letter paper.")


    (LET ((PRINTSTREAM (OR STREAM (OPENIMAGESTREAM "{LPT}" 'INTERPRESS '(LANDSCAPE T)))))
         (|for|
 MONTH |from|
 1 |to|
 12
            |do|
 (PRINT-SCALED-MONTH
 MONTH YEAR 635 635 1.0 1.0 PRINTSTREAM 12 18 6)
                 (DSPNEWPAGE PRINTSTREAM))
         (CLOSEF PRINTSTREAM))))

(PRINT-NOTEBOOK-MONTH

  (LAMBDA (MONTH YEAR STREAM)
                                (* \; "Edited 17-Sep-87 21:55 by jds")

          
          (* |;;| "Print a single month's calendar on a half-sheet, suitable for punching and putting in a Time-Design notebook or a 5 1/2 x 8 1/2\" reminder book.")

          
          (* |;;| "If you leave STREAM NIL, you'll get one page on the printer.")


    (PRINT-SCALED-MONTH
 MONTH YEAR 0 0 0.75 0.6 STREAM)))

(PRINT-NOTEBOOK-YEAR

  (LAMBDA (YEAR STREAM)
                       (* \; "Edited 23-Mar-94 17:22 by turpiN:mv:envos")


    (* |;;| "Print a year's worth of month-calendar pages in half-sheet size.")


    (LET ((PRINTSTREAM (OR STREAM (OPENIMAGESTREAM "{LPT}" 'POSTSCRIPT))))
         (|for|
 MONTH |from|
 1 |to|
 12 |do|
 (PRINT-SCALED-MONTH
 MONTH YEAR 0
                                                                   (COND
                                                                      ((EVENP MONTH 2)
                                                                       13970)
                                                                      (T 0))
                                                                   0.75 0.6 PRINTSTREAM)
                                                         (COND
                                                            ((EVENP MONTH 2)
                                                             (DSPNEWPAGE PRINTSTREAM))))
         (CLOSEF PRINTSTREAM))))

(PRINT-SUMMARY-YEAR

  (LAMBDA (YEAR STREAM)
                       (* \; "Edited 23-Mar-94 17:36 by turpiN:mv:envos")


    (* |;;| "Print a year's worth of small months on 1 sheet of paper that will fit into a 8.25 x 10.5 format (for Time-Design books).")


    (LET ((PRINTSTREAM (OR STREAM (OPENIMAGESTREAM "{LPT}" 'POSTSCRIPT '(LANDSCAPE T)))))
         (|for|
 MONTH |from|
 1 |to|
 4 |as|
 YOFFSET |from|
 44500 |by|
 -14800
            |do|
 (PRINT-SCALED-MONTH
 MONTH YEAR 227 YOFFSET 0.33 0.23 PRINTSTREAM 6 8 6))
         (|for|
 MONTH |from|
 5 |to|
 8 |as|
 YOFFSET |from|
 44500 |by|
 -14800
            |do|
 (PRINT-SCALED-MONTH
 MONTH YEAR 25427 YOFFSET 0.33 0.23 PRINTSTREAM 6 8 6))
         (|for|
 MONTH |from|
 9 |to|
 12 |as|
 YOFFSET |from|
 44500 |by|
 -14800
            |do|
 (PRINT-SCALED-MONTH
 MONTH YEAR 50627 YOFFSET 0.33 0.23 PRINTSTREAM 6 8 6))
         (CLOSEF PRINTSTREAM))))

(PRINT-NARROW-MONTH

  (LAMBDA (MONTH YEAR STREAM)
                                (* \; "Edited 17-Sep-87 22:32 by jds")


    (PRINT-SCALED-MONTH
 MONTH YEAR 0 0 0.45 0.95 STREAM NIL NIL NIL '(LANDSCAPE T))))
)



(* |;;| "Internal functions and macros")


(DEFINEQ

(PRINT-SCALED-MONTH

  (LAMBDA (MONTH YEAR X-OFFSET Y-OFFSET X-SCALE Y-SCALE STREAM DAYSIZE DATESIZE TINYSIZE OPTIONS)

                                                  (* \; "Edited 23-Mar-94 17:24 by turpiN:mv:envos")


    (* |;;| 

  "Print a month's calendar on STREAM. MONTH is a number 1-12, Year is the year, 19-- and all.")


    (PROG ((STREAM-EXISTED STREAM)
           PBIGFONT PCALFONT PLITTLEFONT)
          (SETCURSOR WAITINGCURSOR)
          (PRINTOUT PROMPTWINDOW T "Formatting for print...")
          (SETQ STREAM (OR STREAM (OPENIMAGESTREAM "{LPT}" 'POSTSCRIPT OPTIONS)))
          (SETQ PBIGFONT (FONTCREATE 'MODERN (OR DAYSIZE 8)
                                NIL 0 STREAM))
          (SETQ PCALFONT (FONTCREATE 'CLASSIC (OR DATESIZE 12)
                                NIL 0 STREAM))
          (SETQ PLITTLEFONT (FONTCREATE 'MODERN (OR TINYSIZE 6)
                                   NIL 0 STREAM))
          (PRINTMONTHIMAGE
 MONTH YEAR STREAM X-OFFSET Y-OFFSET X-SCALE (OR Y-SCALE X-SCALE)
                 PBIGFONT PCALFONT PLITTLEFONT)              (* \; "Print horizontal lines")

          (OR STREAM-EXISTED (CLOSEF STREAM))
          (PRINTOUT PROMPTWINDOW "done." T)
          (CURSOR T))))

(PRINTMONTHIMAGE

  (LAMBDA (MONTH YEAR STREAM XOFFSET YOFFSET X-SCALE Y-SCALE DAYFONT DATEFONT TINYDATEFONT)

                                                  (* \; "Edited 23-Mar-94 17:42 by turpiN:mv:envos")


    (* |;;| 

  "Print a month's calendar on STREAM. MONTH is a number 1-12, Year is the year, 19-- and all.")


    (* |;;| 

  " X-SCALE & XOFFSET,  and Y-SCALE & YOFFSET are used in the CAL-X and CAL-Y macros, resp.")


    (* |;;| "DAYFONT and DATEFONT are used for printing the day names and dates/month title resp.")


    (DSPRESET STREAM)
    (DSPRIGHTMARGIN 65535 STREAM)
    (LET ((TITLESTRING (CONCAT (MONTHNAME MONTH)
                              "   " YEAR)))
         (MOVETO (- (CAL-X
 37559)
                    (IQUOTIENT (STRINGWIDTH TITLESTRING DATEFONT)
                           2))
                (CAL-Y
 57827)
                STREAM))
    (DSPFONT DATEFONT STREAM)
    (PRINTOUT STREAM (MONTHNAME MONTH)
           "   " YEAR)
    (LET ((DAYLABELS (APPEND (|for|
 N |from|
 1 |to|
 (DAYOF MONTH 1 YEAR)
                                |collect|
 '\ )
                            (|for|
 N |from|
 1 |to|
 (DAYSIN MONTH YEAR) |collect|

                                                                                   N)))
          (X 1559)
          (Y 47339)
          (CT 0))
         (|for|
 I |in|
 DAYLABELS |do|
 

                                              (* |;;| "Print blanks up to the first day of the month (to allow for not starting on Sunday), then print the dates.")


                                               (MOVETO (CAL-X
 X)
                                                      (CAL-Y
 Y)
                                                      STREAM)
                                               (PRIN1 I STREAM)
                                               (|add|
 X 10630)
                                               (|add|
 CT 1)
                                               (COND
                                                  ((EQ (IREMAINDER CT 7)
                                                       0)
                                                   (SETQ X 1701)
                                                   (|add|
 Y -8974)))))
    (|for|
 X |from|
 850 |to|
 75968 |by|
 10630 |do|
 

                                                                    (* |;;| "Print vertical lines")


                                                                    (DRAWLINE (CAL-X
 X)
                                                                           (CAL-Y
 1701)
                                                                           (CAL-X
 X)
                                                                           (CAL-Y
 55559)
                                                                           40
                                                                           'PAINT STREAM))
    (|for|
 Y |from|
 1701 |to|
 55559 |by|
 8974 |do|
 

                                                                    (* |;;| 

                                                                  "Print horizontal lines")


                                                                    (DRAWLINE (CAL-X
 850)
                                                                           (CAL-Y
 Y)
                                                                           (CAL-X
 75260)
                                                                           (CAL-Y
 Y)
                                                                           40
                                                                           'PAINT STREAM))
    (DSPFONT DAYFONT STREAM)
    (|for|
 X |from|
 2268 |to|
 72567 |by|
 10630 |as|
 D |from|
 0 |to|

                                                                                       6
       |do|
 

             (* |;;| "Print day names")


             (MOVETO (CAL-X
 X)
                    (CAL-Y
 56126)
                    STREAM)
             (PRIN1 (DAYNAME D)
                    STREAM))
    (COND
       ((>= X-SCALE 0.7)
        (DSPFONT PLITTLEFONT STREAM)
        (SHOWMONTHSMALL (MONTHPLUS MONTH -1)
               (MONTHYEARPLUS MONTH YEAR -1)
               (CAL-X
 54709)
               (CAL-Y
 2693)
               (FTIMES X-SCALE 28.0)
               STREAM)
        (SHOWMONTHSMALL (MONTHPLUS MONTH 1)
               (MONTHYEARPLUS MONTH YEAR 1)
               (CAL-X
 65480)
               (CAL-Y
 2693)
               (FTIMES X-SCALE 28.0)
               STREAM)))
    STREAM))
)

(DEFMACRO CAL-X
 (VALUE)
   `(+ XOFFSET (FIXR (FTIMES ,VALUE X-SCALE))))

(DEFMACRO CAL-Y
 (VALUE)
   `(+ YOFFSET (FIXR (FTIMES ,VALUE Y-SCALE))))
(PUTPROPS CALENDARHACKS COPYRIGHT ("Venue & Xerox Corporation" 1987 1990 1994))
(DECLARE\: DONTCOPY
  (FILEMAP (NIL (1199 4926 (PRINT-LAND-MONTH 1209 . 1638) (PRINT-LAND-YEAR 1640 . 2174) (
PRINT-NOTEBOOK-MONTH 2176 . 2650) (PRINT-NOTEBOOK-YEAR 2652 . 3705) (PRINT-SUMMARY-YEAR 3707 . 4700) (
PRINT-NARROW-MONTH 4702 . 4924)) (4976 11001 (PRINT-SCALED-MONTH 4986 . 6231) (PRINTMONTHIMAGE 6233 . 
10999)))))
STOP