00020 **  GLOOM 3-D V1.2 DEMONSTRATION GRAPHICS ENGINE  **
00040 ** BY JOHN KOWALSKI (SOCK MASTER) FOR 6809 COCO 3 **
00060 **      COPYRIGHT (C) 1996 BY JOHN KOWALSKI.      **
00080 
00100 START   EQU    3584
00120         ORG    START
00140         SETDP  START/256
00160 TEMP    FCB    0
00180 GFBANK  FCB    0          GFENGINE MMU BANK
00200 DISTEM  FDB    0
00220 DISTAX  FCB    0          DRAW ROUTINE TEMP
00240 NEWBAR  FDB    0
00260 OLDBAR  FDB    0
00280 TURN    FCB    0
00300 SPEED   FCB    0
00320 GFYX    EQU    GOON+1
00340 CTAADD  EQU    DIREC1+1
00360 ENGINE  LDY    NEWBAR
00380 DIR     EQU    *+1
00400         LDD    #0
00420         ADDD   #64
00440         STB    <TSTEND+1
00460         SUBD   #128
00480 AGAIN2  STD    CDIR
00500         ANDA   #1
00520         BEQ    SIMPLE
00540         LDA    #12        (A=CDIR)
00560         MUL               CALC RADAR TABLE LOCATION
00580         BRA    COMPLX
00600 SIMPLE  LDA    #12
00620         MUL
00640         ADDA   #12
00660 COMPLX  STA    65446      MMU BANK 6 FOR RADAR POINTER
00680         INCA
00700         STA    65447      MMU BANK 7 FOR RADAR POINTER
00720         LSRB
00740         LSRB
00760         LSRB
00780         ORB    #192       (OFFSET TO 49152-65535 WORKSPACE)
00800         STB    <CTAADD    RADAR POINTER MSB
00820         LDB    #0
00840         RORB
00860         STB    <CTAADD+1  RADAR POINTER LSB
00880         LDX    #96        COUNT 96 PIXELS DISTANCE
00900 DIREC1  LDU    #0000      (IMMEDIATE RADAR POINTER ADDRESS)
00920 AGAIN   LDD    ,U++
00940 YLOC    EQU    *+1
00960         ADDD   #161*256   (IMMEDIATE MAP Y POSITION)
00980         STA    <LDMAP
01000         LDD    ,U++
01020 XLOC    EQU    *+1
01040         ADDD   #64*256    (IMMEDIATE MAP X POSITION)
01060         ASLA              CORRECT ADDRESS TO REFLECT 16 BIT MAP ENTRIES
01080         STA    <LDMAP+1
01100 LDMAP   EQU    *+1
01120         LDA    65497      LOAD PIXEL OFF 2D MAP
01140         BEQ    ZERODI     FLOOR - NO RADAR ACCELERATION
01160         BMI    WALL       JUST READ A WALL
01170         CLRB              RADAR SHORTCUT - SKIP OVER KNOWN OPEN SPACES
01180         ASRA
01200         RORB
01220         SUBB   ,-X
01221         SBCA   #0
01224         BMI    YESZER
01260 NOZERO  LEAU   4,U
01280         SUBB   ,-X
01281         BCC    NOZERO
01300         DECA
01320         BPL    NOZERO
01340 YESZER  CMPX   #0
01360         BGT    AGAIN      NOT DONE SCAN YET
01380         LDD    #95
01400         BRA    OUTRAN     OUT OF RANGE
01420 ZERODI  LEAX   -1,X       CHECK DISTANCE
01440         BNE    AGAIN      NOT DONE SCAN YET
01460         LDD    #95
01480         BRA    OUTRAN
01500 WALL    INC    <LDMAP+1
01520         LDA    [LDMAP]    READ WALL COLOR
01540         STX    DISTEM
01560         LDB    #95        REVERSE DISTANCE#
01580         SUBB   DISTEM+1
01600 OUTRAN  STD    ,Y++       STORE COLOR AND DISTANCE IN NEW WALL TABLE
01620 CDIR    EQU    *+1
01640 NEXT    LDD    #0000      DO NEXT RADAR LINE
01660         ADDD   #0001
01680 TSTEND  CMPB   #00        CHECK END OF RADAR SWEEP
01700         BNE    AGAIN2     NOT YET
01720 DRAW    LDB    #1
01740         STB    65425      SWITCH WHOLE GFX SCREEN TO CPU 64K
01760         CLRB              DRAW ALL THE LINES ON THE SCREEN
01780         LDX    NEWBAR
01800         LDU    OLDBAR
01820         STX    OLDBAR
01840         STU    NEWBAR
01860 DAGAIN  STB    <GFYX+1
01880         LDB    1,U        DISTANCE
01900         SUBB   1,X
01920         BMI    FURTHE
01940         LDA    ,X+        WALL COLOR
01960         CMPA   ,U++
01980         BNE    CLODIF
02000 CLOSAM  STB    DISTAX
02020         LDB    #191
02040         SUBB   ,X+
02060         BSR    GENLIN
02080         LDB    -1,U
02100         DECB
02120         BSR    GENLIN
02140         BRA    SKIPPO
02160 CLODIF  LDB    #191+32
02180         SUBB   ,X
02200         STB    <GFYX
02220         LDB    #96
02240         SUBB   ,X+
02260         LSLB
02280         BEQ    SKIPPO
02300         BSR    GOON
02320 SKIPPO  LDB    <GFYX+1
02340         INCB
02360         BPL    DAGAIN     NOT DONE WHOLE SCREEN YET
02380         CLRB
02400         STB    65425      SWITCH NORMAL PRG MEM BACK TO CPU 64K
02420         RTS               DONE IT ALL, RETURN FROM ENGINE CALL
02440 GENLIN  ADDB   #32        OFFSET TO GRAPHICS MEMORY
02460         STB    <GFYX
02480 GENLI2  LDB    DISTAX
02500         BNE    GOON
02520         RTS
02540 GOON    STA    65497
02560         DEC    <GFYX
02580         DECB
02600         BNE    GOON
02620         RTS
02640 FURTHE  LDA    ,X+        WALL COLOR
02660         NEGB
02680         CMPA   ,U+
02700         BNE    FURDIF
02720 FURSAM  STB    DISTAX
02740         LDB    #191       BOTTOM OF SCREEN
02760         SUBB   ,U+        START
02780         LDA    #187       FLOOR COLOR
02800         BSR    GENLIN
02820         LDB    ,X+        START
02840         DECB
02860         LDA    #170       CEILING COLOR
02880         BSR    GENLIN
02900         BRA    SKIPPO
02920 FURDIF  STB    DISTAX
02940         LDB    #191       BOTTOM
02960         SUBB   ,U+
02980         LDA    #187       FLOOR COLOR
03000         BSR    GENLIN
03020         LDA    -1,X       WALL COLOR
03040         LDB    #96
03060         SUBB   ,X+        DISTANCE
03080         LSLB
03100         BSR    GOON
03120         LDA    #170       CEILING COLOR
03140         BSR    GENLI2
03160         BRA    SKIPPO
03180 FIRQ    STD    FSTACK+1
03200         STX    FSTACX+1
03220                           *FIRQ ROUTINE GOES HERE
03240 FSTACX  LDX    #0000      X STACK
03260         LDA    65427      FIRQ ACK
03280 FSTACK  LDD    #0000      A,B STACK
03300         RTI
03320 SETUP   CLRA              EXEC ADDRESS
03340         STA    65497      FAST POKE
03360         STA    65344      STOP DISK SPIN
03380         LDA    #52
03400         STA    $FF03      DISABLE OLD IRQ,ENABLE SOUND & KEYBOARD
03420         ORCC   #80        MASK INTERRUPTS
03440         LDA    #START/256
03460         TFR    A,DP       SET DP TO START OF PRG
03480         LDB    #$FF       CHECK FOR 6309 CPU
03500         FCB    $10,$4F
03520         TSTB
03540         BNE    M6809
03560         LDMD   #$1        ENABLE 6309 NATIVE MODE, FAST FIRQ
03580 M6809   LDS    #1151      SET STACK POINTER TO SOMEWHERE SAFE
03600         LDX    #$FEF4
03620         LDA    #$7E       'JMP EXTENDED'
03640         STA    ,X
03660         STA    3,X
03680         LDD    #FIRQ      FIRQ ROUTINE ADDRESS
03700         STD    1,X
03720         LDD    #IRQ       IRQ ROUTINE ADDRESS
03740         STD    4,X
03760         LDX    #65424     START OF GIME REGS
03780         LDY    #DATA      POINT TO DATA
03800 STLOOP  LDB    ,Y+
03820         STB    ,X+
03840         CMPX   #65472
03860         BLO    STLOOP
03880         LDB    #63
03900         STB    65315      ENABLE AUDIO
03920         LDB    #128
03940         STB    65312      DAC TO CENTER
03960         LDA    #50        CLEAR SCREEN TO BLACK
03980 CLS     LDX    #49152
04000         STA    65446
04020         STA    TEMP
04040         CLRA
04060         CLRB
04080 CLOOP2  STD    ,X++
04100         CMPX   #57344
04120         BLO    CLOOP2
04140         LDA    TEMP
04160         INCA
04180         CMPA   #56
04200         BLO    CLS
04220         LDX    #BAR1      SETUP GFX DISPLAY VECTOR TABLES
04240         STX    NEWBAR
04260         LDX    #BAR2
04280         STX    OLDBAR
04300         CLRB
04320         CLRA
04340 COLDB   STA    ,X+
04360         DECB
04380         BNE    COLDB
04400         LDU    #$000C     GENERATE OTHER HALF OF RADAR DATA TABLE.
04420 RLOOP   STU    65444      (REALLY! THE TABLE IS 192K LONG. LARGER THAN
04440         LDX    #32768      A DISK, SO I HAD TO REDUCE IT SOME...)
04460         LDY    #40960
04480 RLOOP2  LDD    ,X++
04500         COMA
04520         COMB
04540         ADDD   #0001
04560         STD    ,Y++
04580         CMPX   #40960
04600         BLO    RLOOP2
04620         LEAU   $0101,U
04640         CMPU   #$0C0D
04660         BLO    RLOOP
04680         LDA    #0         DIFFERENCE ENGINE TABLE GENERATOR
04700         STA    65446      (CALCULATES DIFFERENCE TABLE USING THE RADAR
04720         LDU    #49154      TABLE TO ENSURE FUTURE COMPATIBILITY)
04740         LDX    #96
04760 DLOOP   LDD    4,U
04780         SUBD   ,U
04800         LEAU   4,U
04820         TSTA
04840         BEQ    AZER       CLIP B AT 255 IF D>255
04860         LDB    #255
04880 AZER    STB    ,-X
04900         CMPX   #0
04920         BHI    DLOOP
04940         LDB    #255
04960         STB    $0000
04980         LDD    #$3031
05000         STD    65444
05020         *ANDCC #175       UNMASK IRQ & FIRQ
05040 DUH     JSR    ENGINE     **THIS IS WHERE THE GAME GOES
05060         JSR    KEYIN      DECODE KEYBOARD CONTROLS
05080         LDB    TURN
05100         LDA    KEYBUF+5
05120         ANDA   #8
05140         BNE    NOLEFT
05160         SUBB   #3
05180         CMPB   #-24
05200         BGT    NOLEFT
05220         LDB    #-24
05240 NOLEFT  LDA    KEYBUF+6
05260         ANDA   #8
05280         BNE    NORITE
05300         ADDB   #3
05320         CMPB   #24
05340         BLT    NORITE
05360         LDB    #24
05380 NORITE  CMPB   #0
05400         BGE    POSIT
05420         ADDB   #2
05440         BCC    POSIT
05460         CLRB
05480 POSIT   BLE    NEGIT
05500         SUBB   #2
05520         BCC    NEGIT
05540         CLRB
05560 NEGIT   STB    TURN
05580         SEX
05600         ADDD   DIR
05620         STD    DIR
05640         LDB    SPEED
05660         LDA    KEYBUF+4
05680         ANDA   #8
05700         BNE    NOUP
05720         ADDB   #3
05740         CMPB   #32
05760         BLT    NOUP
05780         LDB    #32
05800 NOUP    LDA    KEYBUF+3
05820         ANDA   #8
05840         BNE    NODOWN
05860         SUBB   #3
05880         CMPB   #-32
05900         BGT    NODOWN
05920         LDB    #-32
05940 NODOWN  CMPB   #0
05960         BGE    FORWAR
05980         ADDB   #2
06000         BCC    FORWAR
06020         CLRB
06040 FORWAR  BLE    BACKWA
06060         SUBB   #2
06080         BCC    BACKWA
06100         CLRB
06120 BACKWA  STB    SPEED
06140         CMPB   #0
06160         BGT    GOPOS
06180         BEQ    GONO
06200         LDD    DIR
06220         ADDA   #1
06240         ANDA   #1
06260         BSR    ANGLE
06280         LDA    SPEED
06300         NEGA
06320         BRA    GOGO
06340 GOPOS   LDD    DIR
06360         BSR    ANGLE
06380         LDA    SPEED
06400 GOGO    LDU    362,X
06420         PSHS   A
06440         BSR    MULTIP
06460         ADDD   XLOC
06480         STD    XLOC
06500         LDU    360,X
06520         PULS   A
06540         BSR    MULTIP
06560         ADDD   YLOC
06580 YOKE1   CMPA   #129       PREVENT FROM WALKING OFF MAP AREA
06600         BHI    YOKE
06620         ADDD   #64
06640         BRA    YOKE1
06660 YOKE    CMPA   #190
06680         BLO    YOKE2
06700         SUBD   #64
06720         BRA    YOKE
06740 YOKE2   STD    YLOC
06760 GONO    JMP    DUH        DO IT ALL AGAIN
06780 ANGLE   ANDA   #1         *CALC MOVEMENT ANGLE SUBROUTINE
06800         BNE    FIRST
06820         LDA    #12
06840         MUL               CALC RADAR TABLE LOCATION
06860         BRA    SECOND
06880 FIRST   LDA    #12
06900         MUL
06920         ADDA   #12
06940 SECOND  STA    65446      MMU BANK 6 FOR RADAR POINTER
06960         INCA
06980         STA    65447      MMU BANK 7 FOR RADAR POINTER
07000         LSRB
07020         LSRB
07040         LSRB
07060         ORB    #192       (OFFSET TO 49152-65535 WORKSPACE)
07080         STB    <CTAADD    RADAR POINTER MSB
07100         LDB    #0
07120         RORB
07140         STB    <CTAADD+1  RADAR POINTER LSB
07160         LDX    <CTAADD    X=POINTER
07180         RTS
07200 *
07220 *16BIT SIGNED BY 8BIT UNSIGNED MULTIPLY
07240 * D = ( U * A ) / 256
07260 OP1     FDB    0
07280 RES1    FDB    0
07300 MULTIP  STU    OP1
07320         STA    OP2+1
07340         LDB    OP1
07360         BPL    MPOS       CHECK NEGATIVE VALUE
07380         COMB
07400         NEG    OP1+1
07420         ADCB   #0
07440 MPOS    MUL
07460         STD    RES1
07480 OP2     LDA    #0
07500         LDB    OP1+1
07520         MUL
07540         ADDA   RES1+1
07560         TFR    A,B
07580         LDA    RES1
07600         ADCA   #0
07620         TST    OP1
07640         BPL    MPOS2      CHECK NEGATIVE VALUE
07660         COMA
07680         COMB
07700         ADDD   #1
07720 MPOS2   RTS
07740 KEYIN   LDX    #KEYBUF    *READ THE KEYBOARD SUBROUTINE
07760         LDA    #$FF
07780         STA    $FF02
07800 KEYLOP  ROL    $FF02
07820         BCS    KEYGO
07840         RTS
07860 KEYGO   LDA    $FF00
07880         STA    ,X+
07900         BRA    KEYLOP
07920 IRQ     LDA    65426      THIS IS WHERE THE IRQ ROUTINE GOES
07940         RTI
07960 DATA    FCB    124,0,8,32,0,1,0,0,128,26,0,0,0,200,0,128
07980         FCB    56,57,58,59,48,49,62,63,56,50,51,52,53,54,55,63
08000         FCB    0,2,21,23,8,11,29,6,48,54,4,34,53,7,56,63
08020 *BLACK,3 GREEN,3 BLUE,3 YELLO,3 BROWN,3 GREY
08040 *   0 ,1 2 3  ,4 5 6 ,7 8 9  ,A B C  ,D E F
08060 KEYBUF  RMB    8
08080 BAR1    RMB    256
08100 BAR2    RMB    256
08120         END    SETUP