/* $VER: 0.17 beta, (11.11.1997), © by Thorsten Willert

   Macro um einer FinalWriter-Tabellen
   die GRUNDfunktionen einer
   Tabellenkalkulation beizubringen.
 
-----------------------------------------------*/

ADDRESS = 'FinaW'
OPTIONS CACHE RESULTS

STATUS PORTNAME
FW = RESULT
ADDRESS = FW

SIGNAL ON BREAK_C
SIGNAL ON HALT
SIGNAL ON SYNTAX

/*-----------------------------------------------*/

IF ~show('L',"rexxreqtools.library") THEN DO
   IF ~addlib('rexxreqtools.library',0,-30,0) THEN DO
      'ShowMessage 1 1 "Error ..." "Missing rexxreqtools.library!" "" "Cancel !!" "" ""'
      EXIT 20
   END
END

/*------------- Initialisierung -----------------*/

RT.Version = "0.17 beta"
RT.R       = '0A'X
RT.Title   = "FWCalc, "|| RT.Version 
RT.Para1   = "rtez_flags = ezreqf_centertext"
RT.Para2   = "rt_pubscrname = FinalWriterPubScreen rtfi_flags = freqf_selectdirs"
RT.Copyright  = RT.Title || ", © 1997, by Thorsten Willert"

R          = '0A'X
Zahlen     = "1234567890.,-"
FormelZ    = "ABCDEFGHIJKLMNOPQRSTUVWXYZ+-*/%"

Datei.TMP  = "T:FWCalc_Formeln.TMP"
Datei.TMP2 = "T:FWCalc_Formeln.TMP2"
Datei.TMP3 = "T:FWCalc_Formeln.TMP3"
Datei.TMP4 = "T:FWCalc_Formeln.TMP4"

Text.5     = "_Exit"
Text.8     = "  User break!  "
Text.9     = "Syntax Error!"
Message.100 = "Could not open FWCalc.catalog!"

/*--------------- Hauptprogramm ------------------*/

CALL Locale

Info = 1
IF Info = 1 THEN CALL Info

DO FOREVER
    Commando = rtezrequest(Text.1,Text.2,RT.Title)
    CALL DocInfos
    FormelDatei = RESULT
    
    IF EXISTS( FormelDatei ) THEN ADDRESS command 'C:COPY ' FormelDatei 'TO' Datei.TMP2
        ELSE CALL Message( 4 )            
    
    IF TableDimension() = 1 THEN
        DO    
            TabellenName = GetTabName()
            CALL SelectFormeln( TabellenName )
                SELECT
                    WHEN Commando = 1 THEN 
                        DO
                            Modus = "CALC"
                            CALL GetInhalt
                            CALL Calc   
                        END    
                    WHEN Commando = 2 THEN CALL FormelEditor
                    /* WHEN Commando = 3 THEN
                        DO
                            CALL RemoveCoordinaten
                        END */
                    OTHERWISE CALL Ende
                END            
            CALL Clear 
        END
    
END   

/*----------------- Ende -------------------------*/

Ende:

IF Coordinaten = 1 THEN CALL RemoveCoordinaten
CALL Clear

EXIT

/*------------ Unterprogramme --------------------*/

Locale: PROCEDURE EXPOSE Message. Text. RT. R

CatalogOK = 0

IF EXISTS("ENV:Language") THEN 
    IF OPEN( Datei , "ENV:Language", "R" ) THEN Sprache = READLN( Datei )
ELSE
    Sprache = english

IF EXISTS("Locale:Catalogs/" || Sprache || "/FWCalcTab.catalog") THEN CatalogOK =  ReadCatalog( Sprache )
    ELSE IF EXISTS("Locale:Catalogs/english/FWCalcTab.catalog") THEN CatalogOK =  ReadCatalog( "english" )

IF CatalogOK = 0 THEN 
    DO
        CALL Message( 100 )
        CALL Ende
    END

RETURN

/*------------------------------------------------*/

ReadCatalog: PROCEDURE EXPOSE Message. Text. RT. R
PARSE ARG Sprache

IF OPEN( Locale, "Locale:Catalogs/" || Sprache || "/FWCalcTab.catalog" , "R") THEN
        DO WHILE ~EOF( Locale )
            InZeile = READLN( Locale )
            INTERPRET( InZeile )
        END
        
RETURN OffenDatei

/*------------------------------------------------*/

FormelEditor:

Save = 1
Modus = "FORMEL"

Coordinaten = InsertCoordinaten()
CALL ViewFormel

IF ~EXISTS( Datei.TMP4 ) THEN OPEN( Datei1 , Datei.TMP4 , "W" )
CLOSE( Datei1 )

    DO FOREVER
        rtezrequest(Text.3,Text.4,RT.Title)                    
         
            IF rtresult == 1 THEN LEAVE        
            ELSE LEAVE
    END

CALL GetInhalt
CALL CALC


ADDRESS command 'C:join' Datei.TMP4 Datei.TMP3 'TO ' FormelDatei
IF RC=20 THEN
        /*DO
            OPEN( Datei , Datei.TMP4 , "W")
            WRITELN( Datei , "  " )
            CLOSE( Datei )
            ADDRESS command 'C:join' Datei.TMP4 Datei.TMP3 'TO ' FormelDatei*/
            
            ADDRESS command 'C:copy' Datei.TMP3 'TO ' FormelDatei

     
ADDRESS command 'C:delete ' Datei.TMP4

IF Coordinaten = 1 THEN CALL RemoveCoordinaten

Save = 0
               
RETURN

/*-----------------------------------------------*/

DocInfos: PROCEDURE EXPOSE FW Message. RT. Text.

ADDRESS (FW)

STATUS PathName
Path = RESULT
    IF Path = "" THEN 
        DO FOREVER
            CALL Message( 6 )
            SaveAs
            IF RC=0 THEN LEAVE
        END
 
FormelDatei = Path || ".CALC"
    
RETURN FormelDatei

/*-----------------------------------------------*/

GetTabName: PROCEDURE EXPOSE RT. Message. Text.

DO FOREVER
    GetObjectTitle
    TabellenName = RESULT
      
    IF LENGTH( TabellenName ) >= 2 THEN
    DO 
        TabellenName = TRANSLATE( TabellenName ,"_", " " )
        LEAVE
    END
    ELSE 
    DO
        CALL Message( 2 )
        TablePrefs Prompt
    END                   
END

RETURN TabellenName

/*-----------------------------------------------*/

SelectFormeln: PROCEDURE EXPOSE Datei.
PARSE ARG Tabelle

IF EXISTS( Datei.TMP2 ) THEN
    DO
        OPEN( Datei1, Datei.TMP2, "R" )
        OPEN( Datei2, Datei.TMP , "W" )
        OPEN( Datei3, Datei.TMP3, "W" )
    
        DO WHILE ~EOF( Datei1 )
            InZeile = READLN( Datei1 )
            IF InZeile = "" THEN ITERATE
            IF SUBWORD( InZeile ,1,1 ) = Tabelle THEN WRITELN( Datei2, InZeile )
                ELSE WRITELN( Datei3, InZeile )
        END
    
        CLOSE( Datei1 )
        CLOSE( Datei2 )
        CLOSE( Datei3 )            
    END
    
RETURN

/*-----------------------------------------------*/

TableDimension: PROCEDURE EXPOSE Spalten Zeilen FW Message. RT. Text.

TableOK = 1

ADDRESS(FW)
TableGetColumns 
    PARSE VAR RESULT Muell Spalten

TableGetRows
    PARSE VAR RESULT Muell Zeilen

IF Zeilen = "" | Spalten = "" THEN /* Geht nicht über GetObjektType */
    DO
        CALL Message( 1 )
        TableOK = 0
    END

RETURN TableOK

/*-----------------------------------------------*/

InsertCoordinaten: PROCEDURE EXPOSE Zeilen Spalten FW

ADDRESS(FW)
TableInsertRows 2 1
Redraw

TableInsertColumns 2 1 1
Redraw

i = 0
j = 0

DO WHILE i ~= Zeilen - 1
    i = i + 1
    Zeile = i + 2
    TableSetActiveCell Zeile 2
    Justify Center
    Type i
END

DO WHILE j ~= Spalten - 1 | j = 26
    j = j + 1
    Spalte = j + 2
    TableSetActiveCell 2 Spalte
    ABC = D2C( 64 + j )
    Justify Center
    Type ABC
END

Coordinaten = 1

RETURN Coordinaten

/*-----------------------------------------------*/

RemoveCoordinaten:

TableDeleteColumns 2 1 Force;TableDeleteRows 2 1 Force
Coordinaten = 0

RETURN

/*--------- Tabellen Inhalt einlesen -----------*/

GetInhalt:

ADDRESS (FW)

GetDocItemPrefs Decimal
Punkt = result
result = ""

NN=0;s=0

DO FOREVER
    z=0
    IF Modus ~= "FORMEL" THEN TableSetActiveCell z+2 s+2
        ELSE TableSetActiveCell z+3 s+3
        
    SpaltenName=D2C(65+s)
        DO FOREVER
            IF Modus ~= "FORMEL" THEN TableSetActiveCell z+2 s+2
                ELSE TableSetActiveCell z+3 s+3
            SelectAll
            Extract
            ZellenInhalt=COMPRESS(RESULT,'09'X'0A'X)
            IF DATATYPE( ZellenInhalt , Numeric ) THEN Justify Right
                ELSE
                    DO
                        ZellenInhalt2=0
                        IF Save = 1 THEN SaveFormel( ZellenInhalt )
                        IF RESULT = 0 THEN RETURN 
                    END
            
            ZeilenNummer=z+1
            
            IF Modus ~= "FORMEL" THEN TableSetActiveCell z+2 s+2
                ELSE TableSetActiveCell z+3 s+3
            SelectAll
            Clear
            
            ZellenInhalt2=TRANSLATE(ZellenInhalt,"." ,",")     
            Type ZellenInhalt2
                
            IF ZellenInhalt = "" THEN ZellenInhalt2 = 0
            ZellenInhalt2 = COMPRESS(ZellenInhalt2,"+-/%&|():*")
            
            INTERPRET(SpaltenName||ZeilenNummer"="ZellenInhalt2)
            z=z+1
            
            IF z=Zeilen-1 THEN LEAVE
        END
    s=s+1
    IF s=Spalten-1 THEN LEAVE
END
    
RETURN

/*----------- Formeln berechenen  --------------*/

Berechnen:

ErgebnisOK = 0

IF FormelOK = 1 THEN
    DO
    ErgebnisOK = 1
        SELECT
            WHEN Rechnung = "DURCHSCHNITT" THEN
                DO
                    Formel3 = STRIP(TRANSLATE( Formel2 , " ", "+-/;*" ))
                    Operanden = WORDS( Formel3 )
                    Formel2 = TRANSLATE( "(" || Formel3 , "+" , " ") || ")/" || Operanden
                    CALL Ausgabe
                    ErgebnisOK = 1
                END
            WHEN Rechnung = "SUMME" THEN
                DO
                    CALL Ausgabe
                    ErgebnisOK = 1
                END
            WHEN Rechnung = "DATE" THEN CALL UpDate
            WHEN Rechnung = "TIME" THEN CALL UpDateTime
            OTHERWISE NOP 
         END
    END
                     
RETURN ErgebnisOK

/*--------- Ergebnis ausgeben -------------------*/

Ausgabe:

INTERPRET("Ergebnis =" Formel2 )
IF Modus = "CALC" THEN  TableSetActiveCell ZeileA+1 SpalteA+1
    ELSE TableSetActiveCell ZeileA+2 SpalteA+2
    
SelectAll;Clear;FontColor Schwarz;Style Bold;Justify Right;Type Ergebnis

RETURN

/*--------------------------------------------*/

UpDate:

ADDRESS(FW)
IF Modus = "CALC" THEN  TableSetActiveCell ZeileA+1 SpalteA+1
    ELSE TableSetActiveCell ZeileA+2 SpalteA+2

SelectAll;Clear;Justify Left;FontColor Schwarz;Insert Date

RETURN

/*--------------------------------------------*/

UpDateTime: 

ADDRESS(FW)
IF Modus = "CALC" THEN  TableSetActiveCell ZeileA+1 SpalteA+1
    ELSE TableSetActiveCell ZeileA+2 SpalteA+2

SelectAll;Clear;Justify Right;FontColor Schwarz;Insert Time

RETURN

/*--------------------------------------------*/

FormelInterpreter:
PARSE ARG FORMEL

FormelOK  = 0
SpalteA   = 0
ZeileA    = 0

Formel = UPPER(STRIP( Formel ))
BeginnFormel = POS( "=" , Formel )

IF BeginnFormel ~= 0 THEN
    DO
        ErgebnisZelle = SUBSTR( Formel , 1 , BeginnFormel -1  )
        
        SpalteA = C2D( SUBSTR( ErgebnisZelle , 1 , 1)) - 64
        ZeileA = STRIP(SUBSTR( ErgebnisZelle , 2))
         
        SELECT
            WHEN POS( "=(" , Formel ) ~= 0 THEN
                DO
                    Formel2 = StripFormel( Formel )
                    Rechnung = "SUMME"
                END
            WHEN POS( "=DURCHSCHNITT" , Formel ) ~=0 THEN
                DO
                    Formel2 =  StripFormel( Formel )
                    Rechnung = "DURCHSCHNITT"
                END
            WHEN POS( "=DATE", Formel ) ~=0 THEN Rechnung = "DATE"
            WHEN POS( "=TIME", Formel) ~= 0 THEN Rechnung = "TIME"
            OTHERWISE RETURN FormelOK
        END
            
        IF VERIFY( Formel , FormelZ ) ~= 0 THEN FormelOK = 1
                
    END

RETURN FormelOK

/*-------------------------------------------*/

StripFormel: 
PARSE ARG FormelS

    FirstPos = POS( '(', FormelS )
    LastPos = LASTPOS( ')' , FormelS )
    FormelS = DELSTR( FormelS , LastPos )
    
    Formel2 = SUBSTR( FormelS , FirstPos + 1)
    
RETURN Formel2

/*-------------------------------------------*/

Calc:

KF = 1

IF EXISTS( Datei.TMP4 ) THEN Datei = Datei.TMP4
    ELSE Datei = Datei.TMP 

IF EXISTS( Datei ) THEN
    DO
        OffenDatei2 = OPEN( Datei2, Datei, "R" )
        DO WHILE ~EOF( Datei2 )
            InZeile =  READLN( Datei2 )
            IF InZeile = "" THEN LEAVE
            PARSE VAR InZeile TabellenNameD Formel
            IF TabellenNameD ~= TabellenName THEN ITERATE
            KF = 0 
            IF FormelInterpreter( Formel ) = 0 THEN RETURN
            CALL Berechnen
         END   
    END

CLOSE( Datei2 )

IF KF = 1 & Save = 0 THEN CALL Message( 3 )
 
RETURN

/*--------------------------------------------*/

ViewFormel:

IF EXISTS( Datei.TMP ) THEN
    DO
        OffenDatei2 = OPEN( Datei2, Datei.TMP, "R" )
        DO WHILE ~EOF( Datei2 )

            InZeile = READLN( Datei2 )
            PARSE VAR InZeile TabellenNameD Formel
            
            CALL FormelInterpreter( Formel )
            
            TableSetActiveCell ZeileA+2 SpalteA+2
                SelectAll
                Clear
                Justify Left
                FontColor Rot
                Style Normal
                Type Formel
        END
        CLOSE( Datei2 )
    END

RETURN

/*--------------------------------------------*/

SaveFormel: PROCEDURE EXPOSE Datei. RT. Text. Message. FW FormelZ Save
PARSE ARG Formel

SaveFormelOK = 0

STATUS PathName
FormelDatei=RESULT||".CALC"

IF FormelInterpreter( Formel ) = 0 THEN RETURN SaveFormelOK
        
CALL GetTabName
TabellenName = RESULT

IF OPEN( Datei1, Datei.TMP4, "A" ) = 1 THEN
    DO
        WRITELN(Datei1, TabellenName Formel )
        SaveFormelOK = 1
    END
CLOSE( Datei1 )
    
RETURN SaveFormelOK

/*----------------------------------------------*/

Info: PROCEDURE EXPOSE RT. Text.

    rtezrequest(Text.7,Text.5,RT.Title)

RETURN

/*-----------------------------------------------*/

Message: EXPOSE Message. RT. Text.
PARSE ARG Index

IF Index <= 100 THEN rtezrequest(Message.Index,Text.5,RT.Title)
    ELSE
        DO FOREVER
            IF rtezrequest(Message.Index,Text.6,RT.Title) == 1 THEN LEAVE
                ELSE CALL Info
        END

RETURN

/*----------------------------------------------*/

Clear:

CLOSE( Datei  )
CLOSE( Datei1 )
CLOSE( Datei2 )
CLOSE( Datei3 )
CLOSE( Datei4 )

ADDRESS command 'C:delete ' Datei.TMP
ADDRESS command 'C:delete ' Datei.TMP2
ADDRESS command 'C:delete ' Datei.TMP3
ADDRESS command 'C:delete ' Datei.TMP4

RETURN

/*----------------------------------------------*/

HALT:
BREAK_C:

rtezrequest(Text.8,Text.5,RT.Title)

CALL Ende

RETURN

/*---------------------------------------------*/

SYNTAX:

rtezrequest(Text.9,Text.5,RT.Title)

CALL Ende

RETURN