1 /* The original DTEXT.TXT is 271280 bytes; at 80 chars a record, 3391 records */
  2 
  3 dtext_module: proc;
  4 
  5 dcl ioa_ entry options (variable);
  6 dcl hcs_$initiate entry (char(*), char(*), char(*), fixed bin(1), fixed bin(2), ptr, fixed bin(35));
  7 dcl hcs_$terminate_noname entry (ptr, fixed bin(35));
  8 
  9 dcl get_wdir_ entry () returns (char (168) aligned);
 10 dcl sub_err_ entry() options(variable);
 11 
 12 dcl dtext_ptr ptr static init (null);
 13 dcl old_dtext (3391) char (80) based (dtext_ptr);
 14 dcl 1 dtext aligned based (dtext_ptr),
 15   2 record (3391),
 16     3 key fixed bin (35),
 17     3 chars char(76);
 18 dcl dtext_words (67820) bit (36) based (dtext_ptr);
 19 dcl word0 bit (36) based (dtext_ptr);
 20 
 21 dcl code fixed bin (35);
 22 dcl dir_name char (168);
 23 dcl entryname char (168);
 24 dcl ldn fixed bin;
 25 dcl null builtin;
 26 dcl hcs_$fs_get_path_name entry (ptr, char(*), fixed bin, char(*), fixed bin(35));
 27 dcl pathname_ entry (char(*), char(*)) returns(char(168));
 28 
 29 open: entry;
 30 
 31     dtext_ptr = null ();
 32     call hcs_$fs_get_path_name (codeptr(open), dir_name, ldn, entryname, code);
 33     if code ^= 0 then do;
 34         call sub_err_ (code, "dungeon", "Getting path to dungeon");
 35         stop;
 36     end;
 37 
 38     call hcs_$initiate (dir_name, "DTEXT.DAT", "", 0, 0, dtext_ptr, code);
 39     if dtext_ptr = null () then do;
 40       call sub_err_ (code, "initiate failed");
 41       stop;
 42     end;
 43 /*
 44     call ioa_ ("debug ^o ^o ^o ^o", dtext_words (1), dtext_words (2), dtext_words (3), dtext_words (4));
 45     call ioa_ ("in open ^o ^o ^o ^o ^o", word0, substr (old_dtext(1), 1, 1), substr (old_dtext(1), 2, 1), substr (old_dtext(1), 3, 1), substr (old_dtext(1), 4, 1));
 46     call ioa_ ("in open ^o ^o ^o ^o ^o", word0, substr (old_dtext(1), 5, 1), substr (old_dtext(1), 6, 1), substr (old_dtext(1), 7, 1), substr (old_dtext(1), 8, 1));
 47     call ioa_ ("in open ^o ^o ^o ^o ^o", word0, substr (dtext.record(1).chars, 1, 1), substr (dtext.record(1).chars, 2, 1), substr (dtext.record(1).chars, 3, 1), substr (dtext.record(1).chars, 4, 1));
 48 */
 49 
 50     return;
 51 
 52 dindx_path: entry (buffer);
 53 
 54     call hcs_$fs_get_path_name (codeptr(open), dir_name, ldn, entryname, code);
 55     if code ^= 0 then do;
 56         call sub_err_ (code, "dungeon", "Getting path to dungeon");
 57         stop;
 58     end;
 59 
 60     buffer = pathname_ (dir_name, "DINDX.DAT");
 61     return;
 62 
 63 read: entry (rec_num, key, buffer);
 64 
 65     dcl rec_num fixed bin (35),
 66         key fixed bin (35),
 67         buffer char(*);
 68 
 69     key = dtext.record(rec_num).key;
 70     buffer = dtext.record(rec_num).chars;
 71 /*
 72     call ioa_ ("key ^d", key);
 73     call ioa_ ("in read ^o ^o ^o ^o ^o", word0, substr (buffer, 1, 1), substr (buffer, 2, 1), substr (buffer, 3, 1), substr (buffer, 4, 1));
 74 */
 75     return;
 76 
 77 close: entry;
 78     call hcs_$terminate_noname (dtext_ptr, code);
 79     return;
 80 
 81 
 82 itime: entry (time);
 83     dcl time (3) fixed bin (35);
 84 
 85 
 86 
 87     dcl clock_ entry returns (fixed bin(71));
 88     dcl date_time_$from_clock entry (fixed bin(71), char(*), ptr, fixed bin(35));
 89 
 90     dcl 1 tv like time_value;
 91 
 92     tv.version = Vtime_value_3;
 93     call date_time_$from_clock (clock_ (), "", addr(tv), code);
 94 
 95     if code ^= 0
 96     then do;
 97       call sub_err_ (code, "from_clock failed");
 98     end;
 99 
100     time(1) = tv.Hd;
101     time(2) = tv.MH;
102     time(3) = tv.SM;
103     return;
104 
105 idate: entry (y, m, d);
106     dcl y fixed bin (35);
107     dcl m fixed bin (35);
108     dcl d fixed bin (35);
109 
110     tv.version = Vtime_value_3;
111     call date_time_$from_clock (clock_ (), "", addr(tv), code);
112 
113     if code ^= 0
114     then do;
115       call sub_err_ (code, "from_clock failed");
116     end;
117 
118     y = tv.yc;
119     m = tv.my;
120     d = tv.dm;
121     return;
122 
123 %include time_value;
124 end dtext_module;
125