diff tests/agcl/oldagsrc/scr4d.syn @ 0:13d2b8934445

Import AnaGram (near-)release tree into Mercurial.
author David A. Holland
date Sat, 22 Dec 2007 17:52:45 -0500
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/agcl/oldagsrc/scr4d.syn	Sat Dec 22 17:52:45 2007 -0500
@@ -0,0 +1,746 @@
+{
+/*
+   AnaGram Syntax Analyzer. Copyright (c) Jerome T. Holland, 1989, 1990, 1991.
+   All Rights Reserved.
+*/
+
+#include HEADERS
+#include PF
+
+#include STDLIB
+#include DATA
+#include ASSERT
+#include MYALLOC
+#include ARRAYS
+#include SP
+#include SCREEN
+#include STK
+#include SCR4D
+#include SETJMP
+#include STDARG
+#include STDIO
+#include WIN
+/* #include DIRECT */
+#include DEMO
+
+dc          *activate_window(dc *);
+void         bury_top_image(void);
+int          chdir_s1(char*);
+dc          *check_selection(dc *);
+dc          *clear_mode(dc *);
+int          display_line_number(int);
+extern dc   *edit_window;
+void         force_screen_real(void);
+void         hide_cursor(void);
+dc          *prt(dc*);
+extern dc   *quick_ref_display;
+void         remove_ghost(dc *);
+dc          *open_windows(dc *);
+dc          *resize_window_mode(dc *);
+void         set_work_dir(void);
+void         update_screen(dc *);
+dc          *window_move(dc *);
+int          wkb(void);
+void         xeq_qa(void);
+
+extern long current_date, expiration_date;
+
+
+scr_pcb_type scr_pcb;
+#define PCB scr_pcb
+
+#define GET_INPUT PCB.input_code = wkb()
+#define PARSE_STACK_OVERFLOW myabort();
+#define SYNTAX_ERROR
+
+
+extern rect mode_area;
+extern rect position_area;
+extern cint current_cursor;
+
+extern dc *active_dc;
+extern dc *cmnd_map_display;
+extern dc *file_pick_display;
+extern dc *help_index;
+extern dc *pick_list_display;
+extern dc *quick_ref_display;
+extern dc *window_menu_display;
+
+extern int n_windows;
+extern char *string_base;
+
+extern char *current_mode_string;
+
+void sbeep(void);
+
+}
+
+[
+ ~declare pcb
+ ~diagnose errors
+ ~lines and columns
+ ~error frame
+ ~default reductions
+  line numbers
+  parser name = scr
+  test range
+  default token type = int
+  nest comments
+  event driven
+  near functions
+]
+
+CURSOR UP          = 328
+page up            = 329
+CURSOR LEFT        = 331
+CURSOR RIGHT       = 333
+CURSOR DOWN        = 336
+page down          = 337
+control page up    = 388
+control page down  = 374
+control left       = 371
+control right      = 372
+home               = 327
+control home       = 375
+end                = 335
+control end        = 373
+escape              = 27
+return              = '\r'
+control w           =23
+control z           =26
+
+F1                 = 315
+F2                 = 316
+F3                 = 317
+F4                 = 318
+F5                 = 319
+F6                 = 320
+F7                 = 321
+F8                 = 322
+F9                 = 323
+F10                = 324
+
+SHFT F1            = 340
+SHFT F2            = 341
+SHFT F3            = 342
+SHFT F4            = 343
+SHFT F5            = 344
+SHFT F6            = 345
+SHFT F7            = 346
+SHFT F8            = 347
+SHFT F9            = 348
+SHFT F10           = 349
+
+CTRL F1            = 350
+CTRL F2            = 351
+CTRL F3            = 352
+CTRL F4            = 353
+CTRL F5            = 354
+CTRL F6            = 355
+CTRL F7            = 356
+CTRL F8            = 357
+CTRL F9            = 358
+CTRL F10           = 359
+
+ALT F1             = 360
+ALT F2             = 361
+ALT F3             = 362
+ALT F4             = 363
+ALT F5             = 364
+ALT F6             = 365
+ALT F7             = 366
+ALT F8             = 367
+ALT F9             = 368
+ALT F10            = 369
+
+ALT 3              = 378
+
+ALT G              = 290
+ALT L              = 294
+ALT N              = 305
+ALT P              = 281
+ALT R              = 275
+ALT S              = 287
+ALT T              = 276
+ALT X              = 301
+delete             = 339
+
+pick file          = 256
+init string edit   = 257
+out of time        = 258
+
+up =    CURSOR UP
+down =  CURSOR DOWN
+left =  CURSOR LEFT
+right = CURSOR RIGHT
+
+move = F2
+reduce = ALT F2
+
+backspace         = '\b'
+
+enter line number  = ALT L
+help               = F1
+req help index     = ALT F1
+req key assign     = SHFT F1
+req cursor assign  = CTRL F1
+print table        = ALT P
+exit               = ALT X
+search previous    = F3
+create key         = ALT S
+
+search next        = F4
+bury               = F5
+bottom             = F6
+clone window       = F7
+cycle clone        = ALT F7
+req plane menu     = ALT F8
+previous           = F8
+req w menu         = F9
+req c menu         = F10
+req aux win menu   = ALT F9
+req aux cmnd menu  = ALT F10
+{
+#define F1                  315
+#define F2                  316
+#define F3                  317
+#define F4                  318
+#define F5                  319
+#define F6                  320
+#define F7                  321
+#define F8                  322
+#define F9                  323
+#define F10                 324
+#define ALT_F1              360
+#define ALT_F2              361
+#define ALT_F3              362
+#define ALT_F4              363
+#define ALT_F5              364
+#define ALT_F6              365
+#define ALT_F7              366
+#define ALT_F8              367
+#define ALT_F9              368
+#define ALT_F10             369
+
+#define move_code  F2
+#define reduce ALT_F2
+#define left   331
+#define right  333
+
+}
+
+text char = 32..127
+digit = '0-9'
+
+[
+  default token type = dc *
+  default input type = int
+]
+
+(void) edit session $
+ -> any window, quit
+ -> change directory, any edit string, exit
+ -> session complete
+ -> quit =naughty();
+
+(void) quit
+ -> exit
+ -> any search key, exit
+ -> line number, exit
+
+begin
+ -> req c menu    =check_expiration();
+
+any search key
+ -> search key
+ -> adjust search key
+
+any edit string
+ -> edit string
+ -> adjust edit string
+
+{
+
+#ifdef DEMO_FLAG
+void restrict_usage(void);
+
+dc *check_expiration(void) {
+		long *ex = &expiration_date + 47;
+		long *cd = &current_date + 252;
+    if (ex[-47] < cd[-252]) restrict_usage();
+    return NULL;
+ }
+#else
+dc *check_expiration(void) {return NULL;}
+#endif
+
+}
+
+window
+ -> begin                   =activate_cmnd_menu();
+ -> any window, req c menu  =pop_up_window(cmnd_map_display);
+ -> any window, req w menu  =pop_up_window(window_menu_display);
+ -> any window, '?'         =pop_up_window(quick_ref_display);
+ -> change directory,
+      edit string:w, escape =rcs(), search_flag--, quit_window(w);
+
+any window
+ -> window:w                =check_expiration(),w;
+ -> adjust window:w         =check_expiration(),w;
+
+window, session complete, change directory
+ -> any window:d, return                        =(*d->enter)(d);
+
+{
+void set_mode(char *);
+
+dc *replace_window(dc *d, dc *new);
+dc *pop_up_window(dc *d);
+
+}
+
+(int) specify line number
+ -> line number:n, return                  =end_line_number_mode(n);
+
+{
+static int end_line_number_mode(int n){
+  flash_str_fill(mode_area.pos,current_mode_string,0,mode_area.size.x);
+  return n;
+}
+}
+
+(int) specify lines back
+ -> line number:n, up + '-'            =end_line_number_mode(n);
+
+
+(int) specify lines forward
+ -> line number:n, down + '+'          =end_line_number_mode(n);
+
+(int) line number
+ -> enter line number                     =line_number_1();
+ -> line number:n, digit:d                =line_number_2(n,d);
+ -> line number:n, backspace              =line_number_3(n);
+ -> line number:n, delete                 =line_number_3(n);
+{
+static dc *reset_position_window(dc *d) {
+  flash_str_fill(mode_area.pos,current_mode_string,0,mode_area.size.x);
+  current_cursor.x = -1;
+  return d;
+}
+
+static int line_number_1(void) {
+  flash_str_fill(mode_area.pos,"Line Number",0,mode_area.size.x);
+  return 0;
+}
+
+static int line_number_2(int n, int d) {
+  return display_line_number(10*n+d-48);
+}
+static int line_number_3(int n) {
+  return display_line_number(n/10);
+}
+
+dc *find_help(char *);
+dc *pop_up_window(dc *);
+
+static dc *key_assign(dc *dm, char *title) {
+  dc *d = find_help(title);
+  if (d == NULL) return beep(dm);
+  return pop_up_window(d);
+}
+}
+
+window
+ -> window:w, escape                      =quit_window(w);
+ -> any window:w, help                    =help_window(w);
+ -> any window, req help index            =pop_up_window(help_index);
+ -> any window:w, req key assign          =key_assign(w,"Function Keys");
+ -> any window:w, req cursor assign       =key_assign(w,"Cursor Keys");
+ -> any window:w, print table             =prt(w);
+
+ -> window:w, control key:k               =cursor(w,k);
+ -> previous window
+ -> bottom window
+ -> bury window
+ -> adjust window, escape
+ -> adjust window:w, non cursor key:k     =control(w,k);
+ -> any window:w, search forward          =search_forward(w);
+ -> any window:w, search reverse          =search_reverse(w);
+ -> any window:w, text char - '?':c       =alpha_access(w,c);
+ -> any window, edit search key
+
+ -> any window:w, specify line number:n   =reposition_cursor(w,n);
+ -> any window:w, specify lines back:n    =backup_cursor(w,n);
+ -> any window:w, specify lines forward:n =advance_cursor(w,n);
+ -> any window:w, line number, escape     =reset_position_window(w);
+
+ -> any window:w, clone window            =clone_window(w);
+
+ -> any window:w, cycle clone             =cycle_clone(w);
+ -> any window:w, req aux win menu        =pop_up_aux_win_menu(w);
+ -> any window:w, req aux cmnd menu       =pop_up_aux_cmnd_menu(w);
+ -> any window:w, req plane menu          =open_windows(w);
+
+{
+dc *pop_up_aux_win_menu(dc *);
+dc *pop_up_aux_cmnd_menu(dc *);
+
+dc *first_clone(dc *);
+
+static dc *cycle_clone(dc *d) {
+  dc *c;
+  if (d->no_clone) return beep(d);
+  c = first_clone(d);
+  if (c != NULL) return pop_up_window(c);
+  return beep(d);
+}
+}
+previous window
+ -> any window:w, previous             =previous_window(w);
+
+bottom window
+ -> any window:w, bottom               =bottom_window(w);
+
+bury window
+ -> any window:w, bury                 =bury_window(w);
+
+search forward
+ -> search next
+ -> any search key:sk, search next + return        =save_search_key(sk);
+ -> search key:sk, down                            =save_search_key(sk);
+
+search reverse
+ -> search previous
+ -> any search key:sk, search previous             =save_search_key(sk);
+ -> search key:sk, up                              =save_search_key(sk);
+
+edit search key
+ -> search key:sk, escape                          =quit_search(sk);
+
+{
+extern char *search_key;
+char *old_string;
+int search_key_index;
+
+char *build_string(void);
+extern int search_flag;
+
+static dc *save_search_key(dc *d) {
+  if (search_key != NULL) free(search_key);
+  search_flag--;
+  search_key = build_string();
+  close_window(d);
+  hide_cursor();
+  activate_window(map_window_plane[--nplanes].d);
+  return active_dc;
+}
+
+extern char work_dir_name[];
+
+void set_work_dir(void);
+
+static dc *chdir_s2(dc *d) {
+  tss();
+  if (chdir_s1(string_base)) return beep(d);
+  rcs();
+  search_flag--;
+  CHANGE_REDUCTION(new_directory);
+  set_work_dir();
+/*  getcwd(work_dir_name, MAXPATH); */
+  set_work_dir();
+  close_window(d);
+  hide_cursor();
+  activate_window(map_window_plane[--nplanes].d);
+  return active_dc;
+}
+
+static dc *quit_search(dc *d) {
+  close_window(d);
+  rcs();
+  search_flag--;
+  hide_cursor();
+  activate_window(map_window_plane[--nplanes].d);
+  ok_ptr(active_dc->des);
+  active_dc->des->c_loc_doc.x = 0;
+  return active_dc;
+}
+}
+
+search key
+ -> create key                              =init_search_window();
+ -> search key:sk, left:k                   =fiddle_window(sk,k);
+ -> search key:sk, right                    =search_key_right(sk);
+ -> any search key:sk, text char:c          =insert_text(sk,c);
+ -> any search key:sk, backspace            =backspace_char(sk);
+ -> any search key:sk, delete               =delete_char(sk);
+ -> search key:sk, home:k                   =fiddle_window(sk,k);
+ -> search key:sk, end                      =search_key_end(sk);
+ -> any search key:sk, control left:k       =fiddle_window(sk,k);
+ -> any search key:sk, control right:k      =fiddle_window(sk,k);
+ -> adjust search key, escape
+
+window
+ -> change directory, new directory:d =d;
+
+edit string, new directory
+ -> edit string:d, return =chdir_s2(d);
+
+edit string
+ -> init string edit                         =edit_window;
+ -> edit string:sk, left:k                   =fiddle_window(sk,k);
+ -> edit string:sk, right                    =search_key_right(sk);
+ -> edit string:sk, home:k                   =fiddle_window(sk,k);
+ -> edit string:sk, end                      =search_key_end(sk);
+ -> adjust edit string, escape
+ -> any edit string:sk, text char:c          =insert_text(sk,c);
+ -> any edit string:sk, backspace            =backspace_char(sk);
+ -> any edit string:sk, delete               =delete_char(sk);
+ -> any edit string:sk, control left:k       =fiddle_window(sk,k);
+ -> any edit string:sk, control right:k      =fiddle_window(sk,k);
+
+{
+void search_key_line(void)   {
+  tss();
+  sss(string_base);
+}
+
+static dc *search_key_right(dc *d) {
+  if( tis() <= d->des->c_loc_doc.x) {
+    int c;
+    if (search_key == NULL) return d;
+    c = old_string[search_key_index];
+    if (c == 0) return d;
+    acs(c);
+    search_key_index++;
+    ok_ptr(d->des);
+    d->des->refresh++;
+  }
+  fiddle_window(d,right);
+  return d;
+}
+static dc *search_key_end(dc *d) {
+  ok_ptr(d->des);
+
+  if( tis() <= d->des->c_loc_doc.x) {
+    int c = old_string[search_key_index];
+    while (c) {
+      acs(c);
+      c = old_string[++search_key_index];
+    }
+  d->des->refresh++;
+  }
+  d->des->c_loc_doc.x = tis();
+  bound_cursor_hor(d->des);
+  return d;
+}
+
+static dc *insert_text(dc *d, int c) {
+  wd *w;
+
+  w = d->des;
+  ok_ptr(w);
+  its(c, w->c_loc_doc.x);
+  fiddle_window(d,right);
+  w->refresh++;
+  return d;
+}
+static dc *delete_char(dc *d) {
+  ok_ptr(d->des);
+  dcs(d->des->c_loc_doc.x);
+  d->des->refresh++;
+  return d;
+}
+
+static dc *backspace_char(dc *d) {
+  wd *w;
+
+  w = d->des;
+  if (w->c_loc_doc.x == 0) return d;
+  fiddle_window(d,left);
+  delete_char(d);
+  return d;
+}
+
+}
+adjust edit string
+ -> {reduce edit string | move edit string}: sk   =clear_mode(sk);
+
+adjust search key
+ -> {reduce search key | move search key}:sk      =clear_mode(sk);
+
+adjust window
+ -> {resize window | move window}:sk              =clear_mode(sk);
+
+move search key
+ -> any search key:sk, move:k                     =show_mode(sk,k);
+ -> move search key:sk, cursor control:k          =move(sk,k);
+
+reduce search key
+// -> {search key | adjust search key}:sk, reduce:k  =show_mode(sk,k);
+ -> any search key:sk, reduce:k                      =show_mode(sk,k);
+ -> reduce search key:sk, cursor control:k           =resize(sk,k);
+
+move edit string
+ -> any edit string:sk, move:k                       =show_mode(sk,k);
+ -> move edit string:sk, cursor control:k            =move(sk,k);
+
+reduce edit string
+ -> any edit string:sk, reduce:k                     =show_mode(sk,k);
+ -> reduce edit string:sk, cursor control:k          =resize(sk,k);
+
+move window
+ -> any window:w, move:k                             =show_mode(w,k);
+ -> move window:w, cursor control:k                  =move(w,k);
+
+resize window //, window
+ -> any window:w, reduce:k                           =show_mode(w,k);
+ -> resize window:w, cursor control:k                =resize(w,k);
+
+{
+static dc *show_mode(dc *d, int t) {
+  char *ms = "";
+
+  ok_ptr(d);
+  switch (t) {
+  case move_code:
+/*
+    if (d->move == NULL) {
+      PCB.reduction_token = scr_window_token;
+      beep(d);
+      break;
+    }
+*/
+    ms = "Move Window";
+    break;
+  case reduce:
+/*
+    if (d->resize == NULL) {
+      beep(d);
+      PCB.reduction_token = scr_window_token;
+      break;
+    }
+*/
+    ms = "Resize Window";
+    break;
+  }
+  flash_str_fill(mode_area.pos,ms,0,mode_area.size.x);
+  return d;
+}
+
+}
+
+(int) cursor control
+  -> up
+  -> down
+  -> left
+  -> right
+  -> page up
+  -> page down
+  -> home
+  -> end
+
+(int) control key
+  -> cursor control
+  -> non cursor key
+
+(int) non cursor key
+  -> control home
+  -> control end
+  -> control page up
+  -> control page down
+  -> control right
+  -> control left
+  -> control w
+  -> control z
+
+{
+
+cint ci();
+cint aci();
+cint sci();
+cint ulci();
+
+extern int start_keys[];
+extern dc *error_display;
+
+void log_error(void);
+
+void pop_up_code_segment(char *, char *);
+
+dc *resize_window_mode(dc *d) {
+  set_mode("Resize Window");
+  CHANGE_REDUCTION(resize_window);
+  return d;
+}
+
+dc *window_move(dc *d) {
+  set_mode("Move Window");
+  CHANGE_REDUCTION(move_window);
+  return d;
+}
+
+static dc *naughty(void) {
+  force_screen_real();
+  pop_up_code_segment("birb", "");
+  wkb();
+  return NULL;
+}
+
+void deactivate_window(dc *);
+
+static dc *activate_cmnd_menu(void) {
+  dc *new;
+  force_screen_real();
+  if (active_dc != NULL) {
+    if (active_dc != quick_ref_display) return active_dc;
+    deactivate_window(active_dc);
+  }
+  new = activate_window(cmnd_map_display);
+  if (nerrors) new = pop_up_window(error_display);
+  return new;
+}
+
+
+extern dc *search_key_window;
+
+
+static dc *edit_search(void) {
+  cint loc;
+  cint corner;
+  dc *d;
+  rect w;
+
+  d = active_dc;
+  loc = aci(d->act->c_loc_scr, ci(1,1));
+  deactivate_window(d);
+  w = place_rect(display_area, search_key_window->des->b_size,22);
+  corner = w.pos;
+  search_key_window->des->b_loc_scr = ulci(loc,corner);
+  search_key_window->des->b_size = w.size;
+  activate_window(search_key_window);
+  return active_dc;
+}
+
+static dc *init_search_window(void) {
+  ics();
+  search_flag++;
+  ok_ptr(search_key_window->des);
+  search_key_window->des->c_loc_doc.x = 0;
+  search_key_index = 0;
+  old_string = search_key;
+
+  return edit_search();
+}
+
+
+int do_key(int x) {
+  PCB.input_code = x;
+  scr();
+  if (PCB.exit_flag == AG_SYNTAX_ERROR_CODE) {
+    sbeep();
+    PCB.exit_flag = AG_RUNNING_CODE;
+  }
+  return (PCB.exit_flag == AG_RUNNING_CODE);
+}
+
+}