(DECLARE (SPECIAL FASL-OP-INITIALIZE-NUMERIC-ARRAY FASD-GROUP-LENGTH ;-*-LISP-*- CONVERT-LOW-HALF-NIBBLE PICTURE-ARRAY-LEADER-SIZE)) (DECLARE (FIXNUM (FASD-TABLE-ENTER NOTYPE NOTYPE)) (NOTYPE (FASD-START-GROUP NOTYPE FIXNUM FIXNUM) (FASD-FIXED FIXNUM) (FASD-INITIALIZE-ARRAY FIXNUM NOTYPE) (FASD-INDEX FIXNUM) (FASD-EVAL FIXNUM) (FASD-NIBBLE FIXNUM))) (DEFPROP SSTATUS-FTV (QIOFTV FASL DSK BWOOD) AUTOLOAD) (DEFPROP SSTATUS-IMAGE-FILE (FORMAT FASL DSK BWOOD) AUTOLOAD) (DECLARE (FIXNUM (IMAGE FIXNUM FIXNUM))) (SETQ PICTURE-ARRAY-LEADER-SIZE 30.) ;NOTE!! THIS MUST BE SET > OR = THE NUMBER OF ;ENTRIES IN THE PICTURE DEFSTRUCT IN LMPICT;LPDEFS!! (DEFUN CONVERT-POINTS FEXPR (FILESPEC) ;USER CALLS THIS (PROG (RES IN-FILE NEW-FORMAT-P NAME) (SETQ FILESPEC (MERGEF FILESPEC '|DSK:LMIO;POINTS *|)) (PRINT FILESPEC) (SETQ NAME (COND ((EQ (CADR FILESPEC) 'POINTS) (CADDR FILESPEC)) (T (CADR FILESPEC)))) (PRINC ' /OUTPUT/ NAME/ IS/ ) (PRIN1 NAME) (SETQ IN-FILE (OPEN FILESPEC '(IN BLOCK FIXNUM))) (COND ((= (IN IN-FILE) -1) (SETQ NEW-FORMAT-P T) (PRINT 'FILE-IN-NEW-FORMAT))) (CLOSE IN-FILE) (FASD-OPEN (MERGEF FILESPEC '(_CVP_ OUTPUT))) (FASD-INITIALIZE) (COND ((NULL NEW-FORMAT-P) (SETQ RES (APPLY 'SSTATUS-FTV FILESPEC)) ;AVOID BEING SCREWWED BY AUTOLOAD (CONVERT-FTV-RES NAME RES (FUNCTION CONVERT-TRANSFER))) (T (SETQ RES (APPLY 'SSTATUS-IMAGE-FILE FILESPEC)) (CONVERT-FTV-RES NAME RES (FUNCTION CONVERT-TRANSFER-NEW)))) (FASD-END-WHACK) (FASD-END-OF-FILE) (FASD-CLOSE (LIST NAME 'QFASL)) (RETURN T) )) (DEFUN CONVERT-FTV-RES (FILE-NAME RES FCTN) (PROG (QFT) (SETQ QFT (FASD-MAKE-ARRAY 'WORKING-STORAGE-AREA 'ART-8B (LIST (- (CAADR RES) (CAAR RES)) (- (CADADR RES) (CADAR RES))) NIL PICTURE-ARRAY-LEADER-SIZE )) ;STANDARD LEADER .. ; 0 FILL-POINTER ; 1 NAME-HANDLER -> PICTURE-HANDLER ; 2 NAME ; 3 MIN INTENSITY OR NIL ; 4 MAX INTENSITY ; (FASD-STOREIN-ARRAY-LEADER QFT (FASD-CONSTANT 1) (FASD-CONSTANT 'PICTURE-HANDLER)) (FASD-STOREIN-ARRAY-LEADER QFT (FASD-CONSTANT 2) (FASD-CONSTANT FILE-NAME)) (FASD-STOREIN-SYMBOL-VALUE FILE-NAME QFT) (FASD-EVAL (FASD-CONSTANT (LIST 'MAKE-ARRAY-INTO-NAMED-STRUCTURE FILE-NAME))) (FUNCALL FCTN QFT RES))) (DEFUN CONVERT-TRANSFER (IDX RES) (DECLARE (FIXNUM MIN-X MAX-X MIN-Y MAX-Y X Y)) (PROG (MIN-X MAX-X MIN-Y MAX-Y FASD-GROUP-LENGTH CONVERT-LOW-HALF-NIBBLE) (SETQ MIN-X (CAAR RES)) (SETQ MIN-Y (CADAR RES)) (SETQ MAX-X (CAADR RES)) (SETQ MAX-Y (CADADR RES)) (FASD-START-GROUP NIL 1 FASL-OP-INITIALIZE-NUMERIC-ARRAY) (FASD-INDEX IDX) (FASD-CONSTANT (// (1+ (* (- MAX-X MIN-X) (- MAX-Y MIN-Y))) 2)) ;NUMBER OF NIBBLES (DO Y MIN-Y (1+ Y) (= Y MAX-Y) (DO X MIN-X (1+ X) (= X MAX-X) (CONVERT-HALF-NIBBLE (FTV X Y)))) (COND (CONVERT-LOW-HALF-NIBBLE (CONVERT-HALF-NIBBLE 0))) )) (DEFUN CONVERT-TRANSFER-NEW (IDX RES) (DECLARE (FIXNUM MIN-X MAX-X MIN-Y MAX-Y X Y)) (PROG (MIN-X MAX-X MIN-Y MAX-Y FASD-GROUP-LENGTH CONVERT-LOW-HALF-NIBBLE) (SETQ MIN-X (CAAR RES)) (SETQ MIN-Y (CADAR RES)) (SETQ MAX-X (CAADR RES)) (SETQ MAX-Y (CADADR RES)) (FASD-START-GROUP NIL 1 FASL-OP-INITIALIZE-NUMERIC-ARRAY) (FASD-INDEX IDX) (FASD-CONSTANT (// (1+ (* (- MAX-X MIN-X) (- MAX-Y MIN-Y))) 2)) ;NUMBER OF NIBBLES (DO Y MIN-Y (1+ Y) (= Y MAX-Y) (DO X MIN-X (1+ X) (= X MAX-X) (CONVERT-HALF-NIBBLE (IMAGE X Y)))) (COND (CONVERT-LOW-HALF-NIBBLE (CONVERT-HALF-NIBBLE 0))) )) (DECLARE (NOTYPE (CONVERT-HALF-NIBBLE FIXNUM))) (DEFUN CONVERT-HALF-NIBBLE (NIB) (COND ((> NIB 377) (SETQ NIB 377))) (COND ((NULL CONVERT-LOW-HALF-NIBBLE) (SETQ CONVERT-LOW-HALF-NIBBLE NIB)) (T (FASD-NIBBLE (+ (LSH NIB 8) CONVERT-LOW-HALF-NIBBLE)) (SETQ CONVERT-LOW-HALF-NIBBLE NIL))))