home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / CLRUN.ZIP / CLRUN.PRG < prev    next >
Encoding:
Text File  |  1987-01-20  |  3.3 KB  |  139 lines
  1. CLS(99,99,24,79)
  2. SET TALK OFF
  3. SET SCOR OFF
  4. SET STAT OFF
  5. IF ISCO()
  6.    norm='gr/n,w+/rb,,,r+/b'
  7. ELSE
  8.    norm='gr/n,i,,,gr+'
  9. ENDI
  10. SET COLO TO &norm
  11. @1,0 TO 3,79
  12. @2,1  SAY '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<'
  13. DO top WITH 'Clipper Developement Program   Ver 1.0  j&b'
  14. IF FILE('clrun.mem')
  15.    REST FROM clrun ADDI
  16. ELSE
  17.    sysname='PROGRAM '
  18.    DO prompt WITH 'Enter the System Name (Main program name)',sysname,'C'
  19.    sysdate='         '
  20.    sysname=TRIM(sysname)
  21.    SAVE TO clrun
  22. ENDI
  23. CLS(4,99,24,79)
  24. SET COLO TO r*/gr*
  25. @24,0 SAY '                           WAIT  --> Finding Files <--                       '
  26. SET COLO TO &norm
  27. CALL cursoff
  28. RUN dir *.prg >clrun1.$$$
  29. IF FILE('clrun.dbf')
  30.    USE clrun
  31.    ZAP
  32. ELSE
  33.    CREA clrun2
  34.    APPE BLAN
  35.    REPL field_name WITH 'FILE',field_type WITH 'C',field_len WITH 45,field_dec WITH 0
  36.    USE
  37.    CREA clrun FROM clrun2
  38.    ERAS clrun2.dbf
  39. ENDI
  40. APPE FROM clrun1.$$$ SDF
  41. ERAS clrun1.$$$
  42. GO 5
  43. DO wait WITH 'Compiling'
  44. @7,0 SAY 'Compiling to object code:  '+LEFT(sysname,8)+' program file ->'
  45. SET COLO TO g+
  46. DO WHIL !EOF()
  47.    IF SUBS(file,30,2)+SUBS(file,24,5)+SUBS(file,39,1)+SUBS(file,34,5)>sysdate.AND.!'bytes free'$file
  48.       CLS(8,99,12,40)
  49.       @7,54 SAY LEFT(file,8)
  50.       @8,0
  51.       f='d:clipper '+LEFT(file,8)+' -m >junk'
  52.       RUN &f
  53.    ENDI
  54.    SKIP
  55. ENDD
  56. CLS(7,99,24,79)
  57. DO top WITH 'Clipper Developement System terminated normally'
  58. @10,40-(40+LEN(sysname))/2 SAY sysname+' compilation complete.  Have a nice day.'
  59. ERAS junk
  60. d=DTOC(DATE())
  61. d=SUBS(d,7,2)+SUBS(d,1,2)+'-'+SUBS(d,4,2)
  62. IF SUBS(d,3,1)='0'
  63.    d=STUF(d,3,1,' ')
  64. ENDI
  65. t=AMPM(TIME())
  66. t=SUBS(t,10,1)+SUBS(t,1,5)
  67. IF SUBS(t,2,1)='0'
  68.    t=STUF(t,2,1,' ')
  69. ENDI
  70. sysdate=d+t
  71. SAVE TO clrun ALL LIKE sys*
  72. CALL curson
  73. QUIT
  74.  
  75. FUNCTION cls
  76.    PARA frow,fcol,lrow,lcol
  77.    CALL scroll WITH 'C'+CHR(frow)+CHR(fcol)+CHR(lrow)+CHR(lcol)+CHR(7)
  78. RETURN 0
  79. PROC top
  80.    PARA mess
  81.    SET COLO TO W+
  82.    @2,(79-LEN(mess))/2 SAY ' '+mess+' '
  83.    SET COLO TO &norm
  84.    @4,0 SAY ''
  85. RETU
  86. PROC prompt
  87.    PARA mess,var,type
  88.    PUBL k
  89.    r=(79-LEN(mess))/2
  90.    q=LEN(var)
  91.    s=(79-q)/2
  92.    t=MIN(r,s)
  93.    CLS(4,99,7,79)
  94.    @4,t-2 TO 7,80-t DOUB
  95.    @5,r SAY mess
  96.    DO CASE
  97.       CASE type='N'
  98.          var=VAL(var)
  99.          @6,s GET var PICT '@k'
  100.       CASE type='D'
  101.          var=CTOD(var)
  102.          @6,s GET var PICT '@k'
  103.       OTHE
  104.          pic=IIF(ASC(type)<91,'@k'+REPL('!',50),'@k')
  105.          @6,s GET var PICT pic
  106.    ENDC
  107.    r=0
  108.    CALL curson
  109.    READ
  110.    CALL cursoff
  111.    r=IIF(r=0,LASTKEY(),r)
  112.    k=IIF(r=18,.f.,.t.)
  113. RETU
  114. FUNCTION LEFT
  115.    PARAMETERS cl_string, cl_len
  116. RETURN SUBSTR(cl_string, 1, cl_len)
  117. FUNCTION STUF
  118.    PARAMETERS cl_string, cl_start, cl_len, cl_replace
  119. RETURN SUBSTR(cl_string,1,cl_start-1) + cl_replace +SUBSTR(cl_string,cl_start+cl_len)
  120. FUNCTION AMPM
  121. PARAMETERS cl_time
  122. RETURN IF(        VAL(cl_time)<12, cl_time + " am",;
  123.            IF(    VAL(cl_time)=12, cl_time + " pm",;
  124.               STR(VAL(cl_time)-12,2) + SUBSTR(cl_time,3) + " pm" ) )
  125. PROC wait
  126.    PARA r1
  127.    r2='WAIT  '+r1
  128.    l1=LEN(r2)
  129.    r1=SPAC(80)
  130.    r1=STUF(r1,(40-l1/2),l1,r2)
  131.    IF ISCO()
  132.       SET COLO TO r*/gr*
  133.    ELSE
  134.       SET COLO TO i*
  135.    ENDI
  136.    @24,0 SAY LEFT(r1,80)
  137.    SET COLO TO &norm
  138. RETU
  139.