福岡だいの動画と、同人誌の販売

同人誌 動画 プログラム 情報処理 アート グラフィックス 有償 2018年創業

システムアドミニストレーター5 キャラクター解法

2019-03-20 03:47:58 | 日記
4 Season Stock
**************************
100 REM ---------------------
110 REM Program by Dai Fukuoka 2016.08.01-08.05
120 REM (C)電脳組
130 REM --------------------- 140 CONSOLE 0,25,0,1:SCREEN 3,0,0,1:WIDTH 80,25:COLOR 0,7,0,0,1:CLS 3
150 DIM SUM(99):DIM AGREE(20)
160 *START
170 *Q1 PRINT "What many Mounth at Start Incoming"
180 PRINT "何月から収入の始めですか:";:INPUT "",MOUNTH
190 IF MOUNTH>0 AND MOUNTH<13 THEN ELSE *Q1
200 *Q2 PRINT "Is Society Insurance Contract Exparent for much"
210 PRINT "社会保険の契約指数はいくつですか:";:INPUT "",SI
220 IF SI>-1 AND SI<11 THEN ELSE *Q2
230 *Q3 PRINT "Is many at Stock Holder's Fine"
240 PRINT "証券罰金料の指数はいくつですか";:INPUT "",SHF
250 IF SHF="0" AND SI="0" THEN *Q2
260 IF SHF>-1 AND SHF<10000 THEN ELSE *Q2
270 *Q4 PRINT "Select is Money Rate for (0)Euro(1)Yen(2)UsaDoll"
280 PRINT "通貨のレーティングを選択してください(0)Euro(1)Yen(2)UsaDoll";:INPUT "",RATE
290 IF RATE=0 THEN RATING=180 ELSE IF RATE=1 THEN RATING=1 ELSE IF RATE=2 THEN RATING=133 ELSE *Q4
300 *Q5 PRINT "What is Incoming for Payed Type Account(0)Cooprate Tax and Allotment Plus(1)Cooprate Tax Only(2)Allotment Only(3)Full Income"
310 PRINT "収入の支払形式は何ですか(0)法人税と配当(1)法人税のみ(2)配当金のみ(3)全部の収入";:INPUT "",PAY
320 IF PAY>-1 AND PAY<4 THEN ELSE *Q5
330 *Q6 PRINT "Is many Exparent of Stock Market Investment Payed Plan for Plan Total"
340 PRINT "合算は、支払い計画にて幾つの証券指数にしますか";:INPUT "",TOTAL
350 IF TOTAL<0 THEN TOTAL="ABS(TOTAL)" ELSE IF TOTAL="0" THEN *Q6
360 *Q7 PRINT "Stock Market Holder do not Mine(0)Yes(1)No"
370 PRINT "自分が保有しない株ですか(0)はい(1)いいえ";:INPUT "",MINE
380 IF MINE="0" OR MINE="1" THEN ELSE *Q7
390 *Q8 PRINT "Is Year Range of Stock Market Holder for many (0)1Year(1)2Year(2)4Year"
400 PRINT "証券期間を幾つのためにしますか:";:INPUT "",SR
410 IF SR>-1 AND SR<3 THEN ELSE *Q8
420 AGREE(1)=MOUNTH:AGREE(2)=SI:AGREE(3)=SHF:AGREE(4)=RATE:AGREE(5)=PAY
430 AGREE(6)=TOTAL:AGREE(7)=MINE:AGREE(8)=SR
440 IF SR="0" THEN SR2=1 ELSE IF SR="1" THEN SR2=2 ELSE IF SR="2" THEN SR2=4
450 FOR T="1" TO SR2:FOR I="MOUNTH" TO 12:COUNT=COUNT+1
460 INCOME1=SI*30000:INCOME2=SHF*30000:INCOME=INT(INCOME1+INCOME2)/RATING
470 IF PAY="0" THEN INCOME="INCOME/3" ELSE IF PAY="1" OR PAY="2" THEN INCOME="INCOME/3*2
480" SUM="INT(SUM+INCOME)
490" REM
500 SUM(I)=SUM
510 IF I="1" THEN PRINT "First Winter Season Count 1";SUM(I);INT(INCOME)
520 IF I="2" THEN PRINT "First Winter Season Count 2";SUM(I);INT(INCOME)
530 IF I="3" THEN PRINT "First Winter Season Count 3";SUM(I);INT(INCOME)
540 IF I="4" THEN PRINT "Splinter Season Count 1";SUM(I);INT(INCOME)
550 IF I="5" THEN PRINT "Splinter Season Count 2";SUM(I);INT(INCOME)
560 IF I="6" THEN PRINT "Splinter Season Count 3";SUM(I);INT(INCOME)
570 IF I="7" THEN PRINT "Summer Season Count 1";SUM(I);INT(INCOME)
580 IF I="8" THEN PRINT "Summer Season Count 2";SUM(I);INT(INCOME)
590 IF I="9" THEN PRINT "Summer Season Count 3";SUM(I);INT(INCOME)
600 IF I="10" THEN PRINT "Last Fall Season Count 1";SUM(I);INT(INCOME)
610 IF I="11" THEN PRINT "Last Fall Season Count 2";SUM(I);INT(INCOME)
620 IF I="12" THEN PRINT "Last Fall Season Count 3";SUM(I);INT(INCOME)
630 NEXT:MOUNTH=1:INPUT "",PASS:NEXT
640 IF INCOME1+INCOME2>TOTAL THEN PER=(INCOME1+INCOME2)*COUNT*100/(TOTAL*1000000)/RATING
650 IF INCOME1+INCOME2 660 PRINT "share of";PER:PRINT
700 GOTO *START

行番号100,110,120,130は、このプログラムが、福岡 大の製作したソフトである事が書かれています。また、開発環境を電脳組であると明記しています。
Command Line 100,110,120,130, This Program is Programming By Dai Fukuoka Maked with Development "Dennougumi" Coopration Limited Sign Signal .
行番号140は、配列変数の格納個数を”SUM”99個”AGREE”20個定義します。
Command Line 140 , Arrangement Valiable Conteiner Kind of "SUM" 99 Unit and "AGREE" 20 Unit Formated it .
行番号170と180は現在の月を入力します。年末決算までの収入を計算します。
Command Line 170,180 , User Must Just Now Mounth Typing After Incomming Close The Year Sales on Start Line Now .
行番号190は、意志表示の関数を実行します。0より大きく、13より小さい場合は何もしません、その代わり例外が起こった時に、ラベル”Q1”に戻りますから、1から12までしか、変数に格納できません。 Command Line 190 , This Function is Statement Execution 0 More Than 13 Less Than Case in Not Execute , Exception Case is Return Go to "Q1" Label .
行番号200と210は社会保険の指数を入力を必要とします。社会保険がない場合は投資売上を計算する事ができません。
Command Line 200,210, Society Insurance Exparent is Must Need Typing , IF Society Insurance Case Nothing is No Total .
行番号220は、-1より大きく11より小さい場合は何もしません、例外はラベル”Q2”に一段階戻ります。
Command Line 220 , Type Result -1 More Than and 11 Less Than Case is Nothing Else Exception Jump to "Q2" Label Back One Step Type Work .
行番号230と240は、証券罰金の金額を指数で入力します、株から投資の還元が出来ない、ファイナンシャルプランに対して付くファイナンシャルです。”SHF”変数に格納されます。 Command Line 230,240 , Stock Market Fine Must Type Exparent , No Chapital Incomming Case is Financial Plan Use It , This In Puted Infomation is Variable "SHF" Conteiner In . 行番号250と260は、社会保険指数を入力した”SI"と、証券罰金の指数の”SHF”no両方が空で有れば、社会保険の質問の”Q2"ラベルに移動します。
Command Line 250,260 , Typed "SI" and "SHF" Variable with In Puted Exparent Society Insurance and Stock Market Fine , IF Case is Both Nothing Answer Question Label "Q2" Jump . 行番号270と280は、変数”RATE”に通貨換算値を入力します。
Command Line 270,280 , User Must Typing Variable "RATE" In put Money Exchange Rating Value .
行番号290は、前回の入力に0は、180分の1、1は等倍、2は、133分の1とユーロ、円、米ドルに対応します。実際のFXは、もっと日本の通貨が高い数値で取引されていますが、ストックマーケットはこの値です。
Command Line 290 , RearWard Typed Method Exchange Value Case "0" 180 Divide, Case "1" Equivalent ,Case "2" Divide 133 Supprot Change Value 3 Type ,Reality Fx A Mount Japan Yen Height Rating Exchange ,Else Exist Stock Market Standard Value .
行番号300と310は、収入方式を、支払責任を設定します。”0”法人税と配当金を社会保険、罰金に払う、給料は決済される(1)法人税のみ、投資責任を証券会社のみに任せる(2)配当金のみ、投資家責任を負う(3)全部の資本責任を自分で負う。
Command Line 300,310,Setting Incomming Type Payed Responsibility Type In put Valiable "PAY" Value of "(0) Cooprate Tax with Allotment Society Insurance and Fine , Payed Incomming ,(1) Only Cooprate Tax Pay Security with Stock Market (2) Only Allotment Responsibility Investor (3) All Incomming Responsibility" 行番号320は、変数”PAY”がー1より大きく、4より小さい場合に何もしません、その他の実在されるのは、ラベル”Q5”行番号300にある所に移動する。
Command Line 320 Valiable "PAY" More Than -1 Less Than 4 Case Nothing ,Else Exist Jump Label "Q5" Command Line 300 .
行番号330と340は、入力を必要とし、通り越すことができません、社会保険と、証券罰金の合算について聞いています。それを上回る場合は、株と解釈されます。
Command Line 330,340 , User Need Type with on No Skip , hear Society Insurance Addition Fine Total , Case Over is Addit Chapital Understand .
行番号350は、合算の結果が0より小さい場合、ABS関数で符号を反転します。
Command Line 350 , Resualt Case Valiable "TOTAL" Value Less Than "0" is Reverse Sign ABS Founction .
行番号360と370は、署名について自分自身の管轄であるか、預かっているのかを聞きます。
Command Line 360,370 , This Since About User Proxy or My Found Else Undecided hear It , Valiable "MINE" Value Type In Put True (0) Did User No Have Use It , False (1) DId User Have Use It . 行番号380は、変数”MINE”が”0”か”1”であれば何もしません、その他の実在は、元の質問のラベル”Q7”に戻ります。
Command Line 380 , Valiable "MINE" Value is Case "0" or Case "1" Than Nothing ,Else Exist Return Answer Jump Label "Q7" .
行番号390と400は、証券を運用する年数を聞いています、変数”SR”に格納されます、(0)1年(1)2年(2)4年。
Command Line 390,400 , Plactical Use Term Year Type Count Valiable "SR" In Put , Tarm is Next (0)1 Year Between (1) 2 Year Between (2) 4 Year Between .
行番号410は、-1より大きく3より小さい場合は何もしません、その他の実在はラベル”Q8"に戻ります。
Command Line 410 , More Than "-1" Less Than "3" Case Nating , Else Exist Go to Label "Q8" .
行番号420と430は、配列”AGREE”に対して各変数を代入していきます。
Command Line 420,430 , Arragement Valiable "AGREE" Target EquiValent Case "(1):Mounth", Case "(2):SI", Case "(3):SHF" , Case "(4):RATE" , Case "(5):PAY" , Case "(6):TOTAL" , Case "(7):MINE" , Case (8):SR" Input Many Value Equivalent . 行番号440は、”SR”を期間の年数に変換します。”SR2”に代入されます。
Command Line 440 , Valiable "SR" Change Tram "SR2" Min 1Year Max 4 Year Type In put Loop Count Valiable .
行番号450は、関数”FOR”は変数”T”に”1”の開始を定義して、変数”SR2”に終了します。、また、その間“FOR”関数は、変数”I”に対して開始月を変数”MOUNTH”から始まり、12月に統計を終了します。年が繰り越されたら、月は冬の”1月”にもどります。
Command Line 450 , Statement Function "FOR" is Valiable "T" in "1" to "SR2"(SR2 Tarm Season Monthly) and End of "SR2" , Through Also Between Statement Function "FOR" is Valiable "I" in Start Mounth with Valiable "Mounth" to December 31 Close Year ,Over Take Year is Start Mounth Change Junylary 1 Turn And Loop with "SR2" Year End Year with Season .
行番号460は収入変数”INCOME1”に社会保険料変数”SI”に30千に掛け算します。収入変数”INCOME2”には、証券罰金を30千で掛け算します、収入変数”INCOME”は、”INCOME1”と”INCOME2”を合算し通貨換算値で割ります。日本通貨を通常と想定しているので、日本円は、換算値で割りません。
Command Line 460, Recieve Payed Valiable "INCOME1" in Society Insurance Valiable "SI" Method Multiply 30Thousand Resolution Exparent ,With Recieve Pauyed Valiable "INCOME2" in Stock Market Fine Method Multiply 30 Thousand With Method "INCOME1" Addition "INCOME2" Equivalent "INCOME" TOTAL Divition Contry Money Rating Exchange ,Japan Yen Money is Standard Accounting with Defualt .
行番号470は、条件関数にて変数”PAY1”が”0”の場合、”1”の場合、そして”2”の時、3で割り算するのか、3で割って10分の1を求めて2で掛け、20PerMoneyを計算します。雇用計画の二つになる。
Command Line 470, Desision Statement Founction "IF" by 2 Type Brunch Case "0" by Method "INCOME" Divition 3,Reduce 10 Per Money ,Case "1" by Method "INCOME" Divition 3 with Multiply 2 of 20Per Incomming Money Payed Empoyee Plan 3 Type .
行番号480は、変数”SUM"に小数点を切り捨てる関数”INT”を使用して、”SUM”に対して”INCOME”を加算します。
Command Line 480, Valiable "SUM" into "SUM" Addtion with "INCOME" and Filter Function "INT" Execute Matrix .
行番号500は、配列変数”SUM(Count)”に、SUMを等価にします。
Command Line 500, Arragement Valiable "SUM()" with Now Count Equivalent Valiable "SUM" .
行番号520から620は、関数”IF”にて、現在の変数”I”を12段階で分岐し、冬から秋にかけて現在の”INCOME”と、”SUM(数)”を表示します。620番まで途中で加算する式はありません。行番号630は、12月ごと変数”Pass”にて、ユーザーの入力を待ちます。関数”NEXT”で、440行番号から、630の区間を繰り返します。 Command Line First 520 to Last 620, Statement Function "IF" by Now Valiable "I" is Case Count 12 Type to Show Display Valiable "SUM(I)" with Valiable Now "I" and Season List Wait User Typing Passager Valiable "Pass" ,Command Line 630 is Statement Function "NEXT" is 440 to 630 Section Looping Count and Count . 行番号640は、変数”TOTAL”(合算)が収入変数”INCOME1”と”INCOME2”より小さい場合、”PER”変数に、合算を格納します。
Command Line 640 ,Valiable "TOTAL" less than Valiable "INCOME1" Addition "INCOME2" Case Valiable "PER" In put Conteiner Method "INCOME1" Addition with "INCOME2" Multiply Valiable "Count" Multiply 100 Divition Valiable "TOTAL" Multiply 1Milion Divition Valiable "RATING" . 行番号650は、変数”INCOME1”と変数”INCOME2”を加算した同じ値より、変数”TOTAL”が上回る場合、変数”PER”に対して”INCOME1”と”INCOME2”の合算を格納します。 Command Line 650 ,Valiable "INCOME1" Addition "INCOME2" Equivalent More Than Valiable "TOTAL" Case is Valiable Conteiner "TOTAL" Method Valiable "INCOME1" Plus Valiable "INCOME2" Total Valiable "TOTAL" . 行番号660は、占有率と変数”PER”を表示します。
Command Line 660 ,Share of Valiable "PER" to Show Display Counting .行番号700は、ラベル”START”に移動します。行番号160に移動します。
Command Line 700 ,Go to Label "START" and Command Line 160 Jump it .

*****************
deditor

100 REM --------------------
110 REM copyright Module by DaiFukuoka 2016.6.20-7.21
120 REM (c)電脳組
130 REM --------------------
140 CONSOLE 0,24,0,1:SCREEN 3,0,0,1:WIDTH 80,25:COLOR 0,7,0,7,2:CLS 3
150 DIM CSV$(9999,11)
160 IF POINT(639,479)=POINT(639,399) THEN LINEMODE=-1:GOTO *L2 ELSE LINEMODE=1:GOTO *L1
170 *L1
180 LINE (0,0)-(639,18),4,BF:LINE(0,32)-(639,48),4,BF
190 LINE(0,96)-(639,112),5,BF:LINE(0,176)-(639,192),5,BF
200 LINE(0,256)-(639,272),6,BF:GOTO *O1
210 *L2
220 LINE (0,0)-(639,18),4,BF:LINE(0,36)-(639,54),4,BF
230 LINE(0,110)-(639,130),5,BF:LINE(0,187)-(639,204),5,BF
240 LINE(0,263)-(639,282),6,BF
250 *O1
260 LOCATE 0,0:PRINT "Load File Name : ";:INPUT "",LFN$:IF LFN$="" THEN *START
270 OPEN LFN$ AS 1:LEOF=EOF(1):CLOSE 1:IF LEOF=-1 THEN *MAKEFILE
280 OPEN LFN$ FOR INPUT AS #2:
290 FOR I=1 TO 9999:INPUT #2,CSV$(I,1),CSV$(I,2),CSV$(I,3),CSV$(1,4),CSV$(1,5),CSV$(I,6),CSV$(I,7),CSV$(I,8),CSV$(I,9),CSV$(I,10),CSV$(I,11):NEXT:CLOSE #2
300 LOCATE 0,0:PRINT SPC(78);:GOTO *START
310 OPEN LFN$ FOR OUTPUT AS #1
320 FOR I=1 TO 9999:WRITE #1,CSV$(I,1),CSV$(I,2),CSV$(I,3),CSV$(I,4),CSV$(I,5),CSV$(I,6),CSV$(I,7),CSV$(I,8),CSV$(I,9),CSV$(I,10),CSV$(1,11):NEXT:CLOSE #1
330 LOCATE 0,0:PRINT SPC(78);:GOTO *START
340 *START
350 LOCATE 0,0:PRINT SPC(78);
360 IF CSV$(PAGE,ARTICLE)="" THEN CSV$(PAGE,ARTICLE)=" "
370 IF CSV$(PAGE,1)="" THEN CSV$(PAGE,1)=" "
380 IF FLAG=0 THEN PAGE=1:LOCATE 0,0:PRINT "Tittle / Page :";:INPUT "",PAGE:LOCATE 0,1:PRINT CSV$(PAGE,1):LOCATE 0,2:PRINT "Article Preview :";:INPUT "",ARTICLE:LOCATE 0,3:PRINT CSV$(PAGE,ARTICLE)
390 IF FLAG=-1 THEN FLAG=0:LOCATE 0,0:PRINT "Tittle / Page :";PAGE;SPC(200);:LOCATE 0,1:PRINT CSV$(PAGE,1):LOCATE 0,2:PRINT "Article Preview :";ARTICLE;SPC(200);:LOCATE 0,3:PRINT CSV$(PAGE,ARTICLE)
400 LOCATE 0,6:PRINT "Edit Artice";ARTICLE;" Page";SPC(200);PAGE;:LOCATE 0,7:INPUT "",WROTE$
410 IF WROTE$="" OR WROTE$=" " THEN ELSE CSV$(PAGE,ARTICLE)=WROTE$
420 *LOOP1
430 LOCATE 0,10:PRINT "Select Article and Pages";
440 LOCATE 0,11:PRINT "0: NoMove , 1:Add+ , 2: Dec-";:INPUT "",REQUEST
450 IF REQUEST=0 THEN *ACCEPT
460 LOCATE 0,12:PRINT "0:[1]/1:[10]/2:[100]/3:[1000]";:INPUT "",MANY
470 *ACCEPT
480 LOCATE 0,13:PRINT "Okay? 0:Yes / 1:No ";:INPUT "",ACCEPT:IF ACCEPT=1 THEN *LOOP1
490 IF MANY=0 THEN COUNT=1
500 IF MANY=1 THEN COUNT=10
510 IF MANY=2 THEN COUNT=100
520 IF MANY=3 THEN COUNT=1000
530 IF COUNT+PAGE>9999 THEN *LOOP1
540 IF COUNT+PAGE<1 THEN *LOOP1
550 IF REQUEST="0" THEN PAGE="PAGE
560" IF REQUEST="1" THEN PAGE="PAGE+COUNT:FLAG=-1
570" IF REQUEST="2" THEN PAGE="PAGE-COUNT:FLAG=-1
580" LOCATE 0,14:PRINT "For Number of Article : (1-11) : ";:INPUT "",ARTICLE
590 IF ARTICLE<1 OR ARTICLE>11 THEN ARTICLE=1
600 LOCATE 0,15:PRINT "0:Saving Sequence 1:No Think : ";:INPUT "",FILESAVE
610 IF FILESAVE=1 THEN *START ELSE IF FILESAVE=0 GOTO *SFN
620 *SFN
630 LOCATE 0,16:PRINT "Save File Name : ";:INPUT "",SFN$
640 CLS:IF SFN$="" THEN *LOOP1
650 OPEN SFN$ AS 1:CLOSE 1:OPEN SFN$ FOR OUTPUT AS #1
660 FOR I=1 TO 9999:WRITE #1,CSV$(I,1),CSV$(I,2),CSV$(I,3),CSV$(1,4),CSV$(1,5),CSV$(I,6),CSV$(I,7),CSV$(I,8),CSV$(I,9),CSV$(I,10),CSV$(I,11):NEXT:CLOSE #1
670 GOTO *START
680 *IFEND GOTO *START:END IF:END



行番号100,110、120,130、これは、モジュールを作った著者の福岡 大は、控めな申請です。開発環境は、有限会社電脳組です。
Command Line 100,110,120,130 , This is Make Moduler Dai Fukuoka All Right Reserved(Copy right) and PratForm Coopration Limited Dennougumi .
行番号140は、文字の大きさと、スクリーン画面の設定と合わせて、色彩と、背景色です。
Command Line 140 , Setting is Screen Charactor size with Color mode and BackGround Color .
行番号150は、配列変数CSV形式の文字列を、1万回と、11段に分けた設定します。
Command Line 150 , Setting is CSV Type Data of Arrangement Strings Words with Count and 10Thousand withon 11 Category .
行番号160は、背景色が、640と、480数の位置と、640と400の数の位置の色情報を実際に採取して、それをIFステートメントで判定を分けます、480ラインと同じで有れば-1と*L2ラベル、400ラインで有れば、黒色が地点に返されて、+1のラインモードの変数に格納します。ラベル*L1に移動します。
Command Line 160 , Case and Case IF Desision Case Ture Screen Line Mode Max 480 , Less than case False Screen Line Mode Min 400 , Desision Large or Small , Program Must Standard Screen Setting and Execute Setting ForWard Label Large *L2 or Small *L1 withon Target Root in *O1 .
行番号170、180.190、200、図形機能Line関数を使って四角形を端から端まで描いて、画面を編集します、色覚を文字列に密接します。
Command Line 170,180,190,200 , Draw Rect Deep and Deep Screen Side , Edit Screen Color BackGround Color with Fit String Text .
行番号220,230,240、規格高さで整列した四角い領域を400ラインモードで描画します。
Command Line 220,230,240 , Arrangement Rect Square Angle of Standard Height 400 Line Screen Mode at Draw .
行番号260は、必要なければ、名前を指定する必要ありません、記録したファイル名データを読み込みます。
Command Line 260 , Recording Wrote CSV Sequenceal Load File Name , FIle Name is Need Less Appointment .
行番号270は、ファイルの終端をLEOF変数に判定を納めます、LFNが行番号260にて指定されたファイルを開きます。
Command Line 270 , RearWard One Step with Variable Value Decition Put in "LEOF" Variable Value , Appointment File Name "LFN" Open .
行番号280、290は、指定したファイル名を開き、書き込み設定で11列のCSVと、終端までの高さを定数9999行まで記録ファイルから読み取ります
Command Line 280,290 , Appointment File Name Open with Trough Writing 11 Count Arrangement withon 9999 Count Height Clomn Record File to Read and End of File .
行番号300、330は、文字列の在った0,0座標に78文字半角で空白を埋め、ラベル *Startへ飛び越します。
Command Line 300 , Skip out Label "Start" Jump with String Text Coordinate 0,0 Point Harf 78 Count Type Spacing .
病番号310、320は、キャッシュから書き込んで失った変数値を”OUTPUT”設定で書き込んだ情報から読み込みます。
Command Line 310,320 , Wrote Infomation at Cash Memory loss Variable Value After Read Setting "OUTPUT" Mode at Variable Full Fill a Hole Record .
行番号360、370は、CSV形式に空の情報に対して空白を詰めていきます。CSVの先頭配列と参照配列に空白を詰めます。
Reference Pick upping Empty Changing Space Fill a Hole and Top Word Change Space .
行番号380は、変数”FLAG”が0の結果の時、開始準備を設定し、”PAGE”変数が1から始まります。整数で使用者が入力する必要があります。
Command Line 380 , Decition Result Variable Value of 0 Count For Start up Setting Page Variable Start one Trough , User is Need Typing Infometion .
  行番号390は、変数値”FLAG”が-1の時"FLAG”をオフセット(0)にします。現在位置の変数値”PAGE”と、”ARTICLE”の値を表示したあと200文字空白で埋めます。1行目と3行目です、また空白を詰めたあと、現在位置の”CSV”形式の現在位置の内容を表示します。
Command Line 390 , Decition Result Variable "FLAG" Value if "-1" Case For Ward Set "0" off Set , String Text Clear Setting Space Mode , Show Display "CSV" onTime "Page" and "Article" Variable Value to Location 0 with 2 and Show String Text Contents .
行番号400は、7、8行目の6と7に、今編集中の”ARTICLE”と”PAGE”を表示し、変数値”WROTE”に格納します。空の場合は、1文字の空白が詰められます。
Command Line 400 , Colmn 7,8 Value 6,7 onTime Editing Text "ARTICLE" and "Page" Enter "CSV" Type Arrangement Variable , Show Display "Page" and "Article" Count .
行番号410は、入力で何も入力しなかった場合や空白が詰められている場合 なにもしなく、また他は”CSV”配列変数に対して文書を格納します。
Command Line 410 , This is Type Nothing Skip,User Must Typing , if No Nothing Case In Put Arragement Variable Value Type Text Infomation .
行番号430、440、450、460、480は、”MANY”と、”REQUEST”を入力し、その案内を表示します。そのままエンターキーを押すとラベル”ACCEPT”に移動して回答を伺う、否定した場合に変数”ACCEPT”を”1”とする、普通にエンターキーを押して、数値が”0”で有れば、同意し次へ進みます。
Command Line 430,440,450,460,480 , User Type Page Change Program For Input of "MANY" , "REQUEST" Atter Sign In Next , Request Ask Type Method withon Addition or Decrease Type Result , Move Page is "1","10","100","1000" Plus Minous to Decition Value Pages,Accept Type Support Enter and Defualt Value to Skip Request Standard Settings .
行番号490,500,510,520は、変数"MANY”で入力した数値に対して表記結果を条件によって数値が変わります。
Command Line 490,500,510,520, Decition Variable "MANY" Value IF Case is Need Type And Result Method Column , Default Setting Value Skip "Enter" Accept Automation Result Type Value,Change Page Count it .
行番号530,540は項の数値が9999以下1以上になるように例外を除外します。
Command Line 530,540, This Function is Exist Variable Value of 10000 under with 0 Over,Other Run Back .
行番号550、560、570は、回答した項の増減を中立なのか、増えるのか、減るのか変数”PAGE”に対して先ほど入力した”MANY”から作られた”COUNT”を増減します。
Command Line 550,560,570, RearWard This Function Ask reQuest Page Count WareHouse Nutral or Addition or Decrease,This is Make Variable "MANY" to "COUNT" IF Case Nutral is NoFlag Else Other Decition is Flag "-1"
行番号580は、590、CSV規格に準拠し、256文字以内、12項目以下です。質問と答え、”ARTICLE”にCSVの項目値を入力します。正しくない値は除外されます。
Command Line 580, This Soft Ware Standard Basic/98 with MicroSoft N88Basic(86) with TYPE DATA CSV, This Function Infomation "ARTICLE" Type Input "ARTICLE" at Value And Arragement, Request and Answer "CSV" Standard Type Variable Input Values, Exist No "256" Word Over with No "11" Arragement Over .
行番号600は、書いた情報を今保存するのか、結構なのか回答を必要とします。任意のエンターキーでは通常は保存します。変数値”FILESAVE”に結果を保持します。
Command Line 600, Now Savings Infomation Worte or No think Need Type Answer,User Type Result Nothing is Accept Wrote Planning Keep Result .
行番号610は、先程の説明に0と1以外の不正な値が格納されないように判定します。
Decition Bad Value Type Input "FILESAVE" Case Exist it , This Variable is Keep Conteiner Data .
行番号630と640は、”SAVE FILE NAME”保存する名前を”SFN”変数に入力します。次の行で、”SFN”変数が空で有ればラベル”LOOP1”に移動します。”LOOP1”は、420行番号にあります。データを保持することにファイル名を入力しなければならないそれと、通り越し禁止に一緒に
Command Line 630,640 , Show Answer "SAVE FILE NAME" After Stand by Typing and ReName Variable Conteiner "SFN" In Put Typing Infomation , IF Case Variable Value Nothing with Go to Label "Loop1" Jump Command Line 420 .Keep Data is Must Typing FileName withIn NoSkip .
行番号650と660は、変数”SFN"にあらかじめ空のファイルを#なしで作成しておき、後から作られたように、シーケンシャルファイル番号#1番にエクスポートの”OUTPUT"モードに変えます。また次の行でっは、ループ(繰り返し処理)を使って、実際に一行づつ9999回まで書き込みます、書きこまれる内容の全てが、”CSV”配列変数でなければなりません、Nextで折り返しForに戻り、抜けると#1のファイルを閉じます。
Command Line 650,660 , Starting by Empty Data File , Make "SFN" Variable New File Name For Write , Maked ForWard Sequence #1 Open Number Export "OutPut" Mode Change Open FIle Mode , This Function with Variable is Loop 1 to 9999 Count Jump Start on Count , This All Contents is Standard "CSV" Type Variable Arrangement , IF Loop out is Sequence Number #1 Close Open File with File Name Close .
行番号670は、初期化作業のみを除いた位置にラベル”START”に戻ります。行番号340にあります。
Command Line 670 , System Work is Full Setting Go to Jump Label "START" ReTurn Locate on Command Line 340 .

システムアドミニストレーター4 キャラクター 最新版

2019-03-20 03:44:30 | 日記
Timer Set on Aram,Buzzer on Beep Loop Seting Times.
100 REM ---------------------
110 REM Aram Program by Dai Fukuoka 2018.05.09
120 REM (C)電脳組
130 REM ---------------------
140 CONSOLE 0,25,0,1:SCREEN 3,0,0,1:WIDTH 80,25:COLOR 0,7,0,0,1:CLS 3
150 A$=TIME$:FOR I=0 TO 1 STEP 0:IF TIME$="07:40:00" THEN I=1:BEEP:BEEP:BEEP:BEEP:BEEP:BEEP:END
160 NEXT

Suptport Attend Go to That Hospital's, Wake Up Beep Sound on Timming on Get Up And Stand by Attend.Command Line 140,Standard Setting at Source Coode
Command Line 150,Let Timmer Variable Value of A$ Let Times at Scond Process,Catch on Timmer in AM 7:40 Hour and Minute Set with Start Up Stand up Wake Timer and Buzzer of BEEP count 5 Aram Timer.That Timmer is Program at Wake up Aram Source Coode.Statement of End Command is Close Program at on Stand by "Beginner's All-purpose Symbolic Instruction Code" at Those Standard Command Prompt.
このプログラムは初期化と、起床時間のブザー音で知らせるタイマーを朝の7時40分に出発準備をする例文のプログラムソフトです。単純な構造になっており、変数”A$”にタイマーをセットする事で、FORによる無限ループによって、ビープ音で知らせて、ENDにて終了します。病院の通院の8時10分発着発のバスを7時40分から出発して待合します。







100 REM ---------------------
110 REM SearchAscii Program by Dai Fukuoka 2018.07.15
120 REM (C)電脳組
130 REM ---------------------
140 CONSOLE 0,25,0,1:SCREEN 3,0,0,1:WIDTH 80,25:COLOR 0,7,0,0,1:CLS 3
150 DIM STRAIGHT$(390000):DIM HITCOUNT(390000):DIM CASEFILE$(2,99999)
160 INPUT "Open Sequential File Type of CSV Data Base Files : (FileName) ",A$
170 REM ON ERROR GOTO *ERRORSTOP:GOTO *SKIP1
180 REM *ERRORSTOP PRINT "No File Name Error";ERR:END
190 *SKIP1
200 OPEN A$ FOR INPUT AS #1:COUNT=1:WHILE EOF(1)=0:INPUT #1,STRAIGHT$(COUNT)
210 COUNT=COUNT+1:WEND
220 ENDCOUNT=COUNT:COUNT=1:PRINT "This DataBase Catch Out Conut of";ENDCOUNT-1
230 INPUT "Definition Type Sarch Words (2Byte):",B$:WLENGTH=LEN(B$):PRINT "Condition :";B$
240 FOR I=1 TO ENDCOUNT-1:FOR T=1 TO LEN(STRAIGHT$(I))
250 IF MID$(STRAIGHT$(I),T,WLENGTH)=B$ THEN HITCOUNT(I)=HITCOUNT(I)+1
260 NEXT T,I
270 FOR I=1 TO ENDCOUNT-1:IF HITCOUNT(I)=0 THEN ELSE PRINT I;"Result";HITCOUNT(I);",";
280 NEXT:PRINT
290 COUNT=1:FOR I=1 TO ENDCOUNT-1:IF NOT HITCOUNT(I)=0 THEN PRINT COUNT;STRAIGHT$(COUNT);:I=ENDCOUNT
300 NEXT
310 INPUT"Are You Hope All Data Base File Up List(Condition Print)(Y:0/N:1)",A:IF A=1 THEN *SKIP3
320 FOR D=1 TO ENDCOUNT-1
330 IF HITCOUNT(D)=0 THEN ELSE CASEFILE$(2,D)=STRAIGHT$(D):PRINT CASEFILE$(2,D)+" ";
340 NEXT D
350 *SKIP3
360 OPEN "SA18.txt" AS #2:CLOSE #2
370 OPEN "SA18.txt" FOR OUTPUT AS #2
380 FOR I=1 TO ENDCOUNT-1:IF HITCOUNT(I)=0 THEN ELSE WRITE #2,CASEFILE$(2,I);
390 NEXT I:CLOSE #2
Saerch Words and Data Base Read in Common is Count and Count After Type and Type Looking InvestiGate.User is Input Typing Any Clause.User Hope Farvorite Word Quick Search This Program.Analyse Result Data Base Contents.Seach ITEM's Conteiner SA18.txt File is Write with Reference txt.

探している文と、データーベースを読み込む共通の数と数、その後の文と文を見て調べる。使用者は入力して幾つかの箇条使用者は希望する好きな文をすばやく調べるこのソフトです。解析する結果のデーターベースの内容。探した項目は、SA18.txtのファイルに書いて一緒に参照するtxt





100 REM ---------------------
110 REM GuestArragement by Dai Fukuoka 2018.08.30-09.08
120 REM (C)電脳組
130 REM ---------------------
140 CONSOLE 0,25,0,1:SCREEN 3,0,0,1:WIDTH 80,25:COLOR 0,7,0,0,1:CLS 3
150 DIM CSV$(27000):DIM SORTNUM$(255):DIM NEWCSV$(27000):DIM LETSORT$(255):DIM ALPHABET$(255):DIM NUM(27000):DIM TOP(27000):DIM NEWNUM(27000):DIM TWO$(27000,2)
160 INPUT "CSVデーターベースのファイル名を拡張子付きで書いてください",FLN$
170 OPEN FLN$ FOR INPUT AS #1
180 FOR I=1 TO 27000:IF EOF(1)=0 THEN INPUT #1,CSV$(I)
190 IF EOF(1)=-1 THEN ENDPERIOD=I:I=27000
200 NEXT:CLOSE #1
210 IF ENDPERIOD=1 AND CSV$(1)="" THEN PRINT "ファイルが空です"
220 DATA "あいうえおかきくけこさしすせそたちつてとなにぬねのはひふへほまみむめもやゆよらりるれろわをん"
230 READ B$:FOR I=1 TO 46:LETSORT$(I)=MID$(B$,I*2-1,2):NEXT
240 DATA "アイウエオカキクケコサシスセソタチツテトナニヌネノハヒフヘホマミムメモヤユヨラリルレロワヲン"
250 READ A$:FOR I=1 TO 46:LETSORT$(I+46)=MID$(A$,I*2-1,2):NEXT
260 DATA "AIUEOKaKiKuKeKoSaSiSuSeSoTaTiTuTeToNaNiNuNeNoHaHiHuHeHoMaMiMuMeMoYaYuYoRaRiRuReRoWaWoNn"
270 READ C$:FOR I=1 TO 5:ALPHABET$(I)=MID$(C$,I,1):NEXT
280 FOR I=1 TO 42:ALPHABET$(I+5)=MID$(C$,(I*2)+4,2):NEXT
290 FOR I=1 TO ENDPERIOD
300 FOR T=1 TO 5:IF NUM(I)=0 AND MID$(CSV$(I),1,1)=ALPHABET$(T) THEN NUM(I)=92+T
310 NEXT
320 FOR T=1 TO 42:IF NUM(I)=0 AND MID$(CSV$(I),1,2)=ALPHABET$(T+5) THEN NUM(I)=97+T
330 NEXT
340 FOR T=1 TO 92:IF NUM(I)=0 AND MID$(CSV$(I),1,2)=LETSORT$(T) THEN NUM(I)=T
350 NEXT
360 NEXT
370 LET R=1:FOR I=1 TO 139:FOR T=1 TO ENDPERIOD
380 IF NUM(T)=I THEN NEWCSV$(R)=CSV$(T):R=R+1
390 NEXT:NEXT
400 OPEN "sortExport.txt" AS #1
410 IF NOT EOF(1)=0 THEN ENDOFFILE=1
420 CLOSE
430 OPEN "sortExport.txt" FOR OUTPUT AS #1
440 FOR I=1 TO ENDPERIOD:WRITE #1,NEWCSV$(I):NEXT
450 CLOSE #1
460 FOR I=1 TO ENDPERIOD:PRINT NEWCSV$(I);:NEXT
470 PRINT "Result of Sort."
480 INPUT "on Enter Restart.",A$
490 RUN


This is Naming List Book at Japanese is Case of Hiragana,Kana,Roman Order Arragement Reference Firstest Hiragana Second Kana Next Roman Legal Rule.This is Examination Empty File ,And Too Stop on Case with Restarting,If Empty Case is Have File Name True That Touch Type File Name is No Error and Can ReStart.Command Line : 220 is Sort Arragement DataBase Reading Start,That File Put Exchange Word Number is Result 1 to 139 Arragement Changing Top Word Name at Nubmber.ReUse and Change Cycle Alphabet Arragement Remake If Can Your Technique and ABC Sort Arragement ReChange.Result is Display with Export Txt File,This is Note Pad Examination and Change Arragement Result See You Result on Note Pad Applette to "sortExport.txt".

このソフトは日本人名簿を並び替えます。並び替えを日本語でひらがな、カタカナ、ローマ字に並び替えるソフトです。Readで順次、ソート項目を読み込み、DATAから文字配列を抽出します。応用すれば、ABC順に並び替える事もできます。結果は、表示され、新しくソートエクスポートと言うCSVデータ型でTXT形式のメモパッドで読み込み可能です。主に日本語の名前の並び替えに有効な使い道があります。

ドットエディッタ プリセットエディッタ アーカイブ Pest Editor シスアド3残り

2019-03-20 03:43:07 | 日記
7740 ::
7750 END
7760 END
7770 END
7780 *BLOCINMASK
7790 ' CNTB=CNT:TT=TSY+SY+BPY:T=TSY:I=IS:FOR II=IS+SX+BPX TO ISX+SX+BPX STEP IP
7800 IF T>2 AND T<9 AND I>0 AND I<9 AND LAYER(II,TT-1,LAY)=MP AND MASK(II ,TT-2)=1 THEN IF MASK(II,TT-1)=0 THEN MASK(II,TT-1)=1:CNT=CNT+1
7810 IF T>1 AND T<9 AND I>0 AND I<9 AND LAYER(II,TT ,LAY)=MP AND MASK(II ,TT-1)=1 THEN IF MASK(II,TT )=0 THEN MASK(II,TT)=1 :CNT=CNT+1
7820 IF I>1 AND T<9 AND I>1 AND I<9 AND LAYER(II,TT-1,LAY)=MP AND MASK(II-1,TT-1)=1 THEN IF MASK(II,TT-1)=0 THEN MASK(II,TT-1)=1:CNT=CNT+1
7830 IF I>0 AND T<9 AND I>1 AND I<9 AND LAYER(II,TT ,LAY)=MP AND MASK(II-1,TT )=1 THEN IF MASK(II,TT )=0 THEN MASK(II,TT)=1 :CNT=CNT+1
7840 IF T>1 AND T<9 AND I>1 AND I<8 AND LAYER(II,TT-1,LAY)=MP AND MASK(IPENX+1,TT-1)=1 THEN IF MASK(II,TT-1)=0 THEN MASK(II,TT-1)=1:CNT=CNT+1
7850 IF T>0 AND T<9 AND I>0 AND I<8 AND LAYER(II,TT ,LAY)=MP AND MASK(II+1,TT )=1 THEN IF MASK(II,TT )=0 THEN MASK(II,TT)=1 :CNT=CNT+1
7860 IF T>1 AND T<9 AND I>0 AND I<9 AND LAYER(II,TT-1,LAY)=MP AND MASK(II ,TT )=1 THEN IF MASK(II,TT-1)=0 THEN MASK(II,TT-1)=1:CNT=CNT+1
7870 IF T>0 AND T<8 AND I>0 AND I<9 AND LAYER(II,TT ,LAY)=MP AND MASK(IT ,TT+1)=1 THEN IF MASK(II,TT )=0 THEN MASK(II,TT)=1 :CNT=CNT+1
7880 T=T+TP:I=I+IP:NEXT
7890 IF CNT<>CNTB THEN *BLOCINMASK
7900 T=8:I=0:PASS=0:WHILE PASS<1:I=I+1:IF MASK(I+SX,T+SY)=1 AND BLOCY<8 THEN BLPASS(BLOCX,BLOCY+1)=1:PASS=1:BLSTART(BLOCX,BLOCY+1)=I
7910 WEND
7920 T=1:I=0:PASS=0:WHILE PASS<1:I=I+1:IF MASK(I+SX,T+SY)=1 AND BLOCY>1 THEN BLPASS(BLOCX,BLOCY-1)=1:PASS=1:BLSTART(BLOCX,BLOCY-1)=I
7930 WEND
7940 T=8:I=0:PASS=0:WHILE PASS<1:I=I+1:IF MASK(T+SX,I+SY)=1 AND BLOCX<8 THEN BLPASS(BLOCX+1,BLOCY)=1:PASS=1:BLSTART(BLOCX+1,BLOCY)=I
7950 WEND
7960 T=8:I=0:PASS=0:WHILE PASS<1:I=I+1:IF MASK(T+SX,I+SY)=1 AND BLOCX>1 THEN BLPASS(BLOCX-1,BLOCY)=1:PASS=1:BLSTART(BLOCX-1,BLOCY)=I
7970 WEND
7980 RETURN
7990 ::
8000 *BLOCINMASKMR
8010 ' CNTB=CNT:TT=TSY+SY+BPY:T=TSY:I=IS:FOR II=-(IS+SX+BPX) TO -(ISX+SX+BPX) STEP -IP
8020 IF T>2 AND T<9 AND I>0 AND I<9 AND LAYER(II,TT-1,LAY)=MP AND MASK(II ,TT-2)=1 THEN IF MASK(II,TT-1)=0 THEN MASK(II,TT-1)=1:CNT=CNT+1
8030 IF T>1 AND T<9 AND I>0 AND I<9 AND LAYER(II,TT ,LAY)=MP AND MASK(II ,TT-1)=1 THEN IF MASK(II,TT )=0 THEN MASK(II,TT)=1 :CNT=CNT+1
8040 IF I>1 AND T<9 AND I>1 AND I<9 AND LAYER(II,TT-1,LAY)=MP AND MASK(II-1,TT-1)=1 THEN IF MASK(II,TT-1)=0 THEN MASK(II,TT-1)=1:CNT=CNT+1
8050 IF I>0 AND T<9 AND I>1 AND I<9 AND LAYER(II,TT ,LAY)=MP AND MASK(II-1,TT )=1 THEN IF MASK(II,TT )=0 THEN MASK(II,TT)=1 :CNT=CNT+1
8060 IF T>1 AND T<9 AND I>1 AND I<8 AND LAYER(II,TT-1,LAY)=MP AND MASK(II+1,TT-1)=1 THEN IF MASK(II,TT-1)=0 THEN MASK(II,TT-1)=1:CNT=CNT+1
8070 IF T>0 AND T<9 AND I>0 AND I<8 AND LAYER(II,TT ,LAY)=MP AND MASK(II+1,TT )=1 THEN IF MASK(II,TT )=0 THEN MASK(II,TT)=1 :CNT=CNT+1
8080 IF T>1 AND T<9 AND I>0 AND I<9 AND LAYER(II,TT-1,LAY)=MP AND MASK(II ,TT )=1 THEN IF MASK(II,TT-1)=0 THEN MASK(II,TT-1)=1:CNT=CNT+1
8090 IF T>0 AND T<8 AND I>0 AND I<9 AND LAYER(II,TT ,LAY)=MP AND MASK(IT ,TT+1)=1 THEN IF MASK(II,TT )=0 THEN MASK(II,TT)=1 :CNT=CNT+1
8100 T=T+TP:I=I-IP:NEXT
8110 IF CNT<>CNTB THEN *BLOCINMASK
8120 REM T=8:I=0:PASS=0:WHILE PASS<1:I=I+1:IF MASK(I+SX,T+SY)=1 AND BLOCY<8 THEN BLPASS(BLOCX,BLOCY+1)=1:PASS=1:BLSTART(BLOCX,BLOCY+1)=I
8130 REM WEND
8140 REM T=1:I=0:PASS=0:WHILE PASS<1:I=I+1:IF MASK(I+SX,T+SY)=1 AND BLOCY>1 THEN BLPASS(BLOCX,BLOCY-1)=1:PASS=1:BLSTART(BLOCX,BLOCY-1)=I
8150 REM WEND
8160 REM T=8:I=0:PASS=0:WHILE PASS<1:I=I+1:IF MASK(T+SX,I+SY)=1 AND BLOCX<8 THEN BLPASS(BLOCX+1,BLOCY)=1:PASS=1:BLSTART(BLOCX+1,BLOCY)=I
8170 REM WEND
8180 REM T=8:I=0:PASS=0:WHILE PASS<1:I=I+1:IF MASK(T+SX,I+SY)=1 AND BLOCX>1 THEN BLPASS(BLOCX-1,BLOCY)=1:PASS=1:BLSTART(BLOCX-1,BLOCY)=I
8190 REM WEND
8200 RETURN
8210 ::
8220 *BLOCINMASKDS
8230 ' CNTB=CNT:TT=-(TSY+SY+BPY):T=-(TSY):I=IS:FOR II=IS+SX+BPX TO ISX+SX+BPX STEP IP
8240 IF T>2 AND T<9 AND I>0 AND I<9 AND LAYER(II,TT-1,LAY)=MP AND MASK(II ,TT-2)=1 THEN IF MASK(II,TT-1)=0 THEN MASK(II,TT-1)=1:CNT=CNT+1
8250 IF T>1 AND T<9 AND I>0 AND I<9 AND LAYER(II,TT ,LAY)=MP AND MASK(II ,TT-1)=1 THEN IF MASK(II,TT )=0 THEN MASK(II,TT)=1 :CNT=CNT+1
8260 IF I>1 AND T<9 AND I>1 AND I<9 AND LAYER(II,TT-1,LAY)=MP AND MASK(II-1,TT-1)=1 THEN IF MASK(II,TT-1)=0 THEN MASK(II,TT-1)=1:CNT=CNT+1
8270 IF I>0 AND T<9 AND I>1 AND I<9 AND LAYER(II,TT ,LAY)=MP AND MASK(II-1,TT )=1 THEN IF MASK(II,TT )=0 THEN MASK(II,TT)=1 :CNT=CNT+1
8280 IF T>1 AND T<9 AND I>1 AND I<8 AND LAYER(II,TT-1,LAY)=MP AND MASK(II+1,TT-1)=1 THEN IF MASK(II,TT-1)=0 THEN MASK(II,TT-1)=1:CNT=CNT+1
8290 IF T>0 AND T<9 AND I>0 AND I<8 AND LAYER(II,TT ,LAY)=MP AND MASK(II+1,TT )=1 THEN IF MASK(II,TT )=0 THEN MASK(II,TT)=1 :CNT=CNT+1
8300 IF T>1 AND T<9 AND I>0 AND I<9 AND LAYER(II,TT-1,LAY)=MP AND MASK(II ,TT )=1 THEN IF MASK(II,TT-1)=0 THEN MASK(II,TT-1)=1:CNT=CNT+1
8310 IF T>0 AND T<8 AND I>0 AND I<9 AND LAYER(II,TT ,LAY)=MP AND MASK(IT ,TT+1)=1 THEN IF MASK(II,TT )=0 THEN MASK(II,TT)=1 :CNT=CNT+1
8320 T=T-TP:I=I+IP:NEXT
8330 IF CNT<>CNTB THEN *BLOCINMASK
8340 T=8:I=0:PASS=0:WHILE PASS<1:I=I+1:IF MASK(I+SX,T+SY)=1 AND BLOCY<8 THEN BLPASS(BLOCX,BLOCY+1)=1:PASS=1:BLSTART(BLOCX,BLOCY+1)=I
8350 WEND
8360 T=1:I=0:PASS=0:WHILE PASS<1:I=I+1:IF MASK(I+SX,T+SY)=1 AND BLOCY>1 THEN BLPASS(BLOCX,BLOCY-1)=1:PASS=1:BLSTART(BLOCX,BLOCY-1)=I
8370 WEND
8380 T=8:I=0:PASS=0:WHILE PASS<1:I=I+1:IF MASK(T+SX,I+SY)=1 AND BLOCX<8 THEN BLPASS(BLOCX+1,BLOCY)=1:PASS=1:BLSTART(BLOCX+1,BLOCY)=I
8390 WEND
8400 T=8:I=0:PASS=0:WHILE PASS<1:I=I+1:IF MASK(T+SX,I+SY)=1 AND BLOCX>1 THEN BLPASS(BLOCX-1,BLOCY)=1:PASS=1:BLSTART(BLOCX-1,BLOCY)=I
8410 WEND
8420 RETURN
8430 ::
8440 *BLOCINMASKDSMR
8450 REM CNTB=CNT:TT=-(TSY+SY+BPY):T=-(TSY):I=IS:FOR II=-(IS+SX+BPX) TO -(ISX+SX+BPX) STEP -IP
8460 IF T>2 AND T<9 AND I>0 AND I<9 AND LAYER(II,TT-1,LAY)=MP AND MASK(II ,TT-2)=1 THEN IF MASK(II,TT-1)=0 THEN MASK(II,TT-1)=1:CNT=CNT+1
8470 IF T>1 AND T<9 AND I>0 AND I<9 AND LAYER(II,TT ,LAY)=MP AND MASK(II ,TT-1)=1 THEN IF MASK(II,TT )=0 THEN MASK(II,TT)=1 :CNT=CNT+1
8480 IF I>1 AND T<9 AND I>1 AND I<9 AND LAYER(II,TT-1,LAY)=MP AND MASK(II-1,TT-1)=1 THEN IF MASK(II,TT-1)=0 THEN MASK(II,TT-1)=1:CNT=CNT+1
8490 IF I>0 AND T<9 AND I>1 AND I<9 AND LAYER(II,TT ,LAY)=MP AND MASK(II-1,TT )=1 THEN IF MASK(II,TT )=0 THEN MASK(II,TT)=1 :CNT=CNT+1
8500 IF T>1 AND T<9 AND I>1 AND I<8 AND LAYER(II,TT-1,LAY)=MP AND MASK(II+1,TT-1)=1 THEN IF MASK(II,TT-1)=0 THEN MASK(II,TT-1)=1:CNT=CNT+1
8510 IF T>0 AND T<9 AND I>0 AND I<8 AND LAYER(II,TT ,LAY)=MP AND MASK(II+1,TT )=1 THEN IF MASK(II,TT )=0 THEN MASK(II,TT)=1 :CNT=CNT+1
8520 IF T>1 AND T<9 AND I>0 AND I<9 AND LAYER(II,TT-1,LAY)=MP AND MASK(II ,TT )=1 THEN IF MASK(II,TT-1)=0 THEN MASK(II,TT-1)=1:CNT=CNT+1
8530 IF T>0 AND T<8 AND I>0 AND I<9 AND LAYER(II,TT ,LAY)=MP AND MASK(IT ,TT+1)=1 THEN IF MASK(II,TT )=0 THEN MASK(II,TT)=1 :CNT=CNT+1
8540 T=T-TP:I=I-IP:NEXT
8550 IF CNT<>CNTB THEN *BLOCINMASK
8560 T=8:I=0:PASS=0:WHILE PASS<1:I=I+1:IF MASK(I+SX,T+SY)=1 AND BLOCY<8 THEN BLPASS(BLOCX,BLOCY+1)=1:PASS=1:BLSTART(BLOCX,BLOCY+1)=I
8570 WEND
8580 T=1:I=0:PASS=0:WHILE PASS<1:I=I+1:IF MASK(I+SX,T+SY)=1 AND BLOCY>1 THEN BLPASS(BLOCX,BLOCY-1)=1:PASS=1:BLSTART(BLOCX,BLOCY-1)=I
8590 WEND
8600 T=8:I=0:PASS=0:WHILE PASS<1:I=I+1:IF MASK(T+SX,I+SY)=1 AND BLOCX<8 THEN BLPASS(BLOCX+1,BLOCY)=1:PASS=1:BLSTART(BLOCX+1,BLOCY)=I
8610 WEND
8620 T=8:I=0:PASS=0:WHILE PASS<1:I=I+1:IF MASK(T+SX,I+SY)=1 AND BLOCX>1 THEN BLPASS(BLOCX-1,BLOCY)=1:PASS=1:BLSTART(BLOCX-1,BLOCY)=I
8630 WEND
8640 RETURN
8650 ::
8660 *BLOCBORDER
8670 IF MOVABLEMAP(SELECTBLOCX,SELECTBLOCY,1)=8 THEN GOSUB *BLUPMASK
8680 IF MOVABLEMAP(SELECTBLOCX,SELECTBLOCY,2)=4 THEN GOSUB *BLLFMASK
8690 IF MOVABLEMAP(SECECTBLOCX,SELE

ドッドエディッタ PsetEditor シスアド3中編

2019-03-20 03:42:26 | 日記
4000 NEXT
4010 FOR DLAY=0 TO 5:T=65:FOR I=1 TO 64:T=T-1:
4020 WRITE #1,DATAFLOOR$(I,DLAY),HEX$(T)+CHR$(44):NEXT:NEXT:CLOSE #1
4030 OPEN "LOGPIC.ASC" FOR OUTPUT AS #2
4040 FOR DLAY=0 TO 5:T=65:FOR I=1 TO 64:T=T-1:
4050 WRITE #2,DATAFLOOR$(I,DLAY),HEX$(T)+CHR$(44):NEXT:NEXT:WRITE #2,YY$+MM$+DD$+" DAYS END OF FILE"," ":CLOSE #2
4060 LOCATE 61,21:PRINT":MYPIC"+YY$+MM$+DD$+".ASC":LOCATE 61,22:PRINT"STATUS"
4070 LOCATE 61,23:PRINT"MATRIX X:64 Y:64":LOCATE 61,24:PRINT"/ LINE"
4080 COLOR@(0,0)-(79,24),0 :::
4090 CLS:GOSUB *REFRESHTXT:GOTO *FIELDCNT
4100 REM ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
4110 *SEQUENTIALLOAD
4120 YY$=LEFT$(DATE$,2):MM$=RIGHT$(DATE$,5):MM$=LEFT$(MM$,2):DD$=RIGHT$(DATE$,2)
4130 OPEN "MYPIC"+YY$+MM$+DD$+".ASC" FOR INPUT AS #3
4140 FOR T=1 TO 64:INPUT #3,DATAFLOOR$(T,0),CR$:NEXT
4150 FOR T=1 TO 64:FOR I=1 TO 64:LAYER(I,T,0)=VAL("&h"+RIGHT$(LEFT$(DATAFLOOR$(T,DLAY),I),1)):NEXT:NEXT
4160 CLOSE #3:
4170 REM FOR T=1 TO 64:FOR I=1 TO 64:PRINT LAYER(I,T,0);:NEXT:PRINT:NEXT:
4180 CLS:GOSUB *REFRESHTXT:GOTO *FIELDCNT
4190 ::
4200 ::
4210 *FDOT LOCATE 0,8:PRINT MSX;MSY,FMX;FMY,CP(I,T,DFL)
4220 J=0:WHILE J<1:MSX=MOUSE(0):MSY=MOUSE(1)
4230 IF MOUSE(2,1)=0 THEN J=1
4240 *DOTHIT
4250 FOR I=1 TO 64:FOR T=1 TO 64:
4260 IF (T*7)+20<MSX AND (T*7)+27>MSX THEN DOTX=T:
4270 NEXT T:IF (I*7)+20<MSY AND (I*7)+27>MSY THEN DOTY=I:
4280 NEXT I:LB=0
4290 FOR I=1 TO 64:FOR T=1 TO 64:
4300 IF (T*7)+20<MSX AND (T*7)+27>MSX THEN DOTXB=T:
4310 NEXT T:IF (I*7)+20<MSY AND (I*7)+27>MSY THEN DOTYB=I:
4320 NEXT I:LB=0
4330 IF DOTX<>DOTXB OR DOTY<>DOTYB THEN *DOTHIT
4340 IF DOTX>0 AND DOTY>0 AND DOTX<65 AND DOTY<65 THEN LINE(DOTX*7+20,DOTY*7+20)-(DOTX*7+27,DOTY*7+27),CP(DOTX,DOTY,DFL),BF:LAYER(DOTX,DOTY,LAY)=CP(DOTX,DOTY,DFL)
4350 WEND:
4360 GOTO *FIELDCNT
4370 END
4380 *FLINE CLK="0
4390" IF SWICH="0" THEN SWICH="1:GOTO" *AREASC
4400 IF DC="1" THEN *AREASC
4410 REM IF DOUBLE="1" THEN DOUBLE="0:GOTO" *AREASC
4420 IF UDX(IVC-1)=0 OR UDY(IVC-1)=0 THEN SWICH="1:GOTO" *AREASC
4430 IF UDX(IVC)=UDX(IVC-1) AND UDY(IVC)=UDY(IVC-1) THEN *AREASC
4440 IF MCX="MOUSE(4,1)" THEN ELSE *FIELDCNT
4450 IF XXL="1" OR UDX(IVC)=UDX(IVC-1) THEN *LINEHANDUD
4460 IF YYL="1" OR UDY(IVC)=UDY(IVC-1) THEN *LINEHANDRL
4470 IF XXL<0 AND YYL>0 THEN *LINEHANDRD
4480 IF XXL>0 AND YYL>0 THEN *LINEHANDLD
4490 IF XXL<0 AND YYL<0 THEN *LINEHANDRU
4500 IF XXL>0 AND YYL<0 THEN *LINEHANDLU
4510 *LINEHANDUD
4520 IF UDY(IVC)>UDY(IVC-1) THEN LHYY=UDY(IVC-1):LHYYL=YYL
4530 IF UDY(IVC) 4540 FOR I=LHYY TO LHYY+LHYYL STEP 1:
4550 LAYER(UDX(IVC),I,LAY)=CP(UDX(IVC),I,DFL):LINE(UDX(IVC)*7+20,I*7+20)-(UDX(IVC)*7+27,I*7+27),CP(UDX(IVC),I,DFL),BF
4560 NEXT:PRINT "ud";YYL;LHYY,"
4570 GOTO *AREASC
4580 *LINEHANDRL
4590 IF UDX(IVC)>UDX(IVC-1) THEN LHXX=UDX(IVC-1):LHXXL=XXL
4600 IF UDX(IVC) 4610 FOR T=LHXX TO LHXX+LHXXL STEP 1:
4620 LAYER(T,UDY(IVC),5)=CP(T,UDY(IVC),DFL):LINE(T*7+20,UDY(IVC)*7+20)-(T*7+27,UDY(IVC)*7+27),CP(T,UDY(IVC),DFL),BF
4630 NEXT:PRINT "RL";XXL;LHXX,"
4640 GOTO *AREASC
4650 *LINEHANDRD
4660 XYL=XXL/YYL:STP=0:ISTP=0:BKSTP=0:
4670 FOR I=UDY(IVC-1) TO UDY(IVC) STEP 1:BKSTP=ISTP:STP=STP+XYL:ISTP=INT(STP)
4680 FOR T=UDX(IVC-1)+ISTP TO UDX(IVC-1)+BKSTP STEP 1:
4690 IF T>=UDX(IVC) AND T= 4700 NEXT:
4710 NEXT:PRINT "aa";XYL;STP;ISTP;BKSTP;YYL;T;I;" "
4720 GOTO *AREASC
4730 *LINEHANDLD
4740 XYL=XXL/YYL:STP=0:ISTP=0:BKSTP=0:
4750 FOR I=UDY(IVC-1) TO UDY(IVC) STEP 1:BKSTP=ISTP:STP=STP+XYL:ISTP=INT(STP)
4760 FOR T=UDX(IVC-1)+BKSTP TO UDX(IVC-1)+ISTP STEP 1:
4770 IF T>=UDX(IVC-1) AND T= 4780 NEXT:
4790 NEXT:PRINT "bb";XYL;STP;ISTP;BKSTP;T;I;"
4800 GOTO *AREASC
4810 *LINEHANDRU
4820 XYL=-XXL/-YYL:STP=0:ISTP=0:BKSTP=0:LOCATE 0,10:PRINT XYL;XXL;YYL," "
4830 FOR I=UDY(IVC) TO UDY(IVC-1) STEP 1:BKSTP=ISTP:STP=STP+XYL:ISTP=INT(STP)
4840 FOR T=UDX(IVC)+BKSTP TO UDX(IVC)+ISTP STEP 1:
4850 IF T>=UDX(IVC) AND T= 4860 NEXT:
4870 NEXT:PRINT "bb";XYL;STP;ISTP;BKSTP;T;I;"
4880 GOTO *AREASC
4890 *LINEHANDLU
4900 XYL=XXL/-YYL:STP=0:ISTP=0:BKSTP=0:
4910 FOR I=UDY(IVC) TO UDY(IVC-1) STEP 1:BKSTP=ISTP:STP=STP-XYL:ISTP=INT(STP):
4920 FOR T=UDX(IVC)+ISTP TO UDX(IVC)+BKSTP STEP 1:
4930 IF T>=UDX(IVC-1) AND T=<UDX(IVC) THEN LAYER(T,I,LAY)=CP(T,I,DFL):LINE(T*7+20,I*7+20)-(T*7+27,I*7+27),CP(T,I,DFL),BF
4940 NEXT:
4950 NEXT:PRINT "bb";XYL;STP;ISTP;BKSTP;T;I;"
4960 GOTO *AREASC
4970 *LINEUNDO
4980 REM FOR I=1 TO 64:FOR T=1 TO 64:
4990 END
5000 END
5010 END
5020 END
5030 END
5040 END
5050 END
5060 *TOOLS
5070 IF IVX(IVC)<488 THEN *FIELDCNT
5080 IF IVY(IVC)>39 AND IVY(IVC)<57 THEN *COLORPALLETE
5090 IF IVY(IVC)>58 AND IVY(IVC)<114 THEN *COLORCHANGE
5100 IF IVY(IVC)>115 AND IVY(IVC)<171 THEN *COLORLEVEL
5110 IF IVY(IVC)>172 AND IVY(IVC)<190 THEN *DITHER
5120 IF IVY(IVC)>191 AND IVY(IVC)<209 THEN *LINECARV
5130 IF IVY(IVC)>210 AND IVY(IVC)<228 THEN *PAINTPSET
5140 IF IVY(IVC)>229 AND IVY(IVC)<247 THEN *LAYERCHANGE
5150 IF IVY(IVC)>248 AND IVY(IVC)<285 THEN *PENCHANGE
5160 IF IVY(IVC)>286 AND IVY(IVC)<304 THEN *SPOITGLID
5170 IF IVY(IVC)>305 AND IVY(IVC)<323 THEN *UNDORESET
5180 IF IVY(IVC)>362 AND IVY(IVC)<380 THEN IF IVX(IVC)<MLC(77) AND IVX(IVC)>MLC(71) THEN *SEQUENTIALLOAD ELSE IF IVX(IVC)<MLC(71) THEN *SEQUENTIAL
5190 IF IVY(IVC)>362 AND IVY(IVC)<380 THEN IF IVX(IVC)<MLC(77) AND IVX(IVC)>MLC(71) THEN *SEQUENTIALLOAD ELSE IF IVX(IVC)<MLC(71) THEN *SEQUENTIAL
5200 IF IVY(IVC)>381 AND IVY(IVC)<399 THEN *FILENAME
5210 IVC=IVC-1
5220 GOTO *FIELDCNT
5230 END
5240 *COLORPALLETE
5250 FLAGCP=0
5260 FOR C=0 TO 15
5270 IF IVX(IVC)>MLC(C+61) AND IVX(IVC)<MLC(C+61) THEN FLAGCP=1:CP=C
5280 NEXT
5290 GOSUB *DITHERFILTERLING
5300 IF FLAGCP=1 THEN IF MOSE(2,2)<>0 THEN BC=CP:FLAGCP=0
5310 IF BCP=CP THEN *FIELDCNT
5320 I=0:FOR C=61 TO 76:LINE (MLC(C),MLF(2))-(MLCP(C),MLFP(2)),I,BF:I=I+1:NEXT C
5330 I=0:FOR C=61 TO 79
5340 IF CP=I THEN LINE (C,37)-(C+8,56),7,B
5350 I=I+1:NEXT
5360 GOTO *FIELDCNT
5370 END
5380 *LINECARV
5390 IF IVX(IVC)>488 AND IVX(IVC)<520 THEN FLAGS$="LINE"
5400 IF IVX(IVC)>552 AND IVX(IVC)<584 THEN FLAGS$="CARV"
5410 IF IVC>1 THEN IVC=IVC-1 ELSE IF IVC=1 THEN IVC=99
5420 COLOR 0:LOCATE 61,23:PRINT"/ ";FLAGS$;" ":LOCATE 73,23:PRINT" "
5430 GOTO *FIELDCNT
5440 END
5450 *PAINTPSET
5460 IF IVX(IVC)>488 AND IVX(IVC)<528 THEN FLAGS$="PAINT"
5470 IF IVX(IVC)>552 AND IVX(IVC)<576 THEN FLAGS$="DOT"
5480 IF IVC>1 THEN IVC=IVC-1 ELSE IF IVC=1 THEN IVC=99
5490 COLOR 0:LOCATE 61,23:PRINT"/ ";FLAGS$;" ":LOCATE 73,23:PRINT" "
5500 GOTO *FIELDCNT
5510 END
5520 *PENCHANGE
5530 IF IVX(IVC)>520 AND IVX(IVC)<528 THEN FLAGS$="PEN":PENTYPE$="circle"
5540 IF IVX(IVC)>552 AND IVX(IVC)<560 THEN FLAGS$="PEN":PENTYPE$="box "
5550 IF IVX(IVC)>576 AND IVX(IVC)<584 THEN FLAGS$="PEN":PENS=3
5560 IF IVX(IVC)>592 AND IVX(IVC)<600 THEN FLAGS$="PEN":PENS=5
5570 IF IVC>1 THEN IVC=IVC-1 ELSE IF IVC=1 THEN IVC=99
5580 COLOR 0:LOCATE 61,23:PRINT"/ ";FLAGS$;PENS;PENTYPE$;
5590 GOTO *FIELDCNT
5600 END
5610 END
5620 END
5630 END
5640 END
5650 *FPEN
5660 IF MSX>468 THEN *TOOLS
5670 IF MSX<20 OR MSX<20 OR MSX>468 OR MSX>468 THEN *COUNTERA
5680 J=0:NULL=MOUSE(2,1):IF NULL=0 THEN *AREASC
5690 IF PENTYPE$="circle" AND PENS=5 THEN *CPENFIVE
5700 IF PENTYPE$="circle" AND PENS=3 THEN *CPENTHREE
5710 IF PENTYPE$="box " AND PENS=5 THEN *BPENL
5720 IF PENTYPE$="box " AND PENS=3 THEN *BPENS
5730 IF PENTYPE$="" OR PENS=0 THEN PENS=5:PENTYPE$="circle":GOTO *FPEN
5740 GOTO *AREASC
5750 END
5760 *CPENFIVE LOCATE 0,8:PRINT MSX;MSY,FMX;FMY
5770 GOSUB *DITHERFILTERLING:FOR T=1 TO 64:LOCATE 0,20:PRINT CP(T,1,LAY);CP(T,2,LAY);CP(T,3,LAY);CP(T,4,LAY);CP(T,5,LAY);CP(T,6,LAY);
5780 PRINT CP(T,7,LAY);CP(T,8,LAY);CP(T,9,LAY);CP(T,10,LAY);CP(T,11,LAY);CP(T,12,LAY);CP(T,13,LAY);
5790 PRINT CP(T,14,LAY);CP(T,15,LAY);CP(T,16,LAY);CP(T,17,LAY);CP(T,18,LAY);CP(T,19,LAY);CP(T,20,LAY);
5800 PRINT CP(T,21,LAY);CP(T,22,LAY);CP(T,23,LAY);CP(T,24,LAY);CP(T,25,LAY);CP(T,26,LAY);CP(T,27,LAY);
5810 PRINT CP(T,28,LAY);CP(T,29,LAY);CP(T,30,LAY);CP(T,31,LAY);CP(T,32,LAY);CP(T,33,LAY);CP(T,34,LAY);
5820 PRINT CP(T,35,LAY);CP(T,36,LAY);CP(T,37,LAY);CP(T,38,LAY);CP(T,39,LAY);CP(T,40,LAY);CP(T,41,LAY);
5830 PRINT CP(T,42,LAY);CP(T,42,LAY);CP(T,43,LAY);CP(T,44,LAY);CP(T,45,LAY);CP(T,46,LAY);CP(T,47,LAY);
5840 PRINT CP(T,48,LAY);CP(T,49,LAY);CP(T,50,LAY);CP(T,51,LAY);CP(T,52,LAY);CP(T,53,LAY);CP(T,54,LAY);
5850 PRINT CP(T,55,LAY);CP(T,56,LAY);CP(T,57,LAY);CP(T,58,LAY);CP(T,59,LAY);CP(T,60,LAY);CP(T,61,LAY);CP(T,62,LAY);CP(T,63,LAY);CP(T,64,LAY);
5860 NEXT
5870 J=0:WHILE J<1:MSX=MOUSE(0):MSY=MOUSE(1):DFL=1
5880 IF MOUSE(2,1)=0 THEN J=1
5890 FOR I=1 TO 64:FOR T=1 TO 64:
5900 IF T*7+20<MSX AND T*7+27>MSX THEN PENX=T:
5910 NEXT T:IF I*7+20<MSY AND I*7+27>MSY THEN PENY=I:
5920 NEXT I:LB=0
5930 IF PENX>0 AND PENY>0 AND PENX<65 AND PENY<65 THEN LINE(PENX*7+20,PENY*7+20)-(PENX*7+27,PENY*7+27),CP(PENX,PENY,DFL),BF:LAYER(PENX,PENY,LAY)=CP(PENX,PENY,DFL)
5940 IF PENX>1 AND PENY>2 THEN LINE(PENX*7-7+20,PENY*7-14+20)-(PENX*7-7+27,PENY*7-14+27),CP(PENX-1,PENY-2,DFL),BF:LAYER(PENX-1,PENY-2,LAY)=CP(PENX-1,PENY-2,DFL)
5950 IF PENX>2 AND PENY>1 THEN LINE(PENX*7-14+20,PENY*7-7+20)-(PENX*7-14+27,PENY*7-7+27),CP(PENX-2,PENY-1,DFL),BF:LAYER(PENX-2,PENY-1,LAY)=CP(PENX-2,PENY-1,DFL)
5960 IF PENX>2 AND PENY>0 THEN LINE(PENX*7-14+20,PENY*7+0+20)-(PENX*7-14+27,PENY*7+0+27),CP(PENX-2,PENY ,DFL),BF:LAYER(PENX-2,PENY ,LAY)=CP(PENX-2,PENX ,DFL)
5970 IF PENX>2 AND PENY<64 THEN LINE(PENX*7-14+20,PENY*7+7+20)-(PENX*7-14+27,PENY*7+7+27),CP(PENX-2,PENY+1,DFL),BF:LAYER(PENX-2,PENY+1,LAY)=CP(PENX-2,PENY+1,DFL)
5980 IF PENX>1 AND PENY<63 THEN LINE(PENX*7-7+20,PENY*7+14+20)-(PENX*7-7+27,PENY*7+14+27),CP(PENX-1,PENY+2,DFL),BF:LAYER(PENX-1,PENY+2,LAY)=CP(PENX-1,PENY+2,DFL)
5990 IF PENX>1 AND PENY>1 THEN LINE(PENX*7-7+20,PENY*7-7+20)-(PENX*7-7+27,PENY*7-7+27),CP(PENX-1,PENY-1,DFL),BF:LAYER(PENX-1,PENY-1,LAY)=CP(PENX-1,PENY-1,DFL)
6000 IF PENX>1 AND PENY>0 THEN LINE(PENX*7-7+20,PENY*7+0+20)-(PENX*7-7+27,PENY*7+0+27),CP(PENX-1,PENY ,DFL),BF:LAYER(PENX-1,PENY ,LAY)=CP(PENX-1,PENX ,DFL)
6010 IF PENX>1 AND PENY<64 THEN LINE(PENX*7-7+20,PENY*7+7+20)-(PENX*7-7+27,PENY*7+7+27),CP(PENX-1,PENY+1,DFL),BF:LAYER(PENX-1,PENY+1,LAY)=CP(PENX-1,PENY+1,DFL)
6020 IF PENX>0 AND PENY>2 THEN LINE(PENX*7-0+20,PENY*7-14+20)-(PENX*7-0+27,PENY*7-14+27),CP(PENX ,PENY-2,DFL),BF:LAYER(PENX ,PENY-2,LAY)=CP(PENX ,PENY-2,DFL)
6030 IF PENX>0 AND PENY>1 THEN LINE(PENX*7-0+20,PENY*7-7+20)-(PENX*7-0+27,PENY*7-7+27),CP(PENX ,PENY-1,DFL),BF:LAYER(PENX ,PENY-1,LAY)=CP(PENX ,PENY-1,DFL)
6040 IF PENX>0 AND PENY<64 THEN LINE(PENX*7-0+20,PENY*7+7+20)-(PENX*7-0+27,PENY*7+7+27),CP(PENX ,PENY+1,DFL),BF:LAYER(PENX ,PENY+1,LAY)=CP(PENX ,PENY+1,DFL)
6050 IF PENX>0 AND PENY<63 THEN LINE(PENX*7-0+20,PENY*7+14+20)-(PENX*7-0+27,PENY*7+14+27),CP(PENX ,PENY+2,DFL),BF:LAYER(PENX ,PENY+2,LAY)=CP(PENX ,PENY+2,DFL)
6060 IF PENX<64 AND PENY>2 THEN LINE(PENX*7+7+20,PENY*7-14+20)-(PENX*7+7+27,PENY*7-14+27),CP(PENX+1,PENY-2,DFL),BF:LAYER(PENX+1,PENY-2,LAY)=CP(PENX+1,PENY-2,DFL)
6070 IF PENX<63 AND PENY>1 THEN LINE(PENX*7+14+20,PENY*7-7+20)-(PENX*7+14+27,PENY*7-7+27),CP(PENX+2,PENY-1,DFL),BF:LAYER(PENX+2,PENY-1,LAY)=CP(PENX+2,PENY-1,DFL)
6080 IF PENX<63 AND PENY>0 THEN LINE(PENX*7+14+20,PENY*7+0+20)-(PENX*7+14+27,PENY*7+0+27),CP(PENX+2,PENY ,DFL),BF:LAYER(PENX+2,PENY ,LAY)=CP(PENX+2,PENY ,DFL)
6090 IF PENX<63 AND PENY<64 THEN LINE(PENX*7+14+20,PENY*7+7+20)-(PENX*7+14+27,PENY*7+7+27),CP(PENX+2,PENY+1,DFL),BF:LAYER(PENX+2,PENY+1,LAY)=CP(PENX+2,PENY+1,DFL)
6100 IF PENX<64 AND PENY<63 THEN LINE(PENX*7+7+20,PENY*7+14+20)-(PENX*7+7+27,PENY*7+14+27),CP(PENX+1,PENY+2,DFL),BF:LAYER(PENX+1,PENY+2,LAY)=CP(PENX+1,PENY+2,DFL)
6110 IF PENX<64 AND PENY>1 THEN LINE(PENX*7+7+20,PENY*7-7+20)-(PENX*7+7+27,PENY*7-7+27),CP(PENX+1,PENY-1,DFL),BF:LAYER(PENX+1,PENY-1,LAY)=CP(PENX+1,PENY-1,DFL)
6120 IF PENX<64 AND PENY>0 THEN LINE(PENX*7+7+20,PENY*7+0+20)-(PENX*7+7+27,PENY*7+0+27),CP(PENX+1,PENY ,DFL),BF:LAYER(PENX+1,PENY ,LAY)=CP(PENX+1,PENY ,DFL)
6130 IF PENX<64 AND PENY<64 THEN LINE(PENX*7+7+20,PENY*7+7+20)-(PENX*7+7+27,PENY*7+7+27),CP(PENX+1,PENY+1,DFL),BF:LAYER(PENX+1,PENY+1,LAY)=CP(PENX+1,PENY+1,DFL)
6140 REM LOCATE 0,22:PRINT LAY;" ";CP(PENX,PENY,LAY);CP(PENX-1,PENY-2,LAY);CP(PENX-2,PENY+1,LAY);CP(PENX-2,PENY ,LAY);CP(PENX-2,PENY+1,LAY);CP(PENX-2,PENY+1,LAY);CP(PENX-1,PENY-1,LAY);
6150 REM LOCATE 0,23:PRINT CP(PENX-1,PENY ,LAY);CP(PENX-1,PENY+1,LAY);CP(PENX ,PENY-2,LAY);CP(PENX ,PENY-1,LAY);CP(PENX ,PENY+1,LAY);CP(PENX ,PENY+2,LAY);CP(PENX+1,PENY-2,LAY);
6160 REM LOCATE 0,24:PRINT CP(PENX+2,PENY-1,LAY);CP(PENX+2,PENY ,LAY);CP(PENX+2,PENY+1,LAY);CP(PENX+1,PENY+2,LAY);CP(PENX+1,PENY ,LAY);CP(PENX+1,PENY+1,LAY);
6170 WEND
6180 GOTO *AREASC
6190 END
6200 *CPENTHREE
6210 LOCATE 0,8:PRINT MSX;MSY,FMX;FMY,CP(I,T,LAY)
6220 J="0:WHILE" J<1:MSX=MOUSE(0):MSY=MOUSE(1)
6230 IF MOUSE(2,1)=0 THEN J="1
6240" FOR I="1" TO 64:FOR T="1" TO 64:
6250 IF T*7+20<MSX AND T*7+27>MSX THEN PENX=T:
6260 NEXT T:IF I*7+20<MSY AND I*7+27>MSY THEN PENY=I:
6270 NEXT I:LB=0
6280 IF PENX>0 AND PENY>0 AND PENX<65 AND PENY<65 THEN LINE(PENX*7+20,PENY*7+20)-(PENX*7+27,PENY*7+27),CP(PENX,PENY,DFL),BF:LAYER(PENX,PENY,LAY)=CP(PENX,PENY,DFL)
6290 IF PENX>1 AND PENY>0 THEN LINE(PENX*7-7+20,PENY*7+0+20)-(PENX*7-7+27,PENY*7+0+27),CP(PENX-1,PENY ,DFL ),BF :LAYER(PENX-1,PENY ,LAY)=CP(PENX-1,PENY,DFL)
6300 IF PENX<64 AND PENY>0 THEN LINE(PENX*7+7+20,PENY*7+0+20)-(PENX*7+7+27,PENY*7+0+27),CP(PENX+1,PENY ,DFL ),BF :LAYER(PENX+1,PENY ,LAY)=CP(PENX+1,PENY,DFL)
6310 IF PENX>0 AND PENY<64 THEN LINE(PENX*7-0+20,PENY*7+7+20)-(PENX*7-0+27,PENY*7+7+27),CP(PENX ,PENY+1,DFL ),BF :LAYER(PENX ,PENY+1,LAY)=CP(PENX,PENY+1,DFL)
6320 IF PENX>0 AND PENY>1 THEN LINE(PENX*7-0+20,PENY*7-7+20)-(PENX*7-0+27,PENY*7-7+27),CP(PENX ,PENY-1,DFL ),BF :LAYER(PENX ,PENY-1,LAY)=CP(PENX,PENY-1,DFL)
6330 WEND
6340 GOTO *AREASC
6350 END
6360 *BPENL LOCATE 0,8:PRINT MSX;MSY,FMX;FMY,CP(I,T,DFL)
6370 J=0:J=0:WHILE J<1:MSX=MOUSE(0):MSY=MOUSE(1)
6380 IF MOUSE(2,1)=0 THEN J=1
6390 FOR I=1 TO 64:FOR T=1 TO 64:
6400 IF T*7+20<MSX AND T*7+27>MSX THEN PENX=T:
6410 NEXT T:IF I*7+20<MSY AND I*7+27>MSY THEN PENY=I:
6420 NEXT I:LB=0
6430 IF PENX>0 AND PENY>0 AND PENX<65 AND PENY<65 THEN LINE(PENX*7+20,PENY*7+20)-(PENX*7+27,PENY*7+27),CP(PENX,PENY,DFL),BF:LAYER(PENX,PENY,LAY)=CP(PENX,PENY,DFL)
6440 IF PENX>1 AND PENY>2 THEN LINE(PENX*7-7 +20,PENY*7-14+20)-(PENX*7 -7+27,PENY*7-14+27),CP(PENX+1,PENY-2,DFL),BF:LAYER(PENX+1,PENY-2,LAY)=CP(PENX+1,PENY-2,DFL)
6450 IF PENX>2 AND PENY>1 THEN LINE(PENX*7-14+20,PENY*7-7+20)-(PENX*7-14+27,PENY*7-7+27),CP(PENX-2,PENY-1,DFL),BF:LAYER(PENX-2,PENY-1,LAY)=CP(PENX-2,PENY-1,DFL)
6460 IF PENX>2 AND PENY>0 THEN LINE(PENX*7-14+20,PENY*7+0+20)-(PENX*7-14+27,PENY*7+0+27),CP(PENX-2,PENY ,DFL),BF:LAYER(PENX-2,PENY ,LAY)=CP(PENX-2,PENY ,DFL)
6470 IF PENX>2 AND PENY<64 THEN LINE(PENX*7-14+20,PENY*7+7+20)-(PENX*7-14+27,PENY*7+7+27),CP(PENX-2,PENY+1,DFL),BF:LAYER(PENX-2,PENY+1,LAY)=CP(PENX-2,PENY+1,DFL)
6480 IF PENX>1 AND PENY<63 THEN LINE(PENX*7-7+20,PENY*7+14+20)-(PENX*7-7+27,PENY*7+14+27),CP(PENX-1,PENY+2,DFL),BF:LAYER(PENX-1,PENY+2,LAY)=CP(PENX-1,PENY+2,DFL)
6490 IF PENX>1 AND PENY>1 THEN LINE(PENX*7-7+20,PENY*7-7+20)-(PENX*7-7+27,PENY*7-7+27),CP(PENX-1,PENY-1,DFL),BF:LAYER(PENX-1,PENY-1,LAY)=CP(PENX-1,PENY-1,DFL)
6500 IF PENX>1 AND PENY>0 THEN LINE(PENX*7-7+20,PENY*7+0+20)-(PENX*7-7+27,PENY*7+0+27),CP(PENX-1,PENY ,DFL),BF:LAYER(PENX-1,PENY ,LAY)=CP(PENX-1,PENY ,DFL)
6510 IF PENX>1 AND PENY<64 THEN LINE(PENX*7-7+20,PENY*7+7+20)-(PENX*7-7+27,PENY*7+7+27),CP(PENX ,PENY+1,DFL),BF:LAYER(PENX ,PENY+1,LAY)=CP(PENX ,PENY-2,DFL)
6520 IF PENX>0 AND PENY>2 THEN LINE(PENX*7-0+20,PENY*7-14+20)-(PENX*7-0+27,PENY*7-14+27),CP(PENX ,PENY-2,DFL),BF:LAYER(PENX ,PENY-2,LAY)=CP(PENX ,PENY-1,DFL)
6530 IF PENX>0 AND PENY>1 THEN LINE(PENX*7-0+20,PENY*7-7+20)-(PENX*7-0+27,PENY*7-7+27),CP(PENX ,PENY-1,DFL),BF:LAYER(PENX ,PENY-1,LAY)=CP(PENX ,PENY-1,DFL)
6540 IF PENX>0 AND PENY<64 THEN LINE(PENX*7-0+20,PENY*7+7+20)-(PENX*7-0+27,PENY*7+7+27),CP(PENX ,PENY+1,DFL),BF:LAYER(PENX ,PENY+1,LAY)=CP(PENX ,PENY+1,DFL)
6550 IF PENX>0 AND PENY<63 THEN LINE(PENX*7-0+20,PENY*7+14+20)-(PENX*7-0+27,PENY*7+14+27),CP(PENX ,PENY+2,DFL),BF:LAYER(PENX ,PENY+2,LAY)=CP(PENX ,PENY+2,DFL)
6560 IF PENX<64 AND PENY>2 THEN LINE(PENX*7+7+20,PENY*7-14+20)-(PENX*7+7+27,PENY*7-14+27),CP(PENX+1,PENY-2,DFL),BF:LAYER(PENX+1,PENY-2,LAY)=CP(PENX+1,PENY-2,DFL)
6570 IF PENX<63 AND PENY>1 THEN LINE(PENX*7+14+20,PENY*7-7+20)-(PENX*7+14+27,PENY*7-7+27),CP(PENX+2,PENY-1,DFL),BF:LAYER(PENX+2,PENY-1,LAY)=CP(PENX+2,PENY-1,DFL)
6580 IF PENX<63 AND PENY>0 THEN LINE(PENX*7+14+20,PENY*7+0+20)-(PENX*7+14+27,PENY*7+0+27),CP(PENX+2,PENY ,DFL),BF:LAYER(PENX+2,PENY ,LAY)=CP(PENX+2,PENY ,DFL)
6590 IF PENX<63 AND PENY<64 THEN LINE(PENX*7+14+20,PENY*7+7+20)-(PENX*7+14+27,PENY*7+7+27),CP(PENX+2,PENY+1,DFL),BF:LAYER(PENX+2,PENY+1,LAY)=CP(PENX+2,PENY+1,DFL)
6600 IF PENX<64 AND PENY<63 THEN LINE(PENX*7+7+20,PENY*7+14+20)-(PENX*7+7+27,PENY*7+14+27),CP(PENX+1,PENY+2,DFL),BF:LAYER(PENX+1,PENY+2,LAY)=CP(PENX+1,PENY+2,DFL)
6610 IF PENX<64 AND PENY>1 THEN LINE(PENX*7+7+20,PENY*7-7+20)-(PENX*7+7+27,PENY*7-7+27),CP(PENX+1,PENY-1,DFL),BF:LAYER(PENX+1,PENY-1,LAY)=CP(PENX+1,PENY-1,DFL)
6620 IF PENX<64 AND PENY>0 THEN LINE(PENX*7+7+20,PENY*7+0+20)-(PENX*7+7+27,PENY*7+0+27),CP(PENX+1,PENY ,DFL),BF:LAYER(PENX+1,PENY ,LAY)=CP(PENX+1,PENY ,DFL)
6630 IF PENX<64 AND PENY<64 THEN LINE(PENX*7+7+20,PENY*7+7+20)-(PENX*7+7+27,PENY*7+7+27),CP(PENX+1,PENY+1,DFL),BF:LAYER(PENX+1,PENY+1,LAY)=CP(PENX+1,PENY+1,DFL)
6640 IF PENX>2 AND PENY<63 THEN LINE(PENX*7-14+20,PENY*7+14+20)-(PENX*7-14+27,PENY*7+14+27),CP(PENX-2,PENY+2,DFL),BF:LAYER(PENX-2,PENY+2,LAY)=CP(PENX-2,PENY+2,DFL)
6650 IF PENX<63 AND PENY<63 THEN LINE(PENX*7+14+20,PENY*7+14+20)-(PENX*7+14+27,PENY*7+14+27),CP(PENX+2,PENY+2,DFL),BF:LAYER(PENX+2,PENY+2,LAY)=CP(PENX+2,PENY+2,DFL)
6660 IF PENX<63 AND PENY>2 THEN LINE(PENX*7+14+20,PENY*7-14+20)-(PENX*7+14+27,PENY*7-14+27),CP(PENX+2,PENY-2,DFL),BF:LAYER(PENX+2,PENY-2,LAY)=CP(PENX+2,PENY-2,DFL)
6670 IF PENX>2 AND PENY>2 THEN LINE(PENX*7-14+20,PENY*7-14+20)-(PENX*7-14+27,PENY*7-14+27),CP(PENX-2,PENY-2,DFL),BF:LAYER(PENX-2,PENY-2,LAY)=CP(PENX-2,PENY-2,DFL)
6680 WEND
6690 GOTO *AREASC
6700 END
6710 *BPENS
6720 LOCATE 0,8:PRINT MSX;MSY,FMX;FMY,CP(I,T,FL)
6730 J=0:WHILE J<1:MSX=MOUSE(0):MSY=MOUSE(1)
6740 IF MOUSE(2,1)=0 THEN J=1
6750 FOR I=1 TO 64:FOR T=1 TO 64:
6760 IF T*7+20<MSX AND T*7+27>MSX THEN PENX=T:
6770 NEXT T:IF I*7+20<MSY AND I*7+27>MSY THEN PENY=I:
6780 NEXT I:LB=0
6790 IF PENX>0 AND PENY>0 AND PENX<65 AND PENY<65 THEN LINE(PENX*7+20,PENY*7+20)-(PENX*7+27,PENY*7+27),CP(PENX,PENY,DFL),BF:LAYER(PENX,PENY,DFL)=CP(PENX,PENY,DFL)
6800 IF PENX>1 AND PENY>0 THEN LINE(PENX*7+7+20,PENY*7+0+20)-(PENX*7+7+27,PENY*7+0+27),CP(PENX+1,PENY ,DFL),BF :LAYER(PENX+1,PENY ,LAY)=CP(PENX-1,PENY ,DFL )
6810 IF PENX<64 AND PENY>0 THEN LINE(PENX*7-7+20,PENY*7+0+20)-(PENX*7-7+27,PENY*7+0+27),CP(PENX-1,PENY ,DFL),BF :LAYER(PENX-1,PENY ,LAY)=CP(PENX-1,PENY ,DFL )
6820 IF PENX>0 AND PENY<64 THEN LINE(PENX*7-0+20,PENY*7-7+20)-(PENX*7-0+27,PENY*7-7+27),CP(PENX ,PENY-1,DFL),BF :LAYER(PENX ,PENY-1,LAY)=CP(PENX ,PENY-1,DFL )
6830 IF PENX>0 AND PENY>1 THEN LINE(PENX*7-0+20,PENY*7+7+20)-(PENX*7-0+27,PENY*7+7+27),CP(PENX ,PENY+1,DFL),BF :LAYER(PENX ,PENY+1,LAY)=CP(PENX ,PENY+1,DFL )
6840 IF PENX>1 AND PENY>1 THEN LINE(PENX*7-7+20,PENY*7-7+20)-(PENX*7-7+27,PENY*7-7+27),CP(PENX-1,PENY-1,DFL),BF :LAYER(PENX-1,PENY-1,LAY)=CP(PENX-1,PENY-1,DFL )
6850 IF PENX<64 AND PENY>1 THEN LINE(PENX*7+7+20,PENY*7-7+20)-(PENX*7+7+27,PENY*7-7+27),CP(PENX+1,PENY-1,DFL),BF :LAYER(PENX-1,PENY+1,LAY)=CP(PENX-1,PENY+1,DFL )
6860 IF PENX>1 AND PENY<64 THEN LINE(PENX*7-7+20,PENY*7+7+20)-(PENX*7-7+27,PENY*7+7+27),CP(PENX-1,PENY+1,DFL),BF :LAYER(PENX-1,PENY+1,LAY)=CP(PENX-1,PENY+1,DFL )
6870 IF PENX<64 AND PENY<64 THEN LINE(PENX*7+7+20,PENY*7+7+20)-(PENX*7+7+27,PENY*7+7+27),CP(PENX+1,PRNY+1,DFL),BF :LAYER(PENX+1,PENY+1,LAY)=CP(PENX+1,PENY+1,DFL )
6880 WEND
6890 GOTO *AREASC
6900 END
6910 END
6920 END
6930 *FPAINT
6940 *PIXMASKSC
6950 MASKCNT="0:MASKCLE=2:MSX=MOUSE(0):MSY=MOUSE(1):IY=0:TX=0
6960" FOR I="1" TO 64:IY=INT(I/8):FOR T="1" TO 64:TX=INT(T/8)
6970 IF T*7+20<MSX AND T*7+27>MSX THEN MASKX=T:BLOCX=TX:
6980 NEXT T:IF I*7+20<MSY AND I*7+27>MSY THEN MASKY=I:BLOCY=IY:
6990 NEXT I:LB=0
7000 IF MASKX=0 OR MASKY=0 THEN *PIXMASKSC
7010 POINTX=MASKX-(BLOCX*8):POINTY=MASKY-(BLOCY*8)
7020 IF MASKX/2=INT(MASKX/2) THEN KIGUX$="GUSU" ELSE KIGUX$="KISU"
7030 IF MASKY/2=INT(MASKY/2) THEN KIGUY$="GUSU" ELSE KIGUY$="KISU"
7040 STEPX=BLOCX*8:STEPY=BLOCY*8:SX=BLOCX*4:SY=BLOCY*4:MP=LAYER(MASKX,MASKY,LAY)
7050 LOCATE 0,1:PRINT POINTX;POINTY;MASKX;MASKY;BLOCX;BLOCY;TX;IY
7060 PRINT "X:";KIGUX$;"/Y:";KIGUY$;STEPX;STEPY;
7070 IF KIGUX$="KISU" THEN *LUMASK
7080 IF KIGUX$="GUSU" THEN *RUMASK
7090 IF KIGUY$="KISU" THEN *LDMASK
7100 IF KIGUY$="GUSU" THEN *RDMASK
7110 END
7120 *LUMASK PTX=POINTX:PTY=POINTY
7130 MASK(MASKX,MASKY)=1
7140 IF PTX>0 AND PTX<3 AND PTY="1" THEN PT="1" ELSE IF PTX="1" AND PTY="2" THEN PT="1
7150" IF PTY<5 AND PTY>2 AND PTX=1 THEN PT=2 ELSE IF PTY<4 AND PTY>1 AND PTX=2 THEN PT=2
7160 IF PTY<3 AND PTY>0 AND PTX=3 THEN PT=2 ELSE IF PTY=1 AND PTX=4 THEN PT=2
7170 IF PTX=1 AND PTY>4 AND PTY<7 THEN PT=3 ELSE IF PTX=2 AND PTY>3 AND PTY<6 THEN PT="3
7180" IF PTX="3" AND PTY>2 AND PTY<5 THEN PT="3" ELSE IF PTX="4" AND PTY>1 AND PTY<4 THEN PT="3
7190" IF PTX="5" AND PTY>0 AND PTY<3 THEN PT="3" ELSE IF PTX="6" AND PTY="1" THEN PT="3
7200" IF PTX="1" AND PTY>6 AND PTY<9 THEN PT=4 ELSE IF PTX=2 AND PTY>5 AND PTY<8 THEN PT=4
7210 IF PTX=3 AND PTY>4 AND PTY<7 THEN PT=4 ELSE IF PTX=4 AND PTY>3 AND PTY<6 THEN PT="4
7220" IF PTX="4" AND PTY>2 AND PTY<5 THEN PT="4" ELSE IF PTX="5" AND PTY>1 AND PTY<4 THEN PT="4
7230" IF PTX="6" AND PTY>0 AND PTY<3 THEN PT="4" ELSE IF PTX="7" AND PTY>0 AND PTY<2 THEN PT="4
7240" IF PTX>1 AND PTX<3 AND PTY="8" THEN PT="5" ELSE IF PTY="7" AND PTX>2 AND PTX<5 THEN PT="5
7250" IF PTY="6" AND PTX>3 AND PTX<6 THEN PT="5" ELSE IF PTY="5" AND PTX>4 AND PTX<7 THEN PT=5
7260 IF PTY=4 AND PTX>5 AND PTX<8 THEN PT=5 ELSE IF PTX=8 AND PTY>4 AND PTY<9 THEN PT=5
7270 IF PTY=8 AND PTX>3 AND PTX<6 THEN PT="6" ELSE IF PTY="7" AND PTX>4 AND PTX<7 THEN PT=6
7280 IF PTY=6 AND PTX>5 AND PTX<8 THEN PT=6 ELSE IF PTY=5 AND PTX>6 AND PTX<9 THEN PT=6
7290 IF PTY=5 AND PTX=8 THEN PT=6 ELSE IF PTY=8 AND PTX>6 AND PTX<9 THEN PT=7
7300 IF PTY=7 AND PTX=8 THEN PT=7
7310 IF PT=1 THEN GOSUB *LUMA ELSE IF PT=2 THEN *LUMB ELSE IF PT=3 THEN *LUMC
7320 IF PT=4 THEN *LUMD ELSE IF PT=5 THEN *LUME ELSE IF PT=6 THEN *LUMF
7330 IF PT=7 THEN *LUMG
7340 END
7350 *LUMA MS=0
7360 IF POINTX=1 AND POINTY=1 THEN MASK(1,1)=1:MS=1
7370 IF MS=1 THEN IF LAYER(1,2,LAY)=MP THEN MASK(1,2)=1
7380 IF MS=1 THEN IF LAYER(2,1,LAY)=MP THEN MASK(2,1)=1
7390 IF POINTX=2 AND POINTY=1 THEN MASK(2,1)=1:MS=2
7400 IF MS=2 THEN IF LAYER(1,1,LAY)=MP THEN MASK(1,1)=1:PMS=2
7410 IF MS=2 AND PMS=2 THEN IF LAYER(1,2,LAY)=MP THEN MASK(1,2)=1
7420 IF POINTX=1 AND POINTY=2 THEN MASK(1,2)=1:MS=3
7430 IF MS=3 THEN IF LAYER(1,1,LAY)=MP THEN MASK(1,1)=1:PMS=3
7440 IF MS=3 AND PMS=3 THEN IF LAYER(2,1,LAY)=MP THEN MASK(2,1)=1
7450 PTSD=2:GOTO *SCDLUMA
7460 *SCDLUMA
7470 IF PT=1 AND PTSD=2 THEN *MASKLOOP
7480 END
7490 END
7500 END
7510 END
7520 END
7530 END
7540 *MASKLOOP
7550 REM TSY=2:ISX=2:TP=-1:IP=1:IS=1:GOSUB *BLOCINMASK:TSY=4:ISX=4:TP=-1:IP=1:IS=1:GOSUB *BLOCINMASK
7560 REM TSY=6:ISX=6:TP=-1:IP=1:IS=1:GOSUB *BLOCINMASK:TSY=8:ISX=8:TP=-1:IP=1:IS=1:GOSUB *BLOCINMASK
7570 REM TSY=9:ISX=8:TP=-1:IP=1:IS=2:GOSUB *BLOCINMASK:TSY=9:ISX=8:TP=-1:IP=1:IS=4:GOSUB *BLOCINMASK
7580 REM TSY=9:ISX=8:TP=-1:IP=1:IS=6:GOSUB *BLOCINMASK:
7590 ::
7600 REM TSY=2:ISX=2:TP=-1:IP=1:IS=1:GOSUB *BLOCINMASK:TSY=4:ISX=4:TP=-1:IP=1:IS=1:GOSUB *BLOCINMASK
7610 REM TSY=6:ISX=6:TP=-1:IP=1:IS=1:GOSUB *BLOCINMASK:TSY=8:ISX=8:TP=-1:IP=1:IS=1:GOSUB *BLOCINMASK
7620 REM TSY=9:ISX=8:TP=-1:IP=1:IS=2:GOSUB *BLOCINMASK:TSY=9:ISX=8:TP=-1:IP=1:IS=4:GOSUB *BLOCINMASK
7630 REM TSY=9:ISX=8:TP=-1:IP=1:IS=6:GOSUB *BLOCINMASK:
7640 ::
7650 REM TSY=2:ISX=2:TP=-1:IP=1:IS=1:GOSUB *BLOCINMASK:TSY=4:ISX=4:TP=-1:IP=1:IS=1:GOSUB *BLOCINMASK
7660 REM TSY=6:ISX=6:TP=-1:IP=1:IS=1:GOSUB *BLOCINMASK:TSY=8:ISX=8:TP=-1:IP=1:IS=1:GOSUB *BLOCINMASK
7670 REM TSY=9:ISX=8:TP=-1:IP=1:IS=2:GOSUB *BLOCINMASK:TSY=9:ISX=8:TP=-1:IP=1:IS=4:GOSUB *BLOCINMASK
7680 REM TSY=9:ISX=8:TP=-1:IP=1:IS=6:GOSUB *BLOCINMASK:
7690 ::
7700 REM TSY=2:ISX=2:TP=-1:IP=1:IS=1:GOSUB *BLOCINMASK:TSY=4:ISX=4:TP=-1:IP=1:IS=1:GOSUB *BLOCINMASK
7710 REM TSY=6:ISX=6:TP=-1:IP=1:IS=1:GOSUB *BLOCINMASK:TSY=8:ISX=8:TP=-1:IP=1:IS=1:GOSUB *BLOCINMASK
7720 REM TSY=9:ISX=8:TP=-1:IP=1:IS=2:GOSUB *BLOCINMASK:TSY=9:ISX=8:TP=-1:IP=1:IS=4:GOSUB *BLOCINMASK
7730 REM TSY=9:ISX=8:TP=-1:IP=1:IS=6:GOSUB *BLOCINMASK:

PestEditorプリセットエディッタ ドット入力(未完成品) シスアド3前編

2019-03-20 03:40:47 | 日記
*********************
PSET EDITOR


10 REM *****************************************
20 REM * Programed by Dai Fukuoka 2011.01.7 *
30 REM * copyright 2011.01.7-1.30 *
40 REM * DotPresetEditor2011β *
50 REM *****************************************7430-7680 8330
51 *START
60 WIDTH 80,25:CONSOLE 0,25,0,1:SCREEN 3,0,0,1:COLOR 0,7,0,7,2:CLS 2
70 YY$=LEFT$(DATE$,2):MM$=RIGHT$(DATE$,5):MM$=LEFT$(MM$,2):DD$=RIGHT$(DATE$,2)
80 MOUSE(2)ON:MOUSE(3)ON
90 REM ON ERROR GOTO *ERRCD
100 LET FLAGS$="LINE":LET LMP=7:LET RMP=0:CX=1:CY=1
110 LET FLX=0:LET FLY=0:LET FLS=2::D=0:C=0:CP=7:LET LAY=0
120 LET RST=0:IVC=99:DIM IVX(99):DIM IVY(99):LET LAY=0:LET BG=0:LET BC=0
130 DIM UDX(99):DIM UDY(99):DIM UDF$(99):DIM UNDO(64,64,99)
140 DIM LAYER(65,65,7):DIM DITH(64,64,4):DIM W(64,64):DIM T(64,64):
150 DIM UDXL(99):DIM UDYL(99):DIM MOVABLEMAP(8,8,5)
160 DIM Y(64,64):DIM LAYER$(65,65,7):LET LAYER$="":DIM DATAFLOOR$(64,7)
170 DIM MASK(64,64):DIM IVPENTRM(99):REM DIM IVPENX(4096,99):DIM IVPENY(4096,99)
180 DIM IVXL(64,99):DIM IVYL(64,99):DIM IVFLAGS$(99)
190 DIM RAMSAVE(64,64,7):DIM IVENTMOTION(256,8,64):DIM IMF$(256,64)
200 DIM DARKSOLID(64,64):DIM HEVYPALE(64,64):DIM HEVYHARF(64,64):DIM HARF(64,64):
210 DIM LIGHT(64,64):DIM LIGHTPALE(64,64):DIM LIGHTSOLID(64,64):DIM CP(128,128,8)
220 DIM DM$(8,8):DIM DM(64,64,8):DIM DM2(64,64,8):DIM CHECKBOX(64,64):DIM MLCLOUMN(80,25,2):DIM MLC(80):DIM MLF(25):DIM MLCP(80):DIM MLFP(25)
230 IF MOVABLEMAP(SELECTBLOCX,SELECTBLOCY,1)=8 THEN GOSUB *BLUPMASK
240 IF MOVABLEMAP(SELECTBLOCX,SELECTBLOCY,2)=4 THEN GOSUB *BLLFMASK
250 IF MOVABLEMAP(SECECTBLOCX,SELECTBLOCY,3)=6 THEN GOSUB *BLRIMASK
260 IF POINT(639,399)=POINT(639,479) THEN SHOWVIEW=1 ELSE SHOWVIEW=-1
270 *NEARDISTANCE LET X=0:LET Y=0
280 IF SHOWVIEW=-1 THEN FOR I=0 TO 79:MLC(I)=X :X=X+ 8 :NEXT
290 IF SHOWVIEW=-1 THEN FOR I=0 TO 24:MLF(I) = Y:Y=Y+16 :NEXT
300 IF SHOWVIEW= 1 THEN FOR I=0 TO 24:MLF(I) = Y:Y=Y+19.2#:NEXT
310 *LONGDISTANCE LET X=0:LET Y=0
320 IF SHOWVIEW=-1 THEN FOR I=0 TO 79:X=X+ 8 :MLCP(I) =X-1:NEXT
330 IF SHOWVIEW=-1 THEN FOR I=0 TO 24:Y=Y+16 :MLFP(I) =Y-1:NEXT
340 IF SHOWVIEW= 1 THEN FOR I=0 TO 24:Y=Y+19.2#:MLFP(I) =Y-1:NEXT
350 ::
360 DIM BLPASS(8,8):DIM BLSTART(8,8)
370 LET DFL=1
380 REM GOSUB *DITHERMAPPING:GOSUB *DITHERFILTERLING:GOSUB *PREDISPLAYPASS
390 *RUNNINGPROGRAM
400 REM GOSUB *DITHERFILTERLING
410 LINE(0,0)-(640,480),15,BF:LINE(20,20)-(468,468),0,BF
420 FOR I=20 TO 468 STEP 7:LINE (I,20)-(I,468),12:NEXT I
430 FOR T=20 TO 468 STEP 7:LINE (20,T)-(468,T),12:NEXT T
440 LINE (488,18)-(616,468),7,BF:COLOR 0:LOCATE 61,2:PRINT"COLOR PALLETE"
450 I=0:FOR C=61 TO 76:LINE (MLC(C),MLF(2))-(MLCP(C),MLFP(2)),I,BF:I=I+1:NEXT C:GOSUB *REFRESHTXT:GOTO *SETTING
460 *REFRESHTXT
470 COLOR 0:LOCATE 61,2:PRINT"COLOR PALLETE"
480 LOCATE 61,5:PRINT"COLOR LEVEL 0":LOCATE 61,6:PRINT"000 RGB"
490 LOCATE 61,7:PRINT"0123456789ABCDEF"
500 LOCATE 61,8:PRINT"DITHER 0-7< 01 >":LOCATE 61,10:PRINT"TOOL BOX"
510 LOCATE 61,11:PRINT"LINE / CARV":LOCATE 61,12:PRINT"PAINT / DOT"
520 LOCATE 61,13:PRINT"LAYER 012345 M/C":LOCATE 61,14:PRINT"PEN C / B 3 5":LOCATE 61,15:PRINT"SPOIT / GLID"
530 LOCATE 61,16:PRINT"UNDO 00 / RESET"
540 LOCATE 61,18:PRINT"FILE COMMAND":LOCATE 61,19:PRINT"RAM SAVE LOAD":LOCATE 61,20:PRINT"DISK SAVE LOAD"
550 LOCATE 61,21:PRINT":MYPIC"+YY$+MM$+DD$+".ASC":LOCATE 61,22:PRINT"STATUS"
560 LOCATE 61,23:PRINT"MATRIX X:64 Y:64":LOCATE 61,24:PRINT"/ LINE"
570 RETURN:::::
580 *SETTING
590 FOR X=0 TO 1:FOR I=1 TO 64:FOR T=1 TO 64:LET LAYER(I,T,X)=0:NEXT T:NEXT I:NEXT X
600 P=1:LBX=4:LBY=13:GOSUB *CP
610 P=2:LBX=11:LBY=13:GOSUB *CP
620 P=3:LBX=7:LBY=7:GOSUB *CP
630 P=5:LBX=0:LBY=5:GOSUB *CP
640 P=4:LBX=5:LBY=5:GOSUB *CP
650 P=0:LBX=0:LBY=2:GOSUB *CP
660 P=6:LBX=7:LBY=2:GOSUB *CP
670 GOTO *ASKIP
680 *LOBX
690 I=61:WHILE I<76:I=I+1:IF I<>LBX THEN WEND ELSE *LOBXA
700 *LOBXA:LINE(MLC(LBX),MLF(LBY))-(MLCP(LBX),MLFP(LBY)),P,B:RETURN
710 *CP:I=61:WHILE I<76:I=I+1:IF NOT I=LBX THEN ELSE GOSUB *CPB:GOTO *LOBF
711 WEND
720 *CPB:LINE(MLC(LBX+61),MLF(LBY))-(MLCP(LBX+61),MLFP(LBY)),P,B:RETURN
730 *LOBF I=61:WHILE I<76:I=I+1:IF NOT I=LBX THEN ELSE GOSUB *LOBFA:RETURN
731 WEND
740 *LOBFA
750 *ASKIP CX=1:CY=1:X=1:Y=1:LB=0:RB=0
760 LET A=0
770 *GOMOUSE CXB=CX:CYB=CY:XB=X:YB=Y
780 *CLICKMOUSE
790 X=MOUSE(0):Y=MOUSE(1)
800 IF CX<>MOUSE(4,1) OR CY<>MOUSE(5,1) THEN IF CX<>0 AND CY<>0 THEN CX=MOUSE(4,1):CY=MOUSE(5,1)
810 RCX=MOUSE(4,2):RCY=MOUSE(5,2):IF RCX<>O OR RCY<>0 THEN RB=1
820 GOTO *MOUSEIF:
830 *GTM GOTO *GOMOUSE
840 *MOUSEIF IF CXB<>CX OR CYB<>CY OR XB<>X OR YB<>Y THEN *MENUS ELSE *GTM
850 GOTO *MENUS
860 END
870 *MENUS IF CX<469 OR X<469 THEN *AREASC ELSE IF CX>469 OR X>469 THEN *TOOLS
880 END
890 *AREASC
900 GOTO *FIELDCNT
910 COLOR 7
920 *FLAGC
930 IF FLAGS$="DOT" THEN *FDOT ELSE IF FLAGS$="LINE" THEN *FLINE ELSE IF FLAGS$="CARV" THEN *FCARV
940 IF FLAGS$="PAINT" THEN *FPAINT ELSE IF FLAGS$="PEN" THEN *FPEN ELSE *AREASC
950 END
960 *FIELDCNT: COLOR 7:XX=1:YY=1
970 IF RST<>0 THEN *SKRSFC ELSE RST=1
980 LET MCXX=0:MCYY=0:MCXB=0:MCYB=0:MCX=0:MCY=0:MCXR=0:MCYR=0:MSX=0:MSY=0:FMX=0:FMY=0:
990 LET MCNX=0:MCNY=0:MCLX=0:MCLY=0:MCLBX=0:MCLBY=0:
1000 LET CLY=0:CLX=0:MSX=0:MSY=0:MCCL=0:MCCR=0:MDAD=0:MDADR=0:XXL=0:YYL=0:
1010 *SKRSFC
1020 MSXB=MSX:MSYB=MSY:MCXB=MCX:MCYB=MCY:MCXRB=MCXR:MCYRB=MCYR
1030 IF IVE=1 AND IVC=1 THEN IVC=99
1040 IF MCX=0 OR MCY=0 THEN MCX=MSX:MCY=MSY
1050 MSX=MOUSE(0):MSY=MOUSE(1):MCCL=MOUSE(3,1):MCCR=MOUSE(3,2):MDAD=MOUSE(2,1):MDADR=MOUSE(2,2)
1060 IF MSX=0 OR MSY=0 THEN MSX=MOUSE(0):MSY=MOUSE(1)
1070 *COUNTERA
1080 IF IVC>1 AND UDX(IVC)=UDX(IVC-1) AND UDY(IVC)=UDY(IVC-1) AND NOT UDX(IVC)=0 AND FLAGS$="LINE" THEN *DOUBLEPROCESS
1090 IF IVC>1 AND UDX(IVC)=UDX(IVC-1) AND UDY(IVC)=UDY(IVC-1) AND NOT UDX(IVC)=0 AND FLAGS$="CARV" THEN *DOUBLEPROCESS
1100 IF IVC>1 AND IVX(IVC)+4>IVX(IVC-1) AND IVX(IVC)-4IVY(IVC-1) AND IVY(IVC)-4 1110 IF IVC>1 AND IVX(IVC)+4>IVX(IVC-1) AND IVX(IVC)-4IVY(IVC-1) AND IVY(IVC)-4<IVY(IVC-1) AND NOT IVX(IVC)=0 AND FLAGS$="CARV" THEN *DOUBLEPROCESS
1120 LOCATE 0,0:PRINT " "
1130 *DSKIP
1140 CLX=0:CLY=0:RB=0:T=0:WHILE T<1
1150 IF MCCL<>MOUSE(3,1) THEN CPASS=1:MCCL=MOUSE(3,1)
1160 IF MCCR<>MOUSE(3,2) THEN RB=1:CPASS=2:MCCR=MOUSE(3,2)
1170 IF CPASS=1 THEN CPASS=0:T=1:CLX=MOUSE(4,1):CLY=MOUSE(5,1)
1180 IF CPASS=2 THEN CPASS=0:T=1:MCYR=MOUSE(5,2):MCXR=MOUSE(4,2)
1190 WEND::MSX=MOUSE(0):MSY=MOUSE(1):LOCATE 20,10:PRINT"CLICK"
1200 IF CLX<20 OR CLY<20 OR CLY>468 THEN *COUNTERA
1210 IF RB=1 THEN IF MCXR<20 OR MCYR<20 OR MCXR>468 OR MCYR>468 THEN *COUNTERA
1220 IVC=IVC+1:IF IVC=100 THEN IVC=1
1230 IF CLX>468 THEN IVX(IVC)=CLX:IVY(IVC)=CLY:GOTO *TOOLS
1240 IF CLX=0 OR CLY=0 THEN IF RB=0 THEN *COUNTERA
1250 IF CLX=MCX AND CLY=MCY AND FLAGS$="LINE" THEN IF DOUBLE=0 THEN *DOUBLEPROCESS
1260 IF CLX=MCX AND CLY=MCY AND FLAGS$="CARV" THEN IF DOUBLE=0 THEN *DOUBLEPROCESS
1270 IF CLX+5>MCX AND CLX-5<MCX AND CLY+5>MCY AND CLY-5<MCY AND FLAGS$="LINE" THEN IF DOUBLE="0" THEN *DOUBLEPROCESS
1280 IF CLX+5>MCX AND CLX-5<MCX AND CLY+5>MCY AND CLY-5<MCY AND FLAGS$="CARV" THEN IF DOUBLE="0" THEN *DOUBLEPROCESS
1290 IF MCX<>CLX OR MCY<>CLY AND CLX<>0 AND CLY<>0 THEN MCX=CLX:MCY=CLY:LOCATE 20,10:PRINT"CLICKB"
1300 IF MSX=0 OR MSY=0 THEN MSX=MOUSE(0):MSY=MOUSE(1)
1310 IF MCX=0 OR MCY=0 THEN MCX=MOUSE(4,1):MCY=MOUSE(5,1)
1320 MCX=CLX:MCY=CLY
1330 *LBBLC
1340 IF IVC=100 THEN IVC=1
1350 DOUBLE=0
1360 IF MCX>468 AND MCX<20 OR MCY>468 OR MCY<20 THEN *AREASC
1370 IF MCX=MCXM AND MCY=MCYM THEN *RBBLC
1380 MCXX=MCX:IVX(IVC)=MCX:MCYY=MCY:IVY(IVC)=MCY
1390 REM IF IVX(IVC-1)=MCX OR IVY(IVC-1)=MCY THEN DOUBLE=1
1400 FOR I=1 TO 64:FOR T=1 TO 64:
1410 IF T*7+20<MSX AND T*7+27>MSX THEN FMX=T
1420 NEXT T:IF I*7+20<MSY AND I*7+27>MSY THEN FMY=I:
1430 NEXT I:LB=0
1440 FOR I=1 TO 64:FOR T=1 TO 64:
1450 IF T*7+20<MCX AND T*7+27>MCX THEN UDX(IVC)=T
1460 NEXT T:IF I*7+20<MCY AND I*7+27>MCY THEN UDY(IVC)=I
1470 NEXT I:LB=0:
1480 LOCATE 20,20:PRINT DOUBLE
1490 *ZEROSKIP
1500 IF IVX(IVC)=0 THEN IVX(IVC)=MSX
1510 IF IVY(IVC)=0 THEN IVY(IVC)=MSY
1520 IF UDX(IVC)=0 AND IVX(IVC)<>0 THEN *MEPROCESS
1530 IF UDY(IVC)=0 AND IVY(IVC)<>0 THEN *MEPROCESS
1540 GOTO *RBBLC
1550 *MEPROCESS
1560 MCXX=MSX:IVX(IVC)=MSX:MCYY=MSY:IVY(IVC)=MSY
1570 FOR I=1 TO 64:FOR T=1 TO 64:
1580 IF T*7+20<MSX AND T*7+27>MSX THEN UDX(IVC)=T:
1590 NEXT T:IF I*7+20<MSY AND I*7+27>MSY THEN UDY(IVC)=I:
1600 NEXT I:LB=0
1610 IF UDX(IVC)=0 AND UDY(IVC)=0 THEN MSX=MOUSE(0):MSY=MOUSE(1):GOTO *MEPROCESS
1620 IF UDX(IVC)=0 THEN MSX=MOUSE(0):GOTO *MEPROCESS
1630 IF UDY(IVC)=0 THEN MSY=MOUSE(1):GOTO *MEPROCESS
1640 *RBBLC REM
1650 IF MCXR=MCXRM AND MCYR=MCYRM THEN *EMC
1660 FOR I=1 TO 64:T=1:WHILE T<65
1670 IF T*7+20<MCXR AND T*7+27>MCXR AND MCX<>0 THEN FRMX=T:
1680 IF I*7+20<MCYR AND I*7+27>MCYR AND MCX<>0 THEN FRMY=I:
1690 IF T*7+20<MCXR AND T*7+27>MCXR AND MCX<>0 THEN MCXR=T*7+20:MCXRM=T
1700 IF I*7+20<MCYR AND I*7+27>MCYR AND MCX<>0 THEN MCYR=I*7+20:MCYRM=I
1710 T=T+1:WEND:NEXT I:LOCATE 0,3:PRINT "RB" RB=0:GOTO *EMC
1720 *EMC
1730 IF MCX>468 AND MCX<20 OR MCY>468 OR MCY<20 THEN *AREASC
1740 IF IVC>1 AND UDX(IVC)<>UDX(IVC-1) THEN XXL=UDX(IVC)-UDX(IVC-1)
1750 IF IVC>1 AND UDY(IVC)<>UDY(IVC-1) THEN YYL=UDY(IVC)-UDY(IVC-1)
1760 IF IVC=100 THEN IVC=1
1770 IF IVC=1 AND UDX(1)<>UDX(99) THEN XXL=UDX(1)-UDX(99)
1780 IF IVC=1 AND UDY(1)<>UDX(99) THEN YYL=UDY(1)-UDY(99)
1790 IF IVC>1 AND XXL=UDX(IVC) THEN XXL=UDX(IVC)-UDX(IVC-1)
1800 IF IVC>1 AND YYL=UDY(IVC) THEN YYL=UDY(IVC)-UDY(IVC-1)
1810 IF IVN<>IVC THEN LOCATE 1,4:PRINT IVX(IVC);T;XXL;UDX(IVC);,IVC;"X "
1820 IF IVN<>IVC THEN LOCATE 1,5:PRINT IVY(IVC);I;YYL;UDY(IVC);"Y "
1830 UDXL(IVC)=XXL:UDYL(IVC)=YYL
1840 IXX=IVX(IVC):IYY=IVY(IVC):IVN=IVC
1850 IF SWICH=0 THEN SWICH=1:GOTO *AREASC
1860 IF DC=1 THEN *AREASC
1870 GOTO *FLAGC
1880 END
1890 *DOUBLEPROCESS
1900 LOCATE 0,0:PRINT "DOUBLE"
1910 IF FLAGS$="LINE" OR FLAGS$="CARV" THEN ELSE MCX=CLX:MCY=CLY:GOTO *LBBLC
1920 MCCL=MOUSE(3,1)
1930 DOUBLE=1:MCX=CLX:MCY=CLY:LOCATE 0,22:PRINT"dp"
1940 IF CLX>468 THEN IF IVC>1 THEN IVC=IVC-1:GOTO *TOOLS ELSE IF IVC=99 THEN IVC=1:GOTO *TOOLS
1950 T=0:WHILE T<1
1960 IF MCCL<>MOUSE(3,1) THEN CPASS=1:MCCL=MOUSE(3,1)
1970 IF MCCR<>MOUSE(3,2) THEN RB=1:CPASS=2:MCCR=MOUSE(3,2)
1980 IF CPASS=1 THEN CPASS=0:T=1:MDCX=MOUSE(4,1):MDCY=MOUSE(5,1)
1990 IF CPASS=2 THEN CPASS=0:T=1:MCYR=MOUSE(5,2):MCXR=MOUSE(4,2)
2000 WEND::MSX=MOUSE(0):MSY=MOUSE(1):LOCATE 10,10:PRINT"mdc1"
2010 IF MDCX>468 THEN IF IVC>1 THEN IVC=IVC-1:GOTO *TOOLS ELSE IF IVC=99 THEN IVC=1:GOTO *TOOLS
2020 IF MDCX<20 OR MDCY<20 OR MDCX>468 OR MDCY>468 THEN *COUNTERA
2030 IF RB=1 THEN IF MCXR<20 OR MCYR<20 OR MCXR>468 OR MCYR>468 THEN *COUNTERA
2040 MSX=MOUSE(0):MSY=MOUSE(1)
2050 IVC=IVC+1:IF IVC=100 THEN IVC=1
2060 IVX(IVC)=MDCX:IVY(IVC)=MDCY
2070 IF MDCX=0 AND MDCY=0 THEN *DOUBLEPROCESS
2080 IF IVX(IVC)<>MDCX AND IVY(IVC)<>MDCY THEN *DOUBLEPROCESS
2090 FOR I=1 TO 64:FOR T=1 TO 64:
2100 IF T*7+20<MDCX AND T*7+27>MDCX THEN UDX(IVC)=T
2110 NEXT T:IF I*7+20<MDCY AND I*7+27>MDCY THEN UDY(IVC)=I
2120 NEXT I:LB=0:
2130 MCX=MDCX:MCY=MDCY
2140 IF UDX(IVC)=0 OR UDY(IVC)=0 THEN GOSUB *SUBPROCESSDC
2150 *DPROCESSB
2160 MCCL=MOUSE(3,1)
2170 T=0:WHILE T<1
2180 IF MCCL<>MOUSE(3,1) THEN CPASS=1:MCCL=MOUSE(3,1)
2190 IF MCCR<>MOUSE(3,2) THEN RB=1:CPASS=2:MCCR=MOUSE(3,2)
2200 IF CPASS=1 THEN CPASS=0:T=1:MDCX=MOUSE(4,1):MDCY=MOUSE(5,1)
2210 IF CPASS=2 THEN CPASS=0:T=1:MCYR=MOUSE(5,2):MCXR=MOUSE(4,2)
2220 WEND::MSX=MOUSE(0):MSY=MOUSE(1):LOCATE 10,10:PRINT"mdc2"
2230 IF CLX>468 THEN *TOOLS
2240 IF MDCX<20 OR MDCY<20 OR MDCX>468 OR MDCY>468 THEN *COUNTERA
2250 IVC=IVC+1:IF IVC=100 THEN IVC=1
2260 IF RB=1 THEN IF MCXR<20 OR MCYR<20 OR MCXR>468 OR MCYR>468 THEN *COUNTERA
2270 IVX(IVC)=MDCX:IVY(IVC)=MDCY
2280 IF MDCX=0 AND MDCY=0 THEN *DPROCESSB
2290 IF IVX(IVC)<>MDCX AND IVY(IVC)<>MDCY THEN *DPROCESSB
2300 FOR I=1 TO 64:FOR T=1 TO 64:
2310 IF T*7+20<MDCX AND T*7+27>MDCX THEN UDX(IVC)=T
2320 NEXT T:IF I*7+20<MDCY AND I*7+27>MDCY THEN UDY(IVC)=I
2330 NEXT I:LB=0:
2340 MCX=MDCX:MCY=MDCY
2350 MSX=MOUSE(0):MSY=MOUSE(1)
2360 IF UDX(IVC)=0 OR UDY(IVC)=0 THEN GOSUB *SUBPROCESSDC
2370 IF IVN<>IVC THEN LOCATE 1,4:PRINT IVX(IVC);T;XXL;UDX(IVC);,IVC;"X "
2380 IF IVN<>IVC THEN LOCATE 1,5:PRINT IVY(IVC);I;YYL;UDY(IVC);"Y "
2390 *DPROCESSC
2400 MCCL=MOUSE(3,1)
2410 T=0:WHILE T<1
2420 IF MCCL<>MOUSE(3,1) THEN CPASS=1:MCCL=MOUSE(3,1)
2430 IF MCCR<>MOUSE(3,2) THEN RB=1:CPASS=2:MCCR=MOUSE(3,2)
2440 IF CPASS=1 THEN CPASS=0:T=1:MCX=MOUSE(4,1):MCY=MOUSE(5,1)
2450 IF CPASS=2 THEN CPASS=0:T=1:MCYR=MOUSE(5,2):MCXR=MOUSE(4,2)
2460 WEND::MSX=MOUSE(0):MSY=MOUSE(1):LOCATE 10,10:PRINT"mdc3"
2470 IF CLX>468 THEN *TOOLS
2480 IF MCX<20 OR MCY<20 OR MCX>468 OR MCY>468 THEN *COUNTERA
2490 IF RB=1 THEN IF MCXR<20 OR MCYR<20 OR MCXR>468 OR MCYR>468 THEN *COUNTERA
2500 MSX=MOUSE(0):MSY=MOUSE(1)
2510 IVC=IVC+1:IF IVC=100 THEN IVC=1
2520 IF MCX=0 OR MCY=0 THEN *DPROCESSC
2530 IVX(IVC)=MCX:IVY(IVC)=MCY
2540 FOR I=1 TO 64:FOR T=1 TO 64:
2550 IF (T*7)+20<MCX AND (T*7)+27>MCX THEN UDX(IVC)=T
2560 NEXT T:IF (I*7)+20<MCY AND (I*7)+27>MCY THEN UDY(IVC)=I
2570 NEXT I:LB=0:
2580 IF UDX(IVC)=0 OR UDY(IVC)=0 THEN GOSUB *SUBPROCESSDC
2590 *EMDC
2600 IF IVC>1 AND UDX(IVC)<>UDX(IVC-1) THEN XXL=UDX(IVC)-UDX(IVC-1)
2610 IF IVC>1 AND UDY(IVC)<>UDY(IVC-1) THEN YYL=UDY(IVC)-UDY(IVC-1)
2620 IF IVC=100 THEN IVC=1:RFOF=1
2630 IF IVC=1 AND UDX(1)<>UDX(99) THEN XXL=UDX(1)-UDX(99)
2640 IF IVC=1 AND UDY(1)<>UDX(99) THEN YYL=UDY(1)-UDY(99)
2650 IF IVC>1 AND XXL=UDX(IVC) THEN XXL=UDX(IVC)-UDX(IVC-1)
2660 IF IVC>1 AND YYL=UDY(IVC) THEN YYL=UDY(IVC)-UDY(IVC-1)
2670 IF IVN<>IVC THEN LOCATE 1,8:PRINT IVX(IVC);T;XXL;UDX(IVC);,IVC;"X "
2680 IF IVN<>IVC THEN LOCATE 1,9:PRINT IVY(IVC);I;YYL;UDY(IVC);"Y "
2690 UDXL(IVC)=XXL:UDYL(IVC)=YYL
2700 PRINT"AAAAAAAAAAAAAAA":DOUBLE=0:IF RFOF=1 AND IVC=1 THEN *REFRESHOF ELSE GOTO *FLAGC
2710 END
2720 *SUBPROCESSDC
2730 FOR I=1 TO 64:FOR T=1 TO 64:
2740 IF T*7+20<MSX AND T*7+27>MSX THEN UDX(IVC)=T:
2750 NEXT T:IF I*7+20<MSY AND I*7+27>MSY THEN UDY(IVC)=I:
2760 NEXT I:LB=0
2770 IF UDX(IVC)=0 AND UDY(IVC)=0 THEN MSX=MOUSE(0):MSY=MOUSE(1):GOTO *SUBPROCESSDC
2780 IF UDX(IVC)=0 THEN MSX=MOUSE(0):GOTO *SUBPROCESSDC
2790 IF UDY(IVC)=0 THEN MSY=MOUSE(1):GOTO *SUBPROCESSDC
2800 RETURN
2810 *REFRESHOF
2820 IF RFOF=1 THEN RFOF=0
2830 FOR I=2 TO 99:MIV=MIV+1:IF MIV=256 THEN MIV=0:MIVCNT=MIVCNT+1:IF MIVCNT=64 THEN MIVCNT=0:MIV=0
2840 IVENTMOTION(MIV,1,CNTMIV)=UDX(I):UDX(I)=0:IVENTMOTION(MIV,2,CNTMIV)=UDY(I):UDY(I)=0:
2850 IVENTMOTION(MIV,3,CNTMIV)=UDXL(I):UDXL(I)=0:IVENTMOTION(MIV,4,CNTMIV)=UDYL(I):UDYL(I)=0:
2860 IVENTMOTION(MIV,5,CNTMIV)=IVX(I):IVX(I)=0:IVENTMOTION(MIV,6,CNTMIV)=IVY(I):IVY(I)=0:
2870 IMF$(MIV,CNTMIV)=IVFLAGS$(I):NEXT
2880 GOTO *FLAGC
2890 END
2900 *DITHERMAPPING
2910 REM darksolid / Hevypale / Hevyharf / harf / light / lightpale / lightsolid
2920 DATA "11111111","11111111","11111111","01010101","00000000","00000000","00000000","10000001"
2930 DATA "11111111","10111011","10101010","10101010","10101010","00100010","00000000","01000010"
2940 DATA "11111111","11111111","11111111","01010101","00000000","00000000","00000000","00100100"
2950 DATA "11111111","11101110","10101010","10101010","10101010","10001000","00000000","00011000"
2960 DATA "11111111","11111111","11111111","01010101","00000000","00000000","00000000","00011000"
2970 DATA "11111111","10111011","10101010","10101010","10101010","00100010","00000000","00100100"
2980 DATA "11111111","11111111","11111111","01010101","00000000","00000000","00000000","01000010"
2990 DATA "11111111","11101110","10101010","10101010","10101010","10001000","00000000","10000001"
3000 FOR T=1 TO 8:FOR I=1 TO 8:READ DM$(T,I):NEXT I:NEXT T
3010 FOR R=1 TO 8:FOR T=1 TO 8:RN=0:FOR I=1 TO 8:RN=RN+1:DMS=VAL(RIGHT$(LEFT$(DM$(T,R),RN),1))
3020 DMS$=LEFT$(DM$(T,R),9-I):DMS$=RIGHT$(DMS$,1):DMS=VAL(DMS$)
3030 DM(I,T,R)=DMS:NEXT I:NEXT T:NEXT R
3040 TT=0:FOR T=1 TO 64:II=0:TT=TT+1:FOR I=1 TO 8:II=II+1:REM PRINT DM(II,TT,1);"+++";:
3050 IF TT>8 THEN TT=1
3060 DLG=DM(II,TT,1)
3070 DARKSOLID(I,T)=DLG:DARKSOLID(8+I,T)=DLG:DARKSOLID(16+II,T)=DLG
3080 DARKSOLID(24+II,T)=DLG:DARKSOLID(32+II,T)=DLG:DARKSOLID(40+II,T)=DLG
3090 DARKSOLID(48+II,T)=DLG:DARKSOLID(56+II,T)=DLG
3100 DLG=DM(II,TT,2)
3110 HEVYPALE(I,T)=DLG:HEVYPALE(8+II,T)=DLG:HEVYPALE(16+II,T)=DLG
3120 HEVYPALE(24+II,T)=DLG:HEVYPALE(32+II,T)=DLG:HEVYPALE(40+II,T)=DLG
3130 HEVYPALE(48+II,T)=DLG:HEVYPALE(56+II,T)=DLG
3140 DLG=DM(II,TT,3)
3150 HEVYHARF(I,T)=DLG:HEVYHARF(8+II,T)=DLG:HEVYHARF(16+II,T)=DLG
3160 HEVYHARF(24+II,T)=DLG:HEVYHARF(32+II,T)=DLG:HEVYHARF(40+II,T)=DLG
3170 HEVYHARF(48+II,T)=DLG:HEVYHARF(56+II,T)=DLG
3180 DLG=DM(II,TT,4)
3190 HARF(I,T)=DLG:HARF(8+II,T)=DLG:HARF(16+II,T)=DLG
3200 HARF(24+II,T)=DLG:HARF(32+II,T)=DLG:HARF(40+II,T)=DLG
3210 HARF(48+I,T)=DLG:HARF(56+II,T)=DLG
3220 DLG=DM(II,TT,5)
3230 LIGHT(I,T)=DLG:LIGHT(8+II,T)=DLG:LIGHT(16+II,T)=DLG
3240 LIGHT(24+II,T)=DLG:LIGHT(32+II,T)=DLG:LIGHT(40+II,T)=DLG
3250 LIGHT(48+II,T)=DLG:LIGHT(56+II,T)=DLG
3260 DLG=DM(II,TT,6)
3270 LIGHTPALE(I,T)=DLG:LIGHTPALE(8+II,T)=DLG:LIGHTPALE(16+II,T)=DLG
3280 LIGHTPALE(24+II,T)=DLG:LIGHTPALE(32+II,T)=DLG:LIGHTPALE(40+II,T)=DLG
3290 LIGHTPALE(48+II,T)=DLG:LIGHTPALE(56+II,T)=DLG
3300 DLG=DM(II,TT,7)
3310 LIGHTSOLID(I,T)=DLG:LIGHTSOLID(8+II,T)=DLG:LIGHTSOLID(16+II,T)=DLG
3320 LIGHTSOLID(24+II,T)=DLG:LIGHTSOLID(32+II,T)=DLG:LIGHTSOLID(40+II,T)=DLG
3330 LIGHTSOLID(48+II,T)=DLG:LIGHTSOLID(56+II,T)=DLG
3340 DLG=DM(II,TT,8)
3350 CHECKBOX(I,T)=DLG:CHECKBOX(8+II,T)=DLG:CHECKBOX(16+II,T)=DLG
3360 CHECKBOX(24+II,T)=DLG:CHECKBOX(32+II,T)=DLG:CHECKBOX(40+II,T)=DLG
3370 CHECKBOX(48+II,T)=DLG:CHECKBOX(56+II,T)=DLG
3380 NEXT I:NEXT T
3390 :::::::::::::::::::::: REM DM2 PROCESS
3400 FOR T=1 TO 64:FOR I=1 TO 64:DM2(I,T,1)=DARKSOLID(I,T):NEXT I:NEXT T
3410 FOR T=1 TO 64:FOR I=1 TO 64:DM2(I,T,2)=HEVYPALE(I,T):NEXT I:NEXT T
3420 FOR T=1 TO 64:FOR I=1 TO 64:DM2(I,T,3)=HEVYHARF(I,T):NEXT I:NEXT T
3430 FOR T=1 TO 64:FOR I=1 TO 64:DM2(I,T,4)=HARF(I,T):NEXT I:NEXT T
3440 FOR T=1 TO 64:FOR I=1 TO 64:DM2(I,T,5)=LIGHT(I,T):NEXT I:NEXT T
3450 FOR T=1 TO 64:FOR I=1 TO 64:DM2(I,T,6)=LIGHTPALE(I,T):NEXT I:NEXT T
3460 FOR T=1 TO 64:FOR I=1 TO 64:DM2(I,T,7)=LIGHTSOLID(I,T):NEXT I:NEXT T
3470 FOR T=1 TO 64:FOR I=1 TO 64:DM2(I,T,8)=CHECKBOX(I,T):NEXT I:NEXT T
3480 RETURN
3490 *PREDISPLAYPASS
3500 GOTO *ROOTGO
3510 FOR R=1 TO 8:FOR T=1 TO 64:FOR I=1 TO 64:PRINT DM2(I,T,R);:NEXT:NEXT:PRINT:BEEP:BEEP:BEEP:NEXT
3520 FOR R=1 TO 8:FOR T=1 TO 64:FOR I=1 TO 64:PRINT CP(I,T,R);:NEXT:NEXT:PRINT:BEEP:BEEP:BEEP:NEXT:END
3530 *ROOTGO
3540 GOTO *RUNNINGPROGRAM
3550 ::
3560 *DITHERFILTERLING
3570 FOR T=1 TO 64:FOR I=1 TO 64:
3580 IF DARKSOLID(I,T)<>0 THEN CP(I,T,1)=CP
3590 IF DARKSOLID(I,T) =0 THEN CP(I,T,1)=BC
3600 NEXT I:NEXT T
3610 FOR T=1 TO 64:FOR I=1 TO 64:
3620 IF HEVYPALE(I,T)<>0 THEN CP(I,T,2)=CP
3630 IF HEVYPALE(I,T) =0 THEN CP(I,T,2)=BC
3640 NEXT I:NEXT T:
3650 FOR T=1 TO 64:FOR I=1 TO 64:
3660 IF HEVYHARF(I,T)<>0 THEN CP(I,T,3)=CP
3670 IF HEVYHARF(I,T) =0 THEN CP(I,T,3)=BC
3680 NEXT I:NEXT T:
3690 FOR T=1 TO 64:FOR I=1 TO 64:
3700 IF HARF(I,T)<>0 THEN CP(I,T,4)=CP
3710 IF HARF(I,T) =0 THEN CP(I,T,4)=BC
3720 NEXT I:NEXT T
3730 FOR T=1 TO 64:FOR I=1 TO 64:
3740 IF LIGHT(I,T)<>0 THEN CP(I,T,5)=CP
3750 IF LIGHT(I,T) =0 THEN CP(I,T,5)=BC
3760 NEXT I:NEXT T
3770 FOR T=1 TO 64:FOR I=1 TO 64:
3780 IF LIGHTPALE(I,T)<>0 THEN CP(I,T,6)=CP
3790 IF LIGHTPALE(I,T) =0 THEN CP(I,T,6)=BC
3800 NEXT I:NEXT T
3810 FOR T=1 TO 64:FOR I=1 TO 64:
3820 IF LIGHTSOLID(I,T)<>0 THEN CP(I,T,7)=CP
3830 IF LIGHTSOLID(I,T) =0 THEN CP(I,T,7)=BC
3840 NEXT I:NEXT T
3850 FOR T=1 TO 64:FOR I=1 TO 64:
3860 IF CHECKBOX(I,T)<>0 THEN CP(I,T,8)=CP
3870 IF CHECKBOX(I,T) =0 THEN CP(I,T,8)=BC
3880 NEXT I:NEXT T
3890 RETURN
3900 *SEQUENTIAL
3910 YY$=LEFT$(DATE$,2):MM$=RIGHT$(DATE$,5):MM$=LEFT$(MM$,2):DD$=RIGHT$(DATE$,2)
3920 REM ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
3930 OPEN "MYPIC"+YY$+MM$+DD$+".ASC" FOR OUTPUT AS #1
3940 FOR DLAY=0 TO 7:
3950 FOR T=1 TO 64:FOR I=1 TO 64
3960 LAYER$(I,T,DLAY)=HEX$(LAYER(I,T,DLAY)):REM PRINT LAYER$(I,T,Dlay);LAYER(I,T,lay);
3970 NEXT:PRINT:NEXT::
3980 FOR T=1 TO 64:FOR I=1 TO 64:LAYER$=LAYER$+LAYER$(I,T,DLAY):NEXT:DATAFLOOR$(T,DLAY)=LAYER$:LAYER$="":NEXT
3990 REM FOR I=1 TO 64:PRINT DATAFLOOR$(I,DLAY):NEXT
CTBLOCY,3)=6 THEN GOSUB *BLRIMASK