github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-04-24 19:40:36 +00:00
Code Issues Projects Releases Wiki Activity

Move internal/library to internal, xerox font dirs, loadup and medleydir (#709)

Browse Source 
* Move internal/library to internal, xerox font dirs, loadup and medleydir

* and MEDLEYDIR too

* mised some changes in 'promote/internal'

* tiny typo
This commit is contained in:
Larry Masinter
2022-02-28 21:44:12 -08:00
committed by GitHub
parent acc08e0dd7
commit 6de8d3ec77
99 changed files with 115 additions and 47 deletions
Download Patch File Download Diff File Expand all files Collapse all files

248
internal/CALENDARHACKS Normal file
View File

@@ -0,0 +1,248 @@
(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