TL/1 Programming in 21st century：レトロコンピュータピープル〔別館〕：SSブログ

	ブログをはじめるログイン

遠い過去の物となってしまった８／１６ビット時代のパソコンとゲームに関するブログです。

初めての方でも気軽にコメントしてください。

また、過去の記事にもコメントして頂ければありがたいです。

: nice! 111
記事 110
テーマパソコン・インターネット
プロフィール
ブログを紹介する
ブログを紹介する
ログインすると自身のブログで本ブログを紹介できます

過去の遺産という形でゲームの画面イメージ、パッケージ、マニュアル等を取り上げておりますが、もし不都合がございましたら「プロフィール」に記してあるメールアドレスよりご連絡頂けますようお願いいたします。

日	月	火	水	木	金	土
	1	2	3	4	5	6
7	8	9	10	11	12	13
14	15	16	17	18	19	20
21	22	23	24	25	26	27
28	29	30

RSS1.0 | RSS2.0

謹賀新年｜TL/1 の逆襲【こそっと変更】ブログトップ

TL/1 Programming in 21st century　[プログラム] [編集]

日頃からレトロなネタを求めてネットをうろつく事が多いのですが、パソコン用の古い言語関連の情報って本当に少ないですね…。
たまに見つかる事があっても、実際に使用してみた感想というより、ネットから拾い集めた情報の要約のようなものが多い事が残念です。

昨日見つけたサイトの TL/1 に関する説明は「変数がバイト型だけ」とか「コンパイルは速い」とか、どうにもマイナスイメージの付きまとう書き方になっていました。（たぶん私の見方が歪んでいるせいでしょうが＾＾；）
こういう書き方をされると、「8 ビット CPU では、16 ビット演算ができない」と言われたのと同じように感じてしまうのですが……。
「果たしてこのサイトの作者は TL/1 でプログラムを書いた事があるのか？」と訝ってしまいます。

それはさておき

これまでのデモ作成関係の記事へは、こちらからどうぞ。

「久しぶりだ…」

「デモ作成中…毒」

「デモを公開しました」

次回は、実行形式のバイナリデータ（T88 形式）を公開する予定です。
こっちじゃ無理なので〔本館〕になりますが、こちらでもお知らせします＾＾

☆

デモ作りを始めたのには、↑↑で書いたようにネットではあまり良い印象のない TL/1 の実力を知ってもらいたかったからなのですが、デモ動画の公開だけでは TL/1 の実力を示した事にはなりませんので、今回はデモのソースファイルを公開します。

このソースは TL/1-PC（PC-8001用）を元に PC-8801 のグラフィック機能を活用できるように KCB が独自に拡張した TL/1-88G によって書かれています。

TL/1-PC との相違点は、

BASIC の REM 文を使用してソースを格納する方法を使用していないので、行番号の後ろに ' （アポストロフィ）が付かない
'begin', 'end' が多くなると可読性が低下するため '[' や ']' を使用できるように拡張されている
PC-8801 のグラフィック機能が使用できるように、組込みプロシージャ（gmode(), hline(), hpset(), hpoint() 等）が追加されている
Super-text 機能が使用できるように 'write()' プロシージャのファイル番号が追加されている

等が挙げられます。

そのため、そのままの状態では TL/1-PC や他の TL/1 処理系ではコンパイルが通りませんので、ご了承ください。
また、このソースはプロトタイプとして Windows 上のエディタで作成したものです。
あっ、TL/1-PC のソースでは付いているはずの行番号が付いていませんねA＾＾；
PC-8801 のソースと相違点が無いかチェックをしておりますが、漏れがあるかもしれません。
その点も重ねてご了承ください。

ソース全体で 400 行程度ありますので、読む心構えのある方だけ↓の「続きを読む」をクリックしてください。

%
% Demonstration for Retro Computer People
%
%   Created by Thunderbolt
%
%   Copyright (c) Kyoto Computer Brains/Thunderbolt
%
proc logoRCP,announce,
     logoR,logoC,logoP,laser,step,
     laserV,laserH,laserT,laserVC,laserHC,laserVCB,laserHCB,laserRsp,
     star,starfall,flash,initstar,rndstar,delay
%
var xh,xl,y,oxh,oxl,oy,lcol,dcol,q
array st[30],stxh[30],stxl[30],sty[30]
%
begin
%
  locate(0,0,0) color(7,0,0) width(40,25)
  console(0,25,0,1) color(7,0,0)
  gmode(0,$50,0)
  q:=0
  while q=0 do [
    cls delay(50)
    logoRCP
    announce
    q=neg(port(8)).and.$40
  ]
  cls
  width(80,25) locate(0,24,1) stop
end
%
logoRCP
  begin
    lcol:=2 dcol:=6
    oxh:=0 oxl:=$64 oy:=199 %% $064=100
    logoR
    oxh:=1 oxl:=$2C oy:=199 %% $12C=300
    logoC
    oxh:=1 oxl:=$F4 oy:=199 %% $1F4=500
    logoP
  end
%
logoR
  begin
    xh:=0 xl:=40 y:=147
    laserV(44)
    laserVC(1,255)
    laserH(0,192)
    laserHC(1,1)
    laserV(75)
    laserRsp
    laserH(0,192)
    laserHC(1,1)
    laserV(145)
    laserVC(255,1)
    laserH(0,126)
    laserHC(255,255)
    laserV(102)
    laserVCB(255,255)
    laserH(0,76)
    laserHCB(255,1)
    laserV(147)
    laserT(255,1)
    xh:=0 xl:=119 y:=71
    laserV(61)
    laserVCB(1,255)
    laserH(0,163)
    laserHCB(1,1)
    laserV(71)
    laserVCB(255,1)
    laserH(0,144)
    laserHCB(255,255)
  end
%
logoC
  begin
    xh:=0 xl:=240 y:=145
    laserV(44)
    laserVC(1,255)
    laserH(1,$88)   %% 392
    laserHC(1,1)
    laserV(80)
    laserVC(255,1)
    laserH(1,$47)   %% 327
    laserHC(255,255)
    laserV(61)
    laserVCB(255,255)
    laserH(1,$14)   %% 276
    laserHCB(255,1)
    laserV(128)
    laserVCB(1,1)
    laserH(1,$27)   %% 295
    laserHCB(1,255)
    laserV(95)
    laserVC(1,255)
    laserH(1,$88)   %% 392
    laserHC(1,1)
    laserV(145)
    laserVC(255,1)
    laserH(0,247)
    laserHC(255,255)
  end
%
logoP
  begin
    xh:=1 xl:=$B8 y:=145  %% 440
    laserV(44)
    laserVC(1,255)
    laserH(2,$50)   %% 592
    laserHC(1,1)
    laserV(113)
    laserVC(255,1)
    laserH(2,$0F)   %% 527
    laserHC(255,1)
    laserV(145)
    laserVC(255,1)
    laserH(1,$BF)   %% 447
    laserHC(255,255)
    xh:=2 xl:=$07 y:=96   %% 519
    laserV(61)
    laserVCB(1,255)
    laserH(2,$33)   %% 563
    laserHCB(1,1)
    laserV(96)
    laserVCB(255,1)
    laserH(2,$20)   %% 544
    laserHCB(255,255)
  end
%
laserRsp
  begin
    step( 255,1)
    laser(  0,1)
    laser(  0,1)
    laser(255,1)
    laser(  0,1)
    laser(255,1)
    laser(255,1)
    laser(255,1)
    laser(255,0)
    laser(255,1)
    laser(255,1)
    laser(255,0)
    laser(255,1)
    laser(255,0)
    laser(255,0)
    laser(255,1)
    laser(255,0)
    step(   2,1)
  end
%

laserV(gy)
  begin
    if y<gy then [
      while y<gy do
        laser(0,1)
      laser(0,1)   step(0,255) ]
    else [
      while y>gy do
        laser(0,255)
      laser(0,255) step(0,1)   ]
  end
%
laserH(gxh,gxl)
  var dir,ext
  begin
    dir:=255 ext:=false
    if xh<gxh then
      dir:=1
    else
      if (xh=gxh).and.(xl<gxl) then
        dir:=1
    if dir=1 then
      while ext=false do [
        laser(dir,0)
        if xh>gxh then
          ext:=true
        else
          if (xh=gxh).and.(xl>gxl) then
            ext:=true
      ]
    else
      while ext=false do [
        laser(dir,0)
        if xh<gxh then
          ext:=true
        else
          if (xh=gxh).and.(xl<gxl) then
            ext:=true
      ]
    step(0-dir,0)
  end
%
laserT(hdir,vdir)
  begin
    step( hdir,vdir)
    laser(hdir,   0)
    laser(hdir,vdir)
    laser(hdir,   0)
    laser(hdir,   0)
    laser(hdir,   0)
    laser(hdir,   0)
    laser(hdir,   0)
    laser(hdir,0-vdir)
    laser(hdir,   0)
    laser(hdir,0-vdir)
  end
%
laserVC(hdir,vdir)
  begin
    step( hdir,vdir)
    laser(hdir,vdir)
    laser(hdir,   0)
    laser(hdir,vdir)
    laser(hdir,   0)
    laser(hdir,   0)
    laser(hdir,vdir)
  end
%
laserHC(hdir,vdir)
  begin
    step(hdir,vdir)
    laser(hdir,   0)
    laser(hdir,   0)
    laser(hdir,vdir)
    laser(hdir,   0)
    laser(hdir,vdir)
    laser(hdir,vdir)
  end
%
laserVCB(hdir,vdir)
  begin
    step( hdir,vdir)
    laser(   0,vdir)
    laser(   0,vdir)
    laser(hdir,vdir)
    laser(   0,vdir)
    laser(hdir,vdir)
    laser(hdir,vdir)
    laser(hdir,vdir)
    laser(hdir,vdir)
    laser(hdir,   0)
    laser(hdir,vdir)
    laser(hdir,vdir)
    laser(hdir,   0)
    laser(hdir,vdir)
    laser(hdir,   0)
    laser(hdir,vdir)
    laser(hdir,   0)
    laser(hdir,   0)
    laser(hdir,vdir)
    laser(hdir,   0)
    laser(hdir,   0)
    laser(hdir,vdir)
    laser(hdir,   0)
    laser(hdir,   0)
    laser(hdir,   0)
    laser(hdir,   0)
    laser(hdir,   0)
    laser(hdir,vdir)
  end
%
laserHCB(hdir,vdir)
  begin
    step( hdir,vdir)
    laser(hdir,   0)
    laser(hdir,   0)
    laser(hdir,   0)
    laser(hdir,   0)
    laser(hdir,   0)
    laser(hdir,vdir)
    laser(hdir,   0)
    laser(hdir,   0)
    laser(hdir,vdir)
    laser(hdir,   0)
    laser(hdir,   0)
    laser(hdir,vdir)
    laser(hdir,   0)
    laser(hdir,vdir)
    laser(hdir,   0)
    laser(hdir,vdir)
    laser(hdir,vdir)
    laser(hdir,   0)
    laser(hdir,vdir)
    laser(hdir,vdir)
    laser(hdir,vdir)
    laser(hdir,vdir)
    laser(   0,vdir)
    laser(hdir,vdir)
    laser(   0,vdir)
    laser(   0,vdir)
    laser(hdir,vdir)
  end
%
laser(hdir,vdir)
  begin
    hline(oxh,oxl,oy,xh,xl,y,lcol)
    hline(oxh,oxl,oy,xh,xl,y,lcol)
    hpset(xh,xl,y,dcol)
    step(hdir,vdir)
  end
%
step(hdir,vdir)
  begin
    case hdir of
      $1  [ xl:=xl+1 xh:=xh.adc.0 ]
      $ff [ xl:=xl-1 xh:=xh.sbc.0 ]
    else []
    y:=y+vdir
  end
%
announce
  var yp,xcol,scol,fcol
  begin
    initstar
    yp:=21 xcol:=1 scol:=5 fcol:=7
    gcolor(xcol)
    starfall( 4,scol) locate( 8,yp,0)
    write(1:"Japanese ancient PC database")
    starfall(15,scol) locate( 8,yp,0)
    write(1:"                            ")
    starfall( 2,scol) locate( 8,yp,0)
    write(1:"For ex-microcomputer boys")
    starfall(15,scol) locate( 8,yp,0)
    write(1:"                         ")
    starfall( 2,scol) locate(10,yp,0)
    write(1:"RetroComputerPeople")
    flash(xcol,fcol,scol)
    starfall(10,scol)
%   flash(xcol,fcol,scol)
                      locate(10,yp,0)
    write(1:"                   ")
    starfall( 2,scol) locate( 7,yp,0)
    write(1:"www.geocities.jp/retro_zzz/")
    starfall(10,scol) locate( 7,yp,0)
    write(1:"                           ")
    starfall(20,scol)
  end
%
delay(t)
  var i,j,k
  begin
    for j:=0 to t do
      for i:=0 to 255 do
        k:=t
  end
%
flash(cc,fc,sc)
  begin
    star(sc)
    palet(cc,fc)
    star(sc)
    palet(cc,cc)
  end
%
initstar
  var i
  begin
    for i:=0 to 29 do [
      sty[i]:=rnd(199)
      rndstar(i)
    ]
  end
%
%
rndstar(i)
  begin
    stxh[i]:=(rnd(5)-1)/2
      if stxh[i]=2 then
        stxl[i]:=rnd(127)
      else
        stxl[i]:=rnd(255)
  end
%
star(c)
  var i
  begin
    for i:=0 to 29 do [
      if st[i]=true then [
        hpset(stxh[i],stxl[i],sty[i],0) st[i]:=false ]
      if sty[i]=199 then [
        sty[i]:=0
        rndstar(i) ]
      else
        sty[i]:=sty[i]+1
      if hpoint(stxh[i],stxl[i],sty[i])=0 then [
        hpset(stxh[i],stxl[i]sty[i],c) st[i]:=true ]
    ]
  end
%
starfall(t,c)
  var i,j
  begin
    for i:=o to t do
      for j:=0 to 10 do
        star(c)
  end
%
% end of program

タグ：TL/1 PC-8801 PC-8001 デモ

2010-01-08 03:48 nice!(0) コメント(5) トラックバック(0)
共通テーマ：パソコン・インターネット

nice! 0

TL/1-PC使ってました。構造化プログラミングが出来て、コンパクトで実行が早いから、愛用していましたよ。
ゲームとかだと、16bitが必要なのってスコアぐらいで、あとは8bitでほとんど事足りた気がします。高級言語なのにadcとかあるところが笑えた気が（笑）
エディタも慣れ親しんだBASICのエディタが使えたし、けっこう気に入ってました。
by yasuho (2010-01-08 12:49)

yasuhoさん、いつもコメントありがとうございます。
今年もよろしくお願いいたします＾＾

>構造化プログラミングが出来て、コンパクトで実行が早いから、愛用していましたよ。
やっと仲間が見つかったようで嬉しいです＾＾

>高級言語なのにadcとかあるところが笑えた気が（笑）
変数の範囲が 0~255 までなので、255 以上の値を計算しようとすると 'adc' と 'sbc' が必要不可欠ですね。
デモ作成時にも、お世話になりました（笑）
若い人には 'adc' って言ってもわかんないんだろうなぁ。
'adc', 'sbc' はオッサン世代限定演算子なんでしょうね(T_T)
by Thunderbolt (2010-01-08 19:56)

あ、でもAtmelのAVRプロセッサにはキャリー付き加減算があるようなので、組み込みな人には分かるかも。

こちらこそ今年もよろしくお願いします。

by yasuho (2010-01-10 15:31)

>AtmelのAVRプロセッサにはキャリー付き加減算があるようなので
そうなんですか…組み込み方面は随分ご無沙汰なので知りませんでしたＡ＾＾；

なんか、また、組み込み系やりたいような…（笑）

by Thunderbolt (2010-01-10 23:12)

記事中のプログラムに 3 箇所の間違いを発見したので報告します。

- メインプログラム中の q=neg(port(8)).and.$40 は代入文であるべき箇所なのに比較演算子になってます。
- star 内の最後の方にある hpset(stxh[i],stxl[i]sty[i],c) で引数を区切るカンマが抜けてます。
- starfall 内の for i:=o to t do は i を o (オー) で初期化しようとしていますが 0 (ゼロ) の間違いではないでしょうか。

実際に動く処理系も機械も持っていないのですが、処理系はこの間違いを報告しないのでしょうか？
by 齊藤 (2015-03-05 23:32)

コメントを書く

トラックバック 0

謹賀新年｜TL/1 の逆襲【こそっと変更】ブログトップ

レトロコンピュータピープル〔別館〕

Thunderbolt さん

カレンダー

最近のコメント

最新記事一覧

月別表示

マイカテゴリー

タグクラウド