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