lifegame-hsp

lifegame-1.hsp

/*

		HSPによるライフゲームサンプル

		参考文献：
			『C言語による最新アルゴリズム辞典』奥村晴彦著／技術評論社
			『人工生命の世界』服部桂／オーム社
*/
#define ScreenX 160
#define ScreenY 120
#define ImageBuffer 0
#define Speed 0

	//仮想イメージバッファ
	dim vram,ScreenX,ScreenY
	//次世代イメージバッファ
	dim nram,ScreenX,ScreenY
	x=0
	y=0
	gn=0
	i=0

//	初期媒体ペントミノの定義
	nram(ScreenX/2,ScreenY/2)		= 1
	nram(ScreenX/2,ScreenY/2-1)		= 1
	nram(ScreenX/2,ScreenY/2+1)		= 1
	nram(ScreenX/2-1,ScreenY/2)		= 1
	nram(ScreenX/2+1,ScreenY/2-1)	= 1

screen ImageBuffer,ScreenX,ScreenY
	cls 0
	repeat
		repeat
			repeat
				vram(x,y) = nram(x,y)
				x++
				if( x >= ScreenX-1 ) : break
			loop
			y++
			if( y >= ScreenY-1 ) : break
			x=1
		loop
	redraw 0
			color 255,255,255
			boxf
			color 0,0,0
			x=1
			y=1
			repeat
				repeat
					i=0

					if( nram(x,y) != 0 ) :{
						pset x,y
					}
					
					if( vram(x-1,y-1) != 0) : i++
					if( vram(x  ,y-1) != 0) : i++
					if( vram(x+1,y-1) != 0) : i++
					if( vram(x-1,y  ) != 0) : i++
					if( vram(x+1,y  ) != 0) : i++
					if( vram(x-1,y+1) != 0) : i++
					if( vram(x  ,y+1) != 0) : i++
					if( vram(x-1,y+1) != 0) : i++
					if( i = 0 ) : nram(x,y) = 0
					if( i = 2 ) : nram(x,y) = vram(x,y)
					if( i = 3 ) : nram(x,y) = 1
					if( i > 3 ) : nram(x,y) = 0

					x++
					if( x >= ScreenX-1 ) : break
				loop
				y++
				if( y >= ScreenY-1 ) : break
				x=1
			await
			loop
		redraw 1
		gn++
		title "Generation : "+gn+""
		await Speed
	loop

	stop

lifegame-2.hsp

/*
	LIFEGAME SAMPLE for HSP
	VERSION 1.12

	[REFERENCE]
	左クリ	ペントミノ投下
	ENTER	初期位置（中心）にペントミノ投下
	ESC		細胞を全消去
	SPACE	一時停止
	↑		倍率を上げる
	↓		倍率を下げる
	TAB		グリッド表示切替

*/
//行数・文字数
N=128
M=192
//倍率設定
x=2
//グリッド有無
gd=0
//グリッド横分割数
gdx=24
//グリッド縦分割数
gdy=16
//ウェイト
w=10
//背景画像有効
img=1
//自動投下モード
auto=1
//投下タイミング(世代数)
ag=100


*start
	if(img):{
		buffer 2
		picload "back.jpg"
	}
	i=0
	j=0
	gosub *clr
	gosub *put
screen 0,M*x,N*x
	title "LIFEGAME - RUN"
	repeat
*main
		g++
//		title ""+g+""
		redraw 0
		//背景描写
		if(img):{
			pos 0,0
			gzoom M*x,N*x,2,0,0,M,N,1
		}else: color 0,0,0 : boxf
		//グリッド描写
		if(gd):{
			color 63,47,47
			repeat gdx
				line M/gdx*x*cnt,0,M/gdx*x*cnt,N*x
			loop
			repeat gdy
				line 0,N/gdy*x*cnt,M*x,N/gdy*x*cnt
			loop
		}
		//描写系統
		for i,1,N,1
			for j,1,M,1
				if( a(i,j)!=0):{
					color 255-(j+i),63+j,127+i
					//倍率を上げたら、ドットを強調する。
					pset j*x,i*x
					if(x>2):{
						pset j*x,i*x-1
						pset j*x+1,i*x
						pset j*x-1,i*x
						pset j*x,i*x+1
					}
					if(x>4):{
						pset j*x-1,i*x-1
						pset j*x+1,i*x-1
						pset j*x-1,i*x+1
						pset j*x+1,i*x+1
					}
					b(i-1,j-1)++ :	b(i-1,j  )++	:b(i-1,j+1)++
					b(i  ,j-1)++ :					:b(i  ,j+1)++
					b(i+1,j-1)++ :	b(i+1,j  )++	:b(i+1,j+1)++
				}
			next
		next
		//ムーア近傍をチェック
		for i,0,N+1,1
			for j,0,M+1,1
				if(b(i,j)!=2) : a(i,j)=(b(i,j)==3)
				b(i,j)=0;
			next
		next
		redraw 1
		stick key,256
			if key&128	: gosub *clr
			if key&16	: gosub *stp
			if key&32	: gosub *put
			if key&2	: if x<8 : x++ : screen 0,M*x,N*x : goto *main
			if key&8	: if x>1 : x-- : screen 0,M*x,N*x : goto *main
			if key&1024	: if(gd) : gd=0 : else : gd=1
			if key&256	: gosub *click
		await w
		//自動投下
		if(auto) : if(cnt>ag) : if(cnt\ag=0) : gosub *put
	loop
	stop

//一時停止画面
*stp
	title "LIFEGAME - STOP"
	font "Impact",12,16 : color 127,255,192 : pos 0,0
	mes " [ LIFEGAME ] "
	mes "  SIZE : "+M*x+"px, "+N*x+"px ( "+x+"x )"
	mes "  GENERATION : "+g
	c=0
	for i,1,N,1
		for j,1,M,1
			if( a(i,j)!=0):c++
		next
	next
	mes "  CELLS : "+c
	repeat
		stick key,256
			if key&128	: gosub *clr
			if key&16	: 	title "LIFEGAME - RUN" : break
			if key&32	: gosub *put
			if key&2	: if x<8 : x++ : goto *main
			if key&8	: if x>1 : x-- : goto *main
			if key&1024	: if(gd) : gd=0 : else : gd=1
			if key&256	: gosub *click
		wait 10
	loop
	return

//細胞全消去
*clr
	dim a,N+2,M+2
	dim b,N+2,M+2
	g=0
	return

//初期ペントミノを定義
*put
	a(N/2,M/2)		=1
	a(N/2-1,M/2)	=1
	a(N/2+1,M/2)	=1
	a(N/2,M/2-1)	=1
	a(N/2-1,M/2+1)	=1
	return

//クリックした位置にペントミノ投下
*click
	mx=mousey/x
	my=mousex/x
	//タスクバークリックは無効
	if((mx<=0)||(mx>=N)||(my<=0)||(my>=M)) : return
	a(mx,my)		=1
	a(mx-1,my)		=1
	a(mx+1,my)		=1
	a(mx,my-1)		=1
	a(mx-1,my+1)	=1
	return
/* EOF */