home *** CD-ROM | disk | FTP | other *** search
/ Enter 2003 March / EnterCD 03_2003.iso / Multimedia / IntelliCAD 2001 3.3 / data1.cab / tablet / TABLET.LSP < prev   
Encoding:
Lisp/Scheme  |  2003-01-05  |  23.1 KB  |  658 lines

  1. ; tablet_import.lsp
  2. ; Copyright (C) 1998 Visio Corporation.  All Rights Reserved.
  3.  
  4. ; By Ronald Prepchuk
  5.  
  6. (defun C:TABLET_IMPORT (/ DCL_ID MENU_LIST MENU_FILE *ERROR* ERROR_ST)
  7.   (defun *ERROR* (STR)
  8.     (princ ERROR_ST)
  9.     (princ STR)
  10.     (princ "\nAvailable commands are: TABLET_IMPORT or TABI, CLEARTAB")
  11.     (princ)
  12.   )
  13.   (setq ERROR_ST "\nError in C:TABLET_IMPORT: ")
  14.   (cond
  15.     ((not tablet_getgriditem) ;not IntelliCAD 98d
  16.      (alert "You are not using IntelliCAD 98d.  This program\nwill only work with release 98d or later.")
  17.      (exit)
  18.     )
  19.     ((and tablet_getgriditem (= (type (tablet_getgriditem 1 1)) 'INT));IntelliCAD 98d but digitizer not configured properly
  20.      (alert "Your digitizer tablet has not been properly configured.\nPlease refer to the documentation for proper setup procedures.")
  21.      (exit)
  22.     )
  23.     ((and tablet_getgriditem (= (type (tablet_getgriditem 1 1)) 'STR));IntelliCAD 98d and digitizer configured properly
  24.      (if (= (setq DCL_ID (load_dialog "tablet.dcl")) -1)
  25.        (progn (setq ERROR_ST "\ntablet.dcl Not Found!") (exit))
  26.        (progn
  27.          (new_dialog "tablet_import" DCL_ID)
  28.          (setq MENU_LIST (READ_INI))
  29.          (mapcar '(lambda (KEY)
  30.         (action_tile KEY "(TAB_IMP_CALLBK $KEY $REASON)")
  31.           )
  32.          '("filename_e"    "filename_b"    "Tablet1_ul"
  33.            "Tablet2_ul"    "Tablet3_ul"    "Tablet4_ul"
  34.            "Screen_ul"     "Tablet1_lr"    "Tablet2_lr"
  35.            "Tablet3_lr"    "Tablet4_lr"    "Screen_lr"
  36.            "Import1"       "Import2"       "Import3"
  37.            "Import4"       "ImportS"       "accept"
  38.            "cancel"           "help"
  39.           )
  40.          )
  41.          (show_val)
  42.          (show_layout)
  43.          (if MENU_FILE
  44.            (set_tile "filename_e" MENU_FILE)
  45.          )
  46.          (mode_tile "accept" 2) ;set focus to tile
  47.          (if (= (start_dialog) 1)
  48.            (import_menu MENU_FILE MENU_LIST)
  49.          )
  50.          (unload_dialog DCL_ID)
  51.          (setq DCL_ID nil)
  52.         )
  53.       )
  54.     )
  55.   )
  56.   (princ)
  57. )
  58.  
  59.  
  60.  
  61.  
  62. (defun TAB_IMP_CALLBK ($KEY $REASON / STR)
  63.   (setq ERROR_ST "\Error in TAB_IMP_CALLBK: ")
  64.   (set_tile "error" "")
  65.   (cond
  66.     ((= $KEY "help")
  67.      (alert "1. Start by selecting a menu file to import.  Select the 'Browse' button \nor type the name and location in the 'Filename:' edit box.  The menu \nfile should be an AutoCAD style menu containing TABLET and/or BUTTON \nmenu areas.  The number of cells in each menu area will display in the \ncolumn marked 'Cells'.  After selecting a file two new files will be \ncreated: a log file (.mlg) that contains error messages and an import \nfile (.mni) which contains just the tablet and button areas in the \nformat they will be used in IntelliCAD.\n\n2. For each Tablet menu area enter the 'Upper Left' and 'Lower Right' \ncorners in the format <Row>:<Column>.  For example, the upper left of \n'Tablet 1' is usually A:1.\n\n3. If there are tablet menus you don't want to import you may toggle \nthem on and off.  If you are importing a regular AutoCAD tablet menu\nyou will want to toggle off Tablet 3 since it contains duplicates.")
  68.      )    
  69.     ((= (substr $KEY 1 6) "Import");can't select Screen import toggle
  70.       (setq MENU (assoc (strcat "TABLET" (substr $KEY 7 1)) MENU_LIST))
  71.       ;toggle the last item in MENU between T and nil
  72.       (setq MENU_LIST
  73.          (subst (subst (if (= (get_tile $KEY) "0") nil T) (last MENU) MENU) MENU MENU_LIST)
  74.         )
  75.       (show_val)
  76.       )
  77.     ((and (member (substr $KEY 1 6) '("Tablet" "Screen")) (/= (get_tile $KEY) ""))
  78.       (set_tile $KEY (strcase (get_tile $KEY)))
  79.       (setq MENU_CORNER (parse $KEY "_"));returns area and corner
  80.       (setq VAL (parse (get_tile $KEY) ":"))
  81.       (setq MENU (assoc (strcase (car MENU_CORNER)) MENU_LIST))
  82.       (if
  83.     (and
  84.       (= (length VAL) 2);both row and column exist
  85.       (check_cell VAL);check for within range
  86.       )
  87.     (progn
  88.       (setq MENU    ;replace current value in MENU
  89.          (append
  90.            (list (car MENU) (cadr MENU));Menu area and # cells
  91.            (if (= (cadr MENU_CORNER) "ul")
  92.              (append VAL (list (nth 4 MENU) (nth 5 MENU) (nth 6 MENU)))
  93.              (append (list (nth 2 MENU) (nth 3 MENU)) VAL (list (nth 6 MENU)))
  94.              )
  95.            )
  96.         )
  97.       (setq MENU_LIST (subst MENU (assoc (strcase (car MENU_CORNER)) MENU_LIST) MENU_LIST))
  98.       (if (/= "" (nth (if (= (cadr MENU_CORNER) "ul") 4 2) MENU));Other corner not empty
  99.         (progn
  100.           (set_tile (strcat "Import" (substr (car MENU_CORNER) 7)) "1");turn Import toggle On
  101.           (show_layout)
  102.           (if (check_area MENU)
  103.         (set_tile "error" "Areas overlap.  Please change")
  104.         )
  105.           )
  106.         )
  107.       )
  108.     (progn
  109.           (show_val)      
  110.       (mode_tile $KEY 2)
  111.        (set_tile "error" "Out of range . . Resetting")      
  112.       )
  113.     )
  114.       )
  115.     ((= (substr $key 1 8) "filename")
  116.       (setq FILENAME
  117.         (if (= $KEY "filename_e")
  118.           (if (setq STR (findfile (get_tile "filename_e")))
  119.         STR
  120.         (if (= (get_tile "filename_e") "") nil (progn (set_tile "error" (strcat "File '" (get_tile "filename_e") "' not found!")) nil))
  121.         )
  122.           (if (setq STR (getfiled "Select a menu file" (if MENU_FILE MENU_FILE (if (findfile "acad.mnu") (findfile "acad.mnu") "")) "mnu" 0))
  123.         (progn
  124.               (set_tile "filename_e" (setq MENU_FILE STR))
  125.             (setq MENU_FILE (car (parse MENU_FILE ".")));strip extension
  126.           (read_menu MENU_FILE)
  127.           (show_val)
  128.           (show_layout)
  129.           )
  130.         )
  131.       )
  132.         )
  133.       )
  134.     ((= $KEY "accept")
  135.       (save_ini)
  136.       (done_dialog 1)
  137.       )
  138.     )
  139.   )
  140.     
  141.  
  142. (defun CHECK_CELL (VAL)
  143.   (setq ERROR_ST "\Error in CHECK_CELL: ")  
  144.   (and (<= "A" (car VAL) "Z")
  145.        (= (strlen (car VAL)) 1)
  146.        (<= 1 (atoi (cadr VAL)) 26)
  147.        )
  148.   )
  149.  
  150.  
  151. (defun CHECK_AREA (MENU / MENU_NAME MENU_AREA FLAG)
  152.   (setq ERROR_ST "\Error in CHECK_AREA: ")  
  153.   (foreach MENU_NAME '("TABLET1" "TABLET2" "TABLET3" "TABLET4" "SCREEN")
  154.     (if (and (/= MENU_NAME (car MENU)) (setq MENU_AREA (assoc MENU_NAME MENU_LIST)))
  155.       (if (or
  156.         (and
  157.           (<= (nth 2 MENU_AREA) (nth 2 MENU) (nth 4 MENU_AREA));Upper left X
  158.              (<= (nth 3 MENU_AREA) (nth 3 MENU) (nth 5 MENU_AREA));Upper left Y
  159.           )
  160.         (and
  161.            (<= (nth 2 MENU_AREA) (nth 4 MENU) (nth 4 MENU_AREA));Lower right X
  162.              (<= (nth 3 MENU_AREA) (nth 5 MENU) (nth 5 MENU_AREA));Lower right Y
  163.           )
  164.         )
  165.     (setq FLAG T)
  166.     )
  167.       )
  168.     )
  169.   FLAG
  170.   )
  171.  
  172.     
  173. ;SETS THE FIELDS    
  174. (defun SHOW_VAL (/ MENU_NAME MENU_AREA)
  175.   (setq ERROR_ST "\Error in SHOW_VAL: ")
  176.   (foreach MENU_NAME '("Tablet1" "Tablet2" "Tablet3" "Tablet4" "Screen")
  177.     (if (setq MENU_AREA (assoc (strcase MENU_NAME) MENU_LIST))
  178.       (progn
  179.     (if (last MENU_AREA);enable edit boxes
  180.       (progn
  181.         (mode_tile (strcat MENU_NAME "_ul") 0)
  182.         (mode_tile (strcat MENU_NAME "_lr") 0)
  183.         (set_tile (strcat "Import" (substr MENU_NAME 7)) "1")
  184.         )
  185.       (progn;disable edit boxes
  186.         (mode_tile (strcat MENU_NAME "_ul") 1)
  187.         (mode_tile (strcat MENU_NAME "_lr") 1)
  188.         (set_tile (strcat "Import" (substr MENU_NAME 7)) "0")
  189.         )
  190.       )
  191.     (set_tile (strcat "COUNT" (substr MENU_NAME 7) "") (itoa (nth 1 MENU_AREA)))
  192.     (set_tile (strcat MENU_NAME "_ul") 
  193.           (if (/= (nth 2 MENU_AREA) (nth 3 MENU_AREA))
  194.             (strcat (nth 2 MENU_AREA) ":" (nth 3 MENU_AREA))
  195.             ""
  196.             )
  197.       )
  198.     (set_tile (strcat MENU_NAME "_lr")
  199.           (if (/= (nth 4 MENU_AREA) (nth 5 MENU_AREA))
  200.             (strcat (nth 4 MENU_AREA) ":" (nth 5 MENU_AREA))
  201.             ""
  202.             )
  203.       )
  204.     )
  205.       (progn;if menu area doesn't exist disable edit boxes
  206.     (set_tile (strcat MENU_NAME "_ul") "")
  207.     (set_tile (strcat MENU_NAME "_lr") "")
  208.     (set_tile (strcat "Import" (substr MENU_NAME 7)) "0")
  209.     (mode_tile (strcat MENU_NAME "_ul") 1)
  210.     (mode_tile (strcat MENU_NAME "_lr") 1)
  211.     )
  212.       )
  213.     )
  214.   )
  215.  
  216. (defun SET_EDIT (/ MENU)
  217.   (setq ERROR_ST "\Error in SET_EDIT: ")  
  218.   (get_tile "menulist")
  219.   (setq MENU (nth (atoi (get_tile "menulist")) MENU_LIST))
  220.   (mapcar 'set_tile '("menu" "cells" "llrow" "llcol" "urrow" "urcol") menu)
  221.   )
  222.  
  223. (defun show_layout (/ MENU DIMX DIMY COUNT CELLX CELLY UL_X UL_Y LR_X LR_Y MENU)
  224.   (setq ERROR_ST "\Error in TAB_IMP_CALLBK: ")  
  225.   (setq DIMX (dimx_tile "layout") DIMY (dimy_tile "layout"))
  226.   (start_image "layout")
  227.   (fill_image 0 0 DIMX DIMY 0)
  228.   (setq COUNT 0)
  229.   (SETQ CELLX (/ DIMX 26.0) CELLY (/ DIMY 26.0));width and height of each cell as REAL to keep it accurate
  230.   (repeat 27
  231.     (vector_image 0 (fix (* COUNT CELLY)) DIMX (fix (* COUNT CELLY)) 8);Horizontal
  232.     (vector_image (fix (* COUNT CELLX)) 0 (fix (* COUNT CELLX)) DIMY 8);Vertical
  233.     (setq COUNT (1+ COUNT))
  234.     )
  235.   (foreach MENU MENU_LIST
  236.     (if (not (member "" MENU))
  237.       (progn
  238.         (setq
  239.           UL_X (fix (- (* CELLX (atoi (nth 3 MENU))) (* 0.5 CELLX)));Range 1-26      
  240.       UL_Y (fix (+ (* CELLY (- (ascii (nth 2 MENU)) 65)) (* 0.5 CELLY)));Range A-Z
  241.           LR_X (fix (- (* CELLX (atoi (nth 5 MENU))) (* 0.5 CELLX)));Range 1-26      
  242.           LR_Y (fix (+ (* CELLY (- (ascii (nth 4 MENU)) 65)) (* 0.5 CELLY)));Range A-Z      
  243.       )
  244.         (vector_image UL_X UL_Y LR_X UL_Y 2)
  245.         (vector_image LR_X UL_Y LR_X LR_Y 2)
  246.         (vector_image LR_X LR_Y UL_X LR_Y 2)
  247.         (vector_image UL_X LR_Y UL_X UL_Y 2)
  248.     )
  249.       )
  250.     )
  251.   (end_image)
  252.   )
  253.  
  254. (defun PARSE (STR DELIM / COUNT CH RES_STR RES_LIST)
  255.   (setq ERROR_ST "\Error in PARSE: ")  
  256.   (if (= (type STR) 'STR)
  257.     (progn
  258.       (setq COUNT 1 RES_STR "" RES_LIST (list))
  259.       (repeat (strlen STR)
  260.         (setq CH (substr STR COUNT 1))
  261.     (if (= CH DELIM)
  262.       (setq RES_LIST (append RES_LIST (list RES_STR)) RES_STR "")
  263.       (setq RES_STR (strcat RES_STR CH))
  264.           )
  265.     (setq COUNT (1+ COUNT))
  266.     )
  267.       (if (> (strlen RES_STR) 0)
  268.     (setq RES_LIST (append RES_LIST (list RES_STR)))
  269.     )
  270.       RES_LIST
  271.       )
  272.     )
  273.   )
  274.    
  275. ;This function will read an AutoCAD style menu and output an IntelliCAD Style menu
  276. ;Reads just button and tablet areas, ignores everything else
  277. (defun READ_MENU (FILENAME / READF WRITEF LOGFILE RECORD MENU_AREA MENU_LINE)
  278.   (setq ERROR_ST "\Error in READ_MENU: ")  
  279.   (setq MAX_MENU_STR 255 MENU_LIST '(("SCREEN" 1 "J" "12" "R" "22" T)))
  280.   (if (findfile (strcat FILENAME ".mnu"))
  281.     (progn
  282.       (setq READF (open (strcat FILENAME ".mnu") "r"))
  283.       (setq WRITEF (open (strcat FILENAME ".mni") "w"))
  284.       (setq LOGFILE (open (strcat FILENAME ".mlg") "w"))
  285.       (while (setq RECORD (read-line READF))
  286.     (cond
  287.       ((= (substr RECORD 1 3) "***");new menu area
  288.         (if (member (substr RECORD 4 6) '("TABLET" "BUTTON"))
  289.           (progn
  290.             (setq MENU_AREA (substr RECORD 4) MENU_LINE nil MENU_COUNT 1)
  291.               (if (= MENU_AREA "TABLET1")
  292.             (setq MENU_LIST (cons (list MENU_AREA MENU_COUNT "A" "1" "I" "25" T) MENU_LIST));set default area for Tablet 1
  293.             (setq MENU_LIST (cons (list MENU_AREA MENU_COUNT "" "" "" "" nil) MENU_LIST))
  294.             )
  295.           (write-line RECORD WRITEF)
  296.           )
  297.           (setq MENU_AREA nil)
  298.           )
  299.         )
  300.       ((zerop (strlen RECORD)));empty string, do nothing
  301.       ((= (substr RECORD 1 2) "//"));comment, do nothing
  302.        ((= (substr RECORD 1 2) "**"));sub menu area, ignore
  303.       ((= (substr RECORD (strlen RECORD) 1) "+")
  304.         (setq MENU_LINE (strcat (cond (MENU_LINE) (T "")) RECORD))
  305.         )
  306.       (MENU_AREA
  307.         (if (null MENU_LINE) (setq MENU_LINE RECORD))
  308.         (if (> (strlen MENU_LINE) MAX_MENU_STR)
  309.           (write-line (strcat "Menu: " MENU_AREA " Cell: " (itoa MENU_COUNT) " Truncated") LOGFILE)
  310.           )
  311.         (write-line (substr MENU_LINE 1 MAX_MENU_STR) WRITEF)
  312.         (setq MENU_COUNT (1+ MENU_COUNT) MENU_LINE nil)
  313.         )
  314.       )
  315.     )
  316.       (close READF)
  317.       (close WRITEF)
  318.       (close LOGFILE)
  319.       (set_tile "status" (strcat "Log file written to: " FILENAME ".mlg"))
  320.       )
  321.     (princ (strcat "\nFile " FILENAME " not found!"))
  322.     )
  323.   )
  324.  
  325. (defun IMPORT_MENU (FILENAME MENU_LIST / READF LOGFILE RECORD MENU_AREA MENU)
  326.   (setq ERROR_ST "\Error in IMPORT_MENU: ")
  327.   (if (findfile (strcat FILENAME ".mni"))
  328.     (progn
  329.       (setq READF (open (strcat FILENAME ".mni") "r"))
  330.       (setq LOGFILE (open (strcat FILENAME ".mlg") "a"))
  331.       (while (setq RECORD (read-line READF))
  332.     (cond
  333.       ((= (substr RECORD 1 3) "***");new menu area
  334.         (setq MENU_AREA (substr RECORD 4 7)
  335.               MENU (assoc MENU_AREA MENU_LIST)
  336.           )
  337.         (if (and
  338.           (last MENU);menu is tagged for import
  339.           (not (member "" MENU))
  340.           )
  341.           (progn
  342.           (setq MENU_ROWS (1+ (- (ascii (nth 4 MENU)) (ascii (nth 2 MENU))))
  343.             MENU_COLS (1+ (- (atoi (nth 5 MENU)) (atoi (nth 3 MENU))))
  344.             MENU_MAXLEN (* MENU_ROWS MENU_COLS)
  345.             MENU_COUNT 0
  346.             )
  347.           )
  348.           (setq MENU nil MENU_AREA nil MENU_MAXLEN nil)
  349.           )
  350.         )
  351.       (MENU_AREA
  352.         (setq MENU_COUNT (1+ MENU_COUNT))
  353.         (cond
  354.           ((= (substr MENU_AREA 1 6) "BUTTON")
  355.             (tablet_setbutton MENU_COUNT RECORD);This needs work
  356.             )
  357.           ((= (substr MENU_AREA 1 6) "TABLET")
  358.             (if (<= MENU_COUNT MENU_MAXLEN)
  359.           (progn
  360.                 (setq ROW (1+ (fix (/ (1- MENU_COUNT) MENU_COLS)))
  361.               COL (- MENU_COUNT (* (1- ROW) MENU_COLS))
  362.               )
  363.             (setq RECORD (last (parse RECORD "]")));remove label
  364.                 (tablet_setgriditem (+ ROW (- (ascii (nth 2 MENU)) 65)) (+ COL -1 (atoi (nth 3 MENU))) RECORD)
  365.             )
  366.           (write-line (strcat "Menu: " MENU_AREA " Cell: " (itoa MENU_COUNT) " Not imported") LOGFILE)
  367.           )
  368.             )
  369.           )
  370.         )
  371.       )
  372.     )
  373.       (close READF)
  374.       (close LOGFILE)
  375.       (princ (strcat "\nLog file written to: " FILENAME ".mlg"))
  376.       )
  377.     )
  378.   )
  379.  
  380.  
  381. (defun READ_INI (/ FILENAME READF RECORD)
  382.   (setq ERROR_ST "\Error in READ_INI: ")  
  383.   (if (setq FILENAME (findfile "tablet_import.ini"))
  384.     (progn
  385.       (setq READF (open FILENAME "r"))
  386.       (setq RECORD (read (read-line READF)))
  387.       (close READF)
  388.       )
  389.     )
  390.   (if (and RECORD (= (type RECORD) 'LIST))
  391.     (progn (setq MENU_FILE (car RECORD)) (cdr RECORD))
  392.     '(("SCREEN" 1 "J" "12" "R" "22" T))
  393.     )
  394.   )
  395.  
  396. (defun SAVE_INI (/ FILENAME READF)
  397.   (setq ERROR_ST "\Error in SAVE_INI: ")  
  398.   (cond
  399.     ((setq FILENAME (findfile "tablet_import.ini")))
  400.     ((setq FILENAME (findfile "tablet_import.lsp"))
  401.       (setq FILENAME (strcat (car (parse FILENAME ".")) ".ini"))
  402.       )
  403.     ((setq FILENAME (findfile "icad.exe"))
  404.       (setq FILENAME (strcat (apply 'strcat (mapcar '(lambda (STR) (strcat STR "\\")) (reverse (cdr (reverse (parse FILENAME "\\")))))) "tablet_import.ini"))
  405.       )
  406.     )
  407.   (setq READF (open FILENAME "w"))
  408.   (prin1 (cons MENU_FILE MENU_LIST) READF)
  409.   (close READF)
  410.   )
  411.  
  412. ;The following function will clear all tablet cells setting them to ""
  413. (defun C:CLEARTAB (/ COL ROW)
  414. (setq COL 1 ROW 1)
  415. (repeat 26
  416.   (repeat 26
  417.     (tablet_setgriditem ROW COL (strcat ""))
  418.     (setq COL (1+ COL))
  419.     )
  420.   (setq ROW (1+ ROW) COL 1)
  421.   )
  422. )
  423.  
  424. (defun C:TABI () (C:TABLET_IMPORT))
  425.  
  426. ; tablet_modify.lsp
  427. ; Copyright (C) 1998 Visio Corporation.  All Rights Reserved.
  428.  
  429. ; By Ronald Prepchuk
  430.  
  431. (defun C:TABLET_MODIFY (/ DCL_ID CELL DIMX DIMY COUNT CELLX CELLY *ERROR* ERROR_ST)
  432.   (defun *ERROR* (STR)
  433.     (princ ERROR_ST)
  434.     (princ STR)
  435.     (princ "\nAvailable commands are: TABLET_MODIFY or TABM")
  436.     (princ)
  437.   )
  438.   (setq ERROR_ST "\nError in C:TABLET_MODIFY ")
  439.   (cond
  440.     ((not tablet_getgriditem);not IntelliCAD 98d
  441.      (alert "You are not using IntelliCAD 98d.  This program\nwill only work with release 98d or later.")
  442.      (exit)
  443.     )
  444.     ((and tablet_getgriditem (= (type (tablet_getgriditem 1 1)) 'INT));IntelliCAD 98d but digitizer not configured properly
  445.      (alert "Your digitizer tablet has not been properly configured.\nPlease refer to the documentation for proper setup procedures.")
  446.      (exit)
  447.     )
  448.     ((and tablet_getgriditem (= (type (tablet_getgriditem 1 1)) 'STR));IntelliCAD 98d and digitizer configured properly
  449.      (if (= (setq DCL_ID (load_dialog "tablet.dcl")) -1)
  450.        (progn (setq ERROR_ST "\ntablet.dcl Not Found!") (exit))
  451.        (progn
  452.      (new_dialog "modify_tablet" DCL_ID)
  453.      (mapcar
  454.        '(lambda (KEY)
  455.           (action_tile KEY "(TAB_MOD_CALLBK $KEY $REASON $X $Y)")
  456.         )
  457.        '("layout" "accept" "help")
  458.      )
  459.      (setq CELL (list 1 1 (tablet_getgriditem 1 1)))
  460.      (set_cells 1 1 nil)
  461.      (show_grid)
  462.      (mode_tile "accept" 2) ;set focus to tile
  463.      (start_dialog)
  464.      (unload_dialog DCL_ID)
  465.        )
  466.      )
  467.     )
  468.   )
  469.   (princ)
  470. )
  471.  
  472.  
  473. (defun TAB_MOD_CALLBK ($KEY $REASON $X $Y / ROW COL)
  474.   (setq ERROR_ST "\nError in TAB_MOD_CALLBK: ")
  475.   (cond
  476.     ((= $KEY "layout")
  477.       (setq ROW (1+ (fix (/ $Y CELLY))) COL (1+ (fix (/ $X CELLX))))
  478.       (set_cells ROW COL T)     
  479.      )
  480.     ((= $KEY "accept")
  481.       (set_cells (nth 0 CELL) (nth 1 CELL) T)
  482.       (done_dialog)
  483.       )
  484.     ((= $KEY "help")
  485.      (alert "To change the command associated with a cell, click on that cell within the grid.\nThe contents of that cell will show up in the box labeled 'Cell contents'.   \nYou may edit the contents and when you switch focus to a different \nbutton or select 'Done' the changes you have made will be saved.  \nIMPORTANT: there is no Undo button, once you make changes they are \nsaved.")
  486.      )    
  487.     )
  488.   )
  489.  
  490. (defun SET_CELLS (ROW COL FLAG)
  491.   (setq ERROR_ST "\Error in SET_CELLS: ")
  492.   (set_tile "cell_num" (strcat "Cell: " (chr (+ 64 ROW)) ":" (itoa COL)))
  493.   (if FLAG;user switched focus
  494.     (if (/= (get_tile "cell") (last CELL));cell has been modified
  495.       (tablet_setgriditem (nth 0 CELL) (nth 1 CELL) (get_tile "cell"))
  496.       )
  497.     (set_tile "cell" (tablet_getgriditem ROW COL))
  498.     )
  499.   (setq CELL (list ROW COL (tablet_getgriditem ROW COL)))
  500.   (set_tile "cell" (last CELL))
  501.   )
  502.  
  503. (defun SHOW_GRID (/ COUNT)
  504.   (setq ERROR_ST "\Error in SHOW_GRID: ")
  505.   (setq DIMX (dimx_tile "layout") DIMY (dimy_tile "layout"))
  506.   (start_image "layout")
  507.   (fill_image 0 0 DIMX DIMY 0)
  508.   (setq COUNT 0)
  509.   (SETQ CELLX (/ DIMX 26.0) CELLY (/ DIMY 26.0));width and height of each cell as REAL to keep it accurate
  510.   (repeat 27
  511.     (vector_image 0 (fix (* COUNT CELLY)) DIMX (fix (* COUNT CELLY)) 8);Horizontal
  512.     (vector_image (fix (* COUNT CELLX)) 0 (fix (* COUNT CELLX)) DIMY 8);Vertical
  513.     (setq COUNT (1+ COUNT))
  514.     )
  515.   (end_image)
  516.   )
  517.  
  518. (defun C:TABM () (C:TABLET_MODIFY))
  519.  
  520. ; button_modify.lsp
  521. ; Copyright (C) 1998 Visio Corporation.  All Rights Reserved.
  522.  
  523. ; By Ronald Prepchuk
  524.  
  525. (defun C:BUTTON_MODIFY (/ DCL_ID BUTTON *ERROR* ERROR_ST)
  526.   (defun *ERROR* (STR)
  527.     (princ ERROR_ST)
  528.     (princ STR)
  529.     (princ "\nAvailable commands are: BUTTON_MODIFY or BUTM")
  530.     (princ)
  531.   )
  532.   (setq ERROR_ST "\nError in C:BUTTON_MODIFY: ")
  533.   (cond
  534.     ((not tablet_getbutton);not IntelliCAD 98d
  535.      (alert "You are not using IntelliCAD 98d.  This program\nwill only work with release 98d or later.")
  536.      (exit)
  537.     )
  538.     ((and tablet_getbutton (= (type (tablet_getbutton 0)) 'INT));IntelliCAD 98d but digitizer not configured properly
  539.      (alert "Your digitizer tablet has not been properly configured.\nPlease refer to the documentation for proper setup procedures.")
  540.      (exit)
  541.     )
  542.     ((and tablet_getbutton (= (type (tablet_getbutton 0)) 'STR));IntelliCAD 98d and digitizer configured properly
  543.      (if (= (setq DCL_ID (load_dialog "tablet.dcl")) -1)
  544.        (progn (setq ERROR_ST "\ntablet.dcl Not Found!") (exit))
  545.        (progn
  546.      (new_dialog "modify_button" DCL_ID)
  547.      (mapcar '(lambda (KEY)
  548.             (action_tile KEY "(BUT_MOD_CALLBK $KEY $REASON)")
  549.           )
  550.          '("picks"      "pick_st"     "pick_sh"
  551.            "pick_co"      "pick_cs"     "pbutton1"
  552.            "pbutton2"      "pbutton3"     "pbutton4"
  553.            "pbutton5"      "pbutton6"     "pbutton7"
  554.            "pbutton8"      "pbutton9"     "pbutton10"
  555.            "pbutton11"      "pbutton12"     "pbutton13"
  556.            "pbutton14"      "pbutton15"     "pbutton16"
  557.            "button_num"      "button"     "accept"
  558.            "help"
  559.           )
  560.      )
  561.      (setq BUTTON (list 0 1 (tablet_getbutton 0))) ;default value
  562.      (set_buttons 0 1 nil)
  563.      (start_dialog)
  564.      (unload_dialog DCL_ID)
  565.        )
  566.      )
  567.     )
  568.   )
  569.   (princ)
  570. )
  571.  
  572.  
  573. (defun BUT_MOD_CALLBK ($KEY $REASON)
  574.   (setq ERROR_ST "\nError in BUT_MOD_CALLBK: ")
  575.   (cond
  576.     ((= (substr $KEY 1 4) "pick")
  577.       (set_buttons (cadr (assoc (get_tile "picks") '(("pick_st" 0) ("pick_sh" 16) ("pick_co" 32) ("pick_cs" 48)))) (nth 1 BUTTON) T)
  578.       )
  579.     ((= (substr $KEY 1 7) "pbutton")
  580.       (set_buttons (nth 0 BUTTON) (atoi (substr $KEY 8)) T)     
  581.       )
  582.     ((= $KEY "accept")
  583.       (set_buttons (nth 0 BUTTON) (nth 1 BUTTON) T)     
  584.       (done_dialog)
  585.       )
  586.     ((= $KEY "help")
  587.       (alert "IntelliCAD supports digitizer pucks with up to 16 buttons which may be used \nwith key combinations to provide up to 64 virtual buttons.  These buttons \nare laid out differently on different devices and yours may not match the \nformat shown here.  You may assign command strings to any of these \nbuttons, however  the two designated as Left-Click and Right-Click will \nmaintain their functions.\n\nTo change the command associated with a button, click on that buttons \nnumber.   The contents of that button will show up in the box labeled 'Cell \ncontents'.   You may edit the contents and when you switch focus to a \ndifferent button or select 'Done' the changes you have made will be saved.  \nIMPORTANT: there is no Undo button, so once you make changes they are \nsaved.")
  588.       )    
  589.     )
  590.   )
  591.  
  592. (defun SET_BUTTONS (PICK BUTTON_NUM FLAG)
  593.   (setq ERROR_ST "\nError in SET_BUTTONS: ")  
  594.   (set_tile "button_num" (strcat "Button: " (itoa BUTTON_NUM)))
  595.   (if FLAG;user switched focus
  596.     (if (/= (get_tile "button") (last BUTTON));cell has been modified
  597.       (tablet_setbutton (+ -1 (nth 0 BUTTON) (nth 1 BUTTON)) (get_tile "button"))
  598.       )
  599.     (set_tile "button" (tablet_getbutton (+ -1 PICK BUTTON_NUM)))
  600.     )
  601.   (setq BUTTON (list PICK BUTTON_NUM (tablet_getbutton (+ -1 PICK BUTTON_NUM))))
  602.   (set_tile "button" (last BUTTON))
  603.   )
  604.  
  605. (defun C:BUTM () (C:BUTTON_MODIFY))
  606.  
  607.  ; tablet_export.lsp
  608.  ; Copyright (C) 1998 Visio Corporation.  All Rights Reserved.
  609.  
  610.  ; By Ronald Prepchuk
  611.  
  612.  ;This command will export the current settings of the tablet and button menus to a .lsp file
  613.  ;that can be loaded on a different computer to give it the same menu functionality
  614.  
  615. (defun C:TABLET_EXPORT ()
  616.   (defun *ERROR* (STR)
  617.     (princ ERROR_ST)
  618.     (princ STR)
  619.     (princ "\nAvailable commands are: TABLET_EXPORT or TABE")
  620.     (princ)
  621.   )
  622.   (setq ERROR_ST "\nError in C:TABLET_EXPORT:")
  623.   (setq WRITEF (open "TABLET_SETTINGS.LSP" "w"))
  624.   (setq    COL 1 ROW 1)
  625.   (princ ";Load this file in IntelliCAD 98d or later to set tablet and button menus." WRITEF)
  626.   (repeat 26
  627.     (repeat 26
  628.       (setq CELL (tablet_getgriditem ROW COL))
  629.       (print (list 'tablet_setgriditem ROW COL CELL) WRITEF)
  630.       (setq COL (1+ COL))
  631.     )
  632.     (setq ROW (1+ ROW) COL 1)
  633.   )
  634.   (setq BUTTON_NUM 0)  
  635.   (repeat 64
  636.     (setq CELL (tablet_getbutton BUTTON_NUM))
  637.     (print (list 'tablet_setbutton BUTTON_NUM CELL) WRITEF)
  638.     (setq BUTTON_NUM (1+ BUTTON_NUM))
  639.   )
  640.   (close WRITEF)
  641.   (princ (strcat "\nFile written to " (findfile "TABLET_SETTINGS.LSP")))
  642.   (princ)
  643. )
  644.  
  645. (defun C:TABE () (C:TABLET_EXPORT))
  646.  
  647. (princ "\nAvailable commands are: BUTTON_MODIFY or BUTM")
  648. (princ)
  649.  
  650. (princ "\nAvailable commands are: TABLET_MODIFY or TABM")
  651. (princ)
  652.  
  653. (princ "\nAvailable commands are: TABLET_IMPORT or TABI, CLEARTAB")
  654. (princ)
  655.  
  656. (princ "\nAvailable commands are: TABLET_EXPORT or TABE")
  657. (princ)
  658.