LOAN 21-Jul-1991 14:08:13 VAX Pascal V4.1-33 Page 1 01 Source Listing 21-Jul-1991 14:08:10 $USERS:[JEREMY.LOAN]LOAN.PAS;101 (1) -LINE-IDC-PL-SL- 00001 C 0 0 {*********************************************************************************************************************************** 00002 C 0 0 * * 00003 C 0 0 * LOAN.PAS Calculate loan repayments * 00004 C 0 0 * * 00005 C 0 0 ***********************************************************************************************************************************} 00006 0 0 [inherit('SYS$LIBRARY:DECW$DWTDEF')] 00007 0 0 Program LOAN (input,output); 00008 0 0 00009 0 0 Label 00010 0 0 Exit; 00011 0 0 00012 0 0 Const 00013 0 0 progname = 'Loan'; 00014 0 0 UIL_file_count = 1; 00015 0 0 DRM_name_count = 6; 00016 0 0 00017 0 0 Type 00018 0 0 strdescr = record 00019 0 0 w_len : [word] 0..65535; 00020 0 0 b_dtype : [byte] 0..255; 00021 0 0 b_class : [byte] 0..255; 00022 0 0 a_pointer : [unsafe] unsigned; 00023 0 0 end; 00024 0 0 00025 0 0 interval_type = [long] (weekly, fortnightly, monthly, bimonthly, quarterly, half_yearly, yearly); 00026 0 0 field_type = [long] (principal, rate, payment); 00027 0 0 00028 0 0 Var 00029 0 0 ret_status : Dwt$Cardinal; 00030 0 0 topLevel, main : Dwt$Widget; 00031 0 0 class : Dwt$DRM_type; 00032 0 0 arglist : array [1..1] of Dwt$Arg; 00033 0 0 argcount : Dwt$Cardinal := 0; 00034 0 0 hierarchy : Dwt$DRM_Hierarchy; 00035 0 0 UIL_filename : [readonly] packed array [1..30] of char := 'loan_display.uid'(0); 00036 0 0 filenames : array [1..UIL_file_count] of ^strdescr; 00037 0 0 ancilliary_filenames : array [1..UIL_file_count] of Dwt$IDBOS_Oparam := Zero; 00038 0 0 callback_names : array [1..DRM_name_count] of Dwt$DRMreg_Arg; 00039 0 0 00040 0 0 input_fields : array [principal..payment] of record 00041 0 0 widget : Dwt$Widget; 00042 0 0 name : varying [30] of char; 00043 0 0 end; 00044 0 0 00045 0 0 list_box : Dwt$Widget; 00046 0 0 00047 0 0 selected_interval : interval_type := monthly; 00048 0 0 interval_number : integer := 0; 00049 0 0 00050 0 0 initial_loan : integer; { Initial amount of loan (Principal) } LOAN 21-Jul-1991 14:08:13 VAX Pascal V4.1-33 Page 2 01 Source Listing 21-Jul-1991 14:08:10 $USERS:[JEREMY.LOAN]LOAN.PAS;101 (1) -LINE-IDC-PL-SL- 00051 0 0 current_value : double; { Remaining amount to be repayed } 00052 0 0 interest_rate : double; { Interest rate, per annum } 00053 0 0 interval_rate : double; { Interest rate, per interval } 00054 0 0 repayment_amount : double; { Amount to be repaid each interval } 00055 0 0 total_paid : double; { Total amount repaid } 00056 0 0 00057 C 0 0 {*********************************************************************************************************************************** 00058 C 0 0 * 00059 C 0 0 * Utility Routines 00060 C 0 0 * 00061 C 0 0 } 00062 C 0 0 {------------------------------------------------------------------------------ 00063 C 0 0 Store a name/value pair for DRM REGISTER NAMES 00064 C 0 0 } 00065 1 0 procedure register_name (var rname : [readonly] packed array [l..h:integer] of char; 00066 1 0 rvalue : unsigned; 00067 1 0 var reg : Dwt$DRMreg_Arg); 00068 1 0 var p : record case integer of 00069 1 0 1 : ( i : unsigned); 00070 1 0 2 : ( s : Dwt$Strng); 00071 1 0 end; 00072 1 1 begin 00073 1 1 p.i := iaddress(rname); 00074 1 1 reg.Dwt$A_DRMr_name := p.s; 00075 1 1 reg.Dwt$L_DRMr_value := rvalue; 00076 0 0 end; 00077 0 0 00078 C 0 0 {------------------------------------------------------------------------------ 00079 C 0 0 Get the address of the first character in a string 00080 C 0 0 } 00081 1 0 function string_address (var str : [readonly] packed array [l..h:integer] of char) : integer; 00082 1 1 begin 00083 1 1 string_address := iaddress(str); 00084 0 0 end; 00085 0 0 00086 0 0 00087 C 0 0 {------------------------------------------------------------------------------ 00088 C 0 0 Convert an input field value to an integer 00089 C 0 0 } 00090 1 0 function integer_value (f : field_type; var iv: integer) : boolean; 00091 1 0 var s : packed array [1..10] of char; 00092 1 0 i,l : integer; 00093 1 1 begin 00094 1 1 Dwt$S_Text_Get_String (input_fields[f].widget, s, l); { Get the string value of the text widget } 00095 1 1 if l > 0 then 00096 1 2 begin 00097 1 2 readv(substr(s,1,l), i, error:=continue); { Convert it to a number } 00098 1 2 if statusv <> 0 then 00099 1 3 begin 00100 1 3 writeln('Error converting string to integer for field ',input_fields[f].name); 00101 1 3 integer_value := false; 00102 1 3 end 00103 1 2 else 00104 1 3 begin LOAN 21-Jul-1991 14:08:13 VAX Pascal V4.1-33 Page 3 01 Source Listing 21-Jul-1991 14:08:10 $USERS:[JEREMY.LOAN]LOAN.PAS;101 (1) -LINE-IDC-PL-SL- 00105 1 3 if i < 1 then 00106 1 4 begin 00107 1 4 writeln('Value for ',input_fields[f].name,' must be a positive number!'); 00108 1 4 integer_value := false; 00109 1 4 end 00110 1 3 else 00111 1 4 begin 00112 1 4 iv := i; 00113 1 4 integer_value := true; 00114 1 4 end 00115 1 2 end; 00116 1 2 end 00117 1 1 else 00118 1 2 begin 00119 1 2 writeln('A value for ', input_fields[f].name,' is required.'); 00120 1 2 integer_value := false; 00121 1 2 end 00122 0 0 end; 00123 0 0 00124 0 0 00125 0 0 00126 C 0 0 {------------------------------------------------------------------------------ 00127 C 0 0 Convert an input field value to an double-precision value 00128 C 0 0 } 00129 1 0 function double_value (f : field_type; var dv: double) : boolean; 00130 1 0 var s : packed array [1..10] of char; 00131 1 0 l : integer; 00132 1 0 d : double; 00133 1 1 begin 00134 1 1 Dwt$S_Text_Get_String (input_fields[f].widget, s, l); { Get the string value of the text widget } 00135 1 1 if l > 0 then 00136 1 2 begin 00137 1 2 readv(substr(s,1,l), d, error:=continue); { Convert it to a number } 00138 1 2 if statusv <> 0 then 00139 1 3 begin 00140 1 3 writeln('Error converting string value for field ',input_fields[f].name); 00141 1 3 double_value := false; 00142 1 3 end 00143 1 2 else 00144 1 3 begin 00145 1 3 if d < 1 then 00146 1 4 begin 00147 1 4 writeln('Value for ',input_fields[f].name,' must be a positive number!'); 00148 1 4 double_value := false; 00149 1 4 end 00150 1 3 else 00151 1 4 begin 00152 1 4 dv := d; 00153 1 4 double_value := true; 00154 1 4 end 00155 1 2 end; 00156 1 2 end 00157 1 1 else 00158 1 2 begin 00159 1 2 writeln('A value for ', input_fields[f].name,' is required.'); LOAN 21-Jul-1991 14:08:13 VAX Pascal V4.1-33 Page 4 01 Source Listing 21-Jul-1991 14:08:10 $USERS:[JEREMY.LOAN]LOAN.PAS;101 (1) -LINE-IDC-PL-SL- 00160 1 2 double_value := false; 00161 1 2 end 00162 0 0 end; 00163 0 0 00164 C 0 0 {*********************************************************************************************************************************** 00165 C 0 0 * 00166 C 0 0 * Widget Callbacks 00167 C 0 0 * 00168 C 0 0 } 00169 0 0 00170 C 0 0 { Repayment Interval menu } 00171 1 0 Procedure Set_Interval (widget: Dwt$Widget; interval: interval_type; reason: Dwt$Any_CB_St); 00172 1 1 begin 00173 1 1 writeln ('in Set_Interval; selected interval = ', interval); 00174 1 1 selected_interval := interval; 00175 0 0 end; 00176 0 0 00177 0 0 00178 1 0 Procedure Text_Value_Changed (widget: Dwt$Widget; field: field_type; reason: Dwt$Any_CB_St); 00179 1 1 begin 00180 1 1 writeln('in Text_Value_Changed; field = ',field); 00181 0 0 end; 00182 0 0 00183 C 0 0 { List Box } 00184 1 0 Procedure Create_List_Box (widget: Dwt$Widget); 00185 1 1 begin 00186 1 1 writeln('in Create_List_Box'); 00187 1 1 list_box := widget; 00188 0 0 end; 00189 0 0 00190 C 0 0 { Quit button } 00191 1 0 Procedure Quit; 00192 1 1 begin 00193 1 1 writeln('in Quit'); 00194 1 1 goto Exit; 00195 0 0 end; 00196 0 0 00197 0 0 00198 1 0 Procedure Create_Data_Field (widget: Dwt$Widget; f: field_type; reason: Dwt$Any_CB_St); 00199 1 1 begin 00200 1 1 writeln('in Create_Data_Field'); 00201 1 1 input_fields[f].widget := widget; 00202 0 0 end; 00203 0 0 00204 0 0 00205 C 0 0 { Work procedure } 00206 1 0 Function Calculate_One_Interval {(var loan_status : loan_rec)} : boolean; 00207 1 0 var s : varying [40] of char; 00208 1 0 cs : Dwt$Comp_String; 00209 1 0 actual_repayment : double; 00210 1 0 new_value : double; 00211 1 0 insufficient : boolean; 00212 1 0 00213 1 1 begin LOAN 21-Jul-1991 14:08:13 VAX Pascal V4.1-33 Page 5 01 Source Listing 21-Jul-1991 14:08:10 $USERS:[JEREMY.LOAN]LOAN.PAS;101 (1) -LINE-IDC-PL-SL- 00214 C 1 1 { Make the repayment } 00215 1 1 new_value := (current_value * interval_rate) - repayment_amount; 00216 1 1 insufficient := new_value >= current_value; 00217 1 1 if new_value >= 0 then 00218 1 1 actual_repayment := repayment_amount 00219 1 1 else 00220 1 2 begin 00221 1 2 actual_repayment := new_value + repayment_amount; 00222 1 2 new_value := 0; 00223 1 1 end; 00224 1 1 current_value := new_value; 00225 1 1 total_paid := total_paid + actual_repayment; 00226 1 1 interval_number := interval_number + 1; 00227 1 1 00228 C 1 1 { Display the result } 00229 1 1 writev(s,interval_number:3,current_value:16:2,total_paid:11:2); 00230 1 1 Dwt$Latin1_String(s,cs); 00231 1 1 Dwt$List_Box_Add_Item(list_box, cs, 0); 00232 1 1 Dwt$List_Box_Set_Pos(list_box, interval_number); 00233 1 1 Xt$Free (cs); 00234 1 1 Calculate_One_Interval := (current_value <= 0.0) or insufficient; 00235 0 0 end; 00236 0 0 00237 0 0 00238 C 0 0 { Calculate Button } 00239 1 0 Procedure Calculate_Button_Pressed; 00240 1 0 var s : varying [10] of char; 00241 1 0 i : integer; 00242 1 0 work_proc : Dwt$Work_Proc; 00243 1 0 client_data : Dwt$Opaque; 00244 1 0 args : array [1..2] of dwt$arg; 00245 1 1 begin 00246 1 1 writeln('in Calculate_Button_Pressed'); 00247 1 1 if integer_value(principal, initial_loan) and double_value(rate, interest_rate) and double_value(payment, repayment_amount) then 00248 1 2 begin 00249 1 2 total_paid := 0.0; 00250 1 2 current_value := initial_loan; 00251 1 2 interest_rate := round(interest_rate*100) / 100.0; { Only two decimal places, eg 17.205% -> 17.21 } 00252 1 2 repayment_amount := round(repayment_amount*100) / 100.0; { Repayments to nearest cent } 00253 1 3 case selected_interval of 00254 1 3 weekly : interval_rate := interest_rate/365 * 7; 00255 1 3 fortnightly : interval_rate := interest_rate/365 * 14; 00256 1 3 monthly : interval_rate := interest_rate/12; 00257 1 3 bimonthly : interval_rate := interest_rate/6; 00258 1 3 quarterly : interval_rate := interest_rate/4; 00259 1 3 half_yearly : interval_rate := interest_rate/2; 00260 1 3 yearly : interval_rate := interest_rate; 00261 1 2 end; {case} 00262 1 2 interval_rate := 1 + interval_rate/100; 00263 1 2 00264 C 1 2 { Clear out the old entries in the list box } 00265 1 2 if interval_number > 0 then 00266 1 3 begin 00267 1 3 i := string_address('items'(0)); LOAN 21-Jul-1991 14:08:13 VAX Pascal V4.1-33 Page 6 01 Source Listing 21-Jul-1991 14:08:10 $USERS:[JEREMY.LOAN]LOAN.PAS;101 (1) -LINE-IDC-PL-SL- 00268 1 3 args[1].dwt$a_arg_name := i::Dwt$Strng; 00269 1 3 args[1].dwt$l_arg_value := 0; 00270 1 3 i := string_address('itemsCount'(0)); 00271 1 3 args[2].dwt$a_arg_name := i::Dwt$Strng; 00272 1 3 args[2].dwt$l_arg_value := 0; 00273 1 3 Xt$Set_Values (list_box, args, 2); 00274 1 3 interval_number := 0; 00275 1 2 end; 00276 1 2 00277 C 1 2 { Update the input fields to reflect the values in use } 00278 1 2 writev(s,initial_loan:1); Dwt$S_Text_Set_String (input_fields[principal].widget, s); 00279 1 2 writev(s,interest_rate:1:2); Dwt$S_Text_Set_String (input_fields[rate].widget, s); 00280 1 2 writev(s,repayment_amount:1:2); Dwt$S_Text_Set_String (input_fields[payment].widget, s); 00281 1 2 00282 1 2 i := iaddress(Calculate_One_Interval); 00283 1 2 work_proc := i::Dwt$Work_Proc; 00284 1 2 client_data := i::Dwt$Opaque; 00285 1 2 Xt$Add_Work_Proc (work_proc, client_data); 00286 1 2 00287 1 1 end; 00288 0 0 end; 00289 0 0 00290 0 0 00291 C 0 0 {**********************************************************************************************************************************} 00292 0 0 00293 0 1 Begin 00294 C 0 1 { Initialize local data structures } 00295 0 1 input_fields[principal].name := 'Loan'; 00296 0 1 input_fields[rate].name := 'Interest Rate'; 00297 0 1 input_fields[payment].name := 'Repayment'; 00298 0 1 00299 0 1 00300 C 0 1 { Initialize UIL/DRM } 00301 0 1 Dwt$Initialize_DRM; 00302 0 1 00303 C 0 1 { Initialize the Toolkit } 00304 0 1 topLevel := Xt$Initialize (progname, progname, 0, 0, argcount,); 00305 0 1 if topLevel = nil then 00306 0 2 begin 00307 0 2 writeln('Error creating topLevel'); 00308 0 2 goto Exit 00309 0 1 end; 00310 0 1 00311 C 0 1 { Open the UIL/DRM Hierarchy } 00312 0 1 new(filenames[1]); 00313 0 1 with filenames[1]^ do 00314 0 2 begin 00315 0 2 w_len := length(UIL_filename); 00316 0 2 b_dtype := 14; { DSC$K_DTYPE_T } 00317 0 2 b_class := 1; { DSC$K_CLASS_S } 00318 0 2 a_pointer := iaddress(UIL_filename); 00319 0 1 end; 00320 0 1 ret_status := Dwt$Open_Hierarchy (UIL_file_count, filenames, %immed 0, hierarchy); 00321 0 1 if ret_status <> DWT$C_DRM_SUCCESS then LOAN 21-Jul-1991 14:08:13 VAX Pascal V4.1-33 Page 7 01 Source Listing 21-Jul-1991 14:08:10 $USERS:[JEREMY.LOAN]LOAN.PAS;101 (1) -LINE-IDC-PL-SL- 00322 0 2 begin 00323 0 2 writeln('Error opening UIL files'); 00324 0 2 goto Exit 00325 0 1 end; 00326 0 1 00327 C 0 1 { Register names with DRM } 00328 0 1 register_name ('SET_INTERVAL'(0), iaddress(Set_Interval), callback_names[1]); 00329 0 1 register_name ('CREATE_DATA_FIELD'(0), iaddress(Create_Data_Field), callback_names[2]); 00330 0 1 register_name ('TEXT_VALUE_CHANGED'(0), iaddress(Text_Value_Changed), callback_names[3]); 00331 0 1 register_name ('CALCULATE_BUTTON_PRESSED'(0), iaddress(Calculate_Button_Pressed), callback_names[4]); 00332 0 1 register_name ('QUIT'(0), iaddress(Quit), callback_names[5]); 00333 0 1 register_name ('CREATE_LIST_BOX'(0), iaddress(Create_List_Box), callback_names[6]); 00334 0 1 ret_status := Dwt$Register_DRM_Names (callback_names, DRM_name_count); 00335 0 1 if ret_status <> DWT$C_DRM_SUCCESS then 00336 0 2 begin 00337 0 2 writeln('Failed to register DRM names'); 00338 0 2 goto Exit 00339 0 1 end; 00340 0 1 00341 0 1 00342 C 0 1 { Fetch and manage the widget tree } 00343 0 1 ret_status := Dwt$Fetch_Widget (hierarchy, 'MAIN', topLevel, main, class); 00344 0 1 if ret_status <> DWT$C_DRM_SUCCESS then 00345 0 2 begin 00346 0 2 writeln('Error fetching widgets'); 00347 0 2 goto Exit 00348 0 1 end; 00349 0 1 00350 0 1 00351 0 1 Xt$Manage_Child (main); 00352 0 1 00353 0 1 Xt$Realize_Widget (topLevel); 00354 0 1 00355 0 1 Xt$Main_Loop; 00356 0 1 00357 0 1 Exit: 00358 0 0 end. 00359 0 0 LOAN 21-Jul-1991 14:08:13 VAX Pascal V4.1-33 Page 8 01 Pascal Compilation Statistics 21-Jul-1991 14:08:10 $USERS:[JEREMY.LOAN]LOAN.PAS;101 (1) PSECT SUMMARY Name Bytes Attributes $CODE 4965 NOVEC,NOWRT, RD, EXE, SHR, LCL, REL, CON, PIC,ALIGN(2) $LOCAL 188 NOVEC, WRT, RD,NOEXE,NOSHR, LCL, REL, CON, PIC,ALIGN(2) ENVIRONMENT STATISTICS -------- Symbols -------- File Total Loaded Percent SYS$COMMON:[SYSLIB]DECW$DWTDEF.PEN;1 5680 222 4 COMMAND QUALIFIERS PASCAL/CHECK/NOOPTIMIZE/LIST/DEB LOAN /CHECK=(BOUNDS,CASE_SELECTORS,DECLARATIONS,OVERFLOW,POINTERS,SUBRANGE) /DEBUG=(SYMBOLS,TRACEBACK) /NODESIGN /SHOW=(DICTIONARY,INCLUDE,NOINLINE,HEADER,SOURCE,STATISTICS,TABLE_OF_CONTENTS) /NOOPTIMIZE /STANDARD=NONE /TERMINAL=(NOFILE_NAME,NOROUTINE_NAME,NOSTATISTICS) /USAGE=(NOUNUSED,UNINITIALIZED,NOUNCERTAIN) /NOANALYSIS_DATA /NOENVIRONMENT /LIST=$USERS:[JEREMY.LOAN]LOAN.LIS;101 /OBJECT=$USERS:[JEREMY.LOAN]LOAN.OBJ;87 /NOCROSS_REFERENCE /ERROR_LIMIT=30 /NOG_FLOATING /NOMACHINE_CODE /NOOLD_VERSION /WARNINGS COMPILER INTERNAL TIMING Phase Faults CPU Time Elapsed Time Initialization 128 00:00.2 00:00.8 Source Analysis 598 00:01.5 00:05.8 Source Listing 53 00:00.4 00:00.6 Tree Construction 89 00:00.3 00:00.7 Flow Analysis 0 00:00.0 00:00.0 Value Propagation 0 00:00.0 00:00.0 Profit Analysis 0 00:00.0 00:00.0 Context Analysis 268 00:01.5 00:01.9 Name Packing 1 00:00.1 00:00.2 Code Selection 68 00:00.5 00:00.6 Final 58 00:00.8 00:01.1 TOTAL 1267 00:05.4 00:11.8 COMPILATION STATISTICS CPU Time: 00:05.4 (3960 Lines/Minute) Elapsed Time: 00:11.8 Page Faults: 1267 LOAN 21-Jul-1991 14:08:13 VAX Pascal V4.1-33 Page 9 01 Pascal Compilation Statistics 21-Jul-1991 14:08:10 $USERS:[JEREMY.LOAN]LOAN.PAS;101 (1) Pages Used: 1628 Compilation Complete