home *** CD-ROM | disk | FTP | other *** search
/ Piper's Pit BBS/FTP: ibm 0010 - 0019 / ibm0010-0019 / ibm0010.tar / ibm0010 / CADKEY_C.ZIP / CADKEY14.ZIP / CDL / TBDISP2.CDL < prev    next >
Encoding:
Text File  |  1989-06-21  |  2.9 KB  |  148 lines
  1. REM ************************************************************************
  2. REM       Text template maker --- subroutine (tbdisp2.cdl)
  3.  
  4. REM    Purpose:  Draws a selection box on the screen to allow the user
  5. REM          to indicate field to write onto the part
  6. REM ************************************************************************
  7.  
  8.  
  9.    IF (tbdisp_ent == 1)
  10.       GOTO get_fld
  11.    retrn = 1
  12.    SET devin, $tplname
  13.  
  14.    count = 0
  15. :read_fld
  16.    count = count + 1
  17.    INPUT "%d %s %d",sqnum,$tmp,nchar
  18.    CLEAR    $fldtxt
  19.    ARRAY    $fldtxt[nchar+1]
  20.  
  21. REM   *** dummy read two characters
  22.    INPUT "%c %c",$fldtxt[0],$fldtxt[1]
  23.  
  24.    i = 0
  25. :txtloop
  26.    INPUT "%c",$fldtxt[i]
  27.    IF ($fldtxt[i] == 34)
  28.       GOTO read_more
  29.    i = i + 1
  30.    goto txtloop
  31.  
  32. :read_more
  33.    $fldtxt[i] = 0
  34.    INPUT "%f %f %f %f %f %d %d\n",dx,dy,fldlngth,txtht,asprat,font,pen
  35.  
  36.    IF (sqnum != 10000)
  37.       GOTO read_fld
  38.    GOTO close_fl
  39.  
  40. :close_fl
  41.    CLOSE devin
  42.    nlines = count - 1
  43.  
  44. :create_boxes
  45.    sdx = (@xmax - @xmin)/40
  46.    sdy = (@ymax - @ymin)/30
  47.    minx = @xmin + sdx
  48.    maxx = @xmax - sdx
  49.    miny = @ymin + sdy
  50.    maxy = @ymax - sdy
  51.    tcols = 7
  52.    trows = 13
  53.    xinc = (maxx - minx) / tcols
  54.    yinc = (maxy - miny) / trows
  55.    nrows = ceil(nlines / tcols)
  56.  
  57.    MODE draw
  58.    i = 0
  59. :hlines
  60.    VLINE minx, maxy - i*yinc, 0, maxx, maxy - i*yinc, 0, 0, 3
  61.    i = i + 1
  62.    IF (i == nrows + 1)
  63.       GOTO st_vlines
  64.    GOTO hlines
  65.  
  66. :st_vlines
  67.    i = 0
  68. :vlines
  69.    VLINE minx + i*xinc, maxy, 0, minx + i*xinc, maxy - nrows*yinc, 0, 0, 3
  70.    i = i + 1
  71.    IF (i == tcols + 1)
  72.       GOTO read_names
  73.    GOTO vlines
  74.  
  75. :read_names
  76.    SET devin, $tplname
  77.  
  78.    k = 0   
  79. :read_loop1
  80.    j = 0   
  81.    k = k + 1
  82. :read_loop2
  83.    INPUT "%d %s %d",sqnum,$tmp,nchar
  84.    CLEAR    $fldtxt
  85.    ARRAY    $fldtxt[nchar+1]
  86.  
  87. REM   *** dummy read two characters
  88.    INPUT "%c %c",$fldtxt[0],$fldtxt[1]
  89.  
  90.    i = 0
  91. :txtloop1
  92.    INPUT "%c",$fldtxt[i]
  93.    IF ($fldtxt[i] == 34)
  94.       GOTO read1_more
  95.    i = i + 1
  96.    goto txtloop1
  97.  
  98. :read1_more
  99.    $fldtxt[i] = 0
  100.    INPUT "%f %f %f %f %f %d %d\n",dx,dy,fldlngth,txtht,asprat,font,pen
  101.  
  102.    IF (sqnum != 10000)
  103.       GOTO st_write
  104.    GOTO close1_fl
  105.  
  106. :st_write
  107.    sdx = yinc/3
  108.    sdy = yinc/4
  109.    stx = minx + j*xinc + sdx
  110.    sty = maxy - k*yinc + sdy
  111.    TEXT stx, sty, $tmp, 0, yinc/2, 0.5, 0, 3
  112.    j = j + 1
  113.    IF (j == tcols)
  114.       GOTO read_loop1
  115.    GOTO read_loop2
  116.  
  117. :close1_fl
  118.    CLOSE devin
  119.  
  120. :get_fld
  121.    opt = 1
  122.    GETPOS "Cursor-indicate field", opt
  123.    IF (@KEY <= -2)
  124.       GOTO return
  125.    IF (@KEY != 1)
  126.       GOTO get_fld
  127.    pdx = @xview - minx
  128.    pdy = maxy - @yview
  129.    col = floor (pdx / xinc) + 1
  130.    row = floor (pdy / yinc) + 1
  131.    pnum = tcols*(row - 1) + col
  132.    IF (pnum > nlines)
  133.       GOTO message1
  134.    GOTO exit
  135.  
  136. :message1
  137.    PROMPT "Field selection error... try again"
  138.    WAIT 2
  139.    GOTO get_fld
  140.  
  141. :return
  142.    retrn = 0
  143.  
  144. :exit
  145.    MODE normal
  146.    EXIT
  147.  
  148.