UWSCでタートルグラフィック（ロゴ言語もどき）

こんぴーた UWSC

UWSC公式掲示板に、Linersさん作のタートルグラフィックがあった。
いやー、懐かしい！
せっかくだから、キャンバスサイズ変更とか、色変更とかを追加してみた。
XPと7でのみ動作確認（日本語版のみ）



スクリプト

OPTION EXPLICIT

// Turtle_Graphics? June版 for UWSC Ver 0.1
//　簡単な命令で美しい図形を描くことが出来ます。

// 命令は　TG.FD(n)　nピクセル前進描画；　TG.PEN(down)　ペン上げ下げ;　TG.RT(r) r度右回転;　TG.LT(r) r度左回転


TG.Startup()

DIM i, j
TG.COLOR(255, 0, 0)
for i = 200 to 6 step -2; TG.FD(i); TG.RT(89); next　// よくある四角渦巻き

TG.COLOR(0, 255, 0)
TG.PEN(FALSE); TG.LT(82); TG.MV(147.4); TG.PEN(TRUE)
for i = 1 to 5 ; TG.FD(200); TG.RT(144); next　// お星様

TG.COLOR(0, 0, 255)
TG.PEN(FALSE); TG.MV(250); TG.PEN(TRUE)
for i = 1 to 36; TG.FD(200); TG.RT(170); next　// 明るいお星様？

TG.COLOR(0, 0, 0)
TG.PEN(FALSE); TG.RT(180); TG.MV(250); TG.LT(90); TG.MV(251.52); TG.PEN(TRUE)
For i=1 To 8; For j=1 To 8; TG.FD(40); TG.RT(45); Next; TG.RT(45); Next　// 八角形集合体

TG.PEN(FALSE); TG.LT(90); TG.MV(250); TG.PEN(TRUE)
For i=1 To 12; For j=1 To 4; TG.FD(80); TG.RT(90); Next; TG.RT(30); Next　// 四角形集合体

IF MSGBOX("Exit?", BTN_YES OR BTN_NO) = BTN_YES THEN TG.Dispose()


// タートルグラフィック・モジュール
MODULE TG
	DIM _xp = 100, _yp = 200, _direction = 0　// x座標 , y座標, 角度
	DIM _pen = TRUE, _wid = -1
	DIM _o[5]
	const Deg2rad = 3.14159265 / 180	// 度数(デグリー)・ラジアン変換定数

	DEF_DLL PostMessageW(DWORD, DWORD, DWORD, DWORD): BOOL: user32

	Procedure Startup()
		_wid = exec("mspaint")
		_xp = 100
		_yp = 200
		_o[0] = STATUS(_wid, ST_X)
		_o[1] = STATUS(_wid, ST_Y)
		_o[2] = STATUS(_wid, ST_WIDTH)
		_o[3] = STATUS(_wid, ST_HEIGHT)
		acw(_wid, 0, 0, 1025, 805)	//　Paint固定・アクティブ　※キャンパスサイズは800*600以上で
		SCKEY(_wid, VK_CTRL, E)
		DIM title = "イメージのプロパティ"
		IF KINDOFOS() = 13 THEN title = "キャンバスの色とサイズ"
		DIM wid = GETID(title, "#32770")
		IFB wid > -1 THEN
			IFB GETITEM(wid, ITM_EDIT) > 1 THEN
				_o[4] = ALL_ITEM_LIST[0]
				_o[5] = ALL_ITEM_LIST[1]
			ENDIF
			SENDSTR(wid, 800, 1, TRUE)
			SENDSTR(wid, 650, 2, TRUE)
			CLKITEM(wid, "OK")
		ENDIF
	Fend

	Procedure Dispose()
		IFB _wid > -1 THEN
			SCKEY(_wid, VK_CTRL, E)
			DIM title = "イメージのプロパティ"
			IF KINDOFOS() = 13 THEN title = "キャンバスの色とサイズ"
			DIM wid = GETID(title, "#32770")
			IFB wid > -1 THEN
				SENDSTR(wid, _o[4], 1, TRUE)
				SENDSTR(wid, _o[5], 2, TRUE)
				CLKITEM(wid, "OK")
			ENDIF
			acw(_wid, _o[0], _o[1], _o[2], _o[3])
			CTRLWIN(_wid, CLOSE)
			SCKEY(GETID("ペイント", "#32770"), N)
		ENDIF
	Fend

	Procedure COLOR(r, g, b)
		IFB PostMessageW(IDTOHND(_wid), $111, $1ad5, 0) THEN
			DIM wid = GETID("色の編集", "#32770")
			IFB wid > -1 THEN
				DIM title = "色の作成(D) >>"
				IF CHKBTN(wid, title) = 0 THEN CLKITEM(wid, title)
				SLEEP(0.1)
				SENDSTR(wid, r, 2, TRUE)
				SENDSTR(wid, g, 4, TRUE)
				SENDSTR(wid, b, 6, TRUE)
				CLKITEM(wid, "OK")
			ENDIF
		ENDIF
	Fend

	Procedure FD(x)
		IF _pen THEN BTN(LEFT, DOWN, _xp, _yp)
		This.MV(x)
		IF _pen THEN BTN(LEFT, UP, _xp, _yp)
	Fend
	Procedure PEN(down)
		_pen = down
	Fend
	Procedure RT(r)
		_direction = (_direction + r) MOD 360
	Fend
	Procedure LT(r)
		This.RT(-r)
	Fend
	Procedure MV(n)
		_xp = _xp + n * COS(_direction * Deg2rad)
		_yp = _yp + n * SIN(_direction * Deg2rad)
		MMV(_xp, _yp)
	Fend
EndModule

JP命令は廃止して、PEN命令によりペンの上げ下げを可能にした。
StartupとDispose命令でペイントの呼び出し・終了を可能にした。
COLOR命令で色設定可能にした。

小技

XPと7共通のダイアログ呼び出し方法を考えるのが面倒でした。

  • キャンバスサイズ変更のダイアログは、Ctrl+eで
  • 色編集のダイアログは、WM_COMMANDの0x1ad5で