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