Author Topic: "Get the Cash" in Locomotive BASIC / CPC BASIC 3 and a pinch of ASM  (Read 1794 times)

0 Members and 1 Guest are viewing this topic.

Offline AMSDOS

  • Supporter
  • 6128 Plus
  • *
  • Posts: 3.892
  • Country: au
    • index.php?action=treasury
    • Programs for Turbo Pascal 3
  • Liked: 1104
  • Likes Given: 1867
Much of the day, I came up with this small game where you dodge the obstacles & have to collect the Money Bags (look familiar?) to Score Points.  :)


[attachimg=1]


The main driver for creating this small game is the Graphical approach to generate Multicoloured graphics, I've used this program to make up the different parts of the Graphic, each bit using a different colour, the Assembly routine I made simply allows you to position the Graphics Cursor, select Graphics Pen & Display the Relevant area with GRA WR CHAR.


[attachimg=2]


To have Graphics of this nature work, I've used XOR Graphics Mode to Clear the Graphic & OR to Draw it in, to be honest I left this in from my earlier program, which was a Cash Bag moving around the screen, this program could be refined, the other half of my assembly routine uses SCR SW ROLL to Roll part of the Screen, so graphics don't need to be XORed off screen as they Roll off and need to be Redrawn.


[attachimg=3]


Initially I knocked it up in Locomotive BASIC which I thought played quite well under the circumstances, I then altered bits of it, so now it works in CPC BASIC 3, I applied some CALL &BD19s, though the program is blinking away, mostly the paddle at the bottom of screen, which needs to be redrawn as it rolls offscreen. CPC BASIC 3 Code:


Code: [Select]
10 ' Get the Cash! :)
20 '
30 ' Use Left / Right Arrow to Get the Cash, but avoid the Bricks
40 '
50 MODE 0
60 INK 1,25 : INK 2,2 : INK 3,11 : INK 4,26 : INK 5,6 : INK 6,13
80 xp=174 : yp=16 : sc = 0 : exit = 0 : v=3 : GOSUB 2210
90 FOR ys=1 TO 25 : LOCATE 13,ys : PRINT CHR$(219);: NEXT ys
100 LOCATE 14,1 : PRINT"Score:"
110 LOCATE 14,2 : PRINT Sc
120 WHILE exit = 0
130  obj=RND MOD 3+1
140  IF obj=1 OR obj=2 THEN x = RND MOD 352 : y=398 : v=3 : GOSUB 2310
150  IF obj=3 THEN x = RND MOD 352 : y=398 : v=3 : GOSUB 2050
155  CALL &BD19 : CALL &BD19
160  IF NOT INKEY(1) AND xp < 348 THEN v=1 : GOSUB 2210 : xp = xp + 8 : v=3 : GOSUB 2210
170  IF NOT INKEY(8) AND xp > 8 THEN v=1 : GOSUB 2210 : xp = xp - 8 : v=3 : GOSUB 2210
180 IF (TEST(xp+4,yp-4)=6) OR (TEST(xp+20,yp-4)=6) OR (TEST(xp+32,yp-4)=6) THEN GOSUB 290 : dl=1 : WHILE dl<1000 : dl=dl+1 : WEND : exit = 1
190 IF (TEST(xp+4,yp-4)=4) OR (TEST(xp+20,yp-4)=4) OR (TEST(xp+32,yp-4)=4) THEN GOSUB 290 : dl=1 : WHILE dl<1000 : dl=dl+1 : WEND : exit = 1
200 IF (TEST(xp+20,yp-10)=4) OR (TEST(xp+20,yp-10)=3) THEN SOUND 135,100,0,0,1,1: sc=sc+10 : LOCATE 14,2 : PRINT sc
210 CALL &901D : GOSUB 2210
220 WEND
230 CLS : LOCATE 7,8 : PRINT "FINAL" : LOCATE 7,9 : PRINT "SCORE" : LOCATE 8,10 : PRINT sc
240 LOCATE 8,12 : PRINT "PLAY" : LOCATE 7,13 : PRINT "AGAIN" : LOCATE 7,14 : PRINT "(Y/N)" : WHILE INKEY$<>"" : WEND
250 WHILE INKEY(46)=-1
260 IF INKEY(43)<>-1 THEN GOTO 10
270 WEND
280 WHILE INKEY$<>"" : WEND : CALL &BC02 : MODE 2 : END
290 SOUND 135,0,0,0,2,,1 : RETURN
2000 ' Draw Cash Bag
2010 ' Entry :-
2020 '  X = X Co-ordinate
2030 '  Y = Y Co-ordinate
2040 '  V = Graphics Mode Value (0 = Normal, 1 = XOR, 2 = AND, 3 = OR)
2050 PRINT CHR$(23);CHR$(v);
2060  CALL &9000,X,Y,1,240 : CALL &9000,X+32,Y,1,241
2070  CALL &9000,X,Y,2,242 : CALL &9000,X+32,Y,2,243 : CALL &9000,X,Y-16,2,244 : CALL &9000,X+32,Y-16,2,32
2080  CALL &9000,X,Y,3,245
2090  CALL &9000,X,Y,4,246
2100 RETURN
2200 ' Draw Obsticle
2210 PRINT CHR$(23);CHR$(v);
2220  CALL &9000,xp,16,4,247 : CALL &9000,xp+32,16,4,248
2230  CALL &9000,xp,16,5,249 : CALL &9000,xp+32,16,5,250
2240 RETURN
2300 ' Draw Paddle
2310 PRINT CHR$(23);CHR$(v);
2320  CALL &9000,x,y,4,251 : CALL &9000,x,y,6,252
2330 RETURN
* Using the old Amstrad Languages :D   * with the Firmware :P
* I also like to problem solve code in BASIC :)   * And type-in Type-Ins! :D

Home Computing Weekly Programs
Popular Computing Weekly Programs
Your Computer Programs
Updated Other Program Links on Profile Page (Update April 16/15 phew!)
Programs for Turbo Pascal 3

Offline AMSDOS

  • Supporter
  • 6128 Plus
  • *
  • Posts: 3.892
  • Country: au
    • index.php?action=treasury
    • Programs for Turbo Pascal 3
  • Liked: 1104
  • Likes Given: 1867

I've done some modifications to the game above, I've decided to convert the Graphics into Text Co-ordinate based and I've dug out one of my other routines to move the objects down the screen (without actually scrolling the screen).


I've done one version in CPC BASIC 3, which I was hoping would enhance it, but doesn't seem to be the case, though in my Assembly routines I'm using TXT OUTPUT (&BB5A) to print out the characters, I guess it maybe better with TXT WR CHAR (&BB5D), though probably just better to convert the Text Graphics into Sprites with less need to call in the various bits to make up the graphic. But was hoping to leave the Graphics as they were.


Code: [Select]

org &9000


;; call &9000,<xpos>,<ypos>,pen,char


ld h,(ix+06)
ld l,(ix+04)


call &bb75


ld a,(ix+02)


call &bb90


ld a,(ix+00)


call &bb5a


ret


This was the Text Version for CPC BASIC 3 I came up with:


Code: [Select]
10 ' Get the Cash! :)
20 '
30 ' Use Left / Right Arrow to Get the Cash, but avoid the Bricks
40 '
50 DIM objects(30),oldobjects(30)
52 RANDOMIZE TIME : RANDOMIZE RND
53 FOR setobj=1 TO 30 STEP 3: x=setobj+1 : y=setobj+2 : objects(x)=RND MOD 11+1 : objects(y)=RND MOD 20+1
54   obj=RND MOD 3+1
55   IF obj=1 OR obj=2 THEN objects(setobj)=obj
56   IF obj=3 THEN objects(setobj)=obj
57 NEXT setobj
60 MODE 0 : INK 1,25 : INK 2,2 : INK 3,11 : INK 4,26 : INK 5,6 : INK 6,13
80 xp=6 : yp=25 : exit = 0 : sc = 0 :GOSUB 2210
90 FOR ys=1 TO 25 : LOCATE 13,ys : PRINT CHR$(219);: NEXT ys
100 LOCATE 14,1 : PRINT"Score:"
110 LOCATE 14,2 : PRINT Sc
120 WHILE exit = 0
130  FOR ps=1 TO 30 STEP 3
131    x=ps+1 : y=ps+2
132    oldobjects(x)=objects(x) : oldobjects(y)=objects(y) : oldobjects(ps)=objects(ps)
133    IF objects(y)<24 THEN objects(y)=objects(y)+1 ELSE objects(x)=RND MOD 11+1 : objects(y)=1
140    IF objects(ps)=1 OR objects(ps)=2 THEN GOSUB 2340 : GOSUB 2310
150    IF objects(ps)=3 THEN GOSUB 2120 : GOSUB 2050
151  NEXT ps
160  IF NOT INKEY(1) AND xp < 12 THEN GOSUB 2260 : xp = xp + 1 : GOSUB 2210
170  IF NOT INKEY(8) AND xp > 1 THEN GOSUB 2260 : xp = xp - 1 : v=3 : GOSUB 2210
220 WEND
230 CLS : LOCATE 7,8 : PRINT "FINAL" : LOCATE 7,9 : PRINT "SCORE" : LOCATE 8,10 : PRINT sc
240 LOCATE 8,12 : PRINT "PLAY" : LOCATE 7,13 : PRINT "AGAIN" : LOCATE 7,14 : PRINT "(Y/N)" : WHILE INKEY$<>"" : WEND
250 WHILE INKEY(46)=-1
260 IF INKEY(43)<>-1 THEN GOTO 52
270 WEND
280 WHILE INKEY$<>"" : WEND : CALL &BC02 : MODE 2 : END
290 SOUND 135,0,0,0,2,,1 : RETURN
2000 ' Draw Cash Bag
2010 ' Entry :-
2020 '  X = X Text Co-ordinate
2030 '  Y = Y Text Co-ordinate
2050 PRINT CHR$(22);CHR$(1);
2060  CALL &9000,objects(x),objects(y),1,240 : CALL &9000,objects(x)+1,objects(y),1,241
2070  CALL &9000,objects(x),objects(y),2,242 : CALL &9000,objects(x)+1,objects(y),2,243 : CALL &9000,objects(x),objects(y)+1,2,244 : CALL &9000,objects(x)+1,objects(y)+1,2,32
2080  CALL &9000,objects(x),objects(y),3,245
2090  CALL &9000,objects(x),objects(y),4,246
2100 RETURN
2110 ' Remove Cash Bag
2120 PRINT CHR$(22);CHR$(0);
2130  CALL &9000,oldobjects(x),oldobjects(y),0,240 : CALL &9000,oldobjects(x)+1,oldobjects(y),0,241
2140  CALL &9000,oldobjects(x),oldobjects(y),0,242 : CALL &9000,oldobjects(x)+1,oldobjects(y),0,243 : CALL &9000,oldobjects(x),oldobjects(y)+1,0,244
2150  CALL &9000,oldobjects(x),oldobjects(y),0,245
2160  CALL &9000,oldobjects(x),oldobjects(y),0,246
2170 RETURN
2200 ' Draw Paddle
2210 PRINT CHR$(22);CHR$(1);
2220  CALL &9000,xp,25,4,247 : CALL &9000,xp+1,25,4,248
2230  CALL &9000,xp,25,5,249 : CALL &9000,xp+1,25,5,250
2240 RETURN
2250 ' Remove Paddle
2260 PRINT CHR$(22);CHR$(0);
2270  CALL &9000,xp,25,0,247 : CALL &9000,xp+1,25,0,248
2280  CALL &9000,xp,25,0,249 : CALL &9000,xp+1,25,0,250
2290 RETURN
2300 ' Draw Obstacle
2310 PRINT CHR$(22);CHR$(1);
2320  CALL &9000,objects(x),objects(y),4,251 : CALL &9000,objects(x),objects(y),6,252
2330 RETURN
2340 ' Remove Obstacle
2350 PRINT CHR$(22);CHR$(0);
2360  CALL &9000,oldobjects(x),oldobjects(y),0,251 : CALL &9000,oldobjects(x),oldobjects(y),0,252
2370 RETURN


The other thing I was looking at was reducing the program to one array, but ran into problems with my BASIC version:


Code: [Select]
10 ' Get the Cash! :)
20 '
30 ' Use Left / Right Arrow to Get the Cash, but avoid the Bricks
40 '
50 DEFINT a-z : DIM objects(30)
51 IF PEEK(&9000)<>&DD THEN GOSUB 1010 : MEMORY &8FFF : LOAD"sprite.bin",&9000
52 RANDOMIZE TIME : RANDOMIZE RND
53 FOR setobj=1 TO 30 STEP 3: x=setobj+1 : y=setobj+2 : objects(x)=(RND*11)+1 : objects(y)=(RND*10)+1
54   obj=INT(RND*3)+1
55   IF obj=1 OR obj=2 THEN objects(setobj)=obj
56   IF obj=3 THEN objects(setobj)=obj
57 NEXT setobj
60 MODE 0 : INK 1,25 : INK 2,2 : INK 3,11 : INK 4,26 : INK 5,6 : INK 6,13
70 ENV 1,15,-1,2:ENV 2,15,-1,15:ENT -1,8,-4,1
80 xp=6 : yp=25 : exit = 0 : sc = 0 :GOSUB 2210
90 FOR ys=1 TO 25 : LOCATE 13,ys : PRINT CHR$(219);: NEXT ys
100 LOCATE 14,1 : PRINT"Score:"
110 LOCATE 14,2 : PRINT Sc
120 WHILE exit = 0
130  FOR ps=1 TO 30 STEP 3
131    x=ps+1 : y=ps+2
133    IF objects(y)<20 THEN objects(y)=objects(y)+1 ELSE objects(x)=INT(RND*11)+1 : objects(y)=1
140    IF objects(ps)=1 OR objects(ps)=2 THEN GOSUB 2340 : GOSUB 2310
150    IF objects(ps)=3 THEN GOSUB 2120 : GOSUB 2050
151  NEXT ps
160  IF NOT INKEY(1) AND xp < 12 THEN GOSUB 2260 : xp = xp + 1 : GOSUB 2210
170  IF NOT INKEY(8) AND xp > 1 THEN GOSUB 2260 : xp = xp - 1 : v=3 : GOSUB 2210
220 WEND
230 CLS : LOCATE 7,8 : PRINT "FINAL" : LOCATE 7,9 : PRINT "SCORE" : LOCATE 8,10 : PRINT sc
240 LOCATE 8,12 : PRINT "PLAY" : LOCATE 7,13 : PRINT "AGAIN" : LOCATE 7,14 : PRINT "(Y/N)" : WHILE INKEY$<>"" : WEND
250 WHILE INKEY(46)=-1
260 IF INKEY(43)<>-1 THEN RUN 60
270 WEND
280 WHILE INKEY$<>"" : WEND : CALL &BC02 : MODE 2 : END
290 SOUND 135,0,0,0,2,,1 : RETURN
1000 ' Setup Sprite
1010 SYMBOL AFTER 239
1020 SYMBOL 240,0,64,63,0,0,0,0,0
1030 SYMBOL 241,0,128,0,0,0,0,0,0
1040 SYMBOL 242,0,0,64,64,64,64,64,64
1050 SYMBOL 243,0,0,128,128,128,128,128,128
1060 SYMBOL 244,63,0,0,0,0,0,0,0
1070 SYMBOL 245,0,0,0,49,55,35,55,33
1080 SYMBOL 246,0,0,0,14,8,28,8,30
1090 SYMBOL 247,0,0,0,64,64,0,63,0
1100 SYMBOL 248,0,0,0,128,128,0,0,0
1110 SYMBOL 249,0,0,0,0,0,64,64,127
1120 SYMBOL 250,0,0,0,0,0,128,128,128
1130 SYMBOL 251,0,110,0,110,0,110,0,0
1140 SYMBOL 252,0,0,55,0,55,0,55,0
1150 RETURN
2000 ' Draw Cash Bag
2010 ' Entry :-
2020 '  X = X Text Co-ordinate
2030 '  Y = Y Text Co-ordinate
2050 PRINT CHR$(22);CHR$(1);
2060  CALL &9000,objects(x),objects(y),1,240 : CALL &9000,objects(x)+1,objects(y),1,241
2070  CALL &9000,objects(x),objects(y),2,242 : CALL &9000,objects(x)+1,objects(y),2,243 : CALL &9000,objects(x),objects(y)+1,2,244 : CALL &9000,objects(x)+1,objects(y)+1,2,32
2080  CALL &9000,objects(x),objects(y),3,245
2090  CALL &9000,objects(x),objects(y),4,246
2100 RETURN
2110 ' Remove Cash Bag
2120 PRINT CHR$(22);CHR$(0);
2130  CALL &9000,objects(x),objects(y)-1,0,240 : CALL &9000,objects(x)+1,objects(y)-1,0,241
2140  CALL &9000,objects(x),objects(y)-1,0,242 : CALL &9000,objects(x)+1,objects(y)-1,0,243 : CALL &9000,objects(x),objects(y),0,244
2150  CALL &9000,objects(x),objects(y)-1,0,245
2160  CALL &9000,objects(x),objects(y),0,246
2170 RETURN
2200 ' Draw Paddle
2210 PRINT CHR$(22);CHR$(1);
2220  CALL &9000,xp,25,4,247 : CALL &9000,xp+1,25,4,248
2230  CALL &9000,xp,25,5,249 : CALL &9000,xp+1,25,5,250
2240 RETURN
2250 ' Remove Paddle
2260 PRINT CHR$(22);CHR$(0);
2270  CALL &9000,xp,25,0,247 : CALL &9000,xp+1,25,0,248
2280  CALL &9000,xp,25,0,249 : CALL &9000,xp+1,25,0,250
2290 RETURN
2300 ' Draw Obstacle
2310 PRINT CHR$(22);CHR$(1);
2320  CALL &9000,objects(x),objects(y),4,251 : CALL &9000,objects(x),objects(y),6,252
2330 RETURN
2340 ' Remove Obstacle
2350 PRINT CHR$(22);CHR$(0);
2360  CALL &9000,objects(x),objects(y)-1,0,251 : CALL &9000,objects(x),objects(y)-1,0,252
2370 RETURN
* Using the old Amstrad Languages :D   * with the Firmware :P
* I also like to problem solve code in BASIC :)   * And type-in Type-Ins! :D

Home Computing Weekly Programs
Popular Computing Weekly Programs
Your Computer Programs
Updated Other Program Links on Profile Page (Update April 16/15 phew!)
Programs for Turbo Pascal 3

Offline AMSDOS

  • Supporter
  • 6128 Plus
  • *
  • Posts: 3.892
  • Country: au
    • index.php?action=treasury
    • Programs for Turbo Pascal 3
  • Liked: 1104
  • Likes Given: 1867
I went back to the graphical version, but trying to move the graphics individually (which works), have had more headaches when working on the collision detection. It's working at a point, but my Graphics are messing up the screen, and don't know what to do about it. Originally the graphics were 8x8, but made them bigger (particularly the Money Pot & Paddle) when trailing movement for it. If I make them 8x8 again, might help as now I'm moving back to moving those characters a line down, didn't want to go back to the txt option as GRA WR CHAR seems to be writing faster even though my earlier version with Rolling Screen is quicker, unsure if a compiler would benefit that much.


I've changed my assembly code, so now it supports graphics write more, initially I thought it would help moving the graphics down the screen, using fill mode for the top characters which means blanking the top, which worked and then I could use OR to overlap the other pieces of the graphic, which also worked, but had problems when I wanted to collision detect, which I'm not doing enough to clean up the screen. :(


Code: [Select]
org &9000


;; CALL &9000,<xpos>,<ypos>,<gra write mode>,<gra pen>,<char>


ld l,(ix+08)
ld h,(ix+09) ;; XPOS


ex hl,de ;; store in DE


ld l,(ix+06)
ld h,(ix+07) ;; YPOS


call &bbc0 ;; GRA MOVE ABSOLUTE


ld a,(ix+04) ;; Gra write mode (0 = Fill, 1 = XOR, 2 = AND, 3 = OR)


call &bc59 ;; SCR Access


ld a,(ix+02) ;; Gra Pen

call &bbde ;; GRA SET PEN


ld a,(ix+00)


call &bbfc ;; GRA WR CHAR

ret


I was trying a few things with the collision detection, trying to reset the objects when they get to the bottom with my Paddle over it in particular, seems to be leading to problems because of the size of my graphics, if I make them 8x8, but make it a graphical game which is using SCR CHAR POSITION instead of GRA MOVE ABSOLUTE, would give me a better result I guess.


Code: [Select]
10 ' Get the Cash! :)
20 '
30 ' Use Left / Right Arrow to Get the Cash, but avoid the Obstacles
40 '
50 DEFINT a-z : DIM objects(30),oldobjects(30)
51 IF PEEK(&9000)<>&DD THEN GOSUB 1010 : MEMORY &8FFF : LOAD"sprite.bin",&9000
52 RANDOMIZE TIME : RANDOMIZE RND
53 yaxis = 398 : FOR setobj=1 TO 30 STEP 3 : x = setobj + 1 : y = setobj+2 : objects(x) = (RND*348) : objects(y) = yaxis : yaxis = yaxis - 32
54   obj = INT(RND*3)
55   IF obj=1 OR obj=2 THEN objects(setobj)=obj
56   IF obj=3 THEN objects(setobj)=obj
57 NEXT setobj
60 MODE 0 : INK 1,25 : INK 2,2 : INK 3,11 : INK 4,26 : INK 5,6 : INK 6,13 : INK 7,9
70 ENV 1,15,-1,2:ENV 2,15,-1,15:ENT -1,8,-4,1
80 xp=174 : yp=16 : exit = 0 : sc = 0 : v=3 : GOSUB 2220
90 FOR ys=1 TO 25 : LOCATE 13,ys : PRINT CHR$(219);: NEXT ys
100 LOCATE 14,1 : PRINT"Score:"
110 LOCATE 14,2 : PRINT Sc
120 WHILE exit = 0
121  FOR ps=1 TO 30 STEP 3
122   x = ps + 1 : y = ps + 2
123   oldobjects(x) = objects(x) : oldobjects(y) = objects(y) : oldobjects(ps) = objects(ps)
124   IF objects(y)>0 THEN objects(y) = objects(y) - 12 ELSE objects(x) = (RND*348) : objects(y) = 398 : objects(ps) = (RND * 3) + 1
125   IF objects(ps)=1 OR objects(ps)=2 THEN GOSUB 2410 : GOSUB 2320
126   IF objects(ps)=3 THEN GOSUB 2510 : GOSUB 2060
127  NEXT ps
160  IF NOT INKEY(1) AND xp < 348 THEN GOSUB 2220 : xp = xp + 16 : GOSUB 2220
170  IF NOT INKEY(8) AND xp > 0 THEN GOSUB 2220 : xp = xp - 16 : GOSUB 2220
180 IF (TEST(xp+4,yp-2)=6) OR (TEST(xp+20,yp-2)=6) OR (TEST(xp+32,yp-2)=6) THEN GOSUB 290 : FOR dl=1 TO 1000 : NEXT dl : exit = 1
190 IF (TEST(xp+4,yp-4)=7) OR (TEST(xp+20,yp-4)=7) OR (TEST(xp+32,yp-4)=7) THEN GOSUB 290 : FOR dl=1 TO 1000 : NEXT dl : exit = 1
200 IF (TEST(xp+4,yp-4)=2) OR (TEST(xp+20,yp-4)=4) OR (TEST(xp+32,yp-4)=2) THEN SOUND 135,100,0,0,1,1: sc=sc+10 : LOCATE 14,2 : PRINT sc
220 WEND
230 CLS : LOCATE 7,8 : PRINT "FINAL" : LOCATE 7,9 : PRINT "SCORE" : LOCATE 8,10 : PRINT sc
240 LOCATE 8,12 : PRINT "PLAY" : LOCATE 7,13 : PRINT "AGAIN" : LOCATE 7,14 : PRINT "(Y/N)" : WHILE INKEY$<>"" : WEND
250 WHILE INKEY(46)=-1
260 IF INKEY(43)<>-1 THEN RUN
270 WEND
280 WHILE INKEY$<>"" : WEND : CALL &BC02 : MODE 2 : END
290 SOUND 135,0,0,0,2,,1 : RETURN
1000 ' Setup Sprite
1010 SYMBOL AFTER 239
1020 SYMBOL 240,0,64,63,0,0,0,0,0
1030 SYMBOL 241,0,128,0,0,0,0,0,0
1040 SYMBOL 242,0,0,64,64,64,64,64,64
1050 SYMBOL 243,0,0,128,128,128,128,128,128
1060 SYMBOL 244,63,0,0,0,0,0,0,0
1070 SYMBOL 245,0,0,0,49,55,35,55,33
1080 SYMBOL 246,0,0,0,14,8,28,8,30
1090 SYMBOL 247,0,0,0,64,64,0,63,0
1100 SYMBOL 248,0,0,0,128,128,0,0,0
1110 SYMBOL 249,0,0,0,0,0,64,64,127
1120 SYMBOL 250,0,0,0,0,0,128,128,128
1130 SYMBOL 251,0,110,0,110,0,110,0,0
1140 SYMBOL 252,0,0,55,0,55,0,55,0
1150 RETURN
2000 ' Draw Cash Bag
2010 ' Entry :-
2020 '  X = X Co-ordinate
2030 '  Y = Y Co-ordinate
2040 '  V = Graphics Mode Value (0 = Normal, 1 = XOR, 2 = AND, 3 = OR)
2060  CALL &9000,objects(x),objects(y),3,1,240 : CALL &9000,objects(x)+32,objects(y),3,1,241
2070  CALL &9000,objects(x),objects(y),3,2,242 : CALL &9000,objects(x)+32,objects(y),3,2,243 : CALL &9000,objects(x),objects(y)-16,3,2,244
2075 ' CALL &9000,X+32,Y-16,2,32
2080  CALL &9000,objects(x),objects(y),3,3,245
2090  CALL &9000,objects(x),objects(y),3,4,246
2100 RETURN
2200 ' Draw Paddle
2220  CALL &9000,xp,16,1,4,247 : CALL &9000,xp+32,16,1,4,248
2230  CALL &9000,xp,16,1,5,249 : CALL &9000,xp+32,16,1,5,250
2240 RETURN
2300 ' Draw Obstacle
2310 ' PRINT CHR$(23);CHR$(v);
2320  CALL &9000,objects(x),objects(y),0,7,251 : CALL &9000,objects(x),objects(y),3,6,252
2330 RETURN
2400 ' Remove Obstacle
2410 CALL &9000,oldobjects(x),oldobjects(y),0,0,251 : CALL &9000,oldobjects(x),oldobjects(y),0,0,252
2420 RETURN
2500 ' Remove Cash Bag
2510 CALL &9000,oldobjects(x),oldobjects(y),0,0,240 : CALL &9000,oldobjects(x)+32,oldobjects(y),0,0,241
2520 CALL &9000,oldobjects(x),oldobjects(y),0,0,242 : CALL &9000,oldobjects(x)+32,oldobjects(y),0,0,243
2521 CALL &9000,oldobjects(x),oldobjects(y)-16,0,2,244
2530 CALL &9000,oldobjects(x),oldobjects(y),0,0,245
2540 CALL &9000,oldobjects(x),oldobjects(y),0,0,246
2550 RETURN
* Using the old Amstrad Languages :D   * with the Firmware :P
* I also like to problem solve code in BASIC :)   * And type-in Type-Ins! :D

Home Computing Weekly Programs
Popular Computing Weekly Programs
Your Computer Programs
Updated Other Program Links on Profile Page (Update April 16/15 phew!)
Programs for Turbo Pascal 3

Offline AMSDOS

  • Supporter
  • 6128 Plus
  • *
  • Posts: 3.892
  • Country: au
    • index.php?action=treasury
    • Programs for Turbo Pascal 3
  • Liked: 1104
  • Likes Given: 1867
I've put together a program to show text co-ordinate positions via a grid, which can be enabled or disabled by un-commentating or commenting line 70.
The Grid is produced by using a couple of Functions to calculate the cell to the right size, x & y can now be used to hold Text like coordinate positions, but is zero based, so 0-19 for x & 0-24 for y will return the equivalent Text Position, except everything is done Graphically.
For the Graphics I've modified them to 8x8, so each character is no longer wider than the Text Cursor & using the Functions I've made, the Graphics will be placed correctly in the corner (top left edge) of the Text Cursor.


I think taking this approach has produced a better result from my earlier Text Version, though the Graphics are 8x8 now, where's earlier my Text Version was dealing with slightly larger Graphics, changing them to 8x8 will probably produce a similar result, though I'm looking now to push forward with this Graphical Version (which looks like a Text Based Version).  :)
Code: [Select]

10 ' Get the Cash Teaser with Graphical Grid to map MODE 0 text positions
20 RANDOMIZE TIME : RANDOMIZE RND
30 DEFINT a-z : DIM obj(30) : PLOT -2,-2,1 : PRINT CHR$(23);CHR$(0);
40 MODE 0 : GOSUB 510 : GOSUB 610 : INK 1,25 : INK 2,2 : INK 3,11 : INK 4,26
50 DEF FNcolumn=x*(4*
60 DEF FNrow=398-(y*16)
70 ' GOTO 170 ' *** Uncomment this line to skip Graphical Grid ***
80 FOR y=0 TO 24
90 MOVE FNcolumn,FNrow
100 DRAW FNcolumn+640,FNrow
110 FOR x=0 TO 20
120  MOVE FNcolumn,FNrow
130  DRAW FNcolumn,FNrow-16
140 NEXT x
150 x=0
160 NEXT y
170 y = 0
180 FOR ps=1 TO 30 STEP 3
190   x = INT(RND * 12) : obj(ps) = FNcolumn : obj(ps+1) = FNrow : y = y + 2 : obj(ps+2) = INT(RND*3)
200   IF (obj(ps+2) = 1) OR (obj(ps+2) = 2) THEN GOSUB 410 ELSE GOSUB 350
210 NEXT ps
220 WHILE exit = 0
230  FOR ps = 1 TO 30 STEP 3
240   IF obj(ps+1) > 0 THEN obj(ps+1) = obj(ps+1) - 16 ELSE x = INT(RND * 12) : obj(ps) = FNcolumn : obj(ps+1) = 398 : obj(ps+2) = INT(RND*3)
250   IF (obj(ps+2) = 1) OR (obj(ps+2) = 2 ) THEN GOSUB 440 : GOSUB 410 ELSE GOSUB 310 : GOSUB 350
260  NEXT ps
270 WEND
300 ' Remove Money Bag from old position
310  CALL &9000,obj(ps),obj(ps+1)+16,1,1,240 : CALL &9000,obj(ps),obj(ps+1)+16,1,2,241
320  CALL &9000,obj(ps),obj(ps+1)+16,1,3,242 : CALL &9000,obj(ps),obj(ps+1)+16,1,4,243
330 RETURN
340 ' Display Money Bag
350 CALL &9000,obj(ps),obj(ps+1),1,1,240 : CALL &9000,obj(ps),obj(ps+1),1,2,241
360 CALL &9000,obj(ps),obj(ps+1),1,3,242 : CALL &9000,obj(ps),obj(ps+1),1,4,243
370 RETURN
400 ' Display Obstacle
410 CALL &9000,obj(ps),obj(ps+1),1,5,244 : CALL &9000,obj(ps),obj(ps+1),1,6,245
420 RETURN
430 ' Remove Obstacle from old position
440 CALL &9000,obj(ps),obj(ps+1)+16,1,5,244 : CALL &9000,obj(ps),obj(ps+1)+16,1,6,245
450 RETURN
460 END
500 ' Setup Graphics for Money Bag & Obstacles
510 SYMBOL AFTER 239
520 SYMBOL 240,129,126,0,0,0,0,0,0
530 SYMBOL 241,0,129,129,129,129,129,129,126
540 SYMBOL 242,0,0,98,110,70,110,66,0
550 SYMBOL 243,0,0,28,16,56,16,60,0
560 SYMBOL 244,0,239,136,136,0,247,132,132
570 SYMBOL 245,0,0,103,103,0,0,115,115
580 RETURN
600 ' M/C Data For Positing & Display or Remove Graphics
610 FOR addr=&9000 TO &9022
620 READ a$
630 POKE addr,VAL("&"+a$)
640 NEXT addr : RETURN
650 DATA DD,6E,08,DD,66,09,EB,DD,6E,06,DD,66,07,CD,C0,BB
660 DATA DD,7E,04,CD,59,BC,DD,7E,02,CD,DE,BB,DD,7E,00,CD
670 DATA FC,BB,C9
[attachimg=1]

[attachimg=2]
* Using the old Amstrad Languages :D   * with the Firmware :P
* I also like to problem solve code in BASIC :)   * And type-in Type-Ins! :D

Home Computing Weekly Programs
Popular Computing Weekly Programs
Your Computer Programs
Updated Other Program Links on Profile Page (Update April 16/15 phew!)
Programs for Turbo Pascal 3

Offline AMSDOS

  • Supporter
  • 6128 Plus
  • *
  • Posts: 3.892
  • Country: au
    • index.php?action=treasury
    • Programs for Turbo Pascal 3
  • Liked: 1104
  • Likes Given: 1867
Re: "Get the Cash" now in Hisoft Pascal 4t
« Reply #4 on: 14:07, 10 April 16 »

As the title suggests I've thrown the other languages out the window, when I was having problems getting the program to run correctly from Locomotive BASIC to CPC BASIC 3. The good news is I didn't have the same problems when I got to the same stage in Hisoft Pascal 4t.


Like my later BASIC teaser, the graphics are made up from character sets, the procedure to draw the graphics simply moves to a graphical position, sets up the write move, the graphical pen number and the character, other procedures have been written to draw the money bags, walls and the paddle, though code has been optimised to also allow those things to disappear, xor mode is used to allow this, so in some places some colour changes occur.
The game appears to use Text co-ordinate positions, and indeed if the code was written to use Text Co-ordinates, it would look the same, but the program has two Functions for calculating the row & column,  row is simply "xpos*32" & column is "398-(ypos*16)", "xpos" can then have a number between 0 & 19 (in mode 0) which gives the beginning of graphical position which is the corner of the Text Cursor. The column is also the same, though the top of the screen begins at 398, so any number "ypos" has between 0 & 24 will be subtracted from that 398 to give the top of the column position, those calculation can then be used in conjunction with GRA MOVE ABSOLUTE to position the graphics, GRA SET PEN can be used to set the Graphics Pen, SCR ACCESS to set the write mode for the Screen & GRA WR CHAR can then be used write the characters. I've tried it like this as I think there's a slight improvement in performance.
Initially I had no paddle, so my Pascal looked like my Teaser, so now I put that in, I've got the controls for the paddle sorted, like the other graphics they are graphical, but moves in a text like manner, I've got Collision Detection in and working as well, the game ends when you find a Brick Wall on this Level you really have to go looking for a Brick Wall to End the game  I'll make the game progressively harder by reducing the size of the playing field (I hope ), the collection of Money Bags at the moment only produces a little Sound & your Paddle moves (mostly to the left I think, unless your on the Left Corner, your Paddle moves Right), the next thing I'll add is a "yp" variable, at the moment the Paddle only sits at the button of the Screen, but am considering that when you collect a money bag, your Paddle moves up a column.


Some more Screenshots:


[attachimg=1]


[attachimg=2]



* Using the old Amstrad Languages :D   * with the Firmware :P
* I also like to problem solve code in BASIC :)   * And type-in Type-Ins! :D

Home Computing Weekly Programs
Popular Computing Weekly Programs
Your Computer Programs
Updated Other Program Links on Profile Page (Update April 16/15 phew!)
Programs for Turbo Pascal 3

Offline AMSDOS

  • Supporter
  • 6128 Plus
  • *
  • Posts: 3.892
  • Country: au
    • index.php?action=treasury
    • Programs for Turbo Pascal 3
  • Liked: 1104
  • Likes Given: 1867
Re: "Get the Cash" now in Hisoft Pascal 4t
« Reply #5 on: 14:13, 27 April 16 »
I've done some more writing of this and had a few problems along the way, which left me rewriting the code, the playing field has a border placed around it, I ran into problems when my objects reached the bottom causing undesirable effects, I was only left resolving this by doing more IF checks on both the OBJ and OLDOBJ array, which seems to have slowed the program down slightly. Part of the idea is to make a playing field which gets smaller as the game progresses though stages. The other change I made the other week now involves the paddle moving up when it moves through the Cash Bag, I also made some alterations to the Cash Bag routine (which aren't visible yet), so an alternative palette can be used for it. The idea there being for each stage a certain number of Cash Bags must be collected before moving to the next stage and so on, though the main game routine (which is in my main Pascal block), will need to be moved (into a Procedure), so a Stage counter be put in play. I'm also tempted at the idea of making the game harder by making the Brick Walls simply drop at the bottom & have them fill up the playing field, I'd like to make it so if a Brick Wall falls at the same line your paddle is on, it will block you access pass, causing you to collect the Money Bags and move quicker up the screen.


Code: [Select]

   10 PROGRAM GetTheCash;
   11
   12 {$C-}
   13
   14 VAR charset : ARRAY[1..120] OF char;
   16     obj     : ARRAY[1..30]  OF integer;
   17     oldobj  : ARRAY[1..30]  OF integer;
   18     exit    : boolean;
   19     pos     : integer;
   20     x       : integer;
   21     y       : integer;
   22     px      : integer;
   23     oldpx   : integer;
   24     py      : integer;
   25 
   30 FUNCTION rnd(range : integer) : integer;
   40 VAR seed  : integer;
   50     result: real;
   60 BEGIN
   70   seed:=random(0);
   80   result:=(range/maxint);
   90   result:=(seed*result);
  100  rnd:=trunc(result)
  110 END;
  120
  130 PROCEDURE mode(num : char);
  140 BEGIN
  150   ra:=num;
  160   user(#bc0e)
  170 END;
  171
  172 PROCEDURE kmreset;
  173 BEGIN
  174   user(#bb03)
  175 END;
  180
  190 PROCEDURE ink(ink,col1 : char);
  200 BEGIN
  210   ra:=ink;
  220   rb:=col1;
  230   rc:=col1;
  240   user(#bc32)
  250 END;
  260
  270 PROCEDURE border(col1 : char);
  280 BEGIN
  290   rb:=col1;
  300   rc:=col1;
  310   user(#bc38)
  320 END;
  321
  322 FUNCTION key(ch:char) : boolean;
  323 BEGIN
  324   inline(#DD,#7E,#02,
  325          #CD,#1E,#BB,
  326          #28,#05,
  327          #3E,#01,
  328          #DD,#77,#03)
  329 END;
  330
  340 FUNCTION row(xpos : integer) : integer;
  350 BEGIN
  360   row:=xpos*(4*8)
  370 END;
  380
  390 FUNCTION column(ypos : integer) : integer;
  400 BEGIN
  410   column:=398-(ypos*16)
  420 END;
  430
  440 PROCEDURE SetMatrixTable;
  450 BEGIN
  460   rde:=#F0;
  470   rhl:=addr(charset);
  480   user(#bbab)
  490 END;
  500
  510 PROCEDURE SetupGraphics;
  530 BEGIN
  531   SetMatrixTable;
  532   tin('GRAPHICS.DAT',addr(charset));
  560 END;
  570
  580 PROCEDURE SetupScreen;
  590 BEGIN
  600   mode(chr(0));
  610   ink(chr(1),chr(25));
  620   ink(chr(2),chr(2));
  630   ink(chr(3),chr(11));
  640   ink(chr(4),chr(26));
  650   ink(chr(5),chr(13));
  660   ink(chr(6),chr(9));
  661   ink(chr(7),chr(26));
  662   ink(chr(8),chr(6));
  663   ink(chr(9),chr(13));
  664   ink(chr(10),chr(13));
  665   ink(chr(11),chr(13));
  666   ink(chr(12),chr(0));
  670   border(chr(9))
  680 END;
  690
  700 PROCEDURE drawgra(xpos,ypos : integer; gramde, grapen, val : char);
  710 BEGIN
  720   rde:=xpos;
  730   rhl:=ypos;
  740   user(#bbc0);
  750   ra:=gramde;
  760   user(#bc59);
  770   ra:=grapen;
  780   user(#bbde);
  790   ra:=val;
  800   user(#bbfc);
  810 END;
  820
  830 FUNCTION inc(val : char) : char;
  840 BEGIN
  850   inline(#DD,#34,#2);
  860   inc:=val
  870 END;
  880
 4000 PROCEDURE DrawMoneyBag(xpos , ypos : integer; col : char);
 4010 BEGIN
 4020   drawgra(xpos,ypos,chr(1),col,chr(240));
 4021   col:=inc(col);
 4030   drawgra(xpos,ypos,chr(1),col,chr(241));
 4031   col:=inc(col);
 4040   drawgra(xpos,ypos,chr(1),col,chr(242));
 4041   col:=inc(col);
 4050   drawgra(xpos,ypos,chr(1),col,chr(243))
 4060 END;
 4070
 4200 PROCEDURE DrawObstacle(xpos , ypos : integer);
 4210 BEGIN
 4220   drawgra(xpos,ypos,chr(1),chr(5),chr(244));
 4230   drawgra(xpos,ypos,chr(1),chr(6),chr(245))
 4240 END;
 4250
 4300 PROCEDURE DrawPaddle(xpos, ypos : integer);
 4310 BEGIN
 4320   drawgra(xpos,ypos,chr(1),chr(7),chr(246));
 4330   drawgra(xpos,ypos,chr(1),chr(8),chr(247))
 4340 END;
 4350 
 4360 PROCEDURE Collision(goodguyx, goodguyy, badx, bady, whatis : integer);
 4361 VAR loop : char;
 4370 BEGIN
 4380   IF (goodguyx=badx) AND (goodguyy=bady) THEN
 4390   BEGIN
 4400     IF (whatis=1) OR (whatis=2) THEN
 4401     BEGIN
 4402       drawpaddle(px,py);
 4406       env(2,15,-1,15);
 4407       sound(135,2,0,0,1,0,0);
 4408       FOR loop:=chr(1) TO chr(100) DO
 4409          user(#bd19);
 4410       exit:=true
 4411     END ELSE
 4413     BEGIN
 4414       drawpaddle(px,py);
 4415       env(1,15,-1,2);
 4416       ent(-1,8,-4,1);
 4417       sound(135,1,1,100,0,0,0);
 4419       user(#bd19);
 4422       py:=py+16;
 4423       drawpaddle(px,py)
 4430     END;
 4431   END;
 4432 END;
 4440
 4441 PROCEDURE box(size : integer; col : char);
 4442 var loop : integer;
 4443 BEGIN
 4444   drawgra(0,398,chr(0),col,chr(150));
 4445   drawgra(0,16,chr(0),col,chr(147));
 4446   loop:=32;
 4447   repeat
 4448     drawgra(loop,398,chr(0),col,chr(154));
 4449     drawgra(loop,16,chr(0),col,chr(154));
 4450     loop:=loop+32
 4451   until (loop=row(size+1));
 4452   drawgra(row(size+1),398,chr(0),col,chr(156));
 4453   drawgra(row(size+1),16,chr(0),col,chr(153));
 4454   loop:=384;
 4455   repeat
 4456     drawgra(0,loop,chr(0),col,chr(149));
 4457     drawgra(row(size+1),loop,chr(0),col,chr(149));
 4458     loop:=loop-16;
 4459   until (loop=16);
 4460 end;
 4461
 5000 BEGIN
 5010   SetupScreen;
 5030   SetupGraphics;
 5031   Box(10,chr(1));
 5040   y:=1; pos:=1;
 5050   WHILE (pos<30) DO
 5060   BEGIN
 5070     x:=rnd(10)+1;
 5080     obj[pos]:=row(x);
 5090     obj[pos+1]:=column(y);
 5100     y:=y+2;
 5110     obj[pos+2]:=rnd(3)+1;
 5120     IF (obj[pos+2] in [1..2]) THEN
 5130      DrawObstacle(obj[pos],obj[pos+1]);
 5160     ELSE
 5170      DrawMoneyBag(obj[pos],obj[pos+1],chr(1));
 5180     pos:=pos+3
 5190   END;
 5191   px:=row(6);
 5192   py:=column(23);
 5193   DrawPaddle(px,py);
 5194   exit:=false;
 5200   WHILE (exit=false) DO
 5210   BEGIN
 5220     pos:=1;
 5230     WHILE (pos<30) DO
 5240     BEGIN
 5241       collision(px,py,obj[pos],obj[pos+1],obj[pos+2]);
 5250       oldobj[pos]:=obj[pos];
 5260       oldobj[pos+1]:=obj[pos+1];
 5270       oldobj[pos+2]:=obj[pos+2];
 5280       IF (obj[pos+1]>30) THEN
 5290           obj[pos+1]:=obj[pos+1]-16
 5300       ELSE
 5310         BEGIN
 5320           x:=rnd(10)+1;
 5330           obj[pos]:=row(x);
 5340           obj[pos+1]:=382;
 5350           obj[pos+2]:=rnd(3)+1;
 5360         END;
 5370       IF (obj[pos+2] in [1..2]) THEN
 5380         DrawObstacle(obj[pos],obj[pos+1]);
 5390       IF (oldobj[pos+2] in [1..2]) THEN
 5400         DrawObstacle(oldobj[pos],oldobj[pos+1]);
 5410       IF (obj[pos+2] in [3]) THEN
 5420         DrawMoneyBag(obj[pos],obj[pos+1],chr(1));
 5430       IF (oldobj[pos+2] in [3]) THEN
 5440         DrawMoneyBag(oldobj[pos],oldobj[pos+1],chr(1));
 5451       collision(px,py,obj[pos],obj[pos+1],obj[pos+2]);
 5460       pos:=pos+3
 5470     END;
 5480     IF (key(chr(1))=true) THEN
 5490     BEGIN
 5500       IF px<320 THEN
 5510        BEGIN
 5520          oldpx:=px;
 5530          DrawPaddle(oldpx,py);
 5540          px:=px+32;
 5550          DrawPaddle(px,py)
 5560        END;
 5570     END ELSE
 5580     IF (key(chr(8))=true) THEN
 5590     BEGIN
 5600       IF px>32 THEN
 5610       BEGIN
 5620         oldpx:=px;
 5630         DrawPaddle(oldpx,py);
 5640         px:=px-32;
 5650         DrawPaddle(px,py)
 5660       END;
 5670     END;
 6000   END;
 9999 END.

[/size]
* Using the old Amstrad Languages :D   * with the Firmware :P
* I also like to problem solve code in BASIC :)   * And type-in Type-Ins! :D

Home Computing Weekly Programs
Popular Computing Weekly Programs
Your Computer Programs
Updated Other Program Links on Profile Page (Update April 16/15 phew!)
Programs for Turbo Pascal 3

Offline AMSDOS

  • Supporter
  • 6128 Plus
  • *
  • Posts: 3.892
  • Country: au
    • index.php?action=treasury
    • Programs for Turbo Pascal 3
  • Liked: 1104
  • Likes Given: 1867
Hope this makes ones gaming experience more nerve wracking, the previous program ("getcash2.pas"/"getcash.bin"), spends more time drawing up the redefined characters with relevant colours etc, the concept works, but isn't designed for what's going on here. "getcash3.pas"/"getcash3.bin" which simply replaces the old sprite driver with Easi-Sprite Driver, makes a huge difference in performance. Less maths is applied because ESD uses Text Based Coordinates and the Main Looping changes now to reflect the Text coordinated based system, but the box routine I'm using hasn't changed and should come in handy for handling Condensed Text later.


Code: [Select]

   10 PROGRAM GetTheCash;
   11
   12 {$C-}
   13
   14 VAR graphics: ARRAY[0..191] OF char;
   15     esd     : array[0..272] of char;
   16     obj     : ARRAY[1..30]  OF integer;
   17     oldobj  : ARRAY[1..30]  OF integer;
   18     exit    : boolean;
   19     pos     : integer;
   20     x       : integer;
   21     y       : integer;
   22     px      : integer;
   23     oldpx   : integer;
   24     py      : integer;
   25 
   30 FUNCTION rnd(range : integer) : integer;
   40 VAR seed  : integer;
   50     result: real;
   60 BEGIN
   70   seed:=random(0);
   80   result:=(range/maxint);
   90   result:=(seed*result);
  100  rnd:=trunc(result)
  110 END;
  120
  130 PROCEDURE mode(num : char);
  140 BEGIN
  150   ra:=num;
  160   user(#bc0e)
  170 END;
  171
  172 PROCEDURE kmreset;
  173 BEGIN
  174   user(#bb03)
  175 END;
  180
  190 PROCEDURE ink(ink,col1 : char);
  200 BEGIN
  210   ra:=ink;
  220   rb:=col1;
  230   rc:=col1;
  240   user(#bc32)
  250 END;
  260
  270 PROCEDURE border(col1 : char);
  280 BEGIN
  290   rb:=col1;
  300   rc:=col1;
  310   user(#bc38)
  320 END;
  321
  322 FUNCTION key(ch:char) : boolean;
  323 BEGIN
  324   inline(#DD,#7E,#02,
  325          #CD,#1E,#BB,
  326          #28,#05,
  327          #3E,#01,
  328          #DD,#77,#03)
  329 END;
  330
  340 FUNCTION row(xpos : integer) : integer;
  350 BEGIN
  360   inline(#dd,#6e,#02,
  361          #dd,#66,#03,
  362          #29,
  363          #29,
  364          #29,
  365          #29,
  366          #29,
  367          #dd,#75,#04,
  368          #dd,#74,#05)
  370 END;
  380
  390 FUNCTION column(ypos : integer) : integer;
  400 BEGIN
  410   column:=398-(ypos*16)
  420 END;
  430
  431 (*
  440 PROCEDURE SetMatrixTable;
  450 BEGIN
  460   rde:=#F0;
  470   rhl:=addr(charset);
  480   user(#bbab)
  490 END;
  500
  510 PROCEDURE SetupGraphics;
  530 BEGIN
  531   SetMatrixTable;
  532   tin('GRAPHICS.DAT',addr(charset));
  540 END;
  560 *)
  561
  562 PROCEDURE Initialize;
  563 var loop : integer;
  564 begin
  565   tin('ESD     .DAT',ADDR(esd));
  566   for loop:=0 to 272 do
  567     poke(#9c40+loop,ord(esd[loop]));
  568   tin('GETCASH .GRA',ADDR(graphics));
  569   for loop:=0 to 191 do
  570     poke(#9000+loop,ord(graphics[loop]));
  571   user(#9c40);
  572   external('SDEF',1,#9000);
  573   external('SDEF',2,#9030);
  574   external('SDEF',3,#9060);
  575   external('SDEF',4,#9090)
  576 end;
  577
  580 PROCEDURE SetupScreen;
  590 BEGIN
  600   mode(chr(0));
  610   ink(chr(1),chr(25));
  620   ink(chr(2),chr(2));
  630   ink(chr(3),chr(11));
  640   ink(chr(4),chr(26));
  650   ink(chr(5),chr(13));
  660   ink(chr(6),chr(9));
  661   ink(chr(7),chr(26));
  662   ink(chr(8),chr(6));
  663   ink(chr(9),chr(13));
  664   ink(chr(10),chr(13));
  665   ink(chr(11),chr(13));
  666   ink(chr(12),chr(0));
  670   border(chr(9))
  680 END;
  690
  700 PROCEDURE drawgra(xpos,ypos : integer; gramde, grapen, val : char);
  710 BEGIN
  720   rde:=xpos;
  730   rhl:=ypos;
  740   user(#bbc0);
  750   ra:=gramde;
  760   user(#bc59);
  770   ra:=grapen;
  780   user(#bbde);
  790   ra:=val;
  800   user(#bbfc);
  810 END;
  820
  830 FUNCTION inc(val : char) : char;
  840 BEGIN
  850   inline(#DD,#34,#2);
  860   inc:=val
  870 END;
  880
 4000 PROCEDURE DrawMoneyBag(xpos , ypos : integer);
 4010 BEGIN
 4020   external('SPRITE',1,xpos,ypos)
 4060 END;
 4070
 4200 PROCEDURE DrawObstacle(xpos , ypos : integer);
 4210 BEGIN
 4220   external('SPRITE',3,xpos,ypos)
 4240 END;
 4250
 4300 PROCEDURE DrawPaddle(xpos, ypos : integer);
 4310 BEGIN
 4320   external('SPRITE',4,xpos,ypos)
 4340 END;
 4350 
 4360 PROCEDURE Collision(goodguyx, goodguyy, badx, bady, whatis : integer);
 4361 VAR loop : char;
 4370 BEGIN
 4380   IF (goodguyx=badx) AND (goodguyy=bady) THEN
 4390   BEGIN
 4400     IF (whatis in [1..2]) THEN
 4401     BEGIN
 4402       drawpaddle(px,py);
 4406       env(2,15,-1,15);
 4407       sound(135,2,0,0,1,0,0);
 4408       FOR loop:=chr(1) TO chr(100) DO
 4409          user(#bd19);
 4410       exit:=true
 4411     END ELSE
 4413     BEGIN
 4414       drawpaddle(px,py);
 4415       env(1,15,-1,2);
 4416       ent(-1,8,-4,1);
 4417       sound(135,1,1,100,0,0,0);
 4419       user(#bd19);
 4422       py:=py-1;
 4423       drawpaddle(px,py)
 4430     END;
 4431   END;
 4432 END;
 4440
 4441 PROCEDURE box(size : integer; col : char);
 4442 var loop : integer;
 4443 BEGIN
 4444   drawgra(0,398,chr(0),col,chr(150));
 4445   drawgra(0,16,chr(0),col,chr(147));
 4446   loop:=32;
 4447   repeat
 4448     drawgra(loop,398,chr(0),col,chr(154));
 4449     drawgra(loop,16,chr(0),col,chr(154));
 4450     loop:=loop+32
 4451   until (loop=row(size+1));
 4452   drawgra(row(size+1),398,chr(0),col,chr(156));
 4453   drawgra(row(size+1),16,chr(0),col,chr(153));
 4454   loop:=384;
 4455   repeat
 4456     drawgra(0,loop,chr(0),col,chr(149));
 4457     drawgra(row(size+1),loop,chr(0),col,chr(149));
 4458     loop:=loop-16;
 4459   until (loop=16);
 4460 end;
 4461
 5000 BEGIN
 5010   Initialize;
 5030   SetupScreen;
 5031   Box(10,chr(1));
 5040   y:=1; pos:=1;
 5050   WHILE (pos<30) DO
 5060   BEGIN
 5070     x:=rnd(10)+1;
 5080     obj[pos]:=x;
 5090     obj[pos+1]:=y;
 5100     y:=y+2;
 5110     obj[pos+2]:=rnd(3)+1;
 5120     IF (obj[pos+2] in [1..2]) THEN
 5130      DrawObstacle(obj[pos],obj[pos+1])
 5160     ELSE
 5170      DrawMoneyBag(obj[pos],obj[pos+1]);
 5180     pos:=pos+3
 5190   END;
 5191   px:=6;
 5192   py:=23;
 5193   DrawPaddle(px,py);
 5194   exit:=false;
 5200   WHILE (exit=false) DO
 5210   BEGIN
 5220     pos:=1;
 5230     WHILE (pos<30) DO
 5240     BEGIN
 5241       collision(px,py,obj[pos],obj[pos+1],obj[pos+2]);
 5250       oldobj[pos]:=obj[pos];
 5260       oldobj[pos+1]:=obj[pos+1];
 5270       oldobj[pos+2]:=obj[pos+2];
 5280       IF (obj[pos+1]<23) THEN
 5290           obj[pos+1]:=obj[pos+1]+1
 5300       ELSE
 5310         BEGIN
 5320           x:=rnd(10)+1;
 5330           obj[pos]:=x;
 5340           obj[pos+1]:=1;
 5350           obj[pos+2]:=rnd(3)+1;
 5360         END;
 5370       IF (obj[pos+2] in [1..2]) THEN
 5380         DrawObstacle(obj[pos],obj[pos+1]);
 5390       IF (oldobj[pos+2] in [1..2]) THEN
 5400         DrawObstacle(oldobj[pos],oldobj[pos+1]);
 5410       IF (obj[pos+2]=3) THEN
 5420         DrawMoneyBag(obj[pos],obj[pos+1]);
 5430       IF (oldobj[pos+2]=3) THEN
 5440         DrawMoneyBag(oldobj[pos],oldobj[pos+1]);
 5451       collision(px,py,obj[pos],obj[pos+1],obj[pos+2]);
 5460       pos:=pos+3
 5470     END;
 5480     IF (key(chr(1))=true) THEN
 5490     BEGIN
 5500       IF px<10 THEN
 5510        BEGIN
 5520          oldpx:=px;
 5530          DrawPaddle(oldpx,py);
 5540          px:=px+1;
 5550          DrawPaddle(px,py)
 5560        END;
 5570     END ELSE
 5580     IF (key(chr(8))=true) THEN
 5590     BEGIN
 5600       IF px>1 THEN
 5610       BEGIN
 5620         oldpx:=px;
 5630         DrawPaddle(oldpx,py);
 5640         px:=px-1;
 5650         DrawPaddle(px,py)
 5660       END;
 5670     END;
 6000   END;
 9999 END.


* Using the old Amstrad Languages :D   * with the Firmware :P
* I also like to problem solve code in BASIC :)   * And type-in Type-Ins! :D

Home Computing Weekly Programs
Popular Computing Weekly Programs
Your Computer Programs
Updated Other Program Links on Profile Page (Update April 16/15 phew!)
Programs for Turbo Pascal 3