作者MiaoMi225 (口苗口米～)
看板CTSH96302
标题我又来了^^
时间Mon May 11 10:41:03 2009
program spring
use DFLIB
real(kind=8) x0,y0
type(wxycoord) position
TYPE (windowconfig) wc
TYPE (qwinfo) winfo
call frame
open(1,file='user',title='trajectory')
wc.numxpixels = 100
wc.numypixels = 120
wc.numtextcols = -1
wc.numtextrows = -1
wc.numcolors = -1
wc.fontsize =
#0008000C
ii = SETWINDOWCONFIG(wc)
winfo.TYPE = QWIN$SET
winfo.x=0
winfo.y=0
winfo.h=100
winfo.w=200
ii = SETWSIZEQQ(1, winfo)
xmin=0
xmax=100
ymin=-2
ymax=2
ii=setwindow(.true.,xmin,ymax,xmax,ymin)
ii=setbkcolor(15)
call clearscreen($gclearscreen)
open(2,file='user',title='protrait')
wc.numxpixels = 270
wc.numypixels = 320
wc.numtextcols = -1
wc.numtextrows = -1
wc.numcolors = -1
wc.fontsize =
#0008000C
ii = SETWINDOWCONFIG(wc)
winfo.TYPE = QWIN$SET
winfo.x=60
winfo.y=20
winfo.h=19
winfo.w=56
ii = SETWSIZEQQ(2, winfo)
xmin1=-2
xmax1=2
ymin1=-2
ymax1=1
dx=(xmax1-xmin1)/300
dy=(ymax1-ymin1)/300
ii=setwindow(.true.,xmin1,ymax1,xmax1,ymin1)
ii=setbkcolor(15)
call clearscreen($gclearscreen)
ii=setcolor(0)
call moveto_w(-0.2_8,0._8,position)
ii=lineto_w(0.2_8,0._8)
!ii=clickmenuqq(loc(winfullscreen))
ii=setcolor(9)
gamma=0.01
w0=1
dt=0.001
t=0
theta=1
v=0
x0=0
y0=0
l=1
x=l*sin(theta)
y=-l*cos(theta)
call moveto_w(x0,y0,position)
ii=lineto_w(x,y)
ii=setcolor(12)
ii=ellipse_w($gfillinterior,x-dx,y+dy,x+dx,y-dy)
do while(.true.)
ii=setactiveqq(2)
ii=setcolor(15)
call moveto_w(x0,y0,position)
ii=lineto_w(x,y)
ii=ellipse_w($gfillinterior,x-dx,y+dy,x+dx,y-dy)
t=t+dt
v=v+dt*(-2*gamma*v-w0*w0*theta)
theta=theta+v*dt
! Window 1
ii=setactiveqq(1)
ii=setcolor(9)
ii=setpixel_w(t,theta)
! Window 2
ii=setactiveqq(2)
x=l*sin(theta)
y=-l*cos(theta)
ii=setcolor(9)
call moveto_w(x0,y0,position)
ii=lineto_w(x,y)
ii=setcolor(12)
ii=ellipse_w($gfillinterior,x-dx,y+dy,x+dx,y-dy)
!call sleepqq(10)
enddo
end
subroutine frame
use DFLIB
TYPE (qwinfo) winfo
winfo.TYPE = QWIN$MAX
ii = SETWSIZEQQ(QWIN$FRAMEWINDOW, winfo)
return
end
--
※ 发信站: 批踢踢实业坊(ptt.cc)
◆ From: 140.120.148.4
1F：→ a606155123:这一篇文章值 1 银 05/11 10:58
2F：→ luiyilun:还好我没修 英文看不懂ˊˋ 05/11 20:38