I wanted to keep the GWBASIC draw commands intact, so I wrote a simple GWBASIC draw() function which is used to render the car and donkey before storing them in blit strings. The result appears to be pixel perfect to the original. The game code is almost identical to the original. Sound is a little different, and the original used a GOTO at line 1750, from inside a FOR loop, which GFA views as a bug. So, It would appear the original may run out of FOR stack memory after a long donkey game play session
It was kinda a useless exercise, but, at least its done. Maybe the donkey can be used in other games
Space Donkeys?Code: Select all
REM The IBM Computer Donkey
REM Version 1.00 (C)Copyright IBM Corp 1981
REM Licensed Material - Program Property of IBM
REM
REM Converted to GFA BASIC by DJE 2023
'
DEFLIST 0
DEFWRD "A-Z"
'
IF XBIOS(4)
CLS
PRINT "HOLD IT!"
PRINT "YOU'RE NOT USING THE COLOR/GRAPHICS"
PRINT "MONITOR ADAPTER!"
PRINT "THIS PROGRAM USED GRAPHICS AND REQUIRES THAT ADAPTER."
PRINT "PRESS THE SPACE BAR TO CONTINUE"
REPEAT
UNTIL INKEY$=" "
END
ENDIF
'
SPOKE &H484,BCLR(PEEK(&H484),0)
CLS
HIDEM
BOUNDARY FALSE
SETCOLOR 0,0
SETCOLOR 15,&H777
'
PRINT AT(19,5);"IBM"
PRINT AT(12,7);"Personal Computer"
PRINT AT(17,11);CHR$(27);"bb";"DONKEY"
PRINT AT(14,13);"Version 1.00"
PRINT AT(7,17);CHR$(27);"bo";"(C) Copyright IBM Corp 1981"
PRINT AT(7,23);CHR$(27);"bc";"Press space bar to continue"
PRINT CHR$(27);"bo";
COLOR 3
frame(8*8+4,9*8+2,31*8-4,14*8-4)
REPEAT
cmd$=INKEY$
IF cmd$=CHR$(27)
END
ENDIF
UNTIL cmd$=" "
SETCOLOR 0,&H222
GOSUB 1940
GOSUB 1780
'
1540:
'
cx=110
CLS
BOX 0,0,305,199
DEFFILL 5
PBOX 6,6,97,195
PBOX 183,6,305,195
PRINT AT(5,3);"Donkey"
PRINT AT(29,3);"Driver"
PRINT AT(25,19);"Press Space ";
PRINT AT(25,20);"Bar to switch";
PRINT AT(25,21);"lanes ";
PRINT AT(25,23);"Press ESC ";
PRINT AT(25,24);"to exit ";
COLOR 1
FOR y=4 TO 199 STEP 20
LINE 140,y,140,y+10
NEXT y
cy=105
cx=105
LINE 100,0,100,199
LINE 180,0,180,199
'
1670:
'
PRINT AT(6,5);" ";sd;" "
PRINT AT(31,5);" ";sm;" "
cy=cy-4
IF cy<60
GOSUB 2230
GOTO 1540
ENDIF
PUT cx,cy,car$
dx=105+42*INT(RND*2)
FOR y=(RND*-4)*8 TO 124 STEP 6
SOUND 1,14,#3000,2
SOUND 1,0,#0,1
a$=INKEY$
IF a$=CHR$(27)
SOUND 1,0
END
ENDIF
IF LEN(a$)>0
DEFFILL 0
PBOX cx,cy,cx+28,cy+44
cx=252-cx
PUT cx,cy,car$,6
SOUND 1,15,#625,4
ENDIF
IF y>=3
PUT dx,y,dnk$
ENDIF
boom!=cx=dx AND y+25>=cy
EXIT IF boom!
IF y AND 3
GRAPHMODE 3
LINE 140,1,140,198
GRAPHMODE 1
ENDIF
NEXT y
IF boom!
GOSUB 2060
GOTO 1540
ENDIF
DEFFILL 0
PBOX dx,124,dx+32,149
GOTO 1670
'
PROCEDURE 1780
CLS
draw("S8C1")
draw("BM12,1R3M+1,3D2R1ND2U1R2D4L2U1L1")
draw("D7R1ND2U2R3D6L3U2L1D3M-1,1L3")
draw("M-1,-1U3L1D2L3U6R3D2ND2R1U7L1D1L2")
draw("U4R2D1ND2R1U2")
draw("M+1,-3")
draw("BD10D2R3U2M-1,-1L1M-1,1")
draw("BD3D1R1U1L1BR2R1D1L1U1")
draw("BD2BL2D1R1U1L1BR2R1D1L1U1")
draw("BD2BL2D1R1U1L1BR2R1D1L1U1")
GRAPHMODE 3
PBOX 0,0,40,60
GRAPHMODE 0
DEFFILL 0
FILL 1,1,0
GET 1,1,29,45,car$
RETURN
'
PROCEDURE 1940
CLS
COLOR 1
draw("S8")
draw("BM14,18")
draw("M+2,-4R8M+1,-1U1M+1,+1M+2,-1")
draw("M-1,1M+1,3M-1,1M-1,-2M-1,2")
draw("D3L1U3M-1,1D2L1U2L3D2L1U2M-1,-1")
draw("D3L1U5M-2,3U1")
FILL 21,14,1
PSET 37,10,0
PSET 40,10,0
PSET 37,11,0
PSET 40,11,0
GET 13,0,45,24,dnk$
PUT 100,100,dnk$
RETURN
'
PROCEDURE 2060
sd=sd+1
PRINT AT(6,14);"BOOM!"
GET dx,y,dx+16,y+25,d1$
d1x=dx
d1y=y
d2x=dx+17
GET dx+17,y,dx+31,y+25,d2$
GET cx,cy,cx+14,cy+44,c1$
GET cx+15,cy,cx+28,cy+44,c2$
c1x=cx
c1y=cy
c2x=cx+15
FOR p=6 TO 0 STEP -1
z#=1/(2^p)
z1#=1-z#
PUT c1x,c1y,c1$,6
PUT c2x,c1y,c2$,6
PUT d1x,d1y,d1$,6
PUT d2x,d1y,d2$,6
c1x=cx*z1#
d1y=y*z1#
c2x=c2x+(291-c2x)*z#
d1x=dx*z1#
c1y=c1y+(155-c1y)*z#
d2x=d2x+(294-d2x)*z#
PUT c1x,c1y,c1$,6
PUT c2x,c1y,c2$,6
PUT d1x,d1y,d1$,6
PUT d2x,d1y,d2$,6
SOUND 1,15,#2000+RND*400,5
SOUND 1,0
NEXT p
CLS
RETURN
'
PROCEDURE 2230
sm=sm+1
PRINT AT(26,7);"Donkey loses!"
FOR i=1 TO 100
VSYNC
NEXT i
CLS
RETURN
'
PROCEDURE draw(a$)
IF NOT draw.init!
draw.init!=TRUE
draw.x=160
draw.y=100
draw.s=4
ENDIF
LOCAL x,y,r!,b!,n!,a,c$,cmd$
a=1
WHILE a<=LEN(a$)
FOR a=a TO LEN(a$)
c$=MID$(a$,a,1)
EXIT IF c$<>" "
NEXT a
cmd$=UPPER$(c$)
INC a
n!=cmd$="N"
IF n!
cmd$=UPPER$(MID$(a$,a,1))
INC a
ENDIF
b!=cmd$="B"
IF b!
cmd$=UPPER$(MID$(a$,a,1))
INC a
ENDIF
FOR a=a TO LEN(a$)
c$=MID$(a$,a,1)
EXIT IF c$<>" "
NEXT a
r!=INSTR("+-",c$)
xx=VAL(MID$(a$,a))
ADD a,VAL?(MID$(a$,a))
IF MID$(a$,a,1)=","
INC a
ENDIF
FOR a=a TO LEN(a$)
c$=MID$(a$,a,1)
EXIT IF c$<>" "
NEXT a
yy=VAL(MID$(a$,a))
ADD a,VAL?(MID$(a$,a))
x=draw.x
y=draw.y
SELECT cmd$
CASE "C"
COLOR xx
b!=TRUE
CASE "S"
draw.s=xx
b!=TRUE
CASE "M"
IF r!
ADD draw.x,xx*draw.s\4
ADD draw.y,yy*draw.s\4
ELSE
draw.x=xx
draw.y=yy
ENDIF
CASE "U"
SUB draw.y,xx*draw.s\4
CASE "D"
ADD draw.y,xx*draw.s\4
CASE "L"
SUB draw.x,xx*draw.s\4
CASE "R"
ADD draw.x,xx*draw.s\4
ENDSELECT
IF NOT b!
DRAW x,y TO draw.x,draw.y
ENDIF
IF n!
draw.x=x
draw.y=y
ENDIF
WEND
RETURN
'
PROCEDURE frame(x1,y1,x2,y2)
BOX x1,y1,x2,y2
BOX x1+1,y1,x2-1,y2
BOX x1,y1+2,x2,y2-2
RETURN
'
END
An unexpected port. Fun!