Ah, those gloriously outdated questions at the start of Leisure Larry 1 and 3. You gotta love ’em. But what if you wanted to implement your own, accounting for the simple fact that
- we don’t use Text resources any more now that we have Messages;
- bitfield magic is weird and unclear.
Couple years ago, I rolled my own. Actually I did so even further back, when we still used SCI Studio, but that was such an ugly hack I’d rather not talk about that. Anyway, here’s my own implementation. I’ll interrupt the source code to explain things as we go. Ready to prove you’re a learnèd adult?
;;; Sierra Script 1.0 - (do not remove this comment)
(script #140)
(include sci.sh)
(use Main)
(use Game)
(use System)
(use Print)
(public
AgeCheckRm 0
)
Before we go on, you’ll need the following setup in a matching Message resource:
| Noun |
Verb |
Cond |
Seq |
Text |
| 0 |
0 |
1 |
1 |
Question 1 |
| 0 |
0 |
1 |
2 |
Answer 1-A |
| 0 |
0 |
1 |
3 |
Answer 1-B |
| 0 |
0 |
1 |
4 |
Answer 1-C |
| 0 |
0 |
1 |
5 |
Answer 1-D |
| 0 |
0 |
2 |
1 |
Question 2 |
| 0 |
0 |
2 |
2 |
Answer 2-A |
| 0 |
0 |
2 |
3 |
Answer 2-B |
| 0 |
0 |
2 |
4 |
Answer 2-C |
| 0 |
0 |
2 |
5 |
Answer 2-D |
| … |
| 1 |
0 |
0 |
1 |
Challenge |
| 1 |
0 |
0 |
2 |
Correct |
| 1 |
0 |
0 |
3 |
Wrong |
| 1 |
0 |
0 |
4 |
Done |
| 1 |
0 |
0 |
5 |
Cheater |
Questions are phrased like this: "3Which of these is not a pokémon?" where the first character is a digit from 0 to 4. If the digit is 0, all answers are equally correct. If it’s not, 1-4 map to answers A-D. The total number of questions should equal the TOTALQUESTIONS definition that now follows:
(define TOTALQUESTIONS 20) ; How many questions you have messages set up for.
(define REQUIREDQUESTIONS 5) ; How many must be answered.
; Metrics. Depending on your image, you'll want to edit these to match.
(define QUESTIONLEFT 100) ; Where and how the question is written.
(define QUESTIONTOP 32)
(define QUESTIONWIDTH 150)
(define QUESTIONFONT 4)
(define QUESTIONCOLOR 0)
(define ANSWERLEFT 100) ; Where and how the first possible answer is written.
(define ANSWERTOP 60)
(define ANSWERWIDTH 170)
(define ANSWERSPACING 25) ; How much space goes between each answer.
(define ANSWERFONT 4)
(define ANSWERCOLOR 0) ; Black
(define CORRECTCOLOR 35) ; Green
(define WRONGCOLOR 12) ; Red
(define BLACKSCREEN 0) ; Picture # for the black screen. Questions use scriptNumber.
(define CORRECTSOUND 111)
(define WRONGSOUND 112)
(local
questionsAsked = 0 ; Total number of questions asked
currentQuestion = 0 ; Current question's index
correctAnswer = 0 ; Current question's correct answer
answerGiven = 0 ; Player's guess for the current question
correctSoFar = 0 ; Questions answered correctly so far
; score = 0 ; If you were to put a lady in a swimsuit, this'd simplify things.
[textBuffer 200]
)
The EndThis procedure is where you’ll want to do things like set a filth level according to the score and inform the player they’ll get to play at that level.
(procedure (EndThis)
(gRoom newRoom: 120)
)
; Larry 1 and 3 use bitfield magic for this. We're keeping it simple, trading
; a bit of extra overhead for readability.
(instance AskedSoFar of List)
(procedure (PrepareQuestion &tmp i aTop [cleanQuestion 200])
; Try to find a question we haven't asked yet first.
; This might cause an infinite loop if the amount of questions is off.
(while TRUE
(= currentQuestion (Random 1 TOTALQUESTIONS))
(breakif (not (AskedSoFar contains: currentQuestion)))
)
(AskedSoFar add: currentQuestion)
; Grab the question we picked and extract the correct answer.
(Message msgGET scriptNumber 0 0 currentQuestion 1 @textBuffer)
(= correctAnswer (- (StrAt @textBuffer 0) $30)) ; '2' - '0' = 2
; Copy the question *without* the first character (the answer) to our temp space.
(for ((= i 0)) (< i (StrLen @textBuffer)) ((++ i))
(StrAt @cleanQuestion i (StrAt @textBuffer (+ i 1)))
)
; We can now display it.
(Display @cleanQuestion dsCOORD QUESTIONLEFT QUESTIONTOP dsCOLOR ANSWERCOLOR dsBACKGROUND -1 dsWIDTH QUESTIONWIDTH dsFONT QUESTIONFONT)
; Now we can fetch and display the possible answers.
(for ((= i 0)) (< i 4) ((++ i))
(DrawAnswer i ANSWERCOLOR)
)
)
; Draw a given answer (0-3) at the correct position and the given color.
; One thing you might want to try to do is to add the "a. b. c. d." bits.
; I left that out as a challenge.
(procedure (DrawAnswer number color)
(Message msgGET scriptNumber 0 0 currentQuestion (+ answerGiven 1) @textBuffer)
(Display @textBuffer
dsCOORD ANSWERLEFT (+ ANSWERTOP (* (- number 1) ANSWERSPACING))
dsCOLOR color
dsBACKGROUND -1
dsWIDTH ANSWERWIDTH
dsFONT ANSWERFONT
)
)
; Support function to keep the main part a little bit cleaner to read.
(procedure (TimedPrint theSequence theTime)
(Print
font: gFont
ticks: theTime
addText: 1 0 0 theSequence 0 0 scriptNumber
init:
)
)
Now we’re getting to the proper logic of the whole thing! First, we set things up much like you might a title screen, then pass control to a room script.
(instance AgeCheckRm of Room
(properties
picture BLACKSCREEN
)
(method (init)
(super init:)
(gOldMH addToFront: self)
(gOldKH addToFront: self)
(gIconBar hide: disable:)
(gUser canInput: FALSE)
(AskedSoFar init:)
(HideStatus)
(self setScript: RoomScript)
)
(method (dispose)
(AskedSoFar dispose:)
(gIconBar hide: enable:)
(gOldKH delete: self)
(gOldMH delete: self)
(super dispose: &rest)
)
)
(instance RoomScript of Script
(properties)
(method (changeState newState)
(switch (= state newState)
(0 ; Starting up
(Prints 1 0 0 1) ; Give the challenge.
; At this exact point, the Larry games would ask for your age.
(= cycles 1)
)
(1 ; Redraw the background, grab a new question, and wait for an answer.
; For the first question, transition nicely. For the rest, don't.
(if questionsAsked
(DrawPic scriptNumber dpOPEN_NO_TRANSITION)
; (aSuit setCel: score forceUpd:)
else
(DrawPic scriptNumber dpANIMATION_BLACKOUT)
; (aSuit init:)
)
(PrepareQuestion)
; Sit and wait for a cue.
)
(2 ; Got an answer! Is it right!?
; First, redraw the given answer in either green or red.
(DrawAnswer
answerGiven
(if (or (== answerGiven correctAnswer)
(== correctAnswer 0))
CORRECTCOLOR
else
WRONGCOLOR
)
)
; Now, judge 'em.
(++ questionsAsked)
(if (or (== answerGiven correctAnswer)
(== correctAnswer 0))
(++ correctSoFar)
; (++ score) ; for a Larry 3 lady in a swimsuit
(gMusic2 number: CORRECTSOUND play: self)
(TimedPrint 2) ; Correct!
else
(gMusic2 number: WRONGSOUND play: self)
; (-- score) ; for a Larry 3 lady in a swimsuit
; For Larry 1 style, you might want to add a "was it wrong before"
; flag or counter. If we *were* wrong twice, exit the game.
(TimedPrint 3) ; Wrong!
)
(= seconds 1)
)
(3 ; Wait a bit and repeat
(if (== questionsAsked REQUIREDQUESTIONS)
(gMusic1 fade:)
(Prints 1 0 0 4) ; Done!
(EndThis)
else
(= state 0) ; This actually makes state 1 so we get the next question.
(= cycles 1)
)
)
)
)
The handleEvent method will respond to lowercase A-D, uppercase A-D, Ctrl-Alt-X, and mouse clicks on the answers. If any of these things happen, it will cue itself, causing the answer to be checked.
(method (handleEvent event &tmp i aTop aBottom)
(if (!= state 1)
(super handleEvent: event)
(return)
)
(switch (event type?)
(evMOUSEBUTTON
; Check each answer spot in turn.
(= aTop ANSWERTOP)
(= aBottom (+ aTop ANSWERSPACING))
(for ((= i 0)) (< i 4) ((++ i))
(if (InRect (- ANSWERLEFT 10) aTop (+ (+ ANSWERLEFT ANSWERWIDTH) 20) aBottom (event x?) (event y?))
(= answerGiven (+ i 1))
(self cue:)
(break)
)
)
)
(evKEYBOARD
(event claimed: TRUE) ; Prevent the usual inputs from working.
(switch (event message?)
(KEY_a
(= answerGiven 1)
(self cue:)
)
(KEY_b
(= answerGiven 2)
(self cue:)
)
(KEY_c
(= answerGiven 3)
(self cue:)
)
(KEY_d
(= answerGiven 4)
(self cue:)
)
(KEY_A
(= answerGiven 1)
(self cue:)
)
(KEY_B
(= answerGiven 2)
(self cue:)
)
(KEY_C
(= answerGiven 3)
(self cue:)
)
(KEY_D
(= answerGiven 4)
(self cue:)
)
(KEY_ALT_x
(if (& (event modifiers?) 4) ; Holding Control too?
(TimedPrint 5) ; Cheater
; For Larry 3 style, you might want to ask what rating you want.
(EndThis)
)
)
)
)
)
)
)
; Bonus lady in a swimsuit because why not.
;;; (instance aSuit of Prop
;;; (properties
;;; y 77
;;; x 83
;;; view 140
;;; loop 1
;;; )
;;; )
There may yet be some timing issues. I’ll leave fixing those to whoever’s brave enough to use this in the first place.
