Created
January 16, 2026 16:14
-
-
Save scruss/6b5d114383bb7da7f06bf9575c181fc2 to your computer and use it in GitHub Desktop.
Mallard BASIC source for Amstrad's RPED editor for CP/M
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| 1 OPTION NOT TAB:OPTION RUN | |
| 2 DEFINT a-z:e$=CHR$(27):l$=CHR$(133) | |
| 3 DEF FNi$(a$)=" "+e$+"p"+a$+e$+"q":DEF FNc$(c)=FNi$(e$+CHR$(c)) | |
| 4 DEF FNb$(a,b,c,d)=CHR$(a)+STRING$(5,b)+CHR$(c)+STRING$(17,b)+CHR$(c)+STRING$(15,b)+CHR$(c)+STRING$(35,b)+CHR$(c)+STRING$(12,b)+CHR$(d) | |
| 5 DEF FNa$(x,y)=e$+"Y"+CHR$(y+31)+CHR$(x+31):DEF FNe$(m$)=FNa$(7,20)+FNi$(m$+" - press any key to continue"+CHR$(7)) | |
| 6 w1$=e$+"j"+e$+"f"+FNa$(2,2)+"Wait" | |
| 7 w2$=FNa$(2,2)+" "+e$+"e"+e$+"k" | |
| 8 WIDTH 255,255:my=200:sx=90:sy=31 | |
| 9 DIM ed$(my),er(my) | |
| 10 ef$=CHR$(127)+CHR$(7)+CHR$(1)+CHR$(6)+CHR$(2)+CHR$(11)+CHR$(24)+CHR$(22) | |
| 11 x$=CHR$(3)+CHR$(13)+CHR$(31)+CHR$(30)+CHR$(27) | |
| 12 sx$=x$+CHR$(21)+CHR$(5):fx$=x$+":"+"."+CHR$(1)+CHR$(6) | |
| 13 m$=CHR$(27)+CHR$(26)+CHR$(17)+CHR$(19):ei$=CHR$(255):bl$=SPACE$(sx-2):bf$="a: . " | |
| 14 GOSUB 88 | |
| 15 PRINT e$"y"e$"E"e$"f":GOSUB 139 | |
| 16 cf=(1=0):PRINT FNa$(25,10)FNi$("f5")" To edit last screen"FNa$(25,12)FNi$("f3")" To edit new screen"FNa$(25,14)FNi$("f1")" To edit existing file"FNa$(23,16)FNi$("EXIT")" To quit" | |
| 17 t$=INKEY$:IF t$="" THEN 17 | |
| 18 ON INSTR(m$,t$) GOTO 19,21,20,33:GOTO 17 | |
| 19 PRINT e$"e"e$"v"e$"E"e$"Y ";:SYSTEM | |
| 20 cf=(1=1):GOTO 33 | |
| 21 PRINT FNa$(5,10)e$;"JInsert Source disk and type name of existing file":f$=bf$ | |
| 22 tx=60:ty=10:GOSUB 89:IF ASC(ei$)=3 THEN 15 | |
| 23 ON ERROR GOTO 74:RESET:ff$=FIND$(f$):ON ERROR GOTO 0:IF ff$="" THEN PRINT FNe$("File not found");:WHILE INKEY$="":WEND:PRINT e$"l":GOTO 22 | |
| 24 ny=1:f$=LEFT$(f$,2)+STRIP$(ff$) | |
| 25 GOSUB 88:cf=(1=0):OPEN "I",#1,f$ | |
| 26 WHILE NOT EOF(1) AND ny<=my | |
| 27 LINE INPUT #1,i$ | |
| 28 MID$(ed$(ny),1)=i$:er(ny)=MIN(sx-2,LEN(i$)+1) | |
| 29 ny=ny+1 | |
| 30 WEND | |
| 31 mn=ny-1 | |
| 32 CLOSE #1:PRINT FNa$(5,16);:GOTO 34 | |
| 33 f$=bf$:PRINT FNa$(5,10)e$"J"; | |
| 34 PRINT FNa$(5,16)"Insert Destination Disk and type name of new file" | |
| 35 tx=60:ty=16:GOSUB 89:IF ASC(ei$)=3 THEN 15 | |
| 36 ON ERROR GOTO 73:RESET:ff$=FIND$(f$):IF STRIP$(ff$)<>UPPER$(RIGHT$(f$,12)) THEN 39 | |
| 37 ON ERROR GOTO 0:IF (ASC(MID$(ff$,10,1)) AND &H80)=0 THEN 40 | |
| 38 PRINT FNe$("File already exists and is write protected");:WHILE INKEY$="":WEND:PRINT e$"l":GOTO 35 | |
| 39 OPEN "O",#1,f$:CLOSE #1:KILL f$:ON ERROR GOTO 0 | |
| 40 PRINT e$"E"FNa$(1,1)e$"w";:d$=CHR$(149):tx=2:ty=4 | |
| 41 PRINT FNb$(134,138,132,140) | |
| 42 PRINT l$" "d$FNi$("ALT")FNc$(9)" =ins line "d$FNi$("CUT")" =DEL line "d$FNi$("^")FNc$(9)FNc$(11)FNc$(12)FNi$("DEL"+e$+CHR$(12))FNi$(e$+CHR$(11)+"DEL")FNi$("LINE")FNi$("EOL")FNi$("RETURN")" "d$FNi$("EXIT")" "FNi$("STOP")" "l$ | |
| 43 PRINT FNb$(130,154,155,136) | |
| 44 FOR ln=ty TO sy | |
| 45 PRINT l$FNa$(sx,ln)l$; | |
| 46 IF ln<>sy THEN PRINT | |
| 47 NEXT | |
| 48 PRINT w1$:IF cf THEN GOSUB 88 | |
| 49 FOR ny=1 TO MIN(mn,sy-ty+1) | |
| 50 PRINT FNa$(tx,ny+ty-1)LEFT$(ed$(ny),er(ny)); | |
| 51 NEXT | |
| 52 PRINT w2$;:ny=1:ey=1:ex=1:bd=4:ex$=sx$:os=(1=0) | |
| 53 mn=MAX(mn,ny):er=er(ny):ed$=ed$(ny):GOSUB 109 | |
| 54 MID$(ed$(ny),1)=ed$:er(ny)=er | |
| 55 ON INSTR(sx$,ei$) GOTO 15,59,56,59,63,76,82:GOTO 53 | |
| 56 ny=MAX(ny-1,1):ey=MAX(ey-1,1):IF ey>bd OR ny=ey THEN 53 | |
| 57 ey=ey+1:PRINT FNa$(tx-1,ty)e$"L"l$FNa$(sx,ty)l$FNa$(tx,ty); | |
| 58 PRINT ed$(ny-bd):GOTO 53 | |
| 59 ey=MIN(ey+1,sy-ty+1):ny=MIN(ny+1,my):IF ny>my-bd OR ey<sy-bd-ty+2 THEN 61 | |
| 60 ey=ey-1:PRINT FNa$(tx-1,ty)e$"M"FNa$(tx-1,sy)l$FNa$(sx,sy)l$FNa$(tx,sy)LEFT$(ed$(ny+bd),er(ny+bd)); | |
| 61 IF ASC(ei$)=13 THEN ex=1 | |
| 62 GOTO 53 | |
| 63 ON ERROR GOTO 71:PRINT w1$:OPEN "O",#1,f$ | |
| 64 IF ed$(mn)=bl$ THEN ml=mn-1 ELSE ml=mn | |
| 65 FOR ln=1 TO ml | |
| 66 pl=er(ln):ll$=LEFT$(ed$(ln),pl) | |
| 67 IF RIGHT$(ll$,1)=" " THEN ll$=LEFT$(ll$,LEN(ll$)-1):GOTO 67 | |
| 68 PRINT #1,ll$ | |
| 69 NEXT | |
| 70 CLOSE #1:ON ERROR GOTO 0:GOTO 15 | |
| 71 CLOSE:PRINT e$;"E":IF ERR=61 OR ERR=67 THEN PRINT FNe$("Disc or Directory Full"); ELSE PRINT FNe$("Error"+STR$(ERR)); | |
| 72 WHILE INKEY$="":WEND:RESUME 15 | |
| 73 IF ERR=64 THEN GOSUB 75:RESUME 35 | |
| 74 IF ERR=64 THEN GOSUB 75:RESUME 22 ELSE 71 | |
| 75 PRINT FNe$("Invalid file name");:WHILE INKEY$="":WEND:PRINT e$"l":RETURN | |
| 76 PRINT e$;"M";FNa$(tx-1,sy)l$FNa$(sx,sy)l$FNa$(tx,sy);:il=ny+sy-ey-ty+2:IF il<=my THEN PRINT LEFT$(ed$(il),er(il)); | |
| 77 PRINT w1$:FOR ln=ny TO mn-1 | |
| 78 MID$(ed$(ln),1)=ed$(ln+1):er(ln)=er(ln+1) | |
| 79 NEXT:PRINT w2$; | |
| 80 ed$(mn)=bl$:er(mn)=1:mn=MAX(mn-1,1) | |
| 81 GOTO 53 | |
| 82 PRINT e$"L"FNa$(tx-1,ey+ty-1)l$FNa$(sx,ey+ty-1)l$; | |
| 83 PRINT w1$:FOR ln=mn TO ny STEP -1 | |
| 84 MID$(ed$(MIN(ln+1,my)),1)=ed$(ln):er(MIN(ln+1,my))=er(ln) | |
| 85 NEXT:PRINT w2$; | |
| 86 ed$(ny)=bl$:er(ny)=1:mn=MIN(mn+1,my) | |
| 87 GOTO 53 | |
| 88 FOR ey=1 TO my:ed$(ey)=bl$:er(ey)=1:NEXT:mn=0:RETURN | |
| 89 PRINT FNa$(tx-1,ty-1)CHR$(134)STRING$(14,138)CHR$(140) | |
| 90 PRINT FNa$(tx-1,ty)l$f$l$e$"e" | |
| 91 PRINT FNa$(tx-1,ty+1)CHR$(131)STRING$(14,138)CHR$(137) | |
| 92 ex=1:ey=1:st=tx:ex$=fx$:os=(1=1):GOTO 96 | |
| 93 tx=st:ex=1:ed$=MID$(f$,1,1):GOSUB 107:GOSUB 109:IF INSTR("ABM",UPPER$(ed$))=0 THEN 93 | |
| 94 MID$(f$,1)=ed$ | |
| 95 ON INSTR(fx$,ei$) GOTO 106,106,93,96,106,96,93,93,96:GOTO 93 | |
| 96 tx=st+2:ed$=MID$(f$,3,8):GOSUB 107:GOSUB 109:MID$(f$,3)=ed$ | |
| 97 ON INSTR(fx$,ei$) GOTO 106,106,93,100,106,96,100,98,99:GOTO 96 | |
| 98 IF ex=1 THEN 93 ELSE ex=ex-1:GOTO 96 | |
| 99 IF ex=8 THEN 100 ELSE ex=ex+1:GOTO 96 | |
| 100 ex=1 | |
| 101 tx=st+11:ed$=MID$(f$,12,3):GOSUB 107:GOSUB 109:MID$(f$,12)=ed$ | |
| 102 ON INSTR(fx$,ei$) GOTO 106,106,103,101,106,101,101,104,105:GOTO 101 | |
| 103 ex=8:GOTO 96 | |
| 104 IF ex=1 THEN ex=8:GOTO 96 ELSE ex=ex-1:GOTO 101 | |
| 105 ex=MIN(ex+1,3):GOTO 101 | |
| 106 PRINT e$"f":RETURN | |
| 107 FOR er=LEN(ed$)+1 TO 2 STEP -1:IF MID$(ed$,er-1,1)<>" " THEN RETURN | |
| 108 NEXT:RETURN | |
| 109 el=LEN(ed$) | |
| 110 aa$=FNa$(ex+tx-1,ey+ty-1):PRINT aa$;:IF el=1 THEN PRINT ed$;aa$; | |
| 111 ei$=INKEY$:IF ei$="" THEN 111 | |
| 112 IF INSTR(ex$,ei$)<>0 THEN RETURN | |
| 113 ON INSTR(ef$,ei$) GOTO 124,125,122,128,120,129,131,138 | |
| 114 IF ei$<" " THEN 110 | |
| 115 IF (ex<el) AND (NOT os) THEN MID$(ed$,ex+1)=MID$(ed$,ex,el-ex) | |
| 116 MID$(ed$,ex)=ei$:er=MIN(MAX(er+1,ex+2),el+1) | |
| 117 IF ex<er THEN PRINT MID$(ed$,ex,er-ex); ELSE PRINT ei$; | |
| 118 GOSUB 135 | |
| 119 ex=MIN(el,ex+1):GOTO 110 | |
| 120 IF ex=1 THEN ex=MIN(er,el) ELSE ex=1 | |
| 121 GOTO 110 | |
| 122 ex=MAX(1,ex-1) | |
| 123 GOTO 110 | |
| 124 IF ex=1 THEN 110 ELSE ex=ex-1:PRINT CHR$(8); | |
| 125 MID$(ed$,ex)=MID$(ed$,ex+1,el-ex):IF er=el+1 THEN MID$(ed$,el)=" " | |
| 126 IF er>ex THEN PRINT MID$(ed$,ex,er-ex); | |
| 127 GOSUB 135:GOTO 110 | |
| 128 ex=MIN(el,ex+1):GOTO 110 | |
| 129 MID$(ed$,ex)=STRING$(el-ex+1," ") | |
| 130 GOTO 126 | |
| 131 IF ex=1 THEN 110 | |
| 132 MID$(ed$,1)=MID$(ed$,ex,el-ex+1)+STRING$(ex-1," ") | |
| 133 ex=1:PRINT FNa$(ex+tx-1,ey+ty-1);:GOTO 126 | |
| 134 PRINT e$;"f"; | |
| 135 IF er=1 THEN 137 | |
| 136 IF MID$(ed$,er-1,1)=" " THEN er=er-1:GOTO 135 ELSE 137 | |
| 137 PRINT e$;"e";:RETURN | |
| 138 os=NOT os:GOTO 110 | |
| 139 PRINT FNa$(1,1);"This screen editor is for small files (up to 200 lines) and uses normal cursor" | |
| 140 PRINT"and delete keys on both text and filenames. Other features include:" | |
| 141 PRINT:PRINT FNi$("+")" toggles insert/overstrike mode,"FNi$("STOP");" aborts the edit,"FNi$("EXIT")" ends the edit" | |
| 142 RETURN |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment