{$Y-,W-} Program menu_driver; { Author: Earl Chew Date : 01-Dec-83 This software may be used and distributed freely provided that this notice is included and acknowledgement is given to the author. } {Global declarations} const stringlength=80; null = chr(0); prgnam = "MENU"; cr = chr(13); bell = chr(7); exclamation = "!"; atsign = '@'; semi_colon = ';'; terminal = 12; type string = array [1..stringlength+1] of char; {*********** Terminal characteristics *****************} {Terminal characteristics -- VC404} {const fill_char = 50; display_height = 24; input_length = 1; curslen = 1; } {Terminal characteristics -- VT100} const fill_char = 0; display_height = 24; input_length = 3; curslen = 4; { Terminal Independent Type Declarations } { ******* Out Of Bounds To All Amateur Users } type sym = (none, up, down, show, execute, abort); type_in = array [1..input_length+1] of char; cursaddress = array [1..curslen+1] of char; linerec = record next, last : @linerec; descrip : string end; line = @linerec; {Terminal Constants -- VC404} {const up_cmd = type_in(chr(18), chr(0)); down_cmd = type_in(chr(20), chr(0)); show_cmd = type_in(chr(28), chr(0)); execute_cmd = type_in(chr(29), chr(0)); cursor_home = cursaddress(chr(25), chr(0)); cursor_up = cursaddress(chr(26), chr(0)); cursor_down = cursaddress(chr(10), chr(0)); clear_page = cursaddress(chr(24), chr(0)); } {Terminal Constants -- VT100} const up_cmd = type_in(chr(27), '[', 'A', chr(0)); down_cmd = type_in(chr(27), '[', 'B', chr(0)); show_cmd = type_in(chr(27), '[', 'D', chr(0)); execute_cmd = type_in(chr(27), '[', 'C', chr(0)); cursor_home = cursaddress(chr(27), '[', 'H', chr(0), chr(0)); cursor_up = cursaddress(chr(27), '[', 'A', chr(0), chr(0)); cursor_down = cursaddress(chr(27), '[', 'B', chr(0), chr(0)); clear_page = cursaddress(chr(27), '[', '2', 'J', chr(0)); {**********************************************************} var i : integer; first, last, cursor : line; symbol : sym; name : string; inp : text; procedure rerun; external; procedure fatal(prognam, msg : string); external; procedure delete(var dst:string; index, size:integer); external; procedure setcmd(delimiter : char); external; function position(src,pattern:string; index:integer):integer; external; procedure concatenate(src1, src2:string; maxlength:integer); external; procedure chain(prog : string); external; procedure substring(src:string; var dst:string; start,span : integer); external; function length(scr : string):integer; external; procedure jswset(bit : integer); external; procedure trim(var s : string); external; procedure display(first, last, cursor : line); var finished : boolean; i : integer; begin write(cursor_home, clear_page); for i := 1 to fill_char do write(null); write(cr); finished := false; repeat write(first@.descrip); if first <> last then begin writeln; first := first@.next end else finished := true until finished; if cursor = last then write(cr) else write(cursor_home) end; function examine(buffer : type_in; var symbol : sym): boolean; begin symbol := none; if buffer = down_cmd then symbol := down else if buffer = up_cmd then symbol := up else if buffer = show_cmd then symbol := show else if buffer = execute_cmd then symbol := execute else if buffer[1] = null then symbol := abort; examine := symbol <> none end; procedure goforward(first : line; var last, cursor : line); var i : integer; begin last := first; cursor := first; i := 1; while (i < display_height) and (last@.next <> nil) do begin i := i+1; last := last@.next end end; procedure gobackward(var first : line; last : line; var cursor : line); var i : integer; begin first := last; cursor := last; i := 1; while (i < display_height) and (first@.last <> nil) do begin i := i+1; first := first@.last end end; procedure readfile(var first, last, cursor : line); var currentline, nextline : line; s : string; begin reset(inp, argv[1]@, "MNU"); currentline := nil; while not eof(inp) do begin readln(inp, s); new(nextline, length(s) + 1); if currentline <> nil then currentline@.next := nextline else first := nextline; nextline@.last := currentline; currentline := nextline; currentline@.descrip[1] := null; concatenate(currentline@.descrip, s, stringlength); currentline@.next := nil end; if currentline = nil then fatal(prgnam, "No data found in file"); goforward(first, last, cursor); display(first, last, cursor) end; function readchar(var symbol : sym) : sym; var buffer : type_in; nextchar : array [1..2] of char; begin repeat if eoln(input) then readln; read(buffer) until not eoln(input) or eof(input); while not examine(buffer, symbol) do begin delete(buffer, 1, 1); if not eof(input) then begin repeat if eoln(input) then readln; read(nextchar) until not eoln(input) or eof(input); concatenate(buffer, nextchar, input_length) end end; readchar := symbol end; procedure manipulate(var first, last, cursor : line; symbol : sym); begin if symbol = down then begin if cursor@.next = nil then write(bell) else if cursor = last then begin first := last@.next; goforward(first, last, cursor); display(first, last, cursor) end else begin cursor := cursor@.next; write(cursor_down) end end else if symbol = up then begin if cursor@.last = nil then write(bell) else if cursor = first then begin last := first@.last; gobackward(first, last, cursor); display(first, last, cursor) end else begin cursor := cursor@.last; write(cursor_up) end end else begin cursor := first; display(first, last, cursor) end end; procedure extract(cursor : line; var name : string); var i : integer; begin i := position(cursor@.descrip, exclamation, 1); if i = 0 then begin i := length(cursor@.descrip); if i > 0 then i := i + 1 else fatal(prgnam, "Cannot find command") end; substring(cursor@.descrip, name, 1, i-1); trim(name) end; procedure set_kmon(name : string); begin argv[0]@ := name; setcmd(semi_colon) end; begin {main} if argc<>2 then begin writeln('MENU driver MENU version 01.03'); writeln; writeln('$INPUTFILE default extension is .MNU'); writeln; writeln('Commands - cursor up - move up one line'); writeln(' - cursor down - move down one line'); writeln(' - cursor left - refresh screen'); writeln(' - cursor right - execute command'); writeln; rerun end else begin readfile(first, last, cursor); jswset(terminal); while not (readchar(symbol) in [execute,abort]) do manipulate(first, last, cursor, symbol); if symbol = execute then begin extract(cursor, name); set_kmon(name) end; write(cursor_home, clear_page); for i := 1 to fill_char do write(null); write(cr) end end.