[Goodie] QuizMorph

Torsten.Bergmann at phaidros.com Torsten.Bergmann at phaidros.com
Tue Oct 9 07:53:49 UTC 2001


I've integrated the QuizMorph into the objects tool and uploaded the 
code as project to Bobs super swiki.
See http://209.143.91.36/super/498

Have fun
Torsten


-----Original Message-----
From: Lyn A Headley [mailto:laheadle at cs.uchicago.edu]
Sent: Dienstag, 9. Oktober 2001 06:56
To: squeak-dev at lists.squeakfoundation.org
Subject: [Goodie] QuizMorph



I wrote this Morph to play with Squeak and also to quiz me on my
german vocabulary.  It's a Flashcard type application which presents a
list of cards with a question and an answer, sorted by difficulty.  If
you master one of the cards you can decrease its difficulty and
thereby send it to the back.  If you repeatedly miss one, you can
increase its difficulty and send it to the front.  The Morph comes
with a tutorial which comes up when you do QuizMorph new openInWorld.

comments appreciated.

-Lyn

------------------------------------------------------------------


'From Squeak3.0 of 4 February 2001 [latest update: #3552] on 7 October 2001
at 11:21:03 pm'!
Object subclass: #QuizEntry
	instanceVariableNames: 'question answer difficulty '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Quiz'!

!QuizEntry commentStamp: 'lah 9/27/2001 20:26' prior: 0!
triple of question, answer, difficulty
difficulty is low for easy questions!

Morph subclass: #QuizMorph
	instanceVariableNames: 'items index cardState '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Quiz'!

!QuizEntry methodsFor: 'as yet unclassified' stamp: 'lah 9/26/2001 03:35'!
answer
 ^answer! !

!QuizEntry methodsFor: 'as yet unclassified' stamp: 'lah 9/24/2001 18:50'!
answer: a
	answer _ a.
! !

!QuizEntry methodsFor: 'as yet unclassified' stamp: 'lah 9/26/2001 03:36'!
difficulty
 ^difficulty! !

!QuizEntry methodsFor: 'as yet unclassified' stamp: 'lah 9/24/2001 18:50'!
difficulty: d
	difficulty _ d.! !

!QuizEntry methodsFor: 'as yet unclassified' stamp: 'lah 9/26/2001 03:36'!
question
	^question! !

!QuizEntry methodsFor: 'as yet unclassified' stamp: 'lah 9/26/2001 03:26'!
question: h
	question _ h.
! !


!QuizEntry class methodsFor: 'as yet unclassified' stamp: 'lah 9/26/2001
03:27'!
question: h answer: a difficulty: d
	|entry|
	entry _ super new.
	entry question: h; answer: a; difficulty: d.
	^entry.

! !


!QuizMorph methodsFor: 'as yet unclassified' stamp: 'lah 9/28/2001 01:50'!
addCustomMenuItems: aCustomMenu hand: aHandMorph
	super addCustomMenuItems: aCustomMenu hand: aHandMorph.
	aCustomMenu add: 'load from file...' 
				  target: self 
				  action: #loadFromFile.
	aCustomMenu add: 'sort questions' 
				  target: items 
				  action: #reSort.
	aCustomMenu add: 'save as sorted...' 
				  target: self 
				  action: #saveQuiz.

! !

!QuizMorph methodsFor: 'as yet unclassified' stamp: 'lah 9/28/2001 02:20'!
addTutorial

	items add: (QuizEntry question: 'Who wrote this Morph? (hit right
arrow)' answer: 'Lyn Headley.  Click right arrow to take a tour' difficulty:
100).
	items add: (QuizEntry question: 'Right arrow flips the card or moves
on.  And left arrow?' answer: 'It goes back to the previous question!! try
it and come back' difficulty: 99).
	items add: (QuizEntry question: 'What''s that number below me?'
answer: 'The difficulty of this question.' difficulty: 98).
	items add: (QuizEntry question: 'How do I change a question''s
difficulty?' answer: 'with the up and down arrows' difficulty: 97).
	items add: (QuizEntry question: 'How are the questions sorted?'
answer: 'Hardest comes first' difficulty: 90).
	items add: (QuizEntry question: 'How do I load a quiz?' answer: 'hit
l or use the morph menu' difficulty: 89).
	items add: (QuizEntry question: 'What should a quiz file look like?'
answer: 'lines of the form question;answer;difficulty' difficulty: 88).
	items add: (QuizEntry question: 'How do I sort the Questions?'
answer: 'hit t or use the menu' difficulty: 87).
	items add: (QuizEntry question: 'Why isn''t s the sort key?' answer:
'because s means save in a file' difficulty: 86).
	items add: (QuizEntry question: 'How do I go back to the beginning?'
answer: 'with the g key' difficulty: 86).
	items add: (QuizEntry question: 'Anything else I should know?'
answer: 'No.  Load your quiz now.' difficulty: 85).
	items add: (QuizEntry question: 'I said leave me alone' answer:
'I''m calling the cops!!' difficulty: 84).


	
! !

!QuizMorph methodsFor: 'as yet unclassified' stamp: 'lah 9/27/2001 21:15'!
adjustDifficulty:	 amount
	(items at: index) difficulty: ((items at: index) difficulty +
amount).


! !

!QuizMorph methodsFor: 'as yet unclassified' stamp: 'lah 9/24/2001 19:03'!
drawOn: aCanvas
	super drawOn: aCanvas.
! !

!QuizMorph methodsFor: 'as yet unclassified' stamp: 'lah 9/27/2001 21:44'!
goCard: newIndex
	self index: newIndex.
	cardState _ #question.
! !

!QuizMorph methodsFor: 'as yet unclassified' stamp: 'lah 9/27/2001 20:49'!
handlesKeyboard: evt
	^true! !

!QuizMorph methodsFor: 'as yet unclassified' stamp: 'lah 9/24/2001 18:40'!
handlesMouseDown: evt
	^true! !

!QuizMorph methodsFor: 'as yet unclassified' stamp: 'lah 9/28/2001 02:22'!
index: anIndex
	|newIndex|
	newIndex _ anIndex.
	newIndex < 1 ifTrue: [
		newIndex _ 1].
	(newIndex > (items size)) ifTrue: [
		newIndex _ items size].
	index _ newIndex.

! !

!QuizMorph methodsFor: 'as yet unclassified' stamp: 'lah 9/28/2001 01:56'!
initialize
	super initialize.
	self extent: (400 at 240).
	self color: Color paleGreen.
	self layoutPolicy: TableLayout new.
	self listCentering: #center.
	self wrapCentering: #center.
	items _ self itemsCollection.
	self addTutorial.
	self goCard: 1.
	self showCard.	! !

!QuizMorph methodsFor: 'as yet unclassified' stamp: 'lah 9/28/2001 01:06'!
itemsCollection
	^SortedCollection new sortBlock: 
		[:e1 :e2 | 
		|result|
		"difficulty descending, alphabetically ascending"
		 e1 difficulty > e2 difficulty ifTrue: [result _ true].
		 e1 difficulty = e2 difficulty ifTrue: [
			result _ (e1 question <= e2 question)].
		 e1 difficulty < e2 difficulty ifTrue: [
			 result _ false].
		result]! !

!QuizMorph methodsFor: 'as yet unclassified' stamp: 'lah 10/7/2001 23:13'!
keyStroke: event
	| aChar aNum |
	aChar _ event keyCharacter.
	aNum _ aChar asciiValue.

	aNum == 31 ifTrue: [ "down"
		self adjustDifficulty: -1].
	aNum == 30 ifTrue: [ "up"
		self adjustDifficulty: 1].
	aNum == 29 ifTrue: [ "right"
		self nextCard].
	aNum == 28 ifTrue: [ "left"
		self goCard: index - 1].
	aChar == $g ifTrue: [ "go to front"
		self goCard: 1].
	aChar == $s ifTrue: [ "save"
		self saveQuiz].
	aChar == $t ifTrue: [ "sort"
		items reSort.
		self goCard: index].
	aChar == $l ifTrue: [ "load"
		self loadFromFile].
	self showCard.
! !

!QuizMorph methodsFor: 'as yet unclassified' stamp: 'lah 9/28/2001 00:50'!
loadFromFile
	|fileStream parts newItems line |
	newItems _ self itemsCollection.
	fileStream _ StandardFileMenu oldFileStream.
	fileStream isNil ifTrue: [^nil] 
	ifFalse: [
		[fileStream atEnd] whileFalse: [
			line := fileStream upTo: (10 asCharacter).
			parts _ line findBetweenSubStrs: ';'.
			newItems addLast: (QuizEntry question: (parts at: 1)
	
answer: (parts at: 2)
 								difficulty:
(parts at: 3) asInteger).
		].
		items _ newItems.
		items reSort.
		self showCard.
	].
	
! !

!QuizMorph methodsFor: 'as yet unclassified' stamp: 'lah 9/27/2001 21:23'!
mouseUp: evt
	self nextCard.
	self showCard.! !

!QuizMorph methodsFor: 'as yet unclassified' stamp: 'lah 9/27/2001 21:40'!
nextCard
	(cardState = #question) ifTrue: [
		cardState _ #answer.
	] ifFalse: [
		cardState _ #question.
		self index: index + 1
	].
! !

!QuizMorph methodsFor: 'as yet unclassified' stamp: 'lah 9/28/2001 02:19'!
saveQuiz
	|fileStream|
	fileStream _ StandardFileMenu newFileStream.
	fileStream isNil ifTrue: [^nil].
	items reSort.
	items do: [:item|
		fileStream nextPutAll: item question; nextPut: $;.
		fileStream nextPutAll: item answer; nextPut: $;.
		fileStream nextPutAll: item difficulty asString; 
				   nextPut: (10 asCharacter).
	].
	fileStream close.

		! !

!QuizMorph methodsFor: 'as yet unclassified' stamp: 'lah 9/26/2001 03:56'!
showAnswer
	self showString: (items at: index) answer.
! !

!QuizMorph methodsFor: 'as yet unclassified' stamp: 'lah 9/28/2001 01:11'!
showCard
	self removeAllMorphs.
	self showDifficulty.
	cardState == #question ifTrue: [
		self showQuestion.
	] ifFalse: [
		self showAnswer
	].
	self showString:
'----------------------------------------------------'.
	cardState == #question ifTrue: [
		self showString: 'Question'
	] ifFalse: [
		self showString: 'Answer'
	].

	self layoutChanged.


! !

!QuizMorph methodsFor: 'as yet unclassified' stamp: 'lah 9/27/2001 20:58'!
showDifficulty
	self showString: (items at: index) difficulty.
! !

!QuizMorph methodsFor: 'as yet unclassified' stamp: 'lah 9/26/2001 03:56'!
showQuestion
	self showString: (items at: index) question.
! !

!QuizMorph methodsFor: 'as yet unclassified' stamp: 'lah 9/27/2001 20:59'!
showString: anObject
	|aMorph|
	aMorph _ StringMorph contents: (anObject asString).
	self addMorph:  aMorph.
	"aMorph cellPositioning: #center."
! !

QuizMorph removeSelector: #adjustDifficulty!
QuizMorph removeSelector: #handlesKeyBoard:!
QuizMorph removeSelector: #handlesMouseDown!
QuizMorph removeSelector: #mouseDown:!
QuizMorph removeSelector: #show!
QuizEntry class removeSelector: #hint:answer:difficulty:!
QuizEntry removeSelector: #hint:!





More information about the Squeak-dev mailing list