home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
64'er
/
64ER_CD.iso
/
s85xx
/
s8504b.d64
/
shape.src
< prev
next >
Wrap
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