cube3d.tal (3632B)
1 ( Cube3d: Just a cube, y'know ) 2 3 |00 @System &vector $2 &wst $1 &rst $1 &eaddr $2 &ecode $1 &pad $1 &r $2 &g $2 &b $2 &debug $1 &halt $1 4 |20 @Screen &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1 5 |000 6 7 @cube &v0 $8 &v4 $8 8 @center &x $2 &y $2 9 @timer $1 10 11 |100 12 13 @on-reset ( -> ) 14 ( | theme ) 15 #4fcd .System/r DEO2 16 #4fc3 .System/g DEO2 17 #dfc2 .System/b DEO2 18 ( | center ) 19 .Screen/width DEI2 #01 SFT2 #0040 SUB2 .center/x STZ2 20 .Screen/height DEI2 #01 SFT2 #0040 SUB2 .center/y STZ2 21 ( | begin. ) 22 ;on-frame .Screen/vector DEO2 23 24 @on-frame ( -> ) 25 [ LIT &f $1 ] INCk ,&f STR 26 DUP #01 AND ?{ POP BRK } 27 #01 SFT .timer STZ 28 ( | clear ) 29 #0000 DUP2 .Screen/x DEO2 30 .Screen/y DEO2 31 [ LIT2 80 -Screen/pixel ] DEO 32 ( | draw ) 33 <draw-cube> 34 BRK 35 36 @<draw-cube> ( frame -- ) 37 ( | create box ) 38 #0800 39 &>loop ( -- ) 40 STHk [ LIT2 00 -timer ] LDZ #00 STHkr INC #07 AND #60 SFT ADD2 #00ff AND2 ;table ADD2 LDA #01 SFT #00 .timer LDZ #00 STHkr #60 SFT ADD2 #00ff AND2 ;table ADD2 LDA #02 SFT #00 STHkr #62 SFT2 ADD2 .cube/v0 STHr DUP ADD ADD STZ2 41 INC GTHk ?&>loop 42 POP2 43 ( | vertices ) 44 #0800 45 &>ver-loop ( -- ) 46 DUP DUP ADD LDZ2 <draw-vertex> 47 INC GTHk ?&>ver-loop 48 POP2 49 ( lines ) #0400 50 &>line-loop ( -- ) 51 STHk .cube/v0 STHkr DUP ADD ADD .cube/v0 STHkr INC #03 AND DUP ADD ADD <draw-edge> 52 .cube/v0 STHkr DUP ADD ADD .cube/v4 STHkr DUP ADD ADD <draw-edge> 53 .cube/v4 STHkr DUP ADD ADD .cube/v4 STHr INC #03 AND DUP ADD ADD <draw-edge> 54 INC GTHk ?&>line-loop 55 POP2 JMP2r 56 57 @<draw-edge> ( a b -- ) 58 STH 59 STH 60 ( ) #00 STHkr LDZ .center/x LDZ2 ADD2 61 ( ) #00 STHr INC LDZ .center/y LDZ2 ADD2 62 ( ) #00 STHkr LDZ .center/x LDZ2 ADD2 63 ( ) #00 STHr INC LDZ .center/y LDZ2 ADD2 #05 !<draw-line> 64 65 @<draw-vertex> ( x y -- ) 66 #00 SWP #0004 SUB2 .center/y LDZ2 ADD2 .Screen/y DEO2 67 #00 SWP #0003 SUB2 .center/x LDZ2 ADD2 .Screen/x DEO2 68 ;&icn .Screen/addr DEO2 69 [ LIT2 05 -Screen/sprite ] DEO 70 JMP2r 71 &icn [ 0000 387c 7c7c 3800 ] 72 73 @<draw-line> ( x1* y1* x2* y2* color -- ) 74 ,&color STR 75 ,&y STR2 76 ,&x STR2 77 ,&y2 STR2 78 ,&x2 STR2 79 ,&x LDR2 ,&x2 LDR2 SUB2 abs2 ,&dx STR2 80 #0000 ,&y LDR2 ,&y2 LDR2 SUB2 abs2 SUB2 ,&dy STR2 81 #ffff [ LIT2 00 _&x2 ] LDR2 ,&x LDR2 lts2 DUP2 ADD2 ADD2 ,&sx STR2 82 #ffff [ LIT2 00 _&y2 ] LDR2 ,&y LDR2 lts2 DUP2 ADD2 ADD2 ,&sy STR2 83 [ LIT2 &dx $2 ] [ LIT2 &dy $2 ] ADD2 STH2 84 &while ( -- ) 85 [ LIT2 &x2 $2 ] DUP2 .Screen/x DEO2 86 [ LIT2 &x $2 ] EQU2 [ LIT2 &y2 $2 ] DUP2 .Screen/y DEO2 87 [ LIT2 &y $2 ] EQU2 [ LIT2 &color $1 -Screen/pixel ] DEO 88 AND ?&end 89 STH2kr DUP2 ADD2 DUP2 ,&dy LDR2 lts2 ?&skipy 90 STH2r ,&dy LDR2 ADD2 STH2 91 ,&x2 LDR2 [ LIT2 &sx $2 ] ADD2 ,&x2 STR2 92 &skipy ( -- ) 93 ,&dx LDR2 gts2 ?&while 94 STH2r ,&dx LDR2 ADD2 STH2 95 ,&y2 LDR2 [ LIT2 &sy $2 ] ADD2 ,&y2 STR2 96 !&while 97 &end POP2r JMP2r 98 99 @abs2 ( a* -- f ) 100 DUP2 #0f SFT2 EQU ?{ #0000 SWP2 SUB2 } 101 JMP2r 102 103 @lts2 ( a* b* -- f ) 104 #8000 STH2k ADD2 SWP2 STH2r ADD2 GTH2 JMP2r 105 106 @gts2 ( a* b* -- f ) 107 #8000 STH2k ADD2 SWP2 STH2r ADD2 LTH2 JMP2r 108 109 @table ( 256 xy ) 110 [ 111 f7f8 f9fa fbfc fcfd fefe ffff ffff ffff 112 ffff ffff fffe fefd fcfc fbfa f9f8 f7f6 113 f5f3 f2f0 efed ecea e8e6 e4e2 e0de dcda 114 d8d5 d3d1 cecc c9c7 c4c1 bfbc b9b6 b3b0 115 aeab a8a5 a29f 9c98 9592 8f8c 8986 8380 116 7c79 7673 706d 6a67 6360 5d5a 5754 514f 117 4c49 4643 403e 3b38 3633 312e 2c2a 2725 118 2321 1f1d 1b19 1715 1312 100f 0d0c 0a09 119 0807 0605 0403 0302 0101 0000 0000 0000 120 0000 0000 0001 0102 0303 0405 0607 0809 121 0a0c 0d0f 1012 1315 1719 1b1d 1f21 2325 122 272a 2c2e 3133 3638 3b3e 4043 4649 4c4f 123 5154 575a 5d60 6367 6a6d 7073 7679 7c7f 124 8386 898c 8f92 9598 9c9f a2a5 a8ab aeb0 125 b3b6 b9bc bfc1 c4c7 c9cc ced1 d3d5 d8da 126 dcde e0e2 e4e6 e8ea eced eff0 f2f3 f5f6 ] 127