Beijing Paradise BBS Backup/PARADISE.ISO/software/BBSDOORW/POPMAX1.ZIP/COMPILE.POP

Text File | 1993-06-13 | 12.2 KB | 342 lines

{:rit}
{return}

{:writh}
{writ ^(:top^)}
{writ ^(call %%subnam^)}
{writ ^(macl popmax.pop,wait^)}
{return}

-------------------------------------------------------------------------------
{:alk}
{:maksubs}--make subroutines for new menu data file
{clear}
{disp 2,1,07,Note: Compile function is slow. Approximately 2 seconds per option!}
{setv nsubct,0}
{setv endthred,0}
{setv counta,0}
{setv key,abcdefghijklmnopqrstuvwxyz}
{call opfil2}               open files for read/write
{call writh}
{call set2}                 setup for this sub
{call ext2}                 read num from data file
{setv writct,0}
{wclos}
{rclos}
{wopen-a popdata.pop}
{call appen}
{macl popmax.pop,alj}
{return}

{:opfil2}
{wclos}
{rclos}
{wopen popdata.pop}
{ropen outline.pop,rit}
{return}

{:set2}---setvars
{setv hilev,8}
{setv lev,0}
{setv ccl,0}
{setv cc,0}
{call setvars}
{setv writct,0}
{setv laslev,0}
{setv xpoint,0}
{return}

{:setvars}
{incr cc}
{comp cc,8}
{ifco-g rit}
{setv count%cc,0}
{setv nxt%cc,0}
{goto setvars}



{:ext2}---extract level number from read-in line
{read %line}
{call convert}
{call comp2}           compare lastlevel and current
{goto ext2}            repeat until EOF

{:setless}---set levels to the right (higher levels) to zero
{incr writct}                          increment temp pointer
{comp writct,%hilev}                   compare to last pointer pos
{ifco-g rit}                           if greater, were done
{setv count%writct,0}                  set value in this exp var to zero
{goto setless}                         repeat

{:comp2}--compare level number read from file
{disp 5,3,3,                                              }
{disp 5,3,3,%text}
{comp laslev,%lev}    compare val of lastlevel pointer to current level pointer
{ifco-l uplev}        if last num < current, up level pointer
{ifco-e upcnt}        if last num=current increment value held at pointer
{ifco-g downlev}      if last num > current decrement level pointer
{}

{:turnover}---turnover counter
{incr endthred}                  increment new postion of aray to stor tie-end subs
{setv pos%endthred,%nsubnam}     put sub name in tndthread aray for recall
{setv lastopt,%lev}              put level number in var lastopt
{setv writct,%lev}               mark beginning position of reset pointer
{call setless}                   reset all vars to right back to zero
{return}

{:upcnt}--increment value held at current level pointer
{setv-s ccl,count%lev}           store current value at pointer in CCL
{incr ccl}                       increment this value
{setv count%lev,%ccl}            put it back into expanded var
{setv writct,0}                  clear writct
{setv lsubnam,%subnam}           get last subname
{setv subnam}                    clear subname
{setv nsubnam}                   clear out new subroutine name
{call asm}                       assemble new subname
{call subinfo}                   write info to file
{return}


{:subinfo}---write subroutine information
{writ}
{writ ^(:%subnam%^)---display data for this option}
{writ ^(incr optc^)}                  write instruction to bump up counter
{writ ^(setv txt%%optc,%text^)}        insert display information
{writ ^(setv opt%%optc,%outext^)}      insert display information
{writ ^(setv type%%optc%,%type%^)}            set type of command
{writ ^(setv this%%optc%,%subnam%^)}            set type of command
{writ ^(goto %nsubnam^)}
{setv writct,0}
{return}

--------------------

{:uplev}---increment level pointer
{writ}
{setv retopt,%subnam}
{setv ty,%lev}
{decr ty,%laslev}
{writ Going up %ty% level(s) ,from level %laslev% to %lev% ----------->>>}
{incr nsubct}
{setv hold%nsubct,%nsubnam}
{disp 1,3,3,Going up from level %laslev% to %lev% ----------->>>             }
{setv laslev,%lev}               bring last level pointer to current level
{incr count%lev}
{setv writct,0}
{setv lsubnam,%subnam}
{setv subnam}
{setv nsubnam}
{call asm}
{call subinfo}
{return}


{:downlev}-- decrement level pointer
{writ ^(:%nsubnam%^)}
{writ ^(return^)}
{call turnover}                  turn over all vars to right (set to 0)
{setv fcc,0}
{setv ty,%laslev}
{decr ty,%lev}
{writ}
{writ <<------ going back %ty% level(s) from level %laslev% to level %lev}
{disp 1,3,2,<<------ going back from level %laslev% to %lev                   }
{setv laslev,%lev}               make last level pointer current
{incr count%lev}                 add 1 to val held at current counter pos
{setv writct,0}                  reset our temp pointer
{setv lsubnam,%subnam}
{setv subnam}
{setv nsubnam}
{call asm}
{call subinfo}
{return}

--------------------------------------------

{:asm}---assemble sub name
{setv point,0}
{setv ccc,0}
{call copynext}
{incr nxt%lev}
{call assemble}
{comp lastopt,false}
{ifco ,resxt}
{disp 4,4,3,%subnam% %nsubnam}
{return}

{:assemble}
{incr writct}            increment position counter
{comp writct,%hilev}     is counter greater than highest count?
{ifco-g rit}             if true display

{setv-s cc,count%writct}     store current val under temp pointer to cc
{setv-s ccc,nxt%writct}     store current val under temp pointer to cc2

{incr cc}                     add one to value so zero can be accounted for-count
{incr ccc}                     add one to value so zero can be accounted for-nxt
{subs c1,%cc%,1,%key}         find the representative letter in key  (count)
{subs c2,%ccc%,1,%key}        find the representative letter in key  (nxt)
{setv subnam,%subnam%%c1}    append subroutine name
{setv nsubnam,%nsubnam%%c2}    append subroutine name
{goto asm}

{:copynext}---copy array into second array for next presumed sub
{incr point}
{comp point,%hilev}
{ifco-g rit}
{setv-s tranum,count%point}
{setv nxt%point,%tranum}
{goto copynext}

{:resxt}--reset next option number, due to this being last option
{comp lev,%lastopt}
{ifco-e ,rit}
{return}

{:appen}--append subs with leftover information
{writ ^(:rit^)}
{writ ^(return^)}
{incr nsubct}
{setv hold%nsubct,%nsubnam}
{setv zcount,0}
{call capit}
{writ ^(return^)}
{return}

{:capit} -- write all the possible varible names at end of file, so return can happen
{incr zcount}
{comp zcount,%nsubct}
{ifco-g rit}
{setv-s coop,hold%zcount}
{writ ^(:%coop%^)}
{goto capit}

{:capit2}----write all the direct sub names
{incr zcount}
{comp zcount,%xpoint}
{ifco-g rit}
{setv-s coop,xhold%zcount}
{writ ^(:%coop%^)}
{goto capit2}


{:setall}-------
{setv xsubnam}
{setv flev,0}
{setv point,0}
{setv writct,0}
{setv subnam}
{call trans}      transfer COUNT array to ALL array
{setv flev,%lev}
{incr flev}
{comp flev,%hilev}         is it bigger than Highest menu level?
{ifco-g zout}            if so, assign it to zzzzz...
{call assign}
{call alsm}
{return}

{:zout}----set rta keypress values to special subname
{setv subnam,zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz}
{subs xsubnam,1,%hilev%,%subnam}
{return}


{:assign}-------------assign aray to subname
{setv-s fcc,count%flev}
{incr fcc}
{setv all%flev,%fcc}
{return}

{:trans}----transfer values of top variable
{incr point}
{comp point,%hilev}
{ifco-g rit}
{setv-s tranum,count%point}
{setv all%point%,%tranum}
{goto trans}

-------------------------------------------------------------------------------
                         Begin Compile
-------------------------------------------------------------------------------
{:convert}                      main body of conversion program
{setv total,0}                  clear our write file line count
{setv counter,0}                set dash-counter (menulevel) to zero

{:rcompile}                         begin compiling
{setv ast,-}                        set value of menulevel char (-) to level one
                                    drop through
{:testagain}                    test line for menu level
{inst line,%ast}              find first instance of sought menulev in line
{comp %_pos,0}                  is the position result zero? (not in line)
{ifco-e extract}                if it is, we have found menulevel; extract text
{incr counter}                  if not, increment our menulevel counter
{setv ast,%ast%-}               add another dash (menulev) to our search string
{goto testagain}                recycle until we get result 0, or file end

{:extract}                        extract, write 3 fields from human file line
                                    *general setup for this subroutine*
{length %inline)                  get total length of input line we read
{setv lenin,%_len}                put it in var LENIN
{incr total}                      increment our write file line number
                                               *get first field (menu level)*
{setv lev,%counter%}
{incr counter}                    increment menulev counter so it represents
                                  the first character of the field next to the
                                  dashes (first position of our next field
                                  e.g. field#2,the menu option's text decription)
{instr line,`}                  now find the first left small-quote in the
                                  line, indicating the postion to the right of
                                  the end of field#2.
{comp %_pos,0}                    is there no "`"?
{ifco-e closf}                  if not close files, end.
{setv endpos2,%_pos}              put the bracket location (field#2
                                  truncaton point) in ENDPOS2
{setv lenfeld2,%endpos2}                             set the length of field 2
                                                     (LENFELD2) to this value
{decr lenfeld2,%counter}                             count back the num of
                                                     dashes (COUNTER) to get
                                                     actual length of field 2
                                                     (LENFELD2)
{subs text,%counter,%lenfeld2,%line}               extract text for field 2
                                                     (TEXT)

                                  *get third field (selection output text)*
{instr line,`}                  now re-find the first left smallquote in the
                                  in our human input string, indicating the
                                  start position of field #3 (menu option
                                  hidden output string)
{setv beginpos,%_pos}             store location of first leftsmallquote
{incr beginpos}                   move over one position to locate first char
                                  in 3rd field; we now have BEGINPOS
{inst line,'}                   now find the first right small quote in the
                                  human input line, indicating postion to the
                                  right of the end of field#3
{setv endpos,%_pos}               store location of first rightsmallquote
                                  --our truncation point for this field
{setv lenfeld3,%endpos}           set preliminary length of field3 to the
                                  ending postion of field3
{decr lenfeld3,%beginpos}                      get the actual length of field 3
                                               by subtracting the beginning pos
                                               from the end pos
{subs outext,%beginpos%,%lenfeld3%,%line}    extract field#3 from within the
                                               small quote chars in our human
                                               input line. put in OUTEXT
{setv counter,0}                        reset menulevel counter
{comp outext}                           is outext nul?
{ifco address}                          if so, set command status to indirect
{setv type,direct}                      if not, set it to indirect
{return}                                return

{:address}
{setv type,indirect}
{return}                         go back and compile more lines
-------------------------------------------------------------------------------
                            end compile
-------------------------------------------------------------------------------
{:stt}
{}