home *** CD-ROM | disk | FTP | other *** search
/ Chip 1997 January / Chip_1997-01_cd.bin / ms95 / disk21 / dir03 / f008890.re_ / f008890.re
Text File  |  1996-04-02  |  11KB  |  311 lines
  1. ; MSMM.UCM -- Build Microstation Matrix Menu.
  2. ;       -- Places IGDS format Matrix Menu range blocks
  3. ;          and command string entries needed for the cell
  4. ;          to be built.
  5.  
  6.      key 'NoEcho'
  7.          set r2=outflg                          ; save outflg
  8.          set outflg=outflg!@2000                ; disable command parser 
  9.                                                 ; mod by e. sutton 06/01/89 
  10.      cmd nulcmd
  11.           msg 'st* Define MicroStation Matrix Menu *'
  12.  
  13. ;        * Save Active parameters and set some of our own *
  14.  
  15.      set A0 = ACTANG            ; Save active angle
  16.      set R1 = ACTLEV            ; Save active level
  17.      set R4 = CAFONT            ; Save active font
  18.      set R9 = IDSYMB            ; Save weight and color
  19.      set R10 = TXJUST            ; Save text justification
  20.      set R11 = TNJUST            ; Save node justification
  21.  
  22.      key 'Active TXJ LC'                    ; Set text justification
  23.      key 'Active TNJ LB'                    ; using uStn syntax.
  24.  
  25.      key 'wt=0'                             ; Set weight, color
  26.      key 'co=3'                             ; and level using
  27.      key 'lv=63'                            ; IGDS syntax.
  28.                         ; Set angle and font
  29.      set ACTANG = 0             ; using ucm syntax for
  30.      set CAFONT = 1             ; tcb entries.
  31.  
  32.      set I0 = NODSPA            ; Save line spacing
  33.      set I9 = CHHGT             ; Save text height
  34.      set I10 = CHWID            ; Save text width
  35.  
  36.      set NODSPA = 500            ; Set LS, TH & TW
  37.      set CHHGT = 1000            ; using ucm syntax for
  38.      set CHWID = 1000            ; tcb entries.
  39.  
  40.      go ERRTN
  41. IVRC:     msg 'st* Invalid Row,Column Specification *' ; Invalid input.
  42. ERRTN:
  43.      msg 'cfEnter No. of Rows,Cols'
  44.      msg 'prReset to Exit'
  45. GETRC:     get K,CKINP, R,EXITUC            ; Get rows & columns.
  46.      go GETRC
  47.  
  48. CKINP:     msg 'st'
  49.      set msg = ' '                          ; Clear msg register.
  50.      set r7 = 1                ; Initialize counters
  51.      set r8 = 1
  52.  
  53. FNDROW:  tst key(R7) eq ',',SAVROW              ; Find no. of rows
  54.      set msg = msg + key(R7)        ; and move digit into
  55.      set R7 = R7 + 1            ; the msg register.
  56.      set R8 = R8 + 1            ; Exit to find col's
  57.      set NUM = NUM - 1            ; when a "," is found.
  58.      tst NUM eq 0,IVRC
  59.      go FNDROW
  60. SAVROW:  tst R8 eq 1,IVRC            ; (r8=1) ? iv entry
  61.      set R5 = msg                ; Save no. of rows in R5
  62.      set msg = ' '                          ; Clear msg register.
  63.      set R8 = 1                ; Reset counter.
  64.      set R7 = R7 + 1            ; Skip the comma.
  65.      set NUM = NUM - 1
  66.  
  67. FNDCOL:  tst num eq 0,SAVCOL            ; (len=0) ? exit loop
  68.      set msg = msg + key(R7)        ; Find no. of col's
  69.      set R7 = R7 + 1            ; and move digit into
  70.      set R8 = R8 + 1            ; the msg register.
  71.      set NUM = NUM - 1
  72.      go FNDCOL
  73. SAVCOL:  tst R8 EQ 1,IVRC            ; (r8=1) ? iv entry
  74.      set R6 = msg                ; Save col's in r6.
  75.      tst R5 le 0,IVRC            ; Brute force check
  76.      tst R6 le 0,IVRC            ; for positive entries.
  77.  
  78. GETMNU:  msg 'cfEnter Menu Lower Left Corner'   ; Get lower left
  79.      msg 'prReset to re-enter Rows & Columns'
  80. GETLL:     get P,SAVLL, K,CKINP, R,ERRTN
  81.      go GETLL
  82.      msg 'st'
  83.      go ERRTN
  84. SAVLL:     set I5 = XUR                ; Save lower left
  85.      set I6 = YUR                ; in (i5,i6).
  86.      msg 'cfEnter Menu Upper Right Corner'  ; Get upper right
  87.      msg 'prReset to Redefine Lower Left Corner'
  88. GETUR:     get P,CKAREA, R,GETMNU
  89.      go GETUR
  90. CKAREA:  set I7 = XUR                ; Save upper right
  91.      set I8 = YUR                ; in (i7,i8)
  92.      set A0 = YUR - I6            ; Delta Y / no. of rows
  93.      set I11 = A0 / R5            ; is the hgth of a row.
  94.      tst I11 lt 1000,IVAREA         ; (row < 1000 uor) ? iv.
  95.      set A0 = XUR - I5            ; Delta X / no. of cols
  96.      set I12 = A0 / R6            ; is the width of a col.
  97.      tst I12 ge 1000,RTPRMT         ; (col < 1000 uor) ? iv.
  98.                         ; i11 = hgth of row
  99. IVAREA:  msg 'st* Illegal Menu Area *'          ; i12 = wdth of col
  100.      go GETMNU
  101.  
  102. RTPRMT:  msg 'cfEnter Receiving Task Name'      ; Usually FB
  103.      msg 'prReset to Redefine Menu Area'
  104. GETRT:     get K,CKRT, R,GETMNU
  105.      go GETRT
  106.  
  107. CKRT:     set ucasc = key            ; Upcase input string
  108.      set N1 = 0
  109.      set R12 = 1
  110. RTLOOP:  tst R12 gt k0,RTDONE
  111.      tst ucbyt(R12) lt 97,RTPASS
  112.      tst ucbyt(R12) gt 122,RTPASS
  113.      set ucbyt(R12) = ucbyt(R12) & 223
  114. RTPASS:  set C1 = C1 + ucasc(R12)
  115.      set R12 = R12 + 1
  116.      go RTLOOP
  117.  
  118. RTDONE:  set key = C1                ; Restore upcase in key.
  119.      tst key eq ' ',TOPBLK                  ; Branch on Name.
  120.      set key = key + '@012MM@012'           ; Else append MM and
  121.      set key = key + R5            ; row,col.
  122.      set key = key + ','
  123.      set key = key + R6
  124.      cmd PText                ; Optionally place the
  125.      key                    ; FB/MM/row/col node.
  126.      msg 'cfEnter Text Node Origin'
  127.      msg 'prReset to Skip Node Placement'
  128.  
  129. PLCNDE:  get P,NDEPNT, R,TOPBLK
  130.      go PLCNDE
  131. NDEPNT:  pnt
  132.      tst RELERR ne 0,PLCNDE
  133.  
  134. TOPBLK:  key 'NoEcho'
  135.      cmd nulcmd
  136.      key 'Set Dynamic Off'                      ; Turn dynamics off
  137.      key 'selv all'                         ; in all views.
  138.      cmd nulcmd
  139.  
  140.          msg 'cfEnter Action Type (P,U,C,S,D,K,T,M,E,R)'
  141.          msg 'prReset to Exit'
  142. GETTYP:  get K,TSTUC, R,EXITUC            ; Get a valid command type
  143.      go GETTYP
  144.  
  145. TSTUC:     msg 'st'
  146.      set ucasc = key            ; Put input into tcb usasc
  147.      tst ucbyt(1) lt 97, noup        ; (97 <= a <= 122) ? upcase(a)
  148.      tst ucbyt(1) gt 122, noup
  149.      set ucbyt(1) = ucbyt(1) & 223
  150. NOUP:     set C0 = ucasc(1) + ','                ; Save Command prefix in C0
  151.      set C2 = C0                ; Copy to C2 for loop compares
  152.  
  153. ;              * Parse command type *
  154.  
  155. ;Z:       tst C0 ne 'Z,',MESG                    ; User defined
  156. ;         set C3 = 'cfEnter Action String'
  157. ;         set C2 = ''
  158. ;         go IDBLK
  159. MESG:    tst C0 ne 'M,',APPL                    ; Get Message
  160.          set C3 = 'cfEnter Message'
  161.          go IDBLK
  162. APPL:    tst C0 ne 'A,',PRIM                    ; Get application
  163.          set C3 = 'cfEnter Application Number'
  164.          go IDBLK
  165. PRIM:     tst C0 ne 'P,',TSTUCM                  ; Primitive
  166.      set C3 = 'cfEnter Command Name'
  167.      go IDBLK
  168. TSTUCM:  tst C0 ne 'U,',RACELL                  ; User Command
  169.      set C3 = 'cfEnter User Command Index Number'
  170.      go IDBLK
  171. RACELL:  tst C0 ne 'R,',CKCELL                  ; Place Cell
  172.          set C3 = 'cfEnter Cell Name'
  173.          go IDBLK
  174. CKCELL:  tst C0 ne 'C,',CKSYMB                  ; Place Cell
  175.      set C3 = 'cfEnter Cell Name'
  176.      go IDBLK
  177. CKSYMB:  tst C0 ne 'S,',TSTTUT                  ; Place Symbol
  178.      set C3 = 'cfEnter Symbol Character'
  179.      go IDBLK
  180. TSTTUT:  tst C0 ne 'D,',TSTSTR                  ; Activate a Tutorial
  181.      set C3 = 'cfEnter Tutorial Name'
  182.      ;set C2 = 'T,AT='
  183.      go IDBLK
  184. TSTSTR:  tst C0 eq 'K,',STRMSG                  ; Text Entry
  185.          tst C0 eq 'E,',STRMSG                  ; Text Entry
  186.      tst C0 ne 'T,',GOIVCM
  187. STRMSG:  set C3 = 'cfEnter Action String'
  188.      go IDBLK
  189.                         ; Invalid command type
  190. GOIVCM:  set n0 = n0 - 1            ; Strip "," from end of C0
  191.      set msg = 'st* Invalid Action Type <' + C0
  192.      set msg = msg + '> *'
  193.      msg msg
  194.      go GETTYP
  195.  
  196. IDBLK:     cmd nulcmd
  197.      msg 'cfIdentify Command Block'
  198.      msg 'prEnter Action Type (P,U,C,S,D,K,T,M,E,R)'
  199. GETBLK:  get P,CKRNGE, K,TSTUC, R,TOPBLK    ; Get block to process.
  200.      go GETBLK
  201. CKRNGE:  msg 'pr'
  202.      msg 'st'                               ; Check to see if point
  203.      tst XUR lt I5,IVPNT            ; is above and to the
  204.      tst YUR ge I6,CKAGN            ; right of our lower left
  205. IVPNT:     msg 'st* Outside Menu Area *'
  206.      go IDBLK
  207. CKAGN:     set I4 = I6
  208.      set R7 = R5 + 1            ; Put low y in i4 and
  209. YLOOP:     set R7 = R7 - 1            ; no. of rows in r7.
  210.      set I4 = I4 + I11            ; Add hgth of row (r11)
  211.      tst I4 le YUR,YLOOP            ; until in the right blk
  212.      tst R7 le 0,IVPNT            ; and subtr the hgth to
  213.      set I2 = I4 - I11            ; get the lower y value.
  214.      set I3 = I5
  215.      set R8 = 0                ; Put low x in i3 and
  216. XLOOP:     set R8 = R8 + 1            ; set r8 (n_rows) to 0.
  217.      set I3 = I3 + I12            ; Add width of row (r12)
  218.      tst I3 le XUR,XLOOP            ; until in the right blk
  219.      tst R8 gt R6,IVPNT            ; and subtr the width to
  220.      set I1 = I3 - I12            ; get the lower x value.
  221.  
  222.      cmd pptlst                ; Identify the found
  223.      pnt I1,I2                ; command block by
  224.      pnt I1,I4                ; placing a temporary
  225.      pnt I3,I4                ; line string around it.
  226.      pnt I3,I2
  227.      pnt I1,I2
  228.  
  229.      set C4 = R7 + ','                      ; concat "row,col,"
  230.      set C4 = C4 + R8            ; into c4
  231.      set C4 = C4 + ','
  232.      msg c3                 ; Send approporiammte msg for
  233. GETSTR:  get K,B4LOOP, R,IDBLK            ; command string input
  234.      go GETSTR
  235.  
  236. B4LOOP:
  237.          tst C0 eq 'Z,',GOTU                    ; If User Defined String
  238.          set ucasc = key                        ; Upcase input string
  239.      set N5 = 0
  240.      set R7 = 1
  241. LOOP:     tst R7 gt K0,CKNDXD
  242.      tst ucbyt(R7) lt 97,PASS
  243.      tst ucbyt(R7) gt 122,PASS
  244.      set ucbyt(R7) = ucbyt(R7) & 223
  245. PASS:     set C5 = C5 + ucasc(R7)        ; save string in c5
  246.      set R7 = R7 + 1
  247.      go LOOP
  248.  
  249. GOTU:    set    C5=key
  250.  
  251. CKNDXD:  tst C0 ne 'U,',NOTUCM                  ; If User Command
  252.      tst N5 lt 4,TSTNDX            ;
  253. NOTNDX:  set C4 = C4 + 'T,UC='                  ;
  254.      go PLCTXT                ;
  255. TSTNDX:  set ucasc = C5             ; Ck c5 for proper form
  256.      set R12 = 1                ; to be used as an
  257. NDLOOP:  tst R12 gt N5,NDXDNE            ; entry in the uc index.
  258.      tst ucbyt(R12) lt 48,NOTNDX        ; If indexed uc then set
  259.      tst ucbyt(R12) gt 57,NOTNDX        ; the cmd string to "U,"
  260.      set R12 = R12 + 1            ; else leave as terminated
  261.      go NDLOOP                ; "UC=" cmd string.
  262. NDXDNE:  set C4 = C4 + 'U,'                     ;
  263.      go PLCTXT                ;
  264.  
  265. NOTUCM:  set C4 = C4 + C2            ; Concat command type to c4.
  266. PLCTXT:  set msg = C4 + C5            ; Concat cmd entry & type to msg
  267.      set CUREBL = DFSECT            ; Save pointers.
  268.      set CUREBY = DFBYTE
  269.      set A8 = I4 + I2            ; Save the mid-y coordinate
  270.      set I13 = A8 / 2            ; of the block in I13
  271.      key 'Place Text Fitted'                ; and place the text
  272.      key msg
  273.      pnt I1,I13
  274.      pnt I3,I13
  275.      tst RELERR ne 0,EXITUC
  276.      key 'NoEcho'
  277.      cmd nulcmd
  278.      set RANGEE(1) = I1            ; Adjust the range to
  279.      set RANGEE(2) = I2            ; match that of the box
  280.      set RANGEE(4) = I3
  281.      set RANGEE(5) = I4
  282.      wrt CUREBL,CUREBY            ; Rewrite the element
  283.      go IDBLK                ; Get additional blocks
  284.                         ; of this type
  285.  
  286. ;                * Cleanup and exit *
  287.  
  288. EXITUC:                     ; Restore saved parameters
  289.          set outflg = r2                        ; restore outflg
  290.      set ACTANG = A0            ; Restore active angle
  291.      set NODSPA = I0            ; Restore line spacing
  292.      set CHHGT = I9             ; Restore text height
  293.      set CHWID = I10            ; Restore text width
  294.      set ACTLEV = R1            ; Restore active level
  295.      set CAFONT = R4            ; Restore active font
  296.      set IDSYMB = R9            ; Restore weight and color
  297.      set TXJUST = R10            ; Restore text justification
  298.      set TNJUST = R11            ; Restore node justification
  299.  
  300.      key 'Set Dynamic On'                       ; Turn dynamics on
  301.      key 'selv all'                         ; in all views.
  302.      cmd nulcmd                ; Clear any active command
  303.      key 'echo'                             ; as well as all prompt
  304.      msg 'cf'                               ; fields in order to
  305.      msg 'ms'                               ; leave the user command
  306.      msg 'pr'                               ; in a known state and
  307.      msg 'er'                               ; an orderly fashion.
  308.  
  309.      msg 'st* MicroStation Matrix Menu UC Exited *'
  310.      End
  311.