aUCBLogo Demos and Tests / am
setcaseignored false
to addBonus :type_
if :type_ == 1 [
if or :quit == true :reset_ == true [stop]
make "timeLeft :timeLeft-1
make "score :score+5
make "textCount 1 printText
make "textCount 2 printText
waitStop 1
if :timeLeft > 0 [addBonus :type_]
]
if :type_ == 2 [
if or :quit == true :reset_ == true [stop]
make "lives :lives-1
make "score :score+400
make "textCount 2 printText
make "textCount 3 printText
waitStop 40
if :lives > 1 [addBonus :type_]
]
end
to buttonDraw :num :action
local [bdTurtle bdPos bdHeading bdPen]
bdTurtle=turtle
setTurtle turtle0
make "bdPos pos
make "bdHeading heading
make "bdPen pen
setPC RGB 1 1 0
pu setpos item 3 (item :num :buttonList)
drawText item 1 (item :num :buttonList) "getLength
seth 270
pu fd :textLength/2 tfd 9 rt 90
sbitblock textLength+13*textScale+2 38*textScale+1
if :action == "draw
[ pd
repeat 2
[ tfd 8 fd 22*:textScale tfd 8 rt 90
tfd 8 fd :textLength tfd 5 rt 90
]
pu tfd 9 rt 90 tfd 9
make "tempPos pos
drawText item 1 (item :num :buttonList) "draw
setpos :tempPos
make "x round(first :tempPos)
make "y round(last :tempPos)
setpos list :x :y
seth 180 tfd 4 lt 90
pd
ifelse((item 1 (item :num :buttonList)) == [Instructions]) [tfd 7] [tfd 12]
]
setTurtle turtle0
pu setpos :bdPos
seth :bdHeading
setpen :bdPen
setTurtle bdTurtle
end
to buttonHit
local [bhTurtle bhPos bhHeading bhPen bhDone bhNum]
bhTurtle=turtle
setTurtle turtle0
make "bhPos pos
make "bhHeading heading
make "bhPen pen
make "bhNum 0
make "bhDone false
do_while
[ make "bhNum :bhNum+1
if(item 2 (item :bhNum :buttonList)) == true
[ drawText item 1 (item :bhNum :buttonList) "getLength
make "x1 (first item 3 (item :bhNum :buttonList))-:textLength/2-10*:textScale
make "x2 (first item 3 (item :bhNum :buttonList))+:textLength/2+6*:textScale
make "y1 last item 3 (item :bhNum :buttonList)
make "y2 (last item 3 (item :bhNum :buttonList))+42*:textScale
if(and ((first MousePos) > :x1) ((first MousePos) < :x2)
((first bf MousePos) > :y1) ((first bf MousePos) < :y2))
[
;(pr "HIT bhNum)
;Menu
if :bhNum == 1 [
menuOn true
make "bhDone true
]
;Menu Off
if :bhNum == 2 [
menuOn false
]
;Play
if :bhNum == 3 [commandPlay]
;Instructions
if :bhNum == 4 [commandInstructions]
;Quit
if :bhNum == 5 [
make "quit true
make "open_quit true
]
;High Scores
if :bhNum == 6 [commandHighScores]
;High Scores Done
if :bhNum == 7 [commandDone]
;Instructions Done
if :bhNum == 8 [commandDone]
;Continue
if :bhNum == 9 [
make "paused false
]
;reset_
if :bhNum == 10 [
make "paused false
make "reset_ true
]
]
]
][and :bhNum < :numButtons :bhDone == false]
setTurtle turtle0
pu setpos :bhPos
seth :bhHeading
setpen :bhPen
setTurtle bhTurtle
end
to buttonOn :num :action
setItem :num :buttonList (list (item 1 (item :num :buttonList)) :action (item 3 (item :num :buttonList)))
if :action == true [buttonDraw :num "draw]
if :action == false [buttonDraw :num "erase]
end
to clearBox
cs
end
to clearBox_
setTurtle turtle1
setpos(list (:displayWidth/2-:displayWidth)+1 (:displayHeight/2-:displayHeight)+1)
setFC 0
fillRect pos (list :displayWidth+1 :displayHeight+1)
end
to commandPlay
; mouseoff
make "playing true
menuOn false
make "open_quit true
end
to commandInstructions
; keyboardoff
make "menuState :menuOn_
make "doneButtonOn true
make "displayInstructions_ true
make "open_quit true
menuOn false
buttonOn 1 false
make "bhDone true
end
to commandHighScores
; keyboardoff
make "menuState :menuOn_
make "doneButtonOn true
make "displayHighScores_ true
make "open_quit true
menuOn false
buttonOn 1 false
make "bhDone true
end
to commandDone
make "displayHighScores_ false
make "open_quit false
make "displayInstructions_ false
buttonOn 8 false
buttonOn 7 false
make "menuOn_ :menuState
make "doneButtonOn false
end
to displayHighScores
loadScores
setTurtle turtle0
drawText [High Scores] "getLength
setpos list 0-(:textLength/2) (:displayHeight/2-:textBarHeight*2)
drawText [High Scores] "draw
repeat 10
[
setTurtle turtle0
setpos list (-1*(12*:scale*17/2)) ((22*:scale)*6-(22*:scale)*repcount)
make "name item repcount :hiNames
drawText :name "draw
make "scoreS item repcount :AM_Hiscores
if :scoreS == 0 [make "scoreS "]
drawText :scoreS "getLength
setpos list ((12*:scale*17/2)-:textLength) ((22*:scale)*6-(22*:scale)*repcount)
drawText :scoreS "draw
]
end
to displayInstructions
clearBox
setTurtle turtle0
drawText [Instructions] "getLength
setpos list 0-(:textLength/2) (:displayHeight/2-30*:textScale)
drawText [Instructions] "draw
make "ty :displayHeight/2-40*:textScale
make "tx 0-:displayWidth/2+102*:textScale
make "th 0-:displayWidth/2+66*:textScale ;heading
make "ti 0-:displayWidth/2+150*:textScale ;indent
make "line 32*:textScale
setpos(list :th :ty-:line*1) drawText [Playing the game:] "draw
setpos(list :ti :ty-:line*2) drawText [Navigate your mining ship through the asteroid field and] "draw
setpos(list :tx :ty-:line*3) drawText [pick up the crystals. \ When you have collected all the crystals] "draw
setpos(list :tx :ty-:line*4) drawText [you can see, you advance to the next level to mine a new section] "draw
setpos(list :tx :ty-:line*5) drawText [of the asteroid field. \ If you can finish all 13 levels, you win!] "draw
setpos(list :ti :ty-:line*6) drawText [Don't get going too fast. \ In space, the only way to slow] "draw
setpos(list :tx :ty-:line*7) drawText [down is to turn around and fire your engine in the other] "draw
setpos(list :tx :ty-:line*8) drawText [direction. \ By the Time you finish doing that, you may be dust!] "draw
setpos(list :th :ty-:line*9.5) drawText [Ship controls:] "draw
setpos(list :tx :ty-:line*10.5) drawText [J....Turn the ship to the left] "draw
setpos(list :tx :ty-:line*11.5) drawText [K....Fire the engines] "draw
setpos(list :tx :ty-:line*12.5) drawText [L....Turn the ship to the right] "draw
setpos(list :th :ty-:line*14) drawText [Game controls:] "draw
setpos(list :tx :ty-:line*15) drawText [Q....Quit] "draw
setpos(list :tx :ty-:line*16) drawText [P....Pause or reset] "draw
end
to displayText :text_ :pause_
clearBox
drawText :text_ "getLength
setpos(list 0-:textLength/2 0)
drawText :text_ "draw
waitStop :pause_
end
to drawChar :c :action
make "validChar true
setTurtle turtle0
setPenSize list round(1*:scale) round(1*:scale)
seth 0
make "cPos pos
setPC RGB 1 1 0
pd
if not :action == "getLength
[ charvar=word "char_ c
; if name? charvar [run thing charvar]
if procedure? charvar [run charvar]
]
make "charWidth 0
if and c >= "A c <= "Z [make "charWidth 12]
if and c >= "a c <= "z [make "charWidth 10]
if and c >= "0 c <= "9 [make "charWidth 12]
if :c == "I [make "charWidth 7]
if :c == "f [make "charWidth 9]
if :c == "j [make "charWidth 5]
if :c == "i [make "charWidth 1]
if :c == "l [make "charWidth 1]
if :c == "m [make "charWidth 11]
if :c == "r [make "charWidth 9]
if :c == "t [make "charWidth 9]
if :c == "1 [make "charWidth 11]
if :c == ": [make "charWidth 1]
if :c == "- [make "charWidth 10]
if :c == "? [make "charWidth 11]
if :c == "! [make "charWidth 1]
if :c == ". [make "charWidth 3]
if :c == ", [make "charWidth 5]
if :c == "' [make "charWidth 5]
if :c == "" [make "charWidth 6]
if :c == "_ [make "charWidth 11]
if :c == 32 [make "charWidth 7]
pu
setpos :cPos
seth 0
ifelse :charWidth == 0
[ make "validChar false
][
if not :action == "getLength [
;the 3 in "tfd 3" is assumed to be 3 by inputText.keyHit and most button procedures
rt 90 tfd :charWidth tfd 3 lt 90
]
make "textLength :textLength+:charWidth+3
]
end
to drawCrystal :pos1 :action
local "points
if not((last :pos1) == :offScreenY) [
setTurtle turtle0
make "points array 6
setPenSize(list round(1*:scale) round(1*:scale))
seth 0
make "color abs(remainder first(:pos1) 7)
if :action == "draw [
if :color == 0 [setPC RGB 0 1 1]
if :color == 1 [setPC RGB 1 .63 .74]
if :color == 2 [setPC RGB .95 .66 1]
if :color == 3 [setPC RGB 0 .7 1]
if :color == 4 [setPC RGB 1 1 1]
if :color == 5 [setPC RGB .66 1 .66]
if :color == 6 [setPC RGB 1 1 .66]
]
if :ee1 == true [
make "color abs(remainder first(:pos1) 2)
if :action == "draw [
if :color == 0 [setPC RGB 1 .4 .4]
if :color == 1 [setPC RGB 0 1 0]
]
]
if :action == "erase [setPC 0]
repeat 6 [
pu setpos :pos1 pd
ifelse(or repcount == 1 repcount == 4) [
fd :crystalRad
setItem repcount :points pos
][
fd (:crystalRad/4*3)
setItem repcount :points pos
]
ifelse(or repcount == 2 repcount == 5) [rt 90] [rt 45]
]
setpos item 6 :points
repeat 6 [setpos item repcount :points]
pu
]
end
to drawRock :pos1
local "points
setTurtle turtle0
setPenSize(list round(2*:scale) round(2*:scale))
make "x item 1 :pos1
make "y item 2 :pos1
make "d :x
seth :d
make "color (remainder (abs :y) 6)
if :color == 0 [setPC RGB .47 .47 .47]
if :color == 1 [setPC RGB .52 .52 .52]
if :color == 2 [setPC RGB .57 .57 .57]
if :color == 3 [setPC RGB .61 .61 .61]
if :color == 4 [setPC RGB .58 .52 .43]
if :color == 5 [setPC RGB .58 .58 .49]
make "points array 18
;create a symetrical rock using twice as many points as that requires
repeat 9 [
setpos :pos1
rt 360/9 fd :rockRad
setItem repcount*2-1 :points pos
setItem repcount*2 :points pos
]
;replace "random" points in the symetrical rock with nearby points to make it more
;irrigular
repeat 5 [
;select the point to mess with (must be between two points that are on the edge). Uses
;an expression based on the rock's screen position instead of a random number so that
;the same point is selected each Time the rock is drawn
if repcount == 1 [make "pt abs((remainder :x 8))*2+2]
if repcount == 2 [make "pt abs((remainder :y 8))*2+2]
if repcount == 3 [make "pt abs((remainder (:x-:y) 8))*2+2]
if repcount == 4 [make "pt abs((remainder (:x+:y) 8))*2+2]
if repcount == 5 [make "pt abs((remainder (:x*3) 8))*2+2]
;move the point away from the edge
setpos :pos1 seth :d
if repcount == 1 [rt 360/18*(:pt+1) fd :rockRad-:rockRad/3]
if repcount == 2 [rt 360/18*(:pt+1) fd :rockRad-:rockRad/3.5]
if repcount == 3 [rt 360/18*(:pt+1) fd :rockRad-:rockRad/4]
if repcount == 4 [rt 360/18*(:pt+1) fd :rockRad-:rockRad/4.5]
if repcount == 5 [rt 360/18*(:pt+1) fd :rockRad]
make "pt :pt+1
setItem :pt :points pos
]
setpos item 1 :points
pd
;connect the points to draw the rock
repeat 18 [setpos item repcount :points]
setpos item 1 :points
pu
setPenSize(list round(1*:scale) round(1*:scale))
end
to drawShip :x :y :d :action
setTurtle turtle0
setPenSize(list
round(1*:scale*:shipRad/:normalShipRad)
round(1*:scale*:shipRad/:normalShipRad))
make "r ((255-138)/:shipFadeStart*:shipGlow+138)/255
make "g ((255-60)/:shipFadeStart*:shipGlow+60)/255
make "b ((255-255)/:shipFadeStart*:shipGlow+255)/255
if :shipGlow > :shipFadeStart [make "r 1 make "g 1 make "b 1]
if :action == "draw
[make "blink :blink+1
if :blink == 41 [make "blink 0] ;blink cyles through two seconds, then resets (there are 20 fps)
]
if (or :action == "draw :action == "redraw) [setPC RGB :r :g :b]
if :action == "erase [setPC 0]
ifelse :exploding == false
[;draw right side of nose
setpos list :x :y
seth :d
fd :shipRad
make "pos1 pos
bk :shipRad
rt 67.5
fd :shipRad3
make "pos2 pos
pd
fd :shipRad3*2
bk 1*:scale
make "light1Pos pos
fd 1*:scale
rt 112.5
fd :shipSide
; if (or :leaveStep < :numLeaveSteps/3*2 :leaving == false)
; [drawShip_light :light1Pos]
;draw back of ship, trace back over it partway, draw engine if thrusting, then trace forward again--
;this keeps the engine over top of all the other lines
rt 45
fd :shipSide-1.414*:scale
rt 45
fd :shipSide+2*:scale
rt 45
fd :shipSide-1.414*:scale
bk :shipSide-1.414*:scale
lt 45
if(or :thrust == true :action == "erase)
[setPenSize(list
round(2*:scale*:shipRad/:normalShipRad)
round(2*:scale*:shipRad/:normalShipRad))
]
if(and (:leaveStep < :numLeaveSteps/5*4) (:thrust == true)
(or :action == "draw :action == "redraw))
[setPC RGB 1 .9 .5
]
bk :shipSide+2*:scale
if (or :action == "draw :action == "redraw) [setPC RGB :r :g :b]
setPenSize(list
round(1*:scale*:shipRad/:normalShipRad)
round(1*:scale*:shipRad/:normalShipRad))
pu
fd :shipSide+2*:scale
rt 45
fd :shipSide-1.414*:scale
pd
rt 45
fd :shipSide
;draw left side of nose
rt 112.5
fd :scale
make "light2Pos pos
bk :scale
fd :shipRad3*2
if (or :leaveStep < :numLeaveSteps/3*2 :leaving == false)
[drawShip_light :light2Pos]
lt 93.06
fd 12.95*:scale*:shipRad/:normalShipRad
rt 141.11
fd 12.95*:scale*:shipRad/:normalShipRad
pu
setpos list :x :y
seth :d
;draw cockpit begin
rt 90 pd
fd :shipRad6/2
rt 45 fd :shipRad6Diag
rt 45 fd :shipRad3
rt 90 rt 45 fd :shipRad6Diag
lt 45 fd :shipRad6
lt 45 fd :shipRad6Diag rt 45
rt 90 fd :shipRad3
rt 45 fd :shipRad6Diag
rt 45 fd :shipRad6/2
lt 90 pu
;draw cockpit end
]
[ ;explosion--random numbers for the fragment attribute lists are picked in playLoop
if :action == "draw [make "expLen :expLen-:shipRad/:numExpSteps]
repeat :numFrags
[ setpos list :x :y seth :d
rt 360/:numFrags*repcount
make "fal item repcount :fragments ;fal stands for fragment attribute list
fd :shipRad*(item 1 :fal)+:expStep*(item 2 :fal)
rt (item 3 :fal)+:expStep*(item 4 :fal)
pd
fd :expLen*(item 5 :fal)*:scale
rt 180
fd :expLen*(item 6 :fal)*:scale
if (item 7 :fal) == 1
[ rt (item 8 :fal) fd :expLen*(item 9 :fal)*:scale
]
pu
]
]
if and(:shipGlow > 0) (:action == "draw)
[ make "shipGlow :shipGlow-1
]
make "erase_ false
end
to drawShip_light :lightPos
pu
make "h heading
make "pos3 pos
setpos :lightPos
seth 225 fd 1.414*:scale
;draw light if it is on, erase it if it is off
if and (:blink > 19) (or :action == "draw :action == "redraw) [
setFC RGB .8 .2 .2
; sbitblock round(2.4*:scale/(:leaveStep+1)) round(2.4*:scale/(:leaveStep+1))
setFC 0
]
if (:action == "erase) [
; sbitblock round(2.4*:scale) round(2.4*:scale)
]
setpos :pos3
seth :h
pd
end
to drawText_ txt action
setTurtle turtle0
seth 90
setLabelAlign 1 0
ifelse action=="getLength
[ textLength=first LabelSize txt
][Label txt
]
end
to drawText :txt :action
setTurtle turtle0
make "tPos pos
make "textLength 0
seth 0
ifelse list? :txt
[ make "numWords count :txt
repeat :numWords
[ make "chars item repcount :txt
make "numChars count :chars
repeat :numChars
[ drawChar item repcount :chars :action
]
if not repcount == :numWords
[ rt 90 tfd 6 lt 90
textLength=textLength+6
]
]
][
make "numChars count :txt
repeat :numChars
[ drawChar (item repcount :txt) :action
]
]
make "textLength round (:textLength*:textScale )
if :action == "getLength [pu setpos :tPos seth 0]
end
to findXy :object
make "findNew false
if :object == "rock
[ make "neighbor 0
make "x round((random round(:gameWidth-:rockRad*4)) -
(:gameWidth-:rockRad*4)/2
)
make "y round((random round(:gameHeight-:rockRad*4)) -
(:gameHeight-:rockRad*4)/2-:textBarHeight/2
)
setpos(list :x :y)
;make sure rock is not on top of ship
if (distance[0 0]) < (:rockRad+:shipRad+6) [make "findNew true]
;make sure rock is not touching another--this must be the last thing checked for a rock
;if it is too close to another for a ship to pass between them, that's OK only if the other rock does not already have a neigbor
repeat (:loop1-1)
[ if (distance(item repcount :rocks)) < (:rockRad*2+:shipRad*2+6)
[ ifelse (or (item repcount :rockNeighbors) > 0
(:neighbor>0)
(distance(item repcount :rocks)) < :rockRad*2+3)
[ make "findNew true
make "neighbor 0
][
make "neighboringRock repcount
make "neighbor 1
]
]
]
if and (:findNew == false) (:neighbor > 0) [
setItem :loop1 :rockNeighbors :neighbor
setItem :neighboringRock :rockNeighbors :loop1
]
]
if :object == "crystal [
make "x round((random round(:gameWidth-:shipRad*3.2)) -
(:gameWidth-:shipRad*3.2)/2
)
make "y round((random round(:gameHeight-:shipRad*3.2)) -
(:gameHeight-:shipRad*3.2)/2-:textBarHeight/2
)
setpos(list :x :y)
;make sure crystals don't overlap rocks
repeat :numRocks [
if (distance(item repcount :rocks)) < (:rockRad+:crystalRad+2) [
make "findNew true]
]
;make sure crystal is not on top of ship
if (distance[0 0]) < (:crystalRad+:shipRad+2) [make "findNew true]
;make sure crystal is not too close to another
if :findNew == false [
repeat (:loop1-1) [
if (distance(item repcount :crystals)) < (:crystalRad*2+2) [make "findNew true]
]
]
;make sure crystal is not so close to two rocks that the ship can't get to it
if :findNew == false [
repeat :numRocks [
if (distance(item repcount :rocks)) < (:shipRad*2+:rockRad+2) [
make "y :y+0.001 ;marks crystal as too close to a rock to glint
make "firstRock repcount
repeat :numRocks [
if not(repcount == :firstRock) [
if (distance(item repcount :rocks)) < (:shipRad*2+:rockRad+2) [make "findNew true]
]
]
]
]
]
]
if(and :object == "rock :findNew == true) [
make "rockCounter :rockCounter+1
if :rockCounter < 250 [findXy "rock]
]
if(and :object == "crystal :findNew == true) [findXy "crystal]
end
to gameLoop
make "quit false
make "reset_ false
; (keyboardon [processKey keyboardvalue]
; [processKey keyboardvalue+200]
; )
; mouseon [buttonHit] [] [] [] []
menuOn false
open_loop
if not(:quit == true) [
initGame
levelLoop
]
if not(:quit == true) [gameLoop]
setTurtle turtle0 ht pu
setTurtle turtle1 ht pu
setTurtle turtle2 ht pu
setTurtle turtle3 ht pu
end
to glint :action
if :glintStep == 1 [
seth 315
make "glintSize 0
make "speedUp random 3
ifelse :speedUp == 0 [make "rotateSpeed 0] [make "rotateSpeed (random 20)+5]
]
if :glintStep == 20 [drawCrystal (item :glintCrystal :crystals) "draw]
setTurtle turtle3
setPenSize(list round(1*:scale) round(1*:scale))
pu
setpos item :glintCrystal :crystals
seth 0
if :speedUp == 0 [rt 45 fd :crystalRad/4*3 lt 45]
if :speedUp == 1 [lt 45 fd :crystalRad/4*3 rt 45]
if :speedUp == 2 [rt 135 fd :crystalRad/4*3 lt 135]
pd
if :glintStep > 0 [
setPC 0
seth 0
rt :rotateSpeed*(:glintStep-1)
repeat 4[fd :glintSize bk :glintSize rt 90]
drawCrystal (item :glintCrystal :crystals) "draw
]
if and :glintStep < 20 :action == "animate [
setTurtle turtle3
if :glintStep < 11 [make "glintSize :glintStep*:scale]
if :glintStep > 10 [make "glintSize 21*:scale-:glintStep*:scale]
setPC RGB 1 1 1
seth 0
if :speedUp == 0 [make "rotateSpeed :rotateSpeed+2]
rt :rotateSpeed*:glintStep
repeat 4[fd :glintSize bk :glintSize rt 90]
]
pu
end
to checkScreen
make "x 800 ;item 3 machine
make "y 600 ;item 4 machine
; if (:y < 310) [
; messagebox [Screen Problem] [The screen height needs to be at least 310. Set the Asteroid Miner shortcut accordingly. (Try "C:\MSWLogo\logo.exe -h 500 -w 700 -f -l AM.lgo" as the shortcut target.)]
; bye
; ]
; if (or (:x/:y < 1.39) (:x/:y > 1.405)) [
; messagebox [Screen Problem] [The screen width needs to be 1.4 times the height. Set the Asteroid Miner shortcut accordingly. If the Logo screen fills the desktop, the height or width may be too large, in which case Logo is ignoring it.]
; bye
; ]
end
to go
cs
; windowset "Commander 2
; windowset "Editor 2
; setfocus[MSWLogo Screen]
initO
noRefresh
setScreenColor 0
checkScreen
initChars
initMain
gameLoop
; keyboardoff
; mouseoff
; bye
end
to hitCrystalCheck
;checks all the crystals, whether they are on the screen or not, to keep the speed more constant on slow computers
repeat :maxCrystals [
make "x first(item repcount :crystals)
make "y last(item repcount :crystals)
make "dist2 (:shipX-:x)*(:shipX-:x)+(:shipY-:y)*(:shipY-:y)
if and (:dist2 < :shipCrystal2) (:exploding == false) [
if and :glintStep < 20 :glintCrystal == repcount [
make "glintStep :glintStep+1
glint "erase
make "glintStep 20
]
drawCrystal (item repcount :crystals) "erase
setItem repcount :crystals(list :offScreenX :offScreenY)
make "numCrystals :numCrystals-1
if :numCrystals == 0 [
make "bonus :timeLeft*5
make "leaving true
make "thrust true
timerOff
]
make "score :score+:crystalWorth
make "textCount 1 printText
make "textCount 2 printText
make "crystalWorth :crystalWorth+5
make "shipGlow :shipFadeStart+4
]
if and :dist2 < (:shipCrystal2*4) (:exploding == true) [
drawCrystal(item repcount :crystals) "draw
]
]
end
to hitRockCheck
;checks all the rocks, whether they are on the screen or not, to keep the speed more constant on slow computers
repeat :numRocks [
make "x first(item repcount :rocks)
make "y last(item repcount :rocks)
make "dist2 (:shipX-:x)*(:shipX-:x)+(:shipY-:y)*(:shipY-:y)
make "shipRock2 (:shipRad+:rockRad)*(:shipRad+:rockRad)
if (and :dist2 < :shipRock2 :leaving == false :exploding == false) [
timerOff
drawShip :shipXInt :shipYInt :dr "erase
;save the point where the ship hit the rock, for the explosion bitmap
;turtle was set by drawShip
seth towards (item repcount :rocks) fd :shipRad-:shipRad3
make "expCtr (list ((first pos)-:shipRad) ((last pos)-:shipRad))
make "exploding true
make "expLen :shipRad
]
if and :dist2 < (:shipRock2*2) (or :exploding == true :leaving == true) [
drawRock(item repcount :rocks)
]
if (and (:dist2 < :shipRock2) (:leaving == true)) [
make "behindRock true
]
]
end
to initChars
charlist=
[ [A tfd 11 make "pos1 pos pu tfd 10 rt 90 tfd 5.5 make "pos2 pos tfd 5.5 rt 90 tfd 10 pd rt 90 tfd 11 tbk 11 lt 90 tfd 11 tbk 11 setpos :pos2 setpos :pos1]
[B tfd 21 rt 90 tfd 10 rtCnr tfd 8 rtCnr tfd 10 lt 90 tfd 11 lt 90 tfd 10 ltCnr tfd 9 lt 45 tfd 1.4]
[C pu rt 90 tfd 11 rt 180 pd tfd 10 rtCnr tfd 19 rtCnr tfd 11]
[D tfd 21 rt 90 tfd 10 rtCnr tfd 19 rtCnr tfd 10]
[E rt 90 tfd 11 tbk 11 lt 90 tfd 11 rt 90 tfd 10 tbk 10 lt 90 tfd 10 rt 90 tfd 12]
[F tfd 11 rt 90 tfd 10 tbk 10 lt 90 tfd 10 rt 90 tfd 12]
[G pu rt 90 tfd 11 lt 90 pd tfd 11 lt 90 tfd 5 tbk 5 rt 90 tbk 11 lt 90 tfd 10 rtCnr tfd 19 rtCnr tfd 11]
[H tfd 11 rt 90 tfd 11 tbk 11 lt 90 tfd 11 pu rt 90 tfd 11 rt 90 tfd 1 pd tfd 22]
[I pu rt 90 pd tfd 6 tbk 3 lt 90 tfd 21 lt 90 tfd 3 tbk 7]
[J pu tfd 6 rt 180 pd tfd 5 ltCnr tfd 6 ltCnr tfd 20 lt 90 tfd 3 tbk 7]
[K pu rt 90 tfd 6 rt 45 tfd 1.4 make "pos1 pos tbk 1.4 lt 45 bk 11 lt 90 pd tfd 11 make "pos2 pos tfd 11 rt 90 pu tfd 11 rt 90 tfd 1 pd setpos :pos2 setpos :pos1]
[L rt 90 tfd 11 tbk 11 lt 90 tfd 22]
[M pu rt 90 tfd 11 lt 90 pd tfd 21 make "pos1 pos tbk 21 lt 90 pu tfd 6 rt 90 tfd 11 make "pos2 pos tbk 11 lt 90 tfd 5 rt 90 pd tfd 21 setpos :pos2 setpos :pos1]
[N pu rt 90 tfd 11 pd make "pos1 pos lt 90 tfd 21 tbk 21 pu lt 90 tfd 11 rt 90 pd tfd 21 setpos :pos1]
[O pu tfd 1 pd repeat 2 [tfd 19 rtCnr tfd 9 rtCnr]]
[P tfd 11 rt 90 tfd 10 tbk 10 lt 90 tfd 10 rt 90 tfd 10 rtCnr tfd 8 rt 45 tfd 1.4]
[Q pu make "pos1 pos rt 90 tfd 11 lt 90 lt 60 pd tfd 7 pu setpos :pos1 rt 60 tfd 1 pd repeat 2 [tfd 19 rtCnr tfd 8 rtCnr]]
[R pu rt 90 tfd 11 rt 45 tfd 1.4 make "pos1 pos tbk 1.4 lt 45 tbk 11 lt 90 pd tfd 11 rt 90 tfd 10 tbk 10 lt 90 tfd 10 rt 90 tfd 10 rtCnr tfd 8 rtCnr tfd 9 setpos :pos1]
[S rt 90 tfd 10 ltCnr tfd 9 ltCnr tfd 9 rtCnr tfd 8 rtCnr tfd 11]
[T pu rt 90 tfd 6 pd lt 90 tfd 21 lt 90 tfd 6 tbk 12]
[U pu tfd 1 pd tfd 20 rt 180 tfd 20 ltCnr tfd 9 ltCnr tfd 21]
[V pu rt 90 tfd 11 lt 90 tfd 21 rt 180 pd tfd 11 tbk 1 make "pos1 pos pu tfd 11 rt 90 tfd 5.5 make "pos2 pos tfd 5.5 rt 90 tfd 10 pd tfd 11 tbk 11 setpos :pos2 setpos :pos1]
[W pu rt 90 tfd 11 lt 90 tfd 21 rt 180 rt 90 tfd 11 lt 90 pd tfd 21 make "pos1 pos tbk 21 lt 90 pu tfd 6 rt 90 tfd 11 make "pos2 pos tbk 11 lt 90 tfd 5 rt 90 pd tfd 21 setpos :pos2 setpos :pos1]
[X pu rt 90 tfd 11 lt 90 tfd 21 rt 180 pu make "pos1 pos tfd 21 lt 45 tfd 1.4 make "pos2 pos tbk 1.4 rt 45 rt 90 tfd 11 lt 45 tfd 1.4 make "pos3 pos tbk 1.4 rt 45 rt 90 tfd 21 pd setpos :pos2 pu setpos :pos1 pd setpos :pos3]
[Y pu rt 90 tfd 11 lt 90 tfd 21 rt 45 tfd 1.4 make "pos1 pos tbk 1.4 lt 45 tbk 21 lt 90 tfd 6 rt 90 tfd 11 make "pos2 pos tbk 11 lt 90 tfd 5 rt 90 tfd 21 pd setpos :pos2 rt 180 tfd 11 tbk 11 setpos :pos1]
[Z make "pos1 pos rt 90 tfd 12 pu tbk 1 lt 90 tfd 21 pd lt 90 tfd 11 tbk 11 setpos :pos1]
[a pu rt 90 tfd 1 pd tfd 8 tbk 1 lt 90 tfd 11 lt 90 tfd 7 ltCnr tfd 9 lt 45 tfd 1.4]
[b pu rt 90 tfd 9 rt 180 tfd 1 pd tfd 8 rt 90 tfd 21 tbk 10 rt 90 tfd 8 rtCnr tfd 9 rt 45 tfd 1.4]
[c pu rt 90 tfd 9 rt 180 pd tfd 8 rtCnr tfd 9 rtCnr tfd 9]
[d pu rt 90 tfd 1 pd tfd 8 lt 90 tfd 21 tbk 10 lt 90 tfd 8 ltCnr tfd 9 lt 45 tfd 1.4]
[e pu rt 90 tfd 8 rt 180 pd tfd 7 rtCnr tfd 9 rtCnr tfd 7 rtCnr tfd 4 rt 90 tfd 9]
[f pu rt 90 tfd 4 pd lt 90 tfd 11 lt 90 tfd 4 tbk 8 tfd 4 rt 90 tfd 8 rtCnr tfd 4]
[g pu rt 90 tfd 9 rt 180 pd tfd 8 rtCnr tfd 9 rtCnr tfd 8 rt 90 tfd 17 rtCnr tfd 7 rtCnr tfd 1]
[h pu rt 90 tfd 9 rt 180 tfd 1 tfd 8 rt 90 pd tfd 21 tbk 10 rt 90 tfd 8 rtCnr tfd 11]
[i tfd 12 pu tfd 3 pd tfd 2]
[j pu rt 90 tfd 4 lt 90 tfd 17 rt 180 pd tfd 2 pu tfd 3 pd tfd 17 rtCnr tfd 4]
[k tfd 7 make "pos1 pos tfd 14 tbk 21 rt 90 pu tfd 10 rt 90 tfd 1 make "pos2 pos tbk 1 lt 90 tbk 1 lt 90 tfd 11 pd setpos :pos1 setpos :pos2]
[l tfd 22]
[m tfd 11 rt 90 tfd 4 rtCnr tfd 10 rt 180 tfd 10 rtCnr tfd 3 rtCnr tfd 11]
[n tfd 11 rt 90 tfd 8 rtCnr tfd 11]
[o pu tfd 1 pd repeat 2 [tfd 9 rtCnr tfd 7 rtCnr]]
[p rt 90 tfd 8 ltCnr tfd 9 ltCnr tfd 8 lt 90 tfd 19]
[q pu rt 90 tfd 9 rt 180 pd tfd 8 rtCnr tfd 9 rtCnr tfd 8 rt 90 tfd 19]
[r tfd 10 rtCnr tfd 8]
[s rt 90 tfd 8 ltCnr tfd 4 ltCnr tfd 7 rtCnr tfd 3 rtCnr tfd 9]
[t pu rt 90 tfd 4 pd lt 90 tfd 11 lt 90 tfd 4 tbk 8 tfd 4 rt 90 tfd 8]
[u pu tfd 11 rt 180 pd tfd 10 ltCnr tfd 7 ltCnr tfd 11]
[v pu tfd 12 make "pos1 pos tbk 12 rt 90 tfd 5 make "pos2 pos tfd 4 lt 90 tfd 11 pd setpos :pos2 setpos :pos1]
[w pu tfd 6 pd tfd 5 tbk 5 pu make "pos1 pos tbk 6 rt 90 tfd 2 make "pos2 pos tfd 2 lt 90 tfd 5 make "pos3 pos tbk 5 rt 90 tfd 2 make "pos4 pos tfd 2 lt 90 tfd 6 pd tfd 5 tbk 5 setpos :pos4 setpos :pos3 setpos :pos2 setpos :pos1]
[x pu rt 90 tfd 9 lt 90 tfd 11 rt 180 pu make "pos1 pos tfd 11 lt 45 tfd 1.4 make "pos2 pos tbk 1.4 rt 45 rt 90 tfd 9 lt 45 tfd 1.4 make "pos3 pos tbk 1.4 rt 45 rt 90 tfd 11 pd setpos :pos2 pu setpos :pos1 pd setpos :pos3]
[y pu tfd 11 make "pos1 pos tbk 19 make "pos2 pos tfd 8 rt 90 tfd 4 make "pos3 pos tfd 5 lt 90 tfd 11 pd setpos :pos3 setpos :pos1 setpos :pos3 setpos :pos2]
[z make "pos1 pos rt 90 tfd 10 pu tbk 1 lt 90 tfd 11 pd lt 90 tfd 9 tbk 9 setpos :pos1]
[0 pu tfd 1 pd repeat 2 [tfd 19 rtCnr tfd 9 rtCnr]]
[1 pu rt 90 pd tfd 10 tbk 5 lt 90 tfd 21 lt 90 tfd 6]
[2 pu rt 90 tfd 11 lt 90 pd lt 90 tfd 11 rt 90 tfd 10 rtCnr tfd 9 ltCnr tfd 8 ltCnr tfd 11]
[3 rt 90 tfd 10 ltCnr tfd 9 ltCnr tfd 10 rt 180 tfd 10 ltCnr tfd 8 ltCnr tfd 11]
[4 pu rt 90 tfd 11 lt 90 pd tfd 21 tbk 10 lt 90 tfd 11 rt 90 tfd 11]
[5 rt 90 tfd 10 ltCnr tfd 9 ltCnr tfd 9 rtCnr tfd 9 rt 90 tfd 12]
[6 pu tfd 1 pd tfd 11 pu tbk 11 pd rt 90 rt 45 tfd 1.4 lt 45 tfd 9 ltCnr tfd 9 ltCnr tfd 9 rtCnr tfd 8 rtCnr tfd 11]
[7 pu tfd 21 rt 90 pd tfd 11 rt 90 tfd 22]
[8 pu tfd 1 pd tfd 9 rt 45 tfd 1.4 bk 1.4 lt 45 pu tbk 9 pd rt 90 rt 45 tfd 1.4 lt 45 tfd 9 ltCnr tfd 9 ltCnr tfd 9 rtCnr tfd 8 rtCnr tfd 9 rtCnr tfd 8 rtCnr]
[9 pu tfd 21 rt 90 tfd 11 rt 90 tfd 1 pd tfd 11 pu tbk 11 pd rt 90 rt 45 tfd 1.4 lt 45 tfd 9 ltCnr tfd 9 ltCnr tfd 9 rtCnr tfd 8 rtCnr tfd 10]
[: tfd 2 pu tfd 8.5 pd tfd 2]
[- pu tfd 11 rt 90 pd tfd 10]
[? pu rt 90 tfd 11 rt 180 tfd 7 rt 90 pd tfd 2 pu tfd 3 pd tfd 5 rtCnr tfd 4 ltCnr tfd 8 ltCnr tfd 8 ltCnr tfd 4]
[! tfd 2 pu tfd 3 pd tfd 17]
[. tfd 2]
[, pu tbk 4 rt 30 pd tfd 3 lt 30 tfd 2 lt 90 tfd 3]
[' pu tfd 17 rt 30 pd tfd 3 lt 30 tfd 2 lt 90 tfd 3]
[" pu tfd 19 pd tfd 3 pu rt 90 tfd 4 rt 90 tfd 1 pd tfd 4]
[_ pu tbk 2 rt 90 pd tfd 11]
]
foreach charlist
[ ;make (word "char_ first ?) bf ?
define (word "char_ first ?) (list [] bf ?)
]
end
to initGame
make "score 0
make "level 1
make "lives 4
make "gameOver false
wrap
setTurtle turtle0 ht pu
setTurtle turtle1 ht pu
setTurtle turtle2 ht pu
setTurtle turtle3 ht pu
setPenSize(list round(1*:scale) round(1*:scale))
end
to initLevel
make "quit false
make "reset_ false
make "timeLeft 40+:level*40
make "numCrystals :level*2+2
make "numRocks :level*2
make "levelOver false
make "behindRock false
make "crystalWorth 40
setShipSize :normalShipRad
end
to initLife
clearBox
repeat :numRocks [drawRock (item repcount :rocks)]
repeat :maxCrystals [drawCrystal (item repcount :crystals) "draw]
make "key 0
make "shipX 0
make "shipY 0
make "shipXInt 0
make "shipYInt 0
make "dr 0
make "oldShipX :shipX
make "oldShipY :shipY
make "oldDr :dr
make "shipDeltaX 0
make "shipDeltaY 0
make "turnRt false
make "turnLt false
make "thrust false
make "exploding false
make "leaving false
make "expStep 0
make "leaveStep 0
make "textCount 1
make "erase_ false
make "lifeOver false
make "shipGlow 0
make "blink 0 ;controls the ships blinking lights
make "glintCystal 1
make "glintStep 100
make "rockDrawCount 1
make "crystalDrawCount 1
end
to initMain
make "scale 1 ;(item 4 machine)/500 ;sets the game scale based on the height set on the command line
turtle0=turtle
turtle1=newTurtle
turtle2=newTurtle
turtle3=newTurtle
setTurtle turtle0 ht pu
setTurtle turtle1 ht pu
setTurtle turtle2 ht pu
setTurtle turtle3
ht pu
make "displayWidth 800 ;item 3 machine
make "displayHeight 600 ;item 4 machine
make "textLength 0
make "numRocks 0
make "numCrystals 0
make "score 0
make "displayHighScores_ false
make "displayInstructions_ false
make "doneButtonOn false
make "pauseNow false
make "paused false
make "playing false
make "glintCrystal 0
make "timer false
sbitblock 1 1
ifelse and (item 5 time) == 12
(and (item 6 time) > 22 (item 6 time) < 27)
[make "ee1 true]
[make "ee1 false]
ifelse and (item 5 time) == 3 (item 6 time) == 11
[make "ee2 true]
[make "ee2 false]
;CONSTANTS
make "open_scale 1.25*:scale
make "textScale (5/6)*:scale
if :scale == 1 [make "textScale 0.8]
make "numFrags 7 ;number of framents in an explosion
make "crystalRad 8*:scale ;crystals should be wider than maxSpeed
make "textBarHeight 24*:scale
make "gameWidth :displayWidth
make "gameHeight :displayHeight-:textBarHeight
make "maxLevel 13
make "rockRad 25*:scale
make "normalShipRad 14*:scale
setShipSize :normalShipRad
;it's faster if the math is done here, once, and saved in a variable
make "shipCrystal2 (:shipRad+:crystalRad)*(:shipRad+:crystalRad) ;distance squared
make "numExpSteps 30
make "numLeaveSteps 35
make "acceleration 0.4*:scale
make "maxSpeed2 (12*:scale)*(12*:scale) ;maximum speed squared
make "shipFadeStart 20 ;steps until the glowing ship starts to fade again
make "maxCrystals :maxLevel*2+2
make "maxRocks :maxLevel*2
make "rocks (array :maxRocks 1)
make "rockNeighbors (array :maxRocks 1)
make "crystals (array :maxCrystals 1)
make "offScreenX 0
make "offScreenY :displayHeight/2+:rockRad*4
repeat :maxCrystals [setItem repcount :crystals (list :offScreenX :offScreenY)]
repeat :maxRocks [setItem repcount :rocks (list :offScreenX :offScreenY)]
repeat :maxRocks [setItem repcount :rockNeighbors 0]
make "Apos (list -175*:open_scale 105*:open_scale)
make "Mpos (list -115*:open_scale 5*:open_scale)
;BITMAPS
setTurtle turtle0
; setbitindex 1
make "pos1 (list 0 0-:displayHeight/2+10*:scale)
setpos :pos1
; bitload "AM_bitmaps.bmp wait 1
; bitcut 42 42
setTurtle turtle2
; setbitindex 2
setpos(list 0 0-:displayHeight/2+10*:scale+42)
; bitcut 80 110 wait 1
; bitfit round(53*:open_scale) round(73*:open_scale)
; bitmapturtle
;this is down here to allow a "wait" to happen before bitfitting--otherwise data seems to be lost
; setbitindex 1
; bitfit round(:shipRad*2.5*:scale) round(:shipRad*2.5*:scale)
;cut numbers indexes 10-19
bitNumbers=(array 10 0)
repeat 10
[ setpos :pos1
fillRect [0 1] list 10*:scale+1 18*:scale+1
drawChar char (ascii "0)+repcount-1 "draw
setpos :pos1 seth 0
setItem repcount-1 bitNumbers
BitCopy round(10*:scale)+1 round(18*:scale)+1
]
setpos :pos1
fillRect pos1 pos1+(list :textLength 18*:scale+1)
drawText [Score:] "draw
make "scoreLength :textLength
setpos :pos1 seth 0
bitScore=BitCopy :textLength round(18*:scale)+1
setpos :pos1
fillRect pos1 pos1+(list :textLength 18*:scale+1)
drawText [Bonus:] "draw
make "bonusLength :textLength
setpos :pos1 seth 0
bitBonus=BitCopy :textLength round(18*:scale)+1
setShipSize 9*:scale
initLife
drawShip 0 0 0 "draw
pu seth 270 fd :shipRad lt 90 fd :shipRad seth 0
bitShip=BitCopy round(18*:scale)+1 round(18*:scale)+1
setShipSize :normalShipRad
;BUTTONS
make "numButtons 10
make "buttonList array :numButtons
setItem 1 :buttonList (list [Menu] true (list 0 0-:displayHeight/2+4))
setItem 2 :buttonList (list [Menu Off] false (list 0 0-:displayHeight/2+4))
setItem 3 :buttonList (list [Play] false (list -90*:scale 0-:displayHeight/2+4))
setItem 4 :buttonList (list [Instructions] false (list -197*:scale 0-:displayHeight/2+4))
setItem 5 :buttonList (list [Quit] false (list 90*:scale 0-:displayHeight/2+4))
setItem 6 :buttonList (list [High Scores] false (list 192*:scale 0-:displayHeight/2+4))
setItem 7 :buttonList (list [Done] false (list 0 0-:displayHeight/2+4))
setItem 8 :buttonList (list [Done] false (list 0 0-:displayHeight/2+4))
setItem 9 :buttonList (list [Continue] false (list 0 0+8*:textScale))
setItem 10 :buttonList (list [reset] false (list 0 0-42*:textScale))
;HIGH SCORE FILE CHECK
fileExist=filep "AM_Hiscores
; make "filelist shell [dir]
; make "fileExist false
; repeat count :filelist
; [ if (item repcount :filelist) == "AM_Hiscores
; [ make "fileExist true
; ]
; ]
if (:fileExist == false)
[ openWrite "AM_Hiscores
setWriter "AM_Hiscores
print "AsteroidMinerHS
closeall
setWriter []
]
end
to initO
local [p]
setUpdateGraph false
setSC RGB 1 1 1
home
setPenSize [3 3]
setPC hsb 60 .6 .8
pu rt 90 fd 45 lt 90 fd 75 lt 180
p=pos
fd 60 pd
Ellipse 10 12
pu lt 60 fd 5 pd Ellipse 4 2
pu bk 5 rt 120 fd 5 pd Ellipse 4 2
pu setpos p seth 0 pd
initO_feet
rt 180
initO_feet
pu fd 50 pd EllipseArc 180 4 8 90
pu setpos p seth 0 pd
Ellipse 16 50
Ellipse 40 30
Ellipse 40 10
setPC hsb 60 .3 .9
Ellipse 40 50
pu home
bitTurtleSizeX=90
bitTurtleSizeY=135
bitTurtle=BitCopy bitTurtleSizeX bitTurtleSizeY
BitMakeTransparent bitTurtle RGB 1 1 1
setSC 0
setUpdateGraph true
end
to initO_feet
pu lt 40 fd 45 pd EllipseArc 185 6 20 85
pu bk 45 rt 80 fd 45 pd EllipseArc 185 6 20 90
pu bk 45 lt 40 pd
end
to initObjects
do_while [
repeat :maxRocks [setItem repcount :rocks (list :offScreenX :offScreenY)] ;clear the rock list
repeat :maxRocks [setItem repcount :rockNeighbors 0] ;clear the neighbor list
make "rockCounter 0
make "loop1 1 ;findXy needs this value--it's the number of rocks so far
repeat :numRocks [
if not(:rockCounter == 250) [
findXy "rock
setItem :loop1 :rocks (list :x :y)
]
make "loop1 :loop1+1
]
][:rockCounter == 250] ;if rockCounter == 250, then it tried too long to find spots for new rocks,
;so it will start placing them all over again
repeat :maxCrystals [setItem repcount :crystals (list :offScreenX :offScreenY)] ;clear the crystal list
make "loop1 1 ;findXy needs this value--now it's the number of crystals so far
repeat :numCrystals [
findXy "crystal
setItem :loop1 :crystals (list :x :y)
make "loop1 :loop1+1
]
end
to inputText :iPos :txt :max_
; setfocus [MSWLogo Screen]
setpos :iPos
drawText :txt "draw
drawChar 32 "draw
make "iPos pos
pu
drawText [_] "draw
make "key 0
make "string "
; keyboardon [inputText_keyHit]
do_while
[ if key? [inputText_keyHit]
wait 1
][key != char 13]
; keyboardoff
output :string
end
to inputText_eraseChar :char_
drawText :char_ "getLength
pu seth 0 tbk 9 lt 90 fd :textLength
setPC 0
pd rt 90 tfd 33 pu tbk 33
sbitblock round(:textLength+1) round(33*:textScale)
tfd 9
end
to inputText_keyHit
make "key readchar
ifelse :key == char 8 [
if (count :string) > 0 [
if not(count :string) == :max_ [inputText_eraseChar "_]
ifelse not(count :string) == :max_ [
inputText_eraseChar (item (count :string) :string)
][
;erase either the last character or the underscore--whichever is longer
drawText [_] "getLength
make "underscoreLength :textLength
drawText (item (count :string) :string) "getLength
ifelse :underscoreLength > :textLength [
inputText_eraseChar "_
][
inputText_eraseChar (item (count :string) :string)
]
]
make "s :string
make "string "
repeat (count :s)-1 [make "string word :string (item repcount :s)]
drawText [_] "draw
]
][
if not(count :string) == :max_ [inputText_eraseChar "_]
drawText :key "getLength
if :validChar == true [
if not(count :string) == :max_ [
make "string word :string :key
drawText :key "draw
if (count :string) == :max_ [
pu lt 90 fd :textLength
drawText [_] "draw
]
]
]
if not(count :string) == :max_ [drawText [_] "draw]
]
end
to levelLoop
do_while
[ initLevel
;this block pauses while the objects' positions are selected, then continues pausing until one second has gone by if it hasn't already
make "start timemilli
ifelse :level < :maxLevel
[displayText (list "Level :level) 0]
[displayText [Last Level] 0]
initObjects
make "now timemilli
while [:now-:start < 1000] [make "now timemilli]
lifeLoop
if :levelOver == true
[ displayText (list "Level :level "Complete!) 60
ifelse (:timeLeft > 0)
[ displayText [Adding Bonus...] 0
][displayText [No Bonus] 0
]
make "textCount 1 printText
make "textCount 2 printText
waitStop 30
if(:timeLeft > 0) [addBonus 1]
waitStop 60
make "level :level+1
]
if :level > :maxLevel
[ make "gameOver true
displayText [Game Complete!] 120
ifelse (:lives > 1) [displayText [Adding Extra Ship Bonus...] 0] [displayText [No Extra Ship Bonus] 30]
make "textCount 2 printText
make "textCount 3 printText
waitStop 30
if(:lives > 1) [addBonus 2]
waitStop 30
]
][(and (:quit == false) (:reset_ == false) (:gameOver == false))]
if(and :quit == false :reset_ == false)
[ scoreCheck
]
end
to lifeLoop
if :lives > 1 [
displayText [Get Ready!] 60
]
if :lives == 1 [
displayText [Last Ship...Get Ready!] 60
]
initLife
timerOn
playLoop
timerOff
if(and :quit == false :reset_ == false) [waitStop 60]
if :lives == 0 [
make "gameOver true
displayText [Game Over!] 0
make "textCount 2 printText
waitStop 50
]
if(and ( :quit == false) ( :reset_ == false)
(:gameOver == false) (:levelOver == false))
[
lifeLoop
]
end
to loadScores
make "hiNames array 10
make "AM_Hiscores array 10
openRead "AM_Hiscores
setReader "AM_Hiscores
make "tempWord readword
repeat 10
[ make "tempWord1 readword
make "tempWord2 "
make "add repcount
repeat (count :tempWord1)
[ make "tempWord2 word :tempWord2
char mod ((ascii (item repcount :tempWord1))-(117+:add)) 256
]
setItem repcount :hiNames :tempWord2
make "tempWord1 readword
make "tempWord2 "
repeat (count :tempWord1)
[ tempWord2=word tempWord2
char mod ((ascii (item repcount :tempWord1))-(117+:add)) 256
]
ifelse :tempWord2 == "
[ setItem repcount :AM_Hiscores 0
][
setItem repcount :AM_Hiscores :tempWord2
]
]
closeall
setReader []
end
to ltCnr
lt 45 tfd 1.4 lt 45
end
to menuOn :action
if :action == true [buttonOn 1 false]
buttonOn 2 :action
buttonOn 3 :action
buttonOn 4 :action
buttonOn 5 :action
buttonOn 6 :action
make "menuOn_ :action
if and :action == false :playing == false [buttonOn 1 true]
end
to obk :d
bk :d*:open_scale
end
to ofd :d
fd :d*:open_scale
end
to ofdd :d
fd :d*:open_scale
if not(:open_quit == true) [waitStop 4]
end
to open
clearBox
WindowMode
make "playing false
make "open_quit false
if :score > 0 [make "textCount 2 printText]
setPenSize (list round(3*:open_scale) round(3*:open_scale))
setTurtle turtle0
open_stars
menuOn :menuOn_
if :open_quit == false [waitStop 8]
if :ee2 == true [open_author]
open_ASTEROID
open_MINER
open_turtleO
if :open_quit == false [waitStop 60]
open_author
repeat 7 [if :open_quit == false [waitStop 30]]
clearBox
setTurtle turtle2 ht
if(and :displayHighScores_ == false :displayInstructions_ == false :open_quit == false)
[ menuOn :menuOn_
]
if :open_quit == false [displayHighScores]
ifelse :displayHighScores_ == true
[ displayHighScores
buttonOn 7 true
; (keyboardon [processKey keyboardvalue]
; [processKey keyboardvalue+200])
do_while [waitStop 10] [:displayHighScores_ == true]
][
repeat 8 [if not(:open_quit == true) [waitStop 30]]
]
if :displayHighScores_ == true
[ displayHighScores
buttonOn 7 true
; (keyboardon[processKey keyboardvalue]
; [processKey keyboardvalue+200])
do_while [waitStop 10] [:displayHighScores_ == true]
]
if :displayInstructions_ == true
[ displayInstructions
buttonOn 8 true
; (keyboardon[processKey keyboardvalue]
; [processKey keyboardvalue+200])
do_while [waitStop 10] [:displayInstructions_ == true]
]
end
to open_ASTEROID
setPC RGB .78 .47 1
;A
pu setpos :Apos
seth 180 obk 7 pd
seth 198
ofd 55 make "oPos pos ofdd 105 obk 160
lt 30 ofdd 80
obk 20
seth 270 setpos :oPos if not(:open_quit == true) [wait 4]
;S
setPC RGB .71 .49 1
pu setpos :Apos seth 90 ofd 70 pd
seth 280 ofdd 30
lt 80 ofdd 30
lt 115 ofdd 40
rt 90 ofdd 40
rt 80 ofdd 48
;T
setPC RGB .65 .51 1
pu setpos :Apos seth 90 ofd 90 pd
ofdd 40 obk 20
rt 95 ofdd 70
;E
setPC RGB .58 .53 1
pu setpos :Apos seth 90 ofd 140 pd
seth 100 ofdd 40 obk 40
rt 85 ofdd 60 obk 30
lt 90 ofdd 25 obk 25 rt 90
ofd 30
lt 95 ofdd 35
;R
setPC RGB .52 .55 1
pu setpos :Apos seth 90 ofd 190 pd
seth 180
ofdd 60 obk 60
lt 60 ofdd 30
rt 120 ofdd 30
lt 100 ofdd 50
;O skipped until later but pause like it is being done
waitStop 8
;I
setPC RGB .45 .57 1
pu setpos :Apos seth 90 ofd 290 pd
seth 85
ofdd 14 obk 7
rt 90 ofdd 70
lt 80 obk 7 ofdd 14
;D
setPC RGB .39 .59 1
pu setpos :Apos seth 90 ofd 320 pd
seth 175
ofdd 75 make "oPos pos obk 75
lt 70 ofdd 40
rt 60 ofdd 30
setpos :oPos if not(:open_quit == true) [waitStop 4]
end
to open_author
local "fontAttribList
setTurtle turtle0
pu
setpos :Apos
seth 180
ofd 207
rt 90
ofd 50
rt 180
setPC RGB .7 .42 .9
setLabelFont [Times]
ifelse :ee2 == false
[Label [by Dan Gerhards]]
[Label [by Dan Gerhards whose birthday is today!]]
end
to open_loop
open
if not(:open_quit == true) [open_loop]
end
to open_MINER
;M
setPC RGB .78 .49 1
pu setpos :Mpos pd
seth 195 ofdd 70 obk 70
lt 65 ofdd 30
lt 80 ofdd 30
rt 120 ofdd 70
;I
setPC RGB .65 .51 1
pu setpos :Mpos seth 90 ofd 75 pd
seth 95
ofdd 14 obk 7
rt 86 ofdd 65
lt 85 obk 7 ofdd 14
;N
setPC RGB .58 .53 1
pu setpos :Mpos seth 90 ofd 110 pd
seth 185 ofdd 60 obk 60
lt 32 ofdd 72
lt 151 ofdd 60
;E
setPC RGB .52 .55 1
pu setpos :Mpos seth 0 obk 5 seth 90 ofd 165 pd
seth 87 ofdd 40 obk 40
rt 95 ofdd 55 obk 30
lt 90 ofdd 25 obk 25 rt 90
ofd 30
lt 85 ofdd 35
;R
setPC RGB .45 .57 1
pu setpos :Mpos seth 90 ofd 220 pd
seth 180
ofdd 70 obk 40 make "oPos pos obk 30
lt 80 ofdd 30
rt 45 ofdd 15
setpos :oPos if not(:open_quit == true) [wait 4]
lt 8 ofdd 115
end
to open_stars
pu
white=RGB 1 1 1
repeat 1000
[ make "x random(round :displayWidth)
make "y random(round :displayHeight)
setpixel list :x-:displayWidth/2 :y-:displayHeight/2 white
]
end
to open_turtleO
setTurtle turtle2
pu setxy (first :Apos)+220*:open_scale :displayHeight/2
make "speed 1
make "oy last pos
make "ox first pos
make "bounce 0
setUpdateGraph false
if :open_quit != true [open_turtleO_animate]
setUpdateGraph true
sety 40*open_scale
end
to open_turtleO_animate
waitStop 1
speed=speed+1*open_scale
oy=oy-speed
if oy < 10*open_scale
[ oy=10*open_scale
speed=-speed*0.5
bounce=bounce+1
sety oy
wait 1
]
sety oy*open_scale
otaBuffer=BitCopy bitTurtleSizeX bitTurtleSizeY
BitPaste bitTurtle
updateGraph
if and bounce < 3 open_quit == false
[ BitPaste otaBuffer
open_turtleO_animate
]
end
to pauseGame
local "keepOff
make "keepOff false
make "pauseNow false
setTurtle turtle1
setpos list 0-57*:scale 0-43*:scale
; setbitindex 20
sbitcut round(110*:scale) round(90*:scale)
buttonOn 9 true
buttonOn 10 true
if :timer == false [make "keepOff true]
timerOff
OnMouseLeftDown [buttonHit]
make "paused true
do_while [dispatchMessages][:paused == true]
OnMouseLeftDown []
if :keepOff == false [timerOn]
buttonOn 9 false
buttonOn 10 false
setTurtle turtle1
setpos list 0-57*:scale 0-43*:scale
; setbitindex 20
; BitPaste
wait 10
end
to playLoop
do_while
[ make "start timemilli
if(or not(:oldShipX == :shipXInt) not(:oldShipY == :shipYInt)
not(:oldDr == :dr) :exploding == true :leaving == true
:erase_ == true :blink == 0)
[ if :behindRock == false [drawShip :oldShipX :oldShipY :oldDr "erase]
]
if :exploding == true
[ make "expStep :expStep+1
if :expStep == :numExpSteps [make "lives :lives-1]
]
if :leaving == true
[ make "leaveStep :leaveStep+1 shrinkShip
if :leaveStep == :numLeaveSteps [make "levelOver true]
]
if (and :levelOver == false :behindRock == false)
[ drawShip :shipXInt :shipYInt :dr "draw
]
make "oldBehindRock :behindRock
make "behindRock false
setpos (list :shipX :shipY)
if (:leaving == false)
[ hitCrystalCheck
]
hitRockCheck
;if the ship just emerged from behind a rock, draw it now...
if (and :levelOver == false :behindRock == false :oldBehindRock == true) [
drawShip :shipXInt :shipYInt :dr "redraw
]
;...and if it just went behind one, erase it now
if (and :behindRock == true :oldBehindRock == false) [
drawShip :shipXInt :shipYInt :dr "erase
]
if :expStep < :numExpSteps [printText] ;the if keeps it from showing the taking of a life just yet
if and(:exploding == true)(:expStep == 0) [
setpos :expCtr
; setbitindex 1
; BitPaste
make "fragments(array :numFrags 1)
repeat :numFrags [
setItem repcount :fragments
(list ((random 3)/2) ((random 3+2)/2) (random 360)
((random 61)+10) ((random 4)*0.25+0.5) ((random 6)*0.25)
(random 2) ((random 341)+10) ((random 20)/10)
)
]
]
if :expStep == 2 [
setpos :expCtr
; sbitblock (round :shipRad*2.5*:scale) (round :shipRad*2.5*:scale)
]
ifelse :glintStep < 20 [
make "glintStep :glintStep+1
glint "animate
][
make "glint? random 100
if :glint? == 0 [
make "glintCrystal (random (:level*2+2))+1 ;level*2+2 is the number of crystals the level started with
make "y (last (item :glintCrystal :crystals))
if and ((round :y) == :y) not(:y == :offScreenY) [make "glintStep 0] ;if round :y ! == :y, then crystal is close to a rock
]
]
make "oldShipX :shipXInt
make "oldShipY :shipYInt
make "oldDr :dr
if :leaving == true
[make :thrust true]
processCommand
make "shipX :shipX+:shipDeltaX
make "shipY :shipY+:shipDeltaY
wrapCheck
make "shipXInt round :shipX
make "shipYInt round :shipY
make "now timemilli
while [:now-:start < 10] [make "now timemilli]
waitStop 1
][(and (:quit == false) (:reset_ == false)
(:expStep < :numExpSteps) (:levelOver == false))]
;the "10" is the animation delay
end
to printText
setTurtle turtle1
;To speed things up, only one of the three objects at the top of the screen is printed at a time.
;They need to be continuously printed though, because the ship can fly through them.
if :textCount == 1
[ ;paste "Bonus"
setpos (list (:displayWidth/2-:displayWidth+4*:scale)
(:displayHeight/2-:textBarHeight+((:textBarHeight-18*:scale)/2))
)
; setbitindex 4
; BitPaste
BitPaste bitBonus
;paste Time left
setpos(list (:displayWidth/2-:displayWidth+:bonusLength+7*:scale)
(:displayHeight/2-:textBarHeight+((:textBarHeight-18*:scale)/2))
)
seth 90
;noyield keeps Time from changing while it is being printed
; noyield
repeat count (:timeLeft*5) [
; setbitindex (item repcount (:timeLeft*5))+10
; BitPaste
BitPaste bitNumbers.Int item repcount (:timeLeft*5)
fd round(13*:scale)
]
; yield
sbitblock round(10*:scale)+1 round(18*:scale)+1
]
if :textCount == 2 [
;paste "Score"
setpos(list ((0-((count :score)*13+:scoreLength*:scale))/2)
(:displayHeight/2-:textBarHeight+((:textBarHeight-18*:scale)/2))
)
seth 90
sbitblock round(:scoreLength+:scale)+1+5*:textScale round(18*:scale+:scale)+1
; setbitindex 3
; BitPaste
BitPaste bitScore
fd round(:scoreLength+2*:scale)
;paste score
repeat count :score [
sbitblock round(13*:scale+:scale)+1 round(18*:scale+:scale)+1
; setbitindex (item repcount :score)+10
; BitPaste
BitPaste bitNumbers.Int item repcount :score
fd round(13*:scale)
]
]
if :textCount == 3
[ ;print extra lives left
make "extraLives :lives-1
if :extraLives < 0 [make "extraLives 0]
setpos(list (:displayWidth/2-4)
(:displayHeight/2-:textBarHeight+((:textBarHeight-17*:scale)/2))
)
seth 270
; setbitindex 6
repeat :extraLives
[ fd 20*:scale
BitPaste bitShip
]
repeat 3-:extraLives
[ fd 20*:scale
sbitblock round(18*:scale) round(18*:scale)
]
]
make "textCount :textCount+1
if :textCount == 4 [make "textCount 1]
end
to processCommand
if :exploding == false [
if :turnLt == true [make "dr :dr-10]
if :turnRt == true [make "dr :dr+10]
if :dr > 360 [make "dr :dr-360]
if :dr < 0 [make "dr :dr+360]
if :thrust == true [
;sin and cos are backwards because Logo calls 0 degrees straight up
make "xAccel (sin (:dr))*:acceleration
make "yAccel (cos (:dr))*:acceleration
make "shipDeltaX :shipDeltaX+:xAccel
make "shipDeltaY :shipDeltaY+:yAccel
if :leaving == false [
;If the ship is at maximum speed, get rid of the extra speed,
; but leave the direction alone.
make "speed2((:shipDeltaX)*(:shipDeltaX)+(:shipDeltaY)*(:shipDeltaY))
if(:maxSpeed2-:speed2 < 0)[
make "shipDeltaX (:maxSpeed2*:shipDeltaX/:speed2)
make "shipDeltaY (:maxSpeed2*:shipDeltaY/:speed2)
]
]
]
]
if :pauseNow == true [pauseGame]
end
to processKey :key
;the first key of each pair is querty, the second is Dvorak
if :playing == true
[ if (or :key == "l :key == "n)
[ make "turnRt true]
if (or :key == "j :key == "h)
[ make "turnLt true]
ifelse (or :key == "k :key == "t)
[ make "thrust true]
[ if :leaving == false [make "thrust false make "erase_ true]
]
if (and :key == "p :paused == false)
[make "pauseNow true]
if (or :key == "x :key == "q :key == char 27)
[ make "quit true
make "open_quit true
]
if :paused == true
[ if :key == "c [make "paused false]
if :key == "r [make "paused false make "reset_ true]
]
]
if :playing == false
[ ifelse :doneButtonOn == false
[ if :key == "p [commandPlay]
if :key == "i [commandInstructions]
if :key == "h [commandHighScores]
if (or :key == "x :key == "q :key == char 27)
[ make "quit true make "open_quit true
]
if :key == "m [ifelse :menuOn_ == true [menuOn false] [menuOn true]]
][
if :key == "d [commandDone]
]
]
end
to rtCnr
rt 45 tfd 1.4 rt 45
end
to saveScores
openWrite "AM_Hiscores
setWriter "AM_Hiscores
print "AsteroidMinerHS
repeat 10 [
make "tempWord1 item repcount :hiNames
make "tempWord2 "
make "add repcount
repeat (count :tempWord1)
[ make "tempWord2 word :tempWord2
char mod ((ascii (item repcount :tempWord1))+ 117+:add) 256
]
print :tempWord2
make "tempWord1 item repcount :AM_Hiscores
make "tempWord2 "
repeat (count :tempWord1)
[ make "tempWord2 word :tempWord2
char mod ((ascii (item repcount :tempWord1))+ 117+:add) 256
]
ifelse :tempWord2 == "0
[ print "
][
print :tempWord2
]
]
print "AsteroidMinerHS
closeall
setWriter []
end
to sbit_position
make "sPos pos
sTurtle=turtle
make "sHeading heading
setTurtle turtle1
pu
setpos :sPos
seth 0
bk round(:scale)-1
rt 90 bk round(:scale)-1
end
to sbitblock :swidth :sheight
sbit_position
fillRect (list xcor-1 ycor-1) pos+(list swidth sheight)
setTurtle :sTurtle
setpos :sPos
seth :sHeading
end
to sbitcut :swidth :sheight
sbit_position
; bitcut :swidth+(round(:scale)-1)*2 :sheight+(round(:scale)-1)*2
setTurtle :sTurtle
setpos :sPos
seth :sHeading
end
to scoreCheck
loadScores
ifelse :score > item 10 :AM_Hiscores [
displayText [New High Score!] 0
;put the score on top of the screen
make "textCount 2
printText
drawText [Enter your name: Dan_] "getLength ;get the length with a typical(?) input
make "name inputText (list (0-:textLength/2) (0-18*:scale*3)) [Enter your name:] 11
make "index 11
make "done false
do_while [
make "index :index-1
ifelse :score > item :index-1 :AM_Hiscores [
setItem (:index) (:AM_Hiscores) (item :index-1 :AM_Hiscores)
setItem (:index) (:hiNames) (item :index-1 :hiNames)
][setItem (:index) (:AM_Hiscores) (:score)
setItem (:index) (:hiNames) (:name)
make "done true
]
][and (:done == false) (:index > 2)]
if :done == false [
setItem 1 (:AM_Hiscores) (:score)
setItem 1 (:hiNames) (:name)
make "done true
]
saveScores
clearBox
setTurtle turtle2 ht
make "open_quit false
displayHighScores
repeat 3 [if not(:open_quit == true) [waitStop 30]]
][
setWriter[]
displayText [Final Score] 0
;put the score on top of the screen
make "textCount 2
printText
waitStop 180
]
end
to setShipSize :rad
make "shipRad :rad
make "shipSide ((sin 22.5)*:shipRad*2)
make "shipRad3 :shipRad/3
make "shipRad6 :shipRad/6
make "shipRad6Diag :shipRad/6*1.414
end
to shrinkShip
make "shipRad :shipRad-:normalShipRad/:numLeaveSteps
if :shipRad < 0 [make "shipRad 0]
setShipSize :shipRad
end
;make "startup [stealth]
to am
; bury [[loadScores saveScores glint rtCnr ltCnr stealth] [startup] []]
go
end
to tbk :dist
bk :dist*:textScale
end
to tfd :dist
fd :dist*:textScale
end
to timerOff
; if :timer == true [cleartimer 1]
make "timer false
end
to timerOn
;make Windows call this code (timeLeft stuff) every 200 milliseconds
; settimer 1 200 [if :timeLeft > 0 [make "timeLeft :timeLeft-1]]
make "timer true
end
to waitStop :delay
make "turnRt false
make "turnLt false
if leaving==false [make "thrust false]
repeat :delay [
wait 1
if or :reset_ == true :quit == true [stop]
if :pauseNow == true [pauseGame]
dispatchMessages
if key? [processKey readChar]
if MouseButtons==1 [while [MouseButtons==1][] buttonHit]
]
end
to wrapCheck
;if the center of the object is out of the box, wrap it around to the other side
if :shipX > (:gameWidth/2) [
make "shipX (:shipX-:gameWidth)
]
if :shipX < (:gameWidth/2-:gameWidth)[
make "shipX (:shipX+:gameWidth)
]
if :shipY < (:displayHeight/2-:displayHeight)[
make "shipY (:shipY+:displayHeight)
]
if :shipY > (:displayHeight/2) [
make "shipY (:shipY-:displayHeight)
]
end