p16col.tpl

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

REM p16col.tpl
REM EPOC OPL automatic test code for 16-color graphics.
REM Copyright (c) 1991-2000 Symbian Ltd. All rights reserved.

INCLUDE "Const.oph"
INCLUDE "hUtils.oph"

PROC Standalone:
	REM Main procedure called when not running inside test harness.
	LOADM KhUtils$
	hLink:( "p16col", hThreadIdFromOplDoc&:, KhUserFull%)
	REM After standalone completion, control returns here.
	dINIT "Tests complete" :DIALOG
ENDP


proc p16col:
	rem hInitTestHarness:(KhInitLocalErrorHandling%, KhInitNotUsed%)
	hRunTest%:("t16colwin")
rem 	hCleanUp%:("CleanUp")
endp


proc t16colwin:
	global id0%,id1%,id2%
	rem print "Opler1 General 16-colour Window Tests"
	rem print
	tgborder:
	tgbox:
	tgcircle:
	tgcopy:
	tgfill:
	tgfont:
	tggmode:
	tginvert:
	tgmove:
	tgorderandrank:
	tgorigin:
	tgpatt:
	tgpoly:
	tgprint:
	tgscroll:
	tgsetwin:
	tgupdate:
	tvis:
	rem print
	rem print "Opler1 General 16-colour Window Tests finished OK"
	rem pause 30
endp


proc tgborder:
	cls
	print "Test gBORDER"
	print "1. These drawables should have shadows"
	print "Press a key to remove the shadow and again to replace shadow"
	border:(1,2,3,4)
	
	print "2. These drawables should have shadows and rounded corners"
	print "Press a key to remove the shadow and again to replace shadow"
	border:($201,$202,$203,$204)
	
	print "3. These are boxes"
	print "Press a key to draw a border with a 1 pixel gap"
	id1%=gcreate (110,70,100,90,1,2)
	gat 20,20 : gbox 60,50 : get%: : gborder $100,60,50
	id2%=gcreate (430,70,100,90,1,2)
	gat 20,20 : gbox 60,50 : get%: : gborder $100,60,50
	pause%:(10)
	gclose id1% : gclose id2%
	cls
	
	print "4. These drawables should have shadows (borders at 1 pixel gap)"
	print "Press a key to remove the shadow and again to replace shadow"
	border:($101,$102,$103,$104)

	print "5. These should have borders with shadows inside the drawable"
	print "Press a key to remove the shadow"
	id1%=gcreate (110,70,100,90,1,2)
	gborder 2 : gat 10,10
	gborder 1,80,70 : get%: : gborder 2,80,70
	id2%=gcreate (430,70,100,90,1,2)
	gborder 4 : gat 10,10
	gborder 3,80,70 : get%: : gborder 4,80,70
	pause%:(10)
	gclose id1% : gclose id2%
	cls	
endp

proc border:(b1%,b2%,b3%,b4%)
	id1%=gcreate (110,70,100,90,1,2)
	gborder b1% : get%: : gborder b2% : get%: : 	gborder b1%
	id2%=gcreate (430,70,100,90,1,2)
	gborder b3% : get%: : gborder b4% : get%: : gborder b3%
	pause%:(10)
	gclose id1% : gclose id2%
	cls
endp

proc tgbox:
	local i%,x%,y%,col%
	print "Test gBOX"
	pause%:(20)
	id1%=gcreate(0,0,gwidth,gheight,1,2)
	i%=0
	col%=0
	x%=1
	y%=1
	while i%<16
		gat x%,y%
		gcolor col%,col%,col%
		gbox gwidth-2*x%,gheight-2*y%
		x%=x%+12
		y%=y%+4
		col%=col%+$10
		i%=i%+1
	endwh
	get%:
	gcls
	gclose id1%
	cls
endp

proc tgcircle:
	print "Test gCIRLCE and gELLIPSE"
	print
	print "Testing unfilled and filled"
	pause%:(20)
	id1%=gcreate(0,0,gwidth,gheight,1,2)
	gcolor $20,$20,$20
	gat 160,60
	gcircle 50
	gcolor $60,$60,$60
	gat 480,60
	gcircle 50
	gcolor $a0,$a0,$a0
	gat 160,180
	gcircle 50,1
	gcolor $e0,$e0,$e0
	gat 480,180
	gcircle 50,-1
	get%:
	gcls	
	gcolor $10,$10,$10
	gat 160,60
	gellipse 50,30
	gcolor $50,$50,$50
	gat 480,60
	gellipse 50,30
	gcolor $90,$90,$90
	gat 160,180
	gellipse 50,30,1
	gcolor $d0,$d0,$d0
	gat 480,180
	gellipse 50,30,-1
	get%:
	gcls
	gclose id1%
	cls
endp

proc tgcopy:
	local i%,col%,x%
	print "Test gCOPY"
	print
	print "First copying FROM a 16-colour"
	print "window.  Second copying TO 16"
	print "colour window. In each case the 4"
	print "copies represent 4 copy modes."
	print " In the last three cases of each"
	print " copy, the background is black"
	id2%=gcreate(gwidth/2,0,gwidth/2,160,1,2) : gborder 1
	guse 1
	id1%=gcreate(0,161,gwidth/2,80,1,1) : gborder 1
	guse 1
	id0%=gcreate(gwidth/2,161,gwidth/2,80,1,0) : gborder 1
	rem create something to copy
	guse id2%
	x%=10
	while i%<16
		gat x%,10
		gcolor col%,col%,col%
		gfill 4,64,0
		x%=x%+4
		col%=col%+$10
		i%=i%+1
	endwh
	guse id1% : gat 10,10
	gcopy id2%,10,10,64,64,0	
	guse id0% : gat 10,10
	gcopy id2%,10,10,64,64,0	
	guse id1% : gat 80,10
	gfill 64,64,0
	gcopy id2%,10,10,64,64,1
	guse id0% : gat 80,10
	gfill 64,64,0
	gcopy id2%,10,10,64,64,1
	guse id1% : gat 150,10
	gfill 64,64,0
	gcopy id2%,10,10,64,64,2	
	guse id0% : gat 150,10
	gfill 64,64,0
	gcopy id2%,10,10,64,64,2	
	guse id1% : gat 220,10
	gfill 64,64,0
	gcopy id2%,10,10,64,64,3
	guse id0% : gat 220,10
	gfill 64,64,0
	gcopy id2%,10,10,64,64,3
	get%:
	guse id0% : gcls
	guse id1% : gcls
	guse id2% : gcls	

	rem create something to copy
	guse id1%
	gborder 1
	x%=10
	col%=0
	i%=0
	while i%<16
		gat x%,10
		gcolor col%,col%,col%
		gfill 4,64,0
		x%=x%+4
		col%=col%+$10
		i%=i%+1
	endwh
	guse id0%
	gborder 1
	x%=10
	col%=0
	i%=0
	while i%<16
		gat x%,10
		gcolor col%,col%,col%
		gfill 4,64,0
		x%=x%+4
		col%=col%+$10
		i%=i%+1
	endwh

	guse id2%
	gborder 1
	gcolor 0,0,0
	gat 10,5 : gcopy id0%,10,10,64,64,0	
	gat 10,75 : gcopy id1%,10,10,64,64,0	
	gat 80,5 : gfill 64,64,0
	gcopy id0%,10,10,64,64,1
	gat 80,75 : gfill 64,64,0
	gcopy id1%,10,10,64,64,1
	gat 150,5 : gfill 64,64,0
	gcopy id0%,10,10,64,64,2	
	gat 150,75 : gfill 64,64,0
	gcopy id1%,10,10,64,64,2	
	gat 220,5 : gfill 64,64,0
	gcopy id0%,10,10,64,64,3
	gat 220,75 : gfill 64,64,0
	gcopy id1%,10,10,64,64,3
	get%:
	gclose id0% : gclose id1% : gclose id2%
	cls
endp

proc tgfill:
	print "Test gFILL"
	print "Three modes in succession"
	pause%:(30)
	id1%=gcreate(0,0,gwidth,gheight,1,2)
	stripes:(0)
	get%: : gcls
	stripes:(1)
	get%: : gcls
	stripes:(2)
	get%: : gcls
	gclose id1%
	cls
endp

proc tgfont:
	print "Test gFONT"
	pause%:(20)
	id1%=gcreate(0,0,gwidth,gheight,1,2)
	gprintfont:(4,0,20,"Type 4 maps to Courier 8")
	gprintfont:(5,0,33,"Type 5 maps to Times 8")
	gprintfont:(6,0,49,"Type 6 maps to Arial 11")
	gprintfont:(7,0,67,"Type 7 maps to Times 13")
	gprintfont:(8,0,87,"Type 8 maps to Times 15")
	gprintfont:(9,0,100,"Type 9 maps to Arial 8")
	gprintfont:(10,0,116,"Type 10 maps to Arial 11")
	gprintfont:(11,0,134,"Type 11 maps to Arial 13")
	gprintfont:(12,0,154,"Type 12 maps to Arial 15")
	gprintfont:(13,0,164,"Type 13 maps to Tiny 4 (mono)")
	get%:
	gcls
	gprintfont:(10,1,20,"Bold")
	gprintfont:(10,2,35,"Underline")
	gprintfont:(10,4,50,"Inverse")
	gprintfont:(10,8,80,"Double Height")
	gprintfont:(10,16,95,"Mono")
	gprintfont:(10,32,110,"Italic")
	gprintfont:(10,$3f,140,"All Styles")
	get%:
	gcls
	gfont 12 : gstyle 0
	gat 10,20
	gprint "Multicoloured text!"
	gat 10,50
	gcolor 0,0,0 : gprint "a"
	gcolor $10,$10,$10 : gprint "b"
	gcolor $20,$20,$20 : gprint "c"
	gcolor $30,$30,$30 : gprint "d"
	gcolor $40,$40,$40 : gprint "e"
	gcolor $50,$50,$50 : gprint "f"
	gcolor $60,$60,$60 : gprint "g"
	gcolor $70,$70,$70 : gprint "h"
	gcolor $80,$80,$80 : gprint "i"
	gcolor $90,$90,$90 : gprint "j"
	gcolor $A0,$A0,$A0 : gprint "k"
	gcolor $B0,$B0,$B0 : gprint "l"
	gcolor $C0,$C0,$C0 : gprint "m"
	gcolor $D0,$D0,$D0 : gprint "n"
	gcolor $E0,$E0,$E0 : gprint "o"
	gcolor $F0,$F0,$F0 : gprint "p"
	get%:
	gcls
	gclose id1%
	cls
endp

proc gprintfont:(font%,style%,pos%,str$)
	gfont font%
	gstyle style%
	gat 30,pos%
	gprint str$
endp

proc tggmode:
	print "Test gGMODE"
	print "Initially 0 - set"
	pause%:(20)
	id1%=gcreate(0,0,gwidth,gheight,1,2)
	gat 50,50 : gcolor 0,0,0 : gbox 50,50
	gat 150,50 : gcolor $80,$80,$80 : gbox 50,50
	gat 250,50 : gcolor $F0,$F0,$F0 : gbox 50,50
	get%: : gcls
	gorder 1,1
	print "Now 1 - cleared (on white)"
	pause%:(20)
	gorder id1%,1
	ggmode 1
	gat 50,50 : gcolor 0,0,0 : gbox 50,50
	gat 150,50 : gcolor $80,$80,$80 : gbox 50,50
	gat 250,50 : gcolor $F0,$F0,$F0 : gbox 50,50
	get%: : gcls
	gorder 1,1
	print "Now 1 - cleared (on black)"
	pause%:(20)
	gorder id1%,1
	ggmode 0
	gcolor 0,0,0
	gfill gwidth,gheight,0
	ggmode 1
	gat 50,50 : gcolor 0,0,0 : gbox 50,50
	gat 150,50 : gcolor $30,$30,$30 : gbox 50,50
	gat 250,50 : gcolor $F0,$F0,$F0 : gbox 50,50
	get%: : gcls
	gorder 1,1
	print "Now 2 - inverted (on black)"
	pause%:(20)
	gorder id1%,1
	ggmode 0
	gcolor 0,0,0
	gfill gwidth,gheight,0
	ggmode 2
	gat 50,50 : gcolor 0,0,0 : gbox 50,50
	gat 150,50 : gcolor $30,$30,$30 : gbox 50,50
	gat 250,50 : gcolor $F0,$F0,$F0 : gbox 50,50
	get%: : gcls
	gclose id1%
	cls
endp

proc stripes:(mode%)
	local col%,x%,i%
	col%=0
	x%=0
	while i%<16	
		gcolor col%,col%,col%
		gat x%,0
		gfill 40,gheight,mode%
		col%=col%+$10
		x%=x%+40
		i%=i%+1
	endwh
endp

proc tginvert:
	print "Test gINVERT"
	pause%:(20)
	id1%=gcreate(0,0,gwidth,gheight,1,2)
	rem draw something to invert
	stripes:(0)
	get%:
	gat 0,0
	ginvert gwidth,gheight
	get%:
	ginvert gwidth,gheight
	get%:
	gcls
	gclose id1%
	cls
endp

proc tgmove:
	print "Test gMOVE"
	print "Draw circles at each new point to indicate move"
	pause%:(20)
	id1%=gcreate(0,0,gwidth,gheight,1,2)
	gat 200,100 : gcircle 1
	gmove 100,50 : gcircle 112
	gmove -75,-50 : gcircle 90
	get%:
	gcls
	gclose id1%
	cls
endp