home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Media Share 9
/
MEDIASHARE_09.ISO
/
bbs
/
popmax1.zip
/
COMPILE.POP
next >
Wrap
Text File
|
1993-06-13
|
13KB
|
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}
{}