perm filename CYCXGP.PRT[4,LMM] blob
sn#037540 filedate 1973-04-23 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.0)
(SETQ REALEFT -511.0)
(SETQ REALHEIGHT (SETQ REALWIDTH 512.0))
(SETQ EPSILON .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.0)
64.0))
(TYO (LOGAND I 127.0))))
EXPR)
(DEFPROP MAKNUM (LAMBDA (I)
(READLIST (LIST (ASCII (PLUS (QUOTIENT I
130.0)
64.0))
(ASCII (LOGAND I 127.0)))))
EXPR)
(DEFPROP LOGAND (LAMBDA (A B)
(BOOLE 1.0 A B))
EXPR)
(DEFPROP LABELL (LAMBDA (MS)
(PRINC MS))
EXPR)
(DEFPROP LABELL (NIL (3.0 . C)
(2.0 . C)
(6.0 . CO)
(4.0 . C)
(5.0 . C)
(1.0 . 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.0)
(SETQ REALWIDTH (SETQ REALHEIGHT 512.0))
(OR (LESSP (SETQ REALEFT (PLUS 512.0 REALEFT))
1024.0)
(PROG2 (SETQ REALEFT 1.0)
(LESSP (SETQ REALBOTTOM (PLUS 512.0 REALBOTTOM))
1536.0))
(PROG2 (SETQ REALBOTTOM 1.0)
(TERPRI)
(PRINC (QUOTE ""))))))
EXPR)
(DEFPROP ENDDRAW (LAMBDA NIL (PROG2 (LINELENGTH 72.0)
(OUTC NIL NIL)))
EXPR)
(DEFPROP CLOSEXGP (LAMBDA NIL
(PROG2 (SETQ REALEFT -511.0)
(SETQ REALBOTTOM 1.0)
(AND XGPOUT
(PROG2 (SETQ XGPOUT NIL)
(OUTC (QUOTE XGPOUT)
NIL)
(OUTC NIL T)))))
EXPR)
(SETQ XGPOUT NIL)
(SETQ REALBOTTOM 1.0)
(SETQ REALEFT -511.0)
(SETQ REALHEIGHT (SETQ REALWIDTH 512.0))
(SETQ EPSILON .5)
STOP