💾 Archived View for mirrors.apple2.org.za › archive › apple2.archive.umich.edu › apple2 › 8bit › bas… captured on 2024-12-17 at 23:09:07.

View Raw

More Information

-=-=-=-=-=-=-


 XC
 LST OFF

PNTR EQU $00
PNTR2 EQU $02
TEMP EQU $04
CH EQU $24
CV EQU $25
BASL EQU $26
TEMPA EQU $80
TEMPX EQU $81
TEMPY EQU $82
MOUSEX EQU $83
MOUSEY EQU $84
BUTTON EQU $85
OLDMX EQU $86
OLDMY EQU $87

MOUSEXL EQU $47C
MOUSEXH EQU $57C
MOUSEYL EQU $4FC
MOUSEYH EQU $5FC
BUTTONST EQU $77C

VBL EQU $C019
BANK EQU $C054
SETMOUSE EQU $C412
READMOUSE EQU $C414
CLAMPMOUSE EQU $C417
INITMOUSE EQU $C419

 JMP MAIN

COL0TBLL DFB $400,$480,$500,$580,$600,$680,$700,$780
 DFB $428,$4A8,$528,$5A8,$628,$6A8,$728,$7A8
 DFB $450,$4D0,$550,$5D0,$650,$6D0,$750,$7D0
COL0TBLH DFB /$400,/$480,/$500,/$580,/$600,/$680,/$700,/$780
 DFB /$428,/$4A8,/$528,/$5A8,/$628,/$6A8,/$728,/$7A8
 DFB /$450,/$4D0,/$550,/$5D0,/$650,/$6D0,/$750,/$7D0

BASLKUP LDX CV
 LDA COL0TBLL,X
 STA BASL
 LDA COL0TBLH,X
 STA BASL+1
 BIT BANK
 LDA CH
 LSR
 TAY
 BCS :NOBIT
 BIT BANK+1
:NOBIT RTS

RAWCOUT STA TEMPA
 STX TEMPX
 STY TEMPY
 LDX CV
 LDA COL0TBLL,X
 STA BASL
 LDA COL0TBLH,X
 STA BASL+1
 BIT BANK
 LDA CH
 LSR
 TAY
 BCS :NOBIT
 BIT BANK+1
:NOBIT LDA TEMPA
 STA (BASL),Y
 BIT BANK
 INC CH
 LDX TEMPX
 LDY TEMPY
 RTS

UNDER? HEX 00 ; Flag indicating valid byte in UNDER
UNDER HEX 00 ; Character currently under mouse

JMPPNTR JMP (PNTR)

GOMOUSE LDX #$C4
 LDY #$40
 PHP
 SEI
 BIT BANK ; Make sure we have right screen holes!
 JSR JMPPNTR
 PLP
 RTS

INITM STZ UNDER? ; No character in UNDER
 LDA INITMOUSE ; First do INITMOUSE call
 STA PNTR
 LDA #/INITMOUSE
 STA PNTR+1
 JSR GOMOUSE
 LDA SETMOUSE ; Set passive mouse mode
 STA PNTR
 LDA #/SETMOUSE
 STA PNTR+1
 LDA #$01 ; Passive mouse mode
 JSR GOMOUSE
 LDA CLAMPMOUSE ; Set clamping values
 STA PNTR
 LDA #/CLAMPMOUSE
 STA PNTR+1
 LDA #$00 ; Set X clamps first
 STZ $478
 STZ $578
 LDX #632 ; Low = 0, high = 316
 STX $4F8
 LDX #/632
 STX $5F8
 JSR GOMOUSE
 LDA #$01 ; Set Y clamps next
 STZ $478
 STZ $578
 LDX #184
 STX $4F8
 LDX #/184
 STX $5F8
 JMP GOMOUSE

READM LDA READMOUSE ; Read the mouse
 STA PNTR
 LDA #/READMOUSE
 STA PNTR+1
 JSR GOMOUSE
 LDA MOUSEXH ; Divide mouse X position by 4
 STA PNTR
 LDA MOUSEXL
 LSR PNTR
 ROR
 LSR PNTR
 ROR
 STA MOUSEX
 LDA MOUSEYH ; Divide mouse Y position by 8
 STA PNTR
 LDA MOUSEYL
 LSR PNTR
 ROR
 LSR PNTR
 ROR
 LSR PNTR
 ROR
 STA MOUSEY
 LDA BUTTONST ; Set up button status
 STA BUTTON
 RTS

ERASEMP STX TEMP ; Lot of routines need X-register intact
 BIT UNDER? ; If no valid character in UNDER
 BPL :FINIS ;   don't do anything
 LDA OLDMY ; Set up bank, BASL, Y-register
 STA CV
 LDA OLDMX
 STA CH
 JSR BASLKUP
 LDA UNDER ; Restore character at mouse pointer
 STA (BASL),Y
 STZ UNDER?
:FINIS LDX TEMP
 RTS

DRAWMP BIT UNDER? ; See if there is a character waiting
 BPL :DRAWIT ;   to be restored
 JSR ERASEMP ; Erase character first
:DRAWIT LDA MOUSEY ; Set up bank, BASL, Y-register
 STA CV
 LDA MOUSEX
 STA CH
 JSR BASLKUP
 LDA (BASL),Y ; Load character under mouse pointer
 STA UNDER ;   and save it
 SEC
 ROR UNDER?
 LDA #$42 ; Draw mouse pointer
 STA (BASL),Y
 LDA MOUSEX ; Store coordinates as OLDMX, OLDMY
 STA OLDMX
 LDA MOUSEY
 STA OLDMY
 RTS

MBITEML DS 8 ; Pointer to text for each menu bar item
MBITEMH DS 8
MBITEMX DS 9 ; Leftmost column of each item
MBITEMS HEX 00 ; Number of menu bar items

CLRMB STZ MBITEMS
 RTS

ADDMB LDY MBITEMS
 CPY #$07
 BEQ :FULL
 STA MBITEML,Y
 TXA
 STA MBITEMH,Y
 INY
 STY MBITEMS
:FULL RTS

SHOWMB STZ CV ; Set up cursor position
 STZ CH
 LDA #$20 ; Menu bar's leading space
 JSR RAWCOUT
 LDX #$00
 CPX MBITEMS
 BEQ :PADREST
:OUTER LDA MBITEML,X ; Fetch pointer to menu bar item
 STA PNTR
 LDA MBITEMH,X
 STA PNTR+1
 LDA CH ; Store leftmost column of menu bar item
 STA MBITEMX,X
 LDA #$20 ; Menu bar item's leading space
 JSR RAWCOUT
 LDY #$00 ; Print out menu bar item in inverse
:INNER LDA (PNTR),Y
 BEQ :EOL
 CMP #$41 ; Do translation on capital letters
 BCC :NOTRANS
 CMP #$41+26
 BCS :NOTRANS
 AND #%10111111
:NOTRANS JSR RAWCOUT
 INY
 BRA :INNER
:EOL LDA #$20 ; Print trailing two spaces
 JSR RAWCOUT
 JSR RAWCOUT
 INX ; Loop through all menu bar items
 CPX MBITEMS
 BNE :OUTER
:PADREST LDA CH ; Set up rightmost column of last item
 STA MBITEMX,X
 LDA #$20 ; Pad to end of line with inverse spaces
:LOOP JSR RAWCOUT
 LDX CH
 CPX #80
 BNE :LOOP
 RTS

LEFTEDGE HEX 00 ; Top left X position
TOPEDGE HEX 00 ; Top left Y position
WIDTH HEX 00
HEIGHT HEX 00

RGHTEDGE HEX 00
LEDIV2 HEX 00 ; Left edge / 2
REDIV2 HEX 00 ; Right edge / 2
BOTTOM HEX 00 ; Bottom line + 1

CALC2P LDA LEFTEDGE
 CLC
 ADC WIDTH
 STA RGHTEDGE
 DEC
 LSR
 STA REDIV2
 LDA LEFTEDGE
 LSR
 STA LEDIV2
 LDA TOPEDGE
 CLC
 ADC HEIGHT
 STA BOTTOM
 RTS

DRAWMID LDA REDIV2 ; Number of characters
 SEC
 SBC LEDIV2
 STA TEMP
 LDX TOPEDGE
:OUTER LDA COL0TBLL,X ; Set up PNTR
 CLC
 ADC LEDIV2
 STA PNTR
 LDA COL0TBLH,X
 CLC
 ADC #$00
 STA PNTR+1
 LDA #" " ; Fill in line
 BIT BANK+1
 LDY TEMP
:INNER STA (PNTR),Y
 DEY
 BPL :INNER
 BIT BANK
 LDY TEMP
:INNER2 STA (PNTR),Y
 DEY
 BPL :INNER2
 INX ; Move down a row, do next line
 CPX BOTTOM
 BNE :OUTER
 RTS

DRAWVL STA TEMP ; Store fill character in TEMP
 BIT BANK ; Figure out bank first
 TYA
 LSR
 TAY
 BCS :NOBIT
 BIT BANK+1
:NOBIT
 LDX TOPEDGE
:OUTER LDA COL0TBLL,X
 STA PNTR
 LDA COL0TBLH,X
 STA PNTR+1
 LDA TEMP
 STA (PNTR),Y
 INX
 CPX BOTTOM
 BNE :OUTER
 RTS

DRAWHL1 LDA COL0TBLL,X ; Get pointer to column 0
 STA PNTR
 LDA COL0TBLH,X
 STA PNTR+1
 LDX LEFTEDGE ; Loop through from left to right
:LOOP BIT BANK
 TXA
 LSR
 TAY
 BCS :NOBIT
 BIT BANK+1
:NOBIT LDA TEMP
 STA (PNTR),Y
 INX
 CPX RGHTEDGE
 BNE :LOOP
 RTS

DRAWHL2 LDA COL0TBLL,X ; Get pointer to column 0
 STA PNTR
 LDA COL0TBLH,X
 STA PNTR+1
 LDX LEFTEDGE ; Catch left corner space
 DEX
 BIT BANK
 TXA
 LSR
 TAY
 BCS :NOBIT
 BIT BANK+1
:NOBIT LDA #" "
 STA (PNTR),Y
 INX ; Loop through from left to right
:LOOP BIT BANK
 TXA
 LSR
 TAY
 BCS :NOBIT2
 BIT BANK+1
:NOBIT2 LDA TEMP
 STA (PNTR),Y
 INX
 CPX RGHTEDGE
 BNE :LOOP
 BIT BANK ; Catch right corner space
 TXA
 LSR
 TAY
 BCS :NOBIT3
 BIT BANK+1
:NOBIT3 LDA #" "
 STA (PNTR),Y
 RTS

DRAWLEFT LDA #$5A ; Set up parameters
 LDY LEFTEDGE
 DEY
 JMP DRAWVL

DRAWRGHT LDA #$5F
 LDY RGHTEDGE
 JMP DRAWVL

DRAWMBOT LDA #$4C
 STA TEMP
 LDX BOTTOM
 JMP DRAWHL2

DRAWMBOX JSR CALC2P
 JSR DRAWMID ; Draw middle of box
 JSR DRAWLEFT
 JSR DRAWRGHT
 JMP DRAWMBOT

DRAWTOP1 LDA #"_"
 STA TEMP
 LDX TOPEDGE
 DEX
 JSR DRAWHL2
 LDA #$4C
 STA TEMP
 LDX TOPEDGE
 JMP DRAWHL1

DRAWBOT1 LDA #"_"
 STA TEMP
 LDX BOTTOM
 DEX
 JSR DRAWHL1
 LDA #$4C
 STA TEMP
 LDX BOTTOM
 JMP DRAWHL2

DRAWDIA1 JSR CALC2P
 INC BOTTOM
 DEC TOPEDGE
 JSR DRAWMID
 DEC BOTTOM
 INC TOPEDGE
 JSR DRAWLEFT
 JSR DRAWRGHT
 JSR DRAWTOP1
 JMP DRAWBOT1

DRAWTB LDA #"_"
 STA TEMP
 LDX TOPEDGE
 DEX
 JMP DRAWHL1

DRAWBB LDA #$4C
 STA TEMP
 LDX BOTTOM
 JMP DRAWHL1

DRAWBUTN LDA #$01 ; Buttons are a fixed size
 STA HEIGHT
 LDA #10
 STA WIDTH
 JSR CALC2P
 JSR DRAWLEFT
 JSR DRAWRGHT
 JSR DRAWTB ; Draw top of button
 JMP DRAWBB ; Draw bottom of button

GETPNTR2 INC PNTR2
 BNE :SKIPINC
 INC PNTR2+1
:SKIPINC LDA (PNTR2)
 RTS

TQDRAW STA PNTR2
 STX PNTR2+1
 LDA (PNTR2)
 BRA :ENTRY
:GETOBJ JSR GETPNTR2 ; Get object #
:ENTRY BNE :NOTFINI
 RTS
:NOTFINI CMP #$01
 BNE :NOTDIA1
 JSR GETPNTR2 ; Draw a titleless dialogue box
 STA TOPEDGE
 JSR GETPNTR2
 STA LEFTEDGE
 JSR GETPNTR2
 STA HEIGHT
 JSR GETPNTR2
 STA WIDTH
 JSR DRAWDIA1
 BRA :GETOBJ
:NOTDIA1 CMP #$02
 BNE :NOTDIA2
 STA TOPEDGE ; Draw titled dialogue box
 JSR GETPNTR2
 STA LEFTEDGE
 JSR GETPNTR2
 STA HEIGHT
 JSR GETPNTR2
 STA WIDTH
; Put something here
 BRA :GETOBJ
:NOTDIA2 CMP #$03
 BNE :NOTBUTN
 JSR GETPNTR2 ; Draw button
 STA TOPEDGE
 JSR GETPNTR2
 STA LEFTEDGE
 JSR DRAWBUTN
 LDA TOPEDGE ; Fill in text inside
 STA CV
 LDA LEFTEDGE
 STA CH
 LDA #$20
 JSR RAWCOUT
 LDY #$08
:LOOP JSR GETPNTR2
 ORA #$80
 JSR RAWCOUT
 DEY
 BNE :LOOP
 LDA #$20
 JSR RAWCOUT
:GETOBJ2 BRA :GETOBJ ; This BRA used to extend BRA reach
:NOTBUTN CMP #$04
 BNE :NOTRADI
 JSR GETPNTR2 ; Draw radio button
 BRA :GETOBJ2
:NOTRADI CMP #$05
 BNE :NOTTEXT
 JSR GETPNTR2 ; Print text
 STA CV
 JSR GETPNTR2
 STA CH
:LOOP2 JSR GETPNTR2
 BEQ :GETOBJ2
 ORA #$80
 JSR RAWCOUT
 BRA :LOOP2
:NOTTEXT
:FINIS RTS

SAVED? HEX 00 ; Is a screen stored or not?

RESTORE BIT SAVED? ; Make sure there's a saved screen to restore
 BPL :FINIS
 JSR ERASEMP
 LDA #$FF ; No menus or items inversed
 STA CURRMENU
 STA CURRSEL
 BIT BANK+1
 LDY #120
:LOOP LDA SCREEN,Y
 STA $400,Y
 LDA SCREEN+120,Y
 STA $480,Y
 LDA SCREEN+240,Y
 STA $500,Y
 LDA SCREEN+360,Y
 STA $580,Y
 LDA SCREEN+480,Y
 STA $600,Y
 LDA SCREEN+600,Y
 STA $680,Y
 LDA SCREEN+720,Y
 STA $700,Y
 LDA SCREEN+840,Y
 STA $780,Y
 DEY
 BPL :LOOP
 BIT BANK
 LDY #120
:LOOP2 LDA SCREEN+960,Y
 STA $400,Y
 LDA SCREEN+1080,Y
 STA $480,Y
 LDA SCREEN+1200,Y
 STA $500,Y
 LDA SCREEN+1320,Y
 STA $580,Y
 LDA SCREEN+1440,Y
 STA $600,Y
 LDA SCREEN+1560,Y
 STA $680,Y
 LDA SCREEN+1680,Y
 STA $700,Y
 LDA SCREEN+1800,Y
 STA $780,Y
 DEY
 BPL :LOOP2
 STZ SAVED?
:FINIS RTS

SAVE JSR ERASEMP
 BIT SAVED? ; Check if we need to restore screen first
 BPL :NOREST
 JSR RESTORE
:NOREST BIT BANK+1
 LDY #120
:LOOP LDA $400,Y
 STA SCREEN,Y
 LDA $480,Y
 STA SCREEN+120,Y
 LDA $500,Y
 STA SCREEN+240,Y
 LDA $580,Y
 STA SCREEN+360,Y
 LDA $600,Y
 STA SCREEN+480,Y
 LDA $680,Y
 STA SCREEN+600,Y
 LDA $700,Y
 STA SCREEN+720,Y
 LDA $780,Y
 STA SCREEN+840,Y
 DEY
 BPL :LOOP
 BIT BANK
 LDY #120
:LOOP2 LDA $400,Y
 STA SCREEN+960,Y
 LDA $480,Y
 STA SCREEN+1080,Y
 LDA $500,Y
 STA SCREEN+1200,Y
 LDA $580,Y
 STA SCREEN+1320,Y
 LDA $600,Y
 STA SCREEN+1440,Y
 LDA $680,Y
 STA SCREEN+1560,Y
 LDA $700,Y
 STA SCREEN+1680,Y
 LDA $780,Y
 STA SCREEN+1800,Y
 DEY
 BPL :LOOP2
 LDA #$FF
 STA SAVED?
 RTS

CURRMENU HEX 00 ; Menu currently open
CURRSEL HEX 00 ; Current selection inversed

NORMMBI JSR ERASEMP ; Make sure mouse pointer is disappeared
 LDA MBITEML,X ; Fetch pointer to menu bar item
 STA PNTR
 LDA MBITEMH,X
 STA PNTR+1
 STZ CV ; Set up cursor position of
 LDA MBITEMX,X ; menu bar item
 STA CH
 LDA #" " ; Print leading space
 JSR RAWCOUT
 LDY #$00 ; Print out menu bar item in normal text
:LOOP LDA (PNTR),Y
 BEQ :EOL
 ORA #$80
 CMP #"@" ; Translate "@" to an apple-sign
 BNE :NOTRANS
 LDA #$41
:NOTRANS JSR RAWCOUT
 INY
 BRA :LOOP
:EOL LDA #" " ; Print trailing two spaces
 JSR RAWCOUT
 JMP RAWCOUT

SHOWTEXT LDX #21 ; Clear out all divider flags
:LOOP STZ DIVIDER?,X
 DEX
 BPL :LOOP
 LDA #$01 ; Set up first row of text
 STA CV
:OUTER LDA LEFTEDGE ; Set up column
 STA CH
:INNER INY ; Print text out
 BNE :SKIPINC
 INC PNTR2+1
:SKIPINC LDA (PNTR2),Y ; Check if finished already
 BEQ :FINIS
 CMP #$0D
 BEQ :EOL
 ORA #$80
 CMP #$D3
 BNE :NOTDIV
 LDX WIDTH ; Print out a divider line
 LDA #$53
:LOOP2 JSR RAWCOUT
 DEX
 BNE :LOOP2
 LDX CV ; This is a divider row so can't select
 STA DIVIDER?,X
 BRA :INNER
:NOTDIV CMP #"@" ; Translate "@" to Apple-sign
 BNE :NOTATSN
 LDA #$41
:NOTATSN JSR RAWCOUT
 BRA :INNER
:EOL INC CV ; Go to next row of text
 BRA :OUTER
:FINIS RTS

CHKPDM LDX MBITEMS ; If mouse pointer is to right of last
 LDA MBITEMX,X ;  item then don't need to check
 CMP MOUSEX
 BCC :FINIS
 DEX
 LDA MOUSEX ; Find which menu bar item
:LOOP CMP MBITEMX,X ;   mouse pointer is currently over
 BCC :NEXT
 CMP MBITEMX+1,X
 BCC :MATCH
:NEXT DEX
 BPL :LOOP
:FINIS JMP RESTORE ; Mouse pointer is probably over column 0
:MATCH CPX CURRMENU ; Check to see if this menu is already open
 BNE :OPENIT
 RTS
:OPENIT PHX
 JSR SAVE ; Save the screen first
 PLX
 STX CURRMENU
 JSR NORMMBI ; Normalize menu bar item that pointer is on
 LDA MBITEMX,X ; Set up parameters for DRAWMBOX call
 STA LEFTEDGE
 LDA #$01
 STA TOPEDGE
 INY ; (Pick up pointer to pull-down menu left by
 LDA (PNTR),Y ;   NORMMBI)
 TAX
 INY
 LDA (PNTR),Y
 STA PNTR2+1
 STX PNTR2
 LDA (PNTR2) ; Set up more parameters for DRAWMBOX call
 STA HEIGHT
 LDY #$01
 LDA (PNTR2),Y
 STA WIDTH
 JSR DRAWMBOX ; Draw the box
 LDY #$01
 JSR SHOWTEXT ; Show the text in pull-down menu
 RTS

DIVIDER? DS 22 ; If text is divider then null
SELECTS HEX 00 ; Number of selections

NORMMI LDA CURRMENU
 BMI :FINIS
 LDA CURRSEL ; Set up pointer to column 0 of row
 BMI :FINIS
 JSR ERASEMP
 LDX CURRSEL
 LDA COL0TBLL,X
 STA PNTR
 LDA COL0TBLH,X
 STA PNTR+1
 LDX LEFTEDGE
:LOOP BIT BANK
 TXA
 LSR
 TAY
 BCS :NOBIT
 BIT BANK+1
:NOBIT LDA (PNTR),Y
 CMP #$40 ; Make sure apple stays intact
 BNE :NOTAPPL
 INC
 BRA :NOTRANS
:NOTAPPL ORA #$80
 CMP #$81 ; Do translation on capital letters
 BCC :NOTRANS ;   to move them where they're supposed to be
 CMP #$81+26
 BCS :NOTRANS
 ORA #$40
:NOTRANS STA (PNTR),Y
 INX
 CPX RGHTEDGE
 BNE :LOOP
:FINIS LDA #$FF ; Nothing inversed now
 STA CURRSEL
 RTS

SELECTMI LDA CURRMENU ; Make sure there's a window open
 BMI :FINIS
 LDA MOUSEY ; Check if mouse is within menu
 DEC ; If not within menu, then check for
 CMP HEIGHT ;   normalizing selected items
 BCS NORMMI
 LDA MOUSEX
 CMP LEFTEDGE
 BCC NORMMI
 CMP RGHTEDGE
 BCS NORMMI
 LDX MOUSEY ; Check to see if it's a divider
 LDA DIVIDER?,X
 BNE NORMMI
 LDX CURRSEL ; See if it's already inversed
 CPX MOUSEY
 BEQ :FINIS
 TXA ; If there's a menu selection inversed
 BMI :NONORM ;   then normalize it first
 JSR NORMMI
:NONORM JSR ERASEMP
 LDX MOUSEY ; Store selection we're inversing
 STX CURRSEL
 LDA COL0TBLL,X ; Set up pointer to column 0 of row
 STA PNTR
 LDA COL0TBLH,X
 STA PNTR+1
 LDX LEFTEDGE
:LOOP BIT BANK
 TXA
 LSR
 TAY
 BCS :NOBIT
 BIT BANK+1
:NOBIT LDA (PNTR),Y
 CMP #$41 ; Make sure open-apple doesn't get munched
 BNE :NOTAPPL
 DEC
 BRA :NOTRANS
:NOTAPPL AND #$7F
 CMP #$41 ; Do translation on capital letters
 BCC :NOTRANS ;   to move them out of mousetext area
 CMP #$41+26
 BCS :NOTRANS
 AND #$3F
:NOTRANS STA (PNTR),Y
 INX
 CPX RGHTEDGE
 BNE :LOOP
:FINIS RTS

WAIT LDX #$03
:MAIN BIT VBL
 BPL :MAIN
:LOOP BIT VBL
 BMI :LOOP
 DEX
 BNE :MAIN
 RTS

EVENTLOOP
 LDA #$FF ; No menus open or items selected
 STA CURRMENU
 STA CURRSEL
:LOOP BIT VBL
 BMI :LOOP
:WAIT BIT VBL
 BPL :WAIT
 JSR READM ; Read mouse position
 JSR DRAWMP ; Draw mouse pointer
 LDA MOUSEY ; Check if mouse is over menu bar
 BNE :NOTMB
 LDA BUTTON ; Check if mouse button is pressed
 BPL :NOTPRES
 JSR NORMMI ; Normalize any selected items
 JSR CHKPDM ; Check if pull-down menu needs to be opened
 BRA :LOOP
:NOTPRES JSR RESTORE ; Restore screen to normal
 BRA :LOOP
:NOTMB LDA BUTTON ; Mouse is not over menu bar, button pressed?
 BPL :NOTPR2
 JSR SELECTMI ; See mouse pointer is over menu selections
 BRA :LOOP
:NOTPR2 LDX CURRMENU ; See if any menus open & selected
 BMI :NOTPRES
 LDY CURRSEL
 BMI :NOTPRES
 PHX
 DEY
 PHY
 JSR NORMMI
 JSR WAIT
 JSR SELECTMI
 JSR WAIT
 JSR NORMMI
 JSR WAIT
 JSR SELECTMI
 JSR WAIT
 JSR NORMMI
 JSR WAIT
 JSR RESTORE
 PLY
 PLX
 RTS

MAIN STA $C00D ; 80 cols on
 STA $C001 ; 80 col store on
 STA $C00F ; Alt character set
 STZ CV
 STZ CH
 LDX #$06 ; Print out background gunk
 LDY #$00
:LOOP LDA #$FF
 JSR RAWCOUT
 LDA CH
 CMP #80
 BNE :SKIP
 STZ CH
 INC CV
:SKIP DEY
 BNE :LOOP
 DEX
 BNE :LOOP
 JSR CLRMB
 LDA #:ITEM0
 LDX #/:ITEM0
 JSR ADDMB
 LDA #:ITEM1
 LDX #/:ITEM1
 JSR ADDMB
 LDA #:ITEM2
 LDX #/:ITEM2
 JSR ADDMB
 LDA #:ITEM3
 LDX #/:ITEM3
 JSR ADDMB
 JSR INITM
 JSR SHOWMB
:LOOP2 JSR EVENTLOOP
 CPX #$03
 BNE :LOOP
 CPY #$00
 BNE :LOOP
 JMP TEST1
 BRA :LOOP2
:ITEM0 ASC '@',00
 DW :MENU0
:ITEM1 ASC 'File',00
 DW :MENU1
:ITEM2 ASC 'Options',00
 DW :MENU2
:ITEM3 ASC 'K-rad features',00
 DW :MENU3
:MENU0 DFB 7,26
 ASC '  About this program      ',0D
 HEX 7F
 ASC ' About the author       ',7F0D
 ASC '  About his friends       ',0D
 HEX 530D
 ASC '  About the authors dog   ',0D
 ASC '  About the authors cat   ',0D
 ASC '  About the Apple //gs    ',00
:MENU1 DFB 3,7
 ASC '  Gnu  ',0d
 ASC '  Open ',0d
 ASC ' Close ',00
:MENU2 DFB 1,17
 ASC '  What options?  ',00
:MENU3 DFB 14,24
 ASC '  Emit radiation     @R ',0d
 ASC '  Cause power failure   ',0d
 ASC '  Destroy nearby disks  ',0d
 ASC '  Incinerate chips      ',0d
 ASC '  Rain cats and dogs    ',0d
 ASC '  Ginsu knife option    ',0d
 ASC '  Debug any program     ',0d
 ASC '  Crash randomly        ',0D
 ASC '  Barbecue chicken      ',0D
 HEX 530D
 ASC '  Do the twist          ',0d
 ASC '  Do the mamba          ',0d
 ASC '  Do disco Donald       ',0d
 ASC '  Get down! Be hIp!     ',00

TEST2 LDA #5
 STA TOPEDGE
 STA LEFTEDGE
 LDA #10
 STA HEIGHT
 LDA #50
 STA WIDTH
 JSR DRAWDIA1
 LDA #7
 STA TOPEDGE
 STA LEFTEDGE
 JSR DRAWBUTN
 BRK
TEST0 LDA #:DATA
 LDX #/:DATA
 JMP TQDRAW
:DATA DFB 1 ; Titleless dialogue
 DFB 4,15
 DFB 10,40
 DFB 5
 DFB 5,15
 ASC '  '
TEST1 LDA #:DATA
 LDX #/:DATA
 JSR TQDRAW
 RTS
:DATA DFB 1 ; Draw titleless dialogue box
 DFB 10,10 ; At position 10,10
 DFB 6,45 ; Height - 5, Width - 45
 DFB 5
 DFB 11,15
 ASC 'Lethal radiation has been emitted.',00
 DFB 3 ; Draw button
 DFB 13,12 ; At relative position 5,5
 ASC '   OK   ' ; With text "OK" inside
 DFB 3 ; Draw another button
 DFB 13,24
 ASC ' Cancel '
 HEX 00 ; no more objects
SCREEN
 SAV NEAT