;; MODULE_ID PLPCCW.LSP ;; CalComp AutoCAD 12,13 x86 ADI 4.2 Driver ;; Release 6.50 1 Mar 1997 ;; (C) 1995,1996 CalComp, Inc. ;; All Rights Reserved. ;; By David Maeschen ;; ;; 1 Mar 1997 ;; Added TechJET 5600 Enhanced Color Mode ;; 7 Nov 1996 ;; Added Connection CDCLBegin CDCLEnd and Pens DitherAreas Dithering ;; support ;; 4 Nov 1996 ;; Added enable/disable to PensDefine and PlotterValues ;; 4 Oct 1996 ;; Added TechJET 5500s ;; Genericized most functions using plmaker and plpfile ;; The following functions remain ;; ccvarval, cclassify, cclist, ccolor, cconfig/smconfig ;; These would need different names to avoid namespace collision ;; 28 Aug 1996 ;; Remove Plotter source from TechJETs ;; 20 June 1996 ;; Enabled ConnTimeout, MediaFPage, and added PensIntensity ;; 18 June 1996 ;; Made Overlay(OVERWRITE) the default ;; Provided cclassify and ccolor functions, Gray Modes ;; ConnTimeout added ;; 31 May 1996 ;; Distinguish Dual/Sheet Pen class sources, TechJET720, and TechJET class modes ;; 14 May 1996 ;; Added Media Full Page Area MediaFPage ;; 30 Mar 1996 ;; Conn, Pens always enabled ;; 1 Mar 1996 ;; Added CDCLTrailer=1 to DrawingMaster Pluses ;; 7 Feb 1996 ;; Permit cut sheet for any model sporting the SHEETFEED option ;; 20 Dec 1995 ;; Set parameters before creating new conf ;; Set NumPlotters to 0 when last conf is deleted rather than deleting Model section ;; Adapt for nil and zero lists ;; 16 Nov 1995 ;; Permit multiple references to common conf ;; Do not create new configuration if one by that name exists ;; Do not delete configuration if referenced by another model ;; ;; begin functions with cc to avoid namespace collision ;; generic utilities - no globals allowed ;; (defun index( a alist / l n ) ;; return the first index of a in alist, -1 if not found (setq n 0) (if (/= nil alist) (progn (while (and (/= nil (setq l (nth n alist))) (/= a l)) (setq n (1+ n))) (if (= nil l) (setq n -1)) ) ) (car (list n)) ) (defun strindex( a astr / l n) ;; return the first index of a in astr, 0 if not found (setq n 1) (if (/= nil astr) (progn (while (and (/= nil (setq l (substr astr n 1))) (/= a l)) (setq n (1+ n)) ) (if (= nil l) (setq n 0)) ) ) (car (list n)) ) (defun repl(n1 n2 l1 l2 / l0 l m n) ;; replace elements [n1 to n2) of l1 with the contents of l2 ;; inserts before n1 if n1 equals n2 ;; deletes if l2 is nil ;; restrictions 0 <= n1 <= n2 <= (length l1) (setq l0 nil l nil m 0 n 0) (if (< n1 0) (progn (princ " repl: n1 < 0 ") (princ n1) ) ) (if (< n2 n1) (progn (princ " repl: n2 < n1") (princ n2) (princ "<") (princ n1) ) ) (while (< n n1) (setq l0 (cons (nth n l1) l0)) (setq n (1+ n)) ) (if (/= l2 nil) (while (setq l (nth m l2)) (setq l0 (cons l l0)) (setq m (1+ m)) ) ) (setq n n2) (while (setq l (nth n l1)) (setq l0 (cons l l0)) (setq n (1+ n)) ) (reverse l0) ) (defun asval ( key value alist / val ) ;; return the key value from the association list ;; or value if not present (if (= nil (setq val (cadr (assoc key alist)))) (setq val value)) (car (list val)) ) (defun askey ( key value alist / l0 l m n) ;; replace the value of the key in the association list ;; append if not present (setq l0 nil l nil m 0 n 0) (if (/= nil alist) ;; handle nil list (while (setq l (nth n alist)) (if (= key (car l)) (progn (setq m 1) (setq l0 (cons (list key value) l0)) ) (setq l0 (cons l l0)) ) (setq n (1+ n)) ) ) ;; append key value pair if not present (if (= m 0) (setq l0 (cons (list key value) l0)) ) (reverse l0) ) (defun asnil ( key alist / l0 l n) ;; delete key value pair in the association list (setq l0 nil l nil n 0) (while (/= nil (setq l (nth n alist))) (if (/= key (car l)) (setq l0 (cons l l0)) ) (setq n (1+ n)) ) (reverse l0) ) (defun aschg ( key newkey value alist / l0 l m n) ;; replace the key with newkey in the association list ;; append with value if not present (setq l0 nil l nil m 0 n 0) (while (setq l (nth n alist)) (if (= key (car l)) (progn (setq m 1) (setq l0 (cons (list newkey (cadr l)) l0)) ) (setq l0 (cons l l0)) ) (setq n (1+ n)) ) ;; append key value pair if not present (if (= m 0) (setq l0 (cons (list newkey value) l0)) ) (reverse l0) ) (defun anassoclist ( llist / alist i l m n ) ;; convert an assignment list into an associative list of key value pairs ;; key=value, key=(nil), key(=nil) (setq alist nil i 1 l nil m 0 n 0) (while (/= nil (setq l (nth n llist))) (setq n (1+ n)) (setq i 1 m (strlen l)) (while (and (<= i m) (/= "=" (substr l i 1)) ) (setq i (1+ i)) ) (if (<= i m) (setq alist (append alist (list (list (substr l 1 (1- i)) (substr l (1+ i)) )) )) (setq alist (append alist (list (list (substr l 1 (1- i)) )) )) ) ) (car (list alist)) ) (defun anassignlist ( alist / a llist) ;; convert a associative list of key value pairs into an assignment list ;; list values are converted into list strings with embedded \\n newlines ;; \\n translate into \n on output (setq llist nil) (foreach a alist (if (and (/= nil (cadr a)) (/= "" (cadr a))) (if (listp (cadr a)) ;; turn lists into strings (setq llist (append llist (list (strcat (car a) "=" (aliststring (cadr a) "\\n"))))) ;; turn values into strings, nil into nothing or "=" (setq llist (append llist (list (strcat (car a) "=" (cadr a))))) ) (setq llist (append llist (list (strcat (car a) "=")))) ) ) (car (list llist)) ) (defun lstr ( l / n) ;; left string - truncate any trailing white space (if (/= nil l) (progn (setq n (strlen l)) (while (and (> n 0) (= " " (substr l n 1)) ) (setq n (1- n)) ) (if (> n 0) (setq l (substr l 1 n)) (setq l "") ) ) (setq l nil) ) ) (defun rstr ( l / i n) ;; right string - truncate any leading white space (if (/= nil l) (progn (setq i 1 n (strlen l)) (while (and (< i n) (= " " (substr l i 1)) ) (setq i (1+ i)) ) (if (< i n) (setq l (substr l i)) (setq l "") ) ) (setq l nil) ) ) (defun astringlist ( astr aspc / alist c m0 m1 n0 n1 ) ;; convert a string with embedded \\n newlines to a list ;; \\n translates into \n on output (if (/= nil astr) (progn (if (= nil aspc) (setq aspc "\\n")) (setq alist nil m0 1 m1 1 n0 (strlen astr) n1 (strlen aspc)) (while (<= m0 n0) (while (and (<= m1 n0) (/= aspc (setq c (substr astr m1 n1)))) (setq m1 (1+ m1))) ;; append repeated spaces to entry (while (and (<= m1 n0) (= aspc (setq c (substr astr m1 n1)))) (setq m1 (1+ m1))) ;; and backup one (if (<= m1 n0) (setq m1 (1- m1))) (setq alist (append alist (list (substr astr m0 (- m1 m0))))) (setq m1 (+ m1 n1)) (setq m0 m1) ) ) (setq alist nil) ) (car (list alist)) ) (defun aliststring ( alist aspc / astr l n ) ;; convert a list to an string with embedded \\n newlines (if (/= nil alist) (progn (if (= nil aspc) (setq aspc "\\n")) (setq astr "" l nil n 0) (while (/= nil (setq l (nth n alist))) (setq astr (strcat astr l aspc)) (setq n (1+ n)) ) ) (setq astr nil) ) (car (list astr)) ) (defun hexvalue ( astr / c end n0 n1 v val ) ;; convert a hexstring into a number from x to first non-hex digit or end of string (setq end 0 n0 (strlen astr) n1 1 v 0 val 0) (while (and (< n1 n0) (/= "X" (strcase (substr astr n1 1)))) (setq n1 (1+ n1)) ) (setq n1 (1+ n1)) (while (and (= end 0) (<= n1 n0)) (setq c (strcase (substr astr n1 1))) (cond ((and (<= "0" c) (<= c "9")) (setq v (atoi c))) ((and (<= "A" c) (<= c "F")) (setq v (+ 10 (- (ascii c) (ascii "A"))))) (t (setq end 1)) ) (setq val (+ (* val 16) v)) (setq n1 (1+ n1)) ) (car (list val)) ) (defun ccname( ccf / ccn n) ;; return the name of a file (if (= nil ccf) (setq ccn nil) (progn (setq n (strlen ccf)) (while (and (> n 0) (/= "\\" (substr ccf n 1)) (/= "/" (substr ccf n 1)) ) (setq n (1- n)) ) (setq n (1+ n)) (if (/= nil ccf) (setq ccn (substr ccf n)) (setq ccn nil) ) ) ) ) (defun ccpath( ccf / ccp n) ;; return the path of a file (if (= nil ccf) (setq ccp nil) (progn (setq n (1- (strlen ccf))) (while (and (> n 0) (/= "\\" (substr ccf n 1)) (/= "/" (substr ccf n 1)) ) (setq n (1- n)) ) (if (> n 0) (setq ccp (substr ccf 1 n)) (setq ccp nil) ) ) ) ) (defun ccbase ( ccf / ccp n) (if (= nil ccf) (setq ccp nil) (progn (setq n (strlen ccf)) (if (and (/= "\\" (substr ccf n 1)) (/= "/" (substr ccf n 1))) (substr ccf 1 n) (substr ccf 1 (1- n)) ) ) ) ) ;; ;; generic dialog box utilities ;; (defun ccfile ( path ) (if (= nil path) (strcat "") (progn (if (and (wcmatch (getvar "acadver") "*12*") (wcmatch (getvar "platform") "*Windows*")) (strcat path) (strcat "drv/" path) ) ) ) ) (defun ccfileh ( path ) (if (= nil path) (strcat "") (progn (if (and (wcmatch (getvar "acadver") "*12*") (wcmatch (getvar "platform") "*Windows*")) (strcat path) (strcat "help/" path) ) ) ) ) (defun ccvarval ( var / val) ;; maker and model dependent ;; default lists and variables collected here for easy modification - internationalize these (cond ((= var "StdColors") (setq val "Color\\nColor\\nGreyscale\\nBlack\\n")) ((= var "StdGreys") (setq val "Greyscale\\nGreyscale\\nBlack\\n")) ((= var "ColorPalette") (setq val "CCOLR.CCP\\nCCOLR.CCP\\nCGREY.CCP\\nCCDIFF.CCP\\nOther\\n")) ((= var "GreyPalette") (setq val "CGREY.CCP\\nCCOLR.CCP\\nCGREY.CCP\\nCCDIFF.CCP\\nOther\\n")) ;; ClassSources added ((= var "SummaCADSources")(setq val "Roll\\nCut sheet\\nRoll\\n")) ((= var "TechJET5500Sources") (setq val "Roll\\nCut sheet\\nRoll\\n")) ((= var "TechJETSources") (setq val "Roll\\nCut sheet\\nRoll\\n")) ((= var "TechJET720Sources")(setq val "Roll\\nCut sheet\\nRoll\\n")) ((= var "TechJET720cSources")(setq val "Roll\\nCut sheet\\nRoll\\n")) ((= var "SolusSources") (setq val "Best Fit\\nPlotter\\nBest Fit\\nRoll 1\\nRoll 2\\n")) ((= var "DrawingMasterSources") (setq val "Roll & Cut\\nPlotter\\nRoll\\nRoll & Cut\\n")) ((= var "DrawingMasterPlusSources") (setq val "Roll & Cut\\nPlotter\\nRoll\\nRoll & Cut\\n")) ((= var "Electrostatic68KSources") (setq val "Roll & Cut\\nPlotter\\nRoll\\nRoll & Cut\\n")) ((= var "Electrostatic58KSources") (setq val "Plotter\\nPlotter\\n")) ((= var "PenDualSources") (setq val "Roll\\nCut sheet\\nRoll\\n")) ((= var "PenSheetSources") (setq val "Cut sheet\\nPlotter\\nCut sheet\\n")) ((= var "UnknownSources") (setq val "Plotter\\nPlotter\\n")) ;; ClassModes - Note: 57/58K did not have CDCL, therefore did not ;; Grey modes added ((= var "SummaCADModes") (setq val "Normal\\nPlotter\\nDraft\\nNormal\\nEnhanced\\n")) ((= var "SummaCADGModes")(setq val "Normal\\nPlotter\\nDraft\\nNormal\\nEnhanced\\nHi-Res Mono\\n")) ((= var "TechJET5500Modes") (setq val "Quality\\nPlotter\\nDraft\\nQuality\\nEnhanced\\nEnhanced Fast\\nGraphics\\nGraphics Fast\\nHi-Res Mono\\n")) ((= var "TechJETModes") (setq val "Normal\\nPlotter\\nDraft\\nNormal\\nEnhanced\\nGraphics\\nGraphics Fast\\nHi-Res Mono\\nInk-Saver\\n")) ((= var "TechJET720Modes") (setq val "Normal\\nPlotter\\nDraft\\nNormal\\nEnhanced\\nHi-Res Mono\\n")) ((= var "TechJET720cModes") (setq val "Normal\\nPlotter\\nDraft\\nNormal\\nEnhanced\\n")) ((= var "TechJET720cGModes")(setq val "Normal\\nPlotter\\nDraft\\nNormal\\nEnhanced\\nHi-Res Mono\\n")) ((= var "SolusModes") (setq val "Plotter\\nPlotter\\n")) ((= var "DrawingMasterModes") (setq val "Norm\\nPlotter\\nDraft\\nNorm\\nQual\\n")) ((= var "DrawingMasterPlusModes") (setq val "Norm\\nPlotter\\nQuick\\nNorm\\nQual\\nDual\\n")) ((= var "Electrostatic68KModes") (setq val "Norm\\nPlotter\\nDraft\\nNorm\\nMono\\nColor Sep\\n")) ((= var "Electrostatic58KModes") (setq val "Plotter\\nPlotter\\n")) ((= var "PenDualModes") (setq val "Plotter\\nPlotter\\n")) ((= var "PenSheetModes") (setq val "Plotter\\nPlotter\\n")) ((= var "UnknownModes") (setq val "Plotter\\nPlotter\\n")) (t (setq val nil)) ) ) (defun ccvarnum ( var num / val) ;; return a string consisting of varnum with num ;; a three digit number with leading zeros (cond ((< num 10) (setq val (strcat "00"))) ((< num 100) (setq val (strcat "0" ))) ((< num 1000) (setq val (strcat "" ))) (t (progn (princ " ccvarnum error ")(princ num)(princ " >= 1000 "))) ) (strcat var val (itoa num)) ) (defun ccputparms( aparms / aparm ) ;; get and set parm values of simple tiles (default to tile values) ;; the parameter name is the tile name ;; globals ccparml (foreach aparm aparms (setq ccparml (askey aparm (get_tile aparm) ccparml))) ) (defun ccputtiles( aparms / aparm ) ;; get and set tile values of simple tiles (default to tile values) ;; the parameter name is the tile name ;; globals ccparml (foreach aparm aparms (set_tile aparm (asval aparm (get_tile aparm) ccparml))) ) (defun ccputlist ( key values ) ;; put a list up ;; key is the name of the list ;; the first of values is the selected value, and the rest are the list (start_list key) (mapcar 'add_list (cdr values)) (end_list) (set_tile key (itoa (index (car values) (cdr values)))) (mode_tile key 0) ) (defun ccimage ( image name / width height) ;; clear and display image (setq width (dimx_tile image) height (dimy_tile image)) (start_image image) (fill_image 0 0 width height 0) ;; 0 is black (on screen white) (slide_image 0 0 width height (ccfile name)) (end_image) ) (defun ccimages ( image name / width height) ;; superimpose images (setq width (dimx_tile image) height (dimy_tile image)) (start_image image) ;; (fill_image 0 0 width height 0) ;; 0 is black (on screen white) (slide_image 0 0 width height (ccfile name)) (end_image) ) ;; ;; dialog box callbacks ;; ;; globals variables ;; dcl_id dialog control language identifier ;; cconffile configuration file in memory ;; ccmodellist model associative list ;; ccmodell model list (assoc 'selections ccmodellist) ;; ccmodels models list (ccselectlist "Plotter" ccmodell) ;; ccconflist conf associative list ;; ccconfl conf list (assoc 'selections ccconflist) ;; ccconfs conf list (ccselectlist "Cfg" ccconfl) ;; ccparmlist parameter associative list ;; ccparml parameter list (assoc 'selections ccparmlist) ;; ;; associative lists ;; ((firstselection linenumber [section]) ;; (lastselection linenumber next blank line) ;; (selections lines an associative list of entries ((variable value)))) ;; linenumbers in cconffile, lines from cconffile ;; (defun ccanno ( / aparms) ;; annotation dialog box (if (not (new_dialog "anno" dcl_id)) (exit)) ;; parameters (setq aparms (list "AnnoFile" "AnnoTime" "AnnoDrvr" "AnnoCrop" "AnnoComm")) ;; get current/default values (ccputtiles aparms) ;; setup callbacks (action_tile "accept" "(ccputparms aparms) (done_dialog) (set_tile \"comment\" (asval \"AnnoComm\" \"\" ccparml))" ) (action_tile "cancel" "(done_dialog)" ) (action_tile "help" "(acad_helpdlg (ccfileh plpfile) \"ANNO\" )" ) ;; begin (start_dialog) ) (defun ccconn ( / aparms ) ;; connection dialog box (if (not (new_dialog "conn" dcl_id)) (exit)) (setq aparms (list "ConnNsync" "ConnPad" "ConnChksum" "ConnSync" "ConnEobm" "ConnTimeout" "CDCLUser" "CDCLUserEnd")) ;; get current/default values (ccputtiles aparms) ;; setup callbacks (action_tile "accept" "(ccputparms aparms) (done_dialog)" ) (action_tile "cancel" "(done_dialog)" ) (action_tile "help" "(acad_helpdlg (ccfileh plpfile) \"CONN\" )" ) ;; begin (start_dialog) ) (defun ccpensimages ( ) ;; place images (ccimage "merge1" (strcat plpfile "(merge1)")) (ccimage "merge2" (strcat plpfile "(merge2)")) (ccimage "lend1" (strcat plpfile "(lend1)")) (ccimage "lend2" (strcat plpfile "(lend2)")) (ccimage "lend3" (strcat plpfile "(lend3)")) (ccimage "lend4" (strcat plpfile "(lend4)")) ;; place borders (cond ((= "OVERWRITE" PensMerge) (ccimages "merge2" (strcat plpfile "(border1)"))) (t (ccimages "merge1" (strcat plpfile "(border1)"))) ) (cond ((= "SQUARE" PensEnd) (ccimages "lend4" (strcat plpfile "(border1)"))) ((= "ROUNDED" PensEnd) (ccimages "lend3" (strcat plpfile "(border1)"))) ((= "FLAT" PensEnd) (ccimages "lend2" (strcat plpfile "(border1)"))) (t (ccimages "lend1" (strcat plpfile "(border1)"))) ) ) (defun ccpensputparms ( aparms ) ;; get and set parm values (ccputparms aparms) (setq ccparml (askey "PensPalette" (aliststring ccpals "\\n") ccparml)) (setq ccparml (askey "PensDType" PensDType ccparml)) (setq ccparml (askey "PensMerge" PensMerge ccparml)) (setq ccparml (askey "PensEnd" PensEnd ccparml)) ) (defun ccpenspal ( val / ccfn) (if (= "Other" (nth val (cdr ccpals))) (progn (setq ccfn (getfiled (strcat plmaker " Color Palette File") (ccfile "*.ccp") "ccp" 10)) ;; reject redundancies (if (and (/= nil ccfn) (= -1 (index (ccname ccfn) ccpals)) ) (progn (setq ccpals (repl (1+ val) (1+ val) ccpals (list (ccname ccfn)) )) (setq ccpals (cons (nth val (cdr ccpals)) (cdr ccpals) )) (ccputlist "PensPalette" ccpals) ) (ccputlist "PensPalette" ccpals) ) ) (setq ccpals (cons (nth val (cdr ccpals)) (cdr ccpals))) ) ) (defun ccdpens ( PensDefine ) ;; define pens (setq ccparml (askey "PensDefine" PensDefine ccparml)) (if (= "0" PensDefine) ;; disable tiles (progn (mode_tile "PensIntensity" 1) (mode_tile "PensPalette" 1) (mode_tile "PensDither" 1) (mode_tile "PensDAreas" 1) (mode_tile "PensDType" 1) ) ;; enable tiles (progn (mode_tile "PensIntensity" 0) (mode_tile "PensPalette" 0) (mode_tile "PensDither" 0) (mode_tile "PensDAreas" 0) (mode_tile "PensDType" 0) ) ) ) (defun ccpens ( / aparms ) ;; pens dialog box (if (not (new_dialog "pens" dcl_id)) (exit)) ;; place list ;; has 'other' to select a different palette and add to list (if (/= 0 (boole 1 ccfeature (cadr (assoc 'HASCOLOR ccfeatures)))) (setq ccpals (astringlist (asval "PensPalette" (ccvarval "ColorPalette") ccparml) "\\n")) (setq ccpals (astringlist (asval "PensPalette" (ccvarval "GreyPalette") ccparml) "\\n")) ) (ccputlist "PensPalette" ccpals) ;; place tiles (setq aparms (list "PensIntensity" "PensDefine" "PensDither" "PensDAreas")) (ccputtiles aparms) ;; place images (setq PensDType (asval "PensDType" "STANDARD" ccparml)) (setq PensMerge (asval "PensMerge" "OVERWRITE" ccparml)) (setq PensEnd (asval "PensEnd" "ROUNDED" ccparml)) (cond ((= PensDType "STANDARD") (set_tile "Standard" "1")) ((= PensDType "CLUSTER") (set_tile "Cluster" "1")) ((= PensDType "PATTERN") (set_tile "Pattern" "1")) ((= PensDType "STOCHASTIC") (set_tile "Stochastic" "1")) ) (ccpensimages) ;; setup callbacks (action_tile "PensDefine" "(ccdpens $value)" ) (action_tile "PensPalette" "(ccpenspal (atoi $value))" ) (action_tile "Standard" "(setq PensDType \"STANDARD\")") (action_tile "Cluster" "(setq PensDType \"CLUSTER\")") (action_tile "Pattern" "(setq PensDType \"PATTERN\")") (action_tile "Stochastic" "(setq PensDType \"STOCHASTIC\")") (action_tile "merge1" "(setq PensMerge \"MERGE\") (ccpensimages)") (action_tile "merge2" "(setq PensMerge \"OVERWRITE\") (ccpensimages)") (action_tile "lend1" "(setq PensEnd \"MAJOR\") (ccpensimages)") (action_tile "lend2" "(setq PensEnd \"FLAT\") (ccpensimages)") (action_tile "lend3" "(setq PensEnd \"ROUNDED\") (ccpensimages)") (action_tile "lend4" "(setq PensEnd \"SQUARE\") (ccpensimages)") (action_tile "accept" "(ccpensputparms aparms) (done_dialog)" ) (action_tile "cancel" "(done_dialog)" ) (action_tile "help" "(acad_helpdlg (ccfileh plpfile) \"PENS\" )" ) ;; enable/disable tiles ;(setq PlotterValues (asval "PlotterValues" "0" ccparml)) (setq PensDefine (asval "PensDefine" (get_tile "PensDefine") ccparml)) (if (/= "0" PlotterValues) (progn ; disable tiles (mode_tile "PensIntensity" 1) (mode_tile "PensPalette" 1) (mode_tile "PensDefine" 1) (mode_tile "PensDither" 1) (mode_tile "PensDAreas" 1) (mode_tile "PensDType" 1) ;(mode_tile "merge1" 1) ;(mode_tile "merge2" 1) (mode_tile "lend1" 1) (mode_tile "lend2" 1) (mode_tile "lend3" 1) (mode_tile "lend4" 1) ) (progn ; enable tiles ; Handles PensIntensity PensPalette PensDither PensDAreas (ccdpens PensDefine) ;(mode_tile "PensIntensity" 0) ;(mode_tile "PensPalette" 0) (mode_tile "PensDefine" 0) ;(mode_tile "PensDither" 0) ;(mode_tile "PensDAreas" 0) ;(mode_tile "PensDType" 0) ;(mode_tile "merge1" 0) ;(mode_tile "merge2" 0) (mode_tile "lend1" 0) (mode_tile "lend2" 0) (mode_tile "lend3" 0) (mode_tile "lend4" 0) ) ) ;; begin (start_dialog) ) (defun ccmediaimages( mirrorx mirrory / mirror ) ;; place images mirror 0 (x,y) 1 (-x,y) 2 (x,-y) 3 (-x,-y) (setq mirror (rem (+ (atoi mirrorx) (* 2 (atoi mirrory))) 4)) (cond ((= 0 mirror) (ccimage "image1" (strcat plpfile "(ccpl01)")) (ccimage "image2" (strcat plpfile "(ccpl02)")) (ccimage "image3" (strcat plpfile "(ccpl03)")) (ccimage "image4" (strcat plpfile "(ccpl04)")) (ccimage "image5" (strcat plpfile "(ccpl05)")) (ccimage "image6" (strcat plpfile "(ccpl06)")) (ccimage "image7" (strcat plpfile "(ccpl07)")) (ccimage "image8" (strcat plpfile "(ccpl08)")) ) ((= 1 mirror) (ccimage "image1" (strcat plpfile "(ccpl09)")) (ccimage "image2" (strcat plpfile "(ccpl10)")) (ccimage "image3" (strcat plpfile "(ccpl11)")) (ccimage "image4" (strcat plpfile "(ccpl12)")) (ccimage "image5" (strcat plpfile "(ccpl13)")) (ccimage "image6" (strcat plpfile "(ccpl14)")) (ccimage "image7" (strcat plpfile "(ccpl15)")) (ccimage "image8" (strcat plpfile "(ccpl16)")) ) ((= 2 mirror) (ccimage "image1" (strcat plpfile "(ccpl17)")) (ccimage "image2" (strcat plpfile "(ccpl18)")) (ccimage "image3" (strcat plpfile "(ccpl19)")) (ccimage "image4" (strcat plpfile "(ccpl20)")) (ccimage "image5" (strcat plpfile "(ccpl21)")) (ccimage "image6" (strcat plpfile "(ccpl22)")) (ccimage "image7" (strcat plpfile "(ccpl23)")) (ccimage "image8" (strcat plpfile "(ccpl24)")) ) ((= 3 mirror) (ccimage "image1" (strcat plpfile "(ccpl03)")) (ccimage "image2" (strcat plpfile "(ccpl04)")) (ccimage "image3" (strcat plpfile "(ccpl01)")) (ccimage "image4" (strcat plpfile "(ccpl02)")) (ccimage "image5" (strcat plpfile "(ccpl07)")) (ccimage "image6" (strcat plpfile "(ccpl08)")) (ccimage "image7" (strcat plpfile "(ccpl05)")) (ccimage "image8" (strcat plpfile "(ccpl06)")) ) ) ;; frame the selected image (cond ((= "8" MediaOrien) (ccimages "image8" (strcat plpfile "(border2)"))) ((= "7" MediaOrien) (ccimages "image7" (strcat plpfile "(border2)"))) ((= "6" MediaOrien) (ccimages "image6" (strcat plpfile "(border2)"))) ((= "5" MediaOrien) (ccimages "image5" (strcat plpfile "(border2)"))) ((= "4" MediaOrien) (ccimages "image4" (strcat plpfile "(border2)"))) ((= "3" MediaOrien) (ccimages "image3" (strcat plpfile "(border2)"))) ((= "2" MediaOrien) (ccimages "image2" (strcat plpfile "(border2)"))) (t (ccimages "image1" (strcat plpfile "(border2)"))) ) ) (defun ccmediaputtiles ( ) (setq MediaOrien (asval "MediaOrien" "1" ccparml)) (setq MediaMirrx (asval "MediaMirrx" "0" ccparml)) (setq MediaMirry (asval "MediaMirry" "0" ccparml)) (setq MediaFPage (asval "MediaFPage" "0" ccparml)) (setq MediaLplot (asval "MediaLplot" "0" ccparml)) (set_tile "MediaMirrx" MediaMirrx) (set_tile "MediaMirry" MediaMirry) (set_tile "MediaFPage" MediaFPage) (set_tile "MediaLplot" MediaLplot) (if (/= 0 (boole 1 ccoption (cadr (assoc 'LONGAXIS ccoptions)))) (mode_tile "MediaLplot" 0) (mode_tile "MediaLplot" 1) ) ) (defun ccmediaputparms ( ) (setq MediaLplot (get_tile "MediaLplot")) (setq MediaFPage (get_tile "MediaFPage")) (setq ccparml (askey "MediaOrien" MediaOrien ccparml)) (setq ccparml (askey "MediaMirrx" MediaMirrx ccparml)) (setq ccparml (askey "MediaMirry" MediaMirry ccparml)) (setq ccparml (askey "MediaFPage" MediaFPage ccparml)) (setq ccparml (askey "MediaLplot" MediaLplot ccparml)) ) (defun ccmedia ( ) ;; media dialog box (if (not (new_dialog "media" dcl_id)) (exit)) ;; place tiles (ccmediaputtiles) ;; place images (ccmediaimages MediaMirrx MediaMirry) (action_tile "image1" "(setq MediaOrien \"1\") (ccmediaimages MediaMirrx MediaMirry)" ) (action_tile "image2" "(setq MediaOrien \"2\") (ccmediaimages MediaMirrx MediaMirry)" ) (action_tile "image3" "(setq MediaOrien \"3\") (ccmediaimages MediaMirrx MediaMirry)" ) (action_tile "image4" "(setq MediaOrien \"4\") (ccmediaimages MediaMirrx MediaMirry)" ) (action_tile "image5" "(setq MediaOrien \"5\") (ccmediaimages MediaMirrx MediaMirry)" ) (action_tile "image6" "(setq MediaOrien \"6\") (ccmediaimages MediaMirrx MediaMirry)" ) (action_tile "image7" "(setq MediaOrien \"7\") (ccmediaimages MediaMirrx MediaMirry)" ) (action_tile "image8" "(setq MediaOrien \"8\") (ccmediaimages MediaMirrx MediaMirry)" ) (action_tile "MediaMirrx" "(setq MediaMirrx $value) (ccmediaimages MediaMirrx MediaMirry)" ) (action_tile "MediaMirry" "(setq MediaMirry $value) (ccmediaimages MediaMirrx MediaMirry)" ) (action_tile "accept" "(ccmediaputparms) (done_dialog)") (action_tile "cancel" "(done_dialog)" ) (action_tile "help" "(acad_helpdlg (ccfileh plpfile) \"MEDIA\" )" ) ;; begin (start_dialog) ) (defun ccnew ( / newcf ) ;; connection dialog box (if (not (new_dialog "new" dcl_id)) (exit)) (setq newcf nil) (action_tile "newcf" "(setq newcf $value)") (action_tile "accept" "(done_dialog) (newconf newcf)" ) (action_tile "cancel" "(done_dialog)" ) ;; begin (start_dialog) ) (defun ccdelete ( ) ;; connection dialog box (if (not (new_dialog "delete" dcl_id)) (exit)) (action_tile "accept" "(done_dialog) (delconf)" ) (action_tile "cancel" "(done_dialog)" ) ;; begin (start_dialog) ) (defun ccabout ( logo ) ;; about dialog box (if (not (new_dialog "about" dcl_id)) (exit)) ;; place logo (ccimages logo (strcat plpfile "(" logo ")")) ;; setup callbacks (action_tile logo "(done_dialog)" ) (action_tile "accept" "(done_dialog)" ) ;; begin (start_dialog) ) (defun newconf ( newcf / l m n ) ;; do not create another configuration if one already exists, just select it (if (/= -1 (index newcf ccconfs)) (progn (setq ccconfs (cons newcf (cdr ccconfs))) (setq ccconfl (askey "Cfg000" newcf ccconfl)) (setq newcf nil) (setq m (cadr (assoc 'firstselection ccconflist))) (setq n (cadr (assoc 'lastselection ccconflist))) (setq cconffile (repl (1+ m) n cconffile (anassignlist ccconfl))) (setq ccparmlist nil) (cclist nil) ) ) (if (= nil newcf) (setq l nil) (progn ;; set config selection (setq l (+ (index (car ccconfs) (cdr ccconfs)) 2)) (setq m (atoi (asval "NumCfgs" 0 ccconfl))) (setq n (1+ m)) (setq ccconfl (askey "NumCfgs" (itoa n) ccconfl)) (setq ccconfl (askey "Cfg000" newcf ccconfl)) (while (> n l) (setq ccconfl (askey (ccvarnum "Cfg" n) (asval (ccvarnum "Cfg" (1- n)) newcf ccconfl) ccconfl)) (setq n (1- n)) ) (setq ccconfl (askey (ccvarnum "Cfg" l) newcf ccconfl)) (setq m (cadr (assoc 'firstselection ccconflist))) (setq n (cadr (assoc 'lastselection ccconflist))) (setq cconffile (repl (1+ m) n cconffile (anassignlist ccconfl))) ;; do not create another parameter list if one already exists (if (= -1 (index (strcat "[" newcf "]") cconffile)) (progn (setq l (1+ (cadr (assoc 'lastselection ccparmlist)))) (setq cconffile (repl l l cconffile (append (list "" (strcat "[" newcf "]")) (anassignlist ccparml) ))) ) ) (setq ccparmlist nil) (cclist nil) (gc) ) ) ) (defun delconf ( / l l0 l1 m n newmd newcf) ;; delete parameter list if no other references to it exist (setq n 0) (foreach l cconffile (if (and (= (substr l 1 3) "Cfg") (= (substr l 8) (car ccconfs)) ) (setq n (1+ n)) ) ) (if (<= n 2) (setq cconffile (repl (cadr (assoc 'firstselection ccparmlist)) (1+ (cadr (assoc 'lastselection ccparmlist))) cconffile nil)) ) (setq ccparmlist nil) (setq l (+ (index (car ccconfs) (cdr ccconfs)) 1)) (setq m (atoi (asval "NumCfgs" "0" ccconfl))) ;; delete selection (if (= m 1) (progn ;; delete configuration list (setq cconffile (repl (cadr (assoc 'firstselection ccconflist)) (1+ (cadr (assoc 'lastselection ccconflist))) cconffile nil)) (setq ccconflist nil) (setq l (+ (index (car ccmodels) (cdr ccmodels)) 1)) (setq m (atoi (asval "NumPlotters" 0 ccmodell))) ;; delete model (if (= m 1) (progn ;; delete modellist or set the number of plotters to zero instead of deleting? ;; delete modellist ;(setq cconffile (repl (cadr (assoc 'firstselection ccmodellist)) ; (1+ (cadr (assoc 'lastselection ccmodellist))) cconffile nil)) ;(setq ccmodellist nil) ;(setq newcf nil) ;; set the number of plotters to zero instead of deleting (setq ccmodell nil) (setq ccmodell (askey "NumPlotters" "0" ccmodell)) (setq m (cadr (assoc 'firstselection ccmodellist))) (setq n (cadr (assoc 'lastselection ccmodellist))) (setq cconffile (repl (1+ m) n cconffile (anassignlist ccmodell))) ;; get new selection ;(setq ccmodels "[Models]") ;(setq ccmodellist (ccselect ccmodels)) ;(setq ccmodell (cadr (assoc 'selections ccmodellist))) ;(setq ccmodels (ccselectlist "Plotter" ccmodell)) (setq ccmodellist nil) (setq newcf nil) ) (progn ;; delete model ;; get new model from list ;; number of selection (setq ccmodell (askey "NumPlotters" (itoa (1- m)) ccmodell)) (setq l1 (1+ (rem (+ l (- m 2)) m))) (setq newmd (asval (ccvarnum "Plotter" l1) nil ccmodell)) (setq ccmodell (askey "Plotter000" newmd ccmodell)) (setq n l) (while (< n m) (setq ccmodell (askey (ccvarnum "Plotter" n) (asval (ccvarnum "Plotter" (1+ n)) newcf ccmodell) ccmodell)) (setq n (1+ n)) ) ;; delete an association list entry (setq ccmodell (asnil (ccvarnum "Plotter" m) ccmodell)) ;; update (setq m (cadr (assoc 'firstselection ccmodellist))) (setq n (cadr (assoc 'lastselection ccmodellist))) (setq cconffile (repl (1+ m) n cconffile (anassignlist ccmodell))) (setq ccmodellist nil) ;; get new selection (setq ccmodels "[Models]") (setq ccmodellist (ccselect ccmodels)) (setq ccmodell (cadr (assoc 'selections ccmodellist))) (setq ccmodels (ccselectlist "Plotter" ccmodell)) ;; put modellist (start_list "ccmodels") (mapcar 'add_list (cdr ccmodels)) (end_list) (set_tile "ccmodels" (itoa (index (car ccmodels) (cdr ccmodels)))) (mode_tile "ccmodels" 0) ;; create new ccconflist ;; (princ " ccmodel ") (princ (car ccmodels)) (cclist (car ccmodels)) (setq newcf (car ccconfs)) ;; (princ " newcf ") (princ newcf) ) ) ) (progn ;; delete configuration ;; get new configuration from list ;; number of selection (setq ccconfl (askey "NumCfgs" (itoa (1- m)) ccconfl)) (setq l1 (1+ (rem (+ l (- m 2)) m))) (setq newcf (asval (ccvarnum "Cfg" l1) nil ccconfl)) (setq ccconfl (askey "Cfg000" newcf ccconfl)) (setq n l) (while (< n m) (setq ccconfl (askey (ccvarnum "Cfg" n) (asval (ccvarnum "Cfg" (1+ n)) newcf ccconfl) ccconfl)) (setq n (1+ n)) ) ;; delete an association list entry (setq ccconfl (asnil (ccvarnum "Cfg" m) ccconfl)) ;; update (setq m (cadr (assoc 'firstselection ccconflist))) (setq n (cadr (assoc 'lastselection ccconflist))) (setq cconffile (repl (1+ m) n cconffile (anassignlist ccconfl))) (setq ccconflist nil) ) ) (if (/= nil newcf) (cclist nil) (setq ccexits 1) ) (gc) ) (defun ccselect ( ccseln / l n ccs0 ccs1 ccs2 ccsel ccsels) ;; compute an associative list from ;; the object beginning with ccseln in cconffile ;; (firstselection n(ccseln)) first [Model] ;; (initialselection n(selection)) Model selection ;; (lastselection n(last)) initial Model selections ;; (selection (+ n(ccseln) 1)) last ;; (selections (+ n(ccseln) 2) n(last)) ;; initialization (setq l nil n 0 ccs0 0 ccs1 0 ccs2 0 ccsel nil ccsels nil) ;; find object ccseln (if (and (not (null ccseln)) (not (null cconffile)) ) (while (and (/= (setq l (nth n cconffile)) nil) (/= l ccseln)) (setq n (+ n 1))) ) (if (and (/= nil l) (= l ccseln) ) (progn (setq ccs0 n) (setq n (+ n 1)) ;;(setq ccsel (nth n cconffile)) ;;(setq n (+ n 1)) (setq ccs1 n) ;; build list (while (and (/= (setq l (nth n cconffile)) nil) (/= l "")) (setq ccsels (append ccsels (list l))) ;;(if (= l ccsel) (setq ccs1 n)) (setq n (+ n 1))) (setq ccs2 n) ;; create associative list (list (list 'firstselection ccs0) ;;(list 'initialselection ccs1) (list 'lastselection ccs2) ;;(list 'selection ccsel) (list 'selections (anassoclist ccsels)) ) ) (progn ;;(princ " ccselect ") (princ ccseln) (princ " ") (princ l) (princ n) (car (list nil)) ) ) ) (defun ccselectlist ( ccs ccss / k l m n) ;; get a selection list consisting of a selection, ccs000, and ;; list of Num"ccs"s selections, ccsnnn, from the associative list ccss (if (= nil ccss) (setq l nil) (progn (setq l nil m 0) ;; handle nil and zero case (setq k (cadr (assoc (strcat "Num" ccs "s") ccss))) (if (= nil k) (setq n 0) (setq n (atoi k)) ) (while (and (< 0 n) (<= m n)) (setq l (append l (list (cadr (assoc (ccvarnum ccs m) ccss))))) (setq m (1+ m)) ) ) ) (car (list l)) ) (defun cccreateconf ( ccconf / n cconf cconfsel ) ;; create a configuration list ;; remove [], convert to an associative list, ;; select the key, truncating any trailing whitespace (if (= nil ccconf) (car (list conffile)) (progn (setq cconfsel (lstr (substr ccconf 2 (- (strindex "|" ccconf) 2)))) ;; Need at least model configuration list [modellist] selection selections and ;; model configuration [model] param params (need at least one params) (setq cconf (list ccconf (strcat "NumCfgs=1") (strcat "Cfg000=" cconfsel) (strcat "Cfg001=" cconfsel) (strcat "") (strcat "[" cconfsel "]") (strcat "Class= " plmaker " " cclass " Plotter") (strcat "Model=" cconfsel) (strcat "") ) ) (setq n (length cconffile)) (setq cconffile (repl n n cconffile cconf)) ) ) ) (defun cclassify ( ccmodel ) ;; maker and model dependent ;; Determine model class ;; Need a class for each different Source and Mode set ;; These match the models in ccvarval above (cond ((or (= "SummaCAD" (substr ccmodel 1 8)) (= "SummaCAD" (substr ccmodel 2 8))) (setq cclass "SummaCAD")) ((or (= "TechJET 55" (substr ccmodel 1 10)) (= "TechJET 55" (substr ccmodel 2 10))) (setq cclass "TechJET5500")) ((or (= "TechJET 720c" (substr ccmodel 1 12)) (= "TechJET 720c" (substr ccmodel 2 12))) (setq cclass "TechJET720c")) ((or (= "TechJET 720" (substr ccmodel 1 11)) (= "TechJET 720" (substr ccmodel 2 11))) (setq cclass "TechJET720")) ((or (= "Tech" (substr ccmodel 1 4)) (= "Tech" (substr ccmodel 2 4))) (setq cclass "TechJET")) ((or (= "Solu" (substr ccmodel 1 4)) (= "Solu" (substr ccmodel 2 4))) (setq cclass "Solus")) ((or (= "DrawingMaster Plus" (substr ccmodel 1 18)) (= "DrawingMaster Plus" (substr ccmodel 2 18)) ) (setq cclass "DrawingMasterPlus")) ((or (= "Draw" (substr ccmodel 1 4)) (= "Draw" (substr ccmodel 2 4))) (setq cclass "DrawingMaster")) ((or (= "574" (substr ccmodel 1 3)) (= "574" (substr ccmodel 2 3)) (= "584" (substr ccmodel 1 3)) (= "584" (substr ccmodel 2 3)) ) (setq cclass "Electrostatic58K")) ((or (= "674" (substr ccmodel 1 3)) (= "674" (substr ccmodel 2 3)) (= "684" (substr ccmodel 1 3)) (= "684" (substr ccmodel 2 3)) ) (setq cclass "Electrostatic68K")) ((or (= "1044" (substr ccmodel 1 4)) (= "1044" (substr ccmodel 2 4)) (= "1077" (substr ccmodel 1 4)) (= "1077" (substr ccmodel 2 4)) (= "Artisan 1026" (substr ccmodel 1 12)) (= "Artisan 1026" (substr ccmodel 2 12)) (= "Pacesetter C" (substr ccmodel 1 12)) (= "Pacesetter C" (substr ccmodel 2 12)) ) (setq cclass "PenDual")) ((or (= "10" (substr ccmodel 1 2)) (= "10" (substr ccmodel 2 2)) (= "Arti" (substr ccmodel 1 4)) (= "Arti" (substr ccmodel 2 4)) (= "Desi" (substr ccmodel 1 4)) (= "Desi" (substr ccmodel 2 4)) (= "Pace" (substr ccmodel 1 4)) (= "Pace" (substr ccmodel 2 4)) ) (setq cclass "PenSheet")) (t (setq cclass "Unknown")) ) (car (list cclass)) ) (defun ccsele ( cvalue / m n) ;; set config selection (if (/= nil cvalue) (setq ccconfs (cons cvalue (cdr ccconfs))) ) (setq ccconfl (askey "Cfg000" (car ccconfs) ccconfl)) (setq m (cadr (assoc 'firstselection ccconflist))) (setq n (cadr (assoc 'lastselection ccconflist))) (setq cconffile (repl (1+ m) n cconffile (anassignlist ccconfl))) (cclist nil) ) (defun cclist ( cvalue / m n ccsource ccmode ) ;; maker and model dependent ; put and get the model list (if (/= nil cvalue) (setq ccmodels (cons cvalue (cdr ccmodels))) ) (setq cclass (cclassify (car ccmodels))) (setq ccmodell (askey "Plotter000" (car ccmodels) ccmodell)) (setq m (cadr (assoc 'firstselection ccmodellist))) (setq n (cadr (assoc 'lastselection ccmodellist))) (setq cconffile (repl (1+ m) n cconffile (anassignlist ccmodell))) ;(setq ccmodellist (ccselect "[Models]")) ;(setq ccmodell (cadr (assoc 'selections ccmodellist))) ;(setq ccmodels (ccselectlist "Plotter" ccmodell)) ;; place config list (setq ccconfl (strcat "[" (car ccmodels) "]")) (setq ccconflist (ccselect ccconfl)) (if (= nil ccconflist) (progn (cccreateconf ccconfl) (setq ccconflist (ccselect ccconfl)) ) ) (setq ccconfl (cadr (assoc 'selections ccconflist))) (setq ccconfs (ccselectlist "Cfg" ccconfl)) ;;(princ " models ") (princ ccmodels) ;;(princ " cconfs ") (princ ccconfs) (start_list "ccconfigs") (mapcar 'add_list (cdr ccconfs)) (end_list) (set_tile "ccconfigs" (itoa (index (car ccconfs) (cdr ccconfs)))) (mode_tile "ccconfigs" 0) ;; put current parameter list (if (/= nil ccparmlist) (progn (setq PlotterValues (asval "PlotterValues" "0" ccparml)) (setq ccparml (askey "PlotterValues" PlotterValues ccparml)) (setq ccparml (askey "Copies" (asval "Copies" "1" ccparml) ccparml)) (setq ccparml (askey "Sources" (aliststring ccsources "\\n") ccparml)) (setq ccparml (askey "Modes" (aliststring ccmodes "\\n") ccparml)) (setq ccparml (askey "Colors" (aliststring cccolors "\\n") ccparml)) ;; translate names to cdcl ;; should adapt / internationalize ;; SLICE is only supported by Electrostatic68Ks, DrawingMasters, DrawingMasterPluses (setq ccsource (strcase (car ccsources))) (if (or (= cclass "Electrostatic68K") (= cclass "DrawingMaster") (= cclass "DrawingMasterPlus")) (if (= "PLOTTER" ccsource) (setq ccslice "") (if (= " & CUT" (substr ccsource (max 1 (- (strlen ccsource) 5)))) (setq ccslice "SLICE(YES)") (setq ccslice "SLICE(NO)") ) ) (setq ccslice "") ) ;; MEDIA_SOURCE is supported only by Solus (cond ((= "BEST FIT" (substr ccsource 1 8)) (setq ccsource "MEDIA_SOURCE(BEST_FIT)")) ((= "ROLL 2" (substr ccsource 1 6)) (setq ccsource "MEDIA_SOURCE(ROLL_B)")) ((= "ROLL 1" (substr ccsource 1 6)) (setq ccsource "MEDIA_SOURCE(ROLL_A)")) ((= "ROLL B" (substr ccsource 1 6)) (setq ccsource "MEDIA_SOURCE(ROLL_B)")) ((= "ROLL A" (substr ccsource 1 6)) (setq ccsource "MEDIA_SOURCE(ROLL_A)")) (t (setq ccsource "")) ) (setq ccmode (strcat "RAST_MODE(" (strcase (car ccmodes)) ")")) (cond ((= "RAST_MODE(PLOTTER)" ccmode) (setq ccmode "")) ((= "RAST_MODE(ENHANCED FAST)" ccmode) (setq ccmode "RAST_MODE(ENHANCED-FAST)")) ;;((= "RAST_MODE(GRAPHICS)" ccmode) (setq ccmode "RAST_MODE(GRAPHICS-1)")) ((= "RAST_MODE(GRAPHICS FAST)" ccmode) (setq ccmode "RAST_MODE(GRAPHICS-FAST)")) ((= "RAST_MODE(HI-RES MONO)" ccmode) (setq ccmode "RAST_MODE(HI-RES-MONO)")) ((= "RAST_MODE(COLOR SEP)" ccmode) (setq ccmode "RAST_MODE(COLOR_SEP)")) ) (setq ccparml (askey "CDCLSlice" ccslice ccparml)) (setq ccparml (askey "CDCLSource" ccsource ccparml)) (setq ccparml (askey "CDCLMode" ccmode ccparml)) (setq ccparml (askey "CDCLCopies" (strcat "COPIES(" (asval "Copies" "1" ccparml) ")") ccparml)) (setq ccparml (anassignlist ccparml)) ;;(princ " ccparml out ") (princ ccparml) (princ "\n") (setq m (cadr (assoc 'firstselection ccparmlist))) (setq n (cadr (assoc 'lastselection ccparmlist))) (setq cconffile (repl (1+ m) n cconffile ccparml)) ;;(princ " cconffile ") (princ cconffile) ) ) ;; get new parameter list (setq ccparml (strcat "[" (car ccconfs) "]")) (setq ccparmlist (ccselect ccparml)) ;; (princ " cconffile ") (princ cconffile) (princ "\n") (setq ccparml (cadr (assoc 'selections ccparmlist))) ;; (princ " ccparml in ") (princ ccparml) (princ "\n") (if (/= nil cvalue) (progn ;; get plotter options and features (setq ccoption (hexvalue (nth 5 (astringlist (substr (car ccmodels) (1+ (strindex "|" (car ccmodels)))) " ") ))) (setq ccfeature (hexvalue (nth 15 (astringlist (substr (car ccmodels) (1+ (strindex "|" (car ccmodels)))) " ") ))) ) ) ;; setup lists here ;; SummaCAD, TechJETs, and Solus do not support cut(slice) ;; Set the model SHEETFEED option to support cut sheet and ;; adjust the driver margins appropiately ;; ClassSources and ClassModes (setq ccsources (astringlist (asval "Sources" (ccvarval (strcat cclass "Sources")) ccparml) "\\n")) (if (/= 0 (boole 1 ccfeature (cadr (assoc 'HASCDCL ccfeatures)))) (setq ccmodes (astringlist (asval "Modes" (ccvarval (strcat cclass "Modes")) ccparml) "\\n")) (setq ccmodes (astringlist (asval "Modes" (ccvarval "UnknownModes") ccparml) "\\n")) ) (if (/= 0 (boole 1 ccfeature (cadr (assoc 'HASCOLOR ccfeatures)))) (setq cccolors (astringlist (asval "Colors" (ccvarval "StdColors") ccparml) "\\n")) (setq cccolors (astringlist (asval "Colors" (ccvarval "StdGreys") ccparml) "\\n")) ) (setq ccparml (askey "Sources" (aliststring ccsources "\\n") ccparml)) (setq ccparml (askey "Modes" (aliststring ccmodes "\\n") ccparml)) (setq ccparml (askey "Colors" (aliststring cccolors "\\n") ccparml)) (ccputlist "Sources" ccsources) (ccputlist "Modes" ccmodes) (ccputlist "Colors" cccolors) (setq Copies (asval "Copies" "1" ccparml)) (setq ccparml (askey "Copies" Copies ccparml)) (set_tile "Copies" Copies) (setq PlotterValues (asval "PlotterValues" "0" ccparml)) (setq ccparml (askey "PlotterValues" PlotterValues ccparml)) (set_tile "PlotterValues" PlotterValues) (set_tile "comment" (asval "AnnoComm" "" ccparml)) ;; enable/disable tiles ;(if (/= 0 (boole 1 ccfeature (cadr (assoc 'HASCDCL ccfeatures)))) ;(mode_tile "conn" 1) ;(mode_tile "conn" 0) ;) (if (/= "0" PlotterValues) (progn ; disable tiles ;(mode_tile "anno" 1) ;(mode_tile "conn" 1) ;(mode_tile "pens" 1) ;(mode_tile "media" 1) (mode_tile "Sources" 1) (mode_tile "Modes" 1) (mode_tile "Colors" 1) (mode_tile "Copies" 1) ) (progn ; enable tiles (mode_tile "anno" 0) (mode_tile "conn" 0) (mode_tile "pens" 0) (mode_tile "media" 0) (mode_tile "Sources" 0) (mode_tile "Modes" 0) (mode_tile "Colors" 0) (mode_tile "Copies" 0) ) ) ) (defun ccolor ( cvalue ) ;; maker and model dependent (setq cccolors cvalue) (if (or (= cclass "SummaCAD")(= cclass "TechJET720c")) (progn ;; Changing colors will change modes (if (= (car cccolors) "Color") (setq ccmodes (astringlist (ccvarval (strcat cclass "Modes")) "\\n")) (setq ccmodes (astringlist (ccvarval (strcat cclass "GModes")) "\\n")) ) (setq ccparml (askey "Modes" (aliststring ccmodes "\\n") ccparml)) (ccputlist "Modes" ccmodes) ) ) ) (defun ccfread ( ccf / f l l1 n cconffile) ;; find the configuration file ;; search the default paths ;;(princ ccf) (setq ccfn (findfile ccf)) (if (null ccfn) ;; search up one if not found (progn (setq ccfn (strcat "../" ccf)) (setq ccf ccfn) (setq ccfn (findfile ccf)) ;; no longer inquire if not found - assumed not configured ;;(if (null ccfn) ;; inquire if still not found ;;(setq ccfn (getfiled (strcat plmaker " Configuration File") (strcat plpfile ".inc") "inc" 10)) ;;) ) ) ;; read configuration file into the cconffile list ;; add a newline n at the end if necessary (setq cconffile nil n 1) (if (and (not (null ccfn)) (/= nil (setq f (open ccfn "r")))) (progn (while (setq l (read-line f)) ;; Clean up file - insert blank lines before sections and at the end, drop other blank lines (if (= "[" (substr l 1 1)) (setq cconffile (append cconffile (list (strcat ""))))) (if (/= "" l) (setq cconffile (append cconffile (list (strcat l))))) ;; (setq cconffile (cons (list (strcat l)) cconffile)) ) (setq cconffile (append cconffile (list (strcat "")))) ;; (setq cconffile (reverse cconffile)) (close f) ) ) (car (list cconffile)) ;; return cconffile ) (defun ccfwrite ( ccfn / f l) (if (= nil ccfn) (setq l nil) (progn (if (setq f (open ccfn "w")) (progn ;;(princ " cconffile ") (princ cconffile) (foreach l cconffile (write-line l f)) (close f) ) ) ) ) ) (defun ccassign ( variable value values ) ;; set the first of values to the selected value and assign this to variable (setq values (cons (nth (atoi value) (cdr values)) (cdr values))) (setq ccparml (askey variable values ccparml)) (car (list values)) ) (defun ccexit ( ) (if (not (new_dialog "nomodels" dcl_id)) (exit)) (action_tile "accept" "(ccfwrite ccfn) (done_dialog)" ) (action_tile "cancel" "(done_dialog)") ;; begin (start_dialog) ) (defun c:cconfig( / f l ccf) ;; maker and model dependent ;; these globals are used throughout (setq plmaker "CalComp") (setq plpfile "plpccw") (setq pllogo "cclogo") ;; load configuration mainmenu (setq ccexits 0 dcl_id (load_dialog (ccfile (strcat plpfile ".dcl")))) ;; get model file ;; (setq ccf (ccfile (strcat plpfile ".inm"))) ;; (setq cmodelfile (ccfread ccf)) ;; get configuration file (setq ccf (ccfile (strcat plpfile ".inc"))) (setq cconffile (ccfread ccf)) ;; get modellist (setq ccmodel "[Models]") (setq ccmodellist (ccselect ccmodel)) (setq ccmodell (cadr (assoc 'selections ccmodellist))) (setq ccmodels (ccselectlist "Plotter" ccmodell)) (if (= nil ccmodels) (progn (if (not (new_dialog "nomenu" dcl_id)) (exit)) (action_tile "accept" "(done_dialog)" ) ;; begin (start_dialog) ;; end (unload_dialog dcl_id) ) (progn ;; present configuration mainmenu (if (not (new_dialog "mainmenu" dcl_id)) (exit)) ;; put modellist (start_list "ccmodels") (mapcar 'add_list (cdr ccmodels)) (end_list) (set_tile "ccmodels" (itoa (index (car ccmodels) (cdr ccmodels)))) (mode_tile "ccmodels" 0) ;; place logo (ccimages pllogo (strcat plpfile "(" pllogo ")")) ;; ccoptions only longaxis used (setq ccoptions (list (list 'MULTIPEN 1) (list 'MULTILINE 2) (list 'VARSPEED 4) (list 'PENWID 8) (list 'VARINC 16) (list 'ONEPEN 32) (list 'SHEETFEED 64) (list 'NOPENS 128) (list 'SFILLS 256) (list 'FFILE 512) (list 'UPDPWID 1024) (list 'LONGAXIS 2048) (list 'MULT2 4096) )) ;; ccfeatures only hascolor, hascdcl used (setq ccfeatures (list (list 'PALETTE 1) (list 'HASCOLOR 2) (list 'PENMAP 4) (list 'HASCDCL 8) (list 'MULTICOPY 16) (list 'CDCLT 32) (list 'SROLL 64) (list 'INDEX 128) (list 'HASCDCLPENS 256) (list 'HASSEQOV 512) )) (setq ccparmlist nil) (cclist (car ccmodels)) ;; setup callbacks ;; advanced options (action_tile "anno" "(ccanno)" ) (action_tile "conn" "(ccconn)" ) (action_tile "pens" "(ccpens)" ) (action_tile "media" "(ccmedia)" ) ;; model configurations (action_tile "ccmodels" "(cclist (nth (atoi $value) (cdr ccmodels)))" ) (action_tile "ccconfigs" "(ccsele (nth (atoi $value) (cdr ccconfs )))" ) (action_tile "new" "(ccsele (car ccconfs)) (ccnew)" ) ;; set parameters before new (action_tile "delete" "(ccdelete) (if (= 1 ccexits) (progn (ccexit) (done_dialog)))" ) ;; standard options (action_tile "PlotterValues" "(setq ccparml (askey \"PlotterValues\" $value ccparml)) (cclist nil)" ) (action_tile "Sources" "(setq ccsources (ccassign \"Sources\" $value ccsources))" ) (action_tile "Modes" "(setq ccmodes (ccassign \"Modes\" $value ccmodes))" ) (action_tile "Colors" "(ccolor (ccassign \"Colors\" $value cccolors))" ) ;;(action_tile "Colors" "(setq cccolors (ccassign \"Colors\" $value cccolors))" ) (action_tile "Copies" "(setq ccparml (askey \"Copies\" $value ccparml))" ) ;; standard controls (action_tile pllogo "(ccabout pllogo)" ) (action_tile "accept" "(cclist (car ccmodels)) (ccfwrite ccfn) (done_dialog)" ) (action_tile "cancel" "(done_dialog)" ) (action_tile "help" "(acad_helpdlg (ccfileh plpfile) \"CCONFIG\" )" ) (action_tile "about" "(ccabout pllogo)" ) ;; begin (start_dialog) ;; end (unload_dialog dcl_id) )) ;; end of models / no models list if ) (defun cconfig ( ) (c:cconfig) ) ;; automatic load ;; (autoload "drv/plpccw" '( "cconfig" "cconfig")) ;; manual load ;; (load "drv/plpccw") ;; installation ;; (load "a:/plpccw/install.lsp")