home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / perkinelmeridris / pe7boo.bas < prev    next >
BASIC Source File  |  2020-01-01  |  2KB  |  71 lines

  1. $1 rem Use this BASIC program on the PE7500 if you have the printable file 
  2. 2 rem pe7500.boo already on the PE7500 to convert it to an executable
  3. 3 rem file.  This program takes about 7 minutes to run on a PE7500 with
  4. 4 rem a hard disk.
  5. 5 rem  Bill Catchings, June 1984
  6. 6 rem  Columbia University Center for Computing Activities
  7. 7 rem  Converted to Perkin-Elemer Series 7000 (7500) Basic from IBM-PC Basic
  8. 8 rem  Runs under Idris (1.81) By Chris Lent 28-NOV-1986
  9. 9 print "PE7BOO.BAS Version 2.3a (Derived from IBM-PC MSBPCT.BAS)"
  10. 10  t$= clk$                 :rem  Save the time.
  11. 20  defint a-z                :rem  Integer to gain some speed.
  12. 30  n$= chr$ ( 0)
  13. 40  z= asc ("0")
  14. 50  t= asc ("~")-z
  15. 60  def fnuchr%(a$)= asc (a$)-z
  16. 65 k$="pe7ker.boo": rem filename case significant
  17. 70  open "i",# 1,k$:rem filename case significant
  18. 80  f$="hello there"
  19. 100 linput # 1,f$    :rem Is this the right file?
  20. 101 rem remove nasty characters in filename 
  21. 102 h$=""
  22. 103 for i= 1 to  len (f$)
  23. 105  g$= mid$ (f$,i, 1)
  24. 106  if g$>" " and g$<="~" then h$=h$+g$
  25. 107 next i
  26. 108 f$=h$
  27. 109  print f$:rem show user filename
  28. 110  if  len (f$)> 20 then  goto 900 
  29. 120  open "o",# 2,f$
  30. 130  print "Outputting to "+f$
  31. 200  if  eof ( 1) then  goto 800     :rem  Exit nicely on end of file.
  32. 210  linput # 1,x$            :rem  Get a line.
  33. 220  y$=""                :rem  Clear the output buffer.
  34. 230  goto 400 
  35. 300  print # 2,y$;
  36. 310  goto 200                 :rem  Get another line.
  37. 400  if len (x$)< 2 goto 300         :rem  Is the input buffer empty?
  38. 410  a=fnuchr%(x$)
  39. 420  if a=t then  goto 700         :rem  Null repeat character?
  40. 430  if  len (x$)< 3 goto 300         :rem  Is the input buffer empty?
  41. 440  q$= mid$ (x$, 2, 3)        :rem  Get the quadruplet to decode.
  42. 450  x$= mid$ (x$, 5)
  43. 460  b=fnuchr%(q$)
  44. 470  q$= mid$ (q$, 2)
  45. 480  c=fnuchr%(q$)
  46. 490  q$= mid$ (q$, 2)
  47. 500  d=fnuchr%(q$)
  48. 600  y$=y$+ chr$ (((a* 4)+(b\ 16)) and  255):rem  Decode the quad.
  49. 610  y$=y$+ chr$ (((b* 16)+(c\ 4)) and  255)
  50. 620  y$=y$+ chr$ (((c* 64)+d) and  255)
  51. 630  goto 400                 :rem  Get another quad.
  52. 700  x$= mid$ (x$, 2)            :rem  Expand the nulls.
  53. 710  r=fnuchr%(x$)            :rem  Get the number of nulls.
  54. 715  print " Null: ",r
  55. 720  x$= mid$ (x$, 2)
  56. 725  print # 2,y$;
  57. 730  for i= 1 to r
  58. 740  print # 2, chr$ ( 0);
  59. 750  next i
  60. 760  rem
  61. 770  y$=""                :rem  Clear the output buffer.
  62. 780  goto 400 
  63. 800  print "Processing complete, elapsed time: "+t$+" to "+ clk$ 
  64. 810  print "Output in "+f$
  65. 820  close # 1,# 2
  66. 830  goto 9999 
  67. 900  print "?The version of the MSKERMIT.BOO file is incorrect"
  68. 910  goto 820 
  69. 9999 end 
  70. 
  71.