1// ********************************************************
2//  Copyright (c) 2016 Rob Judd <judd@ob-wan.com>
3//  Based on C version by Charles Childers et al
4//  ISC License - see included file LICENSE
5//  Minor adjustments by Charles Childers, 2018
6// ********************************************************
7
8program listener;
9
10{$mode objfpc}{$H+}
11{$macro on}
12
13uses
14  SysUtils, bridge in 'bridge.pas', nga in 'nga.pas';
15
16{$include 'nga.inc'}
17
18const
19  TIB       = 1471;
20
21//implementation
22
23procedure include_file(fname : PChar);
24var
25  source : array[0..65535] of Char;
26  fp : File of Char;
27  f : THandle;
28begin
29  f := FileOpen(fname, fmOpenRead);
30  if f <> THandle(-1) then
31  begin
32    writeln('+ load ', fname);
33    Assign(fp, fname);
34    Reset(fp);
35    while not eof(fp) do
36    begin
37      read_token(fp, source);
38      evaluate(source);
39    end;
40    Close(fp);
41  end;
42  FileClose(f);
43end;
44
45procedure dump_stack();
46var
47  i : Cell;
48begin
49  write('Stack: ');
50  for i := 1 to sp do
51    if i = sp then
52      write(format('< %d >', [data[i]]))
53    else
54      write(format('%d ', [data[i]]));
55  writeln();
56end;
57
58procedure prompt();
59begin
60  if memory[Compiler] = 0 then
61    write(LineEnding, 'ok  ');
62end;
63
64
65// ********************************************************
66//  Main program
67// ********************************************************
68var
69  input : array[0..1023] of Char;
70  i, n : Cell;
71begin
72  ngaPrepare();
73  n := ngaLoadImage('ngaImage');
74  if n = 0 then
75    exit();
76  update_rx();
77  writeln(format('RETRO 12 (rx-%d.%d)', [memory[4] div 100, memory[4] mod 100]));
78  //include_file('retro.forth');
79  writeln(format('%d MAX, TIB @ %d, Heap @ %d', [IMAGE_SIZE, TIB, Heap]));
80  writeln();
81  while true do
82  begin
83    prompt();
84    Dictionary := memory[2];
85    read_token(input);
86    if strcomp(input, 'bye') = 0 then
87    begin
88      exit();
89    end
90    else if strcomp(input, 'words') = 0 then
91    begin
92      i := Dictionary;
93      while i <> 0 do
94      begin
95        string_extract(d_name(i));
96        write(format('%s  ', [string_data]));
97        i := memory[i];
98      end;
99      writeln(format('(%d entries)', [d_count_entries(Dictionary)]));
100    end
101    else if strcomp(input, '.p') = 0 then
102      writeln(format('__%s__', [string_extract(data[sp])]))
103    else if strcomp(input, '.s') = 0 then
104      dump_stack()
105    else
106      evaluate(input);
107  end;
108end.
109
110