home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
archives
/
perkinelmeridris.zip
/
pe7boo.bas
< prev
next >
Wrap
BASIC Source File
|
1986-12-08
|
3KB
|
71 lines
$1 rem Use this BASIC program on the PE7500 if you have the printable file
2 rem pe7500.boo already on the PE7500 to convert it to an executable
3 rem file. This program takes about 7 minutes to run on a PE7500 with
4 rem a hard disk.
5 rem Bill Catchings, June 1984
6 rem Columbia University Center for Computing Activities
7 rem Converted to Perkin-Elemer Series 7000 (7500) Basic from IBM-PC Basic
8 rem Runs under Idris (1.81) By Chris Lent 28-NOV-1986
9 print "PE7BOO.BAS Version 2.3a (Derived from IBM-PC MSBPCT.BAS)"
10 t$= clk$ :rem Save the time.
20 defint a-z :rem Integer to gain some speed.
30 n$= chr$ ( 0)
40 z= asc ("0")
50 t= asc ("~")-z
60 def fnuchr%(a$)= asc (a$)-z
65 k$="pe7ker.boo": rem filename case significant
70 open "i",# 1,k$:rem filename case significant
80 f$="hello there"
100 linput # 1,f$ :rem Is this the right file?
101 rem remove nasty characters in filename
102 h$=""
103 for i= 1 to len (f$)
105 g$= mid$ (f$,i, 1)
106 if g$>" " and g$<="~" then h$=h$+g$
107 next i
108 f$=h$
109 print f$:rem show user filename
110 if len (f$)> 20 then goto 900
120 open "o",# 2,f$
130 print "Outputting to "+f$
200 if eof ( 1) then goto 800 :rem Exit nicely on end of file.
210 linput # 1,x$ :rem Get a line.
220 y$="" :rem Clear the output buffer.
230 goto 400
300 print # 2,y$;
310 goto 200 :rem Get another line.
400 if len (x$)< 2 goto 300 :rem Is the input buffer empty?
410 a=fnuchr%(x$)
420 if a=t then goto 700 :rem Null repeat character?
430 if len (x$)< 3 goto 300 :rem Is the input buffer empty?
440 q$= mid$ (x$, 2, 3) :rem Get the quadruplet to decode.
450 x$= mid$ (x$, 5)
460 b=fnuchr%(q$)
470 q$= mid$ (q$, 2)
480 c=fnuchr%(q$)
490 q$= mid$ (q$, 2)
500 d=fnuchr%(q$)
600 y$=y$+ chr$ (((a* 4)+(b\ 16)) and 255):rem Decode the quad.
610 y$=y$+ chr$ (((b* 16)+(c\ 4)) and 255)
620 y$=y$+ chr$ (((c* 64)+d) and 255)
630 goto 400 :rem Get another quad.
700 x$= mid$ (x$, 2) :rem Expand the nulls.
710 r=fnuchr%(x$) :rem Get the number of nulls.
715 print " Null: ",r
720 x$= mid$ (x$, 2)
725 print # 2,y$;
730 for i= 1 to r
740 print # 2, chr$ ( 0);
750 next i
760 rem
770 y$="" :rem Clear the output buffer.
780 goto 400
800 print "Processing complete, elapsed time: "+t$+" to "+ clk$
810 print "Output in "+f$
820 close # 1,# 2
830 goto 9999
900 print "?The version of the MSKERMIT.BOO file is incorrect"
910 goto 820
9999 end