home *** CD-ROM | disk | FTP | other *** search
/ PDA Software Library / pdasoftwarelib.iso / PSION / 1997 / 866 / HELPKIT1.ZIP / HELPCOMP.OPL < prev    next >
Encoding:
Text File  |  1994-12-17  |  7.7 KB  |  476 lines
  1. PROC main%:
  2.     LOCAL name$(130)
  3.     
  4.     name$="\opd\.hlp"
  5. main::
  6.     ONERR done
  7.     dINIT "Help compiler"
  8.     dFILE name$,"Source",0
  9.     IF DIALOG=0
  10.         RETURN
  11.     ENDIF
  12.     DoComp%:(name$)
  13.     RAISE 0
  14.     
  15. done::
  16.     ONERR OFF
  17.     IF ERR<0
  18.         PRINT ERR$(ERR)
  19.         GOTO main
  20.     ELSEIF ERR>0
  21.         GOTO main
  22.     ELSE
  23.         PRINT "Finished compiling."
  24.     ENDIF
  25.     
  26.     PRINT "Press ENTER to quit."
  27.     WHILE GET<>13 :ENDWH
  28. ENDP
  29.  
  30. proc decode$:(a$)
  31.     local t$(255),i%
  32.     t$=a$
  33.     
  34.     while 1
  35.         i%=i%+1
  36.         if i%>len(t$)
  37.             break
  38.         endif
  39.         if mid$(t$,i%,1)="#"
  40.             if ishash%:(t$,i%)
  41.                 t$=replace$:(t$,i%)
  42.                 i%=i%-1
  43.             endif
  44.         endif
  45.     endwh
  46.     return t$
  47. endp
  48.  
  49. proc replace$:(a$,pos%)
  50.     local c%
  51.     
  52.     c%=VAL(mid$(a$,pos%+1,3))
  53.     return LEFT$(a$,pos%-1)+chr$(c%)+right$(a$,len(a$)-pos%-3)
  54. endp
  55.  
  56. proc ishash%:(a$,pos%)
  57.     local i%,t%,ch$(1)
  58.     
  59.     t%=pos%+3
  60.     i%=pos%
  61.     while i%<t%
  62.         i%=i%+1
  63.         ch$=MID$(a$,i%,1)
  64.         if ch$<"0" or ch$>"9"
  65.             return 0
  66.         endif
  67.     endwh
  68.     return -1
  69. endp
  70.  
  71. PROC CPtopic%:
  72. REM  Write the main topic resource
  73.     
  74.     CPptr%=USR(UADD%,CPptr%,1,0,0)
  75.     POKE$ CPptr%,PPtitle$+CHR$(0)+CHR$(0)
  76.     CPptr%=USR(UADD%,CPptr%,-1,0,0)
  77.     POKEW CPptr%,PPidx%+2
  78.     RETURN LEN(PPtitle$)+4
  79. ENDP
  80.  
  81. PROC CPindex%:
  82.     LOCAL nitems%
  83.     
  84.     POKEB CPptr%,PPidx%
  85.     CPptr%=USR(UADD%,CPptr%,1,0,0)
  86.     WHILE nitems%<PPidx%
  87.         nitems%=nitems%+1
  88.         POKEW CPptr%,nitems%+1
  89.         CPptr%=USR(UADD%,CPptr%,2,0,0)
  90.     ENDWH
  91.     RETURN 1+2*nitems%
  92. ENDP
  93.  
  94. PROC CPbody%:
  95. REM  Write the individual topics
  96.     LOCAL buf$(255),line%,origptr%,count%
  97.     LOCAL byte%,written%
  98.     
  99.     WHILE line%<PPtopic%(CPidx%)
  100.         buf$=GetLine$:+CHR$(0)
  101.         line%=PFRline%:
  102.     ENDWH
  103.     origptr%=CPptr%
  104.     
  105.     REM Write topic name:
  106.     CPptr%=USR(UADD%,CPptr%,1,0,0)
  107.     POKE$ CPptr%,buf$
  108.     CPptr%=USR(UADD%,CPptr%,LEN(buf$)+1,0,0)
  109.     byte%=PPsize%(CPidx%)
  110.     
  111.     WHILE count%<PPsize%(CPidx%)
  112.         count%=count%+1
  113.         buf$=GetLine$:+CHR$(0)
  114.         POKE$ CPptr%,buf$
  115.         POKEB CPptr%,byte%
  116.         CPptr%=USR(UADD%,CPptr%,LEN(buf$),0,0)
  117.         byte%=0
  118.     ENDWH
  119.     
  120.     POKEW origptr%,0
  121.     written%=USR(UADD%,CPptr%,-origptr%,0,0)
  122.     RETURN written%+1
  123. ENDP
  124.  
  125. PROC CPwrite%:(buf%,nitems%)
  126.     GLOBAL UADD&,UADD%,CPptr%,CPidx%
  127.     
  128.     CPptr%=buf%
  129.     UADD&=&CBC303
  130.     UADD%=ADDR(UADD&)
  131.     CPidx%=nitems%-1
  132.     print cpidx%,ppidx%
  133.     IF CPidx%=0
  134.         RETURN CPtopic%:
  135.     ELSEIF CPidx%<=PPidx%
  136.         RETURN CPbody%:
  137.     ELSEIF CPidx%=PPidx%+1
  138.         RETURN CPindex%:
  139.     ELSE
  140.         RETURN 0
  141.     ENDIF
  142. ENDP
  143.  
  144.  
  145. PROC CPmain%:
  146. REM  Main compiler pass
  147. REM  CPname$ is assumed to be set up
  148. REM  as the output name.
  149.     busy "Processing"
  150.     RWinit%:("CPwrite",CPname$)
  151. ENDP
  152.  
  153. PROC DoComp%:(title$)
  154.     GLOBAL PPidx%,PPtopic%(255),PPsize%(255)
  155.     GLOBAL PPtitle$(80),PPpath$(130),CPname$(130)
  156.     LOCAL o%(8)
  157.     
  158.     ONERR done
  159.     PFRinit%:("PPmain",title$)
  160.     CPname$=PARSE$("\opd\.rsc",title$,o%())
  161.     CPname$=PARSE$(PPpath$,CPname$,o%())
  162.     PFRinit%:("CPmain",title$)
  163.     RAISE 0
  164.     
  165. done::
  166.     ONERR OFF
  167.     BUSY OFF
  168.     IF ERR
  169.         RAISE ERR
  170.     ENDIF
  171. ENDP
  172.  
  173. PROC PPmain%:
  174.     LOCAL buf$(255)
  175.     
  176.     ONERR done
  177.     busy "Analysing"
  178.     PPtitle$=GetText$:
  179.     IF Begin%:(PPtitle$)
  180.         RAISE -85
  181.     ENDIF
  182.     IF End%:(PPtitle$)
  183.         RAISE -85
  184.     ENDIF
  185.     
  186.     PPpath$=GetText$:
  187.     IF Begin%:(PPpath$)
  188.         PPpath$=""
  189.         PPtop%:(GetText$:)
  190.     ENDIF
  191.     WHILE 1
  192.         buf$=GetText$:
  193.         IF Begin%:(buf$)
  194.             PPtop%:(GetText$:)
  195.         ELSE
  196.             RAISE -85
  197.         ENDIF
  198.     ENDWH
  199.     
  200. done::
  201.     ONERR OFF
  202.     IF ERR<>-36
  203.         PRINT ERR$(ERR)+" at line "+GEN$(PFRline%:,10)
  204.         RAISE -ERR
  205.     ENDIF
  206. ENDP
  207.  
  208. PROC PPtop%:(text$)
  209.     LOCAL buf$(255),line%,size%
  210.     
  211.     IF Begin%:(text$) OR End%:(text$)
  212.         RAISE -85
  213.     ENDIF
  214.     
  215.     
  216.     line%=PFRline%:
  217.     buf$=GetLine$:
  218.     size%=PPtext%:(buf$)
  219.     
  220.     PPidx%=PPidx%+1
  221.     PPtopic%(PPidx%)=line%
  222.     PPsize%(PPidx%)=size%
  223. ENDP
  224.  
  225.  
  226.  
  227.  
  228. PROC PPtext%:(text$)
  229.     LOCAL buf$(255),count%
  230.     
  231.     ONERR error
  232.     IF End%:(text$)
  233.         RAISE -85
  234.     ENDIF
  235.     
  236.     DO
  237.         buf$=GetLine$:
  238.         IF Begin%:(buf$)
  239.             RAISE -85
  240.         ENDIF
  241.         count%=count%+1
  242.     UNTIL End%:(buf$)
  243.     
  244.     RETURN count%
  245.     
  246. error::
  247.     ONERR OFF
  248.     IF ERR=-36
  249.         RAISE -85
  250.     ELSE
  251.         RAISE ERR
  252.     ENDIF
  253. ENDP
  254.  
  255. PROC End%:(text$)
  256.     IF UPPER$(LEFT$(Trim$:(text$),4))="#END"
  257.         RETURN -1
  258.     ENDIF
  259. ENDP
  260.  
  261. PROC Begin%:(text$)
  262.     IF UPPER$(LEFT$(Trim$:(text$),6))="#BEGIN"
  263.         RETURN -1
  264.     ENDIF
  265. ENDP
  266.  
  267. PROC GetLine$:
  268.     return decode$:(PFRread$:)
  269. ENDP
  270.  
  271. PROC GetText$:
  272.     LOCAL buf$(255)
  273.     
  274.     DO
  275.         buf$=GetLine$:
  276.     UNTIL Trim$:(buf$)<>""
  277.     
  278.     RETURN buf$
  279. ENDP
  280.  
  281. REM ----------------------------------------
  282. REM Resource compiler engine.
  283. REM (General purpose - writes ANY .rsc file!)
  284.  
  285. PROC RWinit%:(func$,fname$)
  286.     GLOBAL RWindex%(512),RWchan%
  287.     LOCAL offset%,idxlen%,nitems%,err%,fsize%
  288.     
  289.     ONERR done
  290.     
  291.     REM Open file for writing:
  292.     RWchan%=IoOpen%:(fname$,$0302,0)
  293.     
  294.     REM Write 4 bytes of junk at head:
  295.     IoWrite%:(RWchan%,ADDR(offset%),4)
  296.     
  297.     REM Write the actual resources:
  298.     nitems%=RWwrite%:(func$)
  299.     
  300.     REM Get current position in file:
  301.     offset%=IoSeek%:(RWchan%,3,&0)
  302.     
  303.     REM Write the resource index table:
  304.     IoWrite%:(RWchan%,ADDR(RWindex%()),nitems%*2)
  305.     
  306.     REM Get current position in file:
  307.     fsize%=IoSeek%:(RWchan%,3,&0)
  308.     
  309.     REM Write index position and length:
  310.     IoSeek%:(RWchan%,1,&0) :REM Start of file
  311.     idxlen%=nitems%*2 :REM 2 bytes per entry
  312.     IoWrite%:(RWchan%,ADDR(offset%),4)
  313.     RAISE 0 :REM Finished OK
  314.     
  315. done::
  316.     ONERR OFF
  317.     IOCLOSE(RWchan%)
  318.     IF ERR
  319.         err%=ERR
  320.         TRAP DELETE fname$
  321.         RAISE err%
  322.     ENDIF
  323.     RETURN fsize%
  324. ENDP
  325.  
  326. PROC RWwrite%:(func$)
  327. REM  Routine to write individual resources.
  328. REM  Used privately by the 'RWinit%'
  329. REM  Calls back YOUR function,
  330. REM  see the spec for 'RWinit%' above.
  331.     
  332.     GLOBAL RWbuf&(1024) :REM 4k buffer
  333.     GLOBAL RWbuf%
  334.     LOCAL nitems%,next%,size%
  335.     
  336.     RWbuf%=ADDR(RWbuf&(1))
  337.     RWindex%(1)=4
  338.     
  339.     WHILE 1
  340.         nitems%=nitems%+1
  341.         size%=@%(func$):(RWbuf%,nitems%)
  342.         RWindex%(nitems%+1)=size%+RWindex%(nitems%)
  343.         IF size%=0
  344.             BREAK
  345.         ENDIF
  346.         IoWrite%:(RWchan%,RWbuf%,size%)
  347.     ENDWH
  348.     
  349.     RETURN nitems%
  350. ENDP
  351.  
  352. REM -----------------------------------------
  353. REM Standard I/O routines with error handling
  354.  
  355. PROC IoOpen%:(name$,mode%,oldhand%)
  356. REM  System version of IOOPEN
  357. REM  Cures some problems with the
  358. REM  Series 3 Classic version, and
  359. REM  adds proper error mechanism.
  360.     
  361.     LOCAL ax%,bx%,cx%,dx%,si%,di%
  362.     LOCAL txt%(129)
  363.     
  364.     REM Convert name to ZTS:
  365.     POKE$ ADDR(txt%(1)),"#"+name$
  366.     
  367.     bx%=ADDR(txt%(2))
  368.     cx%=mode%
  369.     dx%=oldhand%
  370.     IF (OS($85,ADDR(ax%)) AND 1)
  371.         RAISE (ax% OR $FF00)
  372.     ENDIF
  373.     RETURN ax%
  374. ENDP
  375.  
  376. PROC IoRead%:(hand%,adr%,size%)
  377. REM  Error-handling version of IOREAD
  378.     
  379.     LOCAL ret%
  380.     
  381.     ret%=IOREAD(hand%,adr%,size%)
  382.     IF ret%<0
  383.         RAISE ret%
  384.     ENDIF
  385.     
  386.     RETURN ret%
  387. ENDP
  388.  
  389. PROC IoWrite%:(hand%,adr%,size%)
  390. REM  Error-handling version of IOWRITE
  391.     
  392.     LOCAL ret%
  393.     
  394.     ret%=IOWRITE(hand%,adr%,size%)
  395.     IF ret%<0
  396.         RAISE ret%
  397.     ENDIF
  398. ENDP
  399.  
  400. PROC IoSeek%:(hand%,mode%,newpos&)
  401. REM  Error-handling version of IOSEEK
  402.     
  403.     LOCAL ret%,pos&
  404.     
  405.     pos&=newpos&
  406.     
  407.     ret%=IOSEEK(hand%,mode%,pos&)
  408.     IF ret%<0
  409.         RAISE ret%
  410.     ENDIF
  411.     
  412.     RETURN pos&
  413. ENDP
  414.  
  415. REM --------------------------------
  416. REM General purpose string functions
  417.  
  418. PROC Trim$:(string$)
  419. REM  Trim leading spaces
  420.     
  421.     LOCAL tr$(255)
  422.     
  423.     tr$=string$
  424.     
  425.     WHILE LEFT$(tr$,1)=" "
  426.         IF LEN(tr$)=1
  427.             RETURN
  428.         ENDIF
  429.         tr$=MID$(tr$,2,255)
  430.     ENDWH
  431.     
  432.     RETURN tr$
  433. ENDP
  434.  
  435. REM --------------------------
  436. REM Simple passive file reader
  437.  
  438. PROC PFRinit%:(func$,fname$)
  439.     GLOBAL PFRhand%,PFRlcnt%
  440.     
  441.     ONERR done
  442.     PFRhand%=IoOpen%:(fname$,$0020,0)
  443.     @%(func$):
  444.     RAISE 0
  445.     
  446. done::
  447.     ONERR OFF
  448.     IOCLOSE(PFRhand%)
  449.     IF ERR
  450.         RAISE ERR
  451.     ENDIF
  452. ENDP
  453.  
  454. PROC PFRread$:
  455.     LOCAL buf%(130),bufZTS%,bufLBC%
  456.     
  457.     bufLBC%=ADDR(buf%(1))
  458.     bufZTS%=ADDR(buf%(2))
  459.     
  460.     IoRead%:(PFRhand%,bufZTS%,254)
  461.     buf%(1)=CALL($B9,0,0,0,0,bufZTS%)+1
  462.     
  463.     PFRlcnt%=PFRlcnt%+1
  464.     RETURN MID$(PEEK$(bufLBC%),2,255)
  465. ENDP
  466.  
  467. PROC PFRline%:
  468. REM  Return the current line number:
  469.     
  470.     RETURN PFRlcnt%
  471. ENDP
  472.  
  473. REM -----------------
  474.  
  475. REM End of file 
  476.