CS IMP Compiler for M68000.  Version  3.0d

   MENUS  compiled on 17/08/88  at  09.55

    1  
    2  {  12/10/87  14:02   Menus}
    3  
    4  !  The built-in function Set Up Menu expects the data to be given to it
    5  !  as an array of records of format dataf.
    6  !  Each Value is expected to be a list of lines.
    7  
    8  
    9  %include "sm:consts.inc"
   10  %include "sm:formats.inc"
   11  %include "sm:utils.inc"
?  54& Nonstandard 9   %externalstring(255)%fnspec translate command symbol(%string(*) s)
   12  %include "sm:smvti.inc"
   13  
   14  %recordformat dataf(%string(19) name,%record(line80listf) val)
   15  %recordformat menuf(%integer item,%string(19) name,%string(63) val)
   16  %ownrecord(menuf)%array menu(0:250)
   17  
   18  %owninteger cursorx,cursory
   19  %owninteger datastart=20
   20  %externalstring(31) helpfile="menuhelp"
   21  %owninteger linelength=80, menudepth
   22  %externalroutinespec view(%string(255) file,topic)
   23  %owninteger wdepth=16, wmin, wmax
   24  %routinespec write menu
   25  
   26  %externalroutine screen message(%string(255) s,%string(15) mon)
   27  %integer oldout
   28    oldout=outstream
   29    select output(0)
   30    gotoxy(0,wdepth+1)
   31    clear line
   32    print string(s)
   33    %monitor %if mon="mon"
   34    %stop %if mon="stop" %or mon="mon"
   35    gotoxy(cursorx,cursory-wmin+1)
   36    select output(oldout)
   37  %end
   38  
   39  !  If APM.
   40  %externalrecord(line80f)%map newline80
   41  %record(line80f) pattern
   42  %record(line80f)%name p
   43    p==new(pattern)
   44    p_next==nil; p_prev==nil
   45    p_line=""
   46    %result==p
   47  %end
   48  !
   49  
   50  %routine h(%string(31) topic)
   51  %string(255) x, y
   52    topic=x." ".y %while topic->x.("_").y
   53    view(helpfile,topic)
   54  %end
   55  
   56  %externalroutine start screen mode
   57  {!  If Vax.}
   58  {  define video(vttype)}
   59  !
   60    select input(0); select output(0)
   61    set video mode(screen mode+special pad)
   62    set frame(wdepth+2,24,0,80)
   63    clear frame
   64    push window
   65    set frame(0,wdepth+1,0,80)
   66    clear frame
   67    gotoxy(0,0)
   68    cursorx=0; cursory=0
   69    prompt("")
   70  %end
   71  
   72  %externalroutine stop screen mode
   73    clear frame
   74    set video mode(0)
   75  %end
   76  
   77  %externalroutine read screen line(%string(*)%name a)
   78  %integer j,k
   79  %string(255) u
   80  
   81    %on %event 15,0 %start
   82      read symbol(j) %until j=lf    ;!  To get rid of residual NL.
   83      h(menu(cursory)_name)
   84      write menu
   85    %finish
   86  
   87    prompt("")
   88    a=""
   89    cursorx=datastart
   90    gotoxy(cursorx,cursory-wmin+1)
   91    clear line
   92    %cycle
   93      read symbol(j)
   94      %exit %if j=lf %or j=enter
   95      %signal %event 15,0 %if j='?'
   96      screen message("Stopped at ".menu(cursory)_name,"stop") %if j=128+esc
   97      %continue %if j<=31 %or j>=128
   98      %if j=del %thenstart
   99  !  This supposes that del has not been dealt with at the input.
  100        print symbol(sp)
  101        k=length(a)
  102        k=k-1; cursorx=cursorx-1
  103        k=0 %if k<0; cursorx=datastart %if cursorx<datastart
  104        length(a)=k
  105      %finishelsestart
  106  !  This asssumes echo has been made.
  107        cursorx=cursorx+1
  108        a=a.tostring(j)
  109        %exit %if cursorx>linelength
  110      %finish
  111      gotoxy(cursorx,cursory-wmin+1)
  112    %repeat
  113    u=a; lower(u)
  114    cursorx=datastart; gotoxy(cursorx,cursory-wmin+1)
  115    clear line; print string(a)
  116    cursorx=0; gotoxy(cursorx,cursory-wmin+1)
  117  %end
  118  
  119  %externalroutine set up menu(%record(dataf)%arrayname data,
  120+ %integer mask)
  121  %integer flag,i,j
  122  %record(line80f)%name p
  123  !  Ensure that items 0 and 31 are available for escape.
  124    mask=mask!16_80000001
  125    menu(i)=0 %for i=0,1,250
  126    j=0
  127    %for i=0,1,31 %cycle
  128      %if mask&1=0 %then flag='n' %else flag='y'
  129      mask=mask>>1
  130      %continue %if flag='n'
  131  !  Copy wanted item into menu.
  132      p==data(i)_val_head
  133      %if p==nil %thenstart
  134        message("Menu too long","mon") %if j>250
  135        menu(j)_item=i
  136        menu(j)_name=data(i)_name
  137        %if 0#i#31 %then menu(j)_val="*" %else menu(j)_val=""
  138        j=j+1
  139      %finishelsestart
  140        %while p##nil %cycle
  141          message("Menu too long","mon") %if j>250
  142          menu(j)_item=i
  143          menu(j)_name=data(i)_name
  144          menu(j)_val=p_line
  145          j=j+1
  146          p==p_next
  147        %repeat
  148      %finish
  149    %repeat
  150    menudepth=j-1
  151  %end
  152  
  153  %externalroutine write instruction(%string(255) s)
  154    swop window
  155    gotoxy(0,wdepth+4)
  156    clear line
  157    gotoxy(0,wdepth+3)
  158    clear line
  159    gotoxy(0,wdepth+2)
  160    clear line
  161    gotoxy(0,wdepth+1)
  162    clear line
  163    print string(s)
  164    swop window
  165    gotoxy(cursorx,cursory-wmin+1)
  166  %end
  167  
  168  %routine display line(%integer y)
  169    gotoxy(0,y-wmin+1)
  170    clear line
  171    print symbol(' ')
  172    print string(menu(y)_name)
  173    gotoxy(datastart,y-wmin+1)
  174    print string(menu(y)_val)
  175    gotoxy(0,y-wmin+1)
  176  %end
  177  
  178  %routine display item(%integer item,y)
  179    gotoxy(0,y-wmin+1)
  180    clear line
  181    print symbol(' ')
  182    print string(menu(item)_name)
  183    gotoxy(datastart,y-wmin+1)
  184    print string(menu(item)_val)
  185    gotoxy(0,y-wmin+1)
  186  %end
  187  
  188  %externalroutine write menu
  189  %integer d, i
  190  %string(255) s
  191  !  Bring position of cursor within menu.
  192    %if cursorx<0 %then cursorx=0 %else %c
  193+   %if cursorx>linelength %then cursorx=linelength
  194    %if cursory<0 %then cursory=0 %else %c
  195+   %if cursory>menudepth %then cursory=menudepth
  196  !  Adjust window depth to fit menu.
  197    d=wdepth-2    ;!  Allow for escape cases.
  198    d=menudepth %if d>menudepth
  199  !  Adjust window to fit position of cursor.
  200    wmin=cursory-d//2; wmin=1 %if wmin<1
  201    wmax=wmin+d; wmax=menudepth-1 %if wmax>menudepth-1
  202    wmin=wmax-d; wmin=1 %if wmin<1
  203  !  Display menu.
  204    display item(0,wmin-1)            ;!  One escape item.
  205    display line(i) %for i=wmin,1,wmax
  206    display item(menudepth,wmax+1)    ;!  The other escape item.
  207  !  Write instructions.
  208    s="Move the cursor to the appropriate line. Press <RETURN> to alter.".snl. %c
  209+     "Type in the new value and press <RETURN> again. ".snl. %c
  210+     "For help, type ? and press <RETURN>.".snl. %c
  211+     "Move the cursor off the screen to see more of the menu."
  212    write instruction(s)
  213  !  Position cursor.
  214    gotoxy(cursorx,cursory-wmin+1)
  215  %end
  216  
  217  %externalintegerfn cursor depth
  218  %integer j
  219    select input(0)
  220    prompt("")
  221    gotoxy(0,cursory-wmin+1)
  222    %cycle
  223      read symbol(j)
  224      %exit %if j=lf
  225      %if j=down %thenstart
  226        cursory=cursory+1 %until cursory>menudepth-1 %or %c
  227+       menu(cursory)_item#menu(cursory-1)_item
  228      %finishelse %c
  229+     %if j=up %thenstart
  230        cursory=cursory-1 %until cursory<1 %or %c
  231+       menu(cursory)_item#menu(cursory-1)_item
  232      %finishelse %c
  233+     %if j&127=esc %then %signal 15,3 %else %c
  234+     %if j='?' %thenstart
  235        read symbol(j) %until j=lf    ;!  get rid of residual NL.
  236        %if cursory=wmin-1 %then h(menu(0)_name) %else %c
  237+       %if cursory=wmax+1 %then h(menu(31)_name) %else %c
  238+       h(menu(cursory)_name)
  239        write menu
  240      %finish
  241      %if cursory<0 %then cursory=0 %else %c
  242+     %if cursory>menudepth %then cursory=menudepth
  243      %if wmin-1<=cursory<=wmax+1 %then gotoxy(0,cursory-wmin+1) %elsestart
  244        %if cursory<wmin-1 %then cursory=wmin-1 %else cursory=wmax+1
  245        write menu
  246      %finish
  247    %repeat
  248    cursorx=datastart
  249    gotoxy(cursorx,cursory-wmin+1)
  250    %result=0 %if cursory=wmin-1
  251    %result=31 %if cursory=wmax+1
  252    %result=menu(cursory)_item
  253  %end
  254  
  255  
  256  %endoffile
? 257  UNIVADDR unused %endoffile
? 257  SSP underused   %endoffile
? 257  LOWERCASE unused %endoffile
? 257  LETTERD unused  %endoffile
? 257  GRAPHIC unused  %endoffile
? 257  END underused   %endoffile
? 257  DIGITD unused   %endoffile
? 257  DEFAULTEXT underused %endoffile
MENUS compiled: 324 statements (+ 46 comments) to 6132 bytes (+ 60)