Program BasPas
uses
sysutils,dos

TYPE
asel    = String[100]
lbn     = String[160]
libisin     = ARRAY[0..2500] of Byte

FDATAB = RECORD
data : String[200]
next : Byte
end
FHEAD = RECORD
name 	: String[50]
exch    : String[50]
wo	: Integer
end

VAR

libdata		: ARRAY[0..2500] of FDATAB
libid		: ARRAY[0..2500] of FHEAD
isLibin     	: Array[0..20] of libisin
libIncludes  	: ARRAY[0..20] of lbn
basfile,pasfile,basic, basic1, dummy, dummy2, comment 	: AnsiString
bPath,bName,bExt 					: String[200]
fhlb,fhid						: Integer
zahl, mark, allsel, aktsel, tallsel         : Integer
i,j,jj                                      : Integer
ispas,linenumber,indent,libfound 	    : Integer
xuse 	: Array[0..100] of Integer
sel 	: Array[0..100] of asel
bas,pas,tcon,tvar,ttyp,tbv,tpc,pp,incl,tbasf,tbasf2,tfunc,tforw		: Text
Hour,Min,Sec,HSec : word
Hour2,Min2,Sec2,HSec2 : word
begin

INCLUDELIB BASPASLIB  
GetTime(Hour,Min,Sec,HSec);

basfile = Paramstr(1)
FSplit(ParamStr(0),bPath,bName,bExt)

dummy = Extract(basfile,'.')
pasfile = dummy + '.pas'
mark = 1
ispas = 1
linenumber = 0
indent = 0
If FileExists(basfile) then
? 'You compile ',basfile,' with BasPas Version 0.602'
? 'Written by Andrea Tobian-Mezger 2003'
?
? 'Show also on:  http://groups.yahoo.com/group/BasPas'
? 'for informations and files'  
?
For i = 0 to 20
libIncludes[i] = ''
Next i

	OpenWrite(tbasf,'tbasfile')
	OpenRead(bas,basfile)

	While not eof(bas)
		Readln(bas,basic)
		basic = Trim(basic)
		IF (basic <> '') AND (LENGTH(basic) > 8) THEN
			IF LeftStr(basic,8) <> 'INCLUDE ' THEN
			    IF LeftStr(basic,11) <> 'INCLUDELIB ' THEN
                                Writeln(tbasf,basic)   
                            ELSE
                                    Delete(basic,1,11)
                                    For i = 1 to 20
                                        IF libIncludes[i] = '' THEN
					    IF UpCase(basic) <> 'BASPASLIB' THEN
						    libIncludes[i] = bpath + Trim(basic)
						    ? libIncludes[i]
					    END IF
					    BREAK
                                        END IF
                                    Next i
                            END IF
			ELSE
				Delete(basic,1,8)
				basic = Trim(basic)
					If FileExists(basic) then
					OpenRead(incl,basic)
						WHILE NOT eof(incl)
							Readln(incl,basic)
							Writeln(tbasf,basic)
						WEND
					CLOSE(incl)
					END IF		
			END IF
		ELSE
			Writeln(tbasf,basic)	
		END IF
	
	WEND
	libIncludes[0]= bpath + 'BASPASLIB'
	Close(bas)
	CLOSE(tbasf)
IF Paramstr(2) <> UpCase('-nolibs')	
    For jj = 0 to 20
    For j = 0 to 2500
        isLibin[jj][j] = 0
    Next j
    Next jj
    OpenWrite(tfunc,'tfunc.bbb')
  
    
                For j = 0 to 20
                            IF libIncludes[j] = '' THEN
                                
                                BREAK
                            ELSE    

                                BPclearlib
				
                                BPLoadlib(libIncludes[j])
				
                                OpenRead(tbasf,'tbasfile')
				
                                OpenWrite(tbasf2,'tbasfile2')
				
                                    LibWork
				    
                                Close(tbasf2)    
                                Close(tbasf)
                                DeleteFile('tbasfile')
                                RenameFile('tbasfile2','tbasfile')
                                DeleteFile('tbasfile2')
                            END IF                
                Next j
 
    
        Close(tfunc)

       libfound = 1 
       While libfound = 1
            libfound  = 0
                For j = 0 to 20
                    
                            IF libIncludes[j] = '' THEN
                                
                                BREAK
                            ELSE                                    
                                BPclearlib
				
                                BPLoadlib(libIncludes[j])

                                OpenRead(tbasf,'tfunc.bbb')
				
                                OpenWrite(tfunc,'tfunc2.bbb')
                                OpenWrite(tbasf2,'tbasfile2')
                             
                                    LibWork
                              
                                Close(tfunc)    
                                Close(tbasf2)    
                                Close(tbasf)
                                DeleteFile('tfunc.bbb')
                                ConnectFiles('tfunc2.bbb','tbasfile2')
                                RenameFile('tfunc2.bbb','tfunc.bbb')
                                DeleteFile('tfunc2.bbb')                                
                                DeleteFile('tbasfile2')
                            END IF    
                          
                Next j  
        Wend        
      
{Connect the Functions/Procedures to Basicsource}
        OpenRead(tbasf,'tbasfile')
        OpenWrite(tbasf2,'tbasfile2')
	OpenWrite(tforw,'tforward')
        I = 0
            While not eof(tbasf)
                Readln(tbasf,dummy)
		IF  (LeftStr(UpCase(dummy),9) = 'FUNCTION ') or  (LeftStr(UpCase(dummy),10) = 'PROCEDURE ') THEN
			Writeln(tforw,dummy + ';forward;')
		END IF
                Writeln(tbasf2,dummy)
                IF (LeftStr(UpCase(dummy),5) = 'BEGIN') AND (I=0) THEN
                     I = 1
                     OpenRead(tfunc,'tfunc.bbb')
                        While not eof(tfunc)
                            Readln(tfunc,dummy2)
			    		IF  (LeftStr(UpCase(dummy2),9) = 'FUNCTION ') or  (LeftStr(UpCase(dummy2),10) = 'PROCEDURE ') THEN
						Writeln(tforw,dummy2 + ';forward;')
					END IF
                            Writeln(tbasf2,dummy2)
                        WEND           
                END IF            
            WEND
	Close(tforw)    
        Close(tfunc)
        Close(tbasf)
        Close(tbasf2)
        DeleteFile('tbasfile')
        RenameFile('tbasfile2','tbasfile')    
End IF    



	OpenRead(bas,'tbasfile')
	OpenWrite(pas,'tpas')   
	OpenWrite(tcon,'tconst')
	OpenWrite(tvar,'tvar')
	    Writeln(tvar,'VAR')
	OpenWrite(ttyp,'ttyp')
	OpenWrite(tbv,'tbevor')
	OpenWrite(tpc,'tprocs') 
{Write forward; Functions/Procedures}
	OpenRead(tforw,'tforward')
	While not eof(tforw)
		Readln(tforw,dummy)
		Writeln(tpc,dummy)
	WEND
	Close(tforw)
	DeleteFile('tforward')
	While not eof(bas)
	  comment = ''
	  basic = ''
	  Readln(bas,basic)
	  INC(linenumber)
	 
	  Trim(basic)
		
	  IF (basic <> '')  then				  
		  IF Pos(chr(123),basic) > 0 then 
			
			comment = Remain(basic,chr(123))
			basic = Extract(basic,chr(123))
			basic = Trim(basic)
		  END IF
		
		  Trim(basic) 
		  IF (basic <> '')  then  
			  zahl = Length(basic)                        
			  IF (basic[zahl] = ':') OR (basic[zahl] = ';') then
				noSemi
			  ELSE 
				  If mark = 0 then
				    parse
				  end if  
				  If mark > 0 then
				    headerparse
				  end if
			  END IF
		  ELSE
		  	noSemi
		  END IF
	  ELSE IF
		
		  noSemi                       
	  END IF
	
	wend 
	Close(tpc)
	Close(tbv)
	Close(ttyp)
	Close(tvar)
	Close(tcon)
	Close(pas)
	Close(bas)
		OpenWrite(pp,pasfile)
		dummy = chr(123) + ' This file is generated with BasPas Version 0.602 from  March/17/2003, ' + chr(125)
		Writeln(pp,dummy)
		dummy = chr(123) + ' the Basic to Pascal Compiler from Andrea Tobian-Mezger ' + chr(125)
		Writeln(pp,dummy)
		dummy = chr(123) + ' http://groups.yahoo.com/group/BasPas ' + chr(125)
		Writeln(pp,dummy)
			OpenRead(tbv,'tbevor')
			Repeat
			    Readln(tbv,dummy) 
			    Writeln(pp,dummy)
			Until eof(tbv)  
			CLOSE(tbv)
			OpenRead(tcon,'tconst')
			Repeat
			    Readln(tcon,dummy) 
			    Writeln(pp,dummy)
			Until eof(tcon) 
			CLOSE(tcon)
			OpenRead(ttyp,'ttyp')
			Repeat
			    Readln(ttyp,dummy)
			    Writeln(pp,dummy)
			Until eof(ttyp) 
			CLOSE(ttyp)
			OpenRead(tvar,'tvar')
			Repeat
			    Readln(tvar,dummy) 
			    Writeln(pp,dummy)
			Until eof(tvar) 
			CLOSE(tvar)
			OpenRead(tpc,'tprocs')
			Repeat
			    Readln(tpc,dummy)
			    Writeln(pp,dummy)
			Until eof(tpc)  
			CLOSE(tpc)
			OpenRead(pas,'tpas')                    
			Repeat
			    Readln(pas,dummy) 
			    Writeln(pp,dummy)
			Until eof(pas)  
			CLOSE(pas)              
		CLOSE(pp)
DeleteFile('tbevor')
DeleteFile('tconst')
DeleteFile('ttyp')
DeleteFile('tvar')
DeleteFile('tprocs')
DeleteFile('tpas')
DeleteFile('tbasfile')
DeleteFile('tfunc.bbb')
GetTime(Hour2,Min2,Sec2,HSec2);
? 'from Hour:',Hour,' Min:',Min,' Sec:',sec,' hsec:',hsec
? 'to   Hour:',Hour2,' Min:',Min2,' Sec:',sec2,' hsec:',hsec2
? 'even out rake, promotes the brain achievement:)'
? '-----------BasPas End------------------------------'
end if


Procedure ConnectFiles(q,z : AnsiString)
VAR
fq,fz : Text
zt : Ansistring
begin 
OpenAppend(fq,q)
OpenRead(fz,z)
    While not eof(fz)
        Readln(fz,zt)
        Writeln(fq,zt)
    Wend
Close(fz)
Close(fq)

END PROC

PROCEDURE FPrintLF( s : AnsiString)
VAR
xs : AnsiString
begin
IF indent > 0 THEN
	xs = StringofChar(' ',indent)
ELSE
	xs = ''
	indent = 0
END IF
s = xs + s
if ispas = 1 then
	Writeln(pas,s)
Else 
	Writeln(tpc,s)
End if

END PROC
{----------------------------------------------------------------}
Procedure LibWork
VAR

numb,k,tz,index,merk  : Integer

begin
numb = 0
index = 0
merk = 0
While not eof(tbasf)
    Readln(tbasf,basic)


    dummy = UpCASE(basic)
        basic = ' ' + basic + ' '
	dummy = ' ' + dummy + ' '          
    For k = 0 to 2500
        IF libid[k].exch = '' THEN
            BREAK
        END IF
	merk = 0
	Repeat
        REPEAT       
	merk = numb	
        numb = Pos(Trim(UpCASE(libid[k].exch)),dummy)

	
        IF numb > 0 THEN
			    
            tz = Length(libid[k].exch)	


	    IF numb > 0 THEN
		    IF (Byte(basic[numb-1]) > 47 ) AND (Byte(basic[numb-1]) < 58) THEN
			BREAK
		    END IF
		    IF (Byte(basic[numb-1]) > 64 ) AND (Byte(basic[numb-1]) < 91) THEN
			BREAK
		    END IF
		    IF (Byte(basic[numb-1]) > 96 ) AND (Byte(basic[numb-1]) < 123) THEN
			BREAK
		    END IF   
		    IF Byte(basic[numb-1]) = 95   THEN
			BREAK
		    END IF    
	    END IF
	    IF numb < ((Length(basic)-tz)+1)
		    IF (Byte(basic[numb+tz]) > 47 ) AND (Byte(basic[numb+tz]) < 58) THEN
			BREAK
		    END IF
		    IF (Byte(basic[numb+tz]) > 64 ) AND (Byte(basic[numb+tz]) < 91) THEN		    
			BREAK
		    END IF
		    IF (Byte(basic[numb+tz]) > 96 ) AND (Byte(basic[numb+tz]) < 123) THEN
			BREAK
		    END IF   
		    IF Byte(basic[numb+tz]) = 95   THEN
			BREAK
		    END IF  
	    END IF
            IF isLibin[j][k] = 0
	    	libfound = 1
                index = libid[k].wo
                dummy2 = libdata[index].data
                IF libdata[index].next = 1 THEN
                    WHILE libdata[index].next = 1
                        INC(index)
                        dummy2 = dummy2+libdata[index].data				
                    WEND	
                END IF

                Writeln(tfunc,Trim(dummy2)) 
                isLibin[j][k] = 1
            END IF
	    
	    basic = ReplaceOutS(basic,Trim(libid[k].exch),libid[k].name)
	    
	   
          END IF
          UNTIL true

	  IF merk = numb THEN	
		BREAK
	  END IF
	  dummy = UpCase(basic)
	  Until numb = 0	  
    Next k  
    Writeln(tbasf2,Trim(basic))

WEND
END PROC
{...........................................................................}

PROCEDURE noSemi
begin
        basic = basic + comment 
        FPrintLF(basic)
END PROC

PROCEDURE XnoSemi
begin

        If basic <> '' then
        basic = Replace(basic,'=',':=')
        basic = basic + comment 
        FPrintLF(basic)

        END IF
END PROC

PROCEDURE makeSemi
begin
                basic = basic + ';' 
                FPrintLF(basic)
                
END PROC

PROCEDURE XmakeSemi
begin

       	IF basic <> '' then
		zahl = Length(basic)
		IF basic[zahl] <> '_' then
			basic = Replace(basic,'=',':=')
			basic = basic + ';' 
			FPrintLF(basic)			
		ELSE   
			basic[zahl] = chr(95)
			XnoSemi                           
		END IF      

        ELSE  
		basic = basic + comment 
		FPrintLF(basic)
        END IF
        
END PROC






PROCEDURE headerparse
begin

        dummy = ''
        dummy2 = ''     
        basic1 = ''
        basic1 = Trim(UpCase(basic))
        
        SELECT  basic1
        USE = 'BEGIN'   
                basic = basic + comment         
                mark = 0
                FPrintLF(basic)
        USE = 'CONST' 
                mark = 2
                basic = basic + comment 
                Writeln(tcon,basic)
        USE  = 'VAR' 
                mark = 3
                basic =  comment 
                Writeln(tvar,basic)
        USE  = 'TYPE' 
                mark = 4
                basic = basic + comment 
                Writeln(ttyp,basic)
        USE  = 'USES' 
                mark = 5
                basic = basic + comment 
                Writeln(tbv,basic)
                
        ELSE USE       
                IF (RightStr(basic1,7) = ' RECORD') or (RightStr(basic1,7) = '=RECORD') THEN
			 Writeln(ttyp,basic)
                ELSE
                        SELECT  mark
                        USE  = 1 
                                basic = basic + ';' 
                                Writeln(tbv,basic)                      
                        USE  = 2 
                                basic = basic + ';' 
                                Writeln(tcon,basic)             
                        USE  = 3 
                                basic = basic + ';' 
                                Writeln(tvar,basic)             
                        USE  = 4 
                                basic = basic + ';' 
                                Writeln(ttyp,basic)
                        USE  = 5 
                                basic = basic + ';' 
                                Writeln(tbv,basic)
                        else USE       
                                basic = basic + ';' 
                                Writeln(tbv,basic)   
                        END SELECT
		END IF	
                
        END SELECT      
END PROC

PROCEDURE parse
begin

        dummy = ''
        dummy2 = ''     
        basic1 = ''
        basic1 = Trim(UpCase(basic))
SELECT basic1[1]


        

        USE = '?'
                Delete(basic,1,1)
                IF Trim(basic) <> '' then
                        zahl = LongInt(Length(basic))
                        If basic[zahl] = Chr(34) then
                                
                                basic[zahl] = chr(39)
                        END IF  
                        If basic[1] = Chr(34) then      
                                basic[1] = chr(39)
                        END IF  
                END IF  
                        basic = 'Writeln (' + basic +');'
                        noSemi                

        
        USE = 'B'
                WHEN basic1 = 'BEGIN' THEN
			noSemi
                        
		OR WHEN LeftStr(basic1,10) = 'BREAKLOOP ' THEN
			FPrintLF('BREAK;')		
		ELSE WHEN
			XmakeSemi                       
                END WHEN          


        USE = 'C'

        
                        IF basic1 = 'CONST' THEN        
				noSemi
                        ELSE 
				XmakeSemi
                        END IF  
        USE = 'D'       
			IF LeftStr(basic1,4) = 'DIM ' then
				Delete(basic,1,4)
				zahl= Pos(':',basic)
				IF zahl > 1 THEN
					dummy = LeftStr(basic,zahl-1)                                   
					dummy2 = PRemain(basic,zahl+1)
					basic = dummy + ' : ' + dummy2 + ';'
					Writeln(tvar,basic)
				ELSE
					zahl= Pos('as',basic)
					IF zahl > 1 THEN
						dummy = LeftStr(basic,zahl-1)                                   
						dummy2 = PRemain(basic,zahl+2)	
						basic = dummy + ' : ' + dummy2 + ';'
						Writeln(tvar,basic)
					END IF
				END IF
			ELSE
				XmakeSemi
			END IF
        USE = 'E'
			WHEN (basic1 = 'END IF') OR (basic1 = 'ENDIF')  THEN
				indent = indent - 4
				basic = 'END;'
				noSemi
				indent = indent -2
			OR WHEN basic1 = 'END SELECT' THEN
				DEC(aktsel)
				DEC(tallsel)
				indent = indent 
				indent = indent - 4				
				FPrintLF('END;')
				indent = indent - 6
				basic = 'UNTIL true;'
				noSemi
				xuse[aktsel] = 0
			OR WHEN (basic1 = 'ENDPROC') OR (basic1 = 'END PROC') OR (basic1 = 'END PROCEDURE') THEN
				indent = 0
				basic = 'END;'
				noSemi
				ispas = 1       
			OR WHEN (basic1 = 'ENDFUNC') OR (basic1 = 'END FUNC') OR (basic1 = 'END FUNCTION') THEN
				indent = 0
				basic = 'END;'
				noSemi
				ispas = 1       
			OR WHEN (basic1 = 'END WHEN') OR (basic1 = 'ENDWHEN') THEN
				indent = indent - 4
				FPrintLF('END;')
				indent = indent - 2
				basic = 'UNTIL true;'
				noSemi
			OR WHEN basic1 = 'END.' THEN
				indent = 0
				basic = 'END.'
				noSemi   
			OR WHEN ( basic1 = 'ELSE') OR (basic1 = 'ELSETHEN') OR (basic1 = 'ELSE THEN') OR (basic1 = 'ELSEIF') OR (basic1 = 'ELSE IF') THEN
				  indent = indent - 4				
				  FPrintLF('END')
				  indent = indent - 2
				  basic = 'ELSE'                                                
				  noSemi
				  indent = indent + 2
				  FPrintLF('BEGIN')
				  indent = indent + 4
			OR WHEN  (basic1 = 'ELSEWHEN') OR (basic1 = 'ELSE WHEN') OR (basic1 = 'ELSEUSE') OR (basic1 = 'ELSE USE')  THEN 
				  FPrintLF('BREAK;')
				  indent = indent - 4
				  FPrintLF('END')
				  indent = indent - 2
				  basic = 'ELSE'                                                
				  noSemi
				  indent = indent + 2
				  FPrintLF('BEGIN')
				  indent = indent + 4
			OR WHEN basic1 = 'ELSES' THEN   
				indent = indent - 6
				basic = 'ELSE'                                                                          
				FPrintLF('END')
				noSemi  
			OR WHEN basic1 = 'EXITLOOP' THEN
				FPrintLF('BREAK;')
				
			ELSE WHEN                         
			
			XmakeSemi
				
			END WHEN
		

        USE = 'F'
			WHEN LeftStr(basic1,4) = 'FOR ' then
					IF RightStr(basic1,2) = 'DO' then
						dummy = Replace(basic,'=',':=')  
						noSemi
					else 
						dummy = Replace(basic,'=',':=')
						basic = dummy + ' DO' 
						noSemi
						indent = indent + 2
						FPrintLF('BEGIN') 
						indent = indent + 4
					END IF  
					
			OR WHEN LeftStr(basic1,9) = 'FUNCTION ' THEN  
					ispas = 0                                                     
					makeSemi
					
			ELSE WHEN                                  
				XmakeSemi
			END WHEN
		
        USE = 'I'
			WHEN LeftStr(basic1,3) = 'IF ' then                       
				dummy = RightStr(basic1,5)
				IF dummy = ' THEN' then 
						noSemi
						indent = indent + 2
						FPrintLF('BEGIN')   
						indent = indent + 4
				ELSE 
					zahl = Pos(' THEN',basic1)
					IF zahl > 0 then
						zahl = Pos('THEN',UPCASE(basic))
						dummy = Extract(UPCASE(basic),'THEN')                                   
						dummy2 = PRemain(basic,zahl+4)
						dummy2 = Replace(dummy2,'=',':=')
						basic = dummy + dummy2 + ';'
						noSemi
											  
					ELSE                                    
						basic = basic + ' THEN'
						noSemi
						indent = indent + 2
						FPrintLF('BEGIN')  
						indent = indent + 4 						
					END IF
				END IF
				
			OR WHEN  LeftStr(basic1,8) = 'PINCLUDE ' then 
				Delete(basic,1,8)
				Trim(basic)				
				basic = chr(123)+'$I '+basic+chr(125)
				noSemi
			ELSE WHEN
				XmakeSemi                         
			END WHEN  
        USE = 'N'
			IF LeftStr(basic1,5) = 'NEXT ' THEN
				indent = indent - 4
				FPrintLF('END;')    
				indent = indent - 2
				                
			ELSE 
				XmakeSemi              
			END IF                  
                
        USE = 'O'
			IF (LeftStr(basic1,7) = 'ORWHEN ') OR (LeftStr(basic1,8) = 'OR WHEN ') THEN
				indent = indent - 4
				Delete(basic,1,7)
				dummy = RightStr(basic1,5)
				IF dummy = ' THEN' then 
					basic = 'IF ' + basic
				ELSE 
					basic = 'IF ' + basic + ' THEN'
				END IF
					FPrintLF('BREAK;')
					FPrintLF('END;')
					indent = indent - 2
					noSemi
					indent = indent + 2
					FPrintLF('BEGIN')
					indent = indent + 4
			ELSE 
				XmakeSemi
			END IF

        USE = 'P'
			IF LeftStr(basic1,10) = 'PROCEDURE ' THEN
				ispas = 0                       
				makeSemi
				
				
			ELSE 
				XmakeSemi
			END IF                  

        USE = 'R'
			IF basic1 = 'REPEAT' THEN
				noSemi
				indent = indent + 4
			ELSE 
				XmakeSemi
			END IF
	


        USE = 'S'
			IF LeftStr(basic1,7) = 'SELECT ' THEN
				 Delete(basic,1,6)
				sel[aktsel] = Trim(basic)
				INC(aktsel)
				INC(allsel)
				tallsel = allsel
				basic = 'REPEAT'
				noSemi
				indent = indent + 4
			ELSE 
				XmakeSemi
			END IF  

        USE = 'T'
			WHEN basic1 = 'THEN' THEN 
				FPrintLF('BEGIN')         
			OR WHEN  basic1 = 'TYPE' THEN
				noSemi
			ELSE WHEN
				XmakeSemi                        
			END WHEN
        USE = 'U'
			WHEN  LeftStr(basic1,6) = 'UNTIL ' THEN
					indent = indent - 4			
					makeSemi			
			OR WHEN LeftStr(basic1,4) = 'USE ' THEN
					Delete(basic,1,3)
					basic = sel[aktsel-1] + basic
					basic = 'IF ' + basic + ' THEN'
					IF xuse[aktsel-1] = 0 then
						xuse[aktsel-1] = 1
						noSemi
						indent = indent + 2
						FPrintLF( 'BEGIN')
						indent = indent + 4
						
					ELSE 
						indent = indent - 4
						INC( xuse[aktsel-1])
						FPrintLF('BREAK;')
						FPrintLF('END;')
						indent = indent -2
						noSemi
						indent = indent + 2
						FPrintLF('BEGIN')
						indent = indent + 4
					END IF
					
			ELSE WHEN
					XmakeSemi
			END WHEN
        USE = 'V'
			IF basic1 = 'VAR' THEN
				noSemi
			ELSE 
				XmakeSemi
			END IF  
	

        USE = 'W'       
			WHEN  LeftStr(basic1,6) = 'WHILE ' THEN
					basic = basic + ' DO'
					noSemi
					indent = indent + 2
					FPrintLF('BEGIN')
					indent = indent + 4
			OR WHEN basic1 = 'WEND' THEN
					indent = indent - 6
					basic = 'END;'
					noSemi
			OR WHEN basic1 = 'WITH' THEN                 
					noSemi
			OR WHEN LeftStr(basic1,5) = 'WHEN ' THEN 
                     basic = Trim(basic)
					Delete(basic,1,5)
					dummy = RightStr(basic1,5)
					IF dummy = ' THEN' then 
						basic = 'IF ' + basic
					ELSE 
						basic = 'IF ' + basic + ' THEN'
					END IF
						FPrintLF('Repeat')
						noSemi  
						indent = indent + 2
						FPrintLF('Begin')
						indent = indent + 4
			ELSE WHEN                  
					XmakeSemi
			END WHEN
	USE = '_'
			IF basic1 = '+PAS' THEN
				Repeat
					Readln(bas,basic)
					basic = Trim(basic)
					IF UpCase(basic) = '-PAS' THEN
						BREAK
					ELSE
						FPrintLF(basic)
					END IF	
				UNTIL eof(bas)
			ELSE
				XmakeSemi
			END IF
        ELSE USE       
        	XmakeSemi
			                                 
        END SELECT
END PROC


end.

