10 '****************************************
   20 '  BSD File to OBJ EXhale Utility V1.3B
   30 '      For TRANS-DATA Format Ver02
   40 '         Programmed By T.Kuniwa
   50 '     ( sun1560,SPS0137 [VentDoux] )
   60 '****************************************
   70 '
   80 '
   90 *INIT
  100 ' option sreen 3:new on 3
  110   clr:clear $4000
  120   dim FIL$(3),X1(9),X2(9),Y1(9),Y2(9)
  130   init "CRT:80,25,,0":kmode 1
  140   color ,,,,1:cls
  150 '
  160   VER$="TRANS02"
  170   gosub *XTRANS02_OBJ
  180   def usr=$1830
  190   def FNWPEEK(P_ADD)=peek(P_ADD)+peek(P_ADD+1)*256
  200 '
  210   on stop gosub *STOP:stop on
  220   on error goto *ERROR_TRAP
  230 '
  240   X1=6:Y1=0:X2=64:Y2=2:gosub *W_OPEN
  250   locate 10,1
  260   print [6] "BSD File to OBJ EXhate Utility ver1.3B  TRANS02準拠"
  270   gosub *FIL_INPUT
  280   if FIL=0 then clear max:end
  290 '
  300 *EXHALE
  310   FIL_NO=1
  320   HEADER=0
  330 '
  340 *EXHALE0
  350   EX_FLG=0
  360   open "I",#1,FIL$(FIL_NO)
  370   locate 52,6+FIL_NO:print "変換中";
  380 '
  390 *EXHALE1
  400   repeat
  410     X1=3:Y1=12:X2=42:Y2=17:gosub *W_OPEN
  420     ADD=0:gosub *STATUS
  430     if HEADER=0 then gosub *HEADER:if HEADER=0 then *EXHALE2
  440     ADD=FNWPEEK($1833):gosub *STATUS1
  450     gosub *EXHALE_MAIN
  460 '
  470     if eof(#1) then locate 52,6+FIL_NO:print "変換終了";
  480     if STATUS=1 then
  490       gosub *SAVE:EX_FLG=1:HEADER=0
  500     end if
  510     gosub *W_CLOSE
  520   until eof(#1)
  530 '
  540   close #1
  550   if FIL_NO<FIL then FIL_NO=FIL_NO+1:goto *EXHALE0
  560 '
  570 *EXHALE2
  580   gosub *W_CLOSE
  590   if EX_FLG=0 then
  600     if HEADER=0 then restore *EX1:goto *ERR_RET1    'ヘッダが見付からない
  610     restore *EX3:goto *ERR_RET1                     'データが途切れている
  620   end if
  630   clear max:end
  640 '
  650 *HEADER
  660   QUIT=0:repeat
  670     line input #1,DAT$
  680     if left$(DAT$,6)="<"+left$(VER$,5) and right$(DAT$,1)=">" then
  685       QUIT=1:HEADER=1
  686     end if
  690     if eof(#1) then QUIT=2
  700   until QUIT>0
  710   if QUIT=2 then return
  720   if mid$(DAT$,2,7)<>VER$ then
  730     restore *EX2:goto *ERR_RET1                     'Versionが違う
  740   end if
  750 '
  760   SP=instr(10,DAT$,":")
  770   DST$=mid$(DAT$,10,SP-10)
  780   S_ADD=val("$"+mid$(DAT$,SP+1,4))
  790   E_ADD=val("$"+mid$(DAT$,SP+6,4))
  800   A_SUM=val("$"+mid$(DAT$,SP+11,4))
  810   if S_ADD<0 then S_ADD=S_ADD+65536
  820   if E_ADD<0 then E_ADD=E_ADD+65536
  830   if A_SUM<0 then A_SUM=A_SUM+65536
  840   ADD=S_ADD
  850   poke $1833,S_ADD-int(S_ADD/256)*256:poke $1834,int(S_ADD/256)
  860   poke $1835,E_ADD-int(E_ADD/256)*256:poke $1836,int(E_ADD/256)
  870   poke $1837,0,0
  880   return
  890 '
  900 *EXHALE_MAIN
  910   MAIN_QUIT=0:while MAIN_QUIT=0
  920     QUIT2=0:while QUIT2=0
  930       line input #1,DAT$
  940       if left$(DAT$,1)=":" then QUIT2=1
  950       if eof(#1)<>0 then QUIT2=QUIT2+2
  960     wend
  970     if QUIT2=2 then
  980       MAIN_QUIT=1                                   'ファイル読み込み終了
  990     else
 1000       if QUIT2=3 then MAIN_QUIT=1
 1010       DAT$=mid$(DAT$,2)
 1020       DUMMY$=usr(DAT$)
 1030       STATUS=peek($1839)
 1040       if STATUS=1 then MAIN_QUIT=1
 1050       if STATUS=3 then restore *EX3:goto *ERR_RET1
 1060       if STATUS=4 then restore *EX4:goto *ERR_RET1
 1070       if STATUS=5 then restore *EX5:goto *ERR_RET1
 1080       if STATUS>=$80 then
 1090         print "ＯＢＪ呼び出しエラー":stop
 1100       end if
 1110       ADD=FNWPEEK($1833):gosub *STATUS1
 1120     end if
 1130   wend
 1140   return
 1150 '
 1160 *SAVE
 1170   CHECK_SUM=FNWPEEK($1837)
 1180   if A_SUM<>CHECK_SUM then
 1190     restore *EX6:goto *ERR_RET1                       'チェックサムが違う
 1200   end if
 1210   if ADD<E_ADD then
 1220     restore *EX7:goto *ERR_RET1     :#print IREMｹアドレスまで解凍が完了していない
 1230   end if
 1240 '
 1250   X1=16:Y1=19:X2=72:Y2=21:gosub *W_OPEN
 1260   locate 20,20
 1270   print "ｄｉｓｋにＳＡＶＥしますか（Ｙ／Ｎ）  [ ]"+chr$(29,29);
 1280 '
 1290   SAVE_QUIT=0:repeat
 1300     K$=input$(1)
 1310     if asc(K$)>31 then print K$+chr$(29);
 1320     if K$="Y" or K$="y" then SAVE_QUIT=1
 1330     if K$="N" or K$="n" then SAVE_QUIT=2
 1340   until SAVE_QUIT<>0
 1350   gosub *W_CLOSE
 1360   if SAVE_QUIT=2 then return
 1370 '
 1380   X1=28:Y1=15:X2=76:Y2=19:gosub *W_OPEN
 1390   locate 34,16:print "ＯＢＪのファイル名は？";
 1400   console 17,1,32,43:call $1924
 1410   QUIT=0:while QUIT=0
 1420     PATH$=pwd$+"/"
 1430     key 0,PATH$+DST$                        'ヘッダ内のファイル名情報より
 1440     locate 32,17:input "",FIL$
 1450     if FIL$<>"" then
 1460       if attr$(FIL$)="" then
 1470         QUIT=1
 1480       else
 1490         X1=18:Y1=21:X2=62:Y2=24:gosub *W_OPEN
 1500         locate 22,22:print [2] "そのファイル名は既に使用されています。";
 1510         if instr(sum(I,1,2,PATH$+FIL$(I)),FIL$)=0 then
 1520           locate 26,23:print "1)パス変更  2)更新  [ ]"+chr$(29,29);
 1530           repeat:K$=input$(1):JOB=instr("12",K$):until JOB>0:print K$
 1540           if JOB=2 then
 1550             set FIL$,"":kill FIL$
 1560             QUIT=1
 1570           end if
 1580         else
 1590           DLY=0:repeat:DLY=DLY+1:until DLY>800 or inkey$<>""
 1600         end if
 1610         gosub *W_CLOSE
 1620       end if
 1630     end if
 1640   wend
 1650   console 0,24,0,80:call $1920
 1660 '
 1670   bsave FIL$,S_ADD,E_ADD-S_ADD+1,S_ADD,S_ADD
 1680   gosub *W_CLOSE
 1690   return
 1700 '
 1710 *STATUS
 1720   locate 7,13:print "TRANS FileName : ";right$(FIL$(FIL_NO),16)
 1730 *STATUS1
 1740   locate 7,14:print "Start  Address : ";right$("000"+hex$(S_ADD),4)
 1750   locate 7,15:print "Read   Address : ";right$("000"+hex$(ADD),4)
 1760   locate 7,16:print "End    Address : ";right$("000"+hex$(E_ADD),4)
 1770   return
 1780 '
 1790 *FIL_INPUT
 1800   X1=8:Y1=4:X2=62:Y2=10:gosub *W_OPEN
 1810   locate 14,5:print "ＴＲＡＮＳデータを格納したファイル名は？"
 1820   console 7,3,34,26:call $1924
 1830 '
 1840   FIL=0
 1850   QUIT=0:while QUIT=0
 1860     locate 12,7+FIL: print using "TRANS File Name (#) : ";FIL+1;
 1870     input "",FIL$(FIL+1)
 1880     if FIL$(FIL+1)="" then
 1890       QUIT=1
 1900     else
 1910       if attr$(FIL$(FIL+1))<>"" then
 1920         FIL=FIL+1:if FIL=2 then QUIT=2
 1930       else
 1940         X1=18:Y1=15:X2=54:Y2=17:gosub *W_OPEN
 1950         locate 22,16:print [2] "そのファイル名は存在しません。";
 1960         DLY=0:repeat:DLY=DLY+1:until DLY>800 or inkey$<>""
 1970         gosub *W_CLOSE
 1980       end if
 1990     end if
 2000   wend
 2010 '
 2020   if QUIT=1 then locate 12,7+FIL : print spc(39);
 2030   console 0,24,0,80:call $1920
 2040   return
 2050 '
 2060 *W_OPEN
 2070   X1(WDW)=X1:Y1(WDW)=Y1:X2(WDW)=X2:Y2(WDW)=Y2
 2080   WDW=WDW+1
 2090   kmode
 2100   locate X1,Y1:print [5] string$(X2-X1+1,135);
 2110   for I=Y1+1 to Y2-1
 2120     locate X1,I
 2130     print [5] chr$(135,135)+spc((X2-X1)-3)+chr$(135,135);
 2140   next
 2150   locate X1,Y2:print [5] string$(X2-X1+1,135);
 2160   kmode 1
 2170   return
 2180 '
 2190 *W_CLOSE
 2200   WDW=WDW-1
 2210   for I=Y1(WDW) to Y2(WDW)
 2220     locate X1(WDW),I:print spc(X2(WDW)-X1(WDW)+1);
 2230   next
 2240   return
 2250 '
 2260 *STOP
 2270   stop off
 2280   X1=18:Y1=21:X2=56:Y2=23:gosub *W_OPEN
 2290   locate 22,22
 2300   print "処理を中断しますか（Ｙ／Ｎ） [ ]"+chr$(29,29);
 2310   BREAK_QUIT=0:repeat
 2320     BRK$=input$(1)
 2330     if asc(BRK$)>31 then print BRK$+chr$(29);
 2340     if BRK$="Y" or BRK$="y" then BREAK_QUIT=1
 2350     if BRK$="N" or BRK$="n" then BREAK_QUIT=2
 2360   until BREAK_QUIT<>0
 2370   gosub *W_CLOSE
 2380   console 0,24,0,80
 2390   if BREAK_QUIT=1 then close:call $1920:cls:kill #1:clear max:end
 2400   stop on
 2410   return
 2420 '
 2430 *ERROR_TRAP
 2440   if err=20 then restore *E20:goto *ERR_RET
 2450   if err=41 then restore *E41:goto *ERR_RET
 2460   if err=46 then restore *E46:goto *ERR_RET
 2470   if err=50 then restore *E50:goto *ERR_RET
 2480   if err=51 then restore *E51:goto *ERR_RET
 2490   if err=53 then restore *E53:goto *ERR_RET
 2500   if err=58 then restore *E58:goto *ERR_RET
 2510   if err=60 then restore *E60:goto *ERR_RET
 2520   if err=61 then restore *E61:goto *ERR_RET
 2530   on error goto 0
 2540   print "−−（内部処理エラー：作者に連絡して下さい。）−−"
 2550   print "Error No=";err;"  Error Line=";erl
 2560   stop
 2570 '
 2580 *ERR_RET
 2590   read MSG$,RET_FLG:E_FLG=0
 2600   goto *ERR_RET2
 2610 *ERR_RET1
 2620   read MSG$:RET_FLG=0:E_FLG=1
 2630 *ERR_RET2
 2640   EX=pos(0):EY=csrlin
 2650   X1=10:Y1=19:X2=71:Y2=21:gosub *W_OPEN
 2660   locate 14,20
 2670   if E_FLG=1 then print [2] "解凍Error: ";
 2680   print MSG$;" ";
 2690   K$=input$(1)
 2700   gosub *W_CLOSE
 2710   locate EX,EY
 2720 '
 2730   if RET_FLG=0 then close:clear max:end
 2740   if RET_FLG=1 then resume
 2750   stop
 2760 '
 2770 *E20 : data "ファイルの書式を確認して下さい。"                    ,1
 2780 *E41 : data "ディスクにハードウェアトラブルが発生した模様です。"  ,0
 2790 *E46 : data "プロテクト・ＳＷを確認して下さい。"                  ,1
 2800 *E50 : data "指定装置が稼働状態になっていません。"                ,1
 2810 *E51 : data "ファイルの登録数が制限を越えました。"                ,1
 2820 *E53 : data "ＤＩＳＫの空きスペースが無くなりました。"            ,1
 2830 *E58 : data "装置名の指定が不適当です。"                          ,1
 2840 *E60 : data "ファイル名が不適当です。"                            ,1
 2850 *E61 : data "ファイルモードが違います"                            ,1
 2860 '
 2870 *EX1 : data "ＴＲＡＮＳファイルではありません。"
 2880 *EX2 : data "ＴＲＡＮＳデータのバージョンが違います。"
 2890 *EX3 : data "データの欠損がみられます。"
 2900 *EX4 : data "規定外の文字がデータ部に含まれています。"
 2910 *EX5 : data "データ量がヘッダ内の情報以上に存在します。"
 2920 *EX6 : data "チェックサムが合いませんでした。"
 2930 *EX7 : data "データが足りません。"
 2940 '
 2950 *XTRANS02_OBJ
 2960   restore *OBJ_DATA
 2970   for I=$1830 to $192A
 2980     read DAT$:poke I,val("$"+DAT$)
 2990   next
 3000   return
 3010 '
 3020 *OBJ_DATA
 3030 data C3,3B,18,00,00,00,00,00 , 00,00,00,AF,32,39,18,78
 3040 data FE,03,3E,80,C2,1A,19,7E , FE,00,3E,81,CA,1A,19,06
 3050 data 00,7E,04,D6,08,28,09,38 , 02,18,F7,3E,03,C3,1A,19
 3060 data 23,5E,23,56,EB,C5,06,08 , 7E,FE,21,38,0C,FE,7F,38
 3070 data 0D,FE,A1,38,04,FE,C3,38 , 09,3E,04,C3,19,19,D6,21
 3080 data 18,02,D6,43,4F,78,FE,08 , 28,1E,50,3E,FF,05,28,04
 3090 data CB,27,10,FC,E6,7F,A1,42 , 05,28,04,CB,3F,10,FC,47
 3100 data 3A,3A,18,B0,CD,E0,18,42 , 78,FE,01,28,19,50,05,AF
 3110 data CB,27,C6,01,10,FA,A1,5F , 3E,09,42,90,47,CB,23,10
 3120 data FC,7B,32,3A,18,42,23,10 , 9F,C1,3A,39,18,FE,01,20
 3130 data 0A,78,FE,01,28,05,3E,05 , C3,1A,19,10,88,06,03,C9
 3140 data 47,3A,39,18,FE,00,C0,D5 , E5,2A,33,18,78,77,ED,5B
 3150 data 37,18,83,5F,7A,CE,00,57 , ED,53,37,18,ED,5B,35,18
 3160 data B7,ED,52,38,02,18,0A,2A , 33,18,23,22,33,18,E1,D1
 3170 data C9,3E,01,32,39,18,E1,D1 , C9,C1,32,39,18,06,03,C9
 3180 data 3E,00,18,02,3E,FF,0E,03 , DF,66,C9
 3190 '----------( XTRANS02.BASv1.3A : By T.Kuniwa  : 89/09/01 )----------
 3200 '----------( XTRANS02.BASv1.3B : By K.Hayashi : 91/11/24 )----------