home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / acad / autolisp / ansimenu / menu.lsp
Encoding:
Text File  |  1989-09-24  |  6.2 KB  |  166 lines
  1. ;;; -*-  Mode: LISP -*- Syntax: AutoLISP (C) Benjamin Olasov 1988, 1989
  2.  
  3. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  4. ;;; File: MENU.LSP Copyright (C) Benjamin Olasov    Graphic Systems, Inc.   ;;;
  5. ;;; Inquiries:                                                              ;;;
  6. ;;;                                                                         ;;;
  7. ;;;     Benjamin Olasov                                                     ;;;
  8. ;;;     Graphic Systems, Inc.:                                              ;;;
  9. ;;;                                                                         ;;;
  10. ;;;                    New York, NY:   PH (212) 725-4617                    ;;;
  11. ;;;                    Cambridge, MA:  PH (617) 492-1148                    ;;;
  12. ;;;                    MCI-Mail:       GSI-NY   344-4003                    ;;;
  13. ;;;                    Arpanet:        olasov@cs.columbia.edu               ;;;
  14. ;;;                                                                         ;;;
  15. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  16.  
  17. ;; This program is provided 'as is' without warranty of any kind, either 
  18. ;; expressed or implied, including, but not limited to the implied warranties of
  19. ;; merchantability and fitness for a particular purpose.  The entire risk as to
  20. ;; the quality and performance of the program is with the user.  Should the 
  21. ;; program prove defective, the user assumes the entire cost of all necessary 
  22. ;; servicing, repair or correction. 
  23. ;; AutoLisp and AutoCad are registered trademarks of AutoDesk, Inc.
  24.  
  25.  
  26. ;; This function creates menus in text screen mode for AutoLISP.
  27. ;; It assumes an 80 column textscreen monitor and ANSI.SYS graphics device
  28. ;; MENU-OPERATION looks for and returns an integer.
  29.  
  30. ;; In this version, the header, prompt and individual items in the item-list
  31. ;; MUST all be strings, that is, surrounded by double quotes. ex.: "STRING"
  32. ;; The syntax is: 
  33. ;;
  34. ;; (menu-operation "header" '("item-1" "item-2" ... "item-n") "prompt")
  35.  
  36. (TEXTSCR)
  37.  
  38. (VMON)
  39.  
  40. (GC)
  41.  
  42. (EXPAND 3)
  43.  
  44. (princ "\nPlease wait- loading")
  45.  
  46. (DEFUN MENU-OPERATION (HEADER ITEM-LIST PROMPT / HEIGHT WIDTH COUNTER L-COL)
  47.        (TEXTSCR)
  48.        (PRINC "\e[2J")
  49.        (IF (/= (REM (STRLEN HEADER) 2) 0) (SETQ HEADER (STRCAT HEADER " ")))
  50.        (SETQ HEIGHT (+ 9 (LENGTH ITEM-LIST))
  51.              WIDTH (+ 10 (MAX (LONGEST ITEM-LIST) (STRLEN HEADER))))
  52.        (IF (/= (REM HEIGHT 2) 0) (SETQ HEIGHT (1+ HEIGHT)))
  53.        (IF (/= (REM WIDTH 2) 0) (SETQ WIDTH (1+ WIDTH)))
  54.        (SETQ L-COL (- 40 (/ WIDTH 2))
  55.              COUNTER 0)
  56.        (REPEAT (- 12 (/ HEIGHT 2)) (TERPRI))
  57.        (REPEAT L-COL (PRINC " "))
  58.        (PRINC (CHR 201))
  59.        (REPEAT (- WIDTH 2) (PRINC (CHR 205)))
  60.        (PRINC (CHR 187)) (TERPRI)
  61.        (BLANK L-COL WIDTH)
  62.        (REPEAT L-COL (PRINC " "))
  63.        (PRINC (CHR 186))
  64.        (REPEAT (- (- (/ WIDTH 2) (/ (STRLEN HEADER) 2)) 1) (PRINC " "))
  65.        (BOLD)
  66.        (PRINC HEADER)
  67.        (NORMAL)
  68.        (REPEAT (- (- (/ WIDTH 2) (/ (STRLEN HEADER) 2)) 1) (PRINC " "))
  69.        (PRINC (CHR 186)) (TERPRI)
  70.        (BLANK L-COL WIDTH)
  71.        (REPEAT L-COL (PRINC " "))
  72.        (PRINC (CHR 204))
  73.        (REPEAT (- WIDTH 2) (PRINC (CHR 205)))
  74.        (PRINC (CHR 185)) (TERPRI)
  75.        (REPEAT L-COL (PRINC " "))
  76.        (PRINC (CHR 186))
  77.        (REPEAT (- WIDTH 2) (PRINC " "))
  78.        (PRINC (CHR 186))
  79.        (FOREACH ITEM ITEM-LIST
  80.                 (SETQ COUNTER (1+ COUNTER))
  81.                 (TERPRI)
  82.                 (REPEAT L-COL (PRINC " "))
  83.                 (PRINC (STRCAT (CHR 186) "  " (RTOS (FLOAT COUNTER) 2 0) "] " ITEM))
  84.                 (REPEAT (- WIDTH (+ 6 (STRLEN (RTOS (FLOAT COUNTER) 2 0))
  85.                              (STRLEN ITEM)))
  86.                              (PRINC " "))
  87.                 (PRINC (CHR 186)))
  88.        (TERPRI)
  89.        (BLANK L-COL WIDTH)
  90.        (REPEAT L-COL (PRINC " "))
  91.        (PRINC (CHR 200))
  92.        (REPEAT (- WIDTH 2) (PRINC (CHR 205)))
  93.        (PRINC (CHR 188))
  94.        (BOLD)
  95.        (PRINC (STRCAT "\n\n" PROMPT))
  96.        (NORMAL)
  97.        (SETQ CHOICE (GETINT))
  98.        (WHILE (OR (< CHOICE 1) (> CHOICE (LENGTH ITEM-LIST)))
  99.               (SETQ CHOICE (GETINT "Choice is out of range, try again: ")))
  100.        (PRINC "\e[2J") CHOICE)
  101.  
  102. (princ ".")
  103.  
  104. ;;length of longest string in a list of strings
  105. (DEFUN LONGEST (LST)
  106.        (APPLY 'MAX (MAPCAR '(LAMBDA (ITM) (STRLEN ITM)) LST)))
  107.  
  108. (princ ".")
  109.  
  110. (DEFUN BLANK (COL WIDTH)
  111.        (REPEAT COL (PRINC " "))
  112.        (PRINC (CHR 186))
  113.        (REPEAT (- WIDTH 2) (PRINC " "))
  114.        (PRINC (CHR 186))
  115.        (TERPRI))
  116.  
  117. (princ ".")
  118.  
  119. (DEFUN BOLD ()
  120.        (PRINC "\e[1m"))
  121.  
  122. (princ ".")
  123.  
  124. (DEFUN NORMAL ()
  125.        (PRINC "\e[0m"))
  126.  
  127. (princ ".")
  128.  
  129. ;; This an an example of using MENU-OPERATION to get a value from the user.
  130. ;; The first argument must be the header.
  131. ;; The second argument must be a list of things to be chosen from.
  132. ;; The third argument must be a prompt [question] to the user.
  133. ;; MENU-OPERATION looks for and returns an integer.
  134.  
  135. (defun c:test ()
  136.        (setq woodtype 
  137.           (menu-operation "WOOD MENU"
  138.                '("Cedar, western red"
  139.                  "Cedar, northern or southern white"
  140.                  "Cypress, southern"
  141.                  "Douglas fir, western"
  142.                  "Douglas fir, Rocky mountain region"
  143.                  "Fir, balsam"
  144.                  "Fir, golden"
  145.                  "Hemlock, eastern"
  146.                  "Larch, western"
  147.                  "Oak, commerical white or red"
  148.                  "Pine, southern yellow"
  149.                  "Pine, California, midwestern, or northern"
  150.                  "Redwood"
  151.                  "Spruce, Engelemann"
  152.                  "Tamarack, eastern")
  153.                  "Select number corresponding to type of wood to be used: ")))
  154.  
  155.  
  156. (princ "\e[2J")
  157. (princ "\nThis menu system is written for the ANSI graphics standard.")
  158. (princ "\nIf your screen didn't just clear, you must add the line:")
  159. (princ "\n\nDEVICE=ANSI.SYS\n")
  160. (princ "\nto your CONFIG.SYS file in order to use MENU-OPERATION.")
  161. (princ "\n\nThe syntax is: ")
  162. (princ "\n\n\(menu-operation \"header\" '(\"item-1\" \"item-2\" ... \"item-n\") \"prompt\"\)")
  163. (princ "\n\nType TEST to try a sample menu.")
  164. (princ)
  165.  
  166.