//TH-Header //***************************************************************************************** // Copyright (c) 2014 KURANT Project // All rights reserved. // // $FileName : Asdbc.DG // $ProjectName : The Hammer 2.0 // $Authors : Wil van Antwerpen, Michael Kurz, Sergey V. Natarov, Bernhard Ponemayr // $Created : 01.25.2014 01:08 // $Type : LGPL // // Contents: ASDB Compiler Tool // //***************************************************************************************** //TH-RevisionStart //TH-RevisionEnd // Project Object Structure // oASDBC is a ModalPanel // oOK_bn is a Button // oCancel_bn is a Button // Textbox1 is a Textbox // Textbox2 is a Textbox // Textbox3 is a Textbox // ProgressBar1 is a ProgressBar // Textbox4 is a Textbox // List1 is a List // Textbox5 is a Textbox // CO1 is a Group // CheckBox1 is a CheckBox // CheckBox2 is a CheckBox // CheckBox3 is a CheckBox // Form1 is a Form // CheckBox4 is a CheckBox // CheckBox5 is a CheckBox // Register all objects Register_Object CheckBox1 Register_Object CheckBox2 Register_Object CheckBox3 Register_Object CheckBox4 Register_Object CheckBox5 Register_Object CO1 Register_Object Form1 Register_Object List1 Register_Object oASDBC Register_Object oCancel_bn Register_Object oOK_bn Register_Object ProgressBar1 Register_Object Textbox1 Register_Object Textbox2 Register_Object Textbox3 Register_Object Textbox4 Register_Object Textbox5 Use For_All.pkg #IF (FMAC_VERSION < 8) //Use DFPrgRes.pkg #ELSE Use cProgressBar.pkg #ENDIF Use ProcessMessages.pkg Open VDFCLS Open VDFPROP Open ASDB Object oASDBC Is a BasicPanel Property Integer pbAutoStart Public False // This was a BasicPanel with modal_state set to true Set Modal_State To True Set Locate_Mode To CENTER_ON_SCREEN Set Label To "ASDB Compiler" Set Size To 249 263 Set Location To 13 94 Object oOK_bn Is a Button Property Integer Only_Basic Public False Property Integer Include_Parents Public True Property Integer Include_Mixin Public True Property Integer Status_Log Public False Property String Status_File Public "ASDBCLog.txt" Set Label To "&Start" Set Location To 5 204 Procedure Update_Button Send Paint End_Procedure Procedure DoZeroFileASDB Lock For_All Asdb By Index.1 as queue Do Delete Asdb End_For_All Unlock End_Procedure // DoZeroFileASDB Procedure OnClick Integer iRec iRecs bStatus bParents bMixin bBasic Number nRecs nRec nProc String sStatus Get Status_Log To bStatus Get Include_Parents To bParents Get Only_Basic To bBasic Get Include_Mixin To bMixin If (bStatus) Begin Get Status_File To sStatus If (sStatus<>"") Direct_Output sStatus Else Begin Set Status_Log To False Move 0 To bStatus End End Get_Attribute DF_FILE_RECORDS_USED Of VDFCLS.File_Number To iRecs Set Enabled_State To False Set Enabled_State Of oCancel_bn To False Set Enabled_State Of CO1 To False // Opens ASDB Send Add_Item To (List1(Self)) Msg_None ("Cleaning ASDBC database ...") Send DoZeroFileASDB // The Zerofile command needs to have exclusive access, this procedure uses a delete loop to work around that Send Add_Item To (List1(Self)) Msg_None ("Cleanup ASDBC database done.") If (bStatus) Begin Writeln "005 Status Log enabled." Ifnot (bParents) Writeln "005 Parent classes excluded." Ifnot (bMixin) Writeln "006 Mixin classes omitted." End //ZeroFile ASDB Get_Attribute DF_FILE_RECORDS_USED Of VDFCLS.File_Number To iRecs Move iRecs To nRecs Move 0 To nRec Set Label Of (TextBox4(Self)) To "Progress status is 0%" #IF (FMAC_VERSION < 8) Set Current_Position Of ProgressBar1 To 0 #ELSE Set piPosition Of ProgressBar1 To 0 #ENDIF Send Delete_Data To List1 If (iRecs) Begin For iRec From 1 To iRecs Clear VDFCLS Move iRec To VDFCLS.RECNUM Find Eq VDFCLS by Recnum If (found) Begin Move (Round((VDFCLS.RECNUM/nRecs)*100)) To nProc #IF (FMAC_VERSION < 8) Set Current_Position Of ProgressBar1 To nProc #ELSE Set piPosition Of ProgressBar1 To nProc #ENDIF Set Label Of (TextBox4(Self)) To ("Progress status is "+String(nProc)+"%") If (bBasic) Begin If VDFCLS.BASE Eq "Y" Begin Send Add_Item To (List1(Self)) Msg_None ("COMPILING: "+Trim(VDFCLS.NAME)+" class ...") If (bStatus) Writeln ("001 Class "+Trim(VDFCLS.NAME)+" included into AS database.") Send Start_Compiler VDFCLS.CODE VDFCLS.CODE End End Else Begin Send Add_Item To (List1(Self)) Msg_None ("COMPILING: "+Trim(VDFCLS.NAME)+" class ...") If (bStatus) Writeln ("001 Class "+Trim(VDFCLS.NAME)+" included into AS database.") Send Start_Compiler VDFCLS.CODE VDFCLS.CODE End #IF (FMAC_VERSION < 8) Send Advance_Progress To ProgressBar1 #ELSE Send DoAdvance To ProgressBar1 #ENDIF Send Page_Down To (List1(Self)) End //Send Update_Panel to oASDBC Loop End Send Add_Item To (List1(Self)) Msg_None ("Compilation successfully done. "+String(nRecs)+" classes compiled.") If (bStatus) Writeln ("002 Compilation successfully done. "+String(nRecs)+" classes compiled.") Set Enabled_State To True Set Label To "&Recompile" Set Enabled_State Of oCancel_bn To True Set Enabled_State Of CO1 To True Set Label Of (TextBox4(Self)) To "Compilation done." If (bStatus) Close_Output End_Procedure Procedure Start_Compiler Number nCode Number nClass Number nParent Integer iCnt bState bMixin bParent Get Include_Mixin To bMixin Get Include_Parents To bParent Clear VDFPROP For_All VDFPROP by Index.1 Constrain VDFPROP.VDFCLS Eq nCode Do Clear ASDB Move nClass To ASDB.VDFCLS Move VDFPROP.NAME To ASDB.NAME Find Eq ASDB by Index.1 Ifnot (found) Begin Clear ASDB Move nClass To ASDB.VDFCLS Move VDFPROP.Type To ASDB.Type Move VDFPROP.NAME To ASDB.NAME Move 0 To ASDB.PCLASS Move "Self" To ASDB.PCLASSNAME Move VDFPROP.PAR1T To ASDB.PAR1T Move VDFPROP.PAR1 To ASDB.PAR1 Move VDFPROP.PAR2T To ASDB.PAR2T Move VDFPROP.PAR2 To ASDB.PAR2 Move VDFPROP.PAR3T To ASDB.PAR3T Move VDFPROP.PAR3 To ASDB.PAR3 Move VDFPROP.PAR4T To ASDB.PAR4T Move VDFPROP.PAR4 To ASDB.PAR4 Move VDFPROP.PAR5T To ASDB.PAR5T Move VDFPROP.PAR5 To ASDB.PAR5 Move VDFPROP.GETCODE To ASDB.GETCODE Move VDFPROP.SETCODE To ASDB.SETCODE Saverecord ASDB End // if not found End_For_All Clear VDFCLS Move nCode To VDFCLS.CODE Find Eq VDFCLS by Index.3 If ((found)And(bMixin)) Begin If ((VDFCLS.MIXIN1<>0)Or(VDFCLS.MIXIN2<>0)Or(VDFCLS.MIXIN3<>0)Or(VDFCLS.MIXIN4<>0)Or(VDFCLS.MIXIN5<>0)) Send Add_Mixin_Elements nCode 0 nClass End If (bParent) Send AddFromParents nCode nClass End_Procedure Procedure Add_Mixin_Elements Number nCode Integer iLevel Number nClass Integer Mix1 Mix2 Mix3 Mix4 Mix5 Mix6 Mix7 Mix8 Mix9 Mix10 Mix11 Mix12 Mix13 Mix14 Mix15 String sMix Clear VDFCLS Move nCode To VDFCLS.CODE Find Eq VDFCLS by Index.3 If (found) Begin Move VDFCLS.MIXIN1 To Mix1 Move VDFCLS.MIXIN2 To Mix2 Move VDFCLS.MIXIN3 To Mix3 Move VDFCLS.MIXIN4 To Mix4 Move VDFCLS.MIXIN5 To Mix5 Move VDFCLS.MIXIN6 To Mix6 Move VDFCLS.MIXIN7 To Mix7 Move VDFCLS.MIXIN8 To Mix8 Move VDFCLS.MIXIN9 To Mix9 Move VDFCLS.MIXIN10 To Mix10 Move VDFCLS.MIXIN11 To Mix11 Move VDFCLS.MIXIN12 To Mix12 Move VDFCLS.MIXIN13 To Mix13 Move VDFCLS.MIXIN14 To Mix14 Move VDFCLS.MIXIN15 To Mix15 Move VDFCLS.NAME To sMix If (MIX1<>0) Send ProcessMixin MIX1 sMix iLevel nClass If (MIX2<>0) Send ProcessMixin MIX2 sMix iLevel nClass If (MIX3<>0) Send ProcessMixin MIX3 sMix iLevel nClass If (MIX4<>0) Send ProcessMixin MIX4 sMix iLevel nClass If (MIX5<>0) Send ProcessMixin MIX5 sMix iLevel nClass If (MIX6<>0) Send ProcessMixin MIX6 sMix iLevel nClass If (MIX7<>0) Send ProcessMixin MIX7 sMix iLevel nClass If (MIX8<>0) Send ProcessMixin MIX8 sMix iLevel nClass If (MIX9<>0) Send ProcessMixin MIX9 sMix iLevel nClass If (MIX10<>0) Send ProcessMixin MIX10 sMix iLevel nClass If (MIX11<>0) Send ProcessMixin MIX11 sMix iLevel nClass If (MIX12<>0) Send ProcessMixin MIX12 sMix iLevel nClass If (MIX13<>0) Send ProcessMixin MIX13 sMix iLevel nClass If (MIX14<>0) Send ProcessMixin MIX14 sMix iLevel nClass If (MIX15<>0) Send ProcessMixin MIX15 sMix iLevel nClass End End_Procedure Procedure ProcessMixin Integer iCode String sName Integer iLevel Number nClass Number nParent Integer iCnt iFor Integer bStatus bMixin String sSpace Move "" To sSpace Get Include_Mixin To bMixin For iFor From 0 To iLevel Move (sSpace+" ") To sSpace Loop Get Status_Log To bStatus If (bStatus) Begin Clear VDFCLS Move iCode To VDFCLS.CODE Find Eq VDFCLS by index.3 Writeln "003" sSpace "+ Mixin Class " (Trim(VDFCLS.NAME)) " added." End If (iCode>0) Begin Clear VDFPROP For_All VDFPROP by Index.1 Constrain VDFPROP.VDFCLS Eq iCode Do Move VDFPROP.VDFCLS To VDFCLS.CODE Find Eq VDFCLS by index.3 Clear ASDB Move nClass To ASDB.VDFCLS Move VDFPROP.NAME To ASDB.NAME Find Eq ASDB by Index.1 Ifnot (found) Begin Clear ASDB Move nClass To ASDB.VDFCLS Move VDFPROP.Type To ASDB.Type Move VDFPROP.NAME To ASDB.NAME Move VDFCLS.CODE To ASDB.PCLASS If (iLevel) Move (sName+", "+Trim(VDFCLS.NAME)) To ASDB.PCLASSNAME Else Move VDFCLS.NAME To ASDB.PCLASSNAME Move VDFPROP.PAR1T To ASDB.PAR1T Move VDFPROP.PAR1 To ASDB.PAR1 Move VDFPROP.PAR2T To ASDB.PAR2T Move VDFPROP.PAR2 To ASDB.PAR2 Move VDFPROP.PAR3T To ASDB.PAR3T Move VDFPROP.PAR3 To ASDB.PAR3 Move VDFPROP.PAR4T To ASDB.PAR4T Move VDFPROP.PAR4 To ASDB.PAR4 Move VDFPROP.PAR5T To ASDB.PAR5T Move VDFPROP.PAR5 To ASDB.PAR5 Move VDFPROP.GETCODE To ASDB.GETCODE Move VDFPROP.SETCODE To ASDB.SETCODE Saverecord ASDB End // if not found End_For_All End Clear VDFCLS Move iCode To VDFCLS.CODE Find Eq VDFCLS by Index.3 If (Not(Found)) Procedure_Return If ((VDFCLS.MIXIN1<>0)Or(VDFCLS.MIXIN2<>0)Or(VDFCLS.MIXIN3<>0)Or(VDFCLS.MIXIN4<>0)Or(VDFCLS.MIXIN5<>0)) Send Add_Mixin_Elements iCode 1 nClass End_Procedure Procedure AddFromParents Number nCode Number nClass Integer iCnt Number nPArent Integer bStatus bMixin bParent Get Status_Log To bStatus Get Include_Mixin To bMixin Get Include_Parents To bParent Clear VDFCLS Move nCode To VDFCLS.CODE Find Eq VDFCLS by Index.3 If (found) Begin Move VDFCLS.PARENT To nParent While (nParent<>0) Move VDFCLS.PARENT To nParent Clear VDFCLS Move nParent To VDFCLS.CODE Find Eq VDFCLS by Index.3 If (found) Begin Send Add_Item To (List1(Self)) Msg_None (" INCLUDE PARENT: "+Trim(VDFCLS.NAME)+" class ...") If (bStatus) Writeln ("004 + Parent Class "+Trim(VDFCLS.NAME)+" added.") End If (nParent <> 0) Begin Clear VDFPROP For_All VDFPROP by Index.1 Constrain VDFPROP.VDFCLS Eq nParent Do Move nPArent To VDFCLS.CODE Find Eq VDFCLS by index.3 Clear ASDB Move nClass To ASDB.VDFCLS Move VDFPROP.NAME To ASDB.NAME Find Eq ASDB by Index.1 Ifnot (found) Begin Clear ASDB Move nClass To ASDB.VDFCLS Move VDFPROP.Type To ASDB.Type Move VDFPROP.NAME To ASDB.NAME Move VDFPROP.VDFCLS To ASDB.PCLASS Move VDFCLS.NAME To ASDB.PCLASSNAME Move VDFPROP.PAR1T To ASDB.PAR1T Move VDFPROP.PAR1 To ASDB.PAR1 Move VDFPROP.PAR2T To ASDB.PAR2T Move VDFPROP.PAR2 To ASDB.PAR2 Move VDFPROP.PAR3T To ASDB.PAR3T Move VDFPROP.PAR3 To ASDB.PAR3 Move VDFPROP.PAR4T To ASDB.PAR4T Move VDFPROP.PAR4 To ASDB.PAR4 Move VDFPROP.PAR5T To ASDB.PAR5T Move VDFPROP.PAR5 To ASDB.PAR5 Move VDFPROP.GETCODE To ASDB.GETCODE Move VDFPROP.SETCODE To ASDB.SETCODE Saverecord ASDB End // if not found End_For_All Clear VDFCLS Move nParent To VDFCLS.CODE Find Eq VDFCLS by Index.3 If ((found)And(bMixin)) Begin If ((VDFCLS.MIXIN1<>0)Or(VDFCLS.MIXIN2<>0)Or(VDFCLS.MIXIN3<>0)Or(VDFCLS.MIXIN4<>0)Or(VDFCLS.MIXIN5<>0)) Send Add_Mixin_Elements nParent 1 nClass End If (bParent) Send AddFromParents nParent nClass End // if parent Loop End End_Procedure End_Object // oOK_bn Object oCancel_bn Is a Button Set Label To "&Close" Set Location To 22 204 Procedure OnClick Send Close_Panel End_Procedure Procedure Update_Button Send Paint End_Procedure End_Object // oCancel_bn Object Textbox1 Is a Textbox Set Label To "This will add your new classes into the " Set Location To 2 3 Set Size To 10 166 Set FontWeight To 800 Set TypeFace To "MS Sans Serif" End_Object // Textbox1 Object Textbox2 Is a Textbox Set Label To "AutoSuggester Database. Run this compiler every" Set Location To 11 3 Set Size To 10 166 Set FontWeight To 800 Set TypeFace To "MS Sans Serif" End_Object // Textbox2 Object Textbox3 Is a Textbox Set Label To "time that you update your classes or descriptors." Set Location To 20 3 Set Size To 10 158 Set FontWeight To 800 Set TypeFace To "MS Sans Serif" End_Object // Textbox3 Object ProgressBar1 Is a cProgressBar #IF (FMAC_VERSION < 8) Set Step_Value To 1 #ELSE Set piAdvanceBy To 1 #ENDIF Set Size To 6 249 Set Location To 109 5 End_Object // ProgressBar1 Object Textbox4 Is a Textbox Set Label To "Compilation progress status." Set Auto_Size_State To False Set Location To 117 4 Set Size To 10 252 Set Justification_Mode To jMode_Center Set TypeFace To "MS Sans Serif" End_Object // Textbox4 Object List1 Is a List Set Dynamic_update_State To False Set Size To 101 251 Set Location To 129 4 Set Border_Style To Border_ClientEdge // **WvA: Added // Hardcore paint, send this message if the object doesn't show you the // value because windows is in a tight loop busy processing things. Procedure vForcePaint Integer hWnd iVoid Move (Window_Handle(Self)) To hWnd If hWnd Begin Moveint (InvalidateRect(hWnd,0,True)) To iVoid Moveint (UpdateWindow (hWnd)) To iVoid End End_Procedure // vForcePaint // **WvA: 14-Apr-2002 Added to show changes immediately Procedure Update_List Integer iDUS Get Dynamic_Update_State To iDUS Set Dynamic_Update_State To True Send ProcessMessages Send vForcePaint If (iDUS <> True) Set Dynamic_Update_State To iDUS End_Procedure // Update_List End_Object // List1 Object Textbox5 Is a Textbox Set Label To "The processing time will depend on the size and complexity of the database." Set Location To 98 5 Set Size To 10 250 Set TypeFace To "MS Sans Serif" End_Object // Textbox5 Object CO1 Is a Group Set Label To " Compiler options: " Set Size To 58 250 Set Location To 38 5 Object CheckBox1 Is a CheckBox Set Label To "Do not include class hierarchy" Set Size To 10 111 Set Location To 10 132 Procedure OnChange Integer bState Get Checked_State To bState If (bState) Set Include_Parents Of oOk_bn To False Else Set Include_Parents Of oOk_bn To True End_Procedure End_Object // CheckBox1 Object CheckBox2 Is a CheckBox Set Label To "Do not process mixin classes" Set Size To 10 107 Set Location To 26 132 Procedure OnChange Integer bState Get Checked_State To bState If (bState) Set Include_Mixin Of oOk_bn To False Else Set Include_Mixin Of oOk_bn To True End_Procedure End_Object // CheckBox2 Object CheckBox3 Is a CheckBox Set Label To "Create Log file" Set Size To 10 62 Set Location To 10 8 Procedure OnChange Integer bState Get Checked_State To bState If (bState) Begin Set Enabled_State Of Form1 To True Set Value Of Form1 Item 0 To "ASDBCLog.txt" Set Status_Log Of oOk_bn To True End Else Begin Set Enabled_State Of Form1 To False Set Status_Log Of oOk_bn To False End End_Procedure End_Object // CheckBox3 Object Form1 Is a Form Set Enabled_State To False Set Size To 13 107 Set Location To 39 8 Procedure OnChange String sVal Get Value Item 0 To sVal Set Status_File Of oOk_bn To sVal End_Procedure End_Object // Form1 Object CheckBox4 Is a CheckBox Set Label To "Process only Basic Classes" Set Size To 10 102 Set Location To 42 132 Procedure OnChange Integer bState Get Checked_State To bState If (bState) Set Only_Basic Of oOk_bn To True Else Set Only_Basic Of oOk_bn To False End_Procedure End_Object // CheckBox4 Object CheckBox5 Is a CheckBox Set Enabled_State To False Set Label To "Log only errors" Set Size To 10 63 Set Location To 25 8 End_Object // CheckBox5 Procedure Update_Group Send Paint End_Procedure End_Object // CO1 // Procedure Update_Panel // **WvA: Don't send Page_Object yourself, it has very nasty side-effects // In this case it GPF-ed the application when called from our setup script. //Broadcast Recursive_Up Send Page_Object True Send Update_List To List1 // Added to get smooth updates on the list. Send Update_Button To oOk_bn Send Update_Button To oCancel_bn Send Update_Group To CO1 End_Procedure // BugFIX, make sure the icon is still being showed // something that doesn't work when the above window style // is set. Procedure Page_Object Boolean bPage Forward Send Page_Object bPage If (bPage) Begin Set Icon to "applications-science-3.ico" End End_Procedure // Page Procedure Popup_Group String sCmd Forward Send Popup_Group CmdLine sCmd Move (Trim(Uppercase(sCmd))) To sCmd // **WvA: Apr 9, 2002 If sCmd Eq "-START" Begin Set pbAutoStart To True Send onClick To (oOK_bn(Self)) Close DF_ALL Send Stop_Modal_UI End End_Procedure End_Object // oASDBC