home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / cpmug / cpmug080.ark / CONV-BAS.STB < prev    next >
Encoding:
Text File  |  1984-04-29  |  5.8 KB  |  201 lines
  1.  
  2.    30   Gosub Screen'erase
  3.    40   @"Basic File Converter"
  4.    50   @"By David E. Trachtenbarg"
  5.    60   @"Copyright 1981"
  6.    70   Integer I,J,K,L,L1,L2,L'length
  7.    80   Long Line'no,Number
  8.    90   L'length=132
  9.   100   Dim Input'file$(13),Output'file$(13),Tab$(0),Weird$(1),String$(50)
  10.   110   Dim New'line$(L'length),Old'line$(L'length),Temp'line$(L'length)
  11.   120   Weird$=" ;" : Weird$(0,0)=""""
  12.   130   Tab$=Chr$(9)
  13.   140   Set 0,-1
  14.   150   Set 3,0
  15.   155   Line'no=0
  16.   160   Call .Enter'file (Input'file$)
  17.   170   Call .New'file (Output'file$)
  18.   180   Create Output'file$
  19.   190   Open\1\Input'file$
  20.   200   Open\2\Output'file$
  21.   210   Print\2\""
  22.   220   Noesc
  23.   230     Repeat
  24.   240     Gosub Get'line
  25.   250     Gosub Convert'line
  26.   260     Gosub Put'line
  27.   270     If New'line$<>"" Then @ New'line$
  28.   280     Until Sys(3)>0
  29.   290   Close
  30.   300   @ : @"Done!!!!"
  31.   310   Esc
  32.   315   Goto 150
  33.   320   End
  34.   330 *Screen'erase
  35.   340   Out 1,126 : Out 1,28 : Return
  36.   350 Procedure .Enter'file (Text'file$)
  37.   360     Repeat
  38.   370     Set 3,0
  39.   380     Input"Enter the name of the input file. ",Text'file$
  40.   390     On Error Goto 420
  41.   400     Open\1\Text'file$
  42.   410     Close\1\
  43.   420     On Error Stop
  44.   430     If Sys(3)>0 Then  Do
  45.   440       @ : @"Error ";Sys(3);" has occured."
  46.   450       If Sys(3)=128 Or Sys(3)=134 Then @"File does not exist on disk."
  47.   460       If Sys(3)=129 Then @"Please enter a filename."
  48.   470       If Sys(3)=131 Then Close\1\ : @"File not ready.  Please try again."
  49.   480       Enddo
  50.   490     Until Sys(3)=0
  51.   500   Endproc 
  52.   510 Procedure .New'file (Text'file$)
  53.   520   Set 3,0
  54.   530     Repeat
  55.   540     Input"Enter the name of a NEW file. ",Text'file$
  56.   550     On Error Goto 590
  57.   560     Open\1\Text'file$
  58.   570     Close\1\
  59.   580     @"File already exists.  Please enter a NEW filename."
  60.   590     On Error Stop
  61.   600     Until Sys(3)>0
  62.   610   Endproc 
  63.   620 *Get'line
  64.   630   On Error Goto 660
  65.   640   Input\1\Old'line$(-1)
  66.   650   On Error Stop
  67.   660   Return
  68.   670 *Put'line
  69.   680   If New'line$="" Then Return
  70.   690   Print\2\New'line$
  71.   700   Return
  72.   710 *Convert'line
  73.   720   New'line$(-1)=""
  74.   730   If Len(Old'line$)=0 Then Return
  75.   740   Number=Val(Old'line$)
  76.   750   If Number=0 Then  Do
  77.   760     Line'no=Line'no+1
  78.   770     New'line$=Str$(Line'no)+Old'line$
  79.   780     Else
  80.   790     If Number<Line'no Then Call .Errors (2)
  81.   800     Line'no=Number
  82.   810     New'line$=Old'line$
  83.   820     Enddo
  84.   830   Gosub Changes
  85.   840   Return
  86.   850 *Changes
  87.   860   Gosub Delete'tabs
  88.   870   Gosub Change'rnd
  89.   880   Gosub Change'go'to
  90.   900   Gosub Change'left
  91.   910   Gosub Fix'input
  92.   920   Gosub Truncate'remarks
  93.   930   Gosub Variable'fix
  94.   940   Gosub Combine'lines
  95.   950   Return
  96.   960 *Delete'tabs
  97.   965   Local I
  98.   970     Repeat
  99.   980     I=Pos(New'line$,Tab$,0)
  100.   990     If I>-1 Then New'line$(I,I)=" "
  101.  1000     Until I=-1
  102.  1010   Return
  103.  1020 *Change'rnd
  104.  1025   Local I
  105.  1030     Repeat
  106.  1040     I=Pos(New'line$,"RND",0)
  107.  1050     If I>-1 Then  Do
  108.  1060       Expand New'line$(I),3
  109.  1070       New'line$(I,I+5)="Rnd(0)"
  110.  1080       Enddo
  111.  1090     Until I=-1
  112.  1100   Return
  113.  1110 *Change'go'to
  114.  1115   Local I
  115.  1120     Repeat
  116.  1130     I=Pos(New'line$,"GO TO",0)
  117.  1140     If I>-1 Then New'line$(I,I+4)="Goto "
  118.  1150     Until I=-1
  119.  1160   Return
  120.  1170 *Change'left
  121.  1175   Local I,J,L
  122.  1190   I=Pos(New'line$,"LEFT$(",0)
  123.  1200   If I>-1 Then  Do
  124.  1210     J=Pos(New'line$,"$",I+5)
  125.  1230     L=Pos(New'line$,")",0)
  126.  1240     String$(-1)=New'line$(I+6,J)+"(0,"+New'line$(J+2,L-1)+"-1)"
  127.  1250     New'line$(I,L)=String$(-1)
  128.  1260     Gosub Change'to'zero
  129.  1270     Enddo
  130.  1300   Return
  131.  1470 *Fix'input
  132.  1475   Local I
  133.  1480   If Pos(New'line$,"INPUT",0)>-1 Then  Do
  134.  1490       Repeat
  135.  1500       I=Pos(New'line$,Weird$,0)
  136.  1510       If I>-1 Then  Do
  137.  1520         Expand New'line$(I),1
  138.  1530         New'line$(I,I+2)=" "","
  139.  1540         Enddo
  140.  1550       Until I=-1
  141.  1560     Enddo
  142.  1570   Return
  143.  1580 *Truncate'remarks
  144.  1585   Local I
  145.  1590   I=Pos(New'line$,"REMARK",0)
  146.  1600   If I>-1 Then New'line$(I,I+5)="REM   "
  147.  1610   Return
  148.  1620 *Combine'lines
  149.  1625   Local I,J
  150.  1640   I=Pos(New'line$,"\",0)
  151.  1650   J=Len(New'line$)
  152.  1660   If I>-1 And I>(J-2) Then  Do
  153.  1690     New'line$(I,I)=":"
  154.  1710     Gosub Get'line
  155.  1720     Temp'line$=New'line$
  156.  1730     New'line$=Temp'line$+Old'line$
  157.  1740     I=Pos(New'line$,"::",0)
  158.  1750     If I>-1 Then New'line$(I,I+1)=": "
  159.  1760     Gosub Changes
  160.  1790     Enddo
  161.  1800   Return
  162.  1810 *Variable'fix
  163.  1815   Local I,J
  164.  1820   J=0
  165.  1830     Repeat
  166.  1840     I=Pos(New'line$,".",J)
  167.  1850     If I>-1 Then  Do
  168.  1860       J=I+1
  169.  1870       If New'line$(I-1,I-1)>="A" And New'line$(I-1,I-1)<="Z" Then  Do
  170.  1880         If New'line$(I+1,I+1)>="0" And New'line$(I+1,I+1)<="Z" Then  Do
  171.  1890           New'line$(I,I)="'"
  172.  1900           Enddo
  173.  1910         Enddo
  174.  1920       Enddo
  175.  1930     Until I=-1
  176.  1940   Return
  177.  1950 *Change'to'zero
  178.  1960   Local I
  179.  1985   I=Pos(New'line$,"1-1",0)
  180.  1986   If I>-1 Then New'line$(I,I+2)=" 0 "
  181.  1990   Return
  182.  2240 Procedure .Errors (Err)
  183.  2250   @ : @"*******" : @
  184.  2280   Esc
  185.  2290   Close
  186.  2300   Erase Output'file$
  187.  2310   I=Pos(Input'file$,".",0)
  188.  2320   Output'file$=Input'file$
  189.  2330   Input'file$(I+1)="BD"
  190.  2340   Rename Output'file$,Input'file$
  191.  2350   @"There is an error in the program."
  192.  2360   If Err=1 Then @"Unmatched parentheses"
  193.  2370   If Err=2 Then @"Non consecutive line numbers"
  194.  2380   @ : @"Original line:"
  195.  2390   @ Old'line$
  196.  2400   @"Changed line:"
  197.  2410   @ : @ New'line$
  198.  2420   Stop
  199.  2430   Endproc 
  200.