home *** CD-ROM | disk | FTP | other *** search
/ APDL Public Domain 1 / APDL_PD1A.iso / file_trans / bbc__arc / !BBC / BBCprog < prev    next >
Encoding:
Text File  |  1990-10-24  |  7.7 KB  |  310 lines
  1. >L.
  2.  
  3.    10REM Remote control server program #2
  4.  
  5.    20REM to be loaded into BBC
  6.  
  7.    30DIM b% 310
  8.  
  9.    40DIM f$(32)
  10.  
  11.    50DIM cb% 32
  12.  
  13.    60DIM osbuff% 100
  14.  
  15.    70DIM transbuff% 256
  16.  
  17.    80FOR A%=b% TO b%+300:?A%=0:NEXT
  18.  
  19.    90end%=0
  20.  
  21.   100*fx 3 0
  22.  
  23.   110*fx 2 1
  24.  
  25.   120INPUT"Baud reference:"rate%
  26.  
  27.   130*fx 2 2
  28.  
  29.   140unlock%=0
  30.  
  31.   150dir$=":0.$"
  32.  
  33.   160SOUND 2,-15,200,2:SOUND 2,0,200,1:SOUND 2,-15,200,2
  34.  
  35.   170ON ERROR OSCLI("FX 3 0"):OSCLI("FX 2 2"):PRINT"Error!":REPORT:PRINT" at line ";ERL:SOUND 1,-15,0,5:END
  36.  
  37.   180:
  38.  
  39.   190CLS
  40.  
  41.   200PRINT'CHR$141;"   BBC to Archimedes file transfer"'CHR$141;"   BBC to Archimedes file transfer"
  42.  
  43.   210PRINT'"Do not type anything here; the Arc"'"has full control."'"Facilities include file transfer either"'"way, and BBC file renaming and deletion."'
  44.  
  45.   220*FX 3 3
  46.  
  47.   230VDU 32
  48.  
  49.   240*fx 3 0
  50.  
  51.   250REPEAT
  52.  
  53.   260PRINT"Awaiting command from Archimedes"
  54.  
  55.   270*fx 2 1
  56.  
  57.   280*fx 3 0
  58.  
  59.   290INPUT com$
  60.  
  61.   300IF com$="catalogue" THEN PROCcat
  62.  
  63.   310IF com$="delete file" THEN PROCdel
  64.  
  65.   320IF com$="transfer to arc" THEN PROCtrans
  66.  
  67.   330IF com$="quit" THEN PROCquit
  68.  
  69.   340IF com$="transfer to bbc" THEN PROCtransbbc
  70.  
  71.   350IF com$="rename" THEN PROCrename
  72.  
  73.   360IF com$="baud" THEN PROCbaud
  74.  
  75.   370IF com$="lock" THEN PROClock
  76.  
  77.   380IF com$="lock file" THEN PROClockfile
  78.  
  79.   390*FX 3 0
  80.  
  81.   400UNTIL end%
  82.  
  83.   410END
  84.  
  85.   420:
  86.  
  87.   430DEFPROCquit
  88.  
  89.   440end%=-1
  90.  
  91.   450*FX 3 0
  92.  
  93.   460*FX 2 2
  94.  
  95.   470PRINT"Ending session"'
  96.  
  97.   480SOUND 1,-15,100,5
  98.  
  99.   490ENDPROC
  100.  
  101.   500:
  102.  
  103.   510DEFPROCdel
  104.  
  105.   520*fx 2 1
  106.  
  107.   530*fx 3 0
  108.  
  109.   540PRINT"Delete; File: ";dir$;".";
  110.  
  111.   550INPUTLINE""file$
  112.  
  113.   560ok%=FNokalter(file$)
  114.  
  115.   570IF ok% THEN OSCLI("Delete "+dir$+"."+file$)
  116.  
  117.   580*fx 3 3
  118.  
  119.   590*fx 2 2
  120.  
  121.   600IF ok% THEN PRINT"deleted";CHR$13; ELSE PRINT"locked";CHR$13;
  122.  
  123.   610*fx 3 0
  124.  
  125.   620ENDPROC
  126.  
  127.   630:
  128.  
  129.   640DEFPROCrename
  130.  
  131.   650*FX 2 1
  132.  
  133.   660*FX 3 0
  134.  
  135.   670INPUT'"Rename; old file:"old$
  136.  
  137.   680INPUTLINE"New file:"new$
  138.  
  139.   690ok%=FNokalter(old$)
  140.  
  141.   700IF ok% THEN OSCLI("rename "+dir$+"."+old$+" "+dir$+"."+new$)
  142.  
  143.   710*fx 3 3
  144.  
  145.   720*fx 2 2
  146.  
  147.   730IF ok% THEN PRINT"renamed";CHR$13; ELSE PRINT"locked";CHR$13;
  148.  
  149.   740*fx 3 0
  150.  
  151.   750ENDPROC
  152.  
  153.   760:
  154.  
  155.   770DEFPROCcat
  156.  
  157.   780*fx 3 0
  158.  
  159.   790INPUT"Directory:"dir$
  160.  
  161.   800OSCLI("Dir "+dir$)
  162.  
  163.   810PRINT"Reading catalogue"
  164.  
  165.   820FOR f%=0 TO 32:f$(f%)="":NEXT
  166.  
  167.   830FOR byte%=b% TO b%+300 STEP 4:!byte%=0:NEXT
  168.  
  169.   840*CAT
  170.  
  171.   850*FX 2 2
  172.  
  173.   860X%=cb% MOD 256
  174.  
  175.   870Y%=cb% DIV 256
  176.  
  177.   880A%=8
  178.  
  179.   890cb%?0=0
  180.  
  181.   900cb%!1=b%
  182.  
  183.   910cb%!5=32
  184.  
  185.   920cb%!9=0
  186.  
  187.   930CALL &FFD1
  188.  
  189.   940files%=0
  190.  
  191.   950p%=b%
  192.  
  193.   960REPEAT
  194.  
  195.   970IF FNfname(p%)<>"" THEN files%=files%+1:f$(files%)=FNfname(p%):p%=p%+?p%+1
  196.  
  197.   980UNTIL ?p%=0
  198.  
  199.   990PRINT"Sending ";files%;" filenames"
  200.  
  201.  1000*FX 3 3
  202.  
  203.  1010PRINT FNdiscname(osbuff%);CHR$13;
  204.  
  205.  1020PRINT files%;CHR$13;
  206.  
  207.  1030IF files%=0 THEN PRINT" ";CHR$13;:OSCLI("FX 3 0"):ENDPROC
  208.  
  209.  1040FOR f%=1 TO files%
  210.  
  211.  1050PRINT;f$(f%);CHR$13;
  212.  
  213.  1060*fx 3 0
  214.  
  215.  1070PRINT f$(f%)
  216.  
  217.  1080*fx 3 3
  218.  
  219.  1090$(osbuff%+30)=LEFT$(f$(f%),68)
  220.  
  221.  1100!osbuff%=osbuff%+30
  222.  
  223.  1110X%=osbuff% MOD 256
  224.  
  225.  1120Y%=osbuff% DIV 256
  226.  
  227.  1130A%=5
  228.  
  229.  1140A%=USR(&FFDD) AND 255
  230.  
  231.  1150PRINTosbuff%!10;CHR$13;
  232.  
  233.  1160PRINTosbuff%!14;CHR$13;
  234.  
  235.  1170PRINTFNfiletype(f$(f%));CHR$13;
  236.  
  237.  1180NEXT
  238.  
  239.  1190*FX 3 0
  240.  
  241.  1200ENDPROC
  242.  
  243.  1210:
  244.  
  245.  1220DEFPROCtrans
  246.  
  247.  1230*FX 2 1
  248.  
  249.  1240*FX 3 2
  250.  
  251.  1250INPUTLINE f$
  252.  
  253.  1260type%=FNfiletype(f$)
  254.  
  255.  1270FH%=OPENIN(f$)
  256.  
  257.  1280*FX 3 3
  258.  
  259.  1290PRINT;EXT#FH%;CHR$13;
  260.  
  261.  1300PRINT;type%;CHR$13;
  262.  
  263.  1310*FX 2 1
  264.  
  265.  1320*FX 3 2
  266.  
  267.  1330INPUT OK$
  268.  
  269.  1340*FX 2 2
  270.  
  271.  1350*FX 3 0
  272.  
  273.  1360IF OK$<>"OK" THEN PRINT"Communication error":ENDPROC ELSE PRINT"Sending"
  274.  
  275.  1370*FX 3 3
  276.  
  277.  1380FOR F%=1 TO EXT#FH%
  278.  
  279.  1390VDU BGET#FH%
  280.  
  281.  1400NEXT
  282.  
  283.  1410*FX 3 0
  284.  
  285.  1420CLOSE#FH%
  286.  
  287.  1430PRINT"Finish";
  288.  
  289.  1440*FX 2 1
  290.  
  291.  1450*FX 3 2
  292.  
  293.  1460INPUT OK$
  294.  
  295.  1470*FX 2 2
  296.  
  297.  1480*FX 3 0
  298.  
  299.  1490IF OK$="OK" THEN PRINT"ed"'
  300.  
  301.  1500ENDPROC
  302.  
  303.  1510:
  304.  
  305.  1520DEFPROCtransbbc
  306.  
  307.  1530*fx 2 1
  308.  
  309.  1540*fx 3 0
  310.  
  311.  1550ok%=-1
  312.  
  313.  1560PRINT"Receiving file to ";dir$
  314.  
  315.  1570INPUTLINE"Filename:"file$
  316.  
  317.  1580INPUT"Length:"len%
  318.  
  319.  1590F%=OPENIN(dir$+"."+file$)
  320.  
  321.  1600IF F%<>0 THEN CLOSE#F%:ok%=FNokalter(dir$+"."+file$)
  322.  
  323.  1610IF ok% THEN F%=OPENOUT(dir$+"."+file$)
  324.  
  325.  1620*fx 3 3
  326.  
  327.  1630*fx 2 2
  328.  
  329.  1640IF ok% THEN PRINT"receiving";CHR$13; ELSE PRINT"locked";CHR$13;
  330.  
  331.  1650*fx 2 1
  332.  
  333.  1660*FX 3 0
  334.  
  335.  1670FOR block%=1 TO len% STEP 128
  336.  
  337.  1680fails%=0
  338.  
  339.  1690REPEAT
  340.  
  341.  1700crc%=0
  342.  
  343.  1710FOR byte%=block% TO FNlower(block%+127,len%)
  344.  
  345.  1720g%=GET
  346.  
  347.  1730?(transbuff%-block%+byte%)=g%
  348.  
  349.  1740crc%=crc%+g%
  350.  
  351.  1750NEXT
  352.  
  353.  1760*fx 3 3
  354.  
  355.  1770PRINT crc%;CHR$13;
  356.  
  357.  1780*FX 3 2
  358.  
  359.  1790INPUT confirm$
  360.  
  361.  1800IF confirm$<>"crc ok" THEN fails%=fails%+1:SOUND 1,-15,0,2
  362.  
  363.  1810UNTIL confirm$="crc ok" OR fails%>=3
  364.  
  365.  1820IF fails%>=3 THEN OSCLI("FX 3 0"):OSCLI("FX 2 2"):CLOSE#0:PRINT'"Failed to transfer block":END
  366.  
  367.  1830FOR byte%=block% TO FNlower(block%+127,len%)
  368.  
  369.  1840BPUT#F%,?(transbuff%-block%+byte%)
  370.  
  371.  1850NEXT
  372.  
  373.  1860NEXT
  374.  
  375.  1870REM FOR byte%=1 TO len%
  376.  
  377.  1880REM BPUT#F%,GET
  378.  
  379.  1890REM NEXT
  380.  
  381.  1900CLOSE#F%
  382.  
  383.  1910$(osbuff%+30)=dir$+"."+file$
  384.  
  385.  1920!osbuff%=osbuff%+30
  386.  
  387.  1930osbuff%!2=0
  388.  
  389.  1940X%=osbuff% MOD 256
  390.  
  391.  1950Y%=osbuff% DIV 256
  392.  
  393.  1960A%=2
  394.  
  395.  1970CALL&FFDD
  396.  
  397.  1980osbuff%!6=0
  398.  
  399.  1990A%=3
  400.  
  401.  2000CALL&FFDD
  402.  
  403.  2010*fx 2 2
  404.  
  405.  2020*fx 3 3
  406.  
  407.  2030PRINT"finished";CHR$13;
  408.  
  409.  2040*fx 3 0
  410.  
  411.  2050ENDPROC
  412.  
  413.  2060:
  414.  
  415.  2070DEFPROCbaud
  416.  
  417.  2080old%=rate%
  418.  
  419.  2090*fx 2 1
  420.  
  421.  2100*fx 3 0
  422.  
  423.  2110INPUT'"New baud index:"rate%
  424.  
  425.  2120OSCLI("FX 7,"+STR$(rate%))
  426.  
  427.  2130OSCLI("FX 8,"+STR$(rate%))
  428.  
  429.  2140*fx 3 3
  430.  
  431.  2150PRINT"baud reset";CHR$13;
  432.  
  433.  2160*fx 3 0
  434.  
  435.  2170*fx 2 1
  436.  
  437.  2180i$=""
  438.  
  439.  2190REPEAT
  440.  
  441.  2200i%=INKEY(100)
  442.  
  443.  2210IF i%<>13 AND i%<>-1 THEN i$=i$+CHR$(i%)
  444.  
  445.  2220UNTIL i%=13 OR i%=-1
  446.  
  447.  2230IF i$<>"baud confirm" THEN OSCLI("FX 7,"+STR$(old%)):OSCLI("FX 8,"+STR$(old%)):OSCLI("FX 3,0"):PRINT"Failed to confirm new speed":rate%=old%
  448.  
  449.  2240ENDPROC
  450.  
  451.  2250:
  452.  
  453.  2260DEFFNfname(p%)
  454.  
  455.  2270LOCAL f$
  456.  
  457.  2280IF ?p%=0 THEN =""
  458.  
  459.  2290FOR c%=p%+1 TO p%+?p%
  460.  
  461.  2300f$=f$+CHR$(?c%)
  462.  
  463.  2310NEXT
  464.  
  465.  2320=f$
  466.  
  467.  2330:
  468.  
  469.  2340DEFFNfiletype(file$)
  470.  
  471.  2350LOCAL X%,Y%,A%,loadaddr%,execaddr%,attrib%,lenfile%
  472.  
  473.  2360$(osbuff%+30)=LEFT$(file$,68)
  474.  
  475.  2370!osbuff%=osbuff%+30
  476.  
  477.  2380X%=osbuff% MOD 256
  478.  
  479.  2390Y%=osbuff% DIV 256
  480.  
  481.  2400A%=5
  482.  
  483.  2410A%=USR(&FFDD) AND 255
  484.  
  485.  2420REM OSFILE read catalogue information
  486.  
  487.  2430loadaddr%=osbuff%!2
  488.  
  489.  2440execaddr%=osbuff%!6
  490.  
  491.  2450lenfile%=osbuff%!10
  492.  
  493.  2460attrib%=osbuff%!14
  494.  
  495.  2470IF (attrib% AND 1)=1 THEN =0
  496.  
  497.  2480REM type 0 means not transferrable
  498.  
  499.  2490IF loadaddr%=&8000 AND (lenfile% AND &2000) THEN =&BBC
  500.  
  501.  2500IF (loadaddr% AND &FFFFFF)=&FFFFFF AND (execaddr% AND &FFFFFF)=&FFFFFF THEN =&FFF
  502.  
  503.  2510la%=loadaddr% AND &FFFF
  504.  
  505.  2520IF (la%=&E00 OR la%=&1200 OR la%=&1900 OR la%=&1B00) AND (execaddr% AND &FFFF)>&8000 THEN =&FFB
  506.  
  507.  2530X%=OPENIN(file$)
  508.  
  509.  2540PTR#X%=EXT#X%-1
  510.  
  511.  2550lastbyte%=BGET#X%
  512.  
  513.  2560CLOSE#X%
  514.  
  515.  2570IF (execaddr% AND &FFFFFF)=&FFFFFF AND loadaddr%=0 AND lastbyte%=13 THEN =&FFE
  516.  
  517.  2580IF (execaddr% AND &FFFFFF)=&FFFFFF AND loadaddr%=0 AND lastbyte%<>13 THEN =&FFD
  518.  
  519.  2590IF (la%+lenfile%)=&8000 AND (la%=&3000 OR la%=&5800 OR la%=&7C00) THEN =&FF9
  520.  
  521.  2600=-1
  522.  
  523.  2610:
  524.  
  525.  2620DEFFNokalter(file$)
  526.  
  527.  2630$(osbuff%+30)=file$
  528.  
  529.  2640!osbuff%=osbuff%+30
  530.  
  531.  2650X%=osbuff% MOD 256
  532.  
  533.  2660Y%=osbuff% DIV 256
  534.  
  535.  2670A%=5
  536.  
  537.  2680CALL&FFDD
  538.  
  539.  2690locked%=osbuff%!14 AND 8
  540.  
  541.  2700IF locked% THEN locked%=-1
  542.  
  543.  2710IF locked% AND unlock% THEN OSCLI("Access "+file$):locked%=0
  544.  
  545.  2720=NOT locked%
  546.  
  547.  2730:
  548.  
  549.  2740DEFPROClock
  550.  
  551.  2750INPUT unlock%
  552.  
  553.  2760ENDPROC
  554.  
  555.  2770:
  556.  
  557.  2780DEFFNlower(a,b)
  558.  
  559.  2790IF a<b THEN b=a:REM........................
  560.  
  561.  2800=b
  562.  
  563.  2810:
  564.  
  565.  2820DEFPROClockfile
  566.  
  567.  2830LOCAL l$,lock%,file$
  568.  
  569.  2840*FX 3 2
  570.  
  571.  2850*FX 2 1
  572.  
  573.  2860INPUT file$
  574.  
  575.  2870INPUT lock%
  576.  
  577.  2880l$=""
  578.  
  579.  2890IF lock% THEN l$=" L"
  580.  
  581.  2900OSCLI("Access "+file$+l$)
  582.  
  583.  2910*fx 3 3
  584.  
  585.  2920*fx 2 2
  586.  
  587.  2930PRINT"locked";CHR$13;
  588.  
  589.  2940*fx 3 0
  590.  
  591.  2950ENDPROC
  592.  
  593.  2960:
  594.  
  595.  2970DEFFNdiscname(b%)
  596.  
  597.  2980X%=b% MOD 256
  598.  
  599.  2990Y%=b% DIV 256
  600.  
  601.  3000b%!1=b%+40
  602.  
  603.  3010A%=5
  604.  
  605.  3020CALL &FFD1
  606.  
  607.  3030I%=b%?40+1
  608.  
  609.  3040REPEAT:I%=I%-1:UNTIL?(b%+I%+40)<>0
  610.  
  611.  3050?(b%+40+I%+1)=13
  612.  
  613.  3060=$(b%+41)
  614.  
  615.  3070
  616.  
  617. >*Spool
  618.  
  619.