rem |             ************   RLEVEL.CDL   ****************

       sprint $DATFILE,"RLEVEL.DAT"
       ARRAY LEVMASK[16]
       ARRAY LEVMASK1[16]
       ARRAY LEVMASK2[16]
       ARRAY LEVMASK3[16]
       ARRAY NEWMASK[16]
       array levs[257]
       pt = 0
:START

      getmenu "RLevel ver 5.00 for Windows  ---  Tom Groff Aug 1997",\
      "Lev_off","All_but","Ck_lev",\
      "Flip","Tools","L_Mask","Verify"

      on (@key+3) goto ESC,ESC,START,ESC,LEV_OFF,ALLBUT,CKLEV,FLIP,\
                                     TOOLMENU,MASKMENU,\
                                     VERIFY

:MASKMENU
      getmenu "Select an option","Set_msk","Clr_msk"
      on (@key+3) goto ESC,START,MASKMENU,ESC,PICKMASK,CLEARMASK

:PICKMASK
      set masklevel, 0
      getent "Select entity to mask level",ent
      on (@key+3) goto ESC,MASKMENU,,,,,,,,,,,,,,,,,
      set masklevel, @intdat[4]
      goto START
:CLEARMASK
      set masklevel, 0
      goto START
:TOOLMENU
      getmenu "Select an option","Step","Ent-lev"
      on (@key+3) goto ESC,START,TOOLMENU,ESC,STEP,ENTLEV

:ENTLEV
       array lmask[16]
       i = 0
       array map[256]
:INIT44
        map[i] = 0
        i = i + 1
        if (i >= 256)
           goto ENDINIT44
        goto INIT44
:ENDINIT44
        i = 0
:INIT55
        lmask[i] = 0
        i = i + 1
        if (i >= 16)
           goto ENDINIT55
        goto INIT55
:ENDINIT55
       levels 1, 1,255
       auto
       redraw
       getall total
:LOOP44
       if (total <= -1)
          goto ENDLOOP44
       if ((total % 100) == 0)
          prompt "%d",total
       getnext ent,total
       map[ @intdat[4] - 1] = 1
       total = total - 1
       goto LOOP44
:ENDLOOP44
       inc1 = 0
       inc16 = 0
       counter = 1
:STARTFILL
       if (inc1 >= 256)
       goto ENDFILL
       if ((inc1) % 16 == 0)
           counter = 1
       if (map[inc1] == 1)
          lmask[inc16] = lmask[inc16] + counter
       inc1 = inc1 + 1
       counter = counter * 2
       if ((inc1) % 16 == 0)
           inc16 = inc16 + 1
       goto STARTFILL
:ENDFILL
       set levelmask, lmask
       redraw
       clear  lmask,map,inc1,inc16,counter
       goto TOOLMENU

:STEP
       sys_get_name 1,@level,$LNAME
       if (@error<=-24)
          sprint $LNAME,"-"
       sprint $MM, "Select a option LEVEL=[%d][%s]",@level,$LNAME
       getmenu $MM,"Init_on","Up","Down"
       on (@key+3) goto ESC,START,STEP,ESC,SET_CURR,STEPUP,STEPDOWN
:SET_CURR
       getint "Enter level to display alone => ",1,one
       levels 0, 1, 256
       levels 1, one
       set level, one
REM    auto
       redraw -1
       goto STEP
:STEPUP
       if (@level == 255)
          goto STEPUP
       levels 0, 1, 256
       one = @level
       one = one + 1
       levels 1, one
       set level, one
REM    auto
       redraw -1
       goto STEP
:STEPDOWN
       if (@level == 1)
          goto STEPUP
       levels 0, 1, 256
       one = @level
       one = one - 1
       levels 1, one
       set level, one
REM       auto
       redraw -1
       goto STEP

:VERIFY
       sprint $PMPT, "Select entity for level"
:SELECT3
       getent $PMPT,ent
       on (@key+3) goto ESC,START,SELECT3,,,,,,,,,,,,,,,,
       sys_get_name 1, @intdat[4],$LNAME
       if (@error<=-24)
          sprint $LNAME,"-"
       sprint $PMPT,"[ %d \"%s\"] Select entity",@intdat[4],$LNAME
       goto SELECT3
:FLIP
       i = 0
:FLIPMASK
       LEVMASK[i] = 65535-@levels[i]
       if ((i = i + 1) < 16)
           goto FLIPMASK
       set levelmask, LEVMASK
       redraw -1
       goto START
:CKLEV
        getmenu "Select an option", "Add","Subtract","All","None"
        on (@key+3) goto START,START,CKLEV,ESC,ADDLEV,SUBLEV,ALLLEV,NOLEV
                        
:NOLEV
        levels 0, 1, 256
        redraw
        goto CKLEV
:ALLLEV
        levels 1, 1, 256
        redraw
        goto CKLEV
:ADDLEV
        opt = 1
        getstr "Enter level(s) to add => ","",$IN
        on (@key+3) goto ESC,CKLEV,ADDLEV,,,,,,,,,,,,,,,,,
        goto PROCESS
:SUBLEV
        opt = 0
        getstr "Enter level(s) to subtract => ","",$IN
        on (@key+3) goto ESC,CKLEV,SUBLEV,,,,,,,,,,,,,,,,,
        goto PROCESS
:PROCESS
        sz = sizeof($IN)-2

    rem | check for comma or hyphent at start or end of string.

        if (($IN[0]==44)||($IN[0]==45))
           goto ERR1
        if (($IN[sz]==44)||($IN[sz]==45))
           goto ERR2
        ct = 0
:P1
    rem | check for illegal character in entire string.

        if (ct > sz)
           goto P1_END

        if (($IN[ct]<44)||($IN[ct]>57))
           goto ERR3
        if (($IN[ct]==46)||($IN[ct]==47))
           goto ERR3
        ct = ct + 1
        goto P1
:P1_END
        ct = 0
:P2
    rem | check for duplicate commas or hypents.

        if (ct > sz)
           goto P2_END

        if (($IN[ct]==44)&&($IN[ct+1]==44))
           goto ERR4
        if (($IN[ct]==44)&&($IN[ct+1]==45))
           goto ERR4
        if (($IN[ct]==45)&&($IN[ct+1]==44))
           goto ERR4
        if (($IN[ct]==45)&&($IN[ct+1]==45))
           goto ERR4

        ct = ct + 1
        goto P2
:P2_END
        ct = 0
        array LEVNUM[25]
        array ACTION[24]
        offset = 0
        sprint $NUM,""
:P3
    rem | check for out of range numbers.

        if (ct > sz)
           goto P3_END
        sprint $NUM,"%s%c",$NUM,$IN[ct]
        if (($IN[ct]!=44)&&($IN[ct]!=45))
           goto J1
        call strint,$NUM,dummynum

        if ((dummynum < 1)||(dummynum > 256))
           goto ERR5
        LEVNUM[offset] = dummynum
        ACTION[offset] = $IN[ct]
        offset = offset + 1
        sprint $NUM,""
:J1
        ct = ct + 1
        goto P3
:P3_END
        call strint,$NUM,dummynum
        if ((dummynum<1)||(dummynum>256))
           goto ERR5
        LEVNUM[offset] = dummynum
        ACTION[offset] = 46
        offset = offset + 1
        sprint $NUM,""

        ct = 0
        offset = offset - 1
:P4
        if (ct > offset)
           goto P4_END

        if (ACTION[ct] == 44)
           GOTO ONE_LEVEL

        if (ACTION[ct] == 46)
           GOTO ONE_LEVEL

        if (ACTION[ct] == 45)
           GOTO MANY_LEVEL

:ONE_LEVEL
        levels opt, LEVNUM[ct]
        ct = ct + 1
        goto P4
:MANY_LEVEL
        if (LEVNUM[ct] > LEVNUM[ct+1])
           goto ERR6
        if ((ACTION[ct]==45)&&(ACTION[ct+1]==45))
           goto ERR7
        levels opt, LEVNUM[ct], LEVNUM[ct+1]
        ct = ct + 2
        goto P4
:P4_END
        REDRAW
        goto STARTOVER
:ERR1
        pause "First character is not numerical"
        goto STARTOVER
:ERR2
        pause "Last character is not numerical"
        goto STARTOVER
:ERR3
        pause "Invalid character at offset %d",ct+1
        goto STARTOVER
:ERR4
        pause "Duplicate hypent or comma found at offset %d",ct+1
        goto STARTOVER
:ERR5
        pause "Level number(s) must be between 1 and 256."
        goto STARTOVER
:ERR6
        pause "Start level range cannot be larger than end level range"
        goto STARTOVER
:ERR7
        pause "Cannot concatinate level ranges"
        goto STARTOVER
:STARTOVER
        if (opt == 0)
           goto SUBLEV
        if (opt == 1)
           goto ADDLEV
:ALLBUT
       clearsel 1
       i = 0
:SAVE23
       LEVMASK[i] = @LEVELS[i]
       IF ((i = i + 1) < 16)
          GOTO SAVE23
:RECYCLE2
       getmenu "Select an option","Single","Undo"
       on (@key+3) goto ESC,START,RECYCLE2,ESC,PICK2,UNDO2
:UNDO2
       set levelmask, LEVMASK
       redraw -1
       goto RECYCLE2
:PICK2
       pt = 0
       getentm 1, total
       on (@key+3) goto ESC,RECYCLE2,PICK2,,,,,,,,,,,,,,,
       levels 0,1,255
:SELECT2
       if (total <= 0)
          goto STOP2
       getnext ent,total
       total = total - 1
       levels 1,@intdat[4]
       goto SELECT2
:STOP2
       redraw -1
       goto RECYCLE2

:LEV_OFF
       i = 0
:SAVE22
       LEVMASK[i] = @LEVELS[i]
       IF ((i = i + 1) < 16)
          GOTO SAVE22
:RECYCLE1
       getmenu "Select an option","Single","Recall-1","Undo"
       on (@key+3) goto ESC,START,LEV_OFF,ESC,PICK1,RECALL,UNDO1
:UNDO1
       set levelmask, LEVMASK
       redraw -1
       goto RECYCLE1
:PICK1
       clearsel 1
       pt = 0
       getentm 1, total
       on (@key+3) goto ESC,START,PICK1,,,,,,,,,,,,,,,,
:SELECT1
       if (total <= 0)
          goto STOP1
       getnext ent,total
       total = total - 1
       levs[pt]=@intdat[4]
       levels 0,levs[pt]
       pt = pt + 1
       nextcoll 1, etype,id
       if (@error == 0)
          goto ISCOLLECT
       goto SELECT1
:ISCOLLECT
:COLLOOP
       nextcoll -32767, etype,id
       if (@error == -5)
          goto SELECT1
       total = total - 1
       goto COLLOOP
:STOP1
       redraw -1
       goto RECYCLE1
:RECALL
       pt = pt - 1
       if (pt < 0)
          goto RECYCLE1
       levels 1,levs[pt]
       redraw -1
       goto RECYCLE1
:ESC
       clear $DATFILE,$MM,$PMPT,$LNAME,$NUM,$IN,\
       LEVMASK,LEVMASK1,LEVMASK2,LEVMASK3,NEWMASK,LEVNUM,ACTION,\
       levs,pt,ent,one,lev,i,count,new,old,total,pickmode,\
       offset,dummynum,sz,ct,opt
       clearsel 1