home *** CD-ROM | disk | FTP | other *** search
/ Collection of Hack-Phreak Scene Programs / cleanhpvac.zip / cleanhpvac / PWAEBL10.ZIP / EBL.PPS < prev    next >
Text File  |  1995-04-09  |  10KB  |  335 lines
  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ; Enhanced Bulletin Lister v1.0
  3. ; Written by Drew [PWA]
  4. ; Last updated 04-06-95
  5. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  6.  
  7.  
  8.  
  9. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  10. ; function/procedure decl's
  11. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  12. declare procedure Initialize()
  13. declare function  GetBullList() string
  14. declare function  GetMaxLength() byte
  15. declare procedure GetInput()
  16. declare procedure CheckHotKey(byte ascii, var byte currow, var byte curblt)
  17. declare procedure ParseSelected(byte curblt)
  18. declare procedure PrintMenu()
  19. declare procedure PrintBulletin(byte curblt)
  20. declare procedure PrintCredits()
  21. declare procedure PrintHighlight(byte currow)
  22. declare procedure RestoreText(byte currow)
  23. declare procedure GetManualInput(string select)
  24.  
  25.  
  26.  
  27. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  28. ; global var's.
  29. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  30. string bltlstfile     ; the BLT.LST file
  31. string bltmenu        ; the BLT menu
  32. string lb_colour      ; colour of lightbar
  33. string save_text      ; used to save and restore highlighted text
  34. byte numblt           ; number of bulletins
  35. byte startrow         ; starting row for lightbar
  36. byte startcol         ; starting column for lightbar
  37. byte numskiprow       ; number of rows to skip per lightbar movement
  38. byte lb_length        ; lightbar length
  39. boolean autopause     ; pause after displaying every bulletin
  40.  
  41.  
  42.  
  43. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  44. ; main
  45. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  46. begin
  47.     Initialize()
  48.     PrintMenu()
  49.     GetInput()
  50. end
  51.  
  52.  
  53.  
  54. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  55. ; gets input from user, moves lightbar, etc.
  56. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  57. procedure GetInput()
  58.     boolean done
  59.     byte curblt
  60.     byte ascii
  61.     byte currow
  62.  
  63.     ansipos startcol, startrow
  64.     currow = startrow
  65.     PrintHighlight(currow)
  66.  
  67.     curblt = 1
  68.     done = FALSE
  69.     while (!done) do
  70.         ascii = asc(inkey())
  71.         delay 1
  72.         select case (ascii)
  73.         case 13
  74.             ; carriage return - print the bulletin, and remain in the ppe
  75.             ;
  76.             PrintBulletin(curblt)
  77.             PrintMenu()
  78.             PrintHighlight(currow)
  79.         case 76, 85, 56
  80.             ; left arrow, up arrow, 8
  81.             RestoreText(currow)
  82.             dec curblt
  83.             if (curblt < 1) curblt = numblt
  84.             currow = currow - numskiprow
  85.             if (currow < startrow) currow= startrow + (numblt * numskiprow) - 2
  86.             PrintHighlight(currow)
  87.         case 82, 68, 50
  88.             ; right arrow, down arrow, 2
  89.             RestoreText(currow)
  90.             inc curblt
  91.             if (curblt > numblt) curblt = 1
  92.             currow = currow + numskiprow
  93.             if (currow > startrow + (numblt * numskiprow) - 1) currow= startrow
  94.             PrintHighlight(currow)
  95.         case 27, 81, 113
  96.             ; ESC, Q, q - quit
  97.             done = TRUE
  98.         default
  99.             ; make sure the parameter is the ascii # of the lower case letter.
  100.             ; variables "done" and "curblt" cat get updated here.
  101.             ;
  102.             CheckHotKey(asc(lower(chr(ascii))) - 96, currow, curblt)
  103.         endselect
  104.     endwhile
  105.  
  106.     PrintCredits()
  107. endproc
  108.  
  109.  
  110.  
  111. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  112. ; check if the user hit a hotkey corresponding to the bulletin.  if so, then
  113. ; print the bulletin and remain in the ppe
  114. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  115. procedure CheckHotKey(byte ascii, var byte currow, var byte curblt)
  116.     if ((ascii >= 1) && (ascii <= numblt)) then
  117.         RestoreText(currow)
  118.         currow = currow + ((ascii - curblt) * numskiprow)
  119.         PrintHighlight(currow)
  120.         curblt = ascii
  121.         PrintBulletin(curblt)
  122.         PrintMenu()
  123.         PrintHighlight(currow)
  124.     endif
  125. endproc
  126.  
  127.  
  128.  
  129. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  130. ; i hope no one minds. :)
  131. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  132. procedure PrintCredits()
  133.     ansipos 1, u_pagelen
  134.     defcolor
  135.     println "@X08Enhanced Bulletin Lister v1.0 by Drew [PWA]@X07"
  136. endproc
  137.  
  138.  
  139.  
  140. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  141. ; save the old text and then print the lightbar
  142. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  143. procedure PrintHighlight(byte currow)
  144.     save_text = scrtext(startcol, currow, lb_length, TRUE)
  145.     ansipos startcol, currow
  146.     print lb_colour + stripatx(save_text)
  147. endproc
  148.  
  149.  
  150.  
  151. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  152. ; restore text (after moving lightbar)
  153. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  154. procedure RestoreText(byte currow)
  155.     ansipos startcol, currow
  156.     print save_text
  157. endproc
  158.  
  159.  
  160.  
  161. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  162. ; print the BLT file
  163. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  164. procedure PrintMenu()
  165.     ; make sure we clear the screen
  166.     cls
  167.     dispfile bltmenu, DEFS
  168. endproc
  169.  
  170.  
  171.  
  172. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  173. ; print the bulletin.  reads from BLT.LST automatically. :)
  174. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  175. procedure PrintBulletin(byte curblt)
  176.     string foo
  177.  
  178.     ; get the full pathname of the bulletin
  179.     ;
  180.     fopen 1, bltlstfile, O_RD, S_DW
  181.     fseek 1, (curblt-1) * 30, seek_set
  182.     fread 1, foo, 30
  183.     fclose 1
  184.  
  185.     ; show the darn bulletin, trimming any trailing spaces
  186.     ;
  187.     ansipos 1, u_pagelen
  188.     dispfile rtrim(foo, " "), DEFS
  189.     if (autopause) wait
  190. endproc
  191.  
  192.  
  193.  
  194. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  195. ; does a whole bunch of initializing.  see inline documentation for more
  196. ; details (should be straight forward).
  197. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  198. procedure Initialize()
  199.     byte numtok, i, confnum
  200.     string cnames
  201.     string ebl_cfg
  202.     string foo, foo2
  203.     string select
  204.     boolean found
  205.  
  206.     ; if the user does something like "b 1", then kbdstuff accordingly
  207.     ;
  208.     numtok = tokcount()
  209.     if (numtok) then
  210.         foo = "B "
  211.         for i = 1 to numtok
  212.             foo = foo + " " + gettoken()
  213.         next i
  214.         kbdstuff foo
  215.         end
  216.     endif
  217.  
  218.     ; get the CNAMES file
  219.     ;
  220.     cnames = readline(pcbdat(), 31)
  221.     if (!exist(cnames)) then
  222.         println cnames + " does not exist.  Bad path in PCBOARD.DAT"
  223.         end
  224.     endif
  225.  
  226.     ; get the BLT menu file (uses the CNAMES file)
  227.     ;
  228.     bltmenu = readline(cnames, (curconf() * 33) + 24)
  229.  
  230.     ; we might want to do something if the menu doesn't exist...
  231.     ;    if (!exist(bltmenu)) then
  232.     ;        println "@X0CWarning!  Bulletin menu does not exist!@X07"
  233.     ;    endif
  234.  
  235.  
  236.     ; get the full BLT.LST pathname (uses the CNAMES file)
  237.     ;
  238.     bltlstfile = readline(cnames, (curconf() * 33) + 25)
  239.     if (!exist(bltlstfile)) then
  240.         ; no bulletins, so stuffing "B" alone should automatically make
  241.         ; pcboard display the "no bulletins" message
  242.         ;
  243.         kbdstuff "B"
  244.         end
  245.     endif
  246.  
  247.     ; calculate number of bulletins
  248.     ;
  249.     numblt = fileinf(bltlstfile, 4) / 30
  250.  
  251.  
  252.     ; check our config file
  253.     ;
  254.     ebl_cfg = ppepath() + "EBL.CFG"
  255.     if (!exist(ebl_cfg)) then
  256.         println "@X0CError!  " + ebl_cfg + " does not exist!@X07"
  257.         end
  258.     endif
  259.  
  260.     ; the first line is used if there is no line in the config file that
  261.     ; corresponds with the current conference.
  262.     ;
  263.     fopen 1, ebl_cfg, O_RD, S_DW
  264.     fdefin 1
  265.  
  266.     fdget foo
  267.     if (lower(foo) == "yes") then
  268.         autopause = TRUE
  269.     else
  270.         autopause = FALSE
  271.     endif
  272.  
  273.     fdget select
  274.  
  275.  
  276.     ; otherwise, get a line, see if the first token corresponds to the
  277.     ; current conference.
  278.     ;
  279.     fdget foo
  280.     found = FALSE
  281.     while (foo != "<eof>") do
  282.         tokenize foo
  283.         foo2 = gettoken()
  284.         if ((lower(foo2) == "main") && (curconf() == 0)) then
  285.             found = TRUE
  286.             break
  287.         else
  288.             confnum = s2i(foo2, 10)
  289.             if ((curconf() != 0) && (confnum == curconf())) then
  290.                 found = TRUE
  291.                 break
  292.             else
  293.                 fdget foo
  294.             endif
  295.         endif
  296.     endwhile
  297.     fclose 1
  298.  
  299.     ; first token matches current conf, so parse the rest of the line to
  300.     ; get the necessary information.
  301.     ;
  302.     if (found) then
  303.         startrow   = s2i(gettoken(), 10)
  304.         startcol   = s2i(gettoken(), 10)
  305.         numskiprow = s2i(gettoken(), 10)
  306.         lb_length  = s2i(gettoken(), 10)
  307.         lb_colour  = gettoken()
  308.     else
  309.         ; if none of the lines has the first token matching the current conf,
  310.         ; then we prompt them the old fashioned way.
  311.         ;
  312.         GetManualInput(select)
  313.     endif
  314.  
  315.     getuser
  316. endproc
  317.  
  318.  
  319.  
  320. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  321. ; get which bulletin to view the old fashioned way.
  322. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  323. procedure GetManualInput(string select)
  324.     string text
  325.  
  326.     newline
  327.     inputstr select, text, @X07, 3, MASK_NUM() + CHR(13), AUTO + NEWLINE
  328.     if (text != "") then
  329.         kbdstuff "B " + text
  330.     endif
  331.  
  332.     end
  333. endproc
  334.  
  335.