p16col.tpl

在手机操作系统symbina上使用的一个脚本扩展语言的代码实现,可以参考用于自己的开发

proc tgorderandrank:
	local w%,h%,ida%(4),r%,i%
	print "Test gORDER and gRANK"
	pause%:(20)
	rem create several windows to use for this first
	w%=gwidth : h%=gheight
	ida%(1)=gcreate(0,0,w%,h%,1,2)
	gborder 1
	ida%(2)=gcreate(w%/4,h%/4,gwidth/2,gheight/2,1,2)
	gborder 1
	ida%(3)=gcreate(3*w%/8,3*h%/8,gwidth/2,gheight/2,1,2)
	gborder 1
	ida%(4)=gcreate(7*w%/16,7*h%/16,gwidth/2,gheight/2,1,2)
	gborder 1
	
	gorder 1,1
	guse 1
	r%=grank
	if r%<>1 : raise 100 : endif
	i%=1
	while i%<5
		guse ida%(i%)
		r%=grank 
		if r%<>(6-i%)
			hLog%:(khLogAlways%,"ERROR: gRANK "+GEN$(r%,3)+" <> expected "+GEN$(6-i%,3))
			rem raise i%
		endif
		i%=i%+1
	endwh
	
	i%=1
	while i%<5
		gorder ida%(i%),i%
		i%=i%+1
	endwh	
	guse 1
	r%=grank
	if r%<>5 : raise 200 : endif
	i%=1
	while i%<5
		guse ida%(i%)
		r%=grank 
		if r%<>i% : raise i% : endif
		i%=i%+1
	endwh

	i%=1
	while i%<5
		gorder ida%(i%),5-i%
		i%=i%+1
	endwh	
	guse 1
	r%=grank
	if r%<>5 : raise 300 : endif
	i%=1
	while i%<5
		guse ida%(i%)
		r%=grank 
		if r%<>(5-i%) : raise i% : endif
		i%=i%+1
	endwh
	get%:
	i%=1
	while i%<5 
		gclose ida%(i%)
		i%=i%+1
	endwh
	cls
endp

proc tgorigin:
	local x%,y%
	print "Test gORIGINX and gORIGINY"
	pause%:(20)
	id1%=gcreate(0,0,gwidth,gheight,1,2)
	gborder 1
	id2%=gcreate(350,100,100,50,1,2)
	gborder 1
	x%=goriginx : y%=goriginy
	if (x%<>350 or y%<>100) : raise 1 : endif
	guse id1%
	x%=goriginx : y%=goriginy
	if (x%<>0 or y%<>0) : raise 2 : endif
	pause%:(20)
	gclose id1% : gclose id2%
	cls
endp

proc tgpatt:
	print "Test gPATT"
	print "Setting pixels:"
	print "First using two 16-colour windows"
	pattern:(2,2,0)
	print "Now using pattern in a 4-colour window copied to a 16-colour window"
	pattern:(2,1,0)
	print "Now using pattern in a 16-colour window copied to a 4-colour window"
	pattern:(1,2,0)
	print "Now using pattern in a 2-colour window copied to a 16-colour window"
	pattern:(2,0,0)
	print "Now using pattern in a 16-colour window copied to a 2-colour window"
	pattern:(0,2,0)	
	print "Clearing pixels: (on black)"
	print "First using two 16-colour windows"
	pattern:(2,2,1)
	print "Now using pattern in a 4-colour window copied to a 16-colour window"
	pattern:(2,1,1)
	print "Now using pattern in a 16-colour window copied to a 4-colour window"
	pattern:(1,2,1)
	print "Now using pattern in a 2-colour window copied to a 16-colour window"
	pattern:(2,0,1)
	print "Now using pattern in a 16-colour window copied to a 2-colour window"
	pattern:(0,2,1)
	print "Inverting pixels: (on black)"
	print "First using two 16-colour windows"
	pattern:(2,2,2)
	print "Now using pattern in a 4-colour window copied to a 16-colour window"
	pattern:(2,1,2)
	print "Now using pattern in a 16-colour window copied to a 4-colour window"
	pattern:(1,2,2)
	print "Now using pattern in a 2-colour window copied to a 16-colour window"
	pattern:(2,0,2)
	print "Now using pattern in a 16-colour window copied to a 2-colour window"
	pattern:(0,2,2)	
	print "Replacing pixels: (on black)"
	print "First using two 16-colour windows"
	pattern:(2,2,3)
	print "Now using pattern in a 4-colour window copied to a 16-colour window"
	pattern:(2,1,3)
	print "Now using pattern in a 16-colour window copied to a 4-colour window"
	pattern:(1,2,3)
	print "Now using pattern in a 2-colour window copied to a 16-colour window"
	pattern:(2,0,3)
	print "Now using pattern in a 16-colour window copied to a 2-colour window"
	pattern:(0,2,3)	
	cls
endp

proc pattern:(m1%,m2%,mode%)
	pause%:(20)
	id1%=gcreate(0,0,gwidth,gheight,1,m1%)
	id2%=gcreate(0,0,gwidth,40,1,m2%)
	stripes:(0)
	get%:
	gorder id1%,1
	guse id1%
	if mode%<>0
		gcolor 0,0,0
		gfill gwidth,gheight,0
	endif
	gpatt id2%,gwidth,gheight,mode%
	get%:
	gclose id1% : gclose id2%
endp

proc tgpoly:
	local a%(20)
	print "Test gPOLY"
	pause%:(20)
	id1%=gcreate(0,0,gwidth,gheight,1,2)
	a%(1)=20 : a%(2)=20
	a%(3)=4
	a%(4)=200 : a%(5)=0
	a%(6)=0 : a%(7)=100
	a%(8)=-200 : a%(9)=0
	a%(10)=0 : a%(11)=-100
	gcolor $0,$0,$0
	gpoly a%()
	a%(1)=140 : a%(2)=20
	gcolor $30,$30,$30
	gpoly a%()
	a%(1)=260 : a%(2)=20
	gcolor $70,$70,$70
	gpoly a%()
	a%(1)=380 : a%(2)=20
	gcolor $C0,$C0,$C0
	gpoly a%()
	a%(1)=500 : a%(2)=20
	gcolor $F0,$F0,$F0
	gpoly a%()
	get%:
	gclose id1%
	cls
endp

proc tgprint:
	local wp%,wc%,text$(200)
	print "Test text printing"
	pause%:(20)
	id1%=gcreate(0,0,gwidth,gheight,1,2)
	gfill gwidth,gheight,0
	gat 5,20
	gprintB "Text in a cleared box of half screen-width",gwidth/2
	gat 5,40
	gprintB "Centred in a cleared box of full screen-width",gwidth,3
	gat 5,60
	gprintB "This is right-aligned",gwidth/2,1
	gat 5,80
	gprintB "This is left-aligned",gwidth/2,2
	gat 5,105
	gprintB "Top clearance 5, bottom clearance 10",gwidth/2,2,5,10
	gat 5,145
	gprintB "This is centred, m%=200",gwidth,3,0,0,200
	gat 5,165
	gprintB "This is centred, m%=-200",gwidth,3,0,0,-200
	gat 5,185
	gprintB "This is right-aligned, m%=30",gwidth,1,0,0,30
	gat 5,205
	gprintB "This is left-aligned, m%=10",gwidth/2,2,0,0,10
	get%:
	gcls
	gat 5,20
	wc%=gprintclip("This text will be too long to fit in the width allowed",200)
	gat 5,40
	gprint "The number of characters in the above text is ";wc%
	wp%=gtwidth("This test will be too long")
	gat 5,60
	gprint "The length in pixels of the above test is ";wp%
	if 200-wp%>(wp%/wc%) : gprint " ... Incorrect!" : endif
	text$="mmmmmmmmmm"
	wp%=gtwidth(text$)
	gat 5,80
	gprint "Width of "+text$+" is ";wp%
	text$="iiiiiiiiii"
	wp%=gtwidth(text$)
	gat 5,100
	gprint "Width of "+text$+" is ";wp%
	gat 5,120
	gprint "Now in mono"
	gstyle 16
	text$="mmmmmmmmmm"
	wp%=gtwidth(text$)
	gat 5,140
	gprint "Width of "+text$+" is ";wp%
	text$="iiiiiiiiii"
	wp%=gtwidth(text$)
	gat 5,160
	gprint "Width of "+text$+" is ";wp%
	get%:
	gcls
	gstyle 0
	gat 5,20
	gprint "Plain text"
	gat 5,40
	gxprint "Plain text",0
	gat 5,60
	gxprint "Inverse text",1
	gat 5,80
	gxprint "Inverse except corners",2
	gat 5,100
	gxprint "Thin inverse",3
	gat 5,120
	gxprint "Thin inverse excpet corners",4
	gat 5,140
	gxprint "Underlined",5
	gat 5,160
	gxprint "Thin underlined",6
	get%:
	gcls
	gstyle 4
	gat 5,20
	gxprint "Inverse with inverse style",1
	gat 5,40
	gxprint "Inverse except corners with inverse style",2
	gat 5,60
	gxprint "Thin inverse with inverse style",3
	gat 5,80
	gxprint "Thin inverse except corners",4
	gstyle 2
	gat 5,100
	gxprint "Underlined with underlined style",5
	gat 5,120
	gxprint "Thin underlined with underlined style",6
	get%:
	gcls
	gfill gwidth/2, gheight,0
	gstyle 0
	gtmode 1
	gat 5,20
	gprint "Text mode 1 - pixels cleared"
	gat 325,20
	gprint "This should be invisible"
	gtmode 2
	gat 5,50
	gprint "Text mode 2 - pixels inverted"
	gat 325,50
	gprint "This should be visible"
	gtmode 3
	gat 5,80
	gprint "Text mode 3 - pixels replaced"
	gat 325,80
	gprint "This should be visible"
	get%:
	gclose id1%
	cls
endp

proc tgscroll:
	print "Test gSCROLL"
	pause%:(20)
	id1%=gcreate(0,0,gwidth,gheight,1,2)
	gat 100,100
	gcircle 80
	gcircle 60
	gcircle 40
	gcircle 20
	get%:
	gscroll 100,0
	get%:
	gscroll -100,0
	get%:
	gscroll 0,50
	get%:
	gscroll 0,-50
	get%:
	gscroll 100,0,58,58,84,84
	get%:
	gscroll -100,0,158,58,84,84
	get%:
	gscroll 0,50,58,58,84,84
	get%:
	gscroll 0,-50,58,108,84,84
	get%:
	gcls
	stripes:(0)
	get%:
	gscroll 80,0
	get%:
	gscroll -80,0
	get%:
	gscroll -80,0
	get%:
	gscroll 80,0
	get%:
	gcls
	gclose id1%
	cls
endp

proc tgsetwin:
	print "Test gSETWIN"
	pause%:(20)
	id1%=gcreate(0,0,gwidth,gheight,1,2)
	stripes:(0)
	get%:
	gsetwin 0,0,gwidth/2,gheight/2
	get%:
	gsetwin 320,120
	get%:
	gcls
	gclose id1%
	cls
endp

proc tgupdate:
	print "Test gUPDATE"
	pause%:(20)
	id1%=gcreate(0,0,gwidth,gheight,1,2)
	gat 5,20 
	gfont 10
	gprint "Update is ON"
	gat 5,60
	gfill 20,20,0
	pause%:(40)
	gat 5,80
	gcolor $A0,$A0,$A0
	gfill 20,20,0
	gcolor 0,0,0
	gat 325,20
	gprint "Now Turning update OFF and doing the same ..."
	gupdate off
	gat 325,60
	gfill 20,20,0
	pause%:(20)
	gat 325,80
	gcolor $A0,$A0,$A0
	gfill 20,20,0
	gupdate
	get%:
	gclose id1%
	cls
	gupdate on
endp

proc tvis:
	print "Test visibility"
	print "Creating an invisible window and drawing on it"
	id1%=gcreate(0,0,gwidth,gheight,0,2)
	stripes:(0)
	print "Now making the window visible on keypress and invisible again on a second keypress"
	get%:
	gvisible on
	get%:
	gvisible off
	print "Now it's invisible again!"
	gcls
	gclose id1%
	print
	print "Press a key to create a visible window and draw on it"
	print "Press another key to make it invisible"
	get%:
	id1%=gcreate(0,0,gwidth,gheight,1,2)
	stripes:(0)
	get%:
	gvisible off
	print "And press a key to make it visible again"
	get%:
	gvisible on
	pause%:(30)
	gcls
	gclose id1%
	cls
endp


PROC Get%:
	REM get
ENDP


PROC pause%:(duration%)
	rem pause duration%
ENDP

REM End of p16col.tpl