64'er/64ER_CD.iso/s85xx/s8504b.d64/shape.src

Text File | 1995-03-30 | 14KB | 760 lines

; PRIMITIVE SOLID SHAPE DRAWING
;
; RICHARD L. RYLANDER   11/7/84
;
; LOAD ARITHMETIC AND GRAPHIC UTILITIES FIRST
;
;*****************************************
RAM=$036A
ORIGIN=$C5EA
;
MLPCND=$AC     ; MULTIPLICAND (S)
MLPLER=$AD     ; MULTIPLIER (S)
PROD=$AE      ; PRODUCT (D)
MULT=$C011    ; CALL FOR MULTIPLY
;
DVDND=$FD     ; DIVIDEND (D)
DVSOR=$FB     ; DIVISOR (D)
QUOT=$FD      ; QUOTIENT (D)
DIVIDE=$C025  ; CALL FOR DIVIDE
;
ARG=$AC       ; ARGUMENT (S)
SQR=$AE       ; SQUARE OF ARG (D)
SQUARE=$C004  ; CALL FOR SQUARE
;
RADCND=$AC    ; RADICAND (D)
ROOT=$033C    ; SQUARE ROOT (S)
SQRT=$C064    ; CALL FOR SQRT
;
RNDM=$C000    ; RANDOM NUMBER
RANDOM=$C0C8  ; CALL FOR RANDOM
; NOTE - A CALL TO 'RANDOM' LEAVES A RANDOM BYTE
; IN THE ACCUMULATOR
;
XPLT=$033F
YPLT=$0341
NORM=$C224
PLTSHD=$C20F
VALUE=$0344   ; FINAL NORMALIZED SHADE VALUE
HTORRN=$0346  ; SHADE FLAG, 1=HALFTONE
NOSCAL=$0347  ; SCALE FLAG, 1=NO SCALE
;
       *=RAM
XCENT  *=*+2  ; CENTER COORD
XREL   *=*+1  ; RELATIVE (TO CENTER)
XSHD   *=*+2  ; USED IN SHADE CALC
YCENT  *=*+1  ; CENTER COORD
YREL   *=*+1  ; RELATIVE (TO CENTER)
YSHD   *=*+2  ; USED IN SHADE CALC
ZREL   *=*+2  ; RELATIVE (TO CENTER)
ZWX    *=*+2  ; Z WITH X (+ OR -)
;
RADIUS *=*+2  ; LOCAL RADIUS OF SURFACE
TONE   *=*+2  ; USED IN SHADE CALC
TNTMP  *=*+2  ; USED IN SHADE CALC
;
CLIPL  *=*+1  ; LEFT CLIPPING BOUND
CLIPR  *=*+1  ; RIGHT CLIPPING BOUND
CLIPU  *=*+1  ; UP CLIPPING BOUND
CLIPD  *=*+1  ; DOWN CLIPPING BOUND
;
HEMI   *=*+1  ; PLOTTING HEMISPHERE
;
BAKLIT *=*+1  ; BACKLIT FLAG
HVFLAG *=*+1  ; HORIZONTAL/VERTICAL FLAG
TEMP   *=*+2  ; TEMPORARY STORAGE
CNTX   *=*+1   ; LOOP COUNTER
CNTY   *=*+1   ; LOOP COUNTER
MAX    *=*+1   ; LOOP LIMIT
;
HLEN   *=*+1   ; HALF-LENGTH OF CYLINDERS
RS     *=*+2   ; SQUARE OF TOROID RADIUS
RT     *=*+1   ; TOROID (RING) RADIUS
RC     *=*+1   ; CENTER RADIUS OF TOROID
RO     *=*+1   ; OUTER RADIUS OF TOROID
RI     *=*+1   ; INNER RADIUS OF TOROID
XSQR   *=*+2
XMAX   *=*+1
;
R0=HLEN
;
       *=ORIGIN
;*****************************************
;
; DIVIDE WITH SINGLE PRECISION DIVISOR
; (USED OFTEN IN SHAPE ROUTINES)
;
SDIV   LDA #0
       STA DVSOR+1
       JMP DIVIDE
;
;*****************************************
;
; CALCULATE SHADE VALUE (0-63) BY
; MULTIPLYING 'TONE' BY 26 THEN
; DIVIDE RESULT BY RADIUS OF SURFACE
;
GETVAL BIT TONE+1
       BPL CNTNU   ; IF 'TONE'<0, THEN
       LDA BAKLIT  ; MAKE VALUE 0 OR ABS(TONE)
       BNE NEGATE  ; DEPENDING ON BAKLIT FLAG
       STA VALUE
       RTS
NEGATE SEC
       LDA #$00
       SBC TONE
       STA TONE
CNTNU  LDA TONE
       STA MLPCND
       LDA #$1A
       STA MLPLER
       JSR MULT
       STA DVDND+1
       LDA PROD
       STA DVDND
       LDA RADIUS
       STA DVSOR
       JSR SDIV
       LDA QUOT
       STA VALUE
       RTS
;
;*****************************************
;
; POINT PLOTTING BY QUADRANTS USING
; THE FOUR-FOLD SYMMETRY OF SIMPLE OBJECTS
;
; DEPENDING ON STATUS OF 'HVFLAG', EXCHANGE
; X AND Y COORDINATES TO ROTATE OBJECTS 90 DEG
; SINGLE SHAPE ROUTINE CAN THEN BE USED TO
; DRAW 'HORIZONTAL' OR 'VERTICAL' VERSIONS
; OF AN OBJECT
;
; THE FOLOWING IS A 'BASIC SUBROUTINE'
; EQUIVALENT TO EXPLAIN ITS OPERATION
;
; NOTE THAT LABELS ARE USED IN PLACE OF
; LINE NUMBERS
;
; 'PTPLOT' IF HVFLAG<0 THEN GOTO 'NOROT'
;          (STACK)=XREL:XREL=YREL:YREL=(STACK)
;          (STACK)=XSHD:XSHD=YSHD:YSHD=(STACK)
; 'NOROT'  GOSUB 'GETZ'
;          REM CALCULATE 2*Z FROM X,Y AND RADIUS
;          HEMI = 1
;          IF XREL>CLIPL THEN GOTO 'RHEMI'
;          ZWX=2*Z-XSHD
;          XPLT=XCENT-XREL:REM LEFT HEMISPHERE
; 'CHCLUP' IF YREL>CLIPU THEN GOTO 'DHEMI'
;          TONE=ZWX+YSHD
;          GOSUB 'GETVAL':REM NORMALIZE SHADE VAL
;          YPLT=YCENT+YREL
;          GOSUB 'PLTSHD':REM PLOT OR UNPLOT
;          REM   POINTS WEIGHTED BY SHADE VALUE
; 'DHEMI'  IF YREL>CLIPD THEN GOTO 'RHEMI'
;          TONE=ZWX-YSHD
;          GOSUB 'GETVAL'
;          YPLT=YCENT-YREL
;          GOSUB 'PLTSHD'
; 'RHEMI'  IF HEMI=0 THEN RETURN
;          HEMI=0
;          IF XREL>CLIPR THEN RETURN
;          ZWX=2*Z+XSHD
;          XPLT=XCENT+XREL
;          GOSUB 'CHCLUP'
;          RETURN
;
PTPLOT BIT HVFLAG
       BPL NOROT
       LDA XREL
       PHA
       PHA
       LDA YREL
       STA XREL
       PLA
       STA YREL
       LDA XSHD
       PHA
       PHA
       LDA YSHD
       STA XSHD
       PLA
       STA YSHD
       LDA XSHD+1
       PHA
       PHA
       LDA YSHD+1
       STA XSHD+1
       PLA
       STA YSHD+1
NOROT  JSR GETZ
PTPLT2 LDA #$01
       STA HEMI
       SEC
       LDA CLIPL  ; CHECK LEFT HEMISPHERE
       CMP XREL
       BCC RHEMI
       SEC
       LDA ROOT
       SBC XSHD
       STA ZWX
       LDA ROOT+1
       SBC XSHD+1
       STA ZWX+1
       SEC
       LDA XCENT
       SBC XREL
       STA XPLT
       LDA XCENT+1
       SBC #$00
       STA XPLT+1
;
CHCLUP SEC
       LDA CLIPU  ; CHECK FOR UP CLIPPING
       CMP YREL
       BCC DHEMI
       CLC
       LDA ZWX
       ADC YSHD
       STA TONE
       LDA ZWX+1
       ADC YSHD+1
       STA TONE+1
       JSR GETVAL
       CLC
       LDA YCENT
       ADC YREL
       STA YPLT
       JSR PLTSHD
;
DHEMI  SEC
       LDA CLIPD  ; CHECK FOR DOWN CLIPPING
       CMP YREL
       BCC RHEMI
       SEC
       LDA ZWX
       SBC YSHD
       STA TONE
       LDA ZWX+1
       SBC YSHD+1
       STA TONE+1
       JSR GETVAL
       SEC
       LDA YCENT
       SBC YREL
       STA YPLT
       JSR PLTSHD
;
RHEMI  LDA HEMI
       BEQ PLDONE
       DEC HEMI
       SEC
       LDA CLIPR  ; CHECK FOR RIGHT CLIPPING
       CMP XREL
       BCC PLDONE
       CLC
       LDA ROOT
       ADC XSHD
       STA ZWX
       LDA ROOT+1
       ADC XSHD+1
       STA ZWX+1
       CLC
       LDA XCENT
       ADC XREL
       STA XPLT
       LDA XCENT+1
       ADC #$00
       STA XPLT+1
       JMP CHCLUP
PLDONE BIT HVFLAG
       BPL NORSTR
       LDA XSHD+1    ; RESTORE COORDS
       STA YSHD+1
       PLA
       STA XSHD+1
       LDA XSHD
       STA YSHD
       PLA
       STA XSHD
       LDA XREL
       STA YREL
       PLA
       STA XREL
NORSTR RTS
;
;*****************************************
;
; CALCULATE Z FROM LOCAL X,Y BY
; PYTHAGOREAN SUM
;
GETZ   LDA RADIUS
       STA ARG
       JSR SQUARE
       STA TNTMP+1
       LDA SQR
       STA TNTMP
       LDA XSHD
       STA ARG
       JSR SQUARE
       SEC
       LDA TNTMP
       SBC SQR
       STA TNTMP
       LDA TNTMP+1
       SBC SQR+1
       STA TNTMP+1
       LDA YSHD
       STA ARG
       JSR SQUARE
       SEC
       LDA TNTMP
       SBC SQR
       STA RADCND
       LDA TNTMP+1
       SBC SQR+1
       STA RADCND+1
       BMI ZEROOT
       JSR SQRT
       ASL ROOT
       ROL ROOT+1
       RTS
ZEROOT LDA #$00
       STA ROOT
       STA ROOT+1
       RTS
;
;*****************************************
;
; SET UP PARAMETERS FOR TOROIDS
;
; RT=(RO-RI)/2   RS=RT*RT   RC=RT+RI
;
TPARM  LDA RO
       SEC
       SBC RI
       LSR A
       STA RT
       STA RADIUS
       CLC
       ADC RI
       STA RC
       LDA RT
       STA ARG
       JSR SQUARE
       LDA SQR
       STA RS
       LDA SQR+1
       STA RS+1
       LDA #0
       STA CNTX
       RTS
;
;*****************************************
;
; DRAW A SHADED SPHERE
;
; 'BASIC SUBROUTINE' EQUIVALENT
;
; 'SPHERE' FOR CNTX=0 TO RADIUS/SQR(2)
;          XREL=CNTX:XSHD=CNTX
;          FOR CNTY=CNTX TO SQR(RAD*RAD-CNTX*CNTX)
;          YREL=CNTY:YSHD=CNTY
;          HVFLAG=0
;          GOSUB 'PTPLOT'
;          REM EXCHANGE X & Y TO USE 8-FOLD SYM
;          HVFLAG=-128
;
;          GOSUB 'PTPLOT'
;          NEXT CNTY
;          NEXT CNTX
;          RETURN
;
;
SPHERE LDA RADIUS
       STA ARG
       JSR SQUARE
       ASL SQR
       ROL SQR+1
       LDA SQR
       STA RADCND
       LDA SQR+1
       STA RADCND+1
       JSR SQRT
       LSR ROOT+1
       ROR ROOT
       LDA ROOT
       STA XMAX
       LDA #$00
       STA CNTX
       STA XSHD+1
       STA YSHD+1
       LDA RADIUS
       STA ARG
       JSR SQUARE
       STA TEMP+1
       LDA SQR
       STA TEMP
LOOPX  LDA CNTX
       STA CNTY
       STA ARG
       STA XREL
       STA XSHD
       JSR SQUARE
       SEC
       LDA TEMP
       SBC SQR
       STA RADCND
       LDA TEMP+1
       SBC SQR+1
       STA RADCND+1
       JSR SQRT
       LDA ROOT
       STA MAX
LOOPY  LDA CNTY
       STA YREL
       STA YSHD
       LDA #0
       STA HVFLAG
       JSR PTPLOT
       LDA #$80
       STA HVFLAG
       JSR PTPLOT
       LDA CNTY
       CMP MAX
       BEQ DONEY
       INC CNTY
       JMP LOOPY
DONEY  LDA CNTX
       CMP XMAX
       BEQ DONE
       INC CNTX
       JMP LOOPX
DONE   RTS
;
;*****************************************
;
; DRAW SHADED CYLINDERS
;
; 'BASIC SUBROUTINE' EQUIVALENT
;
; 'CYLNDR' XSHD=0
;          FOR YREL=RADIUS TO 0
;          YSHD=YREL
;          FOR XREL=HLEN TO 0
;          GOSUB 'PTPLOT'
;          NEXT XREL
;          NEXT YREL
;          RETURN
;
CYLNDR LDA #0
       STA XSHD
       STA XSHD+1
       STA YSHD+1
       LDA RADIUS
       STA YREL
CYLOOP LDA HLEN
       STA XREL
       LDA YREL
       STA YSHD
CXLOOP JSR PTPLOT
       DEC XREL
       BPL CXLOOP
       DEC YREL
       BPL CYLOOP
       RTS
;
;*****************************************
;
; DRAW EDGE-VIEW TOROIDS
;
; 'BASIC SUBROUTINE' EQUIVALENT
;
; 'EDGTOR' GOSUB 'TPARM':REM SET UP RADII
;          FOR CNTX=0 TO RT
;          XREL=CNTX:XSHD=CNTX
;          R0=SQR(RT*RT-CNTX*CNTX)
;          FOR CNTY=0 TO R0+RC
;          YREL=CNTY
;          YSHD=(R0*CNTY)/(R0+RC)
;          GOSUB 'PTPLOT'
;          NEXT CNTY
;          NEXT CNTX
;          RETURN
;
EDGTOR JSR TPARM
       LDA #$00
       STA XSHD+1
       STA YSHD+1
LOOPX4 LDA CNTX
       STA XREL
       STA XSHD
       STA ARG
       JSR SQUARE
       SEC
       LDA RS
       SBC SQR
       STA RADCND
       LDA RS+1
       SBC SQR+1
       STA RADCND+1
       JSR SQRT
       LDA ROOT
       STA R0
       CLC
       ADC RC
       STA MAX
       LDA #$00
       STA CNTY
LOOPY4 LDA CNTY
       STA YREL
       STA MLPLER
       LDA R0
       STA MLPCND
       JSR MULT
       STA DVDND+1
       LDA PROD
       STA DVDND
       LDA MAX
       STA DVSOR
       JSR SDIV
       LDA QUOT
       STA YSHD
       JSR PTPLOT
       LDA CNTY
       CMP MAX
       BEQ DONE4
       INC CNTY
       JMP LOOPY4
DONE4  LDA CNTX
       CMP RT
       BEQ DONEHT
       INC CNTX
       JMP LOOPX4
DONEHT RTS
;
;*****************************************
;
; DRAW A SHADED, TOP-VIEW TOROID
;
; 'BASIC SUBROUTINE' EQUIVALENT
;
; 'TOROID' GOSUB 'TPARM'
;          FOR CNTX=0 TO RO/SQR(2)
;          REM 8-FOLD SYMMETRY USED
;          XREL=CNTX
;          MAX=SQR(RO*RO-CNTX*CNTX)
;          IF CNTX>RI THEN GOTO 'GRTR'
;          CNTY=SQR(RI*RI-CNTY*CNTY)
;          GOTO 'LLPY1'
; 'GRTR'   CNTY=CNTX
; 'LLPY1'  YREL=CNTY
;          R0=SQR(CNTY*CNTY+CNTX*CNTX)
;          XSHD=CNTX-(CNTX*RC)/R0
;          YSHD=CNTY-(CNTY*RC)/R0
;          HVFLAG=0:GOSUB 'PTPLOT'
;          HVFLAG=-128:GOSUB 'PTPLOT'
;          IF CNTY=MAX THEN GOTO 'DDNY1'
;          CNTY=CNTY+1
;          GOTO 'LLPY1'
; 'DDNY1'  NEXT CNTX
;          RETURN
;
TOROID JSR TPARM
       LDA RO
       STA ARG
       JSR SQUARE
       ASL SQR
       ROL SQR+1
       LDA SQR
       STA RADCND
       LDA SQR+1
       STA RADCND+1
       JSR SQRT
       LSR ROOT+1
       ROR ROOT
       LDA ROOT
       STA XMAX
LLPX1  LDA CNTX
       STA XREL
       STA ARG
       JSR SQUARE
       STA XSQR+1
       LDA SQR
       STA XSQR
       LDA RO
       STA ARG
       JSR SQUARE
       SEC
       LDA SQR
       SBC XSQR
       STA RADCND
       LDA SQR+1
       SBC XSQR+1
       STA RADCND+1
       JSR SQRT
       LDA ROOT
       STA MAX
       SEC
       LDA RI
       SBC CNTX
       BCC GRTR
       LDA RI
       STA ARG
       JSR SQUARE
       SEC
       LDA SQR
       SBC XSQR
       STA RADCND
       LDA SQR+1
       SBC XSQR+1
       STA RADCND+1
       JSR SQRT
       LDA ROOT
       STA CNTY
       JMP LLPY1
GRTR   LDA CNTX
       STA CNTY
LLPY1  LDA CNTY
       STA YREL
       STA ARG
       JSR SQUARE
       CLC
       LDA SQR
       ADC XSQR
       STA RADCND
       LDA SQR+1
       ADC XSQR+1
       STA RADCND+1
       JSR SQRT
       LDA ROOT
       STA R0
       STA DVSOR
       LDA CNTX
       STA MLPLER
       LDA RC
       STA MLPCND
       JSR MULT
       STA DVDND+1
       LDA PROD
       STA DVDND
       JSR SDIV
       SEC
       LDA CNTX
       SBC QUOT
       STA XSHD
       LDA #$00
       SBC QUOT+1
       STA XSHD+1
       LDA CNTY
       STA MLPLER
       LDA RC
       STA MLPCND
       JSR MULT
       STA DVDND+1
       LDA PROD
       STA DVDND
       LDA R0
       STA DVSOR
       JSR SDIV
       SEC
       LDA CNTY
       SBC QUOT
       STA YSHD
       LDA #$00
       STA HVFLAG
       SBC QUOT+1
       STA YSHD+1
       JSR PTPLOT
       LDA #$80
       STA HVFLAG
       JSR PTPLOT
       LDA CNTY
       CMP MAX
       BEQ DDNY1
       INC CNTY
       JMP LLPY1
DDNY1  LDA CNTX
       CMP XMAX
       BEQ DUNTOR
       INC CNTX
       JMP LLPX1
DUNTOR RTS
;
;*****************************************
;
; DRAW "INSIDE VIEW" TOROIDS
;
; 'BASIC SUBROUTINE' EQUIVALENT
;
; 'SPOOL'  GOSUB 'TPARM'
;          FOR CNTX=0 TO RT
;          XREL=CNTX:XSHD=CNTX
;          MAX=RC-SQR(RS-CNTX*CNTX)
;          FOR CNTY=0 TO MAX
;          YREL=CNTY
;          YSHD=(RC*CNTY/MAX)-CNTY
;          GOSUB 'PTPLOT'
;          NEXT CNTY
;          NEXT CNTX
;          RETURN
;
SPOOL  JSR TPARM
LLPX2  LDA CNTX
       STA XREL
       STA ARG
       SEC
       LDA #$00
       SBC CNTX
       STA XSHD
       LDA #$00
       SBC #$00
       STA XSHD+1
       JSR SQUARE
       SEC
       LDA RS
       SBC SQR
       STA RADCND
       LDA RS+1
       SBC SQR+1
       STA RADCND+1
       JSR SQRT
       SEC
       LDA RC
       SBC ROOT
       STA MAX
       LDA #$00
       STA CNTY
LLPY2  LDA CNTY
       STA YREL
       STA MLPLER
       LDA RC
       STA MLPCND
       JSR MULT
       STA DVDND+1
       LDA PROD
       STA DVDND
       LDA MAX
       STA DVSOR
       JSR SDIV
       LDA QUOT
       SEC
       SBC CNTY
       STA YSHD
       LDA QUOT+1
       SBC #$00
       STA YSHD+1
       JSR PTPLOT
       LDA CNTY
       CMP MAX
       BEQ DDNY2
       INC CNTY
       JMP LLPY2
DDNY2  LDA CNTX
       CMP RT
       BEQ DUNHSP
       INC CNTX
       JMP LLPX2
DUNHSP RTS
.END