home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / PARASOL / VIDEOSTO.ARK / SCREEN.LIB < prev    next >
Text File  |  1986-07-20  |  29KB  |  1,089 lines
  1. print off;
  2. {---------------------------------------------------}
  3. {        data   for   screen-handler   routines        }
  4. {---------------------------------------------------}
  5. set    `lin.chars            =    80;    {# chars per line}
  6. set    `s.lins                =    24;    {# lines per `screen}
  7. set    `max.fields            =    180;{max # fields per `screen}
  8. external word    `bios.ptr    address 1;
  9. external record    `dflt.dma    address ^h80    length ^h80;
  10. external label    `entry        address    5;
  11. {---------------------------------------------}
  12. {     special characters in screen record     }
  13. {---------------------------------------------}
  14. set `i.end        =    ^h00;
  15. set    `i.crsr        =    ^h01;
  16. set    `i.alf        =    ^h02;
  17. set    `i.dt        =    ^h03;
  18. set    `i.dol        =    ^h04;
  19. set    `i.dec        =    ^h05;
  20. set    `i.prot        =    ^h06;
  21. set `i.up        =    ^h07;
  22. set `i.lo        =    ^h08;
  23. set    `i.nm        =    ^h09;
  24. set    `i.iv        =    ^h0a;
  25. set    `i.tot        =    ^h0b;
  26. {---------------------------}
  27. {     screen field data     }
  28. {---------------------------}
  29. string    screen.data    ((`lin.chars * `s.lins) + 1)
  30. byte pointer    `c.d.bp        value    #screen.data;
  31. {------------------------------}
  32. {     screen image storage     }
  33. {------------------------------}
  34. string    `c.s.rec    ((`lin.chars * `s.lins) + 1);
  35. byte pointer    `c.s.bp    value    #`c.s.rec;
  36. {-----------------------------------------}
  37. {     screen field descriptor storage     }
  38. {-----------------------------------------}
  39. record    `c.fld.parms;
  40.     byte    `c.fld.type;
  41.     byte    `c.fld.x.pos;
  42.     byte    `c.fld.y.pos;
  43.     byte    `c.fld.len;
  44.     endrec;
  45. string    `c.s.fields    (`max.fields * 4);
  46. byte pointer    `c.fld.bp    value    #`c.s.fields;
  47. {----------------------------
  48. {    Internal Control-Codes
  49. {----------------------------
  50. set    `t.end        = ^h1b;
  51. set    `t.abort    = ^h03;
  52. set    `t.tab        = ^h09;
  53. set    `t.bktab    = ^h0b;
  54. set    `t.fwd        = ^h0c;
  55. set    `t.bksp        = ^h08;
  56. {-------------------------------------------}
  57. {     the terminal-characteristics file     }
  58. {-------------------------------------------}
  59. file    `t.file,
  60.         disk,    random,    key    terminal.type,
  61.         record    `dflt.dma,
  62.         value    "TERMINAL.DAT";
  63. record    `t.parms;
  64.     string    `t.xlate            32;
  65.     string    `t.clr                24;
  66.     string    `t.crsr.lead        5;
  67.     byte    `t.crsr.offset;
  68.     byte    `t.crsr.y.1st;
  69.     string    `t.fore                16;
  70.     string    `t.back                16;
  71.     byte    `t.exit.fore;
  72.     string                        16;    {ascii name of terminal}
  73.     byte    `t.no.wrap;                {flag no end-of-line wrap-around}
  74.     string    `t.lead.ins            5;    {~1b~, ~01~, etc.}
  75.     word    `t.timeout;                {lower for MP/M}
  76.     byte    `t.ibm;
  77.     endrec;
  78. byte pointer    `t.bp;
  79. {-------------------------}
  80. {     the screen file     }
  81. {-------------------------}
  82. record    `s.file.rec;
  83.     string    `ix.name    9;
  84.     word    `ix.key;
  85.     string                110;    {10 more of above}
  86.     word    `nxt.ix;
  87.     field                3;    {filler}
  88.     word    `nxt.scr;
  89.     endrec;
  90. string pointer    `ix.ptr    value    #`ix.name;
  91. string    screen.file.name    15    value    "SCREEN.DAT";
  92. word    `s.next.key;
  93. file    `s.file,
  94.         disk, random, key `s.key,
  95.         record `s.file.rec,
  96.         value screen.file.name;
  97. {-------------------------------------------------}
  98. {     the name of the screen currently in use     }
  99. {-------------------------------------------------}
  100. string    screen.name    9;
  101. string    `prev.screen.name    9;
  102. word    `c.s.key;
  103. {-----------------------------------------}
  104. {     the status-line / error-message     }
  105. {-----------------------------------------}
  106. string    status.line    (`lin.chars + 1);
  107. {-----------------------}
  108. {     misc. storage     }
  109. {-----------------------}
  110. word    `s.sz;
  111. word    `num.bl;
  112. word    `prev.num.bl;
  113. byte    `c.x.pos;
  114. byte    `c.y.pos;
  115. byte    `c.char;
  116. byte    `c.fld.pos;
  117. byte    `field.in.process        value "N";
  118. byte    `p.y.pos;
  119. byte    `init.done        value "N";
  120. byte    `wk.byte;
  121. byte    get.data.skip.count        value    0;
  122. word    get.data.cursor.loc        value    0;
  123. string    `con.str    251;
  124. {-----------------------------------------------}
  125. {    console I/O bios calls                        }
  126. {-----------------------------------------------}
  127. procedure    `con.out:        goto    `con.out;
  128. procedure    `con.in:        goto    `con.in;
  129. procedure    `con.stat:        goto    `con.stat;
  130. {----------------
  131. {    Initialize
  132. {----------------
  133. procedure    `init:
  134. begin
  135.     if `init.done = "N" then
  136.         mcall `entry using 32,^hff giving ,,,`init.done;
  137.  
  138.         push terminal.type;
  139.         open `t.file shared error begin
  140.             mcall `entry using 32,0;
  141.             open `t.file error standard;
  142.             end;
  143.         pop terminal.type;
  144.         read `t.file error standard;
  145.         move `dflt.dma[string] to `t.parms[string] length ##`t.parms;
  146.         close `t.file error standard;
  147.         mcall `entry using 32,`init.done;
  148.  
  149.         open `s.file shared error standard;
  150.         add 3 to `bios.ptr giving `con.stat[+1,word];
  151.         add 6 to `bios.ptr giving `con.in[+1,word];
  152.         add 9 to `bios.ptr giving `con.out[+1,word];
  153.         move "Y" to `init.done;
  154.         fi;
  155. end;
  156. {-----------------------------------------------}
  157. {    clear-screen                            }
  158. { out:    `c.x.pos and `c.y.pos both = 1        }
  159. {-----------------------------------------------}
  160. procedure    clear.screen:
  161. begin
  162.     display `t.clr,;
  163.     move 1 to `c.x.pos;
  164.     move 1 to `c.y.pos;
  165.     end;
  166. {-----------------------------------------------}
  167. {        set & reset hi-lighting                    }
  168. {-----------------------------------------------}
  169. procedure    `hilite.fore:    display `t.fore,;
  170.  
  171. procedure    `hilite.back:    display `t.back,;
  172.  
  173.  
  174. procedure    close.screen.file:
  175. begin
  176.     if `init.done = "Y" then
  177.         close `s.file error standard;
  178.         fi;
  179. end;
  180. {-----------------------------------------------}
  181. {    find screen                                    }
  182. { in:    screen.name                                }
  183. { out:    screen.sz (=0 if not found)                }
  184. {        `c.s.rec                                }
  185. {        `s.key = 0 if not found on disk            }
  186. {-----------------------------------------------}
  187. procedure    `find.screen:
  188. begin
  189.     call `init;
  190.     move 0 to `s.sz;
  191.     move 0 to `s.key;
  192.     do
  193.         read `s.file error standard;
  194.         move #`s.file.rec to `ix.ptr;
  195.         while `ix.ptr < #`nxt.ix do
  196.             if @`ix.ptr = screen.name then
  197.                 add 9 to `ix.ptr;
  198.                 move @`ix.ptr[wp] to `s.key;
  199.                 move #`c.s.rec to `ix.ptr;
  200.                 do
  201.                     read `s.file error standard;
  202.                     move `nxt.scr to `s.key;
  203.                     move 0 to `nxt.scr[byte];
  204.                     move `s.file.rec[string] to @`ix.ptr;
  205.                     add 126 to `ix.ptr;
  206.                     od until `s.key = 0;
  207.                 size `c.s.rec giving `s.sz;
  208.                 add 1 to `s.sz;
  209.                 exit;
  210.                 fi;
  211.             add 11 to `ix.ptr;
  212.             od;
  213.         move `nxt.ix to `s.key;
  214.         od until `s.key = 0;
  215.     end;
  216.  
  217. {-----------------------------------}
  218. {    set crsr address                }
  219. {-----------------------------------}
  220. procedure    `set.crsr:
  221. begin
  222. byte    x.loc;
  223. byte    y.loc;
  224. string    ansi.str    4;
  225.  
  226.     if `t.crsr.lead = "ANSI" then
  227.         convert `c.y.pos to ansi.str;
  228.         display "~1b~[",ansi.str,";",;
  229.         convert `c.x.pos to ansi.str;
  230.         display ansi.str,"f",;
  231.     else
  232.         display `t.crsr.lead,;
  233.         add `t.crsr.offset to `c.x.pos giving x.loc
  234.         add `t.crsr.offset to `c.y.pos giving y.loc;
  235.         if `t.crsr.y.1st = 'Y' then
  236.             mcall `con.out using y.loc;
  237.             mcall `con.out using x.loc;
  238.         else
  239.             mcall `con.out using x.loc;
  240.             mcall `con.out using y.loc;
  241.             fi;
  242.         fi;
  243.     move `c.y.pos to `p.y.pos;
  244.     end;
  245.  
  246.  
  247.  
  248. {-------------------------------------------}
  249. {    bump current crsr pos            }
  250. {-------------------------------------------}
  251. procedure    `bump.ch.pos:
  252. begin
  253.     add 1 to `c.x.pos;
  254.     if `c.x.pos > `lin.chars then
  255.         move 1 to `c.x.pos;
  256.         add  1 to `c.y.pos;
  257.         if `c.y.pos > `s.lins then
  258.             move 1 to `c.y.pos;
  259.         fi;    fi;
  260.     end;
  261.  
  262. {-------------------------------------------}
  263. {    display status-line                        }
  264. {-------------------------------------------}
  265. procedure    status.line.display:
  266. begin
  267.     call `init;
  268.     push `c.x.pos[word];
  269.     move 1 to `c.x.pos;
  270.     move `s.lins to `c.y.pos;
  271.     call `set.crsr;
  272.     call `hilite.fore;
  273.     append " " to status.line;
  274.     append `con.str to status.line;
  275.     move 0 to `con.str[byte];
  276.     justify status.line left length (`lin.chars - 1);
  277.     move screen.name to status.line[+(`lin.chars - 9),field,length 8];
  278.     display status.line,;
  279.     move 0 to status.line[byte];
  280.     call `hilite.back;
  281.     pop `c.x.pos[word];
  282.     call `set.crsr;
  283. end;
  284.  
  285.  
  286. procedure    `make.up:
  287.     if `c.char >= 'a'
  288.     and `c.char <= 'z' then
  289.         subtract ^h20 from `c.char;
  290.         fi;
  291.  
  292. procedure    `make.lo:
  293.     if `c.char >= 'A'
  294.     and `c.char <= 'Z' then
  295.         add ^h20 to `c.char;
  296.         fi;
  297.  
  298.  
  299. {-----------------------------------------------}
  300. {    display screen data                            }
  301. {-----------------------------------------------}
  302. procedure    display.screen.data:
  303. begin
  304.     move #screen.data            to    `c.d.bp;
  305.     move #`c.s.fields    to    `c.fld.bp;
  306.     while @`c.fld.bp <> `i.end do
  307.         move @`c.fld.bp[sp] to `c.fld.parms[string] length 4;
  308.         add 4 to `c.fld.bp;
  309.         move `c.fld.x.pos[word] to `c.x.pos[word];
  310.         call `set.crsr;
  311.         if `c.fld.type <> `i.prot then
  312.             call `hilite.fore;
  313.             fi;
  314.         move 0 to `num.bl;    {-zero-suppress flag-}
  315.         while `c.fld.len <> 0 do
  316.             subtract 1 from `c.fld.len;
  317.             move @`c.d.bp to `c.char;
  318.             and `c.char with ^h7f;
  319.             if `c.char < ' ' then
  320.                 move ' ' to `c.char;
  321.                 fi;
  322.             switch on `c.fld.type:
  323.             `i.tot,
  324.             `i.dec,
  325.             `i.dol:
  326.                     if `num.bl <> 0
  327.                     or `c.char <> '0'
  328.                     or `c.fld.len = 1 then
  329.                         move ^hff to `num.bl;
  330.                     else
  331.                         move ' ' to `c.char;
  332.                         fi;
  333.             `i.iv:    move ' ' to `c.char;
  334.             endswitch;
  335.             mcall `con.out using `c.char;
  336.             add 1 to `c.d.bp;
  337.             call `bump.ch.pos;
  338.             od;
  339.         call `hilite.back;
  340.         od;
  341. end;
  342.  
  343.  
  344.  
  345. {-----------------------------------------------}
  346. {    display screen                                }
  347. { in:    screen.name                                }
  348. {        screen.data                                }
  349. { out:    `c.s.fields                        }
  350. {-----------------------------------------------}
  351. procedure    display.screen:
  352. begin
  353.     if screen.name <> `prev.screen.name then
  354.         call `find.screen;
  355.         call clear.screen;
  356.         move 0 to `con.str[byte];
  357.         call `hilite.back;
  358.         if `s.sz = 0 then
  359.             move screen.name to status.line;
  360.             append " screen not found" to status.line;
  361.             move 0 to `con.str[byte];
  362.             call status.line.display;
  363.             goto end;
  364.             fi;
  365.         move #screen.data        to    `c.d.bp;
  366.         move #`c.s.fields    to    `c.fld.bp;
  367.         move #`c.s.rec        to    `c.s.bp;
  368.         do
  369.             switch on @`c.s.bp:
  370.             `i.end:    exitdo;                    {end of screen}
  371.             `i.crsr:    begin                        {screen pos}
  372.                     add 1 to `c.s.bp;
  373.                     move @`c.s.bp[wp] to `c.x.pos[word];
  374.                     add 2 to `c.s.bp;
  375.                     call `set.crsr;
  376.                     end;
  377.             `i.alf,
  378.             `i.up,
  379.             `i.lo,
  380.             `i.nm,
  381.             `i.iv,
  382.             `i.dt,
  383.             `i.dol,
  384.             `i.dec,
  385.             `i.tot,
  386.             `i.prot:    begin    {start of field}
  387.                     move @`c.s.bp    to    @`c.fld.bp;
  388.                     move @`c.s.bp    to    `c.fld.type;
  389.                     add 1 to `c.fld.bp;
  390.                     move `c.x.pos[word]    to    @`c.fld.bp[wp];
  391.                     add 2 to `c.fld.bp;
  392.                     add 1 to `c.s.bp;
  393.                     move @`c.s.bp    to    `c.fld.len;
  394.                     move `c.fld.len    to    @`c.fld.bp;    {width}
  395.                     add 1 to `c.fld.bp;
  396.                     add 1 to `c.s.bp;
  397.                     while `c.fld.len <> 0 do
  398.                         subtract 1 from `c.fld.len;
  399.                         call `bump.ch.pos;
  400.                         if @`c.s.bp = " " then
  401.                             add 1 to `c.s.bp;
  402.                             mcall `con.out using ' ';
  403.                             fi;
  404.                         od;
  405.                     end;
  406.             else    begin                        {display screen char}
  407.                     if `c.y.pos <> `p.y.pos
  408.                     and `t.no.wrap = 'Y' then
  409.                         call `set.crsr;
  410.                         fi;
  411.                     move @`c.s.bp to `c.char;
  412.                     mcall `con.out using `c.char;
  413.                     call `bump.ch.pos;
  414.                     add 1 to `c.s.bp;
  415.                     end;
  416.                 endswitch;
  417.             od;
  418.         move `i.end to @`c.fld.bp;
  419.         fi;
  420.     {--clear status.line--}
  421.     call `hilite.back;
  422.     move 1 to `c.x.pos;
  423.     move `s.lins to `c.y.pos;
  424.     call `set.crsr;
  425.     move 0 to `num.bl;
  426.     do
  427.         mcall `con.out using ' ';
  428.         add 1 to `num.bl;
  429.         od until `num.bl >= (`lin.chars - 9);
  430.     display screen.name,;
  431.     move screen.name to `prev.screen.name;
  432. end;
  433.  
  434.  
  435. {-----------------------------------------------
  436. {    get screen data
  437. { in:    screen.data
  438. {        `c.s.fields - `c.fld.bp
  439. { out:    screen.data
  440. {-----------------------------------------------
  441. procedure    get.screen.data:
  442. begin
  443.  
  444. byte pointer    wk.bp1,
  445.                 wk.bp2,
  446.                 wk.bp3;
  447. word    wk.word;
  448. byte    data.entered.this.field        value 'N';
  449. byte    skip.past.end                value 'N';
  450. byte    field.overflow                value 'N';
  451. byte    minus.flag                    value 'N';
  452. string    digits    11    value    "0123456789";
  453. string    wk.month    3,
  454.         wk.day    3,
  455.         wk.year    5;
  456. {-------------------------------------------------
  457. {    Special fields for multi-byte key-sequences
  458. {-------------------------------------------------
  459. string            ctl.str            9;
  460.  
  461. record    ctl.codes;
  462.     {--------------------
  463.     {    IBM 3101 codes
  464.     {--------------------
  465.     string 3 value "~1b~A";        byte value `t.bktab;    {up}
  466.     string 3 value "~1b~B";        byte value `t.tab;        {down}
  467.     string 3 value "~1b~C";        byte value `t.fwd;        {right}
  468.     string 3 value "~1b~D";        byte value `t.bksp;        {left}
  469.     string 3 value "~1b~H";        byte value `t.end;        {home}
  470.     string 3 value "~1b~I";        byte value `t.end;        {clear EOL}
  471.     string 3 value "~1b~J";        byte value `t.end;        {clear EOS}
  472.     string 3 value "~1b~K";        byte value `t.end;        {erase input}
  473.     string 3 value "~1b~L";        byte value `t.end;        {clear}
  474.     string    4    value    "~FFFFFF~";
  475.     endrec;
  476.  
  477.  
  478. procedure    `blank.rest:
  479.     while `c.fld.pos < `c.fld.len
  480.     and data.entered.this.field = 'Y'
  481.     and field.overflow <> 'Y' do
  482.         move ' ' to @`c.d.bp;
  483.         mcall `con.out using ' ';
  484.         add 1 to `c.d.bp;
  485.         add 1 to `c.fld.pos;
  486.         od;
  487.  
  488.  
  489. procedure    skip.to.next.field:
  490. begin
  491.     move 'N' to skip.past.end;
  492.     do
  493.         call `blank.rest;
  494.         if data.entered.this.field = 'Y' then
  495.             if field.overflow = 'Y' then
  496.                 add 1 to `c.d.bp;
  497.                 fi;
  498.         else
  499.             add `c.fld.len to `c.d.bp;
  500.             subtract `c.fld.pos from `c.d.bp;
  501.             fi;
  502.         move 'N' to field.overflow;
  503.         move 'N' to data.entered.this.field;
  504.         move  0  to `c.fld.pos;
  505.         add 4 to `c.fld.bp;
  506.         if @`c.fld.bp = `i.end then
  507.             move #`c.s.fields    to    `c.fld.bp;
  508.             move #screen.data            to    `c.d.bp;
  509.             move 'Y'                    to    skip.past.end;
  510.             fi;
  511.         move @`c.fld.bp[sp] to `c.fld.parms[string] length 4;
  512.         move `c.fld.x.pos[word] to `c.x.pos[word];
  513.         od until `c.fld.type <> `i.prot;
  514.     end;
  515.  
  516. procedure    test.numeric.char:
  517.     if `c.char < '0'
  518.     or `c.char > '9' then
  519.         move ^h00 to `c.char;
  520.         fi;
  521.  
  522. procedure    test.alpha.char:
  523.     if `c.char < " "
  524.     or `c.char > "~~" then
  525.         move ^h00 to `c.char;
  526.         fi;
  527.  
  528. procedure    left.just.field:
  529. begin
  530.     while `con.str[byte] = '0'
  531.        or `con.str[byte] = ' ' do
  532.         move `con.str[+1] to `con.str;
  533.         od;
  534.     end;
  535.  
  536. procedure    right.just.field:
  537. begin
  538.     scan `con.str for " " giving address wk.bp1;
  539.     move 0 to @wk.bp1;
  540.     do
  541.         size `con.str giving wk.word;
  542.         if wk.word >= `c.fld.len then
  543.             exitdo;
  544.             fi;
  545.         move `con.str to `con.str[+1] length (##`con.str - 1) reverse;
  546.         move '0' to `con.str[byte];
  547.         od;
  548.     if minus.flag = 'Y' then
  549.         {--if no room for minus, force size error--}
  550.         if `con.str[byte] <> '0' then
  551.             move `con.str to `con.str[+1] length (##`con.str - 1)
  552.                                                     reverse;
  553.             fi;
  554.         move '-' to `con.str[byte];
  555.         fi;
  556.     move 'N' to minus.flag;
  557. end;
  558.  
  559.  
  560. procedure    move.6.date:
  561. begin
  562.     move `con.str[word]        to wk.month[word];
  563.     move `con.str[+2,word]    to wk.day[word];
  564.     move `con.str[+4,word]    to wk.year[word];
  565.     move 0                            to wk.year[+2,byte];
  566.     end;
  567.  
  568.  
  569. procedure    screen.bottom:
  570. begin
  571.     if `t.exit.fore = 'Y' then
  572.         call `hilite.fore;
  573.     else
  574.         call `hilite.back;
  575.         fi;
  576.     move `s.lins to `c.y.pos;
  577.     move 1              to `c.x.pos;
  578.     call `set.crsr;
  579.     end;
  580.  
  581.  
  582.  
  583.  
  584.     {-----main body of get.screen.data-----}
  585.  
  586.     if screen.name <> `prev.screen.name then
  587.         call display.screen;
  588.         fi;
  589.     call display.screen.data;
  590.     move #`c.s.fields    to    `c.fld.bp;
  591.     move #screen.data        to    `c.d.bp;
  592.     if @`c.fld.bp = `i.end then
  593.         exit;
  594.         fi;
  595.     move @`c.fld.bp[sp] to `c.fld.parms[string] length 4;
  596.     while `c.fld.type = `i.prot do
  597.         call skip.to.next.field;
  598.         od until skip.past.end = 'Y';
  599.     if get.data.cursor.loc <> 0 then
  600.         while get.data.cursor.loc > `c.d.bp do
  601.             call skip.to.next.field;
  602.             od until skip.past.end = 'Y';
  603.     else
  604.         while get.data.skip.count <> 0 do
  605.             subtract 1 from get.data.skip.count;
  606.             call skip.to.next.field;
  607.             od until skip.past.end = 'Y';
  608.         fi;
  609.     move 0 to get.data.cursor.loc;
  610. `get.dat.redisplay:
  611.     mcall `con.stat giving ,,,`c.char;
  612.     if `c.char <> 0 then
  613.         mcall `con.in giving ,,,`c.char;
  614.         goto `get.dat.redisplay;
  615.         fi;
  616.     move 'N' to field.overflow;
  617.     call `hilite.fore;
  618.     {-----loop by field-----}
  619.     do
  620.         {---skip initial protected field---}
  621.         while @`c.fld.bp = `i.prot do
  622.             add 3 to `c.fld.bp;
  623.             add @`c.fld.bp to `c.d.bp;
  624.             add 1 to `c.fld.bp;
  625.             od;
  626.         move @`c.fld.bp[sp]        to    `c.fld.parms[string]
  627.                                         length 4;
  628.         move `c.fld.x.pos[word]    to    `c.x.pos[word];
  629.         move 0                        to    `c.fld.pos;
  630.         move 'N' to field.overflow;
  631.         move 'N' to data.entered.this.field;
  632.         {-----loop by character within field-----}
  633.         do
  634.             call `set.crsr;
  635.             mcall `con.in giving ,,,`c.char;
  636.  
  637.             {-------------------------------------------------
  638.             {    Special keystrokes for IBM-PC & compatibles
  639.             {-------------------------------------------------
  640.             if `c.char = 0
  641.             and `t.ibm = "Y" then
  642.                 mcall `con.in giving ,,,`c.char;
  643.                 switch on `c.char:
  644.                     ^h03:            move `t.abort    to `c.char;    {break}
  645.                     ^h48:            move `t.bktab    to `c.char;    {up}
  646.                     ^h4b:            move `t.bksp    to `c.char;    {back}
  647.                     ^h4d:            move `t.fwd        to `c.char;    {fwd}
  648.                     ^h50:            move `t.tab        to `c.char;    {down}
  649.                     ^h52:            move `t.fwd        to `c.char;    {ins}
  650.                     ^h53:            move `t.bksp    to `c.char;    {del}
  651.                     ^h3b - ^h71:    move `t.end        to `c.char;    {func}
  652.                     else    move 0            to `c.char;
  653.                     endswitch;
  654.                 goto `got.char;
  655.                 fi;
  656.             {---check for lead-in char for multi-byte key-sequence---}
  657.             fill ctl.str with 0;
  658.             move `c.char to ctl.str[byte];
  659.             scan `t.lead.ins for ctl.str
  660.             true begin
  661.                 move (#ctl.str + 1) to wk.bp2;
  662.                 move `t.timeout to wk.word;
  663.                 do
  664.                     mcall `con.stat giving ,,,`c.char;
  665.                     if `c.char <> 0 then
  666.                         mcall `con.in giving ,,,`c.char;
  667.                         {---------------------------------------------
  668.                         {--multi-byte sequence can't contain another--}
  669.                         {--lead-in character, discard previous.        }
  670.                         {-- (I.B.M 3101 running under MPM has trouble
  671.                         {-- keeping up with arrow keys typed fast
  672.                         {----------------------------------------------
  673. {                        move #`t.lead.ins to wk.bp1;
  674. {                        while @wk.bp1 <> 0 do
  675. {                            if @wk.bp1 = `c.char then
  676. {                                fill ctl.str with 0;
  677. {                                move `t.timeout to wk.word;
  678. {                                move #ctl.str to wk.bp2;
  679. {                                exitdo;
  680. {                                fi;
  681. {                            add 1 to wk.bp1;
  682. {                            od;
  683.                         move `c.char to @wk.bp2;
  684.                         add 1 to wk.bp2;
  685.                         if wk.bp2 >= (#ctl.str + (##ctl.str - 1))
  686.                             then exitdo;
  687.                             fi;
  688.                         fi;
  689.                     subtract 1 from wk.word;
  690.                     od until wk.word = 0;
  691.                 move #ctl.codes to wk.bp1;
  692.                 do
  693.                     move #ctl.str to wk.bp2;
  694.                     do
  695.                         if @wk.bp2 OR @wk.bp1 then
  696.                         else                        {--if end of both-}
  697.                             add 1 to wk.bp1;
  698.                             move @wk.bp1 to `c.char;
  699.                             goto `got.char;
  700.                             fi;
  701.                         if @wk.bp2 <> @wk.bp1 then
  702.                             while @wk.bp1 <> 0 do
  703.                                 add 1 to wk.bp1;
  704.                                 od;
  705.                             add 2 to wk.bp1;
  706.                             exitdo;
  707.                             fi;
  708.                         add 1 to wk.bp1;
  709.                         add 1 to wk.bp2;
  710.                         od;
  711.                     od until @wk.bp1 = ^hff;
  712.                 move ctl.str[byte] to `c.char;    {-restore 1st char-}
  713.                 end;
  714.             if `c.char < ' ' then
  715.                 add #`t.xlate to `c.char giving `t.bp;
  716.                 move @`t.bp to `c.char;
  717.                 fi;
  718. `got.char:
  719.             switch on `c.char:
  720.             {---end of data entry---}
  721.             `t.end:    begin
  722.                     call skip.to.next.field;
  723.                     call screen.bottom;
  724.                     goto `get.dat.validate;
  725.                     end;
  726.             `t.abort:    begin
  727.                     move "Abort? (Y/N):" to status.line;
  728.                     move 0 to `con.str[byte];
  729.                     call status.line.display;
  730.                     mcall `con.in giving ,,,`c.char;
  731.                     if `c.char = "Y"
  732.                     or `c.char = "y" then
  733.                         call screen.bottom;
  734.                         reboot;
  735.                         fi;
  736.                     end;
  737.             `t.tab:    begin
  738.                     call skip.to.next.field;
  739.                     exitdo;
  740.                     end;
  741.             {---back-tab---}
  742.             `t.bktab:    begin
  743.                     call `blank.rest;
  744.                     move "N" to field.overflow;
  745.                     subtract `c.fld.pos from `c.d.bp;
  746.                     do
  747.                         if `c.fld.bp > #`c.s.fields then
  748.                             subtract 1 from `c.fld.bp;
  749.                             subtract @`c.fld.bp from `c.d.bp;
  750.                             subtract 3 from `c.fld.bp;
  751.                         else
  752.                             move #`c.s.fields    to    `c.fld.bp;
  753.                             move #screen.data    to    `c.d.bp;
  754.                             do
  755.                                 add 3 to `c.fld.bp;
  756.                                 add @`c.fld.bp to `c.d.bp;
  757.                                 add 1 to `c.fld.bp;
  758.                                 od until @`c.fld.bp = `i.end;
  759.                             subtract 1 from `c.fld.bp;
  760.                             subtract @`c.fld.bp from `c.d.bp;
  761.                             subtract 3 from `c.fld.bp;
  762.                             fi;
  763.                         od until @`c.fld.bp <> `i.prot;
  764.                     exitdo;
  765.                     end;
  766.             {---forward space---}
  767.             `t.fwd:    begin
  768.                     add 1 to `c.fld.pos;
  769.                     add 1 to `c.d.bp;
  770.                     if `c.fld.pos >= `c.fld.len then
  771.                         call skip.to.next.field;
  772.                         exitdo;
  773.                         fi;
  774.                     call `bump.ch.pos;
  775.                     end;
  776.             ^h7f,
  777.             `t.bksp:    begin
  778.                     move 'N' to field.overflow;
  779.                     if `c.fld.pos <> 0 then
  780.                         subtract 1 from `c.d.bp;
  781.                         subtract 1 from `c.fld.pos;
  782.                         if `c.x.pos > 1 then
  783.                             subtract 1 from `c.x.pos;
  784.                         else
  785.                             move `lin.chars to `c.x.pos;
  786.                             if `c.y.pos > 1 then
  787.                                 subtract 1 from `c.y.pos;
  788.                             else
  789.                                 move `s.lins to `c.y.pos;
  790.                         fi;    fi;    fi;
  791.                     end;
  792.             else begin                    {normal input char}
  793.                     move 0 to wk.word[byte];
  794.                     if `c.char = ' ' then
  795.                         move ^hff to wk.word[byte];
  796.                         fi;
  797.                     if `c.char = '?'
  798.                     and `c.fld.pos = 0 then
  799.                         move ^hff to wk.word[byte];
  800.                         fi;
  801.                     if wk.word[byte] = 0 then
  802.                         switch on `c.fld.type:
  803.                         `i.dec:    call test.numeric.char;
  804.                         `i.tot:        if `c.char <> '.'
  805.                                     and `c.char <> '-' then
  806.                                         call test.numeric.char;
  807.                                         fi;
  808.                         `i.dol:        if `c.char <> "." then
  809.                                                 call test.numeric.char;
  810.                                                 fi;
  811.                         `i.dt:        if `c.char <> "/"
  812.                                     and `c.char <> '-' then
  813.                                                 call test.numeric.char;
  814.                                                 fi;
  815.                         `i.iv,
  816.                         `i.up:    call `make.up;
  817.                         `i.lo:    call `make.lo;
  818.                         `i.nm: begin
  819.                                 move 0 to wk.word[byte];
  820.                                 if `c.fld.pos = 0 then
  821.                                     move ^hff to wk.word[byte];
  822.                                 else
  823.                                     subtract 1 from `c.d.bp;
  824.                                     switch on @`c.d.bp:
  825.                                     " ","/","`",".",",","-":
  826.                                          move ^hff to wk.word[byte];
  827.                                     endswitch;
  828.                                     add 1 to `c.d.bp;
  829.                                     fi;
  830.                                 if wk.word[byte] <> 0 then
  831.                                     call `make.up;
  832.                                     fi;
  833.                                 end;
  834.                         endswitch;
  835.                         call test.alpha.char;
  836.                         fi;
  837.                     if `c.char <> ^h00 then
  838.                         move `c.char to @`c.d.bp;
  839.                         if `c.fld.type = `i.iv then
  840.                             move ' ' to `c.char;
  841.                             fi;
  842.                         mcall `con.out using `c.char;
  843.                         move 'Y' to data.entered.this.field;
  844.                         add 1 to `c.fld.pos;
  845.                         if `c.fld.pos < `c.fld.len then
  846.                             add 1 to `c.d.bp;
  847.                             call `bump.ch.pos;
  848.                         else
  849.                             subtract 1 from `c.fld.pos;
  850.                             mcall `con.out using ^h08;
  851.                             move 'Y' to field.overflow;
  852.                         fi;    fi;
  853.                     end;
  854.                 endswitch;
  855.             od;
  856.         od;
  857. {-----validate screen data-----}
  858.  
  859. `get.dat.validate:
  860.     move #`c.s.fields    to `c.fld.bp;
  861.     move #screen.data            to `c.d.bp;
  862.     do
  863.         if @`c.d.bp <> '?' then
  864.             move @`c.fld.bp[sp] to `c.fld.parms[string]
  865.                                         length 4;
  866.             if `c.fld.type <> `i.end then
  867.                 move @`c.d.bp[sp] to `con.str
  868.                                         length `c.fld.len;
  869.                 add #`con.str to `c.fld.len giving wk.bp3;
  870.                 move 0 to @wk.bp3;
  871.                 fi;
  872.             switch on `c.fld.type:
  873.             `i.end:    exitdo;
  874.             `i.up,
  875.             `i.lo,
  876.             `i.iv,
  877.             `i.alf,
  878.             `i.nm,
  879.             `i.prot:    null;
  880.             `i.dec: begin
  881.                 scan `con.str for no " " true begin
  882.                     call left.just.field;
  883.                     call right.just.field;
  884.                     move `con.str to @`c.d.bp[sp] length `c.fld.len;
  885.                     end;
  886.                 end;
  887.             `i.tot,
  888.             `i.dol: begin
  889.                 {---if field is blank, leave it blank---}
  890.                 scan `con.str for no " " true begin
  891.                     call left.just.field;
  892.                     {--remove leading blanks--}
  893.                     scan `con.str for " " giving address wk.bp2;
  894.                     move 0 to @wk.bp2;
  895.                     {--remove any minus'es--}
  896.                     move 'N' to minus.flag;
  897.                     do
  898.                         scan `con.str for '-' giving address wk.bp1
  899.                                 false exitdo;
  900.                         move 'Y' to minus.flag;
  901.                         add 1 to wk.bp1 giving wk.bp2;
  902.                         move @wk.bp2[sp] to @wk.bp1[sp]; {remove '-'}
  903.                         od;
  904.                     scan `con.str for "." giving address wk.bp1
  905.                             error begin
  906.                                 append ".00" to `con.str;;
  907.                                 goto `valid.dollar;
  908.                                 end;
  909.                     size @wk.bp1[sp] giving wk.word;
  910.                     switch on wk.word[byte]:
  911.                     1:    append "00" to @wk.bp1[sp];
  912.                     2:    append "0"  to @wk.bp1[sp];
  913.                     3:    null;
  914.                     else begin
  915.                         move "too many decimal places" to status.line;
  916.                         call status.line.display;
  917.                         goto `get.dat.redisplay;
  918.                         end;
  919.                     endswitch;
  920. `valid.dollar:
  921.                     call right.just.field;
  922.                     size `con.str giving wk.word;
  923.                     if wk.word[byte] > `c.fld.len then
  924.                         move "won't fit with cents added" to status.line;
  925.                         call status.line.display;
  926.                         goto `get.dat.redisplay;
  927.                         fi;
  928.                     move `con.str to @`c.d.bp[sp]
  929.                                             length `c.fld.len;
  930.                     end;
  931.                 end;
  932.             `i.dt: begin
  933.                 scan `con.str for no " "
  934.                     error exitswitch;
  935.                 if `c.fld.len = 6 then
  936.                     scan `con.str for no digits
  937.                         error begin
  938.                             call move.6.date;
  939.                             goto `valid.date;
  940.                             end;
  941.                     move "all six digits must be entered (MMDDYY)"
  942.                                     to status.line;
  943.                     call status.line.display;
  944.                     goto `get.dat.redisplay;
  945.                     fi;
  946.                 move #`con.str to wk.bp1;
  947.                 scan `con.str for any "/-" giving address wk.bp2
  948.                     error begin
  949.                         scan `con.str for no digits
  950.                                     giving wk.word;
  951.                         if wk.word[byte] = 6 then
  952.                             call move.6.date;
  953.                             goto `valid.date;
  954.                         else
  955.                             move "must be 6 digits unless using slashes"
  956.                                         to status.line;
  957.                             call status.line.display;
  958.                             goto `get.dat.redisplay;
  959.                             fi;
  960.                         end;
  961.                 subtract wk.bp1 from wk.bp2 giving wk.word;
  962.                 switch on wk.word[byte]:
  963.                 1: begin
  964.                     move "0"        to wk.month[byte];
  965.                     move @wk.bp1    to wk.month[+1,byte];
  966.                     end;
  967.                 2:    move @wk.bp1[wp] to wk.month[word];
  968.                 else move "00" to wk.month[word];
  969.                 endswitch;
  970.                 add 1 to wk.bp2 giving wk.bp1;
  971.                 scan @wk.bp1[sp] for any "/-" giving address wk.bp2
  972.                     error begin
  973.                         move "two slashes required" to status.line;
  974.                         call status.line.display;
  975.                         goto `get.dat.redisplay;
  976.                         end;
  977.                 subtract wk.bp1 from wk.bp2 giving wk.word;
  978.                 switch on wk.word[byte]:
  979.                 1: begin
  980.                     move "0"        to wk.day[byte];
  981.                     move @wk.bp1    to wk.day[+1,byte];
  982.                     end;
  983.                 2:    move @wk.bp1[wp] to wk.day[word];
  984.                 else move "00" to wk.day[word];
  985.                 endswitch;
  986.  
  987.                 add 1 to wk.bp2 giving wk.bp1;
  988.                 scan @wk.bp1[sp] for no digits giving wk.word;
  989.                 switch on wk.word[byte]:
  990.                 2: begin
  991.                     move @wk.bp1[wp] to wk.year[word];
  992.                     move 0             to wk.year[+2,byte];
  993.                     end;
  994.                 4:    move @wk.bp1[sp] to wk.year length 4;
  995.                 else move 0 to wk.year[byte];
  996.                 endswitch;
  997.  
  998. `valid.date:
  999.                 if wk.month < '01'
  1000.                 or wk.month > '12' then
  1001.                     move "invalid month" to status.line;
  1002.                     call status.line.display;
  1003.                     goto `get.dat.redisplay;
  1004.                     fi;
  1005.                 size wk.year giving wk.word;
  1006.                 switch on wk.word[byte]:
  1007.                 2: begin
  1008.                     move wk.year[word] to wk.year[+2,word];
  1009.                     move "19"           to wk.year[word];
  1010.                     end;
  1011.                 4: null;
  1012.                 else begin
  1013.                     move "year must be 2 or 4 digits" to status.line;
  1014.                     call status.line.display;
  1015.                     goto `get.dat.redisplay;
  1016.                     end;
  1017.                 endswitch;
  1018.  
  1019.                 if wk.day < '01'
  1020.                 or wk.day > '31' then
  1021.                     move "invalid day" to status.line;
  1022.                     call status.line.display;
  1023.                     goto `get.dat.redisplay;
  1024.                     fi;
  1025.                 switch on wk.month[word]:
  1026.                 '04','06','09','11': begin
  1027.                     if wk.day > '30' then
  1028.                         move "month entered only has 30 days"
  1029.                                         to status.line;
  1030.                         call status.line.display;
  1031.                         goto `get.dat.redisplay;
  1032.                         fi;
  1033.                     end;
  1034.                 '02': begin
  1035.                     move 0 to status.line[byte];
  1036.                     convert dec wk.year[+2] to wk.word;
  1037.                     divide wk.word by 4 giving wk.bp2 remainder wk.word;
  1038.                     if wk.word[byte] <> 0 then
  1039.                         if wk.day > '28' then
  1040.                             move "(not " to status.line;
  1041.                             fi;
  1042.                     else
  1043.                         if wk.day > '29' then
  1044.                             move "(" to status.line;
  1045.                             fi;
  1046.                         fi;
  1047.                     if status.line[byte] <> 0 then
  1048.                         append "leap year) - wrong day for Feb."
  1049.                                     to status.line;
  1050.                         call status.line.display;
  1051.                         goto `get.dat.redisplay;
  1052.                         fi;
  1053.                     end;
  1054.                 endswitch;
  1055.  
  1056.                 move `c.d.bp to wk.bp1;
  1057.                 move wk.month[word] to @wk.bp1[wp];
  1058.                 add 2 to wk.bp1;
  1059.                 switch on `c.fld.len:
  1060.                 6: begin
  1061.                     move wk.day[word] to @wk.bp1[wp];
  1062.                     add 2 to wk.bp1;
  1063.                     move wk.year[+2,word] to @wk.bp1[wp];
  1064.                     end;
  1065.                 8,10: begin
  1066.                     move "/" to @wk.bp1;
  1067.                     add 1 to wk.bp1;
  1068.                     move wk.day[word] to @wk.bp1[wp];
  1069.                     add 2 to wk.bp1;
  1070.                     move "/" to @wk.bp1;
  1071.                     add 1 to wk.bp1;
  1072.                     if `c.fld.len = 8 then
  1073.                         move wk.year[+2,word] to @wk.bp1[wp];
  1074.                     else
  1075.                         move wk.year to @wk.bp1[sp] length 4;
  1076.                         fi;
  1077.                     end;
  1078.                 endswitch;
  1079.                 end;
  1080.             endswitch;
  1081.             fi;
  1082.         add 3 to `c.fld.bp;
  1083.         add @`c.fld.bp to `c.d.bp;
  1084.         add 1 to `c.fld.bp;
  1085.         od;
  1086.     move 0 to `con.str[byte];
  1087.     end;
  1088. print on;
  1089.