<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">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 &gt; 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 &lt;&gt; 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 &lt; 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 &gt; 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 &lt;&gt; 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 &lt; 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 &gt;= current_value;
00217      1  1   if new_value &gt;= 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 &lt;= 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% -&gt; 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 &gt; 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 &lt;&gt; 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 &lt;&gt; 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 &lt;&gt; 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
</pre></body></html>