( 8/27/1987)
forget it
: it ;

print " ... "

0 variable 㪨
0 variable ࠧ
0 variable ࠢ
2000 string 
2000 string 
0 variable .

500 string ਪ
30 string 樨
10 string 梥
10 variable 
( 0 variable x )
( 0 variable y )

5000 string ࠦ
255 0 ࠦ poke
5000 string 㣮
5000 variable .ࠧ
350 string 
0 variable 㪠⥫.㤠
40 string .ࠦ
1 variable 砫
1 variable 
0 variable 
0 variable 
16 variable 梥.䮭
1 variable 
1 variable ar
50 variable tr
5 variable sr
5 variable rr
0 variable sz
0 variable xt
0 variable yt
0 variable zt
0 variable xr
0 variable yr
0 variable zr
3 variable .
0 variable rg
0 variable ᥭ
64 variable ..
128 variable .ᮢ
0 variable ⥬
0 variable 
0 variable 
0 variable 
0 variable ᥪ
0 variable 
4 variable mode.sel

( : .६ ; )

HEX
: .६ 2c00 -> ax 21 int dx cx ;
: . 0 -> bx 300 -> ax 10 int dx -> 
             .६ dup 100 / -> 
                          ff and -> 
                       dup 100 / -> ᥪ
                          ff and ->  ;
: ६   0 -> bx  -> dx 200 -> ax 10 int .६
      dup 100 /  - abs dup 0a < if print " 0 " then . print " : "
         ff and  - abs dup 0a < if print " 0 " then .  spce
      dup 100 / ᥪ - abs dup 0a < if print " 0 " then . print " : "
         ff and  - abs dup 0a < if print " 0 " then .  spce ;
DECIMAL

: . begin getkey 0 = until 0 -> . ;

: . ( getkey if 1 -> . then )
                getkey dup -> . drop ;

: । 0 72 move 319 136 box ;

: 
  50 0 do rnd abs 320 mod
           rnd abs 160 mod plot
           rnd abs 4   mod gcolor loop ;

: ४ 1 gcolor 0 80 move 319 80 line 160 0 move 160 159 line ;

: .
  10 0 do rnd abs 300 mod i 2 * 樨 pokew loop
  10 0 do rnd abs 3 mod 1 + i 梥 poke loop ;

: .ਪ
  i 梥 peek gcolor
  i 32 * 4 +          ( x )
  i 2 * 樨 peekw ( y )
  move 0 ਪ putblk ;

: ᯫ
  .ਪ
  i 2 * 樨 dup
  peekw  -
  dup -36 < if 250 + then
  swap pokew
  .ਪ ;

: 
  10 0 do .ਪ loop ;

: 
  exmode  0 begin 1 +
  10 0 do ᯫ loop
  . dup 100 > . or until drop ;

: . 
  0  begin
  dup peek 0 <> while
  3 + repeat ;

: 横
  0  (  砫 )
  . 1 + (   )
  pokew ; (   砫 모    )

: 㧨.
  0  1999 memory read " bourree2.mus "
  横 ;

: 
  0 do 0 begin 1 + dup 1075 > . . or until loop ;

: ᮢ
  (  )
  . . 0 = if draw then ;

: ᮢ 
  0 begin
  ᮢ
  dup 390 >= . . or until drop ;

:  
  10 begin
  10 + dup yrot dup xrot ᮢ
  dup 390 >= . . or until drop ;

: 㧨
  pad concat " .img " object dup objadr
  1999 memory pad -> read
  100 scale off ;

: 㧨.ꥪ
  objerase pad assign " soyuz " 0  0 㧨 ;

:  0 = ;

: num.lock.몫 64 segment
  23 dup peek 223 and swap poke
  24 dup peek  32  or swap poke
  local segment ;

: .getc num.lock.몫 getc ;

: .
  2 , 676 ,,
  2 , 845 ,,
  0 , 0 ,, ;

:  ' . -> play ;

: .㪢 dup 96 > if 32 - then ;

: .⮢ 
  num.lock.몫
  2816 -> ax 33 int
  ax 1 and ;

: ᮢ.. 
  .⮢ if else draw then ;

: . print " (  ) " .getc drop ;

: .᫮ num.lock.몫 pad readln
  pad getnum valid
  if else drop then valid ;

( :  1 ->  0 keymode 1 autorun abort ; )
( :  xr ar - dup -> xr ; )  ( F1 )
( :  xr ar + dup -> xr ; )
( :  yr ar + dup -> yr ; )
( :  yr ar - dup -> yr ; )
( :  zr ar - dup -> zr ; )
( :  zr ar + dup -> zr ; )
( :  yt 100 - dup -> yt ; )
( :  yt 100 + dup -> yt ; ) ( F8 )
( :  rg dup abs rr > if dup rr / + else drop rg 1 + then dup -> rg range ; )
( :  rg dup abs rr > if dup rr / - else drop rg 1 - then dup -> rg range ; )
( : [ sz 1 - dup -> sz scalz  ; )
( : ] sz 1 + dup -> sz scalz  ; )
( :  zt tr + dup -> zt ztran ; )
( :  zt tr - dup -> zt ztran ; )
( :  xt tr + dup -> xt xtran ; )
( :  xt tr - dup -> xt xtran ; )
( :  yt tr + dup -> yt ytran ; )
( :  yt tr - dup -> yt ytran ; )
( :  exmode 160 80 plot ormode ; )
: x xr dup 370 + swap 10 + do i xrot draw 10 +loop ;
: y yr dup 370 + swap 10 + do i yrot draw 10 +loop ;
: z zr dup 370 + swap 10 + do i zrot draw 10 +loop ;

: ᪠
  mode.sel mode
  2 38 20 24 window 20 vtab 10 htab cr
 梥.䮭  1 color print "  F1,2=X F3,4=Y F5,6=Z " cr
 梥.䮭  2 color print "    F7,8=X F9,10=Y " cr cr
 梥.䮭  3 color
 0 165 move 319 199 box ;

:  0 -> play 2 mode abort ;
: -xr xr  ar - dup -> xr  ;
: +xr xr  ar + dup -> xr  ;
: +yr yr  ar + dup -> yr  ;
: -yr yr  ar - dup -> yr  ;
: -zr zr  ar - dup -> zr  ;
: +zr zr  ar + dup -> zr  ;
: -yt yt ar - dup -> yt  ;
: +yt yt ar + dup -> yt  ;
: -xt xt ar - dup -> xt  ;
: +xt xt ar + dup -> xt  ;

: .
  getkey dup -> . dup 128 < if 49 - else 187 - then
   dup 10 < over -1 > and if
          case:
            -xr +xr
            +yr -yr
            -zr +zr
            -xt +xt
            -yt +yt
          then
       then drop ;

:  
  ᪠
  1 sequence ( 0 autorun ) 1 keymode 1 ->  ;

: ᭮
 ( 0 ਪ 499 memory read " balloon.blk " )
  pad 126 + peek 78 = if 0 else 1 then -> 㪨
  .
  㧨.ꥪ
  㧨.
  . 0 = if 㪨 if 0  -> play then then
  (  )
  ar rnd  5 mod * -> xr
  ar rnd  5 mod * -> yr
  ar rnd  5 mod * -> zr
  ar rnd 60 mod * -> xt
  ar rnd 50 mod * -> yt
  ᪠ .  ४ ᮢ
  0 sequence 
  exmode
 ( .  )
  0 5000 do 
   . . dup 128 > if
    160 xt + xpos
    100 yt + ypos
    i zr * zrot
    i yr * yrot
    i xr * xrot
    4000 i + range
    draw
  else
   bell  
   ४ ६ ᮢ (  )
  then drop
 -10 +loop
 ( .  )
 1 sequence 0 -> play 2 mode ;
close run
