#define equ .equ ; these will make ti83asm.inc #define EQU .equ ; and tokens.inc work in TASM .NOLIST .INCLUDE "ti83asm.inc" ; TI83 System Routine Equates .INCLUDE "tokens.inc" ; TI83 Tokens .LIST .ORG 9327h ; -------------------------- Initiation ------------------------------------------ CALL intro CALL _clrscrnfull CALL _homeup LD A, (exitflag) CP 01h RET Z SET 5,(IY + 4) RES 2,(IY + 4) SET 7,(IY + 20) ; direct to graph CALL _REGRAPH CALL _runIndicOff CALL computepos CALL ritarect ; -------------------------- xpos = 0 -------------------------------------------- LD A, 01h LD (xpos), A ; xpos = A xpos = 0 ; -------------------------- ypos = 0 -------------------------------------------- xloop: LD A, 01h ; A = 0 LD (ypos), A ; ypos = A ypos = 0 ; -------------------------- op3 = xpos / 32 - 2 --------------------------------- yloop: LD A, (xpos) ; A = xpos CALL _SETXXOP1 ; op1 = A op1 = xpos LD A, (halfheight) ; A = 32 CALL _setXXOP2 ; op2 = A op2 = 32 CALL _FPDIV ; op1 = op1 / op2 op1 = xpos / 32 CALL _MINUS1 ; op1 = op1 - 1 op1 = xpos / 32 - 1 CALL _MINUS1 ; op1 = op1 - 1 op1 = xpos / 32 - 2 CALL _OP1TOOP3 ; op3 = op1 op3 = xpos / 32 - 2 CALL pushop3 ; -------------------------- op4 = ypos / -32 + 1 ------------------------------ LD A, (ypos) ; A = ypos CALL _SETXXOP1 ; op1 = A op1 = ypos LD A, (halfheight) ; A = 32 CALL _SETXXOP2 ; op2 = A op2 = 32 CALL _FPDIV ; op1 = op1 / op2 op1 = ypos / 32 CALL _INVOP1S ; op1 = -op1 op1 = -(ypos / 32) CALL _PLUS1 ; op1 = op1 + 1 op1 = -(ypos / 32) + 1 CALL _OP1TOOP4 ; op4 = op1 op4 = -(ypos / 32) + 1 CALL pushop4 ; -------------------------- color = 0 ------------------------------------------ LD A, 00h ; A = 0 LD (color), A ; color = A color = 0 ; -------------------------- op5 = 0 -------------------------------------------- CALL _OP5SET0 ; op5 = 0 CALL pushop5 ; -------------------------- op6 = 0 -------------------------------------------- CALL _OP1SET0 ; op1 = 0 CALL _OP1TOOP6 ; op6 = op1 op6 = 0 CALL pushop6 ; -------------------------- color = color + 1 ---------------------------------- while: LD A, (color) ; A = color INC A ; A = A + 1 A = color + 1 LD (color), A ; color = A color = color + 1 ; ------------------------- break ---------------------------------------------- LD A, $BF OUT (1), A IN A, (1) BIT 6, A JP Z, userbreak ; -------------------------- temp = op5^2 - op6^2 + op3 ------------------------- CALL popop6 CALL _OP6TOOP1 ; op1 = op6 CALL _FPSQUARE ; op1 = op1^2 op1 = op6^2 CALL _OP1TOOP2 ; op2 = op1 op2 = op6^2 CALL pushop2 CALL popop5 CALL _OP5TOOP1 ; op1 = op5 CALL _FPSQUARE ; op1 = op1^2 op1 = op5^2 CALL popop2 CALL _FPSUB ; op1 = op1 - op2 op1 = op5^2 - op6^2 CALL pushop1 CALL popop3 CALL _OP3TOOP2 ; op2 = op3 CALL popop1 CALL _FPADD ; op1 = op1 + op2 op1 = op5^2 - op6^2 + op3 CALL _STOX ; x = op1 x = op5^2 - op6^2 + op3 ; -------------------------- op6 = 2 * op5 * op6 + op4 --------------------------- CALL popop5 CALL _OP5TOOP1 ; op1 = op5 CALL pushop1 CALL popop6 CALL _OP6TOOP2 ; op2 = op6 CALL popop1 CALL _FPMULT ; op1 = op1 * op2 op1 = op5 * op6 CALL _TIMES2 ; op1 = 2 * op1 op1 = 2 * op5 * op6 CALL pushop1 CALL popop4 CALL _OP4TOOP2 ; op2 = op4 CALL popop1 CALL _FPADD ; op1 = op1 + op2 op1 = 2 * op5 * op6 + op4 CALL _OP1TOOP6 ; op6 = op1 op6 = 2 * op5 * op6 + op4 CALL pushop6 ; -------------------------- op5 = temp ------------------------------------------- CALL _RCLX ; op1 = x CALL _OP1TOOP5 ; op5 = op1 op5 = x CALL pushop5 ; -------------------------- if op5^2 + op6^2 < 4 then goto while ----------------- CALL _OP5TOOP1 ; op1 = op5 CALL _FPSQUARE ; op1 = op1^2 op1 = op5^2 CALL _OP1TOOP2 ; op2 = op1 op2 = op5^2 CALL pushop2 CALL popop6 CALL _OP6TOOP1 ; op1 = op6 CALL _FPSQUARE ; op1 = op1^2 op1 = op6^2 CALL popop2 CALL _FPADD ; op1 = op1 + op2 op1 = op6^2 + op5^2 CALL _OP1TOOP2 ; op2 = op1 op2 = op6^2 + op5^2 CALL pushop2 CALL _OP1SET4 ; op1 = 4 op1 = 4 CALL popop2 CALL _FPSUB CALL _CKOP1POS JR NZ, hoppa_ur ; -------------------------- if color < 10 then goto while ------------------------- LD A, (depth) LD B, A LD A, (color) ; A = color CP B ; color == 4 JR Z, hoppa_ur ; if color == 4 then goto fortsatt JP while hoppa_ur: ; -------------------------- if color = udda then ritaprick --------------------- LD A, (color2) CP 01h JR NZ, ritainv LD A, (color) ; A = color RR A JP C, ritaprick ; if A(0) == 1 then goto ritaprick JR klarrita ritainv: LD A, (color) ; A = color RR A JP NC, ritaprick ; if A(0) == 1 then goto ritaprick klarrita: ; -------------------------- next y ---------------------------------------------- LD A, (height) LD B, A LD A, (ypos) ; A = ypos INC A ; A = A + 1 A = ypos + 1 LD (ypos), A ; ypos = A ypos = ypos + 1 CP B ; ypos == 32 JP NZ, yloop ; if ypos != 32 then goto yloop ; -------------------------- next x ---------------------------------------------- LD A, (width) LD B, A LD A, (xpos) ; A = xpos INC A LD (xpos), A ; xpos = A xpos = xpos + 1 CP B ; xpos == 20 JP NZ, xloop ; if xpos != 20 then goto xloop ; -------------------------- ret ------------------------------------------------- RET userbreak: CALL _clrscrnfull CALL _homeup LD HL, userbreakstr CALL _puts CALL _getkey RET ritarect: LD A, (minx) LD B, A LD A, (miny) LD C, A LD A, (maxx) LD D, A LD A, (miny) LD E, A LD H, 01h CALL _ILine LD A, (minx) LD B, A LD A, (maxy) LD C, A LD A, (maxx) LD D, A LD A, (maxy) LD E, A LD H, 01h CALL _ILine LD A, (minx) LD B, A LD A, (miny) LD C, A LD A, (minx) LD D, A LD A, (maxy) LD E, A LD H, 01h CALL _ILine LD A, (maxx) LD B, A LD A, (miny) LD C, A LD A, (maxx) LD D, A LD A, (maxy) LD E, A LD H, 01h CALL _ILine RET ritaprick: LD A, 1 ; A = 1 LD D, A ; D = A D = 1 LD A, (xpos) ; A = xpos LD B, A LD A, (minx) ADD A, B LD B, A ; B = A B = xpos LD A, (ypos) ; A = ypos LD C, A LD A, (miny) ADD A, C LD C, A CALL _IPoint ; Plot pixel JP klarrita intro: CALL _runIndicOff CALL _clrScrnFull RES 7,(IY + 20) ; direct to graph SET 3,(IY + 5) CALL _HomeUp LD HL, fractalstr CALL _puts LD HL, 0700h LD (pencol), HL LD HL, copyrightstr CALL _vputs RES 3,(IY + 5) LD BC, 0032h LD DE, 5E32h LD H, 1 CALL _ILine CALL writeoptions CALL dispsizevar CALL dispdepthvar CALL dispcolorvar keyloop: CALL _getK CALL _OP2TOOP1 CALL _CONVOP1 CP 19h JR Z, moveup CP 22h JR Z, movedown CP 18h JR Z, left CP 1Ah JR Z, right CP 69h JR Z, enter JR keyloop enter: LD A, (option) CP 03h RET Z CP 04h JR Z, setexitflag JR keyloop setexitflag: LD A, 01h LD (exitflag), A RET writeoptions: CALL dispoptions LD A, (option) CP 00h CALL Z, dispselsize CP 01h CALL Z, dispseldepth CP 02h CALL Z, dispselcolor CP 03h CALL Z, dispselrun CP 04h CALL Z, dispselexit RET moveup: LD A, (option) CP 00h JR Z, keyloop DEC A LD (option), A CALL writeoptions JR keyloop movedown: LD A, (option) CP 04h JR Z, keyloop INC A LD (option), A CALL writeoptions JR keyloop left: LD A, (option) CP 00h JR Z, decsizevar CP 01h JP Z, decdepthvar CP 02h JR Z, deccolorvar JP keyloop right: LD A, (option) CP 00h JR Z, incsizevar CP 01h JR Z, incdepthvar CP 02h JR Z, inccolorvar JP keyloop incsizevar: LD A, (size) CP 62d JP Z, keyloop INC A INC A LD (size), A CALL dispsizevar JP keyloop decsizevar: LD A, (size) CP 10d JP Z, keyloop DEC A DEC A LD (size), A CALL dispsizevar JP keyloop incdepthvar: LD A, (depth) CP 30d JP Z, keyloop INC A LD (depth), A CALL dispdepthvar JP keyloop decdepthvar: LD A, (depth) CP 1d JP Z, keyloop DEC A LD (depth), A CALL dispdepthvar JP keyloop inccolorvar: LD A, 00h LD (color2), A CALL dispcolorvar JP keyloop deccolorvar: LD A, 01h LD (color2), A CALL dispcolorvar JP keyloop dispselsize: SET 3,(IY + 5) LD HL, 0F01h LD (pencol), HL LD HL, sizestr CALL _vputs RES 3,(IY + 5) RET dispseldepth: SET 3,(IY + 5) LD HL, 1601h LD (pencol), HL LD HL, depthstr CALL _vputs RES 3,(IY + 5) RET dispselcolor: SET 3,(IY + 5) LD HL, 1D01h LD (pencol), HL LD HL, colorstr CALL _vputs RES 3,(IY + 5) RET dispselrun: SET 3,(IY + 5) LD HL, 2E2Ah LD (pencol), HL LD HL, runstr CALL _vputs RES 3,(IY + 5) RET dispselexit: SET 3,(IY + 5) LD HL, 3528h LD (pencol), HL LD HL, exitstr CALL _vputs RES 3,(IY + 5) RET dispoptions: LD HL, 0F01h LD (pencol), HL LD HL, sizestr CALL _vputs LD HL, 1601h LD (pencol), HL LD HL, depthstr CALL _vputs LD HL, 1D01h LD (pencol), HL LD HL, colorstr CALL _vputs LD HL, 2E2Ah LD (pencol), HL LD HL, runstr CALL _vputs LD HL, 3528h LD (pencol), HL LD HL, exitstr CALL _vputs RET dispsizevar: LD A, (size) CALL _setxxop1 LD HL, 0F57h LD (pencol), HL LD A, 02h CALL _dispop1a RET dispdepthvar: LD A, (depth) CALL _setxxop1 LD HL, 1657h LD (pencol), HL LD A, 02h CALL _dispop1a RET dispcolorvar: LD HL, 1D40h LD (pencol), HL LD A, (color2) CP 01h JR Z, dispinv LD HL, normstr CALL _vputs RET dispinv: LD HL, invstr CALL _vputs RET computepos: LD A, (size) LD (height), A SRL A LD (halfheight), A LD B, A ADD A, B ADD A, B LD (width), A SRL A LD B, A LD A, 48d SUB B LD (minx), A LD A, (width) SRL A LD B, A LD A, 48d ADD A, B LD (maxx), A LD A, (height) SRL A LD B, A LD A, 32d SUB B LD (miny), A LD A, (height) SRL A LD B, A LD A, 32d ADD A, B LD (maxy), A RET size: .db 62d width: .db 00h height: .db 00h halfheight: .db 00h minx: .db 00h maxx: .db 00h miny: .db 00h maxy: .db 00h xpos: .db 00h ypos: .db 00h color: .db 00h depth: .db 10d color2: .db 00d option: .db 00h exitflag: .db 00h fractalstr: .db " Fractal Viewer ",0 copyrightstr: .db " (C)opyrig" .db "ht in 1997 ",0 sizestr: .db " Size", 0 depthstr: .db " Depth", 0 colorstr: .db " Color", 0 invstr: .db "Inverted", 0 normstr: .db " Normal",0 runstr: .db " RUN", 0 exitstr: .db " EXIT", 0 userbreakstr .db "User break.", 0 pushop1: LD B, 11d LD DE, sop1 LD HL, (adrop1) hopp1: LD A, (HL) LD (DE), A INC DE INC HL DJNZ hopp1 RET pushop2: LD B, 11d LD DE, sop2 LD HL, (adrop2) hopp2: LD A, (HL) LD (DE), A INC DE INC HL DJNZ hopp2 RET pushop3: LD B, 11d LD DE, sop3 LD HL, (adrop3) hopp3: LD A, (HL) LD (DE), A INC DE INC HL DJNZ hopp3 RET pushop4: LD B, 11d LD DE, sop4 LD HL, (adrop4) hopp4: LD A, (HL) LD (DE), A INC DE INC HL DJNZ hopp4 RET pushop5: LD B, 11d LD DE, sop5 LD HL, (adrop5) hopp5: LD A, (HL) LD (DE), A INC DE INC HL DJNZ hopp5 RET pushop6: LD B, 11d LD DE, sop6 LD HL, (adrop6) hopp6: LD A, (HL) LD (DE), A INC DE INC HL DJNZ hopp6 RET popop1: LD B, 11d LD DE, sop1 LD HL, (adrop1) hopp11: LD A, (DE) LD (HL), A INC DE INC HL DJNZ hopp11 RET popop2: LD B, 11d LD DE, sop2 LD HL, (adrop2) hopp12: LD A, (DE) LD (HL), A INC DE INC HL DJNZ hopp12 RET popop3: LD B, 11d LD DE, sop3 LD HL, (adrop3) hopp13: LD A, (DE) LD (HL), A INC DE INC HL DJNZ hopp13 RET popop4: LD B, 11d LD DE, sop4 LD HL, (adrop4) hopp14: LD A, (DE) LD (HL), A INC DE INC HL DJNZ hopp14 RET popop5: LD B, 11d LD DE, sop5 LD HL, (adrop5) hopp15: LD A, (DE) LD (HL), A INC DE INC HL DJNZ hopp15 RET popop6: LD B, 11d LD DE, sop6 LD HL, (adrop6) hopp16: LD A, (DE) LD (HL), A INC DE INC HL DJNZ hopp16 RET sop1: .dw $0000,$0000,$0000,$0000,$0000,$0000,$0000,$0000,$0000,$0000,$0000 sop2: .dw $0000,$0000,$0000,$0000,$0000,$0000,$0000,$0000,$0000,$0000,$0000 sop3: .dw $0000,$0000,$0000,$0000,$0000,$0000,$0000,$0000,$0000,$0000,$0000 sop4: .dw $0000,$0000,$0000,$0000,$0000,$0000,$0000,$0000,$0000,$0000,$0000 sop5: .dw $0000,$0000,$0000,$0000,$0000,$0000,$0000,$0000,$0000,$0000,$0000 sop6: .dw $0000,$0000,$0000,$0000,$0000,$0000,$0000,$0000,$0000,$0000,$0000 adrop1: .dw $8039 adrop2: .dw $8044 adrop3: .dw $804F adrop4: .dw $805A adrop5: .dw $8065 adrop6: .dw $8070 .END