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 / TBWRTF.CDL < prev    next >
Encoding:
Text File  |  1989-06-21  |  1.4 KB  |  73 lines
  1. REM ************************************************************************
  2. REM       Text template maker --- subroutine (tbwrtf.cdl)
  3.  
  4. REM    Purpose:  To write a single field of text onto the part
  5. REM ************************************************************************
  6.  
  7.  
  8.    tbdisp_ent = 0
  9.  
  10. :ind_screen
  11.    DOSUB tbdisp2
  12.    IF (retrn == 0)
  13.       GOTO redrw
  14.    GOTO set_devin
  15.  
  16. :redrw
  17.    REDRAW
  18.    GOTO exit
  19.  
  20. :set_devin
  21.    SET devin, $tplname
  22.  
  23. :read_fld
  24.    INPUT "%d %s %d",sqnum,$tmp,nchar
  25.  
  26.    CLEAR    $fldtxt
  27.    ARRAY    $fldtxt[nchar+1]
  28.  
  29. REM   *** dummy read two characters
  30.    INPUT "%c %c",$fldtxt[0],$fldtxt[1]
  31.  
  32.    i = 0
  33. :txtloop
  34.    INPUT "%c",$fldtxt[i]
  35.    IF ($fldtxt[i] == 34)
  36.       GOTO read_more
  37.    i = i + 1
  38.    goto txtloop
  39.  
  40. :read_more
  41.    $fldtxt[i] = 0
  42.    INPUT "%f %f %f %f %f %d %d\n",dx,dy,fldlngth,txtht,asprat,font,pen
  43.  
  44.    IF (sqnum == pnum)
  45.       GOTO get_fldtxt
  46.    IF (sqnum != 10000)
  47.       GOTO read_fld
  48.    GOTO ind_screen
  49.  
  50. :get_fldtxt
  51.    GETSTR "Enter new text (%s):",$fldtxt,$fldtxt
  52.    ON (@KEY + 3) GOTO exit,ind_screen,
  53.    CALL strlen, $fldtxt, lngth
  54.    IF (lngth > nchar)
  55.       GOTO message1
  56.  
  57.    txtx = bpx + dx
  58.    txty = bpy + dy
  59.    TEXT txtx,txty,$fldtxt,0,txtht,asprat,0,0,0,font,0,0,pen
  60.    CLOSE devin
  61.    tbdisp_ent = 1
  62.    GOTO ind_screen
  63.  
  64. :message1
  65.    PROMPT "Too many characters for this field, try again..."
  66.    WAIT 2
  67.    $fldtxt = " "
  68.    GOTO get_fldtxt
  69.  
  70. :exit
  71.    EXIT
  72.  
  73.