Apple-2-SW/dos33fsprogs
1
0
Fork 0
mirror of https://github.com/deater/dos33fsprogs.git synced 2024-06-01 12:41:35 +00:00
Code Issues Projects Releases Wiki Activity

glados: portals actually work

Browse Source
This commit is contained in:
Vince Weaver 2017-01-06 15:24:56 -05:00
parent b849e7da6f
commit e5fd19f36a
1 changed files with 41 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

68
glados3.3/portal.bas
View File

@ -1,44 +1,52 @@
10 HOME:HGR
11 POKE 232,0:POKE 233,16
12 PRINT CHR$(4)+"BLOAD OBJECTS.SHAPE,A$1000"
11 POKE 232,0:POKE 233,30
12 PRINT CHR$(4)+"BLOAD OBJECTS.SHAPE,A$1E00"
15 GOSUB 1000
20 CX=20:CY=100:VY=0:SX=140:SY=80:BO=0:GO=0
20 CX=20:CY=100:VX=0:VY=0:SX=140:SY=80:BO=0:GO=0
22 XDRAW 1 AT SX,SY
25 XDRAW 2 AT CX,CY-7
30 HCOLOR=5:REM ORANGE
'35 HPLOT CX,CY-7 TO CX,CY+7
' ERASE OLD COPY
'35 XDRAW 2 AT CX,CY-7
25 XDRAW 2 AT CX,CY
30 REM
35 OX=CX:OY=CY:LX=SX:LY=SY
37 IF PEEK(-16384)<128 THEN GOTO 100
40 GET A$
41 IF A$="I" AND SY>4 THEN SY=SY-4
42 IF A$="J" AND SX>4 THEN SX=SX-4
43 IF A$="K" AND SX<275 THEN SX=SX+4
44 IF A$="M" AND SY<150 THEN SY=SY+4
45 IF A$="D" THEN CX=CX+2
46 IF A$="A" THEN CX=CX-2
47 IF A$="Q" THEN GOTO 800
48 IF A$=" " THEN VY=5
49 IF A$="H" THEN GOSUB 5000
50 IF A$="," THEN GOSUB 6000
51 IF A$="." THEN GOSUB 7000
42 IF A$="I" AND SY>4 THEN SY=SY-4
44 IF A$="J" AND SX>4 THEN SX=SX-4
46 IF A$="K" AND SX<275 THEN SX=SX+4
48 IF A$="M" AND SY<150 THEN SY=SY+4
50 IF A$="D" AND VX<0 THEN VX=0:GOTO 52
51 IF A$="D" THEN VX=5
52 IF A$="A" AND VX>0 THEN VX=0:GOTO 54
53 IF A$="A" THEN VX=-5
54 IF A$="Q" THEN GOTO 800
56 IF A$=" " THEN VY=5
58 IF A$="H" THEN GOSUB 5000
60 IF A$="," THEN GOSUB 6000
62 IF A$="." THEN GOSUB 7000
' PHYSICS ENGINE
100 CY=CY-VY
105 VY=VY-4.5
107 CX=CX+VX
110 IF VX<0.5 AND VX>-0.5 THEN VX=0
'
' COLLISION DETECTION
200 IF CX<7 THEN CX=7
205 IF CX>271 THEN CX=271
'
' Edges
200 IF CX<7 THEN CX=7:VX=0
205 IF CX>271 THEN CX=271:VX=0
210 IF CY<7 THEN CY=7:VY=-VY
' DETECT THE FLOOR
220 IF CX < 119 AND CY > 112 THEN CY=112:VY=0
225 IF CX > 161 AND CY > 112 THEN CY=112:VY=0
' Floors
220 IF CX < 119 AND CY > 112 THEN CY=112:VY=0:VX=VX/2
225 IF CX > 161 AND CY > 112 THEN CY=112:VY=0:VX=VX/2
230 IF CX > 119 AND CX < 161 AND CY>140 THEN GOTO 800
' Portals
235 IF BO=0 OR GO=0 GOTO 240
236 IF CX>BX-5 AND CX<BX+5 AND CY<BY+12 AND CY>BY-12 THEN CX=GX+5*VX:CY=GY
238 IF CX>GX-5 AND CX<GX+5 AND CY<GY+12 AND CY>GY-12 THEN CX=BX-5*VX:CY=BY
240 REM
' DRAW AT UPDATE CO-ORDS
245 IF OX=CX AND OY=CY GOTO 255
250 XDRAW 2 AT OX,OY-7
251 XDRAW 2 AT CX,CY-7
250 XDRAW 2 AT OX,OY
251 XDRAW 2 AT CX,CY
255 IF LX=SX AND LY=SY GOTO 300
256 XDRAW 1 AT LX,LY
257 XDRAW 1 AT SX,SY
@ -85,7 +93,8 @@
5080 PRINT " , = SHOOT BLUE"
5090 PRINT " Q = QUIT . = SHOOT ORANGE"
5100 PRINT:GET A$
5110 HGR
' return to hires
5110 POKE -16304,0
5120 RETURN
' DRAW BLUE PORTAL
6000 REM DRAW BLUE
@ -101,3 +110,8 @@
7010 GX=SX+1:GY=SY
7020 GO=1:HCOLOR=5:DRAW 2 AT GX,GY
7030 RETURN
'
' BUGS:
' Shouldn't be able to create portals underground
' Artifacts when deleting portals