|
|
!クリックは、Graphic WINDOW 内の任意な場所で、
! 左押し→ 反転開始、動いている時に押し続けると 一時停止。
! 右押し→ プログラム終了。
!-------------------------
SET bitmap SIZE 501,501
! !401x401 501x501 641x641
SET TEXT font "",10 ! 8 10 11
LET pxw= 6 ! 5 6 7 !Pixels /問題座標ｘ単位
LET pyw= 9 ! 7 9 11 !Pixels / 〃 ｙ単位
!
ASK PIXEL SIZE(0,0;1,1) bmx,bmy
LET px=1/pxw !問題座標ｘ幅 /Pixel
LET py=1/pyw ! 〃 ｙ幅 /Pixel
LET ss=7 ! 〃 ｘ幅 /１人
DIM u( ss*3*pxw, 7*pyw+1)
DIM v( ss*8*pxw, 7*pyw+1), n$(0 TO 7)
MAT READ n$
DATA "head","neck","shoulder","abdomen","back","thigh","shin"," "
!
CALL act(0)
PLOT TEXT,AT ss*2, 17.0: "Right click to STOP"
PLOT TEXT,AT ss*2, 15.4: " Left click to TURN/PAUSE"
CALL act(1)
DO
mouse poll mx,my,ml,mr
IF ml=1 THEN
IF bak_t=1 THEN CALL act(2) ELSE CALL act(1)
END IF
WAIT DELAY 0
LOOP UNTIL mr=1
SUB act(t)
FOR st=1 TO 3 STEP 2
SET AREA COLOR 0
IF st=1 THEN LET k=16 ELSE LET k=44
SET WINDOW -(ss*st+2), bmx/pxw-px-(ss*st+2), -(bmy/pyw-py)+k,k
IF st=1 THEN LET i=i1 ELSE LET i=i3
IF st=1 THEN LET w$=w1$ ELSE LET w$=w3$
IF t=0 THEN CALL init08
IF t=1 THEN CALL left7
IF t=2 THEN CALL right8
IF st=1 THEN LET i1=i ELSE LET i3=i
IF st=1 THEN LET w1$=w$ ELSE LET w3$=w$
NEXT st
LET bak_t=t
END SUB
SUB init08
PLOT AREA: 0,7 ; 0,-7 ; ss*8-px,-7 ; ss*8-px,7 !clear image part
PLOT LINES: 0,0 ; 0, 7 ; ss*st-px, 7 ; ss*st-px,0 ; 0,0 !left upper around
PLOT LINES: ss*st,0 ; ss*st, 7 ; ss*8-px, 7 ; ss*8-px,0 ; ss*st,0 !right upper around
PLOT LINES: 0,-py; 0,-7-py; ss*8-px,-7-py; ss*8-px,-py !; 0,-py !all under around
LET w$=""
FOR i=0 TO 7
LET j=MOD(i*st,8) !← st=1／st=3 で doll の直線整列 散在を切換えている。
DRAW doll WITH SHIFT( i*ss+1, j-7)
LET w$=w$& n$(j)& " "
NEXT i
PLOT LINES: 0,-9; ss*8,-9; ss*8,-7.6; 0,-7.6; 0,-9 !text box
LET i=0
LET j=0
END SUB
SUB right8
MAT u=ZER( ss*st*pxw, 7*pyw+1)
ASK PIXEL ARRAY(i*ss,j+7) u ! right upper image
CALL move(u, 0, 1, 8) !↑ ( u(,), dx,dy, n)
CALL move(u,-1, 0, 8) !←
CALL move(u, 0,-1, 8) !↓
ASK PIXEL ARRAY(i*ss,j+7) v ! all upper image
CALL move(v, 1/7,0, st*7) !→ ( v(,), dx,dy, n)
PLOT AREA: px,py-9; ss*8-px,py-9; ss*8-px,-py-7.6; px,-py-7.6 !clear text box
END SUB
SUB left7
MAT u=ZER( ss*st*pxw, 7*pyw+1)
ASK PIXEL ARRAY(ss*i,j+7) v ! all upper image
CALL move(v, -1/7,0, st*7) !← ( v(,), dx,dy, n)
ASK PIXEL ARRAY(ss*i,j+7) u ! left upper image
CALL move(u, 0, 1, 8) !↑ ( u(,), dx,dy, n)
CALL move(u, 1, 0, 8) !→
CALL move(u, 0,-1, 8) !↓
PLOT TEXT,AT .8,-9: w$ !write text box
END SUB
SUB move( v(,), dx,dy, n)
LET w=SIZE(v,1)/(ss*pxw)
FOR k=1 TO n
MAT PLOT CELLS ,IN ss*(i+dx),7+j+dy; ss*(w+i+dx)-px,j+dy: v
IF 0< dy THEN PLOT AREA: ss*i,j ; ss*(i+w )-px,j ; ss*(i+w )-px,j+dy-py; ss*i,j+dy-py
IF dy< 0 THEN PLOT AREA: ss*i,j+7+dy+py; ss*(i+w )-px,j+7+dy+py; ss*(i+w )-px,j+7 ; ss*i,j+7
IF 0< dx THEN PLOT AREA: ss*i,j ; ss*(i+dx)-px,j ; ss*(i+dx)-px,j+7 ; ss*i,j+7
IF dx< 0 THEN PLOT AREA: ss*(i+w+dx),j ; ss*(i+w )-px,j ; ss*(i+w )-px,j+7 ; ss*(i+w+dx),j+7
CALL bwait(0)
LET i=i+dx
LET j=j+dy
NEXT k
END SUB
PICTURE doll
FOR h=0 TO 6
SET AREA COLOR 23+h
IF h< 2 THEN
PLOT AREA: 1,h; 2-px,h; 2-px,(h+1)-py; 1,(h+1)-py
PLOT AREA: 3,h; 4-px,h; 4-px,(h+1)-py; 3,(h+1)-py
ELSEIF h< 4 THEN
PLOT AREA: 1,h; 4-px,h; 4-px,(h+1)-py; 1,(h+1)-py
PLOT AREA: 0,h; 1-px*3,h; 1-px*3,(h+1)-py; 0,(h+1)-py
PLOT AREA: 5,h; 4+px*2,h; 4+px*2,(h+1)-py; 5,(h+1)-py
ELSEIF h=4 THEN
PLOT AREA: 0,h; 5-px,h; 5-px,(h+1)-py; 0,(h+1)-py
ELSEIF h=5 THEN
PLOT AREA: 2,5; 3-px,5; 3-px,6-py; 2,6-py
ELSEIF h=6 THEN
PLOT AREA: 1,h; 4-px,h; 4-px,(h+1)-py; 1,(h+1)-py
END IF
NEXT h
END PICTURE
SUB bwait(t) !default local value 't'
DO
mouse poll mx,my,ml,mr
IF 0< mr THEN STOP
IF 0< ml THEN LET t=.1
IF t<=0 THEN EXIT SUB
LET t=t-.1
WAIT DELAY .1
LOOP
END SUB
END
|
|