# http://www.ex-parrot.com/~tom/calcs/calcs/encyc/progs/src/qbert.ctf
# ========================================================================
# Program name: Qbert!
# 
#      Version: 1.0
#       Author: Tom Lynn
#         Date: 1995-7
#       Models: 9750, 9850, 9950
#
#
# Description:
#
# This is a calc version of the arcade classic, Qbert.
# I have tried to make it as fast as possible, but it's still
# a bit on the slow side, and there's no snake at the moment.
# It does look good though.
# 
# In case you don't know the game, the object is to paint every
# tile in the pyramid while avoiding getting crushed by the
# cascading balls.  The TARDISes either side will take you to the
# top of the pyramid.
#
# * Before running the program *
#
# Run the program "QBDRAWPY", which draws the pyramid, and then store
# it in picture memory 2 by pressing [OPTN][F1][F2].  (You can use other
# picture memories if you change the line "RclPict 2" in Prog "~QBERT").
# If you haven't got enough free memory, uncomment the marked lines in
# Prog "~QBERT", which will make the screen redraw whenever you change
# level.
#
# * How to play *
#
# Run "~QBERT".  The default keys are 7,4,9 and 6.  If you change the keys,
# you will be asked to choose keys for Up, Down, Left and Right.  On
# the pyramid, these correspond to Top-Left, Bottom-Right, Bottom-Left and
# Top-Right.
#
#
# Global subroutines:
#
# This game also uses these subroutines from tlgames.ctf:
# 
#   +GAMEOVR   |- Draws the "Game Over" screen
#   GO2       /
#   +SETKEYS  Set up keys
#   +YESNO    Wait for either Y or N to be pressed
#   +GK       Wait for any key to be pressed


@@ Program "~QBERT"
# Main routine

"   ~~~ QBERT! ~~~"
74->U:53->D:73->L:54->R
Prog "+SETKEYS"
0->K:0->T:5->V
Lbl R:'NEW LEVEL
K=>Graph Y>0
K=>Graph Y<0
Isz K
Seq(0,X,1,53,1->List6
'Prog "QBDRAWPY"        ; Uncomment this line and
RclV-Win 1              ; \ comment these two if you haven't
RclPict 2               ; / got enough space to store the pyramid in Pict 2
For 1->A To V
Text 2+7A,120,"Q"
Next
3->A~B
Prog "QBPAINT"
499->N
1->P
0->E
Lbl 0:'MAIN LOOP
Text 2,107,N(N>0
N<=99=>N>90=>Text 2,115," "
N<=9=>Text 2,111," "
Dsz N:0
Text 6A+6B-9,62-7(B-A,"Q"
If E<2+(K>2)+(K>3) And Ran#<=.5-.3/K
ThenIsz E
1->List6[44+2E
1->List6[45+2E
IfEnd
If E
ThenFor 1->C To E
Ran#>1/3E=>Prog "QBMOVEME"
List6[44+2C->\r
List6[45+2C->\th
\r+\th-1
List6[\th+.5Ans(Ans-1
Ans=0=>Text 6\r+6\th-9,63-7(\th-\r," "
Ans<>0=>Text 6\r+6\th-9,63-7(\th-\r,"-"
If Ran#<.5
Then1+List6[44+2C->List6[44+2C
Else1+List6[45+2C->List6[45+2C
IfEnd
List6[44+2C->\r
List6[45+2C->\th
If \r+\th>10
ThenDsz E:0
For 1->X To 2E
List6[47+X->List6[45+X
Next
Dsz C:0
ElseText 6\r+6\th-9,63-7(\th-\r,"O"
\r=A=>\th=B=>Prog "QBDISC"
IfEnd
Next
IfEnd
Prog "QBMOVEME"
P=0=>Goto R
Goto 0


@@ Program "QBDRAWPY"
# Draws pyramid

RclV-Win 1
For 1->A To 9
For 1->B To A
Plot 57-7A+14B,69-6A
Prog "QBDRAWCB"
Next
Next
Lbl 0
'TARDISES
For 0->A To 1
Plot 25+78A,50
For 0->B To 12 Step 9
B=9=>3->B
B<>0
F-Line X-5Ans,Y-B,X+5-5Ans,Y-2-B
F-Line X-5+5Ans,Y-2-B,X+5Ans,Y-B
Next
For (-)5->B To 5 Step 5
6-2(B<>0
F-Line X+B,Y-Ans,X+B,Y-7-Ans
Next
Next
Text 2,7,"SCORE:"
Text 2,80,"BONUS:"


@@ Program "QBDRAWCB"
# Draws cubes making up pyramid

F-Line X+1,Y-1,X+7,Y-4
For 3->Z To 4
F-Line X+7,Y-2-Z,X,Y-6-Z
F-Line X,Y-6-Z,X-7,Y-2-Z
Next
F-Line X-7,Y-4,X,Y


@@ Program "QBPAINT"
# Sets cube as 'painted'

A+B-1
B+.5Ans(Ans-1
List6[Ans]<>0=>Return
1->List6[Ans
Isz P
T+10K->T
Text 2,32,T
P<45=>Return
T+N->T
0->P
Text 6A+6B-9,62-7(B-A,"Q"


@@ Program "QBMOVEME"
# Move Qbert

GetKey->J
J<>U=>J<>D=>J<>L=>J<>R=>Return
Dsz N:0
Text 6A+6B-9,62-7(B-A,"-"
J=U=>Dsz A:0
J=D=>Isz A
J=L=>Isz B
J=R=>Dsz B:0
A=0 Or B=0 Or A+B>10=>Goto 2
Text 6A+6B-9,62-7(B-A,"Q"
If E
ThenFor 1->W To E
A=List6[44+2E] And B=List6[45+2E]=>Prog "QBDISC"
Next
IfEnd
Prog "QBPAINT"
Return
Lbl 2
'OFF-PYR
A+B=5=>Goto 3
Prog "QBDIE"
V=0=>Goto Z
Return
Lbl 3
N-3->N
For 1->J To 4
Orange PlotChg 24+78(A<>0,48
Orange PlotChg X+1,Y
Orange PlotChg X+1,Y
Next
1->A~B
Prog "QBPAINT"


@@ Program "QBDIE"
# Kill Qbert, end game if dead

For 1->A To 9
Text 2+7V,120,"Q"
Text 64-Y,X," "
Next
3->A~B
Dsz V
Return
Prog "+GAMEOVR"
Stop


@@ Program "QBDISC"
# Kill Qbert with cascading balls

For 1->H To 3
Text 6A+6B-9,62-7(B-A,"Q"
Text 64-Y,X," "
Text 64-Y,X+1,"O"
Next
Prog "QBDIE"


# ========================================================================
# CTF compliant.  See http://www.york.ac.uk/~tw104/casio/ for details.
#
# More programs and information at:
#              http://www.ex-parrot.com/~tom/calcs/calcs/encyc/
#
# This file last compiled: Friday, 30 April, 1999
# ========================================================================