サンプル；PushBon

ゲームPushBonです。

progloaderで「PushBon」をダウンロードすると、
　PushBon.bas
と必要データファイルが追加されます。

オリジナルは Oh!X 1989-11掲載のS-OS TTI(TinyTinyInterpreter)用です。
以下のリストはオリジナルのもの。動作確認はしてないので打ち込み間違いがあるかも。
これとX-BASIC版を見比べると、構造化の効果がわかるかも。

;
; PUSH BON  FOR TTI
;
;
  'C' WIDCH 40

;MAIN ROUTINE
   .R=0
9
   GOSUB 975 .G=5  GOSUB 980
      GOSUB 965  GOSUB 970
10
   LOCATE  25,15 "PUSH ANY KEY!!"
     LOCATE  25,15 "               "
    IF (G=0,10
11
     .T=0 .X=0 .Y=0 .D=0 .S=0
      GOSUB 980  BELL 1
12
     .B=0 GOSUB 900 GOSUB 953 GOSUB 993
     .B=6 GOSUB 953
13
     .K=(G IF K=0,13
       IF K='4,455
       IF K='6,456
       IF K='8,458
       IF K='2,457
       IF K='G,20
       IF K#' ,13
       GOSUB 300 INC S
       .A=0 ADC A IF A#0,20
       GOSUB 899
       GOSUB 250 IF O#0,23
       GOSUB 255 IF O#0,23
14
      GOSUB 1000
    GOTO 13

;GIVE UP!!!
20
   LOCATE 6,11 "             "
   LOCATE 6,12 "  GIVE UP!!  "
   LOCATE 6,13 "             "
     DEC  G GOSUB 980 BELL 2
25
     GOSUB 990 IF G=0,21
    GOSUB 965 GOSUB 970
   GOTO 11

;GAME OVER
21
   LOCATE 6,11 "* * * * * * *"
   LOCATE 6,12 " *GAME OVER* "
   LOCATE 6,13 "* * * * * * *"
   BELL 3
22
    IF (G#' ,22
   .R=0 GOTO 9

;ROUND CLEAR
23
   LOCATE 6,11 "* * * * * * *"
   LOCATE 6,12 " ROUND CLEAR "
   LOCATE 6,13 "* * * * * * *"
   BELL 3
24
    IF (G#' ,24
    INC R IF R<10,25
    .R=0 GOTO 25

;* BLOCK YOKO CHECK
250
   .H=$9F .I=00  .O=00
   .A=7 REPEAT
     .C=5 REPEAT
       WIND2 H,I .J=]
       @IF J=4 PUSH I PUSH H GOSUB 251 POP H POP I
      DEC C .I=I+1 ADC H
      UNTIL C=0
     .I=I+2 ADC H DEC A
     UNTIL A=0
    RETURN

251
   .L=2
252
    .I=I+1 ADC H WIND2 H,I
      .J=] IF J#4,254
       DEC  L IF L#0,252
      .O=10
254
      RETURN

;* BLOCK TATE CHECK
255
   .H=$9F .I=00  .O=00
   .A=7 REPEAT  PUSH H PUSH I
     .C=5 REPEAT
       WIND2 H,I .J=]
       @IF J=4 PUSH I PUSH H GOSUB 256 POP H POP I
      DEC C .I=I+7 ADC H
      UNTIL C=0
      POP I POP H
     .I=I+1 ADC H DEC A
      UNTIL A=0
    RETURN

256
   .L=2
257
    .I=I+7 ADC H WIND2 H,I
      .J=] IF J#4,258
      DEC  L IF L#0,257
     .O=10
258
     RETURN

;BLOCK PUSH
300
   .T=0
    PUSH X PUSH Y PUSH D
      @GOSUB D*5+150
    POP  D POP  Y POP  X
    BELL 1
   RETURN

;BLOCK UP PUSH
150
  @IF Y<2 RETURN
    DEC Y GOSUB 952 .J=B
    @IF J=5 RETURN
    @IF J=0 DEC S RETURN
151
    .Q=Y DEC Y  IF Q<1,352
      GOSUB 952 IF B#0,162
      GOSUB 390
    GOTO 151
352
    .Y=Q .B=J GOSUB 953
   RETURN

;BLOCK RIGHT PUSH
155
  @IF X>4 GOSUB 952 .J=B
   INC X GOSUB 952 .J=B
   @IF J=5 RETURN
   @IF J=0 DEC S RETURN
156
    .P=X INC X IF X>6,357
      GOSUB 952 IF B#0,167
      GOSUB 391
      GOTO 156
357
    .X=P .B=J GOSUB 953
   RETURN

;BLOCK DOWN PUSH
160
  @IF Y>4 RETURN
    INC Y GOSUB 952 .J=B
    @IF J=5 RETURN
    @IF J=0 DEC S RETURN
161
    .Q=Y INC Y IF Y>6,352
      GOSUB 952 IF B#0,162
      GOSUB 390
    GOTO 161
162
    .W=Y .V=X .U=B .Y=Q .B=J
   GOSUB 953 GOTO 370

;BLOCK LEFT PUSH
165
  @IF X<2 RETURN
    DEC X GOSUB 952 .J=B
    @IF J=5 RETURN
    @IF J=0 DEC S RETURN
166
    .P=X DEC X IF P<1,357
    GOSUB 952 IF B#0,167
    GOSUB 391
    GOTO 166
167
    .W=Y .V=X .U=B .X=P .B=J
   GOSUB 953 GOTO 370

;BLOCK WO HAJIKU
370
   @IF T>10 .T=0 RETURN
    INC T
    @IF U>4 RETURN
     IF J=2,371
     IF J=3,376
   IF U=2,374
   IF U=3,377
   RETURN

;LEFT BLOCK
371
   GOSUB 385
372
     .J=U .X=V .Y=W
    @GOTO D*5+151
374
   GOSUB  385 @GOTO D*5+151

;RIGHT BLOCK
376
    GOSUB 386 GOTO 372
377
    GOSUB 386 @GOTO D*5+151

;DIR LEFT TURN
385
   DEC D @IF D>121 .D=3
   RETURN

;DIR RIGHT TURN
386
   INC D @IF D=4 .D=0
   RETURN

;BLOCK ERASE MOVE
390
    PUSH Y .B=0 .Y=Q GOSUB 900 .B=0 GOSUB 953
      POP  Y .B=J GOSUB 900
    RETURN
391
    PUSH X .B=0 .X=P GOSUB 900 .B=0 GOSUB 953
      POP  X .B=J GOSUB 900
    RETURN

;CURSOR LEFT
455
   .D=3  IF X=0,12
     PUSH X .X=X-1 GOSUB 952
      @IF B#0 POP X GOTO 12
454
      .Q=X POP X  .B=0
         GOSUB 900 .B=0 GOSUB 953
       .X=Q GOSUB 993 .B=6 GOSUB 953
      GOTO 14

;CURSOR RIGHT
456
   .D=1  IF X=6,12
     PUSH X .X=X+1 GOSUB 952
      IF B=0,454
     POP X
   GOTO 12

;CURSOR DOWN
457
   .D=2  IF Y=6,12
     PUSH Y .Y=Y+1 GOSUB 952
      @IF B#0 POP Y GOTO 12
453
      .Q=Y POP Y  .B=0
       GOSUB 900 .B=0 GOSUB 953
     .Y=Q GOSUB 993 .B=6 GOSUB 953
    GOTO 14

;CURSOR UP
458
  .D=0  IF Y=0,12
     PUSH Y .Y=Y-1 GOSUB 952
      IF B=0,453
     POP  Y
   GOTO 12

;BLOCK PRINT
900
   .A=X*3+2 .C=Y*3+2 LOCATE A,C
    @IF B>5 .B=0
    IF B#5,902
       "."     CHR $7B "."     'DLLL'
       CHR $7B CHR $7B CHR $7B 'DLLL'
       "."     CHR $7B "."
    RETURN
902
    IF B#0,901
       "   " 'DLLL' "   " 'DLLL' "   "
       RETURN
901
    "+-+" 'DLLL' "I I" 'DLLL' "+-+"
        LOCATE A+1,C+1
        @GOTO  B+59
   RETURN
60
   " " RETURN
61
   "L" RETURN
62
   "R" RETURN
63
   "*" RETURN

;KVRAM ADDRESS
950
    .A=$9F .C=00 .F=Y
      .C=C+X ADC A
        IF F=0,951
        REPEAT
           .C=C+7 ADC A
           DEC F
        UNTIL F=0
951
    WIND2 A,C
   RETURN

;KVRAM READ
952
    GOSUB 950 .B=] RETURN

;KVRAM WRITE
953
    GOSUB 950 .]=B RETURN

;MEN ADDRESS
960
    .H=$A0 .I=00  IF R=0,961
     .D=R
      REPEAT
         .I=I+49 ADC H
         DEC D
      UNTIL D=0
961
   RETURN

;MEN TENSOU  READ
965
   GOSUB  960  .A=$9F .C=00
     .F=50 REPEAT
       WIND2 H,I .B=]
       WIND2 A,C .]=B
       .I=I+1 ADC H .C=C+1 ADC A
       DEC F
     UNTIL F=0
   RETURN

;MEN PRINT
970
     .Y=0  REPEAT
      .X=0  REPEAT
        GOSUB  950 .B=]
        GOSUB  900
        INC X   UNTIL X=7
      INC Y   UNTIL Y=7
   RETURN

;WAKU PRINT
975
   LOCATE 1,1  .A=23
     REPEAT  "*" DEC A
      UNTIL A=0
       .Y=2 REPEAT
        LOCATE  1,Y "*" DEC A
        .A=21 REPEAT " " DEC A
        UNTIL A=0  "*"
        INC Y UNTIL Y=23
       LOCATE 1,23  .A=23
      REPEAT "*" DEC  A
     UNTIL A=0
   RETURN

;SCREEN PRINT
980
   GOSUB 990
   GOSUB 899
   GOSUB 992
   GOSUB 991
RETURN

;TITLE PRINT
990
   LOCATE 25,2 " @@  @@@  @@ "
   LOCATE 25,3 "@           @"
   LOCATE 25,4 "@ PUSH BON! @"
   LOCATE 25,5 "@           @"
   LOCATE 25,6 " @@  @@@  @@ "
   LOCATE 25,21 "FOR TTI"
   LOCATE 27,23 "BY J.YAMADA"
   RETURN

;STEP PRINT
899
   LOCATE 26,8  "STEP  " PRT1 S
   RETURN

;ROUNT PRINT
991
   LOCATE 26,12 "ROUND " PRT1 R
   RETURN

;LIFE PRINT
992
   LOCATE 26,10 "LIFE  " PRT1 G
   RETURN

;DIRECTION PRINT
993
   LOCATE X*3+2,Y*3+2
    @GOSUB 50+D
   RETURN
50
   'R' "^" 'DL' "I" 'DL' "V"
   RETURN
51
   'D' "-->" RETURN
52
   'R' "I" 'DL' "I" 'DL' "V"
   RETURN
53
   'D' "<--" RETURN

;WAIT
1000
   .W=100 REPEAT .W=W-1 UNTIL W=0
   RETURN
END

サンプル；８QUEEN

エイト・クイーンというパズルの解法を表示します・・・らしいです。

プログラムは移植しましたが、私自身これがどういったものなのか理解していないため、 結果が正しいかどうかは不明です。

progloaderで「8QUEEN」をダウンロードすると、
　8QUEEN.bas
が追加されます。



このプログラムのオリジナルはここにあったMZ-80/1200用ですが、元ネタはWikipediaにもある通り、別のところにあります。

サンプル；ライフゲーム

ライフゲームについてはこちらを参照してください。「ゲーム」とありますが、シミュレーションです。
progloaderで「ライフゲーム」をダウンロードすると、
LigeGame.bas
が追加されます。

RUNするとまずは編集モードになるので、画面内にセルを配置してください。
セルは、任意の座標を直接タッチすることで配置または除去できます。

開始をタップすると実行されます。

基本的には永久に動き続けますが、全てがなくなると自動停止します。
途中で再編集も出来ます。
Wikipediaにあるようなサンプルも実行できますが、フィールドがあまり広くないことと、上下左右がつながってないので結果はちょっと違ってきます。その辺りは適当に改良してください。

このプログラムのオリジナルはOh!X1988年6月号のS-OS上のSLANG用ですが、元ネタはWikipediaにもある通り、別のところにあります。

以下のリストはオリジナルのもの。動作確認はしてないので打ち込み間違いがあるかも。

// ライフゲーム
// Oh!X 1988-6
//

// 宣言

//WORK  $9888;  (≪ for MZ-88/1268 ≫)

  CONST XX=40-1, YY=25-1,
        X =XX-1, Y =YY-1;

   ARRAY BYTE A[YY][XX],
         BYTE B[YY][XX];

   VAR   GEN;
//
// メイン処理
//
MAIN()
   BEGIN
     WIDTH(48);
     intset();   // 初期画面SET
     PRINT("\C");       // 画面を消す

     FOR GEN=0 TO 100 [
        HYOUJ();  // 画面表示
        COPY();   // 配列コピー
        KOUTAI();  // 世代交代
        KEY();   // キー入力
      ]

   END;
//
//   画面表示
//
HYOUJ()
   VAR   I,J;
   BEGIN
     LOCATE(0,0);
     PRINT("GEN:",DECI$(GEN));

     FOR I=1 TO Y [
        LOCATE(1,I);
        FOR J=1 TO X [

           IF A[I][J]==FALSE [
              PRINT(" ");
           ]
           ELSE [
               PRINT("*");
           ]
         ]
       ]
    END;
 //
 // 配列コピー
 //
 COPY()
    VAR   I,J;

    BEGIN
      FOR I=1 TO Y [
         FOR J=1 TO X [
            B[I][J]=A[I][J];
          ]
       ]
    END;
 //
 // 世代交代
 //
 KOUTAI()
    VAR   I,J;

    BEGIN
       FOR I=1 TO Y [
         FOR J=1 TO X [
            CASE JOUTAI(I,J) [
               0,1 : A[I][J]=FALSE;
               2 : []
               3 : A[I][J]=TRUE;
               OTHERS: A[I][J]=FALSE;
            ]
          ]
       ]
    END;
 //
 // 状態
 //
 JOUTAI(I,J)
    BEGIN
    END(
         B[I-1][J-1]+B[I-1][J]+B[I-1][J+1]
        +B[I  ][J-1]       +B[I  ][J+1]
        +B[I+1][J-1]+B[I+1][J]+B[I+1][J+1]
    ) ;
 //
 //  初期画面SET
 //
 INTSET()
    VAR   I,J,KEY;


    CONST  MSG= [
      "START-[CR]  RESET-[SPC]  SET-[S]",0
    ];

    BEGIN
      PRINT( "\C" );
      LOCATE( 8, 8);  PRINT( MSX$(MSG) );
      LOCATE(16,13);

      WHILE TRUE [
         CASE (KEY=INKEY(1)) [
            $1B:        STOP()
            $0D:        EXIT;
            $21 TO $FF: PRINT("*");
            OTHERS:     PRINT(CHR$(KEY));
         ]
       1

      FOR I=0 TO YY [
         FOR J=0 TO XX [
            A[I][J]=FALSE;
         ]
       ]

      FOR I=1 TO Y [
         FOR J=1 TO X [
            IF SCREEN(J,I)=='*' [
               A[I][J]=TRUE;
            ]
         ]
       ]
   END;
 //
 // キー入力
 //
 KEY()
   BEGIN
      WHILE TRUE [
         CASE INKEY(0) [
 //      $00   : EXIT;
            $1B  : STOP();
                    : [
               BEEP();
               WHILE INKEY(1)==' ' []
            ]
            OTHERS: EXIT;
         ]
      ]
   END;
 //
 //END

ゲーム；TICBAN

progloaderで「ゲーム;TICBAN」をダウンロードすると、
TICBAN.bas
が追加されます。

　ゲームの解説です。画面には通路のパーツとなるブロックが並んでいます。
この上を一定の速度でボールが転がっていきます。通路に沿って迷路内を転がっていく
ボールの進路をうまく組み換えて上下左右にある1～8のゲートをすべて通すというのがゲームの内容です。

ゲートは、同じ番号2箇所を通ることで通過とみなされます。
（入り口の番号で入ったことがチェックされ、出口の番号通過で加点されます。）

一度通ったゲートには穴が開きます。

　どのようにするかというと、迷路の中にはひとつだけ空白のブロックがありますので、
その部分を移動させることにより迷路を組み換えていくことができます。ちょうど15パズルのような要領です。
このあたりは説明を読むより、実際にあれこれやってみたほうがわかりやすいでしょう。

　当然、通路からボールが落ちてしまったり、行き止まりになったら、ゲームオーバーです。

　全部で11面ありますが、そのなかに１面だけクリアできない面かあるかもしれません。
そのほかの面はすべてクリアできることを確認してありますので、こんな面クリアできないよーなどと駄々をこねても
ダメですからね。

　X-BASIC for iOS版はプログラムリストだけを見ての移植なので、オリジナルと同じ動作をしているかわかりません。
（S-OSの動作環境を構築できないので。X1エミュレーター自体は入手できたのですが。）
よって、クリアできるかどうかも不明です。
私の頭では1面もクリアできませんでしたので。
クリアしたはずなのに終わらないとか、バグがあるとわかる方はお知らせください。


オリジナルはOh!X1989年7月号のS-OS上のコンパイラTTC用のゲームです。 元があるので転載禁止です。 オリジナルのソースは以下に。

;            TICBAN
;      FOR Tiny Tiny Compiler
;          PROGRAMED BY J.YAMADA
; Oh!X 1989-7

.R=0
WIDCH 40
7
  'C' LOCATE 28,2 "* TICBAN *"
      LOCATE 28,20 "FOR TTC" LOCATE 28,22 "BY J.YAMADA"
 .S=0 .C=0 .M=1 GOSUB 880
10
  LOCATE 27,17 "PUSH ANY KEY!"
  LOCATE 27,17 "             "
  .A=(G  IF A=0,10 IF A<'0,1 IF A>'9,1
    .A=A-$30 .R=A  GOSUB 880


;    MAIN ROUTINE
1
  REPEAT
   .W=5 REPEAT  GOSUB 870
     .A=(G      IF A=$1B,9
     GOSUB 994 DEC W UNTIL W=0
   GOSUB 500 IF A=0,6 GOSUB 880
6
  IF F#8,5 GOSUB 700            ;ROUND CLEAR
5
 UNTIL M=0

;    GAME OVER
   LOCATE 6,13 " * GAME OVER * "
     LOCATE 28,14 "RETRY(Y/N)?"
8
    .A=(F IF A=' ,7 IF A='Y,7
   IF A#'N,8 CHR A
9
RETURN


;    BALL MAIN ROUTINE

;    BALL MOVE
500
  LOCATE N,O CHR $7B .H=N .I=O
   IF P=1,501 IF P=2,502
   IF P=3,503 IF P=4,504
499
  .N=H .O=I LOCATE N,I CHR 'O .C=C+1 ADC S GOSUB 803
  .A=0  RETURN


;    UP MOVE
501
  GOSUB 505 IF A=0,499       ;UP CHECK
  GOSUB 506 .P=2 IF A=0,499  ;RIGHT CHECK
  GOSUB 507 .P=4 IF A=0,499  ;LEFT CHECK
GOTO 510                     ;MISS !!

;    RIGHT MOVE
502
  GOSUB 506 IF A=0,499
  GOSUB 508 .P=3 IF A=0,499
  GOSUB 505 .P=1 IF A=0,499
GOTO 510

;    DOWN MOVE
503
  GOSUB 508 IF A=0,499
  GOSUB 506 .P=2 IF A=0,499
  GOSUB 507 .P=4 IF A=0,499
GOTO 510

;    LEFT MOVE
504
  GOSUB 507 IF A=0,499
  GOSUB 508 .P=3 IF A=0,499
  GOSUB 505 .P=1 IF A=0,499
GOTO 510


;    MISS  !!
510
  LOCATE N,O CHR '* DEC M
     LOCATE 8,11 "  MISS !  " BELL 1 GOSUB 804
511
      IF M=0,512 IF (G#' ,511 .A=$50 RETURN
512
   .A=0 RETURN


;    UP CHECK
505
   .I=I-1 GOTO 509

;    RIGHT CHECK
506
   .H=H+1 GOTO 509

;    LEFT CHECK
507
   .H=H-1 GOTO 509

;    DOWN CHECK
508
   .I=I+1
509
    GOSUB 550 GOSUB 560
RETURN


;    SCRN CALL  $9FF8
550
  LOCATE H,I .A=$9F .B=$F8 CALL A,B GETA D
RETURN

;    CHR CHECK
560
  IF D=$7B,561 IF D='-,562
   IF D='I,562  IF D=' ,562
   IF D='+,562

   IF G#D,563 BELL 1 INC F GOSUB 600
  .A=G-$30*10 .C=C+A ADC S GOSUB 803
563
   .G=D
561
  .A=0 RETURN
562
   .A=$F0 .H=N .I=O
RETURN


;    GATE SUB
600
  IF G='1,601 IF G='2,602
  IF G='3,603 IF G='4,604
  IF G='5,605 IF G='6,606
  IF G='7,607 IF G='8,608
RETURN

601
   .A=6 .B=0 GOTO 609
602
   .A=18 .B=0 GOTO 609
603
   .A=24 .B=6 GOTO 609
604
   .A=24 .B=15 GOTO 609
605
   .A=18 .B=21 GOTO 609
606
   .A=6  .B=21 GOTO 609
607
   .A=0  .B=15 GOTO 609
608
   .A=0  .B=6
609
  LOCATE A,B .Z=1 GOSUB 1011
RETURN


;    ROUND CLEAR
700
   LOCATE 6,10 " ROUND CLEAR! " BELL 1
      INC R IF R#11,701 .R=0
701
    IF (G#' ,701 GOSUB 880
RETURN


;    BLOCK MAIN ROUTINE
870
  .A=(G IF A=0,878
    IF A='J,874 IF A='L,873
    IF A='M,876 IF A='I,875
878
 RETURN


;    RIGHT MOVE 6
873
  IF X=3,810 .L=X .X=X-3 GOSUB 888  .T=A
      LOCATE  L,Y .Z=A   GOSUB 1011 .U=3 .V=0
  GOTO 872

;    LEFT MOVE 4
874
  IF X=21,810 .L=X .X=X+3 GOSUB 888  .T=A
       LOCATE  L,Y .Z=A   GOSUB 1011 .U=253 .V=0
872
    .K=X   .X=L GOSUB 889  .X=K
  GOTO 877


;    UP MOVE 8
875
  IF Y=18,810 .L=Y .Y=Y+3 GOSUB 888  .T=A
       LOCATE  X,L .Z=A   GOSUB 1011 .U=0 .V=253
  GOTO 871

;    DOWN MOVE 2
876
  IF Y=3,810  .L=Y .Y=Y-3 GOSUB 888  .T=A
       LOCATE  X,L .Z=A   GOSUB 1011 .U=0 .V=3
871
     .K=Y   .Y=L  GOSUB 889  .Y=K

877
  IF N-X>2,879 IF O-Y>2,879
    .N=N+U .O=O+V LOCATE N,O CHR 'O
879
   .T=0 GOSUB 889 .Z=0 GOSUB 1000
810
RETURN


;    MEN DATA TO KVRAM           DATA TENSOU

802
  GOSUB 995 .A=$9F .B=00 WIND2 A,B
    .K=0 REPEAT  .]=[ .E=E+1   ADC D WIND1 D,E
        .B=B+1 ADC A WIND2 A,B
    INC  K UNTIL K=42
RETURN


;    SHOKIKA
880
  GOSUB 802   GOSUB 990  GOSUB 997 GOSUB 800
    .X=12 .Y=9 .Z=0  GOSUB 1000 GOSUB 1015
       .T=0   GOSUB 889 .N=4 .O=4  LOCATE N,O CHR 'O .P=2
    GOSUB 803 GOSUB 804 .G=0 .F=0
RETURN

;    ROUND PRINT
800
  LOCATE 28,12 "ROUND" PRT1 R RETURN

;    SCORE PRINT
803
  LOCATE 28,7 "SCORE " PRT2 S,C RETURN

;    BALL PRINT
804
  LOCATE 28,9 "BALL    " PRT1 M RETURN


;    BLOCK NO. ADDRESS
886
  .D=$9F .E=00 .A=X-3/3 .E=E+A ADC D
    IF Y=3,887 .B=Y-3/3  REPEAT
      .E=E+7 ADC D  DEC B UNTIL B=0
887
    WIND1 D,E
RETURN

;    BLOCK NO. READ
888
  GOSUB 886 .A=[ RETURN

;    BLOCK NO. WRITE
889
  GOSUB 886 .[=T RETRUN


;    WAKU PRINT
990
  .X=0 .Y=0 GOSUB 991 GOSUB 991
   .Z=1 GOSUB 1000 .Y=Y+3
        GOSUB 992  GOSUB 992
   .X=0 GOSUB 993  GOSUB 993
  .Z=1  GOSUB 1000
RETURN


991
  .Z=1 GOSUB 1000 .X=X+3
  .Z=8 GOSUB 1000 .X=X+3
  .Z=3 GOSUB 1000 .X=X+3
  .Z=7 GOSUB 1000 .X=X+3
RETURN

992
  .X=0 .Z=8 GOSUB 1000 .X=X+24 .Z=7 GOSUB 1000 .Y=Y+3
  .X=0 .Z=2 GOSUB 1000 .X=X+24      GOSUB 1000 .Y=Y+3
  .X=0 .Z=5 GOSUB 1000 .X=X+24 .Z=6 GOSUB 1000 .Y=Y+3
RETURN

993
  .Z=1 GOSUB 1000 .X=X+3
  .Z=5 GOSUB 1000 .X=X+3
  .Z=3 GOSUB 1000 .X=X+3
  .Z=6 GOSUB 1000 .X=X+3
RETURN


;    WAIT
994
  .A=15 REPEAT .B=0 REPEAT
    INC B UNTIL B=0 DEC A UNTIL A=0
RETURN


;    MEN ADDRESS         MEN DATA $A000
995
  .D=$A0 .E=00
   .A=R  IF A#0,996
     WIND1 D,E RETURN
996
     REPEAT  .E=E+42 ADC D DEC A
   UNTIL A=0 WIND1 D,E
RETURN

;    MEN PRINT            KVRAM AREA $9F00
997
  .D=$9F .E=00    WIND1 D,E
     .G=3 REPEAT .H=3 REPEAT
      .Z=[ .E=E+1 ADC D WIND1 D,E
     LOCATE H,G GOSUB 1011 .H=H+3 UNTIL H=24
  .G=G+3  UNTIL G=21
RETURN


;    BLOCK PRINT ROUTINE
1000
  LOCATE X,Y
1011
   IF Z=0,1001
   IF Z=1,1002 IF Z=2,1003
   IF Z=3,1004 IF Z=4,1005
   IF Z=5,1006 IF Z=6,1007
   IF Z=7,1008 IF Z=8,1009
  RETURN

1001
  "   " 'DLLL' "   " 'DLLL' "   " RETURN
1002
  "+-+" 'DLLL' "I+I" 'DLLL' "+-+" RETURN

1003
  "+" CHR $7B "+" 'DLLL' "I" CHR $7B
  "I" 'DLLL' "+" CHR $7B "+" RETURN
1004
  "+-+" 'DLLL' CHR $7B CHR $7B CHR $7B
  'DLLL' "+-+" RETURN
1005
  "+" CHR $7B "+" 'DLLL' CHR $7B CHR $7B
  CHR $7B 'DLLL' "+" CHR $7B "+" RETURN
1006
  "+" CHR $7B "+" 'DLLL' "I" CHR $7B
  CHR $7B 'DLLL' "+-+" RETURN
1007
  "+" CHR $7B "+" 'DLLL' CHR $7B
  CHR $7B "I" 'DLLL' "+-+" RETURN
1008
  "+-+" 'DLLL' CHR $7B CHR $7B "I"
  'DLLL' "+" CHR $7B "+" RETURN
1009
  "+-+" 'DLLL' "I" CHR $7B CHR $7B
  'DLLL' "+" CHR $7B "+" RETURN

;    GATE NO. PRINT
1015
  .A=4 .B=2 .K='1 GOSUB 1016
   .A=A+6   .K='2 GOSUB 1016
      .A=4 .B=21 .K='6 GOSUB 1016
       .A=A+6 .K='5 GOSUB 1016
       .A=24  .B=4 .K='3 GOSUB 1017
      .B=B+3  .K='4 GOSUB 1017
    .A=2 .B=4 .K='8 GOSUB 1017
    .B=B+3    .K='7 GOSUB 1017
RETURN

1016
   LOCATE  A,B CHR K .A=A+6 LOCATE A,B CHR K
RETURN

1017
   LOCATE  A,B CHR K .B=B+6 LOCATE A,B CHR K
RETURN

END

サンプル：フラクタルグラフィック

氷山のようなフラクタルグラフィックを描画するサンプルです。
progloaderで「フラクタルグラフィック（一部未内蔵）」をダウンロードすると、
　　fractalGraphics.bas
　　TREE.bas
　　fractal15.bas
　　fractal16.bas
の４本が追加されます。
前２本が新規分です（後２本は内蔵サンプルと同じです）。

fractalGraphics.bas

乱数を使ってますので、毎回画像は変わります。

TREE.bas

こちらは毎回同じです。


ちなみに、以下は同プログラムのオリジナルのMZ-2500版での実行結果です(MZ-2500エミュレーター上での実行結果)。

オリジナルは雑誌I/Oの掲載されていたものですが、残念ながらそのページのコピーだけを持っていたので、何年何月号かは不明です。１９８５年頃だとは思うのですが。
X1-turbo/MZ-2500/PC-9801シリーズ「フラクタルグラフィック」江上邦博、下園真一
元があるので転載禁止です。

以下のリストはオリジナルのもの。動作確認はしてないので打ち込み間違いがあるかも。

1000 'program  Fractal graphics
1005 ' for MZ-2500 BASIC-M25 ; 4096色パレット版
1010 INIT "CRT2:640,400,16":CLS 3
1020 '
1030 DEFINT I-K,P,X-Z
1040 DIM X(2200),Y(2200),Z(2200),C$(9)
1050 DEF FNMAXIM(N) = N* ( N+1 )/2
1060 DEF FNMIN(N)=FNMAXIM(N-1)+1
1070 FOR I=1 to 14:COLOR=(I,I+1,I+1,I+1):NEXT
1080 '
1090 '
1100 PAL=15 'How many colors ?
1110 LX=.57735027:LY=.57735027:LZ=-.57735027
1120 '
1130 X(1)=320 :Y(1)=30  :Z(1)=0
1140 X(2)=50  :Y(2)=350 :Z(2)=300
1150 X(3)=590 :Y(3)=350 :Z(3)=300
1160 '
1170 NDIM=2:GOSUB 1700 '*LDRAW
1180 ' *MAIN
1190 FOR LEVEL=1 TO 6
1200 NDIM=NDIM*2-1:GOSUB 1290 '*CALC
1210 CLS 2
1220 LOCATE 0,2 :PRINT "level";LEVEL
1230 GOSUB 1700 '*LDRAW
1240 NEXT
1250 GOSUB 1800 '*PAINT
1260 END
1270 '
1280 '
1290 '*CALC   'calculate
1300 FOR I=NDIM TO 3 STEP -2
1310 FOR K=FNMIN(I) TO FNMAXIM(I) STEP 2
1320 PT1=FNMIN((I+1)/2) :PT2=FNMIN(I)
1330 X(K)=X(PT1+(K-PT2)/2)
1340 Y(K)=Y(PT1+(K-PT2)/2)
1350 Z(K)=Z(PT1+(K-PT2)/2)
1360 NEXT K
1370 FOR K=FNMIN(I)+1 TO FNMAXIM(I)-1   STEP 2
1380 X1=X(K-1) :X2=X(K+1)
1390 Y1=Y(K-1) :Y2=Y(K+1)
1400 Z1=Z(K-1) :Z2=Z(K+1)
1410 GOSUB 1610 '*FRAC_FUNC
1420 X(K)=X:Y(K)=Y:Z(K)=Z
1430 NEXT K
1440 NEXT I
1450 FOR I=NDIM-1 TO 2 STEP -2
1460 FOR K=FNMIN(I) TO FNMAXIM(I)-1
1470 X1=X(K+I) :X2=X(K-I+1)
1480 Y1=Y(K+I) :Y2=Y(K-I+1)
1490 Z1=Z(K+I) :Z2=Z(K-I+1)
1500 GOSUB 1610 '*FRAC_FUNC
1510 X(K)=X :Y(K)=Y :Z(K)=Z
1520 NEXT K
1530 X1=X(K+I+1) :X2=X(K-I)
1540 Y1=Y(K+I+1) :Y2=Y(K-I)
1550 Z1=Z(K+I+1) :Z2=Z(K-I)
1560 GOSUB 1610  '*FHAC_FUNC
1570 PT1=FNMAXIM(I):X(PT1)=X:Y(PT1)=Y:Z(PT1)=Z
1580 NEXT I
1590 RETURN
1600 '
1610 '*FRAC_FUNC    ' X,Y <  X1.Y1-X2,Y2
1620 DX=ABS(X1-X2)
1630 DY=ABS(Y1-Y2)
1640 DZ=ABS(Z1-Z2)
1650 X=(X1+X2)/2+DX*.3*(RND-.5)
1660 Y=(Y1+Y2)/2+DY*.7*(RND-.5)
1670 Z=(Z1+Z2)/2+DZ*.4*(RND-.5)
1680 RETURN
1690 '
1700 ' *LDRAW LINE DRAW
1710 FOR I=1 TO NDIM-1
1720    FOR K=FNMIN(I) TO FNMAXIM(I)
1730      LINE (X(K)  ,Y(K))  -(X(K+I)  ,Y(K+I  ))
1740      LINE (X(K)  ,Y(K))  -(X(K+I+1),Y(K+I+1))
1750      LINE (X(K+I),Y(K+I))-(X(K+1+I),Y(K+1+I))
1760    NEXT K
1770 NEXT I
1780 RETURN
1790 '
1800 ' PAINT
1810 FOR I=1 TO NDIM-1
1820    FOR K=FNMIN(I) TO FNMAXIM(I)
1830      X1=X(K)    :Y1=Y(K)    :Z1=Z(K) :X2=X(K+I):Y2=Y(K+I):Z2=Z(K+I)
1835      X3=X(K+I+1):Y3=Y(K+I+1):Z3=Z(K+I+1)
1840      GOSUB 1920
1850      IF K=FNMAXIM(I) THEN 1880   'next
1860      X1=X(K)  :Y1=Y(K)  :Z1=Z(K) :X2=X(K+I+1) :Y2=Y(K+I+1) :Z2=Z(K+I+1)
1865      X3=X(K+1):Y3=Y(K+1):Z3=Z(K+1)
1870      GOSUB 1920
1880    NEXT K
1890 NEXT I
1900 RETURN
1910 '
1920 '*TRIANGLE
1930 X=(X1+X2+X3)/3:Y=(Y1+Y2+Y3)/3:Z=(Z1+Z2+Z3)/3
1940 S = ABS(X1*(Y2-Y3)+X2*(Y3-Y1)+X3*(Y1-Y2))/2:IF S<3 THEN 2060
1950 LINE (X1,Y1)-(X2,Y2),15
1960 LINE (X2,Y2)-(X3,Y3),15
1970 LINE (X3,Y3)-(X1,Y1),15
1980 ' brightness calc.
1990 DAX=X2-X1:DAY=Y2-Y1:DAZ=Z2-Z1:DBX=X3-X1:DBY=Y3-Y1:DBZ=Z3-Z1
2000 VX=DAY*DBZ-DAZ*DBY:VY=DAZ*DBX-DAX*DBZ:VZ=DAX*DBY-DAY*DBX
2010 VNRM=SQR(VX*VX+VY*VY+VZ*VZ):NX!=VX/VNRM:NY!=VY/VNRM:NZ!=VZ/VNRM
2020 BR=LX*NX+LY*NY+LZ*NZ:COL=INT(BR*PAL)
2030 IF COL<0 THEN COL=0 ELSE IF COL>PAL-1 THEN COL=PAL-1
2040 PAINT (X,Y),15,15
2050 PAINT (X,Y),COL,NOT 15:'時々ここでNO MEMORYエラーが出るが、その時は図形が複雑すぎるということで、re-runして
2060 RETURN
2990'
3000 ' *DEF_pattern
3010 RESTORE 3100
3020 FOR I=0 TO 8
3030 FOR K=1 TO 6
3040 READ D$
3050 C$(I)=C$(I)+CHR$(VAL("&H"+D$) )
3060 NEXT K
3070 NEXT I
3080 RETURN
3090 ' Tile Pattern Data
3100 DATA  00,00,00,00,00,00
3110 DATA  88,00,00,22,00,22
3120 DATA  AA,00,00,55,00,55
3130 DATA  88,00,88,22,00,22
3140 DATA  AA,00,AA,55,00,55
3150 DATA  77,00,77,DD,00,DD
3160 DATA  FF,AA,FF,FF,55,FF
3170 DATA  FF,77,FF,FF,DD,FF
3180 DATA  FF,FF,FF,FF,FF,FF

[重要]progloaderの使い方；今後サンプルの公開はこれで行います

progloaderはV3.00以降に内蔵されているサンプルプログラムです。

実はこのサンプルは極めて重要な意味を持っています。

プログラム自体は簡単です。
出てきたリストから選択し、「ダウンロード」を押すと・・・

そのプログラムがダウンロードされます。
その後progloaderを「終了」し、で閉じると、ダウンロードしたプログラムがプログラムリストで選択出来るようになります。
プログラムだけでなく、それに必要なデータファイルも入ります。

仕組みの詳細はあえて書きませんが「X-BASICのプログラムもデータと同じ」「.basという拡張子を持つデータがプログラム」ということです。

 Zipファイルはこちら : XBprogloader.zip
(下記リストファイルのサンプルを見るためのものです。プログラムそのものは内蔵されています。)


・・・仕組み・・・

この仕組みは、progloaderだけでは成り立ちません。

このプログラムを活用する＝ユーザー自身が自分のプログラム(とデータ)をダウンロードで入れ込みたい場合は、以下の準備が必要になります。

・プログラムがダウンロードできるサーバーを用意する
　http(s)でプログラムがダウンロードできるように、どこかに置いておく必要があります。

・どのようなプログラムがあるかを記載したリストファイルを置く

　リストファイルは以下の書式をもつUTF8のテキストファイルです。

　　プログラム名　　　zipファイル名

1行1プログラム分です。プログラム名はprogloader内で表示される名前で、zipファイル名は、それを選択した時にダウンロードされるzipファイルの名前です。X-BASICのプログラム選択で出てくる名前は、その中にある*.basのファイル名です。

それらの間は1つまたはそれ以上の半角スペースまたはタブで区切ります。

; で始まる行はコメントと見なされ、無視されます。

このリストファイルはサーバー側に置かれます。それはすなわち、progloaderを書き換えずとも、ダウンロードできるプログラムを増減できるということです。

・プログラムとデータを一緒に入れたzipファイルを置く

zipファイル内には通常*.basと必要なデータを入れておきます。

ディレクトリ構造付きでも構いません。その通りにX-BASIC for iOS内に展開されます。

なお、リストファイルとzipファイルは同じURLのフォルダ(？)に置きます。

・progloader.bas内にあるURLを書き換える

str baseURL="～"がそのURLです。

この説明を読んでも理解できない人は、使ってはいけません。

・・・注意・・・

これによって入れたプログラム本体は、プログラムリスト選択から「削除」出来ますが、

付随するデータは消されず、iOS内部に残り続けます＝記憶容量を食います。

なので、別途プログラムを書いて自分で削除するか、内蔵サンプルのfiler.basを使って削除してください。

・・・念のため・・・

念の為に書いておきますと、X-BASIC'にはiOSのシステムをハッキングできるような関数は一切ありません。どのようなプログラムを書いても、そのような用途には使えません。

・・・実は・・・

実はこのプログラムはV2.96公開時に入れ込むつもりでした。いえ、仕組み的に(中で使われている関数)は入れられていましたが、progloader自体を作るのに実に1年以上かかってしまいました。

ちょいと色々ありすぎて、プログラムが組めない状況というか心境にあったからです。

V3.00の開発を始めた時には、Objective-Cどころかあらゆるプログラムをかけるかどうか解からないような状態でしたが、この開発を通じて何とか感を取り戻せたようです。気力もだいぶ回復し、見た目以上にV3.00は気合の入った出来とすることが出来ました。

外部からプログラムを入れる手段を用意出来たことで、X-BASIC'が、単なる学習ツールから、自分でちょっと使うプログラムならこれで書けるんじゃない？ってなぐらいにはなったのではないかと自画自賛しています。まあ、癖は強いと思いますが。

また、非力な内蔵エディタでは書きづらいプログラムも、MacやWindows上の自分の使い慣れたものが使えるようになるので、開発も楽になるでしょう。実際のところ、私自身もプログラムはXcodeや秀丸で書いてましたので。

となると、後はデバッグ機能をなんとかせんといかんところですが、それは「実用する人が増えたら」ということで。

まずは、ご意見ご感想お待ちしています。

・・・今後・・・

progloaderができたので、今後サンプルプログラムの公開をこれ経由で行います。
時々RUNすると、新しいプログラムが入っている事があります。

・・・ProgSaver・・・
最新のアーカイブにはprogSaver.basも含まれています。
これは、プログラムを圧縮して電子メールで送信するプログラムです。
自作プログラムを外部に保存する場合はこれを使ってください。

サンプルのごめんなさい→ダウンロード可能になりました。progloaderを実行してください。

V2.9からはZipでのインポートができなくなったのに、公開しているサンプルの最近のもののほとんどが（ソースが大きいので）Zipのみ公開のままになってました。

BASICソースだけならzipを開いてソーステキストをカットアンドペーストで貼り付けていただければ入りますが、付随データファイルもあるので、それだけではうまく動きません。

あまりの忙しさにすっかり忘れてました。
すみません。

近日中に「代替案」を公開しますので、しばらくお待ちください。


2014/03/12追記：
またもや仕事忙しい、と言うか、通勤時間がそれまでの倍近くになってしまって全然時間が取れません。一応プログラムは書いたのですが、全然検証出来ない状態です。
すみません。

→ダウンロード可能になりました。progloaderを実行してください。

サンプル：ゲーム「digman」

 X1用のゲーム「DIGMAN」を移植しました。
 どことなくpitmanに似てますが、気のせいです(^_^;)。
「Oh!X 1990/5」よりの移植です。
もとネタがあるので、転載禁止です。

 Zipファイルはこちら:XBdigman.zip

サンプル：トランプゲーム 一人占い「ＴＥＮ」

iPad縦画面専用です(横画面は未検証)。



Zipファイル :XBten.zip

cTen.basがiOS用です。ten.basは、X-BASIC/68またはぺけ-BASIC用です。
どのように移植したかを示すための参照用として入れてあります。

サンプル：トランプゲーム７並べ

 

iPad縦画面専用です(横画面は未検証)。


Zipファイル :XB7.zip
c7.basがiOS用です。7.basは、X-BASIC/68またはぺけ-BASIC用です。
どのように移植したかを示すための参照用として入れてあります。

サンプル：トランプゲーム99

 

iPad縦画面専用です(横画面は未検証)。


Zipファイル :XB99.zip

c99.basがiOS用です。99.basと99patch.basは、X-BASIC/68またはぺけ-BASIC用です。
どのように移植したかを示すための参照用として入れてあります。

サンプルの完成度が低いとお嘆きの貴兄に

X-BASIC for iOS用の各種サンプルをあげていますが、
各サンプルの完成度がそれほど高くありません。
移植物の場合、元のできが悪いのではなく、移植の出来がよくない、という意味です。


特にほとんどのものがiPad画面専用なのは、手抜き以外の何者でもありません。
というか、X68やMZ由来のゲームはiPadぐらいの画面サイズがないと移植できません。

iPhone/iPod touchに対応するには、よほどそれに特化して作らないとだめで、その手間は今はかけられません。

操作性にも難はあるでしょうし、グラフィックがちゃちというのもあるでしょう。

カードゲームで札が画面に対して小さいとか縦長だとかいうのは、X68版のものをそのまま移植しているからです。サイズを変えると座標が変わってしまい、その合わせ込みは非常に大変なのです。

しかしすべては「サンプル」ということでお許しいただきたいです。
サンプルの主目的は、各種機能をたたいてデバッグすることにもありますので。

ソースもすべて公開しているので、不満があれば、各人で修正していただくのが正しい道です。
いいのができれば送っていただければ幸いかと<m(__)m>

なお、基本的に、サンプルはよほどのバグが見つからない限りバージョンアップしません。

サンプル：Z80アセンブラー「SuperBASE」

Z80アセンブラー「SuperBASE」を移植しました。

 「Ｉ／Ｏ別冊 ＷＩＣＳ・ＢＡＳＥプログラム集」のMZ-2000用をX1に移植したのが元で、
さらにそれをX68000のCに移植し、今回X-BASIC for iOSに移植しました。
このくらいのサイズのプログラムでも動くという証明用です。

BASICで記述しているのでそれなりに遅いですが、ちゃんとアセンブルできます。
遅いと言っても、実はX68000のC版よりか速かったりします。

SuperBASEはキャリーラボという会社が作った独自ニーモニックのZ80アセンブラーです。


それがどう言うものかは説明書を読んでください。

・・・こんな感じ・・・
;
; DSK-CZ V4.2
;
DRIVE EQU $FF87
ERRJP EQU $FF8A
DSKLD EQU $021A
PRET  EQU $01FB
RDDSK EQU $FF00
IBUFF EQU $0FE3
;
 OFFSET $A000
 START $0EF2 ;HTAB
;
REW
 CALL CDIR
 GOTO $0DEC
;
APSS1
 A=(DIR)
 A+ IF A<8 GOTO APS1
 A=(RDIR)
 A+ IF A>=32 GOTO APS2
 (RDIR)=A
APS2 A=0
APS1
 (DIR)=A
 RET
;
DLOAD
 [BC [HL [DE
 CALL TRNS
 DE=(REC)
 A=B IF A=0 GOTO DLAST
 CALL RDDSK IF CY GOTO DL3
 A=B A=A+H H=A
 DO !() DE+ UNTIL DEC(B)=0
 GOTO DLAST
;
FILE
 A=(7) IF A=40 GOTO $6200
 CALL $143C
 GOTO $61D3
;
; 0FE3-10E2 IBUFF
 START $10E8 ;Screen Edit
;
RDS
 DINT
 [BC [HL [DE
 [HL [AF
DN A=00 (DRIVE)=A
 HL=DSKER-RDS+RDDSK (ERRJP)=HL
 A=$1D PORT(0)=A
 ]AF ]HL
 CALL DSKLD
 CY=0
RD1
 A=$1E PORT(0)=A
 EINT
 GOTO PRET
DSKER
 CY=1
 GOTO RD1
RDE

・・・


X68版を作ったとき、関係者の人にお見せしたら喜んでらしたし、もう今更なので許していただきたいかと。

なお、V2.3以前のX-BASIC for iOSではバグのため正常に走りません。
必ず、V2.4以降にバージョンアップしてください。


Zipファイル :XBsbase.zip


転載禁止です。

サンプル：レーダースネーキー

ＭＺ－８０Ｋの傑作ゲーム、「レーダースネーキー」を移植しました。
しかも、ベタ移植です（本当は少しだけアレンジしてあるんだけど）。

昔はこんなゲームを楽しんでいたんだということを、
ある人はなつかしく、ある人とは新鮮な気持ちで知ってください。

「Ｉ／Ｏ別冊 ＷＩＣＳ・ＢＡＳＥプログラム集」よりの移植です。
もとネタがあるので、転載禁止です。

iPad縦画面のみ対応＋日英対応です。

Zipファイル :XBrs.zip

サンプル：人間対戦チェスプログラム

人間対戦のチェスプログラムです。

間違ってもコンピューターとの対戦など出来ません。
見た目も非常にシンプルです。

結局、中途半端なプログラムに終わっています。
適当に改良してください(^_^;)。

iPadの縦横画面および日英に対応しています。

Zipファイル :XBches.zip

これは珍しく完全自作なので、転載ほか、いかように使っていただいても結構です。

駒のパターンは、実はUnicodeにある文字フォントです。
Unicodeではこんなものまであるのです。
（チェスがあるのですから、トランプなんて当然あります。）

「グラフィックが表示できん」とお嘆きの貴兄に

外人で、「グラフィックが表示されんから金返せ」などと言う奴が居たのですよ。

取説にはグラフィックの表示手順についてちゃんとく書いたし、サンプルも多数出している。
その上ここでも何も聞かずにこんな馬鹿なこという奴は、きっと何を触っても何も出来ないのだろうと、あきれかえってしまうわけです。

ってなわけで、そんな奴は無視して、日本語だけで、グラフィック表示の仕方を簡単に説明します。

・・・まずは、取説からの抜粋・・・

グラフィック画面は4画面あります。それをページと呼びます。
どのページに描画するかはapage()、どのページを表示するかはvpage()、
テキスト画面、グラフィック画面およびスプライト&BG画面の表示順位はvpriority()で

設定します。

従って、グラフィックの描画プログラムは基本的に、

vpage()     表示ページ指定
vpriority() 表示優先順位指定

apage()     描画対象ページ指定
wipe()      クリア
    
gColor()    描画色指定
描画命令群

という順で記述することになります。

 ・・・
ということです。この手順を守れば、確実にグラフィックは表示できます。
これはX-BASIC/68でもほとんど同じです(優先順位指定と色指定が違うけど)。 

・・・例・・・

vpage(B_TPAGE+B_GPAGE0,YES)
vpriority(GPAGE0,TPAGE,GPAGE1,GPAGE2,GPAGE3)
apage(GPAGE0) 
wipe()
//
gColor(255,255,255,255)
line(0,0,100,100)
//
end

これで、(0,0)～(100,100)の間に白の直線を引きます。
描画しているのは、4ページあるグラフィック画面の内、GPAGE0のページです。

・・・

グラフィックを描画するプログラムを書く場合、グラフィックを1画面しか使わないのであれば、変更すべきはgColor()とline()の部分だけであって、他は定型として使い回せば良いのです。
何も難しいことはありません。

ある程度の手順を覚えなければならないことは、どの言語を使っても同じです。
いや、言語じゃなくてもアプリでも、それどころか世の中にある物全て、全く何も覚えずに使える物なんてないのです。

くれぐれも、何も努力をしないで「出来ないのは相手が悪い」などという愚かな発想に至らないように。

サンプル：ルナ・レスキュー

ＭＺ－８０Ｋの傑作ゲーム、「ルナ・レスキュー」を移植しました。
しかも、ベタ移植です（本当は少しだけアレンジしてあるんだけど）。

昔はこんなゲームを楽しんでいたんだということを、
ある人はなつかしく、ある人とは新鮮な気持ちで知ってください。

基本的には「Ｉ／Ｏ別冊　ＭＺ活用研究」よりの移植です。
もとネタがあるので、転載禁止です。


iPad縦画面のみ対応、日英対応です。

Zipファイル :XBlunar.zip

サンプル：新説？！桃太郎ゲーム

MZ-80K用の古いゲームの移植です。
 iPad縦画面のみ対応、日英対応です。

「Ｉ／Ｏ別冊　ＭＺ活用研究」からの移植で、転載禁止です。


Zipファイル :XBmomo.zip

サンプル：地底最大の作戦

MZ-80K用の古いゲームの移植です。
iPad縦画面のみ対応、日英対応です。

Oh!X1988/9からの移植で、転載禁止です。


Zipファイル :XBsnake.zip

サンプル:バネの物理的挙動をシミュレートするプログラム？

バネの物理的挙動をシミュレートするプログラム・・・だそうです。

// http://d.hatena.ne.jp/x68000forever/20101123/1290520018 より
// 画面初期化 / screen initialize
apage(0)
wipe()
vpriority(TPAGE,SPAGE,GPAGE0,GPAGE1,GPAGE2,GPAGE3)
vpage(B_TPAGE+B_SPAGE+B_GPAGE0)
gborder(1,CTHYELLOW)
int by=0
switch deviceType()
 case DEVICE_IPODTOUCH: // iPod touch
 case DEVICE_IPHONE: // iPhone
 case DEVIDE_IPHONE_SIMURATOR
  width(40)
  by=32
endswitch
//
int c1,c2,t
float l1,l2,l3,k,m
float a,b,c,w1,w2,w3,xx1,xx2,xx3,x1,x2,x3,r2=1.4142135623731#
//
print localizedString("変位1=","Displacement1=");:input l1
print localizedString("変位2=","Displacement2=");:input l2
print localizedString("変位3=","Displacement2=");:input l3
print localizedString("バネ定数=","Rate of spring=");:input k
repeat
 print localizedString("質量(>0)=","Mass(>0)=");:input m
until m>0
//
w1=pow((2-r2)*k/m,0.5#)
w2=pow(2*k/m,0.5#)
w3=pow((2+r2)*k/m,0.5#)
a=(l1+r2*l2+l3)/4
b=(l1-l3)/2
c=(l1-r2*l2+l3)/4
//
c1=x68Color2iOSColor(61376):// hsv(30,31,31))
c2=x68Color2iOSColor(55358):// hsv(100,31,31))
gColor(c2)
line(  0,288+by,511,288+by)
gColor(c1)
line(130,285+by,130,291+by)
line(255,285+by,255,291+by)
line(380,285+by,380,291+by)
sp_clr()
sp_disp(0)
sprite_pattern():sprite_pallet()
sp_disp(1)
//
repeat
 x1=a*cos(w1*t)+b*cos(w2*t)+c*cos(w3*t)
 x2=r2*a*cos(w1*t)-r2*c*cos(w3*t)
 x3=a*cos(w1*t)-b*cos(w2*t)+c*cos(w3*t)
 locate(0,5):print "t=";t
 locate(0,6):print "x1=";x1,"x2=";x2,"x3=";x3
 xx1=130+x1:xx2=255+x2:xx3=380+x3
 locate(0,7):print "xx1=";xx1,"xx2=";xx2,"xx3=";xx3
 sp_halt(YES)
 sp_move( 0,xx1-16,256+by, 0)
 sp_move( 1,xx1   ,256+by, 1)
 sp_move( 2,xx1   ,272+by, 2)
 sp_move( 3,xx1-16,272+by, 3)
 sp_move( 4,xx2-16,256+by, 4)
 sp_move( 5,xx2   ,256+by, 5)
 sp_move( 6,xx2   ,272+by, 6)
 sp_move( 7,xx2-16,272+by, 7)
 sp_move( 8,xx3-16,256+by, 8)
 sp_move( 9,xx3   ,256+by, 9)
 sp_move(10,xx3   ,272+by,10)
 sp_move(11,xx3-16,272+by,11)
 sp_halt(NO)
 if t=0 then wait(1)
 t=t+1
 wait(0.1)
until t>1000
end
//
func sprite_pattern()
 int i,j
 dim char sp1(255),sp2(255),sp3(255),sp4(255)
 sp1={
  0,0,0,0,0,0,0,0,0,0,4,4,4,4,5,5,
  0,0,0,0,0,0,0,0,4,5,5,5,5,5,6,6,
  0,0,0,0,0,0,0,4,5,6,6,6,6,6,6,6,
  0,0,0,0,0,4,5,6,6,6,6,7,7,7,7,7,
  0,0,0,0,4,5,6,6,7,7,7,7,8,8,8,8,
  0,0,0,4,5,6,7,7,7,8,8,8,8,8,9,9,
  0,0,4,4,6,6,7,8,8,8,8,9,9,9,9,10,
  0,0,4,5,6,7,8,8,9,9,9,9,10,10,10,10,
  0,4,4,6,6,7,8,9,9,10,10,10,10,11,11,11,
  0,4,5,6,7,8,8,9,10,10,11,11,11,11,12,12,
  4,5,6,6,7,8,9,9,10,11,11,12,12,12,12,13,
  4,5,6,7,7,8,9,10,10,11,12,12,13,13,13,13,
  4,5,6,7,8,8,9,10,10,11,12,13,13,14,14,14,
  4,5,6,7,8,8,9,10,11,11,12,13,14,14,15,15,
  4,6,6,7,8,9,9,10,11,12,12,13,14,15,15,15,
  5,6,6,7,8,9,10,10,11,12,13,13,14,15,15,15
 }
 sp4={
  5,6,6,7,8,9,10,10,11,12,13,13,14,15,15,15,
  4,6,6,7,8,9,9,10,11,12,12,13,14,15,15,15,
  4,5,6,7,8,8,9,10,11,11,12,13,14,14,15,15,
  4,5,6,7,8,8,9,10,10,11,12,13,13,14,14,14,
  4,5,6,7,7,8,9,10,10,11,12,12,13,13,13,13,
  4,5,6,6,7,8,9,9,10,11,11,12,12,12,12,13,
  0,4,5,6,7,8,8,9,10,10,11,11,11,11,12,12,
  0,4,4,6,6,7,8,9,9,10,10,10,10,11,11,11,
  0,0,4,5,6,7,8,8,9,9,9,9,10,10,10,10,
  0,0,4,4,6,6,7,8,8,8,8,9,9,9,9,10,
  0,0,0,4,5,6,7,7,7,8,8,8,8,8,9,9,
  0,0,0,0,4,5,6,6,7,7,7,7,8,8,8,8,
  0,0,0,0,0,4,5,6,6,6,6,7,7,7,7,7,
  0,0,0,0,0,0,0,4,5,6,6,6,6,6,6,6,
  0,0,0,0,0,0,0,0,4,5,5,5,5,5,6,6,
  0,0,0,0,0,0,0,0,0,0,4,4,4,4,5,5
 }
 for i=0 to 255
  sp3(i)=sp1(255-i)
  sp2(i)=sp4(255-i)
 next
 sp_def(0 ,sp1)
 sp_def(1 ,sp2)
 sp_def(2 ,sp3)
 sp_def(3 ,sp4)
 sp_def(4 ,sp1)
 sp_def(5 ,sp2)
 sp_def(6 ,sp3)
 sp_def(7 ,sp4)
 sp_def(8 ,sp1)
 sp_def(9 ,sp2)
 sp_def(10,sp3)
 sp_def(11,sp4)
endfunc
//
func sp_color2(pal;int,colX68;int,pb;int)
// X68の色コードでスプライトの色を設定する / set sprite color by X68 color
 sp_color(pal,x68Color2iOSColor(colX68),pb)
endfunc
//
func sprite_pallet()
 sp_color(  0,    0,1)://sp_color2( 0,    1,1)
 sp_color2( 1, 4229,1)
 sp_color2( 2, 8457,1)
 sp_color2( 3,12685,1)
 sp_color2( 4,19027,1)
 sp_color2( 5,23255,1)
 sp_color2( 6,27483,1)
 sp_color2( 7,31711,1)
 sp_color2( 8,35939,1)
 sp_color2( 9,40167,1)
 sp_color2(10,44395,1)
 sp_color2(11,48623,1)
 sp_color2(12,52851,1)
 sp_color2(13,57079,1)
 sp_color2(14,61307,1)
 sp_color2(15,65535,1)
endfunc

func str localizedString(js;str,es;str)
 if isLocalizeJapan() then return(js)
 return (es)
endfunc

Zip archive file: XBetc.zip