BASICライブラリ化ユーティリティ。かずひと君のプログラミング活動

十進BASICで書かれています
スモールBASIC以前からあるＪＩＳ基準のものです
コボルでかかれています
乗り換えが億劫なのと特に、現在不満もないので
使い切った後Ｃ言語・スモールBASIC・・とか楽しむつもりです
※基本的にBASICにはＣのようにライブラリ化機能がありません
それを仮想的に行えるように作りました

十進BASICのホームページ

Download Microsoft Small Basic 1.2 - 日本語 from Official Microsoft Download Center

命令として
①差し込み命令　　!' <INCLUDE> ファイル名
②カットスタート　!' <CUTSTART>
③カットエンド       !' <CUTEND>

用意するもの
①指示ファイル/ユーティリティにかける
②差し込みファイル－サブルーチンとして
　まとめたもの

※差し込み命令があると前後にカット・カットエンドが
　が書き込まれます
　実は以前に挿入されたものは削除されあらたに
　読み込まれます・・・

今から初められる方はスモールBASICがよいかもでね

REM
REM 和仁ファイル結合 十進対応
REM ver 0.975
REM 2021.01.30　
REM ソースカットデバッグ
REM
OPTION BASE 0
DIM fn(3)
DIM pr(2)
DIM sorce$(10000)
DIM work$(10000)
DIM isorce$(1000)
dim cut$(2)
DIM include$(3)
LET cut$(1) ="!' <CUTSTART>"
LET cut$(2) ="!' <CUTEND>"
LET include$(1)="!' <INCLUDE> "

LET db=0
LET ds=1

GOTO 10000

LET aa$=UCASE$("rem ")
LET w$="!' <include> sex"
PRINT include_c$(w$,include$)
stop

10000

LET void=main(a)
FUNCTION title(void)
PRINT "REM ***************************************************"
PRINT "REM * *"
PRINT "REM * かずひとベーシックライブ化ユーティリティ *"
PRINT "REM * 暫定版 １０進ベーシック *"
PRINT "REM * *"
PRINT "REM ***************************************************"
END FUNCTION



FUNCTION main(a)
LET work=title(void)
LET void=filename(a)
LET se=main_file_read(c) !' kourituka option

CALL sorcecut(sorce$,work$,cut$,se)
!' CALL hairetu_p(work$,se)

LET c00=1
FOR im=1 TO se
LET a0$=work$(im)
LET b$=include_c$(a0$,include$)

IF b$<>"" THEN


PRINT include$(1)&b$


OPEN #3:NAME path$&b$&ext$ ,ACCESS INPUT

!' LET b$=""

PRINT cut$(1)

LET c02=ifread(isorce$)!'*atode
!' CALL sorcecut(isorce$,work$,cut$,c02)
LET c02=c02-3
!' CALL hairetu_p(isorce$,c02)

PRINT cut$(2)

END IF
IF b$="" THEN
PRINT a0$

END IF


NEXT im

END FUNCTION

FUNCTION filename(a)
FILE GETNAME s$
FILE SPLITNAME (s$) path$, name$,ext$
OPEN #1:NAME path$&name$&ext$ ,ACCESS INPUT
rem OPEN #2:NAME path$&name$&"-obj"&ext$
rem ERASE #2
END FUNCTION



FUNCTION main_file_read(c)

LET c=1
DO
LINE INPUT #1,IF MISSING THEN EXIT DO:a$
LET sorce$(c)=a$
!' PRINT a$
LET c=c+1
LOOP

CLOSE #1
LET main_file_read=c-1
REM PRINT "main read kokomade ***"
END FUNCTION



FUNCTION ifread(fn$())

LET ic=1
DO
LINE INPUT #3,IF MISSING THEN EXIT DO:a$

LET fn$(ic)=a$
PRINT a$
LET ic=ic+1
LOOP
CLOSE #3
LET ifread=ic-1
END FUNCTION



END



EXTERNAL SUB hairetu_p(hairetu$(),ct)


FOR i=1 TO ct

PRINT hairetu$(i)

NEXT i


end sub



EXTERNAL FUNCTION include_c$(a$,include$())


LET work_s$=UCASE$(a$)
LET fn$=""
LET l=LEN(include$(1))
IF left$(work_s$,l)=include$(1) THEN
LET fn$=mid$(a$,l+1,LEN(a$))
LET f=1
IF fn$="" THEN STOP
END IF



LET include_c$=fn$

END FUNCTION






EXTERNAL sub sorcecut(so$(),work$(),cut$(),c)
!'*****基本カット メインでも差し込みでも使う
!'so$ 文字配列
!'work$ 作業配列
!'cut$(1): 排除スタート命令
!'cut$(2): 排除ストップ命令
!'cr 配列数：変化後の配列数も返す
!'
LET se=c
LET c=1
LET c2=1
LET f=0
FOR i=1 TO se
LET s$=so$(i)
LET ww$=UCASE$(s$)
LET f1=POS(ww$,cut$(1))
LET f2=POS(ww$,cut$(2))
IF f1=1 THEN

LET f=1
LET f2=0

end if
IF f2=1 THEN
LET f=0
LET f1=0

LET f12=0


end if


IF f=0 and f2=0 THEN
LET work$(c)=s$
LET c=c+1


END if




NEXT i

LET c=c-1
END sub



EXTERNAL SUB hcopy(so$(),work$(),c)

FOR i=1 TO c
LET s$=work$(i)
LET so$(i)=s$
NEXT i

END SUB



EXTERNAL SUB endc(s$,ecf)
IF UCASE$(LTRIM$(RTRIM$(s$)))="END" THEN
LET ecf=1
ELSE
LET ecf=0
END IF
END SUB