perm filename CYCXGP[DEN,LMM] blob
sn#034882 filedate 1973-04-14 generic text, type T, neo UTF8
(DEFPROP CYCXGPFNS
(CYCXGPFNS (SAVVALUE (QUOTE (REALBOTTOM REALEFT REALHEIGHT EPSILON)))
(SAVDEF (QUOTE (APT AIVECT AVECT LABELL INITDRAW ENDDRAW)))
APT
AIVECT
AVECT
MOVBITS
SELFONT
SETFONT
PRINCMAKNUM
MAKNUM
LOGAND
LABELL
INITDRAW
ENDDRAW
CLOSEXGP
(SETQ XGPOUT NIL)
(SETQ REALBOTTOM 1.)
(SETQ REALEFT -511.)
(SETQ REALHEIGHT (SETQ REALWIDTH 512.))
(SETQ EPSILON 0.5))
VALUE)
(SAVVALUE (QUOTE (REALBOTTOM REALEFT REALHEIGHT EPSILON)))
(SAVDEF (QUOTE (APT AIVECT AVECT LABELL INITDRAW ENDDRAW)))
(DEFPROP APT
(LAMBDA (N1 N2) (PROGN (PRINC (QUOTE /␈)) (PRINC (QUOTE "P")) (PRINCMAKNUM N1) (PRINCMAKNUM N2)))
EXPR)
(DEFPROP AIVECT
(LAMBDA (N1 N2) (PROGN (PRINC (QUOTE /␈)) (PRINC (QUOTE "I")) (PRINCMAKNUM N1) (PRINCMAKNUM N2)))
EXPR)
(DEFPROP AVECT
(LAMBDA (N1 N2) (PROGN (PRINC (QUOTE /␈)) (PRINC (QUOTE "V")) (PRINCMAKNUM N1) (PRINCMAKNUM N2)))
EXPR)
(DEFPROP MOVBITS
(LAMBDA(BITS)
(COND ((MINUSP BITS) (PRINC (QUOTE /␈)) (PRINC (QUOTE /␈)) (PRINC (ASCII (MINUS BITS))))
(T (PRINC (QUOTE /␈)) (PRINC (QUOTE " ")) (PRINC (ASCII BITS)))))
EXPR)
(DEFPROP SELFONT
(LAMBDA (DIG) (PROG2 (PRINC (QUOTE /␈)) (PRINC DIG)))
EXPR)
(DEFPROP SETFONT
(LAMBDA (FIL DIG) (PROG2 (PRINC (QUOTE /␈)) (PRINC λ) (PRINC FIL) (PRINC PP) (PRINC DIG)))
EXPR)
(DEFPROP PRINCMAKNUM
(LAMBDA (I) (PROG2 (TYO (PLUS (QUOTIENT I 130.) 64.)) (TYO (LOGAND I 127.))))
EXPR)
(DEFPROP MAKNUM
(LAMBDA (I) (READLIST (LIST (ASCII (PLUS (QUOTIENT I 130.) 64.)) (ASCII (LOGAND I 127.)))))
EXPR)
(DEFPROP LOGAND
(LAMBDA (A B) (BOOLE 1. A B))
EXPR)
(DEFPROP LABELL
(LAMBDA (MS) (PRINC MS))
EXPR)
(DEFPROP LABELL
(NIL (3. . C) (2. . C) (6. . CO) (4. . C) (5. . C) (1. . C))
VALUE)
(DEFPROP LABELL
(NIL)
SPECIAL)
(DEFPROP INITDRAW
(LAMBDA NIL
(PROGN (OUTC
(OR# XGPOUT
(SETQ XGPOUT
(EVAL
(CONS (QUOTE OUTPUT)
(PROG2 (PROG2 (TERPRI) (PRINC (QUOTE "XGP OUTPUT FILE?")))
(LIST (QUOTE XGPOUT) (QUOTE DSK:) (READ))))))))
(LINELENGTH 10000.)
(SETQ REALWIDTH (SETQ REALHEIGHT 512.))
(OR (LESSP (SETQ REALEFT (PLUS 512. REALEFT)) 1024.)
(PROG2 (SETQ REALEFT 1.) (LESSP (SETQ REALBOTTOM (PLUS 512. REALBOTTOM)) 1536.))
(PROG2 (SETQ REALBOTTOM 1.) (TERPRI) (PRINC (QUOTE ""))))))
EXPR)
(DEFPROP ENDDRAW
(LAMBDA NIL (PROG2 (LINELENGTH 72.) (OUTC NIL NIL)))
EXPR)
(DEFPROP CLOSEXGP
(LAMBDA NIL
(PROG2 (SETQ REALEFT -511.)
(SETQ REALBOTTOM 1.)
(AND XGPOUT (PROG2 (SETQ XGPOUT NIL) (OUTC (QUOTE XGPOUT) NIL) (OUTC NIL T)))))
EXPR)
(SETQ XGPOUT NIL)
(SETQ REALBOTTOM 1.)
(SETQ REALEFT -511.)
(SETQ REALHEIGHT (SETQ REALWIDTH 512.))
(SETQ EPSILON 0.5)