[Vm-dev] Tangential: A Lisp Interpreter Implemented in Conway's Game of Life

Fri Jan 20 11:34:48 UTC 2023

Attached is a Morph for playing with the #nextGeneration method.

Usage:

	(BitBltLifeMorph over: 150 at 120) openInHand

The yellow button menu allows edition (you can hand-paint the cells), 
and basic control of the speed and magnification.

Stef
-------------- next part --------------
ImageMorph subclass: #BitBltLifeMorph
	instanceVariableNames: 'magnification stepTime'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'MorphicExtras-BitBltLife'!
!BitBltLifeMorph commentStamp: 'spfa 1/20/2023 12:18' prior: 0!
(BitBltLifeMorph over: 150 at 120) openInHand
!

!BitBltLifeMorph methodsFor: 'editing' stamp: 'spfa 1/20/2023 10:49'!
editPattern

	self editPattern: image! !

!BitBltLifeMorph methodsFor: 'editing' stamp: 'spfa 1/20/2023 10:57'!
editPattern: anImage

	| editor |

	self addMorph: (editor := GoLPatternPaint new editForm: (image := anImage);
			 magnification: self magnification;
			 brushColor: Color black;
			 penSize: 1;
			 bounds: self bounds;
			 yourself).

	^ editor! !

!BitBltLifeMorph methodsFor: 'editing' stamp: 'spfa 1/20/2023 10:50'!
erasePattern

	self editPattern: (Form extent: image extent)! !

!BitBltLifeMorph methodsFor: 'editing' stamp: 'spfa 1/20/2023 12:08'!
randomizePattern

	| rform |

	rform := Form extent: image extent.
	(rform width * rform height * 0.5) floor timesRepeat: [
		rform colorAt: (rform width -2) atRandom @ (rform height -2) atRandom put: Color black].

	(self editPattern: rform) accept! !

!BitBltLifeMorph methodsFor: 'menu' stamp: 'spfa 1/20/2023 11:08'!
beFast

	self stepTime: 0! !

!BitBltLifeMorph methodsFor: 'menu' stamp: 'spfa 1/20/2023 11:08'!
beSlow

	self stepTime: 200! !

!BitBltLifeMorph methodsFor: 'menu' stamp: 'spfa 1/20/2023 11:31'!
beVerySlow

	self stepTime: 1000! !

!BitBltLifeMorph methodsFor: 'menu' stamp: 'spfa 1/20/2023 12:00'!
buildMetaMenu: evt
	"Build the morph menu. This menu has two sections. The first section contains commands that are handled by the hand; the second contains commands handled by the argument morph."
	| menu |

	menu := MenuMorph new defaultTarget: self.
	menu addLine.
	menu add: 'stop & paint' translated action: #editPattern.
	menu addLine.
	menu add: 'slow' translated action: #beSlow.
	menu add: 'very slow' translated action: #beVerySlow.
	menu add: 'fast' translated action: #beFast.
	menu addLine.
	menu add: 'erase' translated action: #erasePattern.
	menu add: 'randomize' translated action: #randomizePattern.
	menu addLine.
	menu add: 'x2' translated action: #mag2.
	menu add: 'x4' translated action: #mag4.
	menu add: 'x8' translated action: #mag8.

	^ menu! !

!BitBltLifeMorph methodsFor: 'menu' stamp: 'spfa 1/20/2023 10:34'!
buildYellowButtonMenu: aHand

	^ self buildMetaMenu: self currentEvent! !

!BitBltLifeMorph methodsFor: 'menu' stamp: 'spfa 1/20/2023 11:26'!
invokeMetaMenu: evt

	| menu |
	menu := self buildMetaMenu: evt.
	menu addTitle: 'Life playground'.
	menu popUpEvent: evt in: self world! !

!BitBltLifeMorph methodsFor: 'menu' stamp: 'spfa 1/20/2023 12:00'!
mag2

	self magnification: 2! !

!BitBltLifeMorph methodsFor: 'menu' stamp: 'spfa 1/20/2023 12:00'!
mag4

	self magnification: 4! !

!BitBltLifeMorph methodsFor: 'menu' stamp: 'spfa 1/20/2023 12:00'!
mag8

	self magnification: 8! !

!BitBltLifeMorph methodsFor: 'menu' stamp: 'spfa 1/20/2023 11:28'!
yellowButtonActivity: shiftState 

	self invokeMetaMenu: self currentEvent! !

!BitBltLifeMorph methodsFor: 'drawing' stamp: 'spfa 1/20/2023 10:17'!
drawOn: aCanvas
	self borderStyle ifNotNil:[:style |
		style frameRectangle: bounds on: aCanvas.
	].
	aCanvas drawImage: (image magnifyBy: self magnification) at: self innerBounds origin! !

!BitBltLifeMorph methodsFor: 'accessing' stamp: 'spfa 1/20/2023 12:01'!
magnification

	^ magnification ifNil: [4]! !

!BitBltLifeMorph methodsFor: 'accessing' stamp: 'spfa 1/20/2023 12:03'!
magnification: anInteger

	magnification := anInteger.
	self pattern: image! !

!BitBltLifeMorph methodsFor: 'accessing' stamp: 'spfa 1/20/2023 10:44'!
pattern: anImage 
	self changed.
	image := anImage. 
	super extent: self preferredExtent! !

!BitBltLifeMorph methodsFor: 'accessing' stamp: 'spfa 1/20/2023 10:16'!
preferredExtent
	^ image ifNil: [0 at 0] ifNotNil: [image extent * self magnification]! !

!BitBltLifeMorph methodsFor: 'stepping and presenter' stamp: 'spfa 1/20/2023 12:07'!
step

	(self findA: GoLPatternPaint) ifNotNil: [^ self].

	image nextGeneration.
	self changed! !

!BitBltLifeMorph methodsFor: 'stepping and presenter' stamp: 'spfa 1/20/2023 11:07'!
stepTime

	^ stepTime ifNil: [0]! !

!BitBltLifeMorph methodsFor: 'stepping and presenter' stamp: 'spfa 1/20/2023 11:07'!
stepTime: aNumber

	stepTime := aNumber! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

BitBltLifeMorph class
	instanceVariableNames: ''!

!BitBltLifeMorph class methodsFor: 'as yet unclassified' stamp: 'spfa 1/20/2023 11:58'!
over: aPoint

	^ self new pattern: (Form extent: aPoint); randomizePattern! !

FatBitsPaint subclass: #GoLPatternPaint
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'MorphicExtras-BitBltLife'!

!GoLPatternPaint methodsFor: 'menu' stamp: 'spfa 1/20/2023 10:26'!
accept

	super accept.
	self delete! !

!GoLPatternPaint methodsFor: 'menu' stamp: 'spfa 1/20/2023 10:39'!
buildYellowButtonMenu: aHand

	^ self buildMetaMenu: self currentEvent! !

!GoLPatternPaint methodsFor: 'menu' stamp: 'spfa 1/20/2023 10:28'!
callThisBaseGraphic

	self accept! !

!GoLPatternPaint methodsFor: 'meta-actions' stamp: 'spfa 1/20/2023 11:16'!
acceptForOneStep

	self owner in: [:o |
		self accept.
		self delete.
		o step.
		o editPattern]! !

!GoLPatternPaint methodsFor: 'meta-actions' stamp: 'spfa 1/20/2023 11:29'!
buildMetaMenu: evt
	"Build the morph menu. This menu has two sections. The first section contains commands that are handled by the hand; the second contains commands handled by the argument morph."
	| menu |
	menu := MenuMorph new defaultTarget: self.
	menu addLine.
	menu add: 'accept & resume' translated action: #accept.
	menu add: 'accept & do one step' action: #acceptForOneStep.
	menu add: 'dismiss' translated action: #dismiss.
	menu add: 'dismiss & resume' translated action: #delete.
	menu addLine.
	menu add: 'erase' translated action: #erasePattern.
	menu add: 'randomize' translated action: #randomizePattern.

	^ menu! !

!GoLPatternPaint methodsFor: 'meta-actions' stamp: 'spfa 1/20/2023 11:02'!
dismiss

	self owner in: [:o |
		self delete.
		o editPattern]! !

!GoLPatternPaint methodsFor: 'meta-actions' stamp: 'spfa 1/20/2023 12:27'!
erasePattern

	self owner in: [:o |
		self delete.
		o erasePattern]! !

!GoLPatternPaint methodsFor: 'meta-actions' stamp: 'spfa 1/20/2023 11:20'!
randomizePattern

	self owner in: [:o |
		self delete.
		o randomizePattern.
		o editPattern]! !

!GoLPatternPaint methodsFor: 'event handling' stamp: 'spfa 1/20/2023 11:00'!
mouseDown: evt 

	"Check for option (menu) click"
	evt yellowButtonPressed ifTrue: [| menu |
		menu := self buildMetaMenu: evt.
		menu addTitle: 'Life painter'.
		menu popUpInWorld: self currentWorld].

	^ super mouseDown: evt 
! !