;;; ISlide.LSP
;;; Copyright 1992,95 by Jerry Workman, CIS 70717,3564
;;; Mountain Software
;;; 1579 Nottingham Road
;;; Charleston, WV 25314
;;; 304-746-0246
;;;
;;; This program requires ELF, the Extended List Function library.
;;; ELF is available on the Compuserve ACAD forum as ELF.ZIP and
;;; many BBS's as ELF???.ZIP or from Mountain Software.
;;;
;;; THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED
;;; WARRANTY. ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR
;;; PURPOSE AND OF MERCHANTABILITY ARE HEREBY DISCLAIMED.
;;;
;;;*===================================================================*
;;;
;;; This program inserts an AutoCAD slide as AutoCAD entities. The slide
;;; can be scaled and inserted (similar to an exploding block insertion)
;;; anywhere within a drawing. The slide is drawn on the current layer
;;; using colors specified in the slide file. Note that a slide consists
;;; only of vectors and solid fills and the actual scale is dependant
;;; on the size of the original image and the size and resolution of the
;;; machine that created the slide. This program was adapted from the C++
;;; program "vSLide", included with LaunchCAD. It has not been tested with
;;; non-Intel "reverse byte" slide files.
(Princ "\nLoading ISlide.Lsp...")
(Load"ELF") ;load ELF.EXP, color and key symbols
(Defun C:ISLIDE ( / fn pt done Filling Xscale Yscale)
(Setq olderr *error* *error* AtErr)
(modes '("BLIPMODE" "CMDECHO" "CLAYER"))
(SetVar "BLIPMODE" 0)
(SetVar "CMDECHO" 0)
(SetQ CLayer (GetVar "CLAYER")
screen (GetVar "SCREENSIZE"))
(setq Color 23
filename (Wgetfile "*.sld")
fp (fopen filename "rb")
MaxX (car screen)
MaxY (cadr screen)
)
(if (not fp)
(printf "\nUnable to open file: %s" filename)
;else
(progn
(initget 1)
(graphscr)
(setq offset (GetPoint "\nInsertion Point: "))
(setq Xscale (getreal "\nX scale <1.0>: "))
(if (not Xscale)
(setq Xscale 1.0))
(setq Yscale (getreal "Y scale (default=X): "))
(if (not Yscale)
(setq Yscale Xscale))
;*----- Read header
(read_header)
(if (/= Id "AutoCAD Slide") (progn
(princ "\nNot a slide file")
(exit)
))
;*----- check for reversed byte order (Motorola / SPARC / MIPS)
(if(and(> Level 1) (/= TestNo (xtoi "0x1234")))
(progn
(setq Max_Y (SwapB Max_Y)
Max_X (SwapB Max_X)
H_Fill (SwapB H_Fill)
SwapBytes T)
(princ "\nnot an Intel Slide")
);else
(progn
(setq SwapBytes nil)
(princ "\nIntel Slide")
))
(if(< Level 2) (progn
(frewind fp)
(read_old_header)
(setq SlideAR Aspect) ; this is already floating point
);else
(setq SlideAR (/ Aspect 10000000.0))
)
(setq
SF (/ SlideAR (/ Max_X Max_Y))
XSF (/(/ MaxX Max_X) MaxY)
YSF (/ SF Max_Y)
scale (mult_vec (list XSF YSF) (list Xscale Yscale))
)
(while (not done) (progn
(setq buff (fgetint fp))
(if SwapBytes
(setq buff (SwapB buff)))
(setq RecType (hibyte buff))
;*----- Record Type determines what we draw -------
(cond
;*----- offset vector
((= RecType 251)
(setq fromx (int2sc(lobyte buff))
fromy (fgetsc fp)
tox (fgetsc fp)
toy (fgetsc fp)
frompt (add_vec lastpt (list fromx fromy))
topt (add_vec lastpt (list tox toy))
)
(vector frompt topt scale offset)
(setq lastpt frompt)
);251
;*----- EOF
((= RecType 252)
(setq Done t)
)
;*----- Solid Fill
((= RecType 253)
(setq Fill_X (fgetint fp)
Fill_Y (fgetint fp))
(if SwapBytes
(setq Fill_X (SwapB Fill_X)
Fill_Y (SwapB Full_Y)))
(if (< Fill_Y 0)
(progn
(setq Filling (not Filling)) ; toggle
(if Filling
(setq SfLst nil)
;else
(Sfill SfLst)
)
);else
(progn
(setq FillPt (add_vec offset (mult_vec scale (list Fill_X Fill_Y))))
(if(not SfLst)
(setq SfLst (list FillPt))
;else
(setq SfLst (append SfLst (list FillPt)))
)
));if
);253
((= RecType 254) ; Common Endpoint Vector
(setq tox (int2sc (lobyte buff))
toy (fgetsc fp)
frompt (add_vec lastpt (list tox toy))
topt lastpt)
(vector frompt topt scale offset)
(setq lastpt frompt)
);254
((= RecType 255) ; New Color
(setq VColor (lobyte buff))
(command ".COLOR" VColor)
);255
((and (>= RecType 0) (<= RecType 127)) ; Vector
(setq fromx buff
fromy (fgetint fp)
tox (fgetint fp)
toy (fgetint fp)
frompt (list fromx fromy)
topt (list tox toy))
(vector frompt topt scale offset)
(setq lastpt frompt)
);Vector
(t (princ "\nUnknown record"))
); cond
)); while
(fclose fp)
))
(moder)
(Princ)
)
;*----- Solid fill a list of verticies
(Defun SFILL(SfLst / first last p1 p2 p3 p4)
(setq first 0 last (1- (length SfLst)))
(while (< first last)
(setq p1 (nth last SfLst)
p2 (nth first SfLst)
first (1+ first)
last (1- last)
p3 (nth last SfLst)
p4 (nth first SfLst))
(solid p1 p2 p3 p4) ; make SOLID entity
);while
)
;*----- Draw a line
(defun VECTOR(from to scale offset / fpt tpt)
(setq fpt (add_vec offset (mult_vec scale from)))
(setq tpt (add_vec offset (mult_vec scale to)))
(line fpt tpt)
)
;*----- Read post R9 Slide header
(defun read_header()
(setq Id (fgets fp 14))
(fseek fp 0 17)
(setq RecType (fgetc fp)
Level (fgetc fp)
Max_X (+(fgetint fp) 0.0)
Max_Y (+(fgetint fp) 0.0)
aspect (fgetlong fp)
H_Fill (fgetint fp)
TestNo (fgetint fp)
)
)
(defun read_old_header()
(setq Id (fgets fp 14))
(fseek fp 0 18)
(setq RecType (fgetc fp)
Level (fgetc fp)
Max_X (fgetint fp)
Max_Y (fgetint fp)
aspect (fgetreal fp)
H_Fill (fgetint fp)
TestNo (fgetc fp)
)
)
;;; add vectors
(defun add_vec (v1 v2)
(mapcar '+ v1 v2)
)
;;; multiply vectors
(defun mult_vec (v1 v2)
(mapcar '* v1 v2)
)
;;;*----- swiped this from ADESK
(defun MODES (a)
(setq MLST '())
(repeat (length a)
(setq MLST (append MLST (list (list (car a) (getvar (car a))))))
(setq a (cdr a)))
)
;;;*----- and this
(defun MODER ()
(repeat (length MLST)
(setvar (caar MLST) (cadar MLST))
(setq MLST (cdr MLST))
)
)
;;;*----- error routine
(defun ATERR(s)
(Beep)
(if(not(member s (list "console break" "Function cancelled")))
(printf "\nISlide ERROR\n%s, RecType = %d" s RecType) 1 (| white red_bg))
(fclose fp)
(gotoxy 0 24)
(moder) ; Restore modified modes
(SetQ *error* olderr olderr nil)
(princ)
)
(princ "\nISlide loaded. Enter \"ISlide\" to run")
(princ)
